Tetris game circa 1996 - QuickBasic

tetris.bas

' QBASIC TETRIS PROGRAM
' TYPE 'QBASIC TETRIS' AT THE DOS PROMPT TO RUN
' ONCE IN QBASIC PRESS F5 TO START
' TO QUIT FROM QBASIC TO DOS PRESS ALT-F THEN E
' ORIGINALLY CREATED BY ALEXEY PAJITNOV

' SHS Programming Class, Spring 1996, [email protected]
' AUTHORS:
' Larry Cragun          Kai Middleton       Mary Tormey
' Lyf Gildersleeve      Dalton Paull        Ryan Turner
' Joe Guercio           Alex Pearson        Jon Veitch
' Justin Herrmann       James Rogers        Alia Walton
' Mike Higgins          Kris Sanborn        Adam Warnock
' Melissa Kingsland     Eldon Smith         Jason Williams
' Ben Landis            John Stephenson
' Matt Malay            Josh Thomas


DECLARE SUB BringItDown (row!)
DECLARE SUB CheckForFilledRows ()
DECLARE FUNCTION CheckGameOver! ()
DECLARE FUNCTION CheckLeft! ()
DECLARE FUNCTION CheckRight! ()
DECLARE FUNCTION CheckRotate ()
DECLARE SUB DrawPlayingField ()
DECLARE SUB DrawShape (thecolor)
DECLARE SUB DropShape ()
DECLARE SUB FillP ()
DECLARE SUB GetSpeed ()
DECLARE FUNCTION GoTop! ()
DECLARE SUB HighScore ()
DECLARE SUB PreviewShape ()
DECLARE FUNCTION QuitGame! ()
DECLARE SUB RemoveRows ()
DECLARE SUB ResetGrid ()
DECLARE FUNCTION RowFilled! (row)
DECLARE SUB SetMaxDelay ()
DECLARE SUB TellScore ()
DECLARE SUB UpdateGrid (thecolor)

' shape = 1  normal L
' shape = 2  backwards L
' shape = 3  square
' shape = 4  long line
' shape = 5  short T
' shape = 6  zig
' shape = 7  zag


' Diagrams of the shapes and their center squares (the O's)
' in the different orientations:
'
' Each square (represented by an X or O) is 20x20 pixels.
' shape = 1  normal L        X       X     XX     XOX
'                            O     XOX      O     X
'                            XX             X
'
' shape = 2 backwards L      X     X       XX
'                            O     XOX     O      XOX
'                           XX             X        X
'
' shape = 3 square           XX     this is the same in all
'                            XX     orientations
'
' shape = 4 long line        X              X
'                            O    XXOX      X     XOXX
'                            X              O
'                            X              X
'
' shape = 5 short t          X              X     X
'                            OX   XOX      XO    XOX
'                            X     X        X
'
' shape = 6 zig              X            X
'                            OX    OX     XO     XX
'                             X   XX       X    XO
'
' shape = 7 zag              X    XX      X
'                           XO     OX    OX     XO
'                           X            X       XX
'
' orientation     can be 0, 1, 2, or 3.

COMMON SHARED i, j, shape, nshape, orientation, true, false, score, speed
COMMON SHARED maxdelay, delaymultiple

true = 1
false = 0

TYPE Recordscore                    ' For the high scores
    score AS INTEGER
    initials AS STRING * 3
END TYPE

DIM SHARED s(10) AS Recordscore     ' For storing high scores

' "the grid" contains a map of all the colors on the 10 by 20 playing field:
DIM SHARED grid(10, 20)

' p for position array.  it holds:
'       shape, orientation+1, square#, offset  (1=column, 2=row)
DIM SHARED p(7, 4, 4, 2)
FillP   ' Fill the position array with data

SCREEN 12

RANDOMIZE TIMER

delaymultiple = 40
SetMaxDelay
GetSpeed
startspeed = speed

