' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2023.12.16.16.28]) on 2024.02.18 at 18:59 (Coordinated Universal Time)
' https://qb64phoenix.com/forum/showthread.php?tid=270&pid=23173#pid23173
_TITLE "VFG"
' Vince's Favorite Game
' A QBJS program by Vince, ported to BAM by Charlie Veniot

' 🟠🟠🟠🟠 DECLARATIONS

CONST KEY_UP = 38, KEY_LEFT = 37, KEY_RIGHT = 39, KEY_SPACE = 32, KEY_SHIFT = 16, KEY_P = 80, KEY_ENTER = 13

DIM piece( 17, 2, 4 ), piece_color( 17 )
    GOSUB 🧩200_BuildPieces
    
DIM size = 15, sw = 12, sh = 25

DIM xx, yy '🔖 big x and y

DIM board( sw - 1, sh - 1 )

DECLARE FUNCTION place( pn, px, py, rot )
DECLARE FUNCTION valid( pn, px, py, rot )
DECLARE SUB rotate( x, y, pn, rot )
DEFDV title$ = "lines=" + LTRIM$( STR$( lines ) ) + ",speed=" + LTRIM$( STR$( speed ) )

DIM t, kt AS DOUBLE

redraw = 1

speed = 3
lines = 0
pause = FALSE
putpiece = FALSE
startx = ( sw - 4 ) / 2

pn = INT( RND * 18 )
px = startx
py = -2
rot = 0

' 🟠🟠🟠🟠 MAIN PROGRAM

SCREEN _NEWIMAGE( sw * size, sh * size + 34, 32 )
_INITAUDIO

t = TIMER : kt = TIMER

🏁🏁🏁LoopStart:

    GOSUB ⏱100_TimerEval

    IF putpiece THEN
       IF valid( pn, px, py, rot ) THEN
          n = place( pn, px, py, rot )
          IF n THEN lines = lines + n
       END IF

       pn = INT( RND * 18 )
       px = startx
       py = -2
       rot = 0

       putpiece = FALSE
       redraw = 1

       IF NOT valid(pn, px, py, rot) THEN
          FOR y = 0 TO sh - 1 : FOR x = 0 TO sw - 1
              board(x, y) = 0
          NEXT x : NEXT y
          lines = 0
          SOUND 200, 3
          PRINT "Ouch !" 
          PRINT "Press the Enter key"
          PRINT "(or click/touch the"
          PRINT "screen) to start a"
          PRINT "new game." 
          WHILE _MOUSEBUTTON : WEND
          WHILE KEYSTATE() <> KEY_ENTER AND NOT _MOUSEBUTTON : WEND
          WHILE _MOUSEBUTTON : WEND
       END IF
    END IF

    IF redraw THEN GOSUB 🖥400_DoRedraw
    IF TIMER - kt > 0.1275 THEN kt = TIMER : GOSUB 🔁300_HandleKeyPress

    redraw = 1
GOTO 🏁🏁🏁LoopStart


' 🟠🟠🟠🟠 GOSUB ROUTINES

⏱100_TimerEval:
    IF (TIMER - t) > (1/speed) AND NOT pause THEN
        IF valid(pn, px, py + 1, rot) THEN py = py + 1 ELSE putpiece = TRUE
        t = TIMER
        redraw = 1
    END IF
RETURN

🧩200_BuildPieces:
  FOR p0% = 0 TO 17 : FOR p2% = 0 TO 4 : FOR p1% = 0 TO 2
      READ d%
      piece( p0%, p1%, p2% ) = d%
  NEXT p2% : NEXT p1% : NEXT p0%
  FOR p0% = 0 TO 17
    READ r%, g%, b%
    piece_color( p0% ) = _rgb( r%, g%, b% )
  NEXT p0%
RETURN

