DraughtsBBC
 Here is the listing for the Draughts program written for the BBC microcomputer to allow the use of the lightpen for games. I am in the process of exploring the uselessness of BBC microcomputer emulators so that I could show you some actual screen dumps of the game - but it is taking a bit of time. ( My brother ( aged twelve at the time ) only did the graphics for the 'normal' and 'crowned' pieces, but it got his name in lights for him )
10 REM" Draughts 8.8.83 "
20 REM" WRITTEN BY G & J McCORMACK "
30 #KEY 10 : PAGE=&DDDD|M OL.|M CLS|M
40 ON ERROR GOT0 910
50 DIM BB(8) : BB(8) = -1 : G% = 12 : H% = 12 : I%=0
60 MODE 1: PRINTTAB(9,14) "How many players ?"
70 VDU 24,224;96;448;320;:GCOL 0,130: CLG: GCOL0,0:VDU 5: MOVE 330,224:VDU 49
80 VDU 24,768;96;992;320;19,129,5,0,0,0:GCOL 0,129:CLG:MOVE 864, 224: VDU 50
90 PROCliqhtpen(-1,0)
100 IF X%=0 OR X%=l J%=l:CLG:GOTO 130
110 IF X%=6 OR X%=7 J%=0:CLG:GOTO 130
120 GOTO 90
130 MODE 1:VDU 19,2,2,0,0,0,19,1,7,0,0,0,19,3,3,0,0,0,19,0,0,0,0,0
140 DIM B(31):FOR L% = 12 T0 19: B(L%) =4: NEXT: FOR L%.= 20 T0 31: B(L%)=2:NEXT:COLOUR 129:COLOUR 2 :PRINT TAB(12,30) "Player Concedes"
150 VDU 23;8202;0;0;0,23,1,0;0;0;0;:PRINT TAB(1,29)" ": PRINT TAB(1,30)"END"
160 COLOUR 1:COLOUR 128:FOR X%=2 TO 6: PRINTTAB ( X%, 8-X%)CHR$(233+X%):NEXT
170 VDU 5 : FOR Y% = 864 T0 84 STEP -780: VDU24,224;Y%;992;Y%+12;:GCOLO.131: CLG:NEXT:FOR X =200 T0 992 STEP 792: VDU24, X%;84; X%+24; 876;:GCOL0, 131:CLG:NEXT
180 FOR Y%=0 T0 7:FOR X% = 0 T0 7:PROCfillin(X%,Y%) :NEXT,
190 PROCarrows(0):FOR N% = 0 T0 31: PROCcounters(N%):NEXT
200 PROCarrows(I%)
210 IF I%=1 AND J%=1 THEN SOUND 2,-7,100,-l:PROCcomputer:SOUND &12,0,0,l:GOT0300
220 O%=0: PROClightpen (0,-1)
230 PROCfillin(X%,Y%) : SOUND 1,-10,53,1 : PROCcounters(N%) : SOUND 2,-10,69,2 : PROCfillin( X%, Y%) : SOUND3,-10,81,2:PROCcounters (N%):SOUND 1,-10,101,2
240 Q%=N%
250 O%=0: PROClightpen(1,Q%)
260 IF O% = -100 THEN PROCfillin(X%,Y%) : SOUND 1 ,-10,101,1 : PROCcounters(N%): SOUND2 , -10 ,81,2:PROCfi11in(X%,Y%): SOUND 3,-10,69,2:PROCcounters(N%): SOUND 1,-10,53,2:GOT0220
270 IF ABS(N%-Q%)<6 THEN PROCmove(N%,Q%) : GOTO 300
280 PROCdecide(N%,I%,Q%) : IF n <> N% SOUND 1 ,-10, 90 , 5 : GOT0250
290 PROCJP
300 S%=B(N%)
310 IF (O% = -100) AND ( (B(Q%) AND 1) = 1) THEN O% = 0: GOTO 280
320 IF O% = -100 THEN SOUND 1 , -15 , 45 , 3 : GOTO 250
330 IF (I% = 0 AND (N% >27 ) AND (S% = 0) THEN B(N%) = 1: PROCcounters(N%) : G% = G%+1: REM " KING Maker "
340 IF (I% = 1) AND (N% < 4) AND (S% = 2) THEN B(N%) = 3: PROCcounters(N%) : H% = H%+1: REM " KING Maker "
350 I% = 1 - I% : GOT0200
360 REM
370 DEF PROCcounters(N%)
380 VDU 26,5: IF (B(N%) AND 4)/4:ENDPROC
390 PROCuncode(N%)
400 FOR E% = 0 TO 8: MOVE X%*96+224+32*(E% MOD 3) , (Y%+1)*96-4+32*(3- (E% DIV 3)):GCOL 0, (INT(B(N%)/2)*2+1) : PRINTCHR$ (224+E%) :NEXT
410 IF B(N%) AND 1 THEN MOVE X%*96+224+32, (Y%+1)*96+64: GCOL 0,0 : PRlNT CHR$240
420 VDU 4:ENDPROC
430 REM
440 DEF PROCarrows(p)
450 VDU 4; COLOUR 130 : COLOUR 1 : IF J% = 0 THEN PRINT TAB (9 ,3) " Player 1 Player 2 " ELSE PRINT TAB(9,3)" Player Computer "
460 p=20-(1-p)*ll
470 COLOUR 0: PRINT TAB(p, 3) CHR$244 : PRINT TAB(p+9 ,3) CHR$ 245
480 COLOUR 128:PRINT TAB(33,12)" ":PRINTTAB(33,24)" "
490 COLOUR 1:COLOUR 128; PRINT TAB (33 ,12);H%: PRINT TAB (33,24);G%: VDU 5
500 IF (G% = 0) OR (H%=0) THEN PROCend:RUN
510 ENDPROC
520 REM
530 DEF PROClightpen(M%,Q%)
540 PROCcontact
550 XX=0:YY=0:FOR p=1 TO 3
560 ?&FEOO=16:LH=?&FE01 AND 63
570 ?&FEOO=17:LL=?&FE01:P=INT((LH*256+LL-1623)/2)
580 Y%=INT(P/40) : X%=P-Y%/:*40: X%=INT((X%-8)/24*8) : Y%=INT(Y%/3-1.1)
590 XX=XX+X% : YY=YY+Y% : NEXT p
600 IF (XX MOD 3)+(YY MOD 3) > 0 THEN GOTO 550
610 IF Y%=8 AND (X%=-2 OR X%=-1) AND (M%>1) THEN PROCend:RUN
620 IF Y%=8 AND M%=0 PROCend:RUN
630 IF Y%>7 OR Y%<0 OR X%>7 OR X%<0 THEN GOT0550
640 IF M%=-1 THEN ENDPROC
650 Y%=7-Y%: IF (Y% AND 1)=(X% AND 1) THEN GOTO 550
660 N%=Y%*4+INT(X%/2)
670 IF (N%=Q%) AND (B(N%)<4) O%=-100: ENDPROC
680 IF (B(N%) AND 4)/4 <> M% THEN SOUND 1,-15,45,3: GOTO 540
690 IF INT(B(N%)/2) = 1-I% THEN SOUND 1,-15,45,3: GOTO 540
700 IF M% = 0 THEN ENDPROC
710 IF (B(Q%) AND 1) THEN ENDPROC
720 IF( (SGN(N%-Q%)/2+0.5 )+I%)<>1 THEN SOUND 1,-15,45,3: GOTO 540
730 ENDPROC
740 REM
750 DEF PROCdecide(Bnew,I%,N%)
760 K%=0:J=0:BB(0)=N%: R%=0: W%=(B(N%) AND 1)*2+2:n=N%:T%=0
770 PROCjump(n,T%,I%)
780 IF (W%=4) AND (T%=0) THEN E%=JP
790 IF (W%=4) THEN E%=E%+JP
800 IF (W%=4) AND (T%=3) AND (E%=0) GOTO 820
810 IF (JP=1) AND (W%=4) AND (J >0) THEN IF (INT(BB(J-1))=N%) THEN JP=0
820 IF JP=1 THEN n=N%:J=J+1 ELSE GOTO 870
830 BB(J)=n+T%/W%: IF J>R% THEN R%=J:K%=n
840 IF n=Bnew R%=J: ENDPROC
850 IF J=0 AND T%=W%-1: ENDPROC
860 T%=0:GOTO 770
870 T% = T% + 1: IF T%<W% THEN GOTO 770
880 IF J=0 THEN ENDPROC
890 J = J-1: n = INT (BB(J)): T%=W%* (BB(J+l) -INT(BB(J+l))): GOTO 870: ENDPROC
900 REM
910 VDU 4:PROCend:RUN
920 DEF PROCuncode(N%) : Y%=INT(N%/4) : X%=2* (N%-4*Y%)+((Y%+1) AND 1): ENDPROC
930 REM
940 DEF PROCmove(N%,Q%)
950 IF(N%<0) OR (Q%<0) OR (N%>31) OR (Q%>31) THEN O%=-1OO:ENDPROC
960 PROCuncode(Q%) :XX=X%: YY=Y%: PROCuncode(N%) : IF (ABS( XX-X%) >1) OR (ABS(YY-Y%) > 1 THEN O%=100:ENDPROC
970 IF (N%>31) OR (N%<0) OR (Q%>31) OR (Q%<0) THEN O%=-70:ENDPROC
980 IF (B(N%)<4) OR (B(Q%)=4) OR (INT (B(Q%)/2)=1-I%) THEN O%=-70: ENDPROC
990 IF (O%=-100) AND ((B(Q%) AND 1) = 1) THEN O%=-150: ENDPROC
1000 IF O%=-100 : ENDPROC
1010 IF (((Q%-4) MOD 8)=0) AND (((N%-3) MOD 8) =0) THEN O%=-100: ENDPROC
1020 IF (((Q%-3) MOD 8)=0) AND (((N%-4) MOD 8) =0) THEN O%=-100: ENDPROC
1030 S% = B(Q%):IF S%=3 AND J%=l AND BB(8)==N% THEN O%=-100: ENDPROC
1040 PROCfillin(XX , YY) : B((Q%)=4: B(N%)=S% : PROCcounters(N%) : BB(8) =Q%
1050 ENDPROC
1060 REM
1070 DEF PROCjump(n,T%,I%)
1080 JP=0: U%= I%: V%=T%: IF T% > 1 THEN U%= 1 -U%:V%=V%-2
1090 IF(( n MOD 8)=0) AND (V%=0) ENDPROC
1100 Xr(((n+l) MOD 8)=0) AND (V%=l) ENDPROC
l110 IF(((n+4) MOD 8)=0) AND (V%=0) ENDPROC
1120 IF(((n+5) MOD 8)=0) AND (V%=1) ENDPROC
1130 IF V%=0 AND U%=0 THEN Z%=3+((Y%+1) AND 1) : N%=7
1140 IF V%=1 AND U%=0 THEN Z%=4+((Y%+1) AND 1) : N%=9
1150 IF V%=0 AND U%=1 THEN Z%=-4-((Y%) AND 1) : N%=-9
1160 IF V%=1 AND U%=1 THEN Z%=-3-((Y%) AND 1) : N%=-7
1170 Z%=n+Z%:N%=n+N%
1180 IF (N%>31) OR (N%<0) ENDPROC
1190 IF (INT(B(Z%)/2)=1-I%) AND B(N%)=4 THEN JP=1
1200 ENDPROC
1210 REM
1220 DEF PROCfillin(X%,Y%)
1230 VDU24,224+X%*96; (Y%+1)*96; 320+X%*96; (Y%+2)*96;: GCOL 0,(((Y% AND 1)-(X% AND 1)) AND 1)+129:CLG:ENDPROC
1240 REM
1250 DEF PROCJP
1260 FOR K% =0 TO (R%-1) : N7=INT(BB(K%)) : PROCuncode (N%):S%=B(N%):PROCfillin(X%,Y%):B(N%)=4: N%=INT (BB(K%+1) ) : B(N%) =S%: PROCcounters(N%)
1270 PROCuncode(INT(BB (K%))) : XX=X%:YY=Y%: PROCuncode (INT(BB(K%+1))) : X%= (XX+X%) /2:Y%=(YY+Y%) /2:n=Y%*4+INT(X%/2) :FF==(B(n) AND 1)+1 : B(n) =4: PROCfillin( X%,Y%) : IF I%= 1 THEN G%=G%-FF ELSE H%=H%-FF
1280 SOUND 1 ,-15,200, 3: NEXT K%: ENDPROC
1290 REM
1300 DEF PROCend : IF G%=H% THEN A$ = "A Draw"
1310 IF G% > H% THEN A$=" White"
1320 IF G% < H% THEN A$="Yellow"
1330 VDU4:COLOUR 3: COLOUR 128: PRINT TAB (0, 12) A$; IF G% <> H% PRINT TAB (2 , 13) "wins"
1340 IF G%< H% THEN PRINT TAB (0 ,15) : H%; "to ";G%'' ELSE PRINTTAB (0, 15) ; G%; " to " ; H%''
1350 *FX 15,1
1360 E%=INKEY(300)
1370 CLS : VDU 4
1380 VDU 19, 129,5,0,0,0,24,224;96;448;320;: GCOL 0,130:CLG:GCOL 0,0:VDU 5 : MOVE 270,224 : PRINT "AGAIN"
1390 VDU 19, 129,5,0,0,0,24,768;96;992;320;: GCOL 0,129:CLS:GCOL 0,0:VDU 5 : MOVE 832,224 : PRINT "END"
1400 PROC1ightpen(-l,0)
1410 IF(X%=0) OR (X%=1) GOSUB 1820: ENDPROC
1420 IF(X%=6) OR (X%=7) VDU 4:PRINT''''"GOODBYE":GOSUB 1820 :END
1430 GOTO 1400
1440 REM
1450 DEFPROCcontact
1460 REPEAT:UNTIL (ADVAL(O) AND 15)=1
1470 REPEAT:UNTIL (ADVAL(O) AND 15)=0
1480 ENDPROC
1490
1500 DEF PROCcomputer
1510 VDU 4
1520 A%=O:FOR D%= 0 T0 31: IF B(D%)=4 OR INT (B(D%))/2)=0 THEN G0TO 1540
1530 PROCuncode (D%) : PROCdecide (-1 , 1 , D%) : IF R% > A% THEN A%=R%:B%=D%:C%=K%
1540 NEXT: IF A%>0 THEN PROCuncode(B%):PROCdecide(C%, 1 ,B%) : PROCJP: ENDPROC
1550 REM
1560 T% = 0 : N%=4 : GOSUB 1650
1570 N% = 12 : GOSUB 1650
1580 N% = 20 : GOSUB 1650
1590 N% = 3 : GOSUB 1650
1600 N% = 11 : GOSUB 1650
1610 N% = 19 ; GOSUB 1650
1620 N% = 27 ; GOSUB 1650
1630 IF T% = 1 THEN K%=1:PROCmove(B%,B%+4) : ENDPROC
1640 GOTO 1670
1650 IF (B(N%)=4) AND ( INT (B(N%+4)/2) T%=l: B%=N%
1660 RETURN
1670 A% = 0: O% = 0 ; K%=l: C%=0 :VDU 4
1680 FOR B% = 0 T0 31: IF C% > 0 THEN GOTO 1780
1690 IF (B (B%) =4) OR ( INT (B (B%) / 2) =0) GOTO 1780
1700 PROCuncode(B%)
1710 D%=(Y%-1)*4+INT((X%-1)/2):O%=0:PROCmove(D%,B%):IF O%=0 C%=l: GOT01780
1720 PROCuncode(B%)
1730 D%=(Y%-1)*4+INT((X%+1)/2):O%=0:PROCmove(D%,B%):IF O%=0 C%=l: GOT01780
1740 PROCuncode(B%)
1750 IF (B(B%) AND 1) = 1 D%= (Y%+1)*4+INT((X%-1) /2):O%=0: PROCmove(D% , B%) : IF O%=0 C%=1:GOTO 1780
1760 PROCuncode(B%)
1770 IF (B(B%) AND l) = 1 D%= (Y%+l)*4+INT((X%+l) /2):O%=0: PROCmove(D% , B%) : IF O%=0 C%=1:GOTO 1780
1780 NEXT
1790 IF C%=1 N%=D%:ENDPROC
1800 VDU4: COLOUR 128: COLOUR 1 : PRINTTAB(12 , 0) "I MUST CONCEDE I can't move " : FOR B%=0 TO 9000:NEXT:PRINTTAB(12,0)" ":SOUND&12,0 ,0 , 1 : FOR B%=0 TO 9000:NEXT :PROCend:RUN
1810 ENDPROC
1820 A%= 1: TIME = 0: B%=0: C% =0
1830 ENVELOPE 1,1,0,0,0,0,0,0,127,-16,-4,-8,126,0
1840 ENVELOPE 2,1,0,0,0,0,0,0,127,-16,-4,-8,84,0
1850 ENVELOPE 3,6,0,0,0,0,0,0,127,-16,-4,-8,84,0
1860 S$="ZXCVBNMASDFGHJKLQWERTYUIOP1234567890=,./?"
1870 ON A% GOTO 1970,2010 ELSE A%=2
1880 D%=13: IF C%=1 RETURN
1890 FOR E%=l TO LEN T$: F%=TIME + D%.
1900 IF (ADVAL(0) AND 15) = 0 THEN C%=1
1910 *FX15,1
1920 F$=MID$(T$,E%,1):G$=MID$(M$,E%, 1) : H$=MID$(N$ ,E%,1)
1930 IF F$<>" " SOUND 1 , 1 , 4*8+4* INSTR (S$ , F$),1
1940 IF G$<>" " SOUND 3 , 2 , 4*8+4* INSTR (S$ , G$),1
1950 IF H$<>" " SOUND 2 , 3 , 4*8+4* INSTR (S$ , H$),1
1960 REPEAT UNTIL TIME>F%:NEXT:GOTO 1870
1970 T$ = "66O13466O O 884680==O O 446431334310IIO13031111166O13466O O 884680==O O 4464313343101131OIOOOOOO"
1980 M$ = "RRRR "
1990 N$ = "HHHHKKQQQQQQWWWWWWQQQQQQKKKKKKHHHHHHRRQQHHRRAWQKQQQQKKHHQQHHWWWWWWQQWQKHKKKKGGHHHHQQWWRRAAHHHHZZ"
2000 A%=A%+1:GOTO 1880
2010 T$ = "??=.?=..6806==80=655351 135680==008800115566666 66OIOO88OIOO664433lOIO11RYIO1344331136OOIIOOOOOO"
2020 M$ = " RRRR YYYY GG "
2030 N$== "HHHHHHGGGGGGDDHHDDKKKKCCKKKKKKQQRREERRGGKKRRAAWWQQQ QQWWW WWQQKKHHRRRR AAAAAADDHHGGHHBBAAHHAAZZ"
2040 A% = A% + l : GOTO 1880
2050 REM "EoF"
|