Swell Foop (in C7420 Basic)

[gertk]

Just some small trial to convert one of my favorite strategy games: Swell Foop also know as 'Same Game' or 'Chain Shot!'
Here is a sneak preview.
It is already quite playable, but there is no end game detection yet.
Conversion to assembler should be possible but since it uses recursion originally to detect adjacent pieces ram space could be a problem. I tackled this by creating a 'stack' system. The program is not optimized at all. Use the joystick to move around, the piece which you are on is blinking. After pressing the fire button it will detect adjacent pieces and make them blink while recalculating the board. After that the board is redrawn.

Some info on how the rules are: http://library.gnome.org/users/swell-foop/stable/introduction.html.en

[gertk]

Use the source...

Code Select Expand

REM ASCII dump
01000 REM * Swell Foop Clone *
01010 REM * by gertk(at)xs4all.nl *
01020 MX=14:MY=9:NC=4
01030 INIT 0
01040 PRINTCHR$(150);
01050 SC=0
01500 SETET 37,"003e7f7f7f7f7f7f3e00"
02000 DIM BD(MX,MY)
02001 DIM SX(MX*MY),SY(MX*MY)
02005 REM * fill arry with numbers 1-4
02010 FOR T=0 TO MX
02020 FOR S=0 TO MY
02030 BD(T,S)=1+INT(RND(1)*NC)
02040 NEXT S
02050 NEXT T
02060 GOSUB 3000
02070 GOTO 4000
03000 REM* display board
03007 STORE
03008 M=0
03010 FOR U=0 TO MX
03020 FOR V=0 TO MY
03030 GOSUB 9100
03050 NEXT V
03060 NEXT U
03090 DISPLAY:SCREEN
03099 RETURN
04000 REM * now evaluate joystick
04010 S=0:T=0
04030 JY=ACTION(0):IF JY=0 THEN 4030
04035 M=0:GOSUB 9000
04040 IF JY AND 8 THEN S=S+1
04045 IF S>MY THEN S=MY
04050 IF JY AND 16 THEN S=S-1
04055 IF S<0 THEN S=0
04060 IF JY AND 2 THEN T=T+1
04065 IF T>MX THEN T=MX
04070 IF JY AND 4 THEN T=T-1
04075 IF T<0 THEN T=0
04076 M=1:GOSUB 9000
04077 IF JY AND 1 THEN 4500
04499 GOTO 4030
04500 PC=BD(T,S)
04507 FT=T:FS=S
04508 CN=1
04509 STORE
04510 GOSUB 5000
04515 TX 7,0,0
04520 CURSORY 10:CURSORX 34
04530 PRINT"Yield:";
04535 CURSORY 12:CURSORX 34
04537 PRINTCN;"  ";
04540 DISPLAY:SCREEN
04550 GOSUB 5100
04560 GOSUB 3000
04565 IF CN>1 THEN SC=SC+(CN-2)^2
04570 CURSORY 0:CURSORX 34
04580 TX 6,0,0
04581 PRINT"Score:";
04590 CURSORY 2:CURSORX 34
04600 PRINTSC;
04999 GOTO 4030
05000 REM clear stack
05005 SP=0
05007 REM search right
05010 X=FT+1:Y=FS:GOSUB 5500
05020 REM search left
05030 X=FT-1:Y=FS:GOSUB 5500
05040 REM search up
05050 X=FT:Y=FS-1:GOSUB 5500
05060 REM search down
05070 X=FT:Y=FS+1:GOSUB 5500
05080 IF BD(FT,FS)=0 THEN 5087
05083 REM if more than 1 piece found
05084 U=FT:V=FS:M=1:GOSUB 9100
05085 BD(FT,FS)=0
05087 IF SP=0 THEN RETURN
05090 SP=SP-1:FT=SX(SP):FS=SY(SP)
05095 GOTO 5010
05100 REM swoop or fall
05105 REM for all rows
05110 FOR X=0 TO MX
05119 REM start y at top
05120 Y=MY
05122 REM set max counter
05125 C=MY
05130 IF BD(X,Y)=0 THEN 5200
05140 Y=Y-1
05150 IF Y<1 THEN 5300
05160 GOTO 5130
05190 REM shift row down
05200 FOR Z=Y TO 1 STEP -1
05210 BD(X,Z)=BD(X,Z-1)
05220 NEXT Z
05225 BD(X,Z)=0
05230 C=C-1
05240 IF C>0 THEN 5130
05300 NEXT X
05310 REM now check for empty rows
05320 FOR X=0 TO MX-1
05324 REM limit maximum nr of shifts
05325 C=MX-X
05330 Y=0
05340 IF BD(X,Y) THEN 5470
05350 Y=Y+1:IF Y<=MY THEN 5340
05380 REM move rows left
05390 FOR Z=X TO MX-1
05400 FOR Y=0 TO MY
05410 BD(Z,Y)=BD(Z+1,Y)
05420 NEXT Y
05430 NEXT Z
05435 REM clear last row
05440 FOR Y=0 TO MY:BD(MX,Y)=0:NEXT Y
05450 REM check again
05460 C=C-1:IF C THEN 5330
05470 NEXT X
05499 RETURN
05500 REM clear if same else adjust sp
05510 IF Y>MY OR Y<0 THEN RETURN
05520 IF X>MX OR X<0 THEN RETURN
05530 IF BD(X,Y)<>PC THEN RETURN
05550 SX(SP)=X:SY(SP)=Y:SP=SP+1
05555 CN=CN+1
05560 RETURN
09000 REM display single piece
09001 STORE
09005 ET BD(T,S),3,M
09010 CURSORX T*2+1:CURSORY S*2
09020 PRINT"%%";
09030 CURSORX T*2+1:CURSORY S*2+1
09040 PRINT"%%";
09045 SCREEN:DISPLAY
09050 RETURN
09100 REM update single piece
09105 ET BD(U,V),3,M
09110 CURSORX U*2+1:CURSORY V*2
09120 PRINT"%%";
09130 CURSORX U*2+1:CURSORY V*2+1
09140 PRINT"%%";
09150 RETURN


