10 REM " PONTOON (main program) "
20 REM by Carl Wheat 1985
30 REM for BBC B
40 :
50 K$=GET$
60 MODE 1:VDU23;8202;0;0;0;
70 VDU19,2,2,0,0,0:VDU28,0,31,39,27
80 COLOUR 130:COLOUR 3
90 VDU24,0;160;1279;1023;:GCOL0,130
100 BJ=&B00:GJ=&B18:RJ=&B23
110 BQ=&B38:GQ=&B43:RQ=&B5E
120 BK=&B79:GK=&B8B:RK=&B92
130 C$=CHR$(240):D$=CHR$(241):H$=CHR$(
242):S$=CHR$(243)
140 P=&BA6:P$=$P:DIM C(9)
150 :
160 W=100:REPEAT:PROCdeal
170 C%=-1:H%=200:T%=0:A%=0
180 REPEAT:C%=C%+1:PROCtwist
190 IF C%>0 THEN PROCscore ELSE PROCbe
t
200 REPEAT
210 IF C%>0 AND C%<>4 AND T%<21 THEN G
%=GET ELSE G%=84
220 UNTIL G%=83 OR G%=84
230 *FX21,0
240 IF A%=1 THEN MOVE(220*C%+70),(H%+1
40):GCOL0,2:PRINT (T%-10);" or ";T%
250 IF G%=84 AND A%=1 AND T%<>21 THEN
T%=T%-10:A%=0
260 UNTIL G%=83 OR C%=4 OR T%>20
270 MOVE(220*C%+70),(H%+140):GCOL0,3:P
RINT T%
280 IF T%>21 THEN U%=0 ELSE U%=T%
290 IF U%=0 THEN PROCbust
300 C%=-1:H%=600:T%=0:A%=0
310 REPEAT:C%=C%+1:PROCtwist
320 IF N%=1 AND T%<12 THEN T%=T%+10:A%
=1
330 IF T%>21 AND A%=1 THEN T%=T%-10:A%
=0
340 IF C%<1 AND U%<10 THEN C%=1:PROCtw
ist:IF N%=1 THEN T%=T%+10
350 UNTIL C%=4 OR T%>16
360 MOVE(220*C%+70),(H%+140):GCOL0,3
370 IF C%>0 THEN PRINT T%
380 IF T%>21 THEN PROCbust
390 PROCtestwin:PROCpay
400 G%=GET:UNTIL W<=0 OR G%=81
410 CLS:VDU4:CLG
420 IF W<=0 THEN PROCend ELSE PROCquit
430 PRINT TAB(6,2)"DO YOU WANT ANOTHER
GO? Y/N" : K$=GET$
440 IF K$="Y" OR K$="y" THEN GOTO 160
450 MODE 7 : END
460 :
470 DEF PROCdeal
480 CLS:VDU5:CLG:B%=0
490 FOR I%=0 TO 9:C(I%)=0:NEXT
500 FOR I%=0 TO 1
510 PLOT4,(220*I%+100),184:PROCcard
520 MOVE(220*I%+136),257
530 GCOL0,1:PRINT P$
540 PLOT4,(220*I%+100),584:PROCcard
550 MOVE(220*I%+136),657
560 GCOL0,1:PRINT P$:NEXT
570 @%=&20201:GCOL0,3:MOVE 400,1000:PR
INT;"Winnings £";(W/100):@%=10
580 VDU4:PRINT TAB(10,2);"PRESS ANY KE
Y":G%=GET:CLS:VDU5:ENDPROC
590 :
600 DEF PROCcard
610 GCOL0,3:PLOT0,0,272:PLOT81,192,-27
2:PLOT81,0,272:ENDPROC
620 :
630 DEF PROCtwist
640 N%=RND(13):S%=RND(4):I%=0:REPEAT
650 IF C(I%)=N%*10+S% THEN N%=RND(13):
S%=RND(4)
660 IF C(I%)<>N%*10+S% THEN I%=I%+1
670 UNTIL I%=9
680 IF H%=200 THEN C(C%)=N%*10+S% ELSE
C(C%+5)=N%*10+S%
690 IF S%=1 THEN S%=1:F$=H$
700 IF S%=2 THEN S%=0:F$=S$
710 IF S%=3 THEN S%=1:F$=D$
720 IF S%=4 THEN S%=0:F$=C$
730 PLOT4,(220*C%+100),(H%-16):PROCcar
d:GCOL0,S%
740 IF N%=1 THEN PROCace
750 IF N%=2 THEN PROCtwo
760 IF N%=3 THEN PROCthree
770 IF N%=4 THEN PROCfour
780 IF N%=5 THEN PROCfive
790 IF N%=6 THEN PROCsix
800 IF N%=7 THEN PROCseven
810 IF N%=8 THEN PROCeight
820 IF N%=9 THEN PROCnine
830 IF N%=10 THEN PROCten
840 IF N%=11 THEN PROCjack:N%=10
850 IF N%=12 THEN PROCqueen:N%=10
860 IF N%=13 THEN PROCking:N%=10
870 T%=T%+N%:ENDPROC
880 :
890 DEF PROCace
900 MOVE(C%*220+184),(H%+124)
910 PRINT,F$:N$="A":PROCnum:ENDPROC
920 :
930 DEF PROCtwo
940 TWO$=F$+CHR$(8)+(STRING$(4,CHR$(11
)))+F$
950 MOVE(C%*220+184),(H%+64)
960 PRINT,TWO$:N$="2":PROCnum:ENDPROC
970 :
980 DEF PROCthree
990 PROCace:PROCtwo
1000 N$="3":PROCnum:ENDPROC
1010 :
1020 DEF PROCfour
1030 FOUR$=F$+" "+F$+(STRING$(4,CHR$(8
)))+(STRING$(5,CHR$(11)))+F$+" "+F$
1040 MOVE(C%*220+132),(H%+48):PRINT,FOU
R$
1050 N$="4":PROCnum:ENDPROC
1060 :
1070 DEF PROCfive
1080 PROCfour:PROCace
1090 N$="5":PROCnum:ENDPROC
1100 :
1110 DEF PROCsix
1120 SIX$=F$+" "+F$
1130 MOVE(C%*220+132),(H%+128):PRINT,SI
X$:PROCfour
1140 N$="6":PROCnum:ENDPROC
1150 :
1160 DEF PROCseven
1170 MOVE(C%*220+180),(H%+172):PRINT,F$
:PROCsix
1180 N$="7":PROCnum:ENDPROC
1190 :
1200 DEF PROCeight
1210 PROCseven
1220 MOVE(C%*220+180),(H%+82):PRINT,F$
1230 N$="8":PROCnum:ENDPROC
1240 :
1250 DEF PROCfourbytwo
1260 B$=F$+" "+F$
1270 MOVE(C%*220+132),(H%+100):PRINT,B$
1280 MOVE(C%*220+132),(H%+156):PRINT,B$
1290 PROCfour:ENDPROC
1300 :
1310 DEF PROCnine
1320 PROCfourbytwo:PROCace
1330 N$="9":PROCnum:ENDPROC
1340 :
1350 DEF PROCten
1360 PROCfourbytwo:PROCtwo
1370 N$="10":PROCnum:ENDPROC
1380 :
1390 DEF PROCjack
1400 BLACK$=$BJ:RED$=$RJ:GREEN$=$GJ
1410 N$="J":PROCpicture:ENDPROC
1420 :
1430 DEF PROCqueen
1440 BLACK$=$BQ:RED$=$RQ:GREEN$=$GQ
1450 N$="Q":PROCpicture:ENDPROC
1460 :
1470 DEF PROCking
1480 BLACK$=$BK:RED$=$RK:GREEN$=$GK
1490 N$="K":PROCpicture:ENDPROC
1500 :
1510 DEF PROCnum
1520 GCOL0,3:MOVE(C%*220+108),(H%+248):
PRINT,"A";CHR$(8);"2";CHR$(8);"4";CHR$(8
);"6";CHR$(8);"7"
1530 GCOL0,S%:MOVE(C%*220+108),(H%+248)
:PRINT,N$:ENDPROC
1540 :
1550 DEF PROCpicture
1560 MOVE(C%*220+132),(H%+56):GCOL0,0:P
RINT,BLACK$
1570 MOVE(C%*220+132),(H%+56):GCOL0,1:P
RINT,RED$
1580 MOVE(C%*220+132),(H%+56):GCOL0,2:P
RINT,GREEN$
1590 PROCnum
1600 MOVE(C%*220+142),(H%+210):PRINT,F$
1610 MOVE(C%*220+132),(H%+24):GCOL0,0:P
LOT1,124,0
1620 PLOT1,0,192:PLOT1,-124,0:PLOT1,0,-
192:GCOL0,S%:ENDPROC
1630 :
1640 DEF PROCbet
1650 REPEAT:VDU4:PRINT TAB(5,2)"PLACE Y
OUR BET IN PENCE "
1660 PRINT TAB(29,2)"";:INPUT B
1670 PRINT TAB(1,3)STRING$(37," ")
1680 IF B>=1 THEN B%=1
1690 IF B>W THEN PRINT TAB(1,3)"YOUR BE
T IS HIGHER THAN YOUR WINNINGS":B%=0
1700 UNTIL B%=1
1710 B$=STR$(B):PRINT TAB(30,2)B$;"p";S
TRING$(8," ")
1720 PRINT TAB(3,0)CHR$(34);"S";CHR$(34
);" for Stick - ";CHR$(34);"T";CHR$(34
);" for Twist":VDU5:ENDPROC
1730 :
1740 DEF PROCscore
1750 I%=-1:REPEAT:I%=I%+1
1760 IF C(I%)<15 AND C(I%)>10 THEN T%=T
%+10:A%=1
1770 UNTIL A%=1 OR I%=4
1780 IF T%>21 AND A%=1 THEN T%=T%-10:A%
=0
1790 MOVE(220*C%+70),(H%+140):GCOL0,3
1800 IF A%=0 THEN PRINT T% ELSE PRINT (
T%-10);" or ";T%
1810 ENDPROC
1820 :
1830 DEF PROCtestwin
1840 IF T%>21 AND U%=0 THEN W$="D":ENDP
ROC
1850 IF T%>21 THEN W$="P":ENDPROC
1860 IF U%=0 THEN W$="C":ENDPROC
1870 IF U%=T% THEN W$="D":ENDPROC
1880 IF U%>T% THEN W$="P":ENDPROC
1890 IF T%=21 AND C(7)=0 THEN W$="C":EN
DPROC
1900 IF U%=21 AND C(2)=0 THEN W$="P":EN
DPROC
1910 IF C(9)<>0 AND C(4)=0 THEN W$="C":
ENDPROC
1920 IF C(4)<>0 AND C(9)=0 THEN W$="P":
ENDPROC
1930 IF T%>=U% THEN W$="C":ENDPROC
1940 :
1950 DEF PROCpay
1960 VDU4:CLS
1970 IF W$="D" THEN PRINT TAB(11,2)"IT'
S A DRAW"
1980 IF W$="C" THEN W=W-B:PRINT TAB(11,
2)"YOU LOSE ";B;"p"
1990 IF W$="P" THEN W=W+B:PRINT TAB(11,
2)"YOU WIN ";B;"p"
2000 PRINT TAB(3,4)"Press any key to de
al, ";CHR$(34);"Q";CHR$(34);" to Quit."
2010 ENDPROC
2020 :
2030 DEF PROCbust
2040 IF C%<4 THEN MOVE(220*C%+300),(H%+
80):PRINT,"BUST":ENDPROC
2050 MOVE 580,(H%+300):PRINT,"BUST"
2060 ENDPROC
2070 :
2080 DEF PROCquit
2090 @%=&20201:PRINT TAB(10,0)"YOU HAVE
WON £";(W/100):@%=10
2100 ENDPROC
2110 :
2120 DEF PROCend
2130 PRINT TAB(7,0)"YOU HAVE RUN OUT OF
MONEY!"
2140 ENDPROC