Scribd
Upload
13 views1 page

Gwbasictetris

This document contains the source code for a Tetris clone written in GW-BASIC. It defines variables and functions for drawing the playing field, generating and moving tetromino shapes, detecting collisions, clearing full lines, and handling input. The main loop spawns new blocks and processes input until a game over occurs.

Uploaded by

maldup
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
13 views1 page

Gwbasictetris

This document contains the source code for a Tetris clone written in GW-BASIC. It defines variables and functions for drawing the playing field, generating and moving tetromino shapes, detecting collisions, clearing full lines, and handling input. The main loop spawns new blocks and processes input until a game over occurs.

Uploaded by

maldup
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as PDF, TXT or read online on Scribd
You are on page 1/ 1

Tetris clone ― GW-BASIC writing example for Youtube – © Joel Yliluoma

10 DEFINT A-Z 90 ' Initialize and draw the playing field.


20 SCREEN 0:WIDTH 40,25: KEY OFF 92 DEF FNempty$(x) = "."
70 ' Define the playing field. 95 c=23: FOR x=0 TO 11: FOR y=0 TO 24: GOSUB 900: NEXT y,x
80 DIM area(11,24) ' Width and height, including borders. 96 c=0: FOR x=1 TO 10: FOR y=0 TO 23: GOSUB 900: NEXT y,x
900 ' Subroutine for drawing a "pixel", i.e. one block slot.
901 ' Params: x,y, c
910 LOCATE y+1,x+1: area(x,y)=c
920 IF c THEN COLOR c AND 15: PRINT CHR$(219); : RETURN
930 COLOR 1: PRINT FNempty$(x);
940 RETURN ’ *** TESTING BARRIER
30 ' Define all distinct tetromino shapes as bitmasks.
31 DATA CC,8C4,6C,4444,F0,264,C6,E4,4C4,4E0,464,8E,C88,E2,226,2E,88C,E8,622
32 REM e.g. 8C4 = 1000, 2E = 0010
33 REM 1100 1110
34 REM 0100 and so on.
35 DIM shapes(18): FOR a=0 TO 18: READ s$: shapes(a)=VAL("&H"+s$): NEXT
40 ' Define the mappings of block number -> block shape
41 DATA 0,0,0,0, 1,2,1,2, 3,4,3,4, 5,6,5,6, 7,8,9,10, 11,12,13,14, 15,16,17,18
45 DIM indices(28): FOR a=0 TO 27: READ indices(a): NEXT
50 ' This function reads the given slot from the given block in given rotation.
55 DEF FNblock(bl,rot,x,y) = shapes(indices(bl*4+rot))AND bitmasks(y*4+x)
52 DIM bitmasks(15): FOR a=0 TO 14: bitmasks(a) = 2^a: NEXT'note: 2^15=overflow
60 ' Bounds checking function
61 DEF FNbounds(x,y) = x>=0 AND y>=0 AND x<12 AND y<=24
700 ' Subroutine for plotting the current block.
701 ' Params: curx,cury,curblock,currotate, c
710 FOR by=0 TO 3:FOR bx=0 TO 3
720 x=curx+bx: y=cury+by
730 IF FNbounds(x,y)AND FNblock(curblock,currotate,bx,by) THEN GOSUB 900
740 NEXT bx,by
750 RETURN

800 ' Subroutine for testing a block collision.


801 ' Params: curx,cury,curblock,currotate 100 ' Main loop. Begin by generating a new piece.
802 ' Output: collided 101 curblock = INT(RND * 7)
810 FOR by=0 TO 3:FOR bx=0 TO 3 102 currotate = INT(RND * 4)
820 IF FNblock(curblock,currotate,bx,by)=0 THEN 860 103 curx = 4 : cury = -2
830 x=curx+bx: y=cury+by 104 colorwhenmove = curblock+1
840 IF FNbounds(x,y)=0 THEN 860 105 colorwhendone = curblock+25
850 IF area(x,y)AND 16 THEN collided=1: RETURN 106 ' Test whether the new block immediately collides
860 NEXT bx,by 107 GOSUB 800: IF collided THEN GOTO 999 'Gameover if cannot
870 collided=0: RETURN spawn block