quit = false        'loop control variable
DO
    score = 0
    orientation = 0 'which direction the shape is pointing
    i = 5           'horizontal grid position   -- column position
    j = 2           'vertical   grid position   -- row position
    speed = startspeed
    DrawPlayingField
    nshape = INT(RND * 7) + 1
    shape = INT(RND * 7) + 1
    PreviewShape
    IF shape = 3 THEN j = 1     ' shape 3 is the box shape
    delayused = speed           ' allow extra time for right & left moves

    DO
        DrawShape shape
        UpdateGrid shape

        FOR delay = speed TO maxdelay
            k$ = UCASE$(INKEY$)
            IF k$ <> "" THEN EXIT FOR
            delayused = delayused + 1
        NEXT
     
        IF k$ = "Q" THEN
            IF QuitGame THEN
                quit = true
            ELSE
                ResetGrid
            END IF
            EXIT DO
        END IF

        IF k$ = "P" THEN SLEEP

        DrawShape 0          ' Erase the shape
        UpdateGrid 0         ' Erase the shape's color info from the grid

        ' Handle left, right, rotate and drop
        l$ = LEFT$(k$, 1)    ' For arrow keys, check for "scan codes"
        r$ = RIGHT$(k$, 1)
        IF k$ = "4" OR k$ = "J" OR (l$ = CHR$(0) AND r$ = CHR$(75)) THEN
            'Move Left
            IF CheckLeft THEN
                i = i - 1
            END IF
        ELSEIF k$ = "5" OR k$ = "K" OR (l$ = CHR$(0) AND r$ = CHR$(72)) THEN
            'Rotate clockwise
            IF CheckRotate THEN orientation = (orientation + 1) MOD 4
        ELSEIF k$ = "6" OR k$ = "L" OR (l$ = CHR$(0) AND r$ = CHR$(77)) THEN
            'Move Right
            IF CheckRight THEN
                i = i + 1
            END IF
        ELSEIF k$ = "2" OR k$ = " " OR (l$ = CHR$(0) AND r$ = CHR$(80)) THEN
            DropShape
        END IF

        IF GoTop THEN
            ' The current piece has hit bottom
            DrawShape shape
            UpdateGrid shape
            IF CheckGameOver THEN
                IF QuitGame THEN
                    quit = true
                ELSE
                    ResetGrid
                END IF
                EXIT DO
            END IF
            CheckForFilledRows
            orientation = 0
            TellScore
            shape = nshape
            nshape = INT(RND * 7) + 1
            PreviewShape
            i = 5
            j = 2
            IF shape = 3 THEN j = 1     ' The box shape
            delayused = speed
        ELSE
            ' move the piece to the next row (maybe)
            IF delayused >= maxdelay THEN
                delayused = speed
                j = j + 1
            END IF
        END IF
    LOOP
LOOP UNTIL quit = true

' A row has been erased, bring anything above it down
'
' First erase everything above and including the filled line
' Then re-paint all of those squares with the information that
'   is stored in the grid array, but with one row removed
' Then update the grid array so that all of the colors in it are brought
'   down also.
'
SUB BringItDown (row)

' for reference, this is the rectangle in DrawPlayingField:
' LINE (219, 39)-(420, 440), 13, B

LINE (220, 40)-(419, 39 + 20 * row), 0, BF

FOR r = row TO 2 STEP -1
    FOR c = 1 TO 10
        ' paint what was in row r-1 into row r:
        x = 200 + 20 * c
        Y = 20 + 20 * r
         LINE (x, Y)-(x + 19, Y + 19), grid(c, r - 1), BF
        IF grid(c, r - 1) > 0 THEN LINE (x + 1, Y + 1)-(x + 18, Y + 18), 15, B
        ' put whatever color is in row r-1 of the grid into row r
        grid(c, r) = grid(c, r - 1)
    NEXT
NEXT

END SUB

' See if dropping the current shape has filled up a row
'
SUB CheckForFilledRows

FOR row = 1 TO 20
    IF RowFilled(row) THEN
        BringItDown (row)
        score = score + 10
        TellScore
    END IF
NEXT

END SUB

