TetrisJLT

Janet's 'Tetris Wannabe' Code
code format="vbnet" ' JB Tetris - Janet Terra ' Submission for JB Forum Tetris Challenge ' http://justbasic.conforums.com/index.cgi?board=challenge&action=display&num=1262806621

' Tetrim Shapes / Sprites

'  tetrim11 - 14 Shape 1 (cyan) '  tetrim21 - 24 Shape 2 (blue) '  tetrim31 - 34 Shape 3 (red) '  tetrim41 - 44 Shape 4 (yellow) '  tetrim51 - 54 Shape 5 (green) '  tetrim61 - 64 Shape 6 (purple) '  tetrim71 - 74 Shape 7 (orange)

' Keypresses '  Left Arrow - move left '  Right Arrow - move right '  Up Arrow - rotate clockwise '  Down Arrow - hard drop

' Tetris Grid 10 columns x 20 rows Dim TetrisGrid(14, 25)

' Tetrims Data Dim Tetrims$(7, 4) Dim Tetrims(4, 4) Dim Grids(4, 4)

' Preferences tetrisPlay = 2 ' 0 = Practice, 1 = Novice, 2 = Normal, 3 = Expert timeDelay = 50 ' 50 = Practice, 50 = Novice, 50 = Normal, 25 = Expert yInc = 2 ' 2 = Practice, 2 = Novice, 4 = Normal, 4 = Expert showGridlines = 1 ' 0 = Hide, 1 = Show

Nomainwin

' Tetris Game WindowWidth = 509 WindowHeight = 600 UpperLeftX = Int((DisplayWidth - WindowWidth) / 2) UpperLeftY = Int((DisplayHeight - WindowHeight) / 2) Menu #main, "&File", "New Game", [newGame],|, "E&xit", [endApp] Menu #main, "&Preferences", "&Practice Play", [practicePlay], _ "&Novice Play", [novicePlay], "&Average Play", [averagePlay], _ "&Expert Play", [expertPlay],|, "&Show Gridlines", [showGrids], _ "&Hide Gridlines", [hideGrids] Menu #main, "&Help", "&Directions", [tetrisDirections], _ "&About JB Tetris", [tetrisAbout] Graphicbox #main.g, 0, 0, 502, 560 Open "JB Tetris" for Window as #main #main "Trapclose [endApp]" Gosub [createTetrims] hueTetris$ = Tetrims$(1, 4);"-";Tetrims$(2, 4);"-";Tetrims$(3, 4);"-"; _ Tetrims$(4, 4);"-";Tetrims$(5, 4);"-";Tetrims$(6, 4);"-";Tetrims$(7, 4)

[newGame] Timer 0 Gosub [titleScreen] Redim TetrisGrid(14, 28) For row = 1 to 25 TetrisGrid(0, row) = 8 For col = 11 to 14 TetrisGrid(col, row) = 8 Next col Next row For col = 0 to 14 For row = 1 to 4 TetrisGrid(col, row) = -1 Next row TetrisGrid(col, 28) = 8 Next col tetrisScore = 0 Wait

[endApp] Timer 0 Close #main End

[keyPress] key$ = Inkey$ Select Case Asc(Right$(key$, 1)) Case 37 moveLeft = 1 Case 38 Gosub [rotateTetrim] Case 39 moveRight = 1 Case 40 hardDrop = 1 End Select Wait

