Programming by Example

 

A BB4W Compendium

freeman69@gmx.com

IDIC BBC_Owl2 M&P

Tetra Blocks

Guide the falling pieces to create solid rows at the bottom of the container. While falling, the pieces can be moved left, right and rotated clockwise, as long as such movement isn't blocked.

 

         Cursor Left = Left

         Cursor Right= Right

         Cursor Up= Rotate clockwise

         Cursor Down= Speed up descent

 

  10 MODE 9:OFF

  20 VDU 23,224,126,255,255,255,255,255,255,126

  30 VDU 23,225,165,149,141,197,163,177,169,165

  40 VDU 23,226,255,16,143,68,34,241,8,255

  50

  60 tubwidth=12:tubheight=24

  70 ORIGIN 640-tubwidth*16,512-tubheight*16

  80 DIM spinmax(6),blocks(6,3,1),tub(tubwidth-1,tubheight-1)

  90 PROCreaddata

 100 delay=8:pdropcount=delay:hiscore=0

 110

 120 REPEAT

 130   score=0:tub()=0

 140   CLS

 150   GCOL 0,7:PROCdrawtub

 160   PRINTTAB(10);"Score ";score TAB(24);"Hi-Score ";hiscore

 170   endgame=FALSE

 180   newpiece=TRUE

 190   REPEAT

 200     TIME=0

 210    

 220     IF newpiece THEN

 230       ptype=RND(7)-1

 240       pspin=0:px=tubwidth DIV 2:py=tubheight-3

 250       pmoved=FALSE:newspin=pspin:movx=0:movy=0

 260       GCOL 0,ptype+1:PROCdrawfour

 270       firstdrop=TRUE

 280       newpiece=FALSE

 290     ENDIF

 300    

 310     pdropcount-=1

 320     IF pdropcount<=0 THEN

 330       PROCfall:pdropcount=delay

 340       *FX21

 350     ELSE

 360       key=ASC(INKEY$(0))

 370       IF key=139 AND FNmoveok(0,FNclockwise,0,0) THEN

 380         newspin=FNclockwise:pmoved=TRUE

 390       ENDIF

 400       IF key=136 AND FNmoveok(0,pspin,-1,0) THEN movx=-1:pmoved=TRUE

 410       IF key=137 AND FNmoveok(0,pspin,1,0) THEN movx=1:pmoved=TRUE

 420       IF key=138 pdropcount=0

 430     ENDIF

 440    

 450     IF pmoved THEN

 460       GCOL 0,0:PROCdrawfour:REM delete old

 470       pspin=newspin

 480       px+=movx:movx=0

 490       py+=movy:movy=0

 500       GCOL 0,ptype+1:PROCdrawfour:REM draw new

 510       pmoved=FALSE

 520     ENDIF

 530    

 540     WAIT 4-TIME

 550   UNTIL endgame

 560   PRINTTAB(7,15);"Press SPACE to play again"

 570   REPEATUNTILGET=32

 580   IF score>hiscore hiscore=score

 590 UNTIL FALSE

 600 END

 610

 620 DEF PROCreaddata

 630 FOR a=0 TO 6:READ spinmax(a):NEXT

 640 FOR p=0 TO 6

 650   FOR b=1 TO 3

 660     READ blocks(p,b,0):READ blocks(p,b,1)

 670   NEXT

 680 NEXT

 690 ENDPROC

 700

 710 DATA 0,90,90,90,270,270,270

 720 DATA 0,1,1,1,1,0

 730 DATA 0,-1,0,1,0,2

 740 DATA 0,-1,-1,0,-1,1

 750 DATA 0,-1,1,0,1,1

 760 DATA 0,-1,1,-1,0,1

 770 DATA 0,-1,-1,-1,0,1

 780 DATA -1,0,1,0,0,1

 790

 800 DEF PROCdrawtub

 810 FOR y=-1 TO tubheight-1

 820   MOVE -32,y*32:VDU 5,225

 830   MOVE tubwidth*32,y*32:VDU 225,4

 840 NEXT

 850 FOR x=-1 TO tubwidth

 860   MOVE x*32,-32:VDU 5,226,4

 870 NEXT

 880 ENDPROC

 890

 900 DEF FNmoveok(brick,spin,xd,yd)

 910 LOCAL x,y

 920 x=px+xd+FNrotatex(brick,spin)

 930 y=py+yd+FNrotatey(brick,spin)

 940 IF x<0 OR x>=tubwidth OR y<0 OR y>=tubheight THEN =FALSE

 950 IF tub(x,y)<>0 THEN =FALSE

 960 IF brick<3 THEN

 970   =FNmoveok(brick+1,spin,xd,yd)

 980 ELSE

 990   =TRUE