[Rafael]

Starting the week with really hot news :D

Will possible to keep basic games saved on your multcart project?

[gertk]

Starting the week with really hot news :D

Will possible to keep basic games saved on your multcart project?

The Basic emulator part in the multicart will be the same as the C7420 emulator I did earlier (and which I tested this code on) and that cloads and csaves from and to the sd card. So basically yes 

[ccc---]

We need your multicart urgently gert  

[gertk]

Some cosmetic and program changes, some sound added and a visible 'cursor' when you are on an empty space, score and yield display, alas no endgame detection yet. The empty row detection must be optimized too, the game gets slower the emptier the board gets....

Code Select Expand


01000 REM Swell Foop for Videopac+                                              
01010 REM by gertk(at)xs4all.nl                                                
01020 REM board dimensions and nr. of colors                                        
01030 MX=14:MY=9:NC=3                                                          
01040 REM clear screen, disable status line                                
01050 INIT 0                                                                    
01060 PRINTCHR$(150);                                                          
01070 REM reset score                                                          
01080 SC=0                                                                      
01090 REM define graphics characters                                            
01100 SETET 37,"003e7f7f7f7f7f7f3e00"                                          
01110 SETET 38,"00412214080814224100"                                          
01120 DIM BD(MX,MY)                                                            
01130 REM pseudo stack for search                                              
01140 DIM SX(MX*MY),SY(MX*MY)                                                  
01150 REM fill array                                                            
01160 FOR X=0 TO MX                                                            
01170 FOR Y=0 TO MY                                                            
01180 BD(X,Y)=1+INT(RND(1)*NC)                                                  
01190 NEXT Y                                                                    
01200 NEXT X                                                                    
01210 PY=MY:PX=0                                                                
01220 REM main loop                                                            
01230 GOSUB 2440                                                                
01240 FOR T=1 TO 10:NEXT T                                                      
01250 SOUND 6                                                                  
01260 STORE                                                                    
01270 MD=1:DX=PX:DY=PY:GOSUB 2290                                              
01280 SCREEN:DISPLAY                                                            
01290 REM wait for joystick movement                                            
01300 JS=ACTION(0):IF JS=0 THEN 1300                                            
01310 REM action button pressed                                                
01320 IF JS AND 1 THEN 1470                                                    
01330 STORE                                                                    
01340 MD=0:DX=PX:DY=PY:GOSUB 2290                                              
01350 SCREEN:DISPLAY                                                            
01360 REM check directional movement                                            
01370 IF JS AND 8 THEN PY=PY+1                                                  
01380 IF PY>MY THEN PY=MY                                                      
01390 IF JS AND 16 THEN PY=PY-1                                                
01400 IF PY<0 THEN PY=0                                                        
01410 IF JS AND 2 THEN PX=PX+1                                                  
01420 IF PX>MX THEN PX=MX                                                      
01430 IF JS AND 4 THEN PX=PX-1                                                  
01440 IF PX<0 THEN PX=0                                                        
01450 GOTO 1260                                                                
01460 REM action !                                                              
01470 FC=BD(PX,PY)                                                              
01480 REM check for empty space                                                
01490 IF FC=0 THEN SOUND 5:GOTO 1260                                            
01500 REM set search coordinates                                                
01510 FX=PX:FY=PY                                                              
01520 REM reset yield                                                          
01530 YD=0                                                                      
01540 STORE                                                                    
01550 GOSUB 1760                                                                
01560 SOUND 1                                                                  
01570 REM show yield in double height                                          
01580 TX 7,1,0                                                                  
01590 CURSORY 10:CURSORX 33                                                    
01600 PRINT"Yield:";                                                            
01610 CURSORY 11:CURSORX 33                                                    
01620 PRINT"Yield:";                                                            
01630 CURSORY 12:CURSORX 33                                                    
01640 PRINT STR$(YD);"  ";                                                      
01650 CURSORY 13:CURSORX 33                                                    
01660 PRINT STR$(YD);"  ";                                                      
01670 REM force screen update and redraw                                        
01680 DISPLAY:SCREEN                                                            
01690 REM check fall or swoop                                                  
01700 GOSUB 1880                                                                
01710 REM calculate score                                                      
01720 IF YD<2 THEN SOUND 8:GOTO 1230                                            
01730 SC=SC+(YD-2)^2                                                            
01740 GOTO 1230                                                                
01750 REM search start                                                          
01760 SP=0                                                                      
01770 REM searchloop                                                            
01780 X=FX+1:Y=FY:GOSUB 2180                                                    
01790 X=FX-1:Y=FY:GOSUB 2180                                                    
01800 X=FX:Y=FY-1:GOSUB 2180                                                    
01810 X=FX:Y=FY+1:GOSUB 2180                                                    
01820 REM if no adjacent pieces found                                          
01830 IF SP=0 THEN RETURN                                                      
01840 REM get next coordinates from stack                                        
01850 FX=SX(SP):FY=SY(SP):SP=SP-1                                              
01860 GOTO 1780                                                                
01870 REM swoop or fall                                                        
01880 FOR X=0 TO MX                                                            
01890 Y=MY                                                                      
01900 CC=MY                                                                    
01910 IF BD(X,Y)=0 THEN 1950                                                    
01920 Y=Y-1                                                                    
01930 IF Y<1 THEN 2010                                                          
01940 GOTO 1910                                                                
01950 FOR Z=Y TO 1 STEP -1                                                      
01960 BD(X,Z)=BD(X,Z-1)                                                        
01970 NEXT Z                                                                    
01980 BD(X,Z)=0                                                                
01990 CC=CC-1                                                                  
02000 IF CC>0 THEN 1910                                                        
02010 NEXT X                                                                    
02020 REM check for empty rows                                                  
02030 FOR X=0 TO MX-1                                                          
02040 C=MX-X                                                                    
02050 Y=0                                                                      
02060 IF BD(X,Y) THEN 2150                                                      
02070 Y=Y+1:IF Y<=MY THEN 2060                                                  
02080 FOR Z=X TO MX-1                                                          
02090 FOR Y=0 TO MY                                                            
02100 BD(Z,Y)=BD(Z+1,Y)                                                        
02110 NEXT Y                                                                    
02120 NEXT Z                                                                    
02130 FOR Y=0 TO MY:BD(MX,Y)=0:NEXT Y                                          
02140 C=C-1:IF C THEN 2050                                                      
02150 NEXT X                                                                    
02160 RETURN                                                                    
02170 REM check limits and piece for color                                        
02180 IF Y>MY OR Y<0 THEN RETURN                                                
02190 IF X>MX OR X<0 THEN RETURN                                                
02200 IF BD(X,Y)<>FC THEN RETURN                                                
02210 REM found same color, push on stack                                        
02220 SP=SP+1:SX(SP)=X:SY(SP)=Y                                                
02230 DX=X:DY=Y:MD=1:GOSUB 2290                                                
02240 BD(X,Y)=0                                                                
02250 REM increase yield counter                                                
02260 YD=YD+1                                                                  
02270 RETURN                                                                    
02280 REM display white cross if empty                                          
02290 IF BD(DX,DY) THEN 2370                                                    
02300 ET 7*MD,3,MD                                                              
02310 CURSORX DX*2+1:CURSORY DY*2                                              
02320 PRINT"&&";                                                                
02330 CURSORX DX*2+1:CURSORY DY*2+1                                            
02340 PRINT"&&";                                                                
02350 RETURN                                                                    
02360 REM display single piece                                                  
02370 ET BD(DX,DY),3,MD                                                        
02380 CURSORX DX*2+1:CURSORY DY*2                                              
02390 PRINT"%%";                                                                
02400 CURSORX DX*2+1:CURSORY DY*2+1                                            
02410 PRINT"%%";                                                                
02420 RETURN                                                                    
02430 REM draw board                                                            
02440 STORE                                                                    
02450 REM display score                                                        
02460 CURSORY 0:CURSORX 33                                                      
02470 TX 6,1,0                                                                  
02480 PRINT"Score:";                                                            
02490 CURSORY 1:CURSORX 33                                                      
02500 PRINT"Score:";                                                            
02510 CURSORY 2:CURSORX 33                                                      
02520 PRINT STR$(SC);                                                          
02530 CURSORY 3:CURSORX 33                                                      
02540 PRINT STR$(SC);                                                          
02550 REM draw all pieces in mode 0                                            
02560 MD=0                                                                      
02570 FOR DX=0 TO MX                                                            
02580 FOR DY=0 TO MY                                                            
02590 GOSUB 2370                                                                
02600 NEXT DY                                                                  
02610 NEXT DX                                                                  
02620 DISPLAY:SCREEN                                                            
02630 RETURN                    