[lowerTetrim] Timer 0 yDrop = 0 xTemp = xTetrim yTemp = yTetrim If hardDrop = 1 Then yDrop = yStop(pTetrim$) hardDrop = 0 End If   If moveLeft = 1 Then validLeftMove = validLeftMove(pTetrim$) If validLeftMove = 1 Then xTetrim = xTetrim - 20 tCol = tCol - 1 End If       moveLeft = 0 End If   If moveRight = 1 Then validRightMove = validRightMove(pTetrim$) If validRightMove = 1 Then xTetrim = xTetrim + 20 tCol = tCol + 1 End If       moveRight = 0 End If   If yDrop = 0 Then yTetrim = yTetrim + yInc Else yTetrim = yDrop yTemp = yTetrim #main.g "Spritexy ";pTetrim$;" ";xTetrim;" ";yTetrim #main.g "Drawsprites" End If   validDownMove = validDownMove(pTetrim$) If validDownMove = 0 Then yTetrim = 20 * Int(yTemp / 20) tRow = Int((yTetrim - 20) / 20) For rr = 0 to 3 For cc = 0 to 3 If TetrisGrid(tCol + cc, tRow + rr) = 0 Then TetrisGrid(tCol + cc, tRow + rr) = Tetrims(cc + 1, rr + 1) End If           Next cc        Next rr        tetrisScore = tetrisScore + 4 Gosub [displayScreen] If tetrisPlay = 0 Then #main.g "When leftButtonUp [nextTetrim]" #main.g "When characterInput [nextTetrim]" #main.g "Setfocus" Else Timer 250, [nextTetrim] End If   Else Timer timeDelay, [lowerTetrim] End If   #main.g "Spritexy ";pTetrim$;" ";xTetrim;" ";yTetrim #main.g "Drawsprites" #main.g "Setfocus" Wait

[centerTetrim] x1 = x1 - 4 If x1 < xStop Then xTetrim = xStop Gosub [xStop] Timer 0 Timer 25, [lowerTetrim] #main.g "When characterInput [keyPress]" #main.g "Setfocus" End If   #main.g "Spritexy ";pTetrim$;" ";x1;" ";yTetrim #main.g "Drawsprites" Wait

[slideTetrim] x1 = x1 - 4 If x1 = 280 Then #main.g "Spritevisible qTetrim1 Off" yTetrim = 40 #main.g "Spritexy ";pTetrim$;" 280 ";yTetrim Timer 0 Timer 25, [centerTetrim] End If   x2 = x2 - 4 x3 = x3 - 4 x4 = x4 - 4 x5 = x5 - 4 If x2 < 320 Then x2 = 320 x3 = 360 x4 = 400 x5 = 440 End If   #main.g "Spritexy qTetrim1 ";x1;" ";y1 #main.g "Spritexy qTetrim2 ";x2;" ";y2 #main.g "Spritexy qTetrim3 ";x3;" ";y3 #main.g "Spritexy qTetrim4 ";x4;" ";y4 #main.g "Spritexy qTetrim5 ";x5;" ";y5 #main.g "Drawsprites" xTetrim = x1   xStop = 160 yStop = 440 tCol = 5 Wait

[playTetris] Timer 0 For i = 1 to 7 For j = 1 to 4 #main.g "Spritexy tetrim";i;j;" -100 0" Next j   Next i    t1 = Int(Rnd(1) * 7) + 1 t2 = Int(Rnd(1) * 7) + 1 t3 = Int(Rnd(1) * 7) + 1 t4 = Int(Rnd(1) * 7) + 1 t5 = Int(Rnd(1) * 7) + 1 t6 = Int(Rnd(1) * 7) + 1 pTetrim$ = "tetrim";t1;"1" Gosub [displayScreen]

