tsvm/assets/blackjack.bas

1 OPTIONBASE 1
2 PRINT SPC(31);"BLACK JACK"
4 PRINT SPC(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
6 PRINT
7 PRINT
8 PRINT
10 REM DEFUN A(Q)=Q+11*(Q>=22)
20 HANDS=DIM(15,12)
21 HANDTOTAL=DIM(15)
22 DECK=DIM(52)
23 DISCARDECK=DIM(52)
24 PLRSUM=DIM(8)
25 PLRHNDSUM=DIM(7)
26 BETS=DIM(15)
30 HANDSLENS=DIM(15)
40 REM--HANDS(I,J) IS THE JTH CARD IN HAND I, HANDTOTAL(I) IS TOTAL OF HAND I
50 REM--C IS THE DECK BEING DEALT FROM, D IS THE DISCARD PILE,
60 REM--PLRSUM(I) IS THE TOTAL FOR PLAYER I, PLRHNDSUM(I) IS THE TOTAL THIS HAND FOR
70 REM--PLAYER I, BETS(I) IS TH BET FOR HAND I
80 REM--HANDSLENS(I) IS THE LENGTH OF HANDS(I,*)
90 GOTO 1500
100 REM--SUBROUTINE TO GET A CARD.  RESULT IS PUT IN X.
110 IF C<51 THEN GOTO 230
120 PRINT "RESHUFFLING"
130 FOR DI=D TO 1
140   C=C-1
150   DECK(C)=DISCARDECK(DI)
160 NEXT
170 FOR C1=52 TO C
180   C2=INT(RND(1)*(C1-C+1))+C
190   C3=DECK(C2)
200   DECK(C2)=DECK(C1)
210   DECK(C1)=C3
220 NEXT
230 X=DECK(C)
240 C=C+1
250 RETURN
300 REM--SUBROUTINE TO EVALUATE HAND I.  TOTAL IS PUT INTO
310 REM--HANDTOTAL(I). TOTALS HAVE THE FOLLOWING MEANING:
320 REM--  2-10...HARD 2-10
330 REM-- 11-21...SOFT 11-21
340 REM-- 22-32...HARD 11-21
350 REM--  33+....BUSTED
360 Q=0
370 FOR Q2=1 TO HANDSLENS(I)
380   X=HANDS(I,Q2)
390   GOSUB 500
400 NEXT
410 HANDTOTAL(I)=Q
420 RETURN
500 REM--SUBROUTINE TO ADD CARD X TO TOTAL Q.
510 X1=X
511 IF X1>10 THEN X1=10
512 REM  SAME AS X1=10 MIN X
520 Q1=Q+X1
530 IF Q>=11 THEN GOTO 590
540 IF X>1 THEN GOTO 570
550 Q=Q+11
560 RETURN
570 Q=Q1-11*(Q1>=11)
580 RETURN
590 Q=Q1-(Q<=21 AND Q1>21)
600 IF Q<33 THEN GOTO 620
610 Q=-1
620 RETURN
700 REM--CARD PRINTING SUBROUTINE
710 REM  DSTR DEFINED ELSEWHERE
720 PRINT MID(DSTR,3*X-2,3);
730 PRINT "  ";
740 RETURN
750 REM--ALTERNATIVE PRINTING ROUTINE
760 PRINT " ";MID(DSTR,3*X-1,2);
770 PRINT "   ";
780 RETURN
800 REM--SUBROUTINE TO PLAY OUT A HAND.
810 REM--NO SPLITTING OR BLACKJACKS ALLOWED
820 H1=5
830 GOSUB 1410
840 H1=3
850 REM --ON H GOTO 950,930--
851 IF H==1 THEN GOTO 950
852 IF H==2 THEN GOTO 930
860 GOSUB 100
870 BETS(I)=BETS(I)*2
880 PRINT "RECEIVED";
890 GOSUB 700
900 GOSUB 1100
910 IF Q>0 THEN GOSUB 1300
920 RETURN
930 GOSUB 1320
940 RETURN
950 GOSUB 100
960 PRINT "RECEIVED";
970 GOSUB 700
980 GOSUB 1100
990 IF Q<0 THEN GOTO 940
1000 PRINT "HIT";
1010 GOTO 830
1100 REM--SUBROUTINE TO ADD A CARD TO ROW I
1110 HANDSLENS(I)=HANDSLENS(I)+1
1120 HANDS(I,HANDSLENS(I))=X
1130 Q=HANDTOTAL(I)
1140 GOSUB 500
1150 HANDTOTAL(I)=Q
1160 IF Q>=0 THEN GOTO 1190
1170 PRINT "...BUSTED"
1180 GOSUB 1200
1190 RETURN
1200 REM--SUBROUTINE TO DISCARD ROW I
1210 IF HANDSLENS(I)<>0 THEN GOTO 1230
1220 RETURN
1230 D=D+1
1240 DISCARDECK(D)=HANDS(I,HANDSLENS(I))
1250 HANDSLENS(I)=HANDSLENS(I)-1
1260 GOTO 1210
1300 REM--PRINTS TOTAL OF HAND I
1310 PRINT
1320 AA=HANDTOTAL(I)
1321 GOSUB 3400
1325 PRINT "TOTAL IS ";AA
1330 RETURN
1400 REM--SUBROUTINE TO READ REPLY
1410 REM  ISTR DEFINED ELSEWHERE
1420 INPUT HSTR
1421 HSTR=LEFT(HSTR,1)
1430 FOR H=1 TO H1 STEP 2
1440   IF HSTR==MID(ISTR,H,1) THEN GOTO 1480
1450 NEXT
1460 PRINT "TYPE ";MID(ISTR,1,H1-1);" OR ";MID(ISTR,H1,2);" PLEASE";
1470 GOTO 1420
1480 H=(H+1)/2
1490 RETURN
1500 REM--PROGRAM STARTS HERE
1510 REM--INITIALIZE
1520 DSTR="N A  2  3  4  5  6  7N 8  9 10  J  Q  K"
1530 ISTR="H,S,D,/,"
1540 FOR I=1 TO 13
1550   FOR J=4*I-3 TO 4*I
1560     DISCARDECK(J)=I
1570   NEXT
1580 NEXT
1590 D=52
1600 C=53
1610 PRINT "DO YOU WANT INSTRUCTIONS";
1620 INPUT HSTR
1630 IF LEFT(HSTR,1)=="N" OR LEFT(HSTR,1)=="n" THEN GOTO 1760
1640 PRINT "THIS IS THE GAME OF 21. AS MANY AS 7 PLAYERS MAY PLAY THE"
1650 PRINT "GAME. ON EACH DEAL, BETS WILL BE ASKED FOR, AND THE"
1660 PRINT "PLAYERS' BETS SHOULD BE TYPED IN. THE CARDS WILL THEN BE"
1670 PRINT "DEALT, AND EACH PLAYER IN TURN PLAYS HIS HAND. THE"
1680 PRINT "FIRST RESPONSE SHOULD BE EITHER 'D', INDICATING THAT THE"
1690 PRINT "PLAYER IS DOUBLING DOWN, 'S', INDICATING THAT HE IS"
1700 PRINT "STANDING, 'H', INDICATING HE WANTS ANOTHER CARD, OR '/',"
1710 PRINT "INDICATING THAT HE WANTS TO SPLIT HIS CARDS. AFTER THE"
1720 PRINT "INITIAL RESPONSE, ALL FURTHER RESPONSES SHOULD BE 'S' OR"
1730 PRINT "'H', UNLESS THE CARDS WERE SPLIT, IN WHICH CASE DOUBLING"
1740 PRINT "DOWN IS AGAIN PERMITTED. IN ORDER TO COLLECT FOR"
1750 PRINT "BLACKJACK, THE INITIAL RESPONSE SHOULD BE 'S'."
1760 PRINT "NUMBER OF PLAYERS";
1770 INPUT N
1771 ZARR=DIM(N)
1775 PRINT
1780 IF N<1 OR N>7 OR N>INT(N) THEN GOTO 1760
1790 FOR I=1 TO 8
1791   PLRSUM(I)=0
1792 NEXT
1800 D1=N+1
1810 IF 2*D1+C>=52 THEN GOSUB 120
1820 IF C==2 THEN C=C-1
1830 FOR I=1 TO N
1831   ZARR(I)=0
1832 NEXT
1840 FOR I=1 TO 15
1841   BETS(I)=0
1842 NEXT
1850 FOR I=1 TO 15
1851   HANDTOTAL(I)=0
1852 NEXT
1860 FOR I=1 TO 7
1861   PLRHNDSUM(I)=0
1862 NEXT
1870 FOR I=1 TO 15
1871   HANDSLENS(I)=0
1872 NEXT
1880 PRINT "BETS:"
1890 FOR I=1 TO N
1891   PRINT "# ";I;
1892   INPUT ZARR(I)
1893 NEXT
1900 FOR I=1 TO N
1910   IF ZARR(I)<=0 OR ZARR(I)>500 THEN GOTO 1880
1920   BETS(I)=ZARR(I)
1930 NEXT
1940 PRINT "PLAYER ";
1950 FOR I=1 TO N
1960   PRINT I;"   ";
1970 NEXT
1980 PRINT "DEALER"
1990 FOR J=1 TO 2
2000   PRINT SPC(5);
2010   FOR I=1 TO D1
2020     GOSUB 100
2030     HANDS(I,J)=X
2040     IF J==1 OR I<=N THEN GOSUB 750
2050   NEXT
2060   PRINT
2070 NEXT
2080 FOR I=1 TO D1
2090   HANDSLENS(I)=2
2100 NEXT
2110 REM--TEST FOR INSURANCE
2120 IF HANDS(D1,1)>1 THEN GOTO 2240
2130 PRINT "ANY INSURANCE";
2140 INPUT HSTR
2150 IF LEFT(HSTR,1)<>"Y" THEN GOTO 2240
2160 PRINT "INSURANCE BETS"
2170 FOR I=1 TO N
2171   PRINT "# ";I;
2172   INPUT ZARR(I)
2173 NEXT
2180 FOR I=1 TO N
2190   IF ZARR(I)<0 OR ZARR(I)>BETS(I)/2 THEN GOTO 2160
2200 NEXT
2210 FOR I=1 TO N
2220   PLRHNDSUM(I)=ZARR(I)*(3*(-(HANDS(D1,2)>=10))-1)
2230 NEXT
2240 REM--TEST FOR DEALER BLACKJACK
2250 L1=1
2251 L2=1
2252 IF HANDS(D1,1)==1 AND HANDS(D1,2)>9 THEN L1=0
2253 L2=0
2254 IF HANDS(D1,2)==1 AND HANDS(D1,1)>9 THEN L1=0
2255 L2=0
2256 IF L1<>0 OR L2<>0 THEN GOTO 2320
2260 PRINT
2261 PRINT "DEALER HAS A";MID(DSTR,3*HANDS(D1,2)-2,3);" IN THE HOLE ";
2270 PRINT "FOR BLACKJACK"
2280 FOR I=1 TO D1
2290   GOSUB 300
2300 NEXT
2310 GOTO 3140
2320 REM--NO DEALER BLACKJACK
2330 IF HANDS(D1,1)>1 AND HANDS(D1,1)<10 THEN GOTO 2350
2340 PRINT
2341 PRINT "NO DEALER BLACKJACK."
2350 REM--NOW PLAY THE HANDS
2360 REM--FOR I=1 TO N--
2361 I=1
2370   PRINT "PLAYER ";I;
2380   H1=7
2390   GOSUB 1410
2400   REM--ON H GOTO 2550,2410,2510,2600--
2401   IF H==1 THEN GOTO 2550
2402   IF H==2 THEN GOTO 2410
2403   IF H==3 THEN GOTO 2510
2404   IF H==4 THEN GOTO 2600
2410   REM--PLAYER WANTS TO STAND
2420   GOSUB 300
2430   IF HANDTOTAL(I)<>21 THEN GOTO 2490
2440   PRINT "BLACKJACK"
2450   PLRHNDSUM(I)=PLRHNDSUM(I)+1.5*BETS(I)
2460   BETS(I)=0
2470   GOSUB 1200
2480   GOTO 2900
2490   GOSUB 1320
2500   GOTO 2900
2510   REM--PLAYER WANTS TO DOUBLE DOWN
2520   GOSUB 300
2530   GOSUB 860
2540   GOTO 2900
2550   REM--PLAYER WANTS TO BE HIT
2560   GOSUB 300
2570   H1=3
2580   GOSUB 950
2590   GOTO 2900
2600   REM--PLAYER WANTS TO SPLIT
2610   L1=HANDS(I,1)
2611   IF HANDS(I,1)>10 THEN L1=10
2612   L2=HANDS(I,2)
2613   IF HANDS(I,2)>10 THEN L2=10
2614   IF L1==L2 THEN GOTO 2640
2620   PRINT "SPLITTING NOT ALLOWED."
2630   GOTO 2370
2640   REM--PLAY OUT SPLIT
2650   I1=I+D1
2660   HANDSLENS(I1)=2
2670   HANDS(I1,1)=HANDS(I,2)
2680   BETS(I+D1)=BETS(I)
2690   GOSUB 100
2700   PRINT "FIRST HAND RECEIVES A";
2710   GOSUB 700
2720   HANDS(I,2)=X
2730   GOSUB 300
2740   PRINT
2750   GOSUB 100
2760   PRINT "SECOND HAND RECEIVES A";
2770   I=I1
2780   GOSUB 700
2790   HANDS(I,2)=X
2800   GOSUB 300
2810   PRINT
2820   I=I1-D1
2830   IF HANDS(I,1)==1 THEN GOTO 2900
2840   REM--NOW PLAY THE TWO HANDS
2850   PRINT "HAND ";(1-(I>D1));
2860   GOSUB 800
2870   I=I+D1
2880   IF I==I1 THEN GOTO 2850
2890   I=I1-D1
2900 REM--NEXT I--
2901 I=I+1
2902 IF I<=N THEN GOTO 2370
2910 GOSUB 300
2920 REM--TEST FOR PLAYING DEALER'S HAND
2930 FOR I=1 TO N
2940   IF HANDSLENS(I)>0 OR HANDSLENS(I+D1)>0 THEN GOTO 3010
2950 NEXT
2960 PRINT "DEALER HAD A";
2970 X=HANDS(D1,2)
2980 GOSUB 700
2990 PRINT " CONCEALED."
3000 GOTO 3140
3010 PRINT "DEALER HAS A";MID(DSTR,3*HANDS(D1,2)-2,3);" CONCEALED ";
3020 I=D1
3030 AA=HANDTOTAL(I)
3031 GOSUB 3400
3035 PRINT "FOR A TOTAL OF ";AA
3040 IF AA>16 THEN GOTO 3130
3050 PRINT "DRAWS";
3060 GOSUB 100
3070 GOSUB 750
3080 GOSUB 1100
3090 AA=Q
3091 GOSUB 3400
3095 IF Q>0 AND AA<17 THEN GOTO 3060
3100 HANDTOTAL(I)=Q-(Q<0)/2
3110 IF Q<0 THEN GOTO 3140
3120 AA=Q
3121 GOSUB 3400
3125 PRINT "---TOTAL IS ";AA
3130 PRINT
3140 REM--TALLY THE RESULT
3150 REM 
3160 ZSTR="LOSES PUSHES WINS "
3165 PRINT
3170 REM--FOR I=1 TO N--
3171 I=1
3180   AA=HANDTOTAL(I)
3181   GOSUB 3400
3182   AB=HANDTOTAL(I+D1)
3183   GOSUB 3410
3184   AC=HANDTOTAL(D1)
3185   GOSUB 3420
3186   PLRHNDSUM(I)=PLRHNDSUM(I)+BETS(I)*SGN(AA-AC)+BETS(I+D1)*SGN(AB-AC)
3188   BETS(I+D1)=0
3200   PRINT "PLAYER ";I;
3210   PRINT MID(ZSTR,SGN(PLRHNDSUM(I))*6+7,6);" ";
3220   IF PLRHNDSUM(I)<>0 THEN GOTO 3250
3230   PRINT "      ";
3240   GOTO 3260
3250   PRINT ABS(PLRHNDSUM(I));
3260   PLRSUM(I)=PLRSUM(I)+PLRHNDSUM(I)
3270   PRINT "TOTAL= ";PLRSUM(I)
3280   GOSUB 1200
3290   PLRSUM(D1)=PLRSUM(D1)-PLRHNDSUM(I)
3300   I=I+D1
3310   GOSUB 1200
3320   I=I-D1
3330 REM--NEXT I--
3331 I=I+1
3332 IF I<=N THEN GOTO 3180
3340 PRINT "DEALER'S TOTAL= ";PLRSUM(D1)
3345 PRINT
3350 GOSUB 1200
3360 GOTO 1810
3400 AA=AA+11*(AA>=22)
3401 RETURN
3410 AB=AB+11*(AB>=22)
3411 RETURN
3420 AC=AC+11*(AC>=22)
3421 RETURN