QBASIC GAME : CLASSIC BLOCKS PUZZLE

DefInt A-Z
 
 
 
 Const WELLWIDTH = 10
 Const WELLHEIGHT = 21
 Const NUMSTYLES = 7
 Const WINGAME = 1000000
 Const NEXTLEVEL = 300
 Const BASESCORE = 1000
 Const ROTATEDIR = 1
 Const PLAYCLEARROW = MBT255L16O4CDEGO6C
 Const PLAYINTRO = MBT170O1L8CO2CO1CDCA-A-FGFA-F
 Const PLAYGAMEOVER = MBT255L16O6CO4GEDC
 Const PLAYNEWBLOCK = MBT160L28N20L24N5
 Const PLAYWINGAME = T255L16O6CO4GEDCCDEFGO6CEG
 Const FALSE = 0
 Const TRUE = Not FALSE
 Const SPACEBAR = 32
 Const DOWNARROW = 80
 Const RIGHTARROW = 77
 Const UPARROW = 72
 Const LEFTARROW = 75
 Const DOWNARROW2 = 50
 Const RIGHTARROW2 = 54
 Const UPARROW2 = 56
 Const LEFTARROW2 = 52
 Const UPARROW3 = 53
 Const QUIT = Q
 Const PAUSE = P
 Const XMATRIX = 3
 Const YMATRIX = 1
 Const BYTESPERBLOCK = 76
 Const BLOCKVOLUME = (XMATRIX + 1) * (YMATRIX + 1)
 Const ELEMENTSPERBLOCK = BLOCKVOLUME * BYTESPERBLOCK  2
 Const XSIZE = 13
 Const YSIZE = 8
 Const XOFFSET = 10
 Const YOFFSET = 2
 Const WELLX = XSIZE * XOFFSET
 Const WELLY = YSIZE * YOFFSET
 Const TILTVALUE = 9999000
 Const WELLCOLOR7 = 0
 Const WELLCOLOR1 = 0
 Const BORDERCOLOR1 = 8
 Const BORDERCOLOR7 = 15
 
 Type BlockType
 X As Integer
 Y As Integer
 Style As Integer
 Rotation As Integer
 End Type
 
 
 DECLARE FUNCTION CheckFit ()
 DECLARE FUNCTION GameOver ()
 DECLARE SUB AddBlockToWell ()
 DECLARE SUB CheckForFullRows ()
 DECLARE SUB Center (M$, Row)
 DECLARE SUB DeleteChunk (Highest%, Lowest%)
 DECLARE SUB DisplayIntro ()
 DECLARE SUB DisplayGameTitle ()
 DECLARE SUB DisplayChanges ()
 DECLARE SUB DrawBlock (X, Y, FillColor)
 DECLARE SUB InitScreen ()
 DECLARE SUB MakeInfoBox ()
 DECLARE SUB NewBlock ()
 DECLARE SUB PerformGame ()
 DECLARE SUB RedrawControls ()
 DECLARE SUB Show (b AS BlockType)
 DECLARE SUB UpdateScoring ()
 DECLARE SUB PutBlock (b AS BlockType)
 DECLARE SUB DrawAllShapes ()
 DECLARE SUB DrawPattern (Patttern)
 DECLARE SUB DrawPlayingField ()
 
 Dim Shared Level As Integer
 Dim Shared WellBlocks(WELLWIDTH, WELLHEIGHT) As Integer
 Dim Shared CurBlock As BlockType
 Dim Shared BlockShape(0 To XMATRIX, 0 To YMATRIX, 1 To NUMSTYLES)
 Dim Shared PrevScore As Long
 Dim Shared Score As Long
 Dim Shared ScreenWidth As Integer
 Dim Shared ScreenMode As Integer
 Dim Shared WellColor As Integer
 Dim Shared BorderColor As Integer
 Dim Shared OldBlock As BlockType
 Dim Shared TargetTime As Single
 Dim Shared GameTiltScore As Long
 Dim Shared Temp(11175) As Integer
 Dim Shared BlockColor(1 To NUMSTYLES) As Integer
 Dim Shared BlockImage((NUMSTYLES * 4 + 3) * ELEMENTSPERBLOCK) As Integer
 Dim KeyFlags As Integer
 Dim BadMode As Integer
 
 
 On Error GoTo ScreenError
 BadMode = FALSE
 ScreenMode = 7
 Screen ScreenMode
 If BadMode = TRUE Then
 ScreenMode = 1
 BadMode = FALSE
 Screen ScreenMode
 End If
 On Error GoTo 0
 
 If BadMode = TRUE Then
 Cls
 Locate 10, 12: Print CGA, EGA Color, or VGA graphics required to run QBLOCKS.BAS
 Else
 Randomize Timer
 DisplayIntro
 
 Def Seg = 0
 KeyFlags = Peek(1047)
 If (KeyFlags And 32) = 0 Then
 Poke 1047, KeyFlays Or 32
 End If
 Def Seg
 
 
 For i = 1 To NUMSTYLES
 For j = 0 To YMATRIX
 For k = 0 To XMATRIX
 Read BlockShape(k, j, i)
 Next k
 Next j
 Next i
 DrawAllShapes
 PerformGame
 DisplayChanges
 
 Def Seg = 0
 Poke 1047, KeyFlags And 233
 Def Seg
 
 If ScreenMode = 7 Then Palette
 
 End If
 
 End
 ' Data for Style 1: Long
 Data 1,1,1,1
 Data 0,0,0,0
 ' Data for Style 2: L Right
 Data 1,1,1,0
 Data 0,0,1,0
 ' Data for Style 3: L Left
 Data 0,1,1,1
 Data 0,1,0,0
 ' Data for Style 4: Z Right
 Data 1,1,0,0
 Data 0,1,1,0
 ' Data for Style 5: Z Left
 Data 0,1,1,0
 Data 1,1,0,0
 ' Data for Style 6: T
 Data 1,1,1,0
 Data 0,1,0,0
 ' Data for Style 7: Square
 Data 0,1,1,0
 Data 0,1,1,0
 
 ScreenError:
 BadMode = TRUE
 Resume Next
 Sub AddBlockToWell
 
 For i = 0 To XMATRIX
 For j = 0 To YMATRIX
 If BlockShape(i, j, CurBlock.Style) = 1 Then
 Select Case CurBlock.Rotation
 Case 0
 WellBlocks(CurBlock.X + i, CurBlock.Y + j) = CurBlock.Style
 Case 1
 WellBlocks(CurBlock.X - j + 2, CurBlock.Y + i - 1) = CurBlock.Style
 Case 2
 WellBlocks(CurBlock.X - i + 3, CurBlock.Y - j + 1) = CurBlock.Style
 Case 3
 WellBlocks(CurBlock.X + j + 1, CurBlock.Y - i + 2) = CurBlock.Style
 End Select
 End If
 Next j
 Next i
 End Sub
 
 Sub Center (text$, Row)
 Locate Row, (ScreenWidth - Len(text$))  2 + 1
 Print text$;
 
 End Sub
 
 Function CheckFit
 
 CheckFit = TRUE
 
 For i = 0 To XMATRIX
 For j = 0 To YMATRIX
 
 If BlockShape(i, j, CurBlock.Style) = 1 Then
 Select Case CurBlock.Rotation
 Case 0
 NewX = CurBlock.X + i
 NewY = CurBlock.Y + j
 Case 1
 NewX = CurBlock.X - j + 2
 NewY = CurBlock.Y + i - 1
 Case 2
 NewX = CurBlock.X - i + 3
 NewY = CurBlock.Y - j + 1
 Case 3
 NewX = CurBlock.X + j + 1
 NewY = CurBlock.Y - i + 2
 End Select
 
 If (NewX > WELLWIDTH - 1 Or NewX < 0 Or NewY > WELLHEIGHT - 1 Or NewY < 0) Then
 CheckFit = FALSE
 Exit Function
 
 ElseIf WellBlocks(NewX, NewY) Then
 CheckFit = FALSE
 Exit Function
 End If
 
 End If
 Next j
 Next i
 End Function
 
 Sub CheckForFullRows
 Dim RowsToDelete(WELLHEIGHT)
 NumRowsToDelete = 0
 i = WELLHEIGHT
 Do
 DeleteRow = TRUE
 j = 0
 Do
 DeleteRow = DeleteRow * Sgn(WellBlocks(j, i))
 j = j + 1
 Loop While DeleteRow = TRUE And j < WELLWIDTH
 
 If DeleteRow = TRUE Then
 
 NumRowsToDelete = NumRowsToDelete + 1
 RowsToDelete(i - NumDeleted) = TRUE
 NumDeleted = NumDeleted + 1
 For Row = i To 1 Step -1
 For Col = 0 To WELLWIDTH
 WellBlocks(Col, Row) = WellBlocks(Col, Row - 1)
 Next Col
 Next Row
 Else
 i = i - 1
 End If
 Loop While i >= 1
 
 If NumRowsToDelete > 0 Then
 Score = Score + 100 * NumRowsToDelete
 
 
 Highest = -1
 Lowest = 100
 
 
 For i = WELLHEIGHT To 1 Step -1
 If RowsToDelete(i) = TRUE Then
 If i > Highest Then Highest = i
 If i < Lowest Then Lowest = i
 End If
 Next i
 
 If (Highest - Lowest) + 1 = NumRowsToDelete Then
 DeleteChunk Highest, Lowest
 Else
 i = Lowest
 Do While i <= Highest
 If RowsToDelete(i) = FALSE Then
 DeleteChunk i - 1, Lowest
 Exit Do
 Else
 i = i + 1
 End If
 Loop
 Lowest = i
 Do While RowsToDelete(Lowest) = FALSE
 Lowest = Lowest + 1
 Loop
 DeleteChunk Highest, Lowest
 
 End If
 End If
 
 End Sub
 Sub DeleteChunk (Highest, Lowest)
 Get (WELLX, Lowest * YSIZE + WELLY)-(WELLX + WELLWIDTH * XSIZE, (Highest + 1) * YSIZE + WELLY - 1), Temp()
 Play PLAYCLEARROW
 
 For Flash = 1 To 3
 Put (WELLX, Lowest * YSIZE + WELLY), Temp(), PReset
 DelayTime! = Timer + .02
 Do While Timer < DelayTime!: Loop
 Put (WELLX, Lowest * YSIZE + WELLY), Temp(), PSet
 DelayTime! = Timer + .02
 Do While Timer < DelayTime!: Loop
 Next Flash
 Get (WELLX, WELLY)-(WELLX + WELLWIDTH * XSIZE, Lowest * YSIZE + WELLY), Temp()
 Put (WELLX, (Highest - Lowest + 1) * YSIZE + WELLY), Temp(), PSet
 Line (WELLX, WELLY)-(WELLX + WELLWIDTH * XSIZE, WELLY + (Highest - Lowest + 1) * YSIZE), WellColor, BF
 End Sub
 
 Sub DisplayChanges
 
 DisplayGameTitle
 
 Color 7
 Center The following game characteristics can be easily changed from, 5
 Center within the QuickBASIC Interpreter.  To change the values of  , 6
 Center these characteristics, locate the corresponding CONST or DATA, 7
 Center statements in the source code and change their values, then  , 8
 Center restart the program (press Shift + F5).                      , 9
 
 Color 15
 Center Block shapes                         , 11
 Center Block rotation                       , 12
 Center Number of different block shapes     , 13
 Center Score needed to advance to next level, 14
 Center Width of the game well               , 15
 Center Height of the game well              , 16
 Center Songs played during game             , 17
 
 Color 7
 Center The CONST statements and instructions on changing them are   , 19
 Center located at the beginning of the main program.                , 20
 Do While InKey$ = : Loop
 Cls
 
 End Sub
 Sub DisplayGameTitle
 Screen 0
 Width 80, 25
 Color 4, 0
 Cls
 ScreenWidth = 80
 Locate 1, 2
 Print Chr$(201); String$(76, 205); Chr$(187);
 For i% = 2 To 24
 Locate i%, 2
 Print Chr$(186); Tab(79); Chr$(186);
 Next i%
 Locate 25, 2
 Print Chr$(200); String$(76, 205); Chr$(188);
 Color 0, 4
 Center       Microsoft      , 1
 Center     Q B L O C K S    , 2
 Center    Press any key to continue   , 25
 Color 7, 0
 
 End Sub
 Sub DisplayIntro
 
 Cls
 DisplayGameTitle
 
 Center QBlocks challenges you to keep the well from filling.  Do this by, 5
 Center completely filling rows with blocks, making the rows disappear.  , 6
 Center Move and rotate the falling shapes to get them into the best     , 7
 Center position.  The game will get faster as you score more points.    , 8
 
 Color 4
 Center String$(74, 196), 11
 Color 7
 Center  Game Controls , 11
 Center      General                             Block Control      , 13
 Center                                      (Rotate), 15
 Center    P - Pause                                  + Chr$(24) +  (or 5)   , 16
 Center       Q - Quit                         (Left)  + Chr$(27) +     + Chr$(26) +  (Right)   , 17
 Center                                      + Chr$(25), 18
 Center                                           (Drop)      , 19
 
 Do
 kbd$ = UCase$(InKey$)
 Loop While kbd$ = 
 If kbd$ = Q Then
 Cls
 Locate 10, 30: Print Really quit? (Y/N);
 Do
 kbd$ = UCase$(InKey$)
 Loop While kbd$ = 
 If kbd$ = Y Then
 Cls
 End
 End If
 End If
 
 End Sub
 
 Sub DrawAllShapes
 
 Dim b As BlockType
 Screen ScreenMode
 
 
 If ScreenMode = 7 Then
 Dim Colors(0 To 15)
 Palette Using Colors()
 For i = 1 To NUMSTYLES
 BlockColor(i) = ((i - 1) Mod 7) + 1
 Next i
 Else
 For i = 1 To NUMSTYLES
 BlockColor(i) = ((i - 1) Mod 3) + 1
 Next i
 End If
 
 Cls
 Count = 0
 For shape = 1 To NUMSTYLES
 
 RtSide = 4
 Do
 If BlockShape(RtSide - 1, 0, shape) = 1 Or BlockShape(RtSide - 1, 1, shape) = 1 Then Exit Do
 RtSide = RtSide - 1
 Loop Until RtSide = 1
 
 LtSide = 0
 Do
 If BlockShape(LtSide, 0, shape) = 1 Or BlockShape(LtSide, 1, shape) = 1 Then Exit Do
 LtSide = LtSide + 1
 Loop Until LtSide = 3
 
 For Rotation = 0 To 3
 b.X = Rotation * 4 + 2
 b.Y = Count + 2
 b.Rotation = Rotation
 b.Style = shape
 Show b
 
 X = b.X: Y = b.Y
 Select Case Rotation
 Case 0
 x1 = X: x2 = X + RtSide: y1 = Y: y2 = Y + 2
 Case 1
 x1 = X + 1: x2 = X + 3: y1 = Y - 1: y2 = Y + RtSide - 1
 Case 2
 x1 = X: x2 = X + 4 - LtSide: y1 = Y: y2 = Y + 2
 Case 3
 x1 = X + 1: x2 = X + 3: y1 = Y - 1: y2 = Y + 3 - LtSide
 End Select
 Get (x1 * XSIZE, y1 * YSIZE)-(x2 * XSIZE, y2 * YSIZE), BlockImage(((shape - 1) * 4 + Rotation) * ELEMENTSPERBLOCK)
 
 Next Rotation
 
 Count = Count + 5
 If Count = 20 Then
 Cls
 Count = 0
 End If
 Next shape
 Cls
 If ScreenMode = 7 Then
 Palette
 Palette 6, 14
 Palette 14, 15
 End If
 
 End Sub
 Sub DrawBlock (X, Y, FillColor)
 
 Line (X * XSIZE + 2, Y * YSIZE + 2)-((X + 1) * XSIZE - 2, (Y + 1) * YSIZE - 2), FillColor, BF
 Line (X * XSIZE + 1, Y * YSIZE + 1)-((X + 1) * XSIZE - 1, Y * YSIZE + 1), FillColor + 8
 Line (X * XSIZE + 1, Y * YSIZE + 1)-(X * XSIZE + 1, (Y + 1) * YSIZE - 1), FillColor + 8
 
 End Sub
 Sub DrawPattern (Pattern)
 
 Cls
 X = 1: Y = 1
 Dim Temp2(215) As Integer
 Select Case Pattern
 Case 0
 j = Y + 21
 For i = X To X + 27 Step 3
 j = j - 2
 Line (i, j)-(i, Y + 19), 12, BF
 Next i
 Line (X, Y)-(X + 30, Y + 19), 4, B
 Line (X + 1, Y + 1)-(X + 31, Y + 18), 4, B
 Case 1
 Line (X, Y)-(X + 8, Y + 12), 1, BF
 Line (X + 9, Y + 8)-(X + 24, Y + 20), 2, BF
 Line (X + 25, Y)-(X + 32, Y + 12), 3, BF
 Case 2
 Line (X, Y)-(X + 29, Y + 18), X / 32 + 1, B
 Line (X + 1, Y + 1)-(X + 28, Y + 17), X / 32 + 2, B
 Case 3
 For i = 0 To 9 Step 2
 Line (X + i, Y + i)-(X + 29 - i, Y + 18 - i), i, B
 Next i
 Case 4
 j = 0
 For i = 1 To 30 Step 3
 Line (X + i, Y + j)-(X + 30 - i, Y + j), i
 Line (X + i, Y + 19 - j)-(X + 30 - i, Y + 19 - j), i
 j = j + 2
 Next i
 Case 5
 Line (X, Y)-(X + 29, Y + 4), 1, BF
 Line (X, Y)-(X + 4, Y + 18), 1, BF
 Line (X + 7, Y + 7)-(X + 29, Y + 11), 5, BF
 Line (X + 7, Y + 7)-(X + 11, Y + 18), 5, BF
 Line (X + 14, Y + 14)-(X + 29, Y + 18), 4, BF
 Case 6
 Line (X + 15, Y)-(X + 17, Y + 19), 1
 Line (X, Y + 9)-(X + 31, Y + 11), 2
 Line (X, Y + 1)-(X + 31, Y + 18), 9
 Line (X + 30, Y)-(X + 1, Y + 19), 10
 Case 7
 For i = 1 To 6
 Circle (X + 16, Y + 10), i, i
 Next i
 Case 8
 For i = X To X + 30 Step 10
 Circle (i, Y + 9), 10, Y / 20 + 1
 Next i
 Case 9
 Line (X + 1, Y)-(X + 1, Y + 18), 3
 Line (X + 1, Y)-(X + 12, Y + 18), 3
 Line (X + 1, Y + 18)-(X + 12, Y + 18), 3
 Line (X + 30, Y)-(X + 30, Y + 18), 3
 Line (X + 30, Y)-(X + 19, Y + 18), 3
 Line (X + 30, Y + 18)-(X + 19, Y + 18), 3
 Line (X + 4, Y)-(X + 26, Y), 1
 Line (X + 4, Y)-(X + 15, Y + 18), 1
 Line (X + 26, Y)-(X + 15, Y + 18), 1
 End Select
 
 Get (0, 0)-(31, 19), Temp2()
 For H = 0 To 319 Step 32
 For V = 0 To 199 Step 20
 Put (H, V), Temp2(), PSet
 Next V
 Next H
 
 End Sub
 Sub DrawPlayingField
 
 Select Case ScreenMode
 Case 7
 WellColor = WELLCOLOR7
 BorderColor = BORDERCOLOR7
 
 Case Else
 WellColor = WELLCOLOR1
 BorderColor = BORDERCOLOR1
 End Select
 
 ScreenWidth = 40
 DrawPattern Level
 Line (WELLX - 1, WELLY - 5)-(WELLX + WELLWIDTH * XSIZE + 1, WELLY + WELLHEIGHT * YSIZE + 1), WellColor, BF
 Line (WELLX - 1, WELLY - 5)-(WELLX + WELLWIDTH * XSIZE + 1, WELLY + WELLHEIGHT * YSIZE + 1), BorderColor, B
 Line (XSIZE, WELLY - 5)-(XSIZE * 8, WELLY + 12), WellColor, BF
 Line (XSIZE, WELLY - 5)-(XSIZE * 8, WELLY + 12), BorderColor, B
 Line (XSIZE, WELLY + 20)-(WELLX - 2 * XSIZE, 78), WellColor, BF
 Line (XSIZE, WELLY + 20)-(WELLX - 2 * XSIZE, 78), BorderColor, B
 MakeInfoBox
 Color 12
 Locate 3, 5: Print QBLOCKS
 Color BorderColor
 Locate 6, 4: Print Score:;
 Locate 7, 4: Print Using #,###,###; Score
 Locate 9, 4: Print Using Level: ##; Level
 
 End Sub
 
 Function GameOver
 Play PLAYGAMEOVER
 MakeInfoBox
 Do While InKey$ <> : Loop
 Locate 14, 4: Print Game Over
 Locate 17, 6: Print Play
 Locate 18, 5: Print again?
 Locate 20, 6: Print (Y/N)
 Do
 a$ = UCase$(InKey$)
 Loop Until a$ = Y Or a$ = N
 
 If a$ = Y Then
 GameOver = FALSE
 Else
 GameOver = TRUE
 End If
 
 End Function
 Sub InitScreen
 
 DrawPlayingField
 Color 12
 Locate 14, 5: Print Select;
 Locate 16, 5: Print start;
 Locate 18, 5: Print level?;
 Locate 20, 5: Print (0 - 9);
 Color BorderColor
 Level = TRUE
 Do
 a$ = UCase$(InKey$)
 Loop While (a$ > 9 Or a$ < 0) And a$ <> Q
 
 If a$ = Q Then
 Exit Sub
 Else
 Level = Val(a$)
 End If
 
 If Level > 0 Then DrawPlayingField
 RedrawControls
 
 End Sub
 Sub MakeInfoBox
 
 Line (WELLX - 9 * XSIZE, 90)-(WELLX - 2 * XSIZE, 185), WellColor, BF
 Line (WELLX - 9 * XSIZE, 90)-(WELLX - 2 * XSIZE, 185), BorderColor, B
 
 End Sub
 Sub NewBlock
 
 CurBlock.Style = Int(Rnd(1) * NUMSTYLES) + 1
 CurBlock.X = (WELLWIDTH  2) - 1
 CurBlock.Y = 0
 CurBlock.Rotation = 0
 
 Play PLAYNEWBLOCK
 
 End Sub
 Sub PerformGame
 Do
 a$ = 
 Erase WellBlocks
 Score = 0
 Level = 0
 PrevScore = BASESCORE - NEXTLEVEL
 GameTiltScore = WINGAME
 
 InitScreen
 If Level = -1 Then Exit Sub
 
 TargetTime = Timer + 1 / (Level + 1)
 Do
 DoneWithThisBlock = FALSE
 NewBlock
 If CheckFit = FALSE Then Exit Do
 PutBlock CurBlock
 
 Do
 OldBlock = CurBlock
 Do
 ValidEvent = TRUE
 ans$ = UCase$(InKey$)
 
 If ans$ = PAUSE Or ans$ = QUIT Then
 MakeInfoBox
 Select Case ans$
 Case PAUSE
 Sound 1100, .75
 Locate 16, 6: Print GAME;
 Locate 18, 5: Print PAUSED;
 Do While InKey$ = : Loop
 Case QUIT
 Sound 1600, 1
 Sound 1000, .75
 Locate 15, 5: Print Really;
 Locate 17, 6: Print quit?;
 Locate 19, 6: Print (Y/N);
 Do
 a$ = UCase$(InKey$)
 Loop Until a$ <> 
 If a$ = Y Then Exit Sub
 End Select
 RedrawControls
 
 Else
 ans = Asc(Right$(Chr$(0) + ans$, 1))
 Select Case ans
 Case DOWNARROW, DOWNARROW2, SPACEBAR
 Do '
 CurBlock.Y = CurBlock.Y + 1
 Loop While CheckFit = TRUE
 CurBlock.Y = CurBlock.Y - 1
 TargetTime = Timer - 1
 Case RIGHTARROW, RIGHTARROW2
 CurBlock.X = CurBlock.X + 1
 Case LEFTARROW, LEFTARROW2
 CurBlock.X = CurBlock.X - 1
 Case UPARROW, UPARROW2, UPARROW3
 CurBlock.Rotation = ((CurBlock.Rotation + ROTATEDIR) Mod 4)
 Case Else
 ValidEvent = FALSE
 End Select
 
 If ValidEvent = TRUE Then
 If CheckFit = TRUE Then
 PutBlock OldBlock
 PutBlock CurBlock
 OldBlock = CurBlock
 Else
 CurBlock = OldBlock
 End If
 End If
 End If
 
 Loop Until Timer >= TargetTime
 
 TargetTime = Timer + 1 / (Level + 1)
 CurBlock.Y = CurBlock.Y + 1
 
 If CheckFit = FALSE Then
 DoneWithThisBlock = TRUE
 CurBlock = OldBlock
 End If
 
 PutBlock OldBlock
 PutBlock CurBlock
 OldBlock = CurBlock
 
 Loop Until DoneWithThisBlock
 
 AddBlockToWell
 CheckForFullRows
 UpdateScoring
 
 If Score >= GameTiltScore Then
 
 Play PLAYWINGAME
 MakeInfoBox
 Locate 13, 5: Print Using #######; Score
 Play PLAYWINGAME
 
 If GameTiltScore = TILTVALUE Then
 Locate 15, 4: Print GAME TILT
 Locate 17, 5: Print You are
 Locate 18, 4: Print Awesome!
 Locate 20, 4: Print Press any
 Locate 21, 6: Print key...
 Play PLAYWINGAME
 Do While InKey$ = : Loop
 Exit Sub
 Else
 Locate 15, 4: Print YOU WON!
 Locate 17, 5: Print Want to
 Locate 18, 4: Print continue
 Locate 20, 6: Print (Y/N)
 
 Do
 a$ = UCase$(InKey$)
 Loop Until a$ <> 
 
 If a$ <> Y Then Exit Do
 
 GameTiltScore = TILTVALUE
 
 RedrawControls
 End If
 End If
 
 Loop
 Loop Until GameOver
 
 End Sub
 
 Sub PutBlock (b As BlockType)
 
 Select Case b.Rotation
 Case 0
 x1 = b.X: y1 = b.Y
 Case 1
 x1 = b.X + 1: y1 = b.Y - 1
 Case 2
 x1 = b.X: y1 = b.Y
 Case 3
 x1 = b.X + 1: y1 = b.Y - 1
 End Select
 
 Put (x1 * XSIZE + WELLX, y1 * YSIZE + WELLY), BlockImage(((b.Style - 1) * 4 + b.Rotation) * ELEMENTSPERBLOCK), Xor
 
 End Sub
 Sub RedrawControls
 MakeInfoBox
 
 
 Color BorderColor
 Locate 13, 4: Print Controls
 Locate 14, 4: Print --------
 Locate 15, 4: Print Chr$(24) +  = Turn
 Locate 16, 4: Print Chr$(27) +  = Left
 Locate 17, 4: Print Chr$(26) +  = Right
 Locate 18, 4: Print Chr$(25) +  = Drop
 Locate 20, 4: Print P = Pause
 Locate 21, 4: Print Q = Quit
 
 End Sub
 Sub Show (b As BlockType)
 For i = 0 To XMATRIX
 For j = 0 To YMATRIX
 
 If BlockShape(i, j, b.Style) = 1 Then
 Select Case b.Rotation
 Case 0
 DrawBlock b.X + i, b.Y + j, BlockColor(b.Style)
 Case 1
 DrawBlock b.X - j + 2, b.Y - 1 + i, BlockColor(b.Style)
 Case 2
 DrawBlock b.X + 3 - i, b.Y - j + 1, BlockColor(b.Style)
 Case 3
 DrawBlock b.X + j + 1, b.Y - i + 2, BlockColor(b.Style)
 End Select
 End If
 Next j
 Next i
 
 End Sub
 
 Sub UpdateScoring
 
 If Level < 9 And Score >= (NEXTLEVEL * (Level + 1) + PrevScore) Then
 
 Get (WELLX, WELLY)-(WELLX + WELLWIDTH * XSIZE, WELLY + WELLHEIGHT * YSIZE), Temp()
 
 PrevScore = Score
 Level = Level + 1
 DrawPlayingField
 Put (WELLX, WELLY), Temp()
 
 RedrawControls
 End If
 
 Locate 7, 4: Print Using #,###,###; Score
 
 End Sub