[nextTetrim] Timer 0 clearRow = clearRow If clearRow > 0 Then tetrisScore = tetrisScore + 2 * clearRow Gosub [displayScreen] End If   hardDrop = 0 #main.g "When leftButtonUp" #main.g "When characterInput" #main.g "Spritexy ";pTetrim$;" -100 0" If TetrisGrid(4, 5) + TetrisGrid(5, 5) + TetrisGrid(6, 5) > 0 Then Timer 0 Wait End If   t1 = t2    t2 = t3    t3 = t4    t4 = t5    t5 = t6    t6 = Int(Rnd(1) * 7) + 1 #main.g "Spritevisible qTetrim1 On" #main.g "Spritevisible qTetrim2 On" #main.g "Spritevisible qTetrim3 On" #main.g "Spritevisible qTetrim4 On" #main.g "Spriteimage qTetrim1 tetrim";t1;"1" #main.g "Spriteimage qTetrim2 tetrim";t2;"1" #main.g "Spriteimage qTetrim3 tetrim";t3;"1" #main.g "Spriteimage qTetrim4 tetrim";t4;"1" #main.g "Spriteimage qTetrim5 tetrim";t5;"1" #main.g "Background display 0 0" x1 = 320: y1 = 80 + 10 * (t1 = 1) x2 = 360: y2 = 80 + 10 * (t2 = 1) x3 = 400: y3 = 80 + 10 * (t3 = 1) x4 = 440: y4 = 80 + 10 * (t4 = 1) x5 = 480: y5 = 80 + 10 * (t5 = 1) #main.g "Spritexy qTetrim1 ";x1;" ";y1 #main.g "Spritexy qTetrim2 ";x2;" ";y2 #main.g "Spritexy qTetrim3 ";x3;" ";y3 #main.g "Spritexy qTetrim4 ";x4;" ";y4 #main.g "Spritexy qTetrim5 ";x5;" ";y5 nTetrim = t1   rTetrim = 1 pTetrim$ = "tetrim";t1;"1" #main.g "Cls" #main.g "Drawsprites" Timer 25, [slideTetrim] Wait

[showGridlines] showGrid = 1 Wait

[rotateTetrim] rTetrim = rTetrim + 1 If rTetrim = 5 Then rTetrim = 1 End If   #main.g "Spritexy ";pTetrim$;" -100 0" pTetrim$ = "tetrim";nTetrim;rTetrim #main.g "Spritexy ";pTetrim$;" ";x1;" ";y1 Gosub [xStop] Return

[xStop] tetrim = nTetrim * 10 + rTetrim Select Case tetrim Case 11, 13 xStop = 200 Case 12, 14 xStop = 260 Case 21, 23, 31, 33, 51, 53, 61, 63, 71, 73 xStop = 220 Case 22, 24, 32, 34, 41, 42, 43, 44, 52, 54, 62, 64, 72, 74 xStop = 240 End Select Return

[createTetrims] For t = 1 to 7 Read t$       Tetrims$(t, 4) = t$        For p = 0 to 3 Read t$           Tetrims$(t, p) = t$        Next p    Next t    #main.g "Down" For t = 1 to 7 #main.g "Cls; Color Black; Backcolor Black" #main.g "Place 0 80; Boxfilled 320 160" For p = 0 to 3 x = p * 80 y = 0 For n = 1 to 16 b = Val(Mid$(Tetrims$(t, p), n, 1)) If b > 0 Then #main.g "Place ";x;" ";y #main.g "Boxfilled ";x + 20;" ";y + 20 End If               x = x + 20 If x = p * 80 + 80 Then x = p * 80 y = y + 20 End If           Next n        Next p        #main.g "Color Lightgray" #main.g "Backcolor ";Tetrims$(t, 4) For p = 0 to 3 x = p * 80 y = 80 For n = 1 to 16 b = Val(Mid$(Tetrims$(t, p), n, 1)) If b > 0 Then #main.g "Place ";x;" ";y #main.g "Boxfilled ";x + 20;" ";y + 20 End If               x = x + 20 If x = p * 80 + 80 Then x = p * 80 y = y + 20 End If           Next n        Next p        t1$ = "tetrim";t;"1" t2$ = "tetrim";t;"2" t3$ = "tetrim";t;"3" t4$ = "tetrim";t;"4" #main.g "Getbmp ";t1$;" 0 0 80 160" #main.g "Getbmp ";t2$;" 80 0 80 160" #main.g "Getbmp ";t3$;" 160 0 80 160" #main.g "Getbmp ";t4$;" 240 0 80 160" #main.g "Addsprite ";t1$;" ";t1$ #main.g "Addsprite ";t2$;" ";t2$ #main.g "Addsprite ";t3$;" ";t3$ #main.g "Addsprite ";t4$;" ";t4$ #main.g "Spritexy ";t1$;" -100 0" #main.g "Spritexy ";t2$;" -100 0" #main.g "Spritexy ";t3$;" -100 0" #main.g "Spritexy ";t4$;" -100 0" Next t   For i = 1 to 5 qt$ = "qTetrim";i qn$ = "" For j = 1 to 7 qn$ = qn$;" tetrim";j;"1" Next j       #main.g "Addsprite ";qt$;qn$ #main.g "Spritexy ";qt$;" -100 0" #main.g "Spritescale ";qt$;" 35" Next i Return