' If there is anything in the middle column, top row then it's game over.
'
FUNCTION CheckGameOver

IF grid(5, 1) <> 0 THEN
    FOR r = 1 TO 400 STEP 4
        CIRCLE (320, 240), r, 4
    NEXT
    LOCATE 2, 33
    COLOR 14
    PRINT " --GAME OVER-- "
    PLAY "E"
    CheckGameOver = true
ELSE
    CheckGameOver = false
END IF

END FUNCTION

' Is it legal to move the piece to the left?
'
FUNCTION CheckLeft

' Loop four times for each square of the piece
' Do a "move" of the piece to the left to where its new position would be.
' For each square in its "new" position
' if any of the column positions are less than one, checkleft = false
' otherwise,
'       check every square of the new position for color,
'           if any of them has color and is a square on the left,
'               checkleft stays false.

CheckLeft = false
FOR newsquare = 1 TO 4
    newcol = i + p(shape, orientation + 1, newsquare, 1) - 1
    IF newcol < 1 THEN EXIT FUNCTION        ' return a false
    newrow = j + p(shape, orientation + 1, newsquare, 2)
    IF grid(newcol, newrow) <> 0 THEN
        onleft = true
        FOR oldsquare = 1 TO 4
            oldcol = i + p(shape, orientation + 1, oldsquare, 1)
            oldrow = j + p(shape, orientation + 1, oldsquare, 2)
            onleft = onleft AND (newcol <> oldcol OR newrow <> oldrow)
        NEXT
        IF onleft THEN EXIT FUNCTION        ' return a false
    END IF
NEXT
CheckLeft = true

END FUNCTION

' Is it legal to move the piece to the right?
'
FUNCTION CheckRight


' Loop four times for each square of the piece
' Do a "move" of the piece to the right to where its new position would be.
' For each square in its "new" position
' if any of the column positions are more than ten, checkright = false
' otherwise,
'       check every square of the new position for color,
'           if any of them has color and is a square on the right,
'               checkright stays false.

CheckRight = false
FOR newsquare = 1 TO 4
    newcol = i + p(shape, orientation + 1, newsquare, 1) + 1
    IF newcol > 10 THEN EXIT FUNCTION        ' return a false
    newrow = j + p(shape, orientation + 1, newsquare, 2)
    IF grid(newcol, newrow) <> 0 THEN
        onright = true
        FOR oldsquare = 1 TO 4
            oldcol = i + p(shape, orientation + 1, oldsquare, 1)
            oldrow = j + p(shape, orientation + 1, oldsquare, 2)
            onright = onright AND (newcol <> oldcol OR newrow <> oldrow)
        NEXT
        IF onright THEN EXIT FUNCTION        ' return a false
    END IF
NEXT
CheckRight = true

END FUNCTION

'Return True if player can rotate, false otherwise
'
FUNCTION CheckRotate

' Loop four times for each square of the piece
' Do a "move" of the piece to the left to where its new position would be.
' For each square in its "new" position
' if any column or row position is out of bounds, checkrotate = false
' otherwise,
'       check every square of the new position for color,
'           if any of them has color and is not on an old square,
'               checkrotate stays false.

CheckRotate = false
FOR newsquare = 1 TO 4
    neworientation = (orientation + 1) MOD 4
    newcol = i + p(shape, neworientation + 1, newsquare, 1)
    newrow = j + p(shape, neworientation + 1, newsquare, 2)
    IF newcol < 1 OR newcol > 10 THEN EXIT FUNCTION       ' return a false
    IF newrow < 1 OR newrow > 20 THEN EXIT FUNCTION       ' return a false
    IF grid(newcol, newrow) <> 0 THEN
        notonold = true
        FOR oldsquare = 1 TO 4
            oldcol = i + p(shape, orientation + 1, oldsquare, 1)
            oldrow = j + p(shape, orientation + 1, oldsquare, 2)
            notonold = notonold AND (newcol <> oldcol OR newrow <> oldrow)
        NEXT
        IF notonold THEN EXIT FUNCTION        ' return a false
    END IF