[gertk]

Maybe someone could try this binary basic file of swell_foop in Windows o2em.

In the Linux version 120B5 I keep struggling with the keyboard and joysticks on the laptop (scroll lock is not recognized so I can not disable the joysticks).

If I read in this .k7 file with F9 key it seems to run OK but if I try to LIST it crashes the output.

Could be that my converter from text to binary messes up but I tried to read in the text version in o2em but it needs a header of some sort. Even with the header attached it makes a mess of LIST...
Would be nice to have a uniform format for Basic binaries or have o2em read in headerless basic sources.

[manopac]

Hey

I was able to load and run it using quickload, I did have a problem listing it though ... I think I also found out why - all your basic-lines have lots of trailing spaces, which seem to confuse the interpreter ... (look into the binary and you will find lots of 0x20 at the end of each line) - actually the same thing happend when I took the sourcecode from your previous post and pasted it into a text-file - yes, this works :-)
O2EM can just load a textfile without a header ... what I had to do (using a texteditor) was deleting all the trailing spaces of each line ... see above :-)

there are still some small differences between Quickload and using CLOAD btw, I still need to figure those out and eliminate them, to make it work better ...

[gertk]

Hey

I was able to load and run it using quickload, I did have a problem listing it though ... I think I also found out why - all your basic-lines have lots of trailing spaces, which seem to confuse the interpreter ... (look into the binary and you will find lots of 0x20 at the end of each line) - actually the same thing happend when I took the sourcecode from your previous post and pasted it into a text-file - yes, this works :-)