[titleScreen] #main.g "Cls" #main.g "Backcolor Buttonface" #main.g "Place -10 -10; Boxfilled 520 600" #main.g "Color Lightgray; Backcolor 250 250 250" #main.g "Place 80 40; Boxfilled 281 521" For col = 80 to 280 Step 20 #main.g "Line ";col;" 120 ";col;" 520" Next col For row = 120 to 520 Step 20 #main.g "Line 80 ";row;" 280 ";row Next row #main.g "Font Verdana 14 Italic" #main.g "Color Darkblue; Backcolor Buttonface" #main.g "Place 310 160" #main.g "\Just BASIC Tetris" #main.g "Place 325 230" #main.g "\L-Click Mouse" #main.g "Place 380 250" #main.g "\or" #main.g "Place 325 270" #main.g "\Press Any Key" #main.g "Place 360 290" #main.g "\to Play" #main.g "Getbmp title 0 0 500 600" #main.g "Drawbmp title 0 0; Flush" #main.g "When leftButtonUp [playTetris]" #main.g "When characterInput [playTetris]" #main.g "Setfocus" Return

[displayScreen] #main.g "Backcolor Buttonface" #main.g "Place -10 -10; Boxfilled 520 600" #main.g "Color Lightgray; Backcolor 250 250 250" #main.g "Place 80 40; Boxfilled 281 521" If showGridlines = 1 Then For col = 80 to 280 Step 20 #main.g "Line ";col;" 120 ";col;" 520" Next col For row = 120 to 520 Step 20 #main.g "Line 80 ";row;" 280 ";row Next row End If   #main.g "Font Verdana 14 Italic" #main.g "Color Darkblue; Backcolor Buttonface" #main.g "Place 310 160" #main.g "\Just BASIC Tetris" #main.g "Place 350 230" #main.g "\Move Left" #main.g "Place 350 270" #main.g "\Move Right" #main.g "Place 350 312" #main.g "\Rotate" #main.g "Place 350 352" #main.g "\Hard Drop" #main.g "Line 320 225 340 225" #main.g "Line 325 215 320 225; Line 325 235 320 225" #main.g "Line 320 265 340 265" #main.g "Line 335 255 340 265; Line 335 275 340 265" #main.g "Line 330 295 330 315" #main.g "Line 320 305 330 295; Line 340 305 330 295" #main.g "Line 330 335 330 355" #main.g "Line 320 345 330 355; Line 340 345 330 355" #main.g "Place 320 400" #main.g "\Score: ";tetrisScore #main.g "Color Lightgray" For hue = 1 to 7 hue$ = Word$(hueTetris$, hue, "-") #main.g "Backcolor ";hue$ For rr = 5 to 24 For cc = 1 to 10 If TetrisGrid(cc, rr) = hue Then #main.g "Place ";60 + 20 * cc;" ";20 + 20 * rr                   #main.g "Boxfilled ";80 + 20 * cc;" ";40 + 20 * rr                End If            Next cc        Next rr    Next hue #main.g "Getbmp display 0 0 500 600" #main.g "Background display 0 0" #main.g "Drawbmp display 0 0; Flush displayScreen" Return

[practicePlay] tetrisPlay = 0 timeDelay = 50 yInc = 2 Wait

