This game, based on one written by Chris Callender, is somehwat like Draughts, except that the board measures nine squares by eight, rather than eight by eight. Captures are made like pawn captures in Chess. That is, you move diagonally and land on top of an opponent's piece in order to capture it. All moves are on the white squares, diagonally in any direction. There are no multiple jumps.
You have the first move, and the winner is the first player to capture six of the opponent's pieces. You're playing from the bottom of the screen and the BBC Micro is playing down from the top.
You move by entering the number down the side relating to the square you're moving from, and then the number across the bottom of the relevant square. Then you follow the same process for the square you're moving to. Only legal moves are accepted.
10 REM NINE x EIGHT 20 30 MODE 1 40 PROC_init 50 REPEAT 60 PROC_new_game 70 REPEAT 80 PROC_board 90 PROC_your_go 100 PROC_board 110 PROC_my_go 120 UNTIL Myscore=6 OR Yourscore=6 130 PROC_board 140 UNTIL NOT FN_another 150 MODE 7 160 END 170 180 DEF PROC_init 190 VDU 23,0,10,32,0;0;0; 200 VDU 23,128,-1,-1,-1,-1,-1,-1,-1,-1 210 VDU 23,129,0,0,0,1,3,7,&F,&1E 220 VDU 23,130,0,0,-1,-1,-1,-1,0,0 230 VDU 23,131,0,0,0,&80,&C0,&E0,&F0,& 78 240 VDU 23,132,&3C,&3C,&3C,&3C,&3C,&3C ,&3C,&3C 250 VDU 23,133,0,&18,&3C,&7E,&7E,&3C,& 18,0 260 VDU 23,134,&1E,&F,7,3,1,0,0,0 270 VDU 23,135,&78,&F0,&E0,&C0,&80,0,0 ,0 280 DIM S$(10,11) 290 VDU 19,3,6,0,0,0 300 ENDPROC 310 320 DEF PROC_new_game 330 RESTORE 340 FOR Y%=1 TO 10 350 READ R$ 360 FOR X%=1 TO 11 370 S$(Y%,X%)=MID$(R$,X%,1) 380 NEXT X% 390 NEXT Y% 400 Myscore=0:Yourscore=0 410 CLS 420 ENDPROC 430 440 DEF PROC_board 450 LOCAL X%,Y% 460 FOR Y%=0 TO 9 470 FOR X%=0 TO 10 480 PRINT TAB(X%*3,Y%*3); 490 PROC_square(S$(Y%+1,X%+1)) 500 NEXT X% 510 NEXT Y% 520 COLOUR 2:COLOUR 129 530 PRINT TAB(34,1);"9 x 8"; 540 COLOUR 1:COLOUR 128 550 PRINT TAB(34,27);"Me ";Myscore 560 COLOUR 2 570 PRINT TAB(34,29);"You ";Yourscore 580 ENDPROC 590 600 DEF PROC_square(C$) 610 IF C$<"J" PROC_side(C$) 620 IF C$="x" COLOUR 1:PROC_piece 630 IF C$="o" COLOUR 2:PROC_piece 640 IF C$="[fs0]" COLOUR 3:PROC_block 650 ENDPROC 660 670 DEF PROC_side(N$) 680 COLOUR 2:COLOUR 129 690 IF N$=" " THEN COLOUR 128 700 PRINT "[spc3]";TAB(POS-3,VPOS+1);" ";N$;" ";TAB(POS-3,VPOS+1);"[spc3]"; 710 ENDPROC 720 730 DEF PROC_block 740 IF X%=0 OR X%=10 THEN COLOUR 1:COL OUR 130 750 PRINT"[fs0][fs0][fs0]";TAB(POS-3,V POS+1);"[fs0][fs0][fs0]";TAB(POS-3,VPOS+ 1);"[fs0][fs0][fs0]"; 760 ENDPROC 770 780 DEF PROC_piece 790 COLOUR 128 800 PRINT"[fs1][fs2][fs3]";TAB(POS-3,V POS+1);"[fs4][fs5][fs4]";TAB(POS-3,VPOS+ 1);"[fs6][fs2][fs7]" 810 ENDPROC 820 830 DEF PROC_your_go 840 COLOUR 2 850 VDU 28,33,26,39,3,12,26 860 PRINT TAB(33,6);"Your go" 870 PRINT TAB(34,8);"FROM?" 880 REPEAT 890 COLOUR 1 900 PRINT TAB(35,10); 910 from$=FN_move 920 X%=ASC(from$)-63:Y%=VAL(RIGHT$(f rom$,1))+1 930 IF S$(Y%,X%)="o" THEN 980 940 VDU 7 950 PRINT TAB(33,10);"ILLEGAL"; 960 PROC_delay(200) 970 PRINT TAB(33,10);"[spc7]"; 980 UNTIL S$(Y%,X%)="o" 990 COLOUR 2 1000 PRINT TAB(35,12);"TO?" 1010 REPEAT 1020 COLOUR 1 1030 PRINT TAB(35,14); 1040 to$=FN_move 1050 X1%=ASC(to$)-63:Y1%=VAL(RIGHT$(t o$,1))+1 1060 IF S$(Y1%,X1%)<>"o" AND ABS(X%-X 1%)=1 AND ABS(Y%-Y1%)=1 THEN 1110 1070 VDU 7 1080 PRINT TAB(33,14);"ILLEGAL"; 1090 PROC_delay(200) 1100 PRINT TAB(33,14);"[spc7]"; 1110 UNTIL S$(Y1%,X1%)<>"o" AND ABS(X %-X1%)=1 AND ABS(Y%-Y1%)=1 1120 IF S$(Y1%,X1%)="x" THEN Yourscore= Yourscore+1 1130 S$(Y%,X%)=" ":S$(Y1%,X1%)="o" 1140 SOUND 2,-10,101,5:SOUND 2,-10,84,5 1150 ENDPROC 1160 1170 DEF PROC_my_go 1180 VDU 28,33,26,39,3,12,26 1190 COLOUR 2 1200 PRINT TAB(34,6);"MY GO" 1210 IF Yourscore=6 THEN ENDPROC 1220 A$="o":PROC_think 1230 IF FL%<>1 THEN A$=" ":PROC_think 1240 S$(E%,F%)=" " 1250 IF S$(E%+G%,F%+H%)="o" THEN Myscor e=Myscore+1 1260 S$(E%+G%,F%+H%)="x" 1270 SOUND 2,-10,84,5:SOUND 2,-10,101,5 1280 ENDPROC 1290 1300 DEF PROC_think 1310 PRINT TAB(34,8);"Think" 1320 E%=RND(4)+1:F%=RND(2)+1:G%=0:H%=0 1330 FL%=0 1340 IF S$(E%,F%)<>"x" THEN 1400 1350 IF S$(E%+1,F%+1)=A$ THEN G%=1:H%=1 1360 IF S$(E%+1,F%-1)=A$ THEN G%=1:H%=- 1 1370 IF S$(E%-1,F%+1)=A$ THEN G%=-1:H%= 1 1380 IF S$(E%-1,F%-1)=A$ THEN G%=-1:H%= -1 1390 IF G%<>0 AND H%<>0 THEN FL%=1:GOTO 1430 1400 E%=E%+1:IF E%>9 THEN E%=2:F%=F%+1 1410 IF F%>10 THEN 1430 1420 GOTO 1330 1430 PRINT TAB(34,8);"[spc5]" 1440 ENDPROC 1450 1460 DEF FN_another 1470 VDU 28,33,26,39,3,12 1480 COLOUR 3 1490 IF Myscore=6 THEN PRINT"I WON" ELS E PRINT"YOU WON" 1500 COLOUR 1 1510 PRINT''"Again?"; 1520 REPEAT K$=FNkey 1530 UNTIL K$="Y" OR K$="N" 1540 VDU 26,12 1550 =(K$="Y") 1560 1570 DEF PROC_delay(centi) 1580 TIME=0 1590 REPEAT UNTIL TIME>=centi 1600 ENDPROC 1610 END 1620 1630 DEF FN_move 1640 LOCAL key$,key$,move$ 1650 REPEAT key$=FNkey 1660 IF key$<"A" OR key$>"I" THEN VDU 7 1670 UNTIL key$>="A" AND key$<="I" 1680 PRINT key$;:move$=key$ 1690 REPEAT key$=FNkey 1700 IF (key$<"1" OR key$>"8") AND ke y$<>CHR$(127) THEN VDU7 1710 UNTIL (key$>="1" AND key$<="8") OR key$=CHR$(127) 1720 IF key$=CHR$(127) VDU127:GOTO 1660 1730 PRINT key$;:move$=LEFT$(move$,1)+k ey$ 1740 REPEAT key%=GET 1750 IF key%<>13 AND key%<>127 THEN V DU 7 1760 UNTIL key%=13 OR key%=127 1770 IF key%=127 THEN VDU127:GOTO 1690 1780 =move$ 1790 1800 DEF FNkey 1810 *FX 15 1 1820 LOCAL Key% 1830 Key%=GET 1840 IF Key%>96 AND Key%<127 THEN Key%= Key%-32 1850 =CHR$(Key%) 1860 1870 DATA "[fs0]ABCDEFGHI[fs0]" 1880 DATA "1x[fs0]x[fs0]x[fs0]x[fs0]x1" 1890 DATA "2[fs0]x[fs0]x[fs0]x[fs0]x[fs 0]2" 1900 DATA "3x[fs0]x[fs0] [fs0]x[fs0]x3" 1910 DATA "4[fs0] [fs0]x[fs0] [fs0] [fs 0]4" 1920 DATA "5 [fs0] [fs0] [fs0] [fs0] 5" 1930 DATA "6[fs0]o[fs0]o[fs0]o[fs0]o[fs 0]6" 1940 DATA "7o[fs0]o[fs0]o[fs0]o[fs0]o7" 1950 DATA "8[fs0]o[fs0]o[fs0]o[fs0]o[fs 0]8" 1960 DATA "[fs0]ABCDEFGHI[fs0]"
Mandala
Based on Draughts, this game pits you (the round, mandala-like pieces) against the BBC Micro's pieces (which look a little like Chess knights). You move diagonally, as in Draughts, and you capture by jumping over the opponent's piece into an empty square beyond. There are no multiple jumps. Each piece can move in any direction (that is, forwards or backwards on the diagonal).
You start off in the corner of the board, rather than along the sides as in ordinary Draughts. You defeat your trusty BBC Micro if you manage to capture seven of its pieces before it manages to capture seven of yours. The computer will concede the game if it decides you have such a lead that it could never catch up.
You'll find the game runs very quickly, and the computer's response time increases a little as the game progresses. You move by entering a four-digit number, made up from the number across the top then down the side of the piece you're moving, then the number across the top then down the side of the square you're moving to.
Note that this program uses speech, if fitted, speaking the moves. Due to the length of the program, you must set page to &E00. You do this by entering, as a direct command, PAGE=&E00 before you enter or load the program.
10 REM MANDALA 20 ON ERROR GOTO 2580 30 MODE 1 40 PROC_initialise 50 REPEAT 60 PROC_newgame 70 PROC_drawboard 80 ON ERROR GOTO 2570 90 REPEAT 100 PROC_humanmove:PROC_wait 110 PROC_computermove:PROC_wait 120 UNTIL human=7 OR computer=7 130 UNTIL NOT FN_anothergame 140 MODE 7 150 END 160 DEF PROC_humanmove 170 COLOUR 1:COLOUR 131 180 PRINT TAB(33,8);"Your";TAB(33,9);" Move" 190 PROCspeak(290):PROCspeak(272):PROC speak(128) 200 COLOUR 1:COLOUR 131:PRINT TAB(33,1 2);"From":COLOUR 128:PROCspeak(200) 210 VDU 31,34,13,32,32,8,8 220 from$=FN_move 230 xfrom=ASC(LEFT$(from$,1))-64 240 yfrom=VAL(RIGHT$(from$,1)) 250 IF A%(10*xfrom+yfrom)<>mandala THE N PROC_retry:GOTO 200 260 COLOUR 131:PRINT TAB(33,15);" To " :COLOUR 128:PROCspeak(ASC"2") 270 VDU 31,34,16,32,32,8,8 280 to$=FN_move 290 xto=ASC(LEFT$(to$,1))-64 300 yto=VAL(RIGHT$(to$,1)) 310 IF (xto MOD2<>yto MOD2)THEN PROC_r etry:GOTO 200 320 IF (yto-yfrom)<0 THEN PROC_retry:G OTO 200 330 IF A%(10*xto+yto)<>blank PROC_retr y:GOTO 200 340 IF ABS(xfrom-xto)<>1 THEN 410 350 A%(10*xfrom+yfrom)=blank:A%(10*xto +yto)=mandala 360 COLOUR 1 370 PROC_mandala(xto,yto) 380 COLOUR 0 390 PROC_square(xfrom,yfrom) 400 ENDPROC 410 IF A%((10*xto+yto+10*xfrom+yfrom)/ 2)<>knight THEN PROC_retry:GOTO 200 420 human=human+1 430 PROCspeak(275):PROCspeak(228):PROC speak(204):PROCspeak(65):PROCspeak(257): PROCspeak(232):PROCspeak(48+human) 440 A%((10*xto+yto+10*xfrom+yfrom)/2)= blank 450 COLOUR 1 460 PROC_mandala(xto,yto) 470 COLOUR 0 480 PROC_square(xfrom,yfrom) 490 A%(10*xfrom+yfrom)=blank:A%(10*xto +yto)=mandala 500 PROC_square(xfrom+(xto-xfrom)-SGN( xto-xfrom),yfrom+(yto-yfrom)-SGN(yto-yfr om)) 510 COLOUR 1 520 PRINT TAB(32,3);"YOU : ";human 530 ENDPROC 540 DEF PROC_computermove 550 COLOUR 2:COLOUR 131 560 PRINT TAB(33,8);" My ";TAB(33,9);" Move":PROCspeak(ASC"I"):PROCspeak(272):P ROCspeak(228) 570 FOR Z%=88 TO 1 STEP -1 580 IF A%(Z%)<>knight THEN 640 590 Y%=-11:FLAG=0 600 IF Z%+Y%>88 OR Z%+Y%<11 OR Z%+2* Y%>88 OR Z%+2*Y%<11 THEN 620 610 IF A%(Z%+Y%)=mandala AND A%(Z%+2 *Y%)=blank THEN FLAG=Z%:Z%=1:GOTO 640 620 Y%=-9*(Y%=-11)+9*(Y%=-9)+10*(Y%= 11)+(Y%=100) 630 IF Y%<>0 THEN 600 640 NEXT Z% 650 IF FLAG=0 THEN 870 660 Z%=FLAG 670 A%(Z%)=blank 680 A%(Z%+Y%)=blank 690 A%(Z%+2*Y%)=knight 700 computer=computer+1 710 COLOUR 128:PRINT TAB(32,4);"ME : ";computer 720 xfrom=INT(Z%/10):yfrom=Z%-10*xfrom 730 xdel=INT((Z%+Y%)/10):ydel=Z%+Y%-10 *xdel 740 PROCspeak(200):PROCspeak(64+xfrom) :PROCspeak(48+yfrom) 750 PRINT TAB(34,13);CHR$(64+xfrom);yf rom 760 COLOUR 2 770 xto=INT((Z%+2*Y%)/10):yto=Z%+2*Y%- 10*xto 780 PROCspeak(ASC"2"):PROCspeak(64+xto ):PROCspeak(48+yto) 790 PRINT TAB(34,16);CHR$(64+xto);yto 800 PROC_knight(xto,yto) 810 COLOUR 0 820 PROC_square(xfrom,yfrom) 830 PROC_square(xdel,ydel) 840 COLOUR 2 850 PROCspeak(ASC"I"):PROCspeak(228):P ROCspeak(204):PROCspeak(65):PROCspeak(25 7):PROCspeak(232):PROCspeak(48+computer) 860 ENDPROC 870 Q%=1 880 FOR Z%=Q% TO 200 890 K%=RND(77)+12 900 IF A%(K%)<>knight THEN 960 910 Y%=-11:FLAG=0 920 IF K%+Y%<11 OR K%+Y%>88 THEN 960 930 IF A%(K%+Y%)=blank THEN FLAG=Z%: Z%=200:GOTO 960 940 Y%=-9*(Y%=-11)+9*(Y%=-9)+10*(Y%= 11)+(Y%=100) 950 IF Y%<>0 THEN 920 960 NEXT Z% 970 IF FLAG=0 THEN 1190 980 Z%=FLAG 990 IF K%+2*Y%>88 OR K%+2*Y%<11 THEN 1 040 1000 IF A%(K%+2*Y%)=mandala THEN 870 1010 IF K%-2*Y%<11 OR K%-2*Y%>88 THEN 1 040 1020 IF A%(K%-2*Y%)=mandala THEN 870 1030 IF A%(K%+Y%)<>blank OR A%(K%)<>kni ght THEN 880 1040 xto=INT((K%+Y%)/10):yto=K%+Y%-10*x to 1050 xfrom=INT(K%/10):yfrom=K%-10*xfrom 1060 IF xto<1 OR xto>8 THEN 870 1070 IF yto<1 PR yto>8 THEN 870 1080 IF (xto MOD 2)<>(yto MOD 2) THEN 8 70 1090 A%(K%+Y%)=knight:A%(K%)=blank 1100 COLOUR 2:COLOUR 128 1110 PROCspeak(200):PROCspeak(64+xfrom) :PROCspeak(48+yfrom) 1120 PRINT TAB(34,13);CHR$(64+xfrom);yf rom 1130 PROCspeak(ASC"2"):PROCspeak(64+xto ):PROCspeak(48+yto) 1140 PRINT TAB(34,16);CHR$(64+xto);yto 1150 PROC_knight(xto,yto) 1160 COLOUR 0 1170 PROC_square(xfrom,yfrom) 1180 ENDPROC 1190 FOR G%=1 TO 200 1200 K%=RND(77)+11 1210 FLAG=FALSE 1220 IF A%(K%)=knight THEN G%=200:FLA G=TRUE 1230 NEXT G% 1240 IF FLAG THEN 1260 1250 PRINT TAB(31,21);"I CONCEDE":human =7:COLOUR 128:PRINT TAB(32,3);"YOU : 7": ENDPROC 1260 IF A%(K%-11)=blank THEN Y%=-11:GOT O 1040 1270 IF A%(K%-9)=blank THEN Y%=-blank:G OTO 1040 1280 GOTO 1250 1290 DEF PROC_newgame 1300 mandala=104:knight=99:square=143:b lank=32 1310 B$="MSMSMSBS"+"SMSMSBSB"+"MSMSBSBS "+"SMSBSBSK"+"MSBSBSKS"+"SBSBSKSK"+"BSBS KSKS"+"SBSKSKSK" 1320 FOR Z%=0 TO 100:A%(Z%)=9:NEXT 1330 FOR row%=1 TO 8 1340 FOR column%=1 TO 8 1350 C$=MID$(B$,(row%-1)*8+column%, 1) 1360 IF C$="S" THEN A%(10*column%+r ow%)=square 1370 IF C$="M" THEN A%(10*column%+r ow%)=mandala 1380 IF C$="B" THEN A%(10*column%+r ow%)=blank 1390 IF C$="K" THEN A%(10*column%+r ow%)=knight 1400 NEXT column% 1410 NEXT row% 1420 computer=0:human=0 1430 ENDPROC 1440 DEF PROC_drawboard 1450 COLOUR 128:CLS 1460 COLOUR 2:COLOUR 131 1470 PRINT TAB(32,0);"MANDALA" 1480 COLOUR 1:COLOUR 128 1490 PRINT TAB(32,3);"YOU : 0" 1500 COLOUR 2 1510 PRINT TAB(32,4);"ME : 0" 1520 COLOUR 0:COLOUR 131 1530 PRINT TAB(0,0);STRING$(30," ");TAB (0,1);"[spc4]A B C D E F G H[spc4 ]";TAB(0,2);"[spc3]";STRING$(24,"_");"[s pc3]";TAB(0,27);"[spc3]";STRING$(24,"[fc 0]");"[spc3]";TAB(0,28);"[spc4]A B C D E F G H[spc4]";TAB(0,29);STRING$(3 0," ") 1540 FOR row%=1 TO 8 1550 PRINT TAB(0,3*row%);" [fc1]";TA B(27,3*row%);"[fc2] " 1560 PRINT TAB(0,1+3*row%);" ";row%;" [fc1]";TAB(27,1+3*row%);"[fc2]";row%;" " 1570 PRINT TAB(0,2+3*row%);" [fc1]"; TAB(27,2+3*row%);"[fc2] " 1580 NEXT row% 1590 COLOUR 128 1600 FOR row%=8 TO 1 STEP -1 1610 FOR column%=1 TO 8 1620 IF A%(10*row%+column%)=mandala THEN COLOUR 1:PROC_mandala(column%,row% ) 1630 IF A%(10*row%+column%)=knight THEN COLOUR 2:PROC_knight(column%,row%) 1640 IF A%(10*row%+column%)=square THEN COLOUR 3:PROC_square(column%,row%) 1650 NEXT column% 1660 NEXT row% 1670 PRINT TAB(10,25); 1680 ENDPROC 1690 DEF PROC_mandala(column%,row%) 1700 VDU 31,3*column%,3*row%,129,130,13 1,10,8,8,8,132,133,132,10,8,8,8,134,130, 135 1710 ENDPROC 1720 DEF PROC_knight(column%,row%) 1730 VDU 31,3*column%,3*row%,32,136,137 ,10,8,8,8,138,139,140,10,8,8,8,32,141,14 2 1740 ENDPROC 1750 DEF PROC_square(column%,row%) 1760 VDU 31,3*column%,3*row%,128,128,12 8,10,8,8,8,128,128,128,10,8,8,8,128,128, 128 1770 ENDPROC 1780 DEF PROC_initialise 1790 DIM A%(100) 1800 VDU 23,0,10,32,0;0;0; 1810 VDU 23,128,&FF,&FF,&FF,&FF,&FF,&FF ,&FF,&FF 1820 VDU 23,129,&00,&00,&00,&01,&03,&07 ,&0F,&1E 1830 VDU 23,130,&00,&00,&FF,&FF,&FF,&FF ,&00,&00 1840 VDU 23,131,&00,&00,&00,&80,&C0,&E0 ,&F0,&78 1850 VDU 23,132,&3C,&3C,&3C,&3C,&3C,&3C ,&3C,&3C 1860 VDU 23,133,&00,&18,&3C,&7E,&7E,&3C ,&18,&00 1870 VDU 23,134,&1E,&0F,&07,&03,&01,&00 ,&00,&00 1880 VDU 23,135,&78,&F0,&E0,&C0,&80,&00 ,&00,&00 1890 VDU 23,136,&00,&00,&01,&07,&0F,&13 ,&33,&7F 1900 VDU 23,137,&00,&80,&80,&80,&C0,&C0 ,&C0,&E0 1910 VDU 23,138,&00,&01,&03,&07,&0F,&09 ,&03,&00 1920 VDU 23,139,&FF,&FF,&FF,&F7,&C7,&87 ,&07,&07 1930 VDU 23,140,&E0,&E0,&E0,&E0,&E0,&E0 ,&F0,&F0 1940 VDU 23,141,&0F,&1E,&1E,&3E,&7D,&FF ,&00,&00 1950 VDU 23,142,&F0,&F0,&F0,&F0,&F0,&F8 ,&00,&00 1960 VDU 23,143,&01,&01,&01,&01,&01,&01 ,&01,&FE 1970 VDU 23,144,&FF,&00,&00,&00,&00,&00 ,&00,&00 1980 VDU 23,145,&01,&01,&01,&01,&01,&01 ,&01,&01 1990 VDU 23,146,&80,&80,&80,&80,&80,&80 ,&80,&80 2000 VDU 19,3,4,0,0,0 2010 speech=FN_SYNTH 2020 ENDPROC 2030 DEF FN_SYNTH:REM if OS 0.10 put =F LASE here. 2040 A%=235:X%=&00:Y%=&FF:!&70=USR&FFF4 2050 IF ?&71=&FF THEN =TRUE ELSE =FALSE 2060 DEF PROCspeak(word) 2070 IF NOT speech THEN ENDPROC 2080 SOUND -1,word,0,0 2090 REPEAT UNTIL ADVAL(-9)>60 2100 ENDPROC 2110 DEF FN_move 2120 LOCAL key$,key%,move$ 2130 *FX 15 1 2140 REPEAT key$=GET$ 2150 IF key$<"A" OR key$>"H" THEN VDU 7 2160 UNTIL key$>="A" AND key$<="H" 2170 REMUNTIL key$>="A" AND key$<="H" 2180 PRINT key$;:PROCspeak(ASC(key$)) 2190 move$=key$ 2200 REPEAT key$=GET$ 2210 IF (key$<="1" OR key$>="8") AND key$<>CHR$(127) VDU7 2220 UNTIL (key$>="1" AND key$<="8") OR key$=CHR$(127) 2230 IF key$=CHR$(127) THEN VDU 127:GOT O 2150 2240 PRINT key$;:PROCspeak(ASC(key$)) 2250 move$=LEFT$(move$,1)+key$ 2260 REPEAT key%=GET 2270 IF key%<>13 AND key%<>127 THEN V DU7 2280 UNTIL key%=13 OR key%=127 2290 IF key%=127 THEN VDU 127:GOTO 2200 2300 =move$ 2310 DEF PROC_retry 2320 PRINT TAB(32,20);"ILLEGAL":PROCspe ak(193) 2330 PRINT TAB(34,21);"MOVE":PROCspeak( 128) 2340 PROCspeak(241):PROCspeak(272):PROC speak(162) 2350 PROC_wait 2360 PRINT TAB(32,20);"[spc7]" 2370 PRINT TAB(34,21);"[spc4]" 2380 ENDPROC 2390 DEF PROC_wait 2400 FOR W%=1 TO 5000:NEXT 2410 ENDPROC 2420 DEF FN_anothergame 2430 ON ERROR GOTO 2580 2440 COLOUR 1 2450 PRINT TAB(31,22); 2460 IF computer=7 AND human=7 THEN PRI NT"A DRAW":PROCspeak(ASC"U"):PROCspeak(1 65):PROCspeak(ASC"I"):PROCspeak(173):PRO Cspeak(ASC"1") 2470 IF computer=7 AND human<>7 THEN PR INT"I WIN":PROCspeak(ASC"I"):PROCspeak(A SC"I") 2480 IF computer<>7 AND human=7 THEN PR INT"YOU WIN":PROCspeak("ASC"U"):PROCspea k("ASC"1") 2490 PROCspeak(128):PROCspeak(267):PROC speak(257):PROCspeak(209):PROCspeak(266) :PROCspeak(275):PROCspeak(204):PROCspeak (human+48):PROCspeak(165):PROCspeak(205) :PROCspeak(204):PROCspeak(computer+48) 2500 PRINT TAB(31,24);"Another" 2510 PRINT TAB(31,25);"try Y/N"; 2520 PROCspeak(184):PROCspeak(ASC"U"):P ROCspeak(281):PROCspeak(166):PROCspeak(2 72) 2530 *FX 15 1 2540 REPEAT K$=GET$ 2550 UNTIL K$="Y" OR K$="N" 2560 IF K$="Y" THEN PROCspeak(289):=TRU E ELSE PROCspeak(226):=FALSE 2570 IF ERR=17 THEN PRINT TAB(34,20);"Y ou";TAB(32,21);"CONCEDE":computer=7:COLO UR 128:PRINT TAB(32,4);"ME : 7":IF FN_a nothergame THEN RUN 2580 MODE 7 2590 ON ERROR OFF 2600 IF ERR<>17 THEN REPORT:PRINT" at l ine ";ERL ELSE PRINT'"[fs1]BYE[fs7]"
Four Up
In this game, as its name implies, the aim is to get four of your pieces in a line in any direction before the computer manages to do this with its pieces.
Once you've decided which column you wish to move into, the piece drops to the lowest available position in that column.
The computer plays this game fairly well, and surprisingly quickly, when you see how many loops it has to go through.
In this version of Four Up, the BBC Micro always allows the human to have the first move, and bases its initial move on the move made by the human. You may wish to modify the program so that there is provision for the player to decide, at the start of each game, who should move first. You'll be offered a new game at the end of each round.
10 REM Four UP 20 30 MODE 7 40 ON ERROR GOTO 1600 50 PROC_initialise 60 REPEAT 70 PROC_board 80 PROC_win 90 PROC_human 100 PROC_board 110 PROC_win 120 PROC_computer 130 UNTIL FALSE 140 END 150 160 DEF PROC_initialise 170 VDU 23,0,10,32,0;0;0; 180 *FX 4 1 190 DIM A%(109),M%(30),P%(6) 200 E%=ASC"." 210 H%=ASC"H":C%=ASC"C" 220 FOR B%=1 TO 109 230 A%(B%)=E% 240 D%=B%-10*INT(B%/10) 250 IF D%=0 OR D%>7 OR B%<11 OR B%>7 7 THEN A%(B%)=-9 260 NEXT B% 270 quit=FALSE 280 ENDPROC 290 300 DEF PROC_win 310 IF quit THEN 450 320 X%=H% 330 B%=10 340 B%=B%+1 350 IF A%(B%)<>X% THEN 400 360 IF A%(B%+1)=X% AND A%(B%+2)=X% AND A%(B%+3)=X% THEN 440 370 IF B%>30 THEN IF A%(B%-10)=X% AND A%(B%-20)=X% AND A%(B%-30)=X% THEN 440 380 IF B%>33 THEN IF A%(B%-11)=X% AND A%(B%-22)=X% AND A%(B%-33)=X% THEN 440 390 IF B%>27 THEN IF A%(B%-9)=X% AND A %(B%-18)=X% AND A%(B%-27)=X% THEN 440 400 IF B%<77 THEN 340 410 IF X%=H% THEN X%=C%:GOTO 330 420 ENDPROC 430 REM win found 440 IF X%=H% THEN PRINT"[fs8][fs3]You: ve beaten me" ELSE PRINT"[fs8][fs2]I've defeated you" 450 PRINT TAB(0,22);"[fs1][fs8]Another game ?"; 460 REPEAT K$=GET$ 470 UNTIL K$="Y" OR K$="N" 480 IF K$="Y" THEN RUN 490 CLS 500 *FX 4 510 END 520 530 DEF PROC_board 540 VDU 28,0,23,39,14,12,26 550 PRINT TAB(8,1);CHR$(141);"[fs1]Fou r Up" 560 PRINT TAB(8,2);CHR$(141);"[fs1]Fou r Up"' 570 FOR K%=10 TO 70 STEP 10 580 PRINT TAB(5); 590 FOR J%=1 TO 7 600 IF A%(K%+J%)=H% THEN PRINT"[fs 3]"; 610 IF A%(K%+J%)=C% THEN PRINT"[fs 2]"; 620 IF A%(K%+J%)<>C% AND A%(K%+J%) <>H% THEN PRINT"[fs6]"; 630 VDU A%(K%+J%) 640 NEXT J% 650 PRINT 660 NEXT K% 670 PRINT TAB(5);"[fs1]1 2 3 4 5 6 7" 680 PRINT SPC(30) 690 ENDPROC 700 710 DEF PROC_human 720 PRINT"[fs3]Your move..."' 730 REPEAT 740 PRINT TAB(0,17);"[fs3]Which colu mn do you wish to move into" 750 PRINT"[fs3]To move: [fs6][ left" 760 PRINT"[fs6][spc10]] right" 770 PRINT"[fs6][spc5]RETURN drop" 780 J%=4 790 REPEAT 800 PRINT TAB(3+2*J%,12);"[fs3]^"; 810 *FX 15 1 820 K%=GET 830 PRINT TAB(0,22);SPC(39); 840 PRINT TAB(3+2*J%,12);" "; 850 IF K%=136 THEN J%=J%-1 860 IF K%=137 THEN J%=J%+1 870 IF J%=0 THEN J%=7 880 IF J%=8 THEN J%=1 890 UNTIL K%=13 900 Z%=J% 910 REPEAT 920 Z%=Z%+10 930 UNTIL A%(Z%+10)<>E% 940 IF A%(Z%)<>E% PRINT TAB(3,22);"[ fs1][fs8]You can't move there" 950 UNTIL A%(Z%)=E% 960 A%(Z%)=H% 970 ENDPROC 980 990 DEF PROC_computer 1000 PRINT'"[fs2]Stand by for my move.. ." 1010 B%=10 1020 B%=B%+1 1030 IF A%(B%)=-9 THEN 1060 1040 IF A%(B%)=C% THEN X%=C%:GOTO 1110 1050 IF A%(B%)=H% THEN X%=H%:GOTO 1110 1060 IF B%<77 THEN 1020 1070 GOTO 1370 1080 1090 REM Four in a row Danger/Chance? 1100 REM across 1110 IF A%(B%+1)=X% AND A%(B%+2)=X% AND A%(B%+3)=E% AND A%(B%+13)<>E% THEN move =B%+3:GOTO 1550 1120 IF A%(B%-1)=X% AND A%(B%-2)=X% AND A%(B%-3)=E% AND A%(B%+7)<>E% THEN move= B%-3:GOTO 1550 1130 IF A%(B%+1)=X% AND A%(B%+2)=X% AND A%(B%-1)=E% AND A%(B%+9)<>E% THEN move= B%-1:GOTO 1550 1140 IF A%(B%-1)=X% AND A%(B%+2)=X% AND A%(B%+1)=E% AND A%(B%+11)<>E% THEN move =B%+1:GOTO 1550 1150 IF A%(B%+1)=X% AND A%(B%-1)=X% AND A%(B%+2)=E% AND A%(B%+12)<>E% THEN move =B%+2:GOTO 1550 1160 IF A%(B%+1)=X% AND A%(B%-1)=X% AND A%(B%-2)=E% AND A%(B%+8)<>E% THEN move= B%-2:GOTO 1550 1170 IF A%(B%-1)=X% AND A%(B%-2)=X% AND A%(B%+1)=E% AND A%(B%+11)<>E% THEN move =B%+1:GOTO 1550 1180 REM down 1190 IF B%>20 THEN IF A%(B%-10)=X% AND A%(B%-20)=X% AND A%(B%+10)=E% AND A%(B%+ 20)<>E% THEN move=B%+10:GOTO 1550 1200 REM diagonals 1210 IF A%(B%+11)=X% AND A%(B%+22)=X% A ND A%(B%-11)=E% AND A%(B%-1)<>E% THEN mo ve=B%-11:GOTO 1550 1220 IF A%(B%+9)=X% AND A%(B%+18)=X% AN D A%(B%-9)=E% AND A%(B%+1)<>E% THEN move =B%-9:GOTO 1550 1230 1240 REM make block three? 1250 REM across 1260 IF A%(B%+1)=X% AND A%(B%+2)=E% AND A%(B%+12)<>E% THEN move=B%+2:GOTO 1550 1270 IF A%(B%+1)=X% AND A%(B%-2)=E% AND A%(B%+9)<>E% THEN move=B%-1:GOTO 1550 1280 IF A%(B%-1)=X% AND A%(B%-2)=E% AND A%(B%+8)<>E% THEN move=B%-2:GOTO 1550 1290 REM vertical 1300 IF A%(B%+10)=X% AND A%(B%-10)=E% A ND A%(B%)<>E% THEN move=B%-10:GOTO 1550 1310 REM diagonal 1320 IF A%(B%+9)=X% AND A%(B%-9)=E% AND A%(B%+1)<>E% THEN move=B%-9:GOTO 1550 1330 IF B%>11 THEN IF A%(B%+11)=X% AND A%(B%-11)=E% AND A%(B%-1)<>E% THEN move= B%-11:GOTO 1550 1340 GOTO 1060 1350 1360 REM single moves 1370 FOR N%=1 TO 3 1380 M%(N%)=0 1390 NEXT N% 1400 count=0 1410 FOR B%=11 TO 77 1420 IF A%(B%)<>C% AND A%(B%)<>H% THE N 1480 1430 IF A%(B%+1)=E% AND A%(B%+11)<>E% THEN count=count+1:M%(count)=B%+1 1440 IF A%(B%-1)=E% AND A%(B%+9)<>E% THEN count=count+1:M%(count)=B%-1 1450 IF A%(B%-10)=E% AND A%(B%)<>E% T HEN count=count+1:M%(count)=B%-10 1460 IF A%(B%-11)=E% AND A%(B%-1)<>E% THEN count=count+1:M%(count)=B%-11 1470 IF A%(B%-9)=E% AND A%(B%+1)<>E% THEN count=count+1:M%(count)=B%-9 1480 NEXT B% 1490 IF count<>0 THEN 1540 1500 PRINT''"[fs8][fs4]I think we shoul d call this a draw" 1510 PRINT''' 1520 quit=TRUE 1530 PROC_win 1540 move=M%(RND(count)) 1550 A%(move)=C% 1560 PRINT TAB(3+2*(move MOD 10),12);"[ fs2]^"; 1570 ENDPROC 1580 1590 REM Handle Errors 1600 IF ERR=17 THEN 450 1610 MODE 7 1620 *FX 4 1630 REPORT:PRINT" at line ";ERL