NEXT
CheckRotate = true

END FUNCTION

' The grid is 20 by 10 squares, so 400 by 200 pixels.
' Draw the main playing rectangle, background graphics, and instructions.
'
SUB DrawPlayingField

CLS

x1 = 640
X12 = 0
Y1 = 480
Y12 = 0
DO
    RANDOMIZE TIMER
    SCREEN 12
    FOR c = 1 TO 15
        x = INT(RND * 640)
        Y = INT(RND * 480)
        LINE (x, Y)-(x + 2, Y + 2), c, BF
    NEXT
    clr1 = 3 * INT(RND * 5) + 1
    clr2 = 3 * INT(RND * 5) + 1
    IF clr1 < 9 THEN clr1 = 14
    IF clr2 < 9 THEN clr2 = 4
    FOR c = 1 TO 15
        COLOR clr1
        X12 = X12 + 1
        x1 = x1 - 1
        CIRCLE (320, 240), Y1
        COLOR clr2
        CIRCLE (320, 240), Y12
        j = (j + 1) MOD 6
        COLOR clr2
        CIRCLE (320, 240), c
        COLOR clr2
        CIRCLE (x1, Y1), Y12
        CIRCLE (X12, Y12), Y12
        LINE (640, Y1)-(0, Y12), 0
        LINE (x1, Y1)-(X12, Y12), 4
        LINE (640, Y1)-(0, Y12), 4, B
        LINE (x1, Y1)-(X12, Y12), 0, B
        Y12 = Y12 + 1
        Y1 = Y1 - 1
        COLOR 15
    NEXT c
LOOP UNTIL Y1 < 300 OR INKEY$ <> ""

LOCATE 4, 54
PRINT " Press Q to Quit "
LOCATE 5, 54
PRINT " Use Left & Right Arrows "
LOCATE 6, 54
PRINT " Up Arrow to Rotate "
LOCATE 7, 54
PRINT " Or, Use 4,5 & 6 Keys "
LOCATE 8, 54
PRINT " (Num Lock must be on) "
LOCATE 9, 54
PRINT " Or, Use J,K & L Keys "
LOCATE 10, 54
PRINT " Down Arrow to Drop "
LOCATE 11, 54
PRINT " Or Spacebar "
LOCATE 12, 54
PRINT " P to Pause "

LINE (217, 37)-(422, 442), 0, BF
LINE (219, 39)-(420, 440), 0, BF
LINE (217, 37)-(422, 442), 15, B
LINE (219, 39)-(420, 440), 15, B

END SUB

' Draw the appropriate shape in its appropriate orientation
' in the appropriate location.
'
SUB DrawShape (thecolor)

' Draw the four squares of the shape based on info in the 'p' array
FOR square = 1 TO 4
    col = i + p(shape, orientation + 1, square, 1)
    row = j + p(shape, orientation + 1, square, 2)
    x = 200 + 20 * col
    Y = 20 + 20 * row
    LINE (x, Y)-(x + 19, Y + 19), thecolor, BF
    IF thecolor > 0 THEN LINE (x + 1, Y + 1)-(x + 18, Y + 18), 15, B
NEXT

END SUB

' This sub will drop a shape from its current position all the way down
'
SUB DropShape

DO WHILE GoTop = false
    DrawShape shape
    UpdateGrid shape
    DrawShape 0
    UpdateGrid 0
    j = j + 1
LOOP

END SUB

' Fill all the information that specifies the 7 different shapes
' in their four orientations, with four squares each
'
' The 1st component of p specifies the shape
' The 2nd component of p specifies the orientation
' The 3rd component of p specifies each square of the shape in its orientation
' The 4th component of p specifies column or row:  1 for column, 2 for row
'
SUB FillP