[novicePlay] tetrisPlay = 1 timeDelay = 50 yInc = 2 Wait

[averagePlay] tetrisPlay = 2 timeDelay = 50 yInc = 4 Wait

[expertPlay] tetrisPlay = 3 timeDelay = 25 yInc = 4 Wait

[showGrids] showGridlines = 1 Wait

[hideGrids] showGridlines = 0 Wait

[tetrisDirections] Timer 0 WindowWidth = 357 WindowHeight = 200 UpperLeftX = 100 UpperLeftY = 50 Graphicbox #1.g, 0, 0, 350, 170 Open "JB Tetris Directions" for Dialog_Modal as #1 #1, "Trapclose [closeDialog]" #1.g, "Vertscrollbar On 0 250" #1.g, "Color Darkblue; Place 30 30" #1.g, "Font Times_New_Roman 12 Bold" #1.g, "\JB Tetris Directions" #1.g, "\\Object of Game" #1.g, "\";Space$(3);"Manuever dropping blocks to fill in grid." #1.g, "\";Space$(3);"Filled cells become obstacles." #1.g, "\";Space$(3);"Each completely filled row is cleared." #1.g, "\";Space$(3);"Game ends when block can no longer fall." #1.g, "\\Game Modes" #1.g, "\";Space$(3);"Practice - Keypress to drop block" #1.g, "\";Space$(3);"Novice - Slow Rate" #1.g, "\";Space$(3);"Normal - Average Rate" #1.g, "\";Space$(3);"Expert - Fast Rate" #1.g, "\\Scoring" #1.g, "\";Space$(3);"Filled Cell = 1 pt" #1.g, "\";Space$(3);"Cleared Row = 10 pts" #1.g, "Flush dialogScreen" Wait

[tetrisAbout] Timer 0 WindowWidth = 357 WindowHeight = 200 UpperLeftX = 100 UpperLeftY = 50 Graphicbox #1.g, 0, 0, 350, 170 Open "About JB Tetris" for Dialog_Modal as #1 #1, "Trapclose [closeDialog]" #1.g, "Vertscrollbar On 0 250" #1.g, "Color Darkblue; Place 30 30" #1.g, "Font Times_New_Roman 12 Bold" #1.g, "\JB Tetris" #1.g, "\\Author" #1.g, "\";Space$(3);"Janet Terra (2010)" #1.g, "\\License" #1.g, "\";Space$(3);"Public Domain" #1.g, "\\Purpose" #1.g, "\";Space$(3);"Tetris Challenge" #1.g, "\";Space$(3);"http://justbasic.conforums.com" #1.g, "\";Space$(3);"January, 2010" #1.g, "\\Just BASIC Programming Language" #1.g, "\";Space$(3);"A FREE BASIC Programming Language" #1.g, "\";Space$(3);"http://justbasic.com" #1.g, "\\Join the Just BASIC Community and" #1.g, "\join the fun!" #1.g, "Flush dialogScreen" Wait

[closeDialog] Close #1 Wait

[tetrimsData] Data "cyan" Data "0000000000001111" Data "1000100010001000" Data "0000000000001111" Data "1000100010001000" Data "blue" Data "0000000020002220" Data "0000220020002000" Data "0000000022200020" Data "0000020002002200" Data "red" Data "0000000000303330" Data "0000300030003300" Data "0000000033303000" Data "0000330003000300" Data "yellow" Data "0000000044004400" Data "0000000044004400" Data "0000000044004400" Data "0000000044004400" Data "green" Data "0000000005505500" Data "0000500055000500" Data "0000000005505500" Data "0000500055000500" Data "darkpink" Data "0000000006006660" Data "0000600066006000" Data "0000000066600600" Data "0000060066000600" Data "255 128 0" Data "0000000077000770" Data "0000070077007000" Data "0000000077000770" Data "0000070077007000"