1000 ENDIF

1010

1020 DEF FNclockwise

1030 LOCAL r

1040 r=pspin+90:IF r>spinmax(ptype) r=0

1050 =r

1060

1070 DEF PROCdrawfour

1080 LOCAL x,y

1090 FOR brick=0 TO 3

1100   x=px+FNrotatex(brick,pspin)

1110   y=py+FNrotatey(brick,pspin)

1120   MOVE x*32,y*32:VDU 5,224,4

1130 NEXT

1140 ENDPROC

1150

1160 DEF PROCfall

1170 IF FNmoveok(0,pspin,0,-1) THEN

1180   movy=-1:pmoved=TRUE:firstdrop=FALSE

1190 ELSE

1200   FOR brick=0 TO 3

1210     tub(px+FNrotatex(brick,pspin),py+FNrotatey(brick,pspin))=ptype+1

1220   NEXT

1230   newpiece=TRUE

1240   score+=10:PRINTTAB(16,0);score

1250   PROCcheckrow

1260   IF firstdrop THEN endgame=TRUE

1270 ENDIF

1280 ENDPROC

1290

1300 DEF FNrotatex(brick,spin)

1310 LOCAL x

1320 CASE spin OF

1330   WHEN 0 : x=blocks(ptype,brick,0)

1340   WHEN 90 : x=blocks(ptype,brick,1)

1350   WHEN 180 : x=-blocks(ptype,brick,0)

1360   WHEN 270 : x=-blocks(ptype,brick,1)

1370 ENDCASE

1380 =x

1390

1400 DEF FNrotatey(brick,spin)

1410 LOCAL y

1420 CASE spin OF

1430   WHEN 0 : y=blocks(ptype,brick,1)

1440   WHEN 90 : y=-blocks(ptype,brick,0)

1450   WHEN 180 : y=-blocks(ptype,brick,1)

1460   WHEN 270 : y=blocks(ptype,brick,0)

1470 ENDCASE

1480 =y

1490

1500 DEF PROCcheckrow

1510 LOCAL r,c,nogaps

1520 r=0

1530 REPEAT

1540   c=0:nogaps=TRUE

1550   WHILE nogaps AND c<tubwidth

1560     IF tub(c,r)=0 THEN nogaps=FALSE

1570     c+=1

1580   ENDWHILE

1590   IF nogaps THEN

1600     PROCscrolldown(r)

1610     score+=100:PRINTTAB(16,0);score

1620   ELSE

1630     r+=1

1640   ENDIF

1650 UNTIL r=tubheight

1660 ENDPROC

1670

1680 DEF PROCscrolldown(row)

1690 LOCAL r,c

1700 FOR r=row+1 TO tubheight-1

1710   FOR c=0 TO tubwidth-1

1720     tub(c,r-1)=tub(c,r)

1730     GCOL 0,tub(c,r-1):MOVE c*32,(r-1)*32:VDU 5,224,4

1740   NEXT

1750 NEXT

1760 ENDPROC

Tetra

Tetra Blocks: Code explained...

 

  10 MODE 9:OFF

  20 VDU 23,224,126,255,255,255,255,255,255,126

  30 VDU 23,225,165,149,141,197,163,177,169,165

  40 VDU 23,226,255,16,143,68,34,241,8,255

 

The first few lines set the display mode and create the graphics for an individual block and for the container walls.

 

  60 tubwidth=12:tubheight=24

  70 ORIGIN 640-tubwidth*16,512-tubheight*16

  80 DIM spinmax(6),blocks(6,3,1),tub(tubwidth-1,tubheight-1)

  90 PROCreaddata

 100 delay=8:pdropcount=delay:hiscore=0

 