O2EM can just load a textfile without a header ... what I had to do (using a texteditor) was deleting all the trailing spaces of each line ... see above :-)

Ah, that explains a lot. The source which I copy/pasted to the forum came from the terminal (the ASCII dump function) and that might also explain the whitespace. I will modify the converter to trim these spaces off.

there are still some small differences between Quickload and using CLOAD btw, I still need to figure those out and eliminate them, to make it work better ...

I am contemplating a similar system for the multicart: let the LPC do the testing for binary/ascii of the requested file so you can use source code and binaries. Too bad in C7420 Basic you can only use 6 characters for the filename, maybe I can catch that function and use longer filenames with extensions.

Anyway, thanks for testing!

[gertk]

Just cleaned up the converter and it creates better binaries now. Still your C7420 seems to dislike the last line.
I tried with the converted binary and a clean basic source code file.

As soon as the last line is LIST-ed the emulator starts to act goofy: screen starts to flash and becomes unresponsive.
The last line being line 2630 and that line number is displayed twice.

Could this have anything to do with the length of the program calculation ? I am not sure if this length value is in- or excluding the filler bytes at the end (the 10 bytes 0x00)

Another small bug is that when I load the source code file (swell.lst) in o2em with F9, in REM statements the keywords are converted to uppercase. I downloaded the windows o2em zip version from the link in the forum and ran it with Wine.