Function validLeftMove(pTetrim$) validLeftMove = 1 #main.g "Spritexy? ";pTetrim$;" x y"   shape = Val(Mid$(pTetrim$, 7, 1)) dir = Val(Mid$(pTetrim$, 8, 1)) col = Int((x - 40) / 20) - (x Mod 20 = 0) row = Int(y / 20) - (y Mod 20 = 0) #main.g "Spritexy? ";pTetrim$;" x y"   If col = 1 Then validLeftMove = 0 Exit Function End If   Call tetrimArray Tetrims$(shape, dir - 1) Call gridArray col - 1, row For rr = 1 to 4 For cc = 1 to 4 If Tetrims(cc, rr) <> 0 Then If Grids(cc, rr) > 0 Then validLeftMove = 0 End If           End If        Next cc    Next rr End Function

Function validRightMove(pTetrim$) validRightMove = 1 #main.g "Spritexy? ";pTetrim$;" x y"   shape = Val(Mid$(pTetrim$, 7, 1)) dir = Val(Mid$(pTetrim$, 8, 1)) col = Int((x - 40) / 20) - (x Mod 20 = 0) row = Int(y / 20) - (y Mod 20 = 0) #main.g "Spritexy? ";pTetrim$;" x y"   If col = 10 Then validRightMove = 0 Exit Function End If   Call tetrimArray Tetrims$(shape, dir - 1) Call gridArray col + 1, row For rr = 1 to 4 For cc = 1 to 4 If Tetrims(cc, rr) <> 0 Then If Grids(cc, rr) > 0 Then validRightMove = 0 End If           End If        Next cc    Next rr End Function

Function validDownMove(pTetrim$) validDownMove = 1 shape = Val(Mid$(pTetrim$, 7, 1)) dir = Val(Mid$(pTetrim$, 8, 1)) #main.g "Spritexy? ";pTetrim$;" x y"   col = Int((x - 40) / 20) - (x Mod 20 = 0) row = Int(y / 20) - (y Mod 20 = 0) If row < 0 Then Exit Function End If   If row = 22 Then validDownMove = 0 Exit Function End If   Call tetrimArray Tetrims$(shape, dir - 1) Call gridArray col, row For rr = 1 to 4 For cc = 1 to 4 If Tetrims(cc, rr) <> 0 Then If Grids(cc, rr) > 0 Then validDownMove = 0 End If           End If        Next cc    Next rr End Function

Function yStop(pTetrim$) shape = Val(Mid$(pTetrim$, 7, 1)) dir = Val(Mid$(pTetrim$, 8, 1)) #main.g "Spritexy? ";pTetrim$;" x y"   col = Int((x - 40) / 20) - (x Mod 20 = 0) row = Int(y / 20) - (y Mod 20 = 0) For yy = y to 460 Step 8 #main.g "Spritexy ";pTetrim$;" ";x;" ";yy validDownMove = validDownMove(pTetrim$) If validDownMove = 0 Then yStop = yy           Exit For End If   Next yy End Function

Sub tetrimArray Tetrims$ n = 0 For rr = 1 to 4 For cc = 1 to 4 n = n + 1 Tetrims(cc, rr) = Val(Mid$(Tetrims$, n, 1)) Next cc   Next rr End Sub

Sub gridArray col, row For rr = 0 to 3 For cc = 0 to 3 Grids(cc + 1, rr + 1) = TetrisGrid(col + cc, row + rr) Next cc   Next rr End Sub

Function clearRow clearRow = 0 For rr = 5 to 24 row$ = "" For cc = 1 to 10 row$ = row$;TetrisGrid(cc, rr) Next cc       If Instr(row$, "0") = 0 Then clearRow = clearRow + 1 For cc = 1 to 10 TetrisGrid(cc, rr) = 0 Next cc           For drop = rr to 6 Step -1 For cc = 1 to 10 TetrisGrid(cc, drop) = TetrisGrid(cc, drop - 1) Next cc           Next drop End If   Next rr End Function

code