p(1, 1, 1, 1) = 0
p(1, 1, 1, 2) = -1
p(1, 1, 2, 1) = 0
p(1, 1, 2, 2) = 0
p(1, 1, 3, 1) = 0
p(1, 1, 3, 2) = 1
p(1, 1, 4, 1) = 1
p(1, 1, 4, 2) = 1
p(1, 2, 1, 1) = -1
p(1, 2, 1, 2) = 0
p(1, 2, 2, 1) = 0
p(1, 2, 2, 2) = 0
p(1, 2, 3, 1) = 1
p(1, 2, 3, 2) = 0
p(1, 2, 4, 1) = -1
p(1, 2, 4, 2) = 1
p(1, 3, 1, 1) = -1
p(1, 3, 1, 2) = -1
p(1, 3, 2, 1) = 0
p(1, 3, 2, 2) = -1
p(1, 3, 3, 1) = 0
p(1, 3, 3, 2) = 0
p(1, 3, 4, 1) = 0
p(1, 3, 4, 2) = 1
p(1, 4, 1, 1) = 1
p(1, 4, 1, 2) = -1
p(1, 4, 2, 1) = -1
p(1, 4, 2, 2) = 0
p(1, 4, 3, 1) = 0
p(1, 4, 3, 2) = 0
p(1, 4, 4, 1) = 1
p(1, 4, 4, 2) = 0
p(2, 1, 1, 1) = 0
p(2, 1, 1, 2) = -1
p(2, 1, 2, 1) = 0
p(2, 1, 2, 2) = 0
p(2, 1, 3, 1) = 0
p(2, 1, 3, 2) = 1
p(2, 1, 4, 1) = -1
p(2, 1, 4, 2) = 1
p(2, 2, 1, 1) = -1
p(2, 2, 1, 2) = -1
p(2, 2, 2, 1) = -1
p(2, 2, 2, 2) = 0
p(2, 2, 3, 1) = 0
p(2, 2, 3, 2) = 0
p(2, 2, 4, 1) = 1
p(2, 2, 4, 2) = 0
p(2, 3, 1, 1) = 0
p(2, 3, 1, 2) = -1
p(2, 3, 2, 1) = 1
p(2, 3, 2, 2) = -1
p(2, 3, 3, 1) = 0
p(2, 3, 3, 2) = 0
p(2, 3, 4, 1) = 0
p(2, 3, 4, 2) = 1
p(2, 4, 1, 1) = -1
p(2, 4, 1, 2) = 0
p(2, 4, 2, 1) = 0
p(2, 4, 2, 2) = 0
p(2, 4, 3, 1) = 1
p(2, 4, 3, 2) = 0
p(2, 4, 4, 1) = 1
p(2, 4, 4, 2) = 1
p(3, 1, 1, 1) = 0
p(3, 1, 1, 2) = 0
p(3, 1, 2, 1) = 1
p(3, 1, 2, 2) = 0
p(3, 1, 3, 1) = 0
p(3, 1, 3, 2) = 1
p(3, 1, 4, 1) = 1
p(3, 1, 4, 2) = 1
p(3, 2, 1, 1) = 0
p(3, 2, 1, 2) = 0
p(3, 2, 2, 1) = 1
p(3, 2, 2, 2) = 0
p(3, 2, 3, 1) = 0
p(3, 2, 3, 2) = 1
p(3, 2, 4, 1) = 1
p(3, 2, 4, 2) = 1
p(3, 3, 1, 1) = 0
p(3, 3, 1, 2) = 0
p(3, 3, 2, 1) = 1
p(3, 3, 2, 2) = 0
p(3, 3, 3, 1) = 0
p(3, 3, 3, 2) = 1
p(3, 3, 4, 1) = 1
p(3, 3, 4, 2) = 1
p(3, 4, 1, 1) = 0
p(3, 4, 1, 2) = 0
p(3, 4, 2, 1) = 1
p(3, 4, 2, 2) = 0
p(3, 4, 3, 1) = 0
p(3, 4, 3, 2) = 1
p(3, 4, 4, 1) = 1
p(3, 4, 4, 2) = 1
p(4, 1, 1, 1) = 0
p(4, 1, 1, 2) = -1
p(4, 1, 2, 1) = 0
p(4, 1, 2, 2) = 0
p(4, 1, 3, 1) = 0
p(4, 1, 3, 2) = 1
p(4, 1, 4, 1) = 0
p(4, 1, 4, 2) = 2
p(4, 2, 1, 1) = -2
p(4, 2, 1, 2) = 0
p(4, 2, 2, 1) = -1
p(4, 2, 2, 2) = 0
p(4, 2, 3, 1) = 0
p(4, 2, 3, 2) = 0
p(4, 2, 4, 1) = 1
p(4, 2, 4, 2) = 0
p(4, 3, 1, 1) = 0
p(4, 3, 1, 2) = -2
p(4, 3, 2, 1) = 0
p(4, 3, 2, 2) = -1
p(4, 3, 3, 1) = 0
p(4, 3, 3, 2) = 0
p(4, 3, 4, 1) = 0
p(4, 3, 4, 2) = 1
p(4, 4, 1, 1) = -1
p(4, 4, 1, 2) = 0
p(4, 4, 2, 1) = 0
p(4, 4, 2, 2) = 0
p(4, 4, 3, 1) = 1
p(4, 4, 3, 2) = 0
p(4, 4, 4, 1) = 2
p(4, 4, 4, 2) = 0
p(5, 1, 1, 1) = 0
p(5, 1, 1, 2) = -1
p(5, 1, 2, 1) = 0
p(5, 1, 2, 2) = 0
p(5, 1, 3, 1) = 1
p(5, 1, 3, 2) = 0
p(5, 1, 4, 1) = 0
p(5, 1, 4, 2) = 1
p(5, 2, 1, 1) = -1
p(5, 2, 1, 2) = 0
p(5, 2, 2, 1) = 0
p(5, 2, 2, 2) = 0
p(5, 2, 3, 1) = 1
p(5, 2, 3, 2) = 0
p(5, 2, 4, 1) = 0
p(5, 2, 4, 2) = 1
p(5, 3, 1, 1) = 0
p(5, 3, 1, 2) = -1
p(5, 3, 2, 1) = -1
p(5, 3, 2, 2) = 0
p(5, 3, 3, 1) = 0
p(5, 3, 3, 2) = 0
p(5, 3, 4, 1) = 0
p(5, 3, 4, 2) = 1
p(5, 4, 1, 1) = 0
p(5, 4, 1, 2) = -1
p(5, 4, 2, 1) = -1
p(5, 4, 2, 2) = 0
p(5, 4, 3, 1) = 0
p(5, 4, 3, 2) = 0
p(5, 4, 4, 1) = 1
p(5, 4, 4, 2) = 0
p(6, 1, 1, 1) = 0
p(6, 1, 1, 2) = -1
p(6, 1, 2, 1) = 0
p(6, 1, 2, 2) = 0
p(6, 1, 3, 1) = 1
p(6, 1, 3, 2) = 0
p(6, 1, 4, 1) = 1
p(6, 1, 4, 2) = 1
p(6, 2, 1, 1) = 0
p(6, 2, 1, 2) = 0
p(6, 2, 2, 1) = 1
p(6, 2, 2, 2) = 0
p(6, 2, 3, 1) = -1
p(6, 2, 3, 2) = 1
p(6, 2, 4, 1) = 0
p(6, 2, 4, 2) = 1
p(6, 3, 1, 1) = -1
p(6, 3, 1, 2) = -1
p(6, 3, 2, 1) = -1
p(6, 3, 2, 2) = 0
p(6, 3, 3, 1) = 0
p(6, 3, 3, 2) = 0
p(6, 3, 4, 1) = 0
p(6, 3, 4, 2) = 1
p(6, 4, 1, 1) = 0
p(6, 4, 1, 2) = -1
p(6, 4, 2, 1) = 1
p(6, 4, 2, 2) = -1
p(6, 4, 3, 1) = -1
p(6, 4, 3, 2) = 0
p(6, 4, 4, 1) = 0
p(6, 4, 4, 2) = 0
p(7, 1, 1, 1) = 1
p(7, 1, 1, 2) = -1
p(7, 1, 2, 1) = 0
p(7, 1, 2, 2) = 0
p(7, 1, 3, 1) = 1
p(7, 1, 3, 2) = 0
p(7, 1, 4, 1) = 0
p(7, 1, 4, 2) = 1
p(7, 2, 1, 1) = -1
p(7, 2, 1, 2) = 0
p(7, 2, 2, 1) = 0
p(7, 2, 2, 2) = 0
p(7, 2, 3, 1) = 0
p(7, 2, 3, 2) = 1
p(7, 2, 4, 1) = 1
p(7, 2, 4, 2) = 1
p(7, 3, 1, 1) = 0
p(7, 3, 1, 2) = -1
p(7, 3, 2, 1) = -1
p(7, 3, 2, 2) = 0
p(7, 3, 3, 1) = 0
p(7, 3, 3, 2) = 0
p(7, 3, 4, 1) = -1
p(7, 3, 4, 2) = 1
p(7, 4, 1, 1) = -1
p(7, 4, 1, 2) = -1
p(7, 4, 2, 1) = 0
p(7, 4, 2, 2) = -1
p(7, 4, 3, 1) = 0
p(7, 4, 3, 2) = 0
p(7, 4, 4, 1) = 1
p(7, 4, 4, 2) = 0