🔁300_HandleKeyPress:
    IF KEYSTATE( KEY_UP ) _
           OR ( _MOUSEBUTTON AND BETWEEN( _MOUSEX, 2, 37 ) AND BETWEEN( _MOUSEY, YMAX - 32, YMAX ) ) THEN
        IF valid( pn, px, py, ( rot + 1 ) MOD 4 ) THEN rot = ( rot + 1 ) MOD 4 : SOUND 50, 0.5
        pause = FALSE
    ELSEIF KEYSTATE( KEY_LEFT ) _
           OR ( _MOUSEBUTTON AND BETWEEN( _MOUSEX, 96, 131 ) AND BETWEEN( _MOUSEY, YMAX - 32, YMAX ) ) THEN
        IF valid( pn, px - 1, py, rot ) THEN px = px - 1
        pause = FALSE
    ELSEIF KEYSTATE( KEY_RIGHT ) _
           OR ( _MOUSEBUTTON AND BETWEEN( _MOUSEX, 136, 171 ) AND BETWEEN( _MOUSEY, YMAX - 32, YMAX ) ) THEN
        IF valid( pn, px + 1, py, rot ) THEN px = px + 1
        pause = FALSE
    ELSEIF KEYSTATE( KEY_SPACE ) _
           OR ( _MOUSEBUTTON AND BETWEEN( _MOUSEX, 42, 77 ) AND BETWEEN( _MOUSEY, YMAX - 32, YMAX ) ) THEN
        FOR y2 = py TO sh - 1
            py = y2 - 1
            IF NOT valid( pn, px, y2, rot ) THEN y2 = sh '🔖 exit for
        NEXT
        putpiece = TRUE
        pause = FALSE
    ELSEIF KEYSTATE( KEY_P ) _
           OR ( _MOUSEBUTTON AND BETWEEN( _MOUSEX, 0, XMAX ) AND BETWEEN( _MOUSEY, 0, ( sh * size ) ) ) THEN
        pause = TRUE
    END IF
RETURN

🖥400_DoRedraw:
    LINE ( 0, 0 ) - ( sw * size, sh * size ), _RGB( 0, 0, 0 ), BF
    FOR y = 0 TO sh - 1 : FOR x = 0 TO sw - 1
        IF board(x, y) <> 0 THEN
           LINE ( x * size, y * size ) - STEP ( size - 2, size - 2 ), piece_color( board( x, y ) -1 ), BF
           LINE ( x * size, y * size ) - STEP ( size - 2, size - 2 ), _RGB( 255,255,255 ), B
        ELSE
           line ( x * size, y * size ) - STEP ( size - 2, size - 2 ), _RGB( 100,100,100 ), b
        END IF
    NEXT x : NEXT y
    FOR y = 0 TO 4 : FOR x = 0 TO 2
        rotate ( x, y, pn, rot )
        IF piece( pn, x, y ) THEN _
            LINE ( ( px + xx ) * size, ( py + yy ) * size ) - STEP ( size - 2, size - 2 ), piece_color( pn ), BF : _
            LINE ( ( px + xx ) * size, ( py + yy ) * size ) - STEP ( size - 2, size - 2 ), _RGB( 255, 255, 255 ), B
    NEXT x : NEXT y

    LOCATE INT(YMAX/16) , 3  : PRINT "U    S      L    R";
    xl% = 2 : LINE ( xl%, YMAX - 32 ) - (xl% + 35,YMAX), _RGB(255,255,255), B
    xl% = 42: LINE ( xl%, YMAX - 32 ) - (xl% + 35,YMAX), _RGB(255,255,255), B
    xl% = 96: LINE ( xl%, YMAX - 32 ) - (xl% + 35,YMAX), _RGB(255,255,255), B
    xl% = 136: LINE ( xl%, YMAX - 32 ) - (xl% + 35,YMAX), _RGB(255,255,255), B
    LOCATE 1, 1 : PRINT "lines=" + LTRIM$( STR$( lines ) ) + ",speed=" + LTRIM$( STR$( speed ) ) ' title$
    _DISPLAY
    redraw = 0
RETURN

' 🟠🟠🟠🟠 SUB AND FUNCTIONS

SUB rotate( x, y, pn, rot )
    LET rot_new = IFF( pn = 0, rot mod 2 , rot )

    SELECT CASE rot_new
      CASE 0
        xx = x : yy = y
      CASE 1
        IF pn = 0 OR pn = 14 OR pn = 15 THEN
           xx = y - 1 : yy = 3 - x
        ELSE
           xx = y - 2 : yy = 4 - x
        END IF
      CASE 2
        xx = 2 - x
        yy = IFF( pn = 14 OR pn = 15, 4, 6 ) - y
      CASE 3
        IF pn = 14 OR pn = 15 THEN
            xx = 3 - y : yy = x + 1
        ELSE
            xx = 4 - y : yy = x + 2
        END IF
    END SELECT