'tubwidth' & 'tubheight' define the size of the container.

The graphics origin is set to the inside, bottom left corner of the container.

'spinmax' contains the maximum angle of rotation that a shape can be displayed e.g. square blocks (piece zero) are so symmetrical that we don't rotate them at all, whereas L-shaped pieces can be rotated by 0, 90, 180 and 270 degrees.

(See DATA lines for specific piece numbers)

'blocks' contains the character position of all 4 blocks relative to the origin block. i.e. one block in each piece acts as the centre of the piece, about which the other blocks will be rotated. This array is a 3 dimensional array. The first element refers to the type of piece, the second refers to the block number (0-3) and the third element refers to the block offset co-ordinates.

'tub' is a 2 dimensional array that will store the colour of each block piled up within the container.

PROCreaddata fills 'spinmax' and 'blocks' with data from line 710 onwards.

'delay' and 'pdropcount' are used to count the number of animation frames before a piece drops down one character in height.

 

 120 REPEAT

 130   score=0:tub()=0

 140   CLS

 150   GCOL 0,7:PROCdrawtub

 160   PRINTTAB(10);"Score ";score TAB(24);"Hi-Score ";hiscore

 170   endgame=FALSE

 180   newpiece=TRUE

 

This is the outer-loop that executes once per new game. We reset the score and fill the 'tub' array with zeros (the colour black).

The window is cleared and the container is drawn. Text for the players' score and hi-score are displayed.

'endgame' will trigger the end of the inner-loop.

'newpiece' triggers the appearance of a new piece at the top of the container.

 

 190   REPEAT

 200     TIME=0

 

We enter the inner-loop and reset the clock to time the animation.

 

 220     IF newpiece THEN

 230       ptype=RND(7)-1

 240       pspin=0:px=tubwidth DIV 2:py=tubheight-3

 250       pmoved=FALSE:newspin=pspin:movx=0:movy=0

 260       GCOL 0,ptype+1:PROCdrawfour

 270       firstdrop=TRUE

 280       newpiece=FALSE

 290     ENDIF

 

If a new piece is required then one is chosen randomly from the 7 available.

'pspin' holds the current degree of rotation: 0, 90, 180, 270 (limited by 'spinmax').

'px' & 'py' hold the position of the centre-block of the current piece.

'pmoved' indicates if the current piece can be moved in the manner requested by the player.

'newspin', 'movx' & 'movy'  hold the requested angle of rotation, new x and new y.

Line 260 draws the new piece at the top of the container.

'firstdrop' is used to test if the game is over i.e. if a piece can't drop then the container is full.

 

 310     pdropcount-=1

 320     IF pdropcount<=0 THEN

 330       PROCfall:pdropcount=delay

 340       *FX21

 350     ELSE

 360       key=ASC(INKEY$(0))

 370       IF key=139 AND FNmoveok(0,FNclockwise,0,0) THEN

 380         newspin=FNclockwise:pmoved=TRUE

 390       ENDIF

 400       IF key=136 AND FNmoveok(0,pspin,-1,0) THEN movx=-1:pmoved=TRUE

 410       IF key=137 AND FNmoveok(0,pspin,1,0) THEN movx=1:pmoved=TRUE

 420       IF key=138 pdropcount=0

 430     ENDIF

 

When 'pdropcount' reaches zero then the current piece attempts to drop down the display by one character. At any other time, the user can move the piece.

ASC(INKEY$(0)) returns the ASCII value of a key pressed, having given the user zero time to press a key. Although this sounds silly, the keyboard buffer will already hold the values of any keys pressed and doesn't require any extra time to obtain user input. This method is employed because we know the ASCII value of the cursor keys and because INKEY$() makes use of the autorepeat delay. (The autorepeat delay is seen in word processing. If the autorepeat delay wasn't present then pressing the cursor up key, even briefly, would result in the current piece spinning wildly.)

Line 370 to 390 processes a request to rotate the piece clockwise. FNmoveok returns either TRUE of FALSE depending on whether the move is okay or blocked.

Line 400 and 410 execute when the user moves the piece left and right.