Attached are both the new binary and the source (.lst)

[Rafael]

Here I had error on 1100

Edit: Anyway the .k7 work nice

[gertk]

Here I had error on 1100

Hmm.. which version of o2em did you use ?

Edit: Anyway the .k7 work nice

Thanks, the search routine and the dropping down/shifting empty rows can be optimized a lot and then it will be perfectly playable.

[manopac]

Here I had error on 1100

Hmm.. which version of o2em did you use ?

I think it was the long lines problem - for me it also got a syntax error in 1100 with the long lines, after trimming it worked

I guess I will have to rework the migration code in O2EM to trim a line before reading it, which is a big change, as I read the file currently byte by byte, not line by line ;-)

[Rafael]

[Hmm.. which version of o2em did you use ?

Hi, I tested in version 1.20.01b and 1.20b5.

[gertk]

This one is fully working, let me know what you think of this game.

Code Select Expand


1000 REM Swell Foop for Videopac+
1010 REM by gertk(at)xs4all.nl
1020 REM clear screen, disable status line
1030 INIT 0
1040 PRINTCHR$(150);
1050 STORE
1060 TX 2,3,0
1070 PRINT "VViiddeeooppaacc  ";
1080 PRINT "CC77442200"
1090 PRINT "VViiddeeooppaacc  ";
1100 PRINT "CC77442200"
1110 TX 3,3,0
1120 PRINT
1130 PRINT
1140 PRINT "SSwweellll  FFoooopp"
1150 PRINT "SSwweellll  FFoooopp"
1160 PRINT
1170 PRINT
1180 TX 4,0,0
1190 PRINT "(c)2012 gertk@xs4all.nl";
1200 DISPLAY:SCREEN
1210 GOSUB 3570
1220 INIT 0
1230 PRINTCHR$(150);
1240 STORE
1250 TX 7,0,0
1260 PRINT "Swell Foop is a puzzle ";
1270 PRINT "game."
1280 PRINT
1290 PRINT "The goal is to remove";
1300 PRINT " as many objects"
1310 PRINT "as possible in ";
1320 PRINT "as few moves as"
1330 PRINT "possible."
1340 PRINT "Objects adjacent to each";
1350 PRINT " other get"
1360 PRINT "removed as as a group."
1370 PRINT "The remaining objects";
1380 PRINT " then collapse"
1390 PRINT "to fill in the gaps and";
1400 PRINT " new groups are"
1410 PRINT "formed."
1420 PRINT "You cannot remove single";
1430 PRINT " objects."
1440 PRINT
1450 REM reset score
1460 SC=0
1470 REM board dimensions and nr. of colors
1480 MX=14:MY=9:NC=3
1490 REM define graphics characters
1500 SETET 37,"003e7f7f7f7f7f7f3e00"
1510 SETET 38,"00412214080814224100"
1520 DIM BD(MX,MY)
1530 REM pseudo stack for search
1540 DIM SX(MX*MY),SY(MX*MY)
1550 REM fill array
1560 FOR X=0 TO MX
1570 FOR Y=0 TO MY
1580 BD(X,Y)=1+INT(RND(1)*NC)
1590 NEXT Y
1600 NEXT X
1610 PY=MY:PX=0
1620 EX=MX
1630 TX 2,0,0
1640 PRINT "press button to start.."
1650 DISPLAY:SCREEN
1660 GOSUB 3570
1670 INIT 0
1680 PRINTCHR$(150);
1690 REM main loop
1700 GOSUB 2990
1710 GOSUB 3190
1720 SOUND 6
1730 STORE
1740 MD=1:DX=PX:DY=PY:GOSUB 2840
1750 SCREEN:DISPLAY
1760 REM wait for joystick movement
1770 JS=ACTION(0):IF JS=0 THEN 1770
1780 REM action button pressed
1790 IF JS AND 1 THEN 1940
1800 STORE
1810 MD=0:DX=PX:DY=PY:GOSUB 2840
1820 SCREEN:DISPLAY
1830 REM check directional movement
1840 IF JS AND 8 THEN PY=PY+1
1850 IF PY>MY THEN PY=MY
1860 IF JS AND 16 THEN PY=PY-1
1870 IF PY<0 THEN PY=0
1880 IF JS AND 2 THEN PX=PX+1
1890 IF PX>MX THEN PX=MX
1900 IF JS AND 4 THEN PX=PX-1
1910 IF PX<0 THEN PX=0
1920 GOTO 1730
1930 REM action !
1940 FC=BD(PX,PY)
1950 REM check for empty space
1960 IF FC=0 THEN SOUND 5:GOTO 1730
1970 REM set search coordinates
1980 FX=PX:FY=PY
1990 REM reset yield
2000 YD=0
2010 STORE
2020 GOSUB 2230
2030 SOUND 1
2040 REM show yield in double height
2050 TX 7,1,0
2060 CURSORY 10:CURSORX 33
2070 PRINT"Yield:";
2080 CURSORY 11:CURSORX 33
2090 PRINT"Yield:";
2100 CURSORY 12:CURSORX 33
2110 PRINT STR$(YD);"  ";
2120 CURSORY 13:CURSORX 33
2130 PRINT STR$(YD);"  ";
2140 REM force screen update and redraw
2150 DISPLAY:SCREEN
2160 REM check fall or swoop
2170 GOSUB 2350
2180 REM calculate score
2190 IF YD<2 THEN SOUND 8:GOTO 1730
2200 SC=SC+(YD-2)^2
2210 GOTO 1700
2220 REM search start
2230 SP=0
2240 REM searchloop
2250 X=FX+1:Y=FY:GOSUB 2730
2260 X=FX-1:Y=FY:GOSUB 2730
2270 X=FX:Y=FY-1:GOSUB 2730
2280 X=FX:Y=FY+1:GOSUB 2730
2290 REM if no adjacent pieces found
2300 IF SP=0 THEN RETURN
2310 REM get next coordinates from stack
2320 FX=SX(SP):FY=SY(SP):SP=SP-1
2330 GOTO 2250
2340 REM swoop or fall
2350 FOR X=0 TO EX
2360 Y=MY
2370 CC=0
2380 IF BD(X,Y)=0 THEN 2430
2390 IF CC>0 THEN 2450
2400 Y=Y-1
2410 IF Y<0 THEN 2530
2420 GOTO 2380
2430 CC=CC+1
2440 GOTO 2400
2450 FOR Z=Y TO 0 STEP -1
2460 BD(X,Z+CC)=BD(X,Z)
2470 NEXT Z
2480 Y=Y+CC
2490 CC=CC-1
2500 BD(X,CC)=0
2510 IF CC=0 THEN 2400
2520 GOTO 2490
2530 NEXT X
2540 REM check for empty rows
2550 X=0
2560 IF BD(X,MY) THEN 2690
2570 IF X>EX THEN 2710
2580 FOR S=X TO EX-1
2590 FOR T=0 TO MY
2600 BD(S,T)=BD(S+1,T)
2610 NEXT T
2620 NEXT S
2630 FOR T=0 TO MY
2640 BD(EX,T)=0
2650 NEXT T
2660 EX=EX-1
2670 if EX<0 THEN 2710
2680 GOTO 2560
2690 X=X+1
2700 IF X<EX THEN 2560
2710 RETURN
2720 REM check limits and piece for color
2730 IF Y>MY OR Y<0 THEN RETURN
2740 IF X>EX OR X<0 THEN RETURN
2750 IF BD(X,Y)<>FC THEN RETURN
2760 REM found same color, push on stack
2770 SP=SP+1:SX(SP)=X:SY(SP)=Y
2780 DX=X:DY=Y:MD=1:GOSUB 2840
2790 BD(X,Y)=0
2800 REM increase yield counter
2810 YD=YD+1
2820 RETURN
2830 REM display white cross if empty
2840 IF BD(DX,DY) THEN 2920
2850 ET 7*MD,3,MD
2860 CURSORX DX*2+1:CURSORY DY*2
2870 PRINT"&&";
2880 CURSORX DX*2+1:CURSORY DY*2+1
2890 PRINT"&&";
2900 RETURN
2910 REM display single piece
2920 ET BD(DX,DY),3,MD
2930 CURSORX DX*2+1:CURSORY DY*2
2940 PRINT"%%";
2950 CURSORX DX*2+1:CURSORY DY*2+1
2960 PRINT"%%";
2970 RETURN
2980 REM draw board
2990 STORE
3000 REM display score
3010 CURSORY 0:CURSORX 33
3020 TX 6,1,0
3030 PRINT"Score:";
3040 CURSORY 1:CURSORX 33
3050 PRINT"Score:";
3060 CURSORY 2:CURSORX 33
3070 PRINT STR$(SC);
3080 CURSORY 3:CURSORX 33
3090 PRINT STR$(SC);
3100 REM draw all pieces in mode 0
3110 MD=0
3120 FOR DY=0 TO MY
3130 FOR DX=0 TO MX
3140 GOSUB 2920
3150 NEXT DX
3160 NEXT DY
3170 DISPLAY:SCREEN
3180 RETURN
3190 X=0
3200 Y=MY
3210 C=0
3220 IF BD(X,Y)=0 THEN 3280
3230 GOSUB 3320
3240 IF C>0 THEN RETURN
3250 Y=Y-1
3260 IF Y>=0 THEN 3210
3270 GOTO 3290
3280 IF X=0 AND Y=MY THEN 3440
3290 X=X+1
3300 IF X>EX THEN 3450
3310 GOTO 3200
3320 FC=BD(X,Y)
3330 IF (X-1)<0 THEN 3350
3340 IF BD(X-1,Y)=FC THEN 3420
3350 IF (X+1)>EX THEN 3370
3360 IF BD(X+1,Y)=FC THEN 3420
3370 IF (Y-1)<0 THEN 3390
3380 IF BD(X,Y-1)=FC THEN 3420
3390 IF (Y+1)>MY THEN 3410
3400 IF BD(X,Y+1)=FC THEN 3420
3410 RETURN
3420 C=C+1
3430 RETURN
3440 SC=SC+1000
3450 TX 6,1,0
3460 CURSORY 2:CURSORX 33
3470 PRINT STR$(SC);
3480 CURSORY 3:CURSORX 33
3490 PRINT STR$(SC);
3500 TX 2,1,1
3510 CURSORY 4:CURSORX 10
3520 PRINT "GAME OVER";
3530 CURSORY 5:CURSORX 10
3540 PRINT "GAME OVER"
3550 GOSUB 3570
3560 RUN
3570 JS=ACTION(0)
3580 IF JS<>0 THEN 3570
3590 JS=ACTION(0)
3600 IF (JS AND 1)=0 THEN 3590
3610 RETURN
3620 END