END SUB

SUB GetSpeed
           
CLS

a = 10000
b = 1
c = 1
e = INT(RND * 20) + 1
FOR k = 1 TO 400
    x = x + 1
    a1 = a1 - 1
    x1 = x1 + 1
    LINE (a1, x - a1)-(a - a1, b), d + c + 2
    IF c = 12 THEN c = 0
    IF d = 12 THEN d = 0
NEXT

LINE (100, 150)-(520, 230), 0, BF

LOCATE 12, 30
PRINT "--Welcome to TETRIS--"
LOCATE 14, 20
hf$ = "How fast do you want to go (0-"
PRINT hf$ + LTRIM$(RTRIM$(STR$(maxdelay))) + ")"
LOCATE 14, 55
INPUT speed

END SUB

' Is it time to go to the top and start another piece coming down?
'
FUNCTION GoTop

' Loop four times for each square of the piece
' Do a "move" of the piece down to where its new position would be.
' For each square in its "new" position
' if any of the row positions are more than 20, GoTop = true
' otherwise,
'       check every square of the new position for color,
'           if any of them has color and is a square on the bottom,
'               GoTop stays true.

GoTop = true
FOR newsquare = 1 TO 4
    newrow = j + p(shape, orientation + 1, newsquare, 2) + 1
    IF newrow > 20 THEN EXIT FUNCTION       ' return a true
    newcol = i + p(shape, orientation + 1, newsquare, 1)
    IF grid(newcol, newrow) <> 0 THEN
        onbottom = true
        FOR oldsquare = 1 TO 4
            oldcol = i + p(shape, orientation + 1, oldsquare, 1)
            oldrow = j + p(shape, orientation + 1, oldsquare, 2)
            onbottom = onbottom AND (newcol <> oldcol OR newrow <> oldrow)
        NEXT
        IF onbottom THEN EXIT FUNCTION        ' return a true
    END IF