Line 420 temporarily reduces the delay, triggering the piece to drop by one character immediately.

 

 450     IF pmoved THEN

 460       GCOL 0,0:PROCdrawfour:REM delete old

 470       pspin=newspin

 480       px+=movx:movx=0

 490       py+=movy:movy=0

 500       GCOL 0,ptype+1:PROCdrawfour:REM draw new

 510       pmoved=FALSE

 520     ENDIF

 

If the piece is okay to be moved then the old graphic has to be deleted and a new one drawn in a new position or in a new orientation.

 

 540     WAIT 4-TIME

 550   UNTIL endgame

 560   PRINTTAB(7,15);"Press SPACE to play again"

 570   REPEATUNTILGET=32

 580   IF score>hiscore hiscore=score

 590 UNTIL FALSE

 600 END

 

The end of the inner and outer loops.

 

 620 DEF PROCreaddata

 630 FOR a=0 TO 6:READ spinmax(a):NEXT

 640 FOR p=0 TO 6

 650   FOR b=1 TO 3

 660     READ blocks(p,b,0):READ blocks(p,b,1)

 670   NEXT

 680 NEXT

 690 ENDPROC

 700

 710 DATA 0,90,90,90,270,270,270

 720 DATA 0,1,1,1,1,0

 730 DATA 0,-1,0,1,0,2

 740 DATA 0,-1,-1,0,-1,1

 750 DATA 0,-1,1,0,1,1

 760 DATA 0,-1,1,-1,0,1

 770 DATA 0,-1,-1,-1,0,1

 780 DATA -1,0,1,0,0,1

 

As mentioned above, PROCreaddata fills two arrays with data contained in lines 710 to 780.

Line 710 contains one value for each piece that is used to limit its rotation.

Lines 720 to 780 contain three pairs of x,y co-ordinates for each piece. These are the positions of 3 blocks, relative to the centre block. Note that Line 650 uses a loop from values 1 to 3. Element zero will contain 0,0 by default for the first block of each piece i.e. the centre-block.

The pieces defined are: square, vertical line, crook left, crook right, L, backwards L, upside-down T.

 

 800 DEF PROCdrawtub

 810 FOR y=-1 TO tubheight-1

 820   MOVE -32,y*32:VDU 5,225

 830   MOVE tubwidth*32,y*32:VDU 225,4

 840 NEXT

 850 FOR x=-1 TO tubwidth

 860   MOVE x*32,-32:VDU 5,226,4

 870 NEXT

 880 ENDPROC

 

Draws two vertical columns for the sides and one row for the bottom of the container.

 

 900 DEF FNmoveok(brick,spin,xd,yd)

 910 LOCAL x,y

 920 x=px+xd+FNrotatex(brick,spin)

 930 y=py+yd+FNrotatey(brick,spin)

 940 IF x<0 OR x>=tubwidth OR y<0 OR y>=tubheight THEN =FALSE

 950 IF tub(x,y)<>0 THEN =FALSE

 960 IF brick<3 THEN

 970   =FNmoveok(brick+1,spin,xd,yd)

 980 ELSE

 990   =TRUE

1000 ENDIF

 

LOCAL x,y specifies that 'x' & 'y' are variables local to this routine. When the function exits then the values of these local variables will be lost.

The function as a whole takes one bock of the current piece at a time, rotates it about the centre-block, if necessary, then adds the current co-ordinates plus the requested direction of movement. Having calculated the proposed new position for this block, the function tests to see if the block is still within the walls of the container and doesn't overlap any blocks piled at the bottom of the container.

If the current block (one of four) is okay to be moved then the function calls itself to test the next block, until all four blocks have been checked. Only if all four blocks of the current piece are free to move, does the function 'unwind' itself and return a value of TRUE.

 

1020 DEF FNclockwise

1030 LOCAL r

1040 r=pspin+90:IF r>spinmax(ptype) r=0

1050 =r

 

This routine adds 90 degrees to 'pspin', adjusting for the maximum value of rotation allowed for the current piece.

 

1070 DEF PROCdrawfour

1080 LOCAL x,y

1090 FOR brick=0 TO 3

1100   x=px+FNrotatex(brick,pspin)

1110   y=py+FNrotatey(brick,pspin)