END SUB

FUNCTION valid( pn, px, py, rot )
    FOR y = 0 TO 4
        FOR x = 0 TO 2
            rotate ( x, y, pn, rot )
            IF py + yy >= 0 THEN
                IF piece( pn, x, y ) THEN
                    IF ( px + xx >= sw ) OR ( px + xx < 0 ) _
                    OR ( py + yy >= sh ) OR board( px + xx, py + yy ) THEN
                        valid = FALSE
                        EXIT FUNCTION
                    END IF
                END IF
            END IF
        NEXT x
    NEXT y
    valid = TRUE
END FUNCTION

FUNCTION place( pn, px, py, rot )
    lines2 = 0
    FOR y = 0 TO 4 : FOR x = 0 TO 2
        CALL rotate( x, y, pn, rot )
        IF py + yy >= 0 AND piece( pn, x, y ) THEN board( px + xx, py + yy ) = pn + 1
    NEXT x : NEXT y
    FOR y = py - 5 TO py + 5 '🔖 clear lines
        IF y >= 0 AND y < sh THEN
            clr = 1
            FOR x = 0 TO sw - 1
                IF board( x, y ) = 0 THEN
                    clr = 0 : x = sw '🔖 exit for
                END IF
            NEXT x
            IF clr THEN
                lines2 = lines2 + 1
                FOR y2 = y TO 1 STEP - 1  : FOR x = 0 TO sw - 1
                    board( x, y2 ) = board( x, y2 - 1 )
                NEXT x : NEXT y2
            END IF
        END IF
    NEXT y
    place = lines2
END FUNCTION

' 🟠🟠🟠🟠 DATA

PieceShapes:
  DATA 0, 1, 0,  0, 1, 0,  0, 1, 0,  0, 1, 0,  0, 1, 0,    0, 0, 0,  0, 0, 0,  0, 1, 1,  1, 1, 0,  0, 1, 0
  DATA 0, 0, 0,  0, 0, 0,  1, 1, 0,  0, 1, 1,  0, 1, 0,    0, 0, 0,  0, 1, 0,  0, 1, 0,  0, 1, 0,  1, 1, 0
  DATA 0, 0, 0,  0, 1, 0,  0, 1, 0,  0, 1, 0,  0, 1, 1,    0, 0, 0,  0, 0, 0,  1, 1, 0,  1, 1, 0,  0, 1, 0
  DATA 0, 0, 0,  0, 0, 0,  0, 1, 1,  0, 1, 1,  0, 1, 0,    0, 0, 0,  0, 1, 0,  0, 1, 0,  1, 1, 0,  1, 0, 0
  DATA 0, 0, 0,  0, 1, 0,  0, 1, 0,  0, 1, 1,  0, 0, 1,    0, 0, 0,  0, 0, 0,  1, 1, 1,  0, 1, 0,  0, 1, 0
  DATA 0, 0, 0,  0, 0, 0,  0, 0, 0,  1, 0, 1,  1, 1, 1,    0, 0, 0,  0, 0, 0,  0, 0, 1,  0, 0, 1,  1, 1, 1
  DATA 0, 0, 0,  0, 0, 0,  0, 0, 1,  0, 1, 1,  1, 1, 0,    0, 0, 0,  0, 0, 0,  0, 1, 0,  1, 1, 1,  0, 1, 0
  DATA 0, 0, 0,  0, 1, 0,  1, 1, 0,  0, 1, 0,  0, 1, 0,    0, 0, 0,  0, 1, 0,  0, 1, 1,  0, 1, 0,  0, 1, 0
  DATA 0, 0, 0,  0, 0, 0,  0, 1, 1,  0, 1, 0,  1, 1, 0,    0, 0, 0,  0, 0, 0,  1, 1, 0,  0, 1, 0,  0, 1, 1
  
PieceColors:  
  DATA 255,0,0,      255,145,0
  DATA 255,200,211,  0,255,220
  DATA 0,230,255,    0,170,10
  DATA 0,250,20,     128,230,0
  DATA 80,150,0,     0,200,0
  DATA 50,160,170,   50,110,175
  DATA 50,50,175,    110,50,175
  DATA 210,0,255,    110,0,130
  DATA 255,0,140,    170,0,100