NEXT
GoTop = false

END FUNCTION

' Show the current high scores, and if the player just scored a within
' the top ten, get initials and store that new score.
'
SUB HighScore

OPEN "tetris.txt" FOR RANDOM AS #1 LEN = LEN(s(1))

FOR k = 1 TO 10
    GET #1, k, s(k)
NEXT

IF score > s(10).score THEN
    initials$ = ""
    FOR i = 1 TO 100
        COLOR INT(RND * 15) + 1
        LOCATE 2, 1
        PRINT "Initials     "
    NEXT
    LOCATE 2, 9
    INPUT initials$
    initials$ = UCASE$(initials$)

    FOR i = 1 TO 10
        IF score > s(i).score THEN
            'move the succeeding scores and initials down
            FOR j = 10 TO i + 1 STEP -1
                s(j).score = s(j - 1).score
                s(j).initials = s(j - 1).initials
            NEXT
            s(i).score = score
            s(i).initials = initials$
            EXIT FOR
        END IF
    NEXT
    FOR k = 1 TO 10
        PUT #1, k, s(k)
    NEXT
END IF
  
LOCATE 3, 1
PRINT "             "
PRINT "Hall of Fame:"
PRINT "             "
FOR k = 1 TO 10
    PRINT s(k).initials; s(k).score; " "
NEXT

CLOSE

END SUB

' Display an image of the next shape to be dropped
'
SUB PreviewShape

LINE (472, 272)-(564, 363), 0, BF
LINE (470, 270)-(560, 365), 0, BF
LINE (472, 272)-(562, 363), 15, B
LINE (470, 270)-(564, 365), 15, B
hold = shape
shape = nshape
i = 15
IF shape = 2 THEN i = 16
j = 14
DrawShape shape
shape = hold
i = 5
j = 2

END SUB

' Do some special effects, then ask if the user wants to play again
'
FUNCTION QuitGame

HighScore

j = 0
DO WHILE j < 20
    j = j + 1
    FOR i = 1 TO 10
        IF INKEY$ = CHR$(27) THEN EXIT DO      'if user presses Esc
        IF grid(i, j) <> 0 THEN
            col = i + p(shape, orientation + 1, square, 1)
            row = j + p(shape, orientation + 1, square, 2)
            x = 200 + 20 * col
            Y = 20 + 20 * row
            FOR k = 1 TO INT(RND * 20) + 20 STEP 2
                colr1 = INT(RND * 3)
                SELECT CASE colr1
                    CASE 0
                        clr = 15
                    CASE 1
                        clr = 12
                    CASE 2
                        clr = 4
                END SELECT
                CIRCLE (x + 10, Y + 10), k, clr
            NEXT k
        END IF
     NEXT i
LOOP

LOCATE 20, 1
PRINT "Play Again?"
DO
    key$ = UCASE$(INKEY$)
    COLOR INT(RND * 15) + 1
    LOCATE 20, 11
    PRINT "?"
LOOP UNTIL key$ = "Y" OR key$ = "N"
IF key$ = "Y" THEN
    QuitGame = false
ELSE
    QuitGame = true
END IF

END FUNCTION

' If the player is going to play again, the grid needs to be reset
'
SUB ResetGrid

FOR a = 1 TO 10
    FOR b = 1 TO 20
        grid(a, b) = 0
    NEXT b
NEXT a

END SUB

'This function scans the given row, and tells if it is filled.
'
FUNCTION RowFilled (row)

RowFilled = true
FOR col = 1 TO 10
    IF grid(col, row) = 0 THEN
        RowFilled = false
        EXIT FOR
    END IF
NEXT

END FUNCTION

' Use the TIMER function to calibrate the speed of the machine
' for the delay loop in the main routine
'
SUB SetMaxDelay

startTime# = TIMER                          ' Calculate speed of system
FOR i# = 1 TO 1000: NEXT i#                 ' and do some compensation
stopTime# = TIMER + 1
maxdelay = 100 * INT(30 / (stopTime# - startTime#))

END SUB

' Display the score and level
' AND update the score and speed
'
SUB TellScore

score = score + 1
LOCATE 2, 54
PRINT " Score: "; score
IF speed < maxdelay - delaymultiple THEN speed = speed + 1
PRINT "Level:"; INT(speed / 200) + 1

END SUB

' Put color information for the current position into the grid array.
' If thecolor is zero, then this erases color from the grid array.
'
SUB UpdateGrid (thecolor)

' Put "thecolor" into the four grid positions the shape occupies
FOR square = 1 TO 4
    col = i + p(shape, orientation + 1, square, 1)
    row = j + p(shape, orientation + 1, square, 2)
    grid(col, row) = thecolor
NEXT

END SUB