999 WIDTH 80: COLOR 7,0: PRINT "GAME OVER" : KEY ON: END
Written in July 2010.
110 REM Flush input buffer: WHILE INKEY$<>"":WEND P.S. The colors in this code are hints for me in directing
130 c=colorwhenmove: GOSUB 700 'Draw the current block the Youtube video. – Joel Yliluoma
140 ' Wait for input before dropping the block a bit
150 ti!=TIMER + 0.5 ’ *** TESTING BARRIER
160 WHILE TIMER < ti! 400 ' Make full lines empty
250 WEND 'done 410 FOR y=1 TO 23
300 'Move down after timer elapsed 420 x=1: WHILE x<=10 AND area(x,y)>0: x=x+1: WEND
310 mx=curx: my=cury: mr=currotate 421 empty=x>10
320 cury=cury+1: GOSUB 600 ' Try moving down 430 IF empty THEN c=0: FOR x=1 TO 10: GOSUB 900: SOUND
330 IF collided=0 THEN 150 ' Loop until collision 40+RND*200,.1:NEXT
340 ' The block hit the ground. 440 NEXT
350 c=colorwhendone: GOSUB 700 ' Draw at final color 81 DIM emptyline(23)
499 GOTO 100 ' Generate a new block 405 emptycount=0
422 emptyline(y) = empty: IF empty THEN
600 ' Try moving to a given direction emptycount=emptycount+1
601 ' Params: curx,cury,curblock,currotate: Suggested new position 423 NEXT
602 ' Params: mx,my,mr: Current position 424 IF emptycount=0 THEN 499
603 ' Output: collided=1 -> No move (curx,.. reset to mx,..) 425 empty$ = ".." + MID$("SINGLEDOUBLETRIPLETETRIS",
604 ' collided=0 -> Moved emptycount*6-5, 6) + ".."
605 ' In either case, mx,my,mr will be overwritten. 426 DEF FNempty$(x) = MID$(empty$,x,1)
610 GOSUB 800 'Test move 427 FOR y=1 TO 23
620 SWAP mx,curx:SWAP my,cury:SWAP mr,currotate 428 empty = emptyline(y)
630 IF collided THEN RETURN 'No move 445 DEF FNempty$(x) = "."
640 ' No obstacle for moving block
650 c=0: GOSUB 700 ' Undraw at old location 450 ' Drop non-empty lines that are above empty lines
660 SWAP mx,curx:SWAP my,cury:SWAP mr,currotate 451 y=23 'Target of next non-empty line = bottom
670 c=colorwhenmove: GOTO 700 ' Draw at new location 460 FOR source=23 TO 1 STEP -1
120 dropping=0 ’ *** TESTING BARRIER 465 x=1: WHILE x<=10 AND area(x,source)=0: x=x+1: WEND
170 k$ = INKEY$ 470 empty = x>10
180 mx=curx: my=cury: mr=currotate 480 IF y<>source THEN FOR x=1 TO 10: c=area(x,source): GOSUB 900: NEXT
190 IF k$="w" THEN currotate=(currotate+1)AND 3: dropping=0: GOSUB 600 490 IF NOT empty THEN y=y-1
200 IF k$="a" THEN curx=curx-1: dropping=0: GOSUB 600 495 NEXT
210 IF k$="d" THEN curx=curx+1: dropping=0: GOSUB 600 496 ' Clear the top in case it was not cleared yet
220 IF k$="q" THEN GOTO 999 ' Gameover if request quit 497 c=0
230 IF k$="s" OR dropping=1 THEN 300 'Try moving down 498 WHILE y>1: FOR x=1 TO 10: GOSUB 900: NEXT: y=y-1: WEND
240 IF k$=" " THEN dropping=1 462 SOUND 30+source*40,.5

You might also like