Board Games




Nine by Eight


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