1120   MOVE x*32,y*32:VDU 5,224,4

1130 NEXT

1140 ENDPROC

 

PROCdrawfour simply plots four block characters in the pattern of the current piece, having rotated the pattern to the correct orientation.

 

1160 DEF PROCfall

1170 IF FNmoveok(0,pspin,0,-1) THEN

1180   movy=-1:pmoved=TRUE:firstdrop=FALSE

1190 ELSE

1200   FOR brick=0 TO 3

1210     tub(px+FNrotatex(brick,pspin),py+FNrotatey(brick,pspin))=ptype+1

1220   NEXT

1230   newpiece=TRUE

1240   score+=10:PRINTTAB(16,0);score

1250   PROCcheckrow

1260   IF firstdrop THEN endgame=TRUE

1270 ENDIF

1280 ENDPROC

 

When the current piece drops down the display it eventually hits the bottom of the container or the remains of pieces previously deposited. PROCfall processes both eventualities. Each piece dropped into the container gains the player 10 points, but space is created by filling rows without leaving any gaps. Full rows are automatically deleted by the program, releasing the blocks piled above to drop down.

If a new piece can't fall then the game ends.

 

1300 DEF FNrotatex(brick,spin)

1310 LOCAL x

1320 CASE spin OF

1330   WHEN 0 : x=blocks(ptype,brick,0)

1340   WHEN 90 : x=blocks(ptype,brick,1)

1350   WHEN 180 : x=-blocks(ptype,brick,0)

1360   WHEN 270 : x=-blocks(ptype,brick,1)

1370 ENDCASE

1380 =x

1390

1400 DEF FNrotatey(brick,spin)

1410 LOCAL y

1420 CASE spin OF

1430   WHEN 0 : y=blocks(ptype,brick,1)

1440   WHEN 90 : y=-blocks(ptype,brick,0)

1450   WHEN 180 : y=-blocks(ptype,brick,1)

1460   WHEN 270 : y=blocks(ptype,brick,0)

1470 ENDCASE

1480 =y

 

FNrotatex & FNrotatey return new values for x and y co-ordinates of a block. The 'blocks' array can be thought of as holding a template pattern for each piece, but the pattern held is frozen at an angle of zero degrees. If we want to draw the piece rotated by 90, 180 or 270 degrees then we have to rotate a copy of the blocks each time.

Because rotations in this game are limited to steps of 90 degrees, the transformation is relatively simple. In other programs we will rotate co-ordinates by smaller steps, in a similar manner, by using SIN & COS.

 

1500 DEF PROCcheckrow

1510 LOCAL r,c,nogaps

1520 r=0

1530 REPEAT

1540   c=0:nogaps=TRUE

1550   WHILE nogaps AND c<tubwidth

1560     IF tub(c,r)=0 THEN nogaps=FALSE

1570     c+=1

1580   ENDWHILE

1590   IF nogaps THEN

1600     PROCscrolldown(r)

1610     score+=100:PRINTTAB(16,0);score

1620   ELSE

1630     r+=1

1640   ENDIF

1650 UNTIL r=tubheight

1660 ENDPROC

 

When a piece falls to the bottom of the container, it may complete one or more rows (up to four). PROCcheckrow systematically scans every row, from the bottom up. When it finds a completed row it calls PROCscrolldown to delete the row and shift down every block above it.

The player gains 100 points for each completed row.

 

1680 DEF PROCscrolldown(row)

1690 LOCAL r,c

1700 FOR r=row+1 TO tubheight-1

1710   FOR c=0 TO tubwidth-1

1720     tub(c,r-1)=tub(c,r)

1730     GCOL 0,tub(c,r-1):MOVE c*32,(r-1)*32:VDU 5,224,4

1740   NEXT

1750 NEXT

1760 ENDPROC

 

As described above, PROCscrolldown overwrites a completed row by copying the blocks, or empty spaces, from the row above. This process begins with the completed row, moving up one row at a time until it reaches the top of the container.

This process is applied to the graphical display and to the 'tub' array that holds the colour of each block. The player never sees the contents of the 'tub' array directly; this array is used to check that the current piece is free to move in a particular manner.

Arrow black large Arrow black large