home *** CD-ROM | disk | FTP | other *** search
10 '*************************************************************************** '**** **** 11 '**** KAYPRO 10 BLACKJACK Version 2.1 7/14/89 **** '**** **** 12 '**** by Richard S. Altman **** '**** P.O. Box 4388 **** 13 '**** Clearlake, CA 95422 **** '**** **** 14 '**** (c) 1989 by Richard Altman. All Rights Reserved. **** '**** **** 15 '*************************************************************************** 16 ' 17 ' USER SUPPORTED 18 ' -------------- 19 ' 20 ' This program is user-supported software. It is copyrighted and cannot 21 ' be sold for profit (without the author's express written permission), but 22 ' it may be copied and distributed for free. 23 ' 24 ' The SHAREWARE concept is a distribution method that dispenses with 25 ' heavy marketing/advertising costs and gives the user the opportunity to 26 ' try a software program before buying. Its continued existence depends on 27 ' each user paying for what he does, in fact, use. 28 ' 29 ' If you plan to continue to use this program [BLACKJACK], please send 30 ' the $20 (or more) registration fee directly to the author: 31 ' 32 ' Richard S. Altman 33 ' P.O. Box 4388 34 ' Clearlake, CA 95422-4388 35 ' 36 ' Upon registration, you will receive a floppy diskette containing the 37 ' latest version of this program, as well as a printed manual detailing its 38 ' uses and specifications. You will also receive a Blackjack TUTORIAL, 39 ' a FREE calendar printing program, and other programs by the same author. 40 ' 41 ' WHEN ORDERING, please be sure to indicate single or double density 42 ' disk drive, and the name of the program [BLACKJACK.BAS]. Comments on pro- 43 ' grams are also most welcome! 44 ' 45 ' Due to possible unforeseen circumstances, the above offer is subject 46 ' to change without notice. 47 ' 48 CLEAR:DEFINT A-S,V-Z:DEFSTR D-F,I:DIM A(111),AA(3,8),JJ(3,8),F(24) 49 CLS$=CHR$(26):PRINT CLS$:GOSUB 7000:WIDTH 255:GOTO 200:' 50 ' ******************************************* *** Miscellaneous Subroutines *** ******************************************* 52 IF BK>999 THEN DP="#####":GOTO 56 54 IF BK>99 THEN DP="####":GOTO 56 ELSE DP="###" 56 PRINT USING DP;BK;:RETURN 58 PRINT F(21);:GOSUB 5010:PRINT" "L$"'s turn " DSCR:RETURN 60 IF UX=0 AND X=1 AND (JA=0 OR JA=1011) THEN 68 62 IF UX=9 AND X=1 AND (JB=0 OR JB=1011) THEN 68 64 IF UX=0 AND X=2 AND (JC=0 OR JC=1011) THEN 68 66 IF UX=9 AND X=2 AND (JD=0 OR JD=1011) THEN 68 ELSE RETURN 68 U=21.5:T(X)=T(X)+TB(X)*1.5:RETURN 70 PRINT F(21) DSCR:IF M=1 THEN PS$=FNF(6,61):RETURN 72 IF M=2 THEN PS$=FNF(11,61):RETURN ELSE PS$=FNF(17,61):RETURN 74 PRINT STRING$(79,8) CHR$(11) DCLEAR:RETURN:' Clear Prev. Line 76 PRINT CLS$:PRINT DS:PRINT" "E5;TAB(30)"B L A C K J A C K"; 78 PRINT TAB(67);E5:PRINT DS:PRINT:RETURN 80 IQ=INKEY$:FOR G=1 TO 1000:IF INKEY$=CHR$(13) THEN RETURN ELSE NEXT:RETURN 82 ' Money Display Routine 84 TA=ABS(TT) 86 IF TA>999999! THEN U$="$#####,####.##":GOTO 98 88 IF TA>99999! THEN U$="$####,####.##":GOTO 98 90 IF TA>9999 THEN U$="$###,####.##":GOTO 98 92 IF TA>999 THEN U$="$##,####.##":GOTO 98 94 IF TA>99 THEN U$="$#####.##":GOTO 98 96 U$="$####.##" 98 PRINT USING U$;TA;:RETURN 100 PRINT CLS$:PRINT FB:PRINT FL:PRINT" ***" TAB(30); 102 PRINT"B L A C K J A C K"TAB(71)"***":PRINT FL:PRINT FB:RETURN 104 IF U=21.5 THEN RETURN 106 T(X)=T(X)+TB(X):RETURN:' Add to Player's score. 108 T(X)=T(X)-TB(X):RETURN:' Subtract from Player's score. 110 PRINT F1 A$ F2 B$ F3"DEALER":RETURN 112 ' 200 ' Preparation for BLACKJACK 205 ' 210 IF FTEMP="*" THEN 240 215 PRINT FNF(24,14)"(c) 1989 by Richard Altman -- All Rights Reserved."FNF(15,20) I7"Do you want instructions (Y or N) ? "; 220 FK=INKEY$:IF FK="" THEN COUNTER=COUNTER+1:GOTO 220 225 IF FK="Y" OR FK="y" OR FK="N" OR FK="n" OR FK=CHR$(13) THEN 230 ELSE 220 230 PRINT:RANDOMIZE COUNTER:GOSUB 74 235 IF FK="Y" OR FK="y" THEN 4000 240 'ND=2:NP=2:A$="RICH":B$="LINDA":C=ND*52:T1=500:T2=350:GOTO 270 245 PRINT F(12);:INPUT".... 1 or 2 decks";ND:IF ND<>1 THEN ND=2 250 PRINT FNF(12,20) ND DCLEAR:C=ND*52 255 PRINT F(14);:INPUT".... 1 or 2 players";NP:IF NP<>1 THEN NP=2 260 PRINT FNF(14,22) NP DCLEAR:A$="":B$="" 265 PRINT FNF(16,9)DSCR;:INPUT"Enter first name of Player #1--- ";A$:IF NP=2 THEN PRINT FNF(17,9);:INPUT"Enter first name of Player #2--- ";B$ ELSE B$="" 270 L1=LEN(A$):IF L1=0 THEN 265 ELSE FOR X=1 TO L1 275 IF ASC(MID$(A$,X,1))>90 THEN MID$(A$,X,1)=CHR$(ASC(MID$(A$,X,1))-32) 280 NEXT:L2=LEN(B$):IF NP=2 AND L2=0 THEN 265 ELSE FOR X=1 TO L2 285 IF ASC(MID$(B$,X,1))>90 THEN MID$(B$,X,1)=CHR$(ASC(MID$(B$,X,1))-32) 290 NEXT 295 ' 300 ' ************************************* ***** INITIAL SET-UP ***** ************************************* 305 PRINT F(12) DSCR:GOSUB 5500 310 FOR X=1 TO ND:N=(X-1)*52:FOR Y=1 TO 52:A(N+Y)=Y:NEXT Y,X 315 FOR L=1 TO 104:X=INT(RND(C)*100):Y=INT(RND(C)*100):A=A(X):A(X)=A(Y):A(Y)=A 320 NEXT:' GOSUB 385 325 J=1:GOSUB 5020:PRINT I7:GOTO 500 330 ' 350 ' ************************************* ***** SHUFFLE ***** ************************************* 355 LC=1:RANDOMIZE COUNTER+FNRN(COUNTER):GOSUB 5025 360 PRINT F(20) E1:PRINT E2:PRINT E3:PRINT E2:PRINT E1; 365 FOR L=1 TO 104:X=FNRN(C):Y=FNRN(C):A=A(X):A(X)=A(Y):A(Y)=A 370 GOSUB 380:NEXT L:' GOSUB 385 375 J=1:IF JS=0 THEN PRINT CLS$:GOTO 5020 ELSE PRINT F(19) DSCR 380 IF L=10 OR L=30 OR L=50 OR L=70 OR L=90 THEN PRINT F(20) E1:PRINT E2:PRINT E2:PRINT E2:PRINT E1;:RETURN ELSE IF L=20 OR L=40 OR L=60 OR L=80 THEN PRINT F(20) E1:PRINT E2:PRINT E3:PRINT E2:PRINT E1;:RETURN ELSE RETURN 385 FOR L=C-14 TO C-3:J=L:GOSUB 350:R1=R:J=L+3:GOSUB 350:IF R=R1 THEN FOR L1=LC TO 40:IF A(L1)<>A(L) THEN A=A(L1):A(L1)=A(L):A(L)=A:LC=LC+1:NEXT 390 RETURN 395 ' 400 ' ************************************* ***** DETERMINE SUIT, RANK ***** ************************************* 410 AJ=A(J):S=INT((AJ-1)/13):R=AJ-S*13: 'GOSUB 430 420 RETURN 430 IF M=3 THEN RETURN ELSE PRINT F(1) DCLEAR"Suit="S+1" Rank="R" --- "; 440 INPUT"Input Rank (1-13)";RR:IF RR<>0 THEN R=RR 450 GOSUB 460:A(J)=S*13+R:PRINT F(1) DCLEAR:RETURN 460 IF A(J)=(S+1)*13+R THEN S=S+1:RETURN ELSE RETURN 470 ' 500 ' ************************************* ***** PLACE BETS ***** ************************************* 504 'TB(1)=T1:TB(2)=T2:JS=0:GOTO 555 505 TB(1)=T1:TB(2)=T2:GOSUB 76:XF=1:PRINT FNF(8,1) A$" "; 510 FOR X=1 TO NP:PRINT FNF(10,XF)" Last Bet was: "; 515 TT=TB(X):GOSUB 84:PRINT FNF(12,XF)DSCR;:INPUT" Place Bet_____ ";TB$ 520 TB=VAL(TB$):IF TB<>0 THEN TB(X)=TB 525 IF TB(X)=0 THEN TB(X)=50 530 IF TB(X)>50000! THEN L$=" Maximum Bet is $ 50,000.00 "+I7:GOTO 570 535 PRINT FNF(12,XF+19);:TT=TB(X):GOSUB 84 540 IF TB(X)=9999 THEN PRINT CLS$:PRINT:PRINT"End of Program":PRINT:SYSTEM 545 IF X=1 AND NP=2 THEN XF=41:PRINT FNF(8,XF) B$" "; 550 T1=TB(1):T2=TB(2):NEXT:JS=0:FOR TX=1 TO 300:NEXT 555 IF J>C-10 THEN GOSUB 350 560 GOSUB 600:JS=0:GOTO 700 565 ' 570 L$=FNF(12,XF+4)+L$:GOSUB 5075:GOSUB 80:PRINT 575 TB(1)=T1:TB(2)=T2:GOTO 515 580 ' 600 ' ************************************* ***** DISPLAY CARDS ***** ************************************* 605 PRINT CLS$:BJ=0:PRINT F(3) DL 610 FOR N=1 TO 2:FOR M=1 TO 3 STEP 3-NP 615 IF M<>3 OR N<>1 THEN 620 ELSE 650 620 IF NP=1 AND M=2 THEN M=3 625 GOSUB 2050:A(108+M)=A(108+M)+R 630 AA(M,N)=R:JJ(M,N)=J-1 635 NEXT M,N:RETURN 650 ' ************************************* ***** (Dealer's 1st Card) ***** ************************************* 655 GOSUB 400:A(0)=A(J):J=J+1:IF R>9 THEN R=10 660 IF R=1 THEN R=1001 665 N=1:GOSUB 2000:PRINT STRING$(3,11) STRING$(8,8) D1 DDOWN D1 DDOWN D1 670 A(111)=R:PRINT F(20) DL 675 GOTO 635 700 ' ************************************* ***** DEALER ACE ??? ***** ************************************* 705 X=0:Y=0:IF R=1001 THEN 800 710 IF A(111)=1011 THEN 900 715 GOTO 1000 800 ' ************************************* ***** INSURANCE, etc. ***** ************************************* 805 GOSUB 110:GOSUB 5050:GOSUB 845 810 IX=INKEY$:IF IX="" THEN 810 ELSE X=VAL(IX) 815 IF X<1 OR X>2 THEN 810 820 IF NP=1 THEN 840 825 GOSUB 110:GOSUB 5055:GOSUB 845 830 IY=INKEY$:IF IY="" THEN 830 ELSE Y=VAL(IY) 835 IF Y<1 OR Y>2 THEN 830 840 IF A(111)<>1011 THEN 950 ELSE 900 845 PRINT F(22) DSCR;:GOSUB 5010:PRINT" "L$" ";:GOSUB 5015 850 PRINT FNF(22,LEN(L$)+9) INSUR$;:RETURN 900 ' ************************************* ***** Dealer Blackjack !! ***** ************************************* 905 GOSUB 110:H=J:J=0:N=1:M=3:GOSUB 2100 910 PRINT FNF(17,32)DJ F(22) DSCR:L$="DEALER" 915 J=H:BJ(3)=BJ(3)+1 920 IF X=1 THEN TB(1)=0 925 IF Y=1 THEN TB(2)=0 930 V=21:BD=9:GOTO 2590 950 ' ************************************* ***** NO Dealer Blackjack ***** ************************************* 955 PRINT F(22) DSCR" ... NO BLACKJACK ... ";:GOSUB 80 960 IF X=1 THEN T(1)=T(1)-TB(1)*.5 965 IF Y=1 THEN T(2)=T(2)=TB(2)*.5 970 ' 1000 ' ************************************* ***** DEAL and PLAY ***** ************************************* 1010 PL=NP:FOR M=1 TO NP:N=3 1020 C1=AA(1,1):C2=AA(1,2):C3=AA(2,1):C4=AA(2,2) 1030 GOSUB 110 1040 IF M=1 THEN GOSUB 5050:GOSUB 58 1050 IF M=2 THEN GOSUB 5055:GOSUB 58 1060 IF JR=9 AND ((M=1 AND C1=1001) OR (M=2 AND C3=1001)) THEN IL=IJ ELSE IL=IK 1070 GOSUB 5015:PRINT F(23) IL DCLEAR;:X=5:DD=F 1080 IF JR=0 AND JS=0 THEN PRINT", 3--DOUBLE DOWN";:IF (M=1 AND N=3 AND C1=C2 AND C1<>10) OR (M=2 AND N=3 AND C3=C4 AND C3<>10) THEN PRINT", "I7;:GOSUB 5100 1090 PRINT" ? "; 1100 IF IL=IJ THEN 5125 1110 II=INKEY$:IX="" 1120 IX=INKEY$:IF IX="" OR IX<"1" OR IX>"4" THEN 1120 ELSE X=VAL(IX) 1130 IF JR=9 AND ((M=1 AND C1=1001) OR (M=2 AND C3=1001)) THEN 1500 1140 IF JR=9 AND X>2 THEN 1110 1150 Q=M+108:IF N=3 AND A(Q)=1011 THEN 1500 1160 IF X=1 THEN 1400 1170 IF X=2 THEN GOSUB 74:GOTO 1500 1180 IF X=3 THEN 1600 1190 IF X=4 THEN 1700 1200 ' 1400 ' ************************************* ***** H I T ***** ************************************* 1410 GOSUB 74:GOSUB 2050 1420 A(Q)=A(Q)+R 1430 IF A(Q)<1000 AND A(Q)>21 THEN 1460 1440 IF A(Q)-(INT(A(Q)/1000)*1000)>21 THEN 1460 1450 N=N+1:IF DD="DD" THEN DD=D:GOTO 1500 ELSE 1060 1460 GOSUB 110:BU=BU+1:BX=1:GOSUB 5150:' BUST 1470 ' 1500 ' ************************************* ***** S T A N D ***** ************************************* 1510 GOSUB 110:JS=0:IF N=3 AND A(Q)=1011 THEN T(M+2)=T(M+2)+1:BJ=BJ+1:BJ(M)=BJ(M)+1:GOSUB 1540:IF JR=9 THEN GOSUB 80:IF BJ>1 AND (C1=1001 OR C3=1001) THEN BJ=BJ-1 1520 IF JR=9 THEN RETURN 1530 NEXT M:GOTO 2500 1540 IF M=1 THEN PRINT FNF(6,32)DJ;:RETURN ELSE PRINT FNF(11,32)DJ;:RETURN 1550 ' 1600 ' ************************************* ***** D O U B L E D O W N ***** ************************************* 1610 IF N<>3 THEN 1110 1620 DD="DD":TB(M)=TB(M)*2:GOTO 1400 1630 ' 1700 ' ************************************* ***** S P L I T P A I R ***** ************************************* 1710 IF (M=1 AND N=3 AND C1=C2 AND C1<>10) OR (M=2 AND N=3 AND C3=C4 AND C3<>10) THEN 1760 ELSE 1110 1720 IF M=1 THEN PRINT I1 DCLEAR ELSE PRINT I2 DCLEAR 1730 FOR X=1 TO 5:PRINT DCLEAR:IF X>1 THEN 1750 1740 IF M=1 THEN GOSUB 5050 ELSE GOSUB 5055 1750 NEXT:RETURN 1760 PRINT F(23) IK DSCR;:PL=PL+1:BC=BC+M 1770 FOR JX=1 TO 2:GOSUB 1720:BX=0 1780 JL=J:J=JJ(M,JX):N=1:GOSUB 2050:A(Q)=R:J=JL 1790 N=2:GOSUB 2050:A(Q)=A(Q)+R:N=3 1800 JR=9:GOSUB 1060 1810 IF M=1 AND JX=1 THEN JA=A(Q):A(Q)=0 : IF BX=1 THEN BB=1 1820 IF M=1 AND JX=2 THEN JB=A(Q):A(Q)=JA: IF BX=1 THEN BB=BB+2 1830 IF M=2 AND JX=1 THEN JC=A(Q):A(Q)=0 : IF BX=1 THEN BB=BB+4 1840 IF M=2 AND JX=2 THEN JD=A(Q):A(Q)=JC: IF BX=1 THEN BB=BB+8 1850 NEXT JX:JR=0:IF BB=0 THEN BU=0:BB=16:GOTO 1530 1860 IF BB=15 THEN BU=2:GOTO 1530 1870 IF NP=1 AND BB=3 THEN BU=1:GOTO 1530 ELSE BU=NP-1:GOTO 1530 1880 ' 2000 ' ************************************* ***** DRAW CARD OUTLINE ***** ************************************* 2010 GOSUB 2240:GOSUB 5030:PRINT ITL ITM ITR DOWN; 2020 PRINT ITL F7 ITL DOWN ITL F7 ITL DOWN ITL F7 ITL DOWN; 2030 PRINT IBL IBM IBR;:GOSUB 5035:RETURN 2040 ' 2050 JS=9 2100 ' ************************************* ***** PRINT SUIT and RANK ***** ************************************* 2110 GOSUB 400:GOSUB 2000:PRINT STRING$(3,11) STRING$(8,8); 2120 IF R=1 THEN PRINT" ACE ";:R=1001:GOTO 2170 2130 IF R=11 THEN PRINT" JACK ";:R=10:GOTO 2170 2140 IF R=12 THEN PRINT" QUEEN ";:R=10:GOTO 2170 2150 IF R=13 THEN PRINT" KING ";:R=10:GOTO 2170 2160 IF R=10 THEN PRINT" 10 "; ELSE PRINT" "R" "; 2170 GOSUB 5200 2180 IF S<=0 THEN PRINT" HEART";:GOTO 2220 2190 IF S=1 THEN PRINT" D'MND";:GOTO 2220 2200 IF S=2 THEN PRINT" SPADE";:GOTO 2220 2210 IF S=3 THEN PRINT" CLUBS"; 2220 J=J+1:IF J>C THEN GOSUB 350 2230 RETURN 2240 P=N-1:IF M=1 THEN 2250 ELSE IF M=2 THEN 2260 ELSE 2270 2250 IF N=1 THEN PRINT I1;:RETURN ELSE PRINT I1 STRING$(P*10,12);:RETURN 2260 IF N=1 THEN PRINT I2;:RETURN ELSE PRINT I2 STRING$(P*10,12);:RETURN 2270 IF N=1 THEN PRINT I3;:RETURN ELSE PRINT I3 STRING$(P*10,12);:RETURN 2280 ' 2500 ' ************************************* ***** S C O R E H A N D S ***** ************************************* 2510 PRINT F(21) DSCR:GOSUB 110:PRINT F3;:L$="DEALER":GOSUB 5060 2520 N=1:M=3:W=J:J=0:GOSUB 2100:J=W:VV=0 2530 V=A(111):N=3:IF BU=PL OR BJ=2 OR (BU=PL-1 AND BJ=1) THEN VV=1:' Both players have finished. 2540 UX=0:W=V/1000:V=V-W*1000:X=0:IF W>0 THEN X=1 2550 IF V>16 THEN 2590 2560 IF X>0 AND V+10>16 AND V+10<22 THEN V=V+10:GOTO 2590 2570 IF VV=1 THEN 2590 ELSE GOSUB 2050 2580 V=V+R+W*1000:N=N+1:GOTO 2540:' Dealer gets another card. 2590 FOR X=1 TO NP:U=A(108+X):' U=Player, V=Dealer 2600 Y=U/1000:U=U-Y*1000 2610 IF Y>0 AND U+10<22 THEN U=U+10:' Add 10 if Ace is present. 2620 U(X)=U:IF U>21.5 THEN U=0:' Player's hand went BUST. 2630 IF T(X+2)>0 THEN GOSUB 60:' T(X+2) had Blackjack! 2640 BU=C+X:H=BU+2:IF V>21 AND VV=0 THEN V=1:GOSUB 5150 ELSE GOSUB 3200:' Dealer (also) went BUST. 2650 PRINT F3 L$:IF BC=0 THEN 2690:' No split hands. 2660 IF (X=1 AND BC=2) OR (X=2 AND BC<2) THEN 2690 ELSE 2750 2670 ' 2680 ' ********** No SPLIT hands 2690 IF V=U THEN WP=3:P(X)=P(X)+1:GOTO 2720 2700 IF V>U THEN WP=2:L(X)=L(X)+1:GOSUB 108:GOTO 2720 2710 IF V<U THEN WP=1:W(X)=W(X)+1:GOSUB 104 2720 MX=M:M=X:GOSUB 70:M=MX:PRINT PS$ DCLEAR;D(WP);:GOTO 2790 2730 ' 2740 ' ********** Score SPLIT hands 2750 IF V=U THEN PP(X)=PP(X)+1:GOTO 2790 2760 IF V>U THEN LL(X)=LL(X)+1:GOSUB 108:GOTO 2790 2770 IF V<U THEN WW(X)=WW(X)+1:GOSUB 104 2780 ' 2790 IF BB=0 THEN 2910:' IF BB=0 then NO splits/GOTO next player. 2800 IF X=1 THEN 2810 ELSE 2830:' else Score SPLITS ..... 2810 IF BC=0 OR BC=2 THEN 2910:' ..... for Player #1 2820 IF UX=9 THEN 2850 ELSE U=JB:UX=9:GOTO 2600 2830 IF BC=0 OR BC=1 THEN 2910:' ..... for Player #2 2840 IF UX=9 THEN 2850 ELSE U=JD:UX=9:GOTO 2600 2850 IF PP(X)=2 THEN WP=6:P(X)=P(X)+1:GOTO 2910 2860 IF WW(X)=2 THEN WP=4:W(X)=W(X)+1:GOTO 2910 2870 IF LL(X)=2 THEN WP=5:L(X)=L(X)+1:GOTO 2910 2880 IF PP(X)=1 AND WW(X)=1 THEN WP=7:W(X)=W(X)+1:GOTO 2910 2890 IF PP(X)=1 AND LL(X)=1 THEN WP=8:L(X)=L(X)+1:GOTO 2910 2900 IF WW(X)=1 AND LL(X)=1 THEN WP=9:P(X)=P(X)+1 2910 MX=M:M=X:GOSUB 70:M=MX:PRINT PS$ DCLEAR;D(WP);:UX=0:T(X+2)=0:NEXT 2920 PRINT F(23)">>>>> Press <";:L$=" T ":GOSUB 5075:PRINT"> only if you "; 2930 PRINT"want TOTALS displayed. ";:I=INKEY$:COUNT=0 2940 FK=INKEY$:IF FK="" THEN COUNT=COUNT+1:GOTO 2960 2950 IF FK="T" OR FK="t" THEN 3000 ELSE FK="XX":GOTO 3000 2960 IF COUNT>350 THEN 500 ELSE 2940 2970 ' 3000 ' ************************************* ***** PRINT SUMMARY ***** ************************************* 3010 PRINT CLS$:FOR X=107 TO 111:A(X)=0:NEXT 3020 BD=0:BC=0:BU=0:BB=0:JA=0:JB=0:JC=0:JD=0 3030 FOR X=1 TO 2:PP(X)=0:WW(X)=0:LL(X)=0:NEXT:TH=TH+1:IF FK="XX" THEN 500 3040 X=1:GOSUB 76:PRINT F(7) A$; 3050 IF T(X)=0 THEN L$="EVEN" ELSE IF T(X)<0 THEN L$="LOST" ELSE L$="WON" 3060 IF T(X)=0 THEN PRINT" is ";:GOSUB 5060:PRINT": $ 0.00"; 3070 IF T(X)<0 THEN PRINT" has ";:GOSUB 5060:PRINT": ";:TT=T(X):GOSUB 84 3080 IF T(X)>0 THEN PRINT" has ";:GOSUB 5060:PRINT": ";:TT=T(X):GOSUB 84 3090 IF X=1 THEN PRINT F(7); ELSE PRINT F(9); 3100 PRINT STRING$(35,12)"BJ= ";:BK=BJ(X):GOSUB 52 3110 PRINT" W= ";:BK=W(X):GOSUB 52 3120 PRINT" L= ";: BK=L(X):GOSUB 52 3130 PRINT" P= ";: BK=P(X):GOSUB 52 3140 PRINT:PRINT 3150 IF NP=2 AND X=1 THEN X=2:PRINT B$;:GOTO 3050 3160 PRINT DS:PRINT:PRINT TAB(43)"TOTAL HANDS= ";TH 3170 PRINT TAB(43)"DEALER BJ's= ";BJ(3):PRINT:PRINT DS 3180 PRINT F(23)"Press <ANY KEY> to continue. ";:I=INKEY$ 3190 IN=INKEY$:IF IN="" THEN 3190 ELSE 500 3200 IF V=1 OR BD=9 THEN RETURN 3210 PRINT FNF(17,61)" "V CHR$(8) CHR$(34) STRING$(4,8) CHR$(34);:RETURN 4000 ' ************************************* ***** DISPLAY INSTRUCTIONS ***** ************************************* 4005 GOSUB 76:PRINT F(8); 4010 PRINT F" This BLACKJACK program enables the operator to play head-" 4015 PRINT F"to-head with the computer, simulating the exact rules as those" 4020 PRINT F"on the Las Vegas strip.":PRINT 4025 PRINT F" The cards are dealt from one or two 52-card decks until a" 4030 PRINT F"hand starts with less than 12 cards remaining, in which case" 4035 PRINT F"they are shuffled again.":PRINT 4040 PRINT F" The dealer ";:L$="must":GOSUB 5060 4045 PRINT" HIT all totals up to 16 and STAND on all" 4050 PRINT F"totals of 17 and above.":PRINT:L$="repeat your last bet" 4055 PRINT F" When placing your bet, you may ";:GOSUB 5060 4060 PRINT" by ":PRINT F"simply pressing <RETURN>." 4065 FTEMP="continue.":GOSUB 6030 4070 PRINT CLS$ 4075 PRINT"The ";:L$="INSURANCE":GOSUB 5060 4080 PRINT" bet is offered at half the player's bet when the dealer's" 4085 PRINT"up-card is an Ace.":PRINT 4090 PRINT"You may ";:L$="DOUBLE DOWN":GOSUB 5060 4095 PRINT" on any two cards, and receive one more card while" 4100 PRINT"the original bet is doubled.":PRINT 4105 PRINT"You may ";:L$="SPLIT":GOSUB 5060 4110 PRINT" any pair, but resplitting is not allowed. Also, only one" 4115 PRINT"card is dealt to each of a pair of split aces." 4120 PRINT:PRINT:PRINT 4125 PRINT F"THE ";:L$=" COMMANDS ":GOSUB 5075 4130 PRINT" ARE AS FOLLOWS:" 4135 PRINT F;F"1 -- HIT (draw another card)" 4140 PRINT F;F"2 -- STAND (stand on current total)" 4145 PRINT F;F"3 -- DOUBLE DOWN (double your bet and draw one card)" 4150 PRINT F;F"4 -- SPLIT PAIR (form two hands from a pair with the" 4155 PRINT F;F;F"original bet on each hand)" 4160 L$=F(21)+"To exit program, enter ":GOSUB 5060:L$=" 9999 ":GOSUB 5075 4165 L$=" as a Bet. GOOD LUCK! ":GOSUB 5060 4170 FTEMP="START the game.":GOSUB 6030:PRINT CLS$ 4175 FTEMP="*":GOSUB 100:GOTO 210 4180 ' 5000 ' ************************************************** ********** MISC. SUBROUTINES ********** ************************************************** 5005 ' 5010 PRINT ESC "B0";:RETURN:' Inverse Video ON/OFF 5015 PRINT ESC "C0";:RETURN:' 5020 PRINT ESC "B4";:RETURN:' Turn Cursor ON/OFF 5025 PRINT ESC "C4";:RETURN:' 5030 PRINT ESC "B1";:RETURN:' Reduced Intensity ON/OFF 5035 PRINT ESC "C1";:RETURN:' 5040 PRINT ESC "B3";:RETURN:' Underline ON/OFF 5045 PRINT ESC "C3";:RETURN:' 5050 L$=A$:PRINT F1;:GOTO 5060:' Underline A$ 5055 L$=B$:PRINT F2;:' Underline B$ 5060 GOSUB 5040:PRINT L$;:GOSUB 5045:RETURN:' Underline On/Off Subroutine 5065 ' ----------------------------------- 5070 GOSUB 5010:GOSUB 5030:PRINT L$;:GOSUB 5015:GOTO 5035:' Rvrse Video 5075 GOSUB 5010:PRINT L$;:GOTO 5015:' BRITE Video 5080 ' 5100 GOSUB 5025:L$=" 4--SPLIT PAIR ":FOR XT=1 TO 6:GOSUB 5075:FOR TX=1 TO 150 5105 NEXT:PRINT STRING$(15,8) L$;:FOR TX=1 TO 175:NEXT:PRINT STRING$(15,8); 5110 NEXT XT:GOSUB 5020:PRINT LEFT$(L$,14)I7;:RETURN 5115 ' 5125 FKEY=FNF(23,55):GOSUB 5025 5130 IX=INKEY$:IF IX="" THEN 5135 ELSE 5225 5135 FOR TX=1 TO 300:NEXT:PRINT FKEY" "; 5140 FOR TX=1 TO 150:NEXT:PRINT FKEY"ANY KEY";:GOTO 5130 5145 ' 5150 PRINT F3"DEALER" 5155 GOSUB 5025:GOSUB 70:FOR AT=1 TO 3:' Flash "BUST" .......... 5160 PRINT PS$".BUST.";:FOR TA=1 TO 200:NEXT:' ... 5165 PRINT PS$ DCLEAR;:FOR TA=1 TO 100:NEXT TA,AT:PRINT PS$".BUST.";:' ... 5170 FOR TIMER=1 TO 600:NEXT:GOSUB 5020:PRINT PS$ DCLEAR:RETURN:' ... 5175 ' 5200 PRINT DOWNR;:RETURN:' Go DOWN one line 5225 PRINT F(24);:GOSUB 74:GOSUB 5020:GOTO 1130 5230 ' 5245 ' ***** Dealer 1st Card 5250 N=1:GOSUB 2000:PRINT STRING$(3,11) STRING$(8,8) D DDOWN D DDOWN D;:RETURN 5255 ' 5500 ' *************************************** ***** PRINT INITIAL "Shuffle" BOX ***** *************************************** 5510 GOSUB 5025:PRINT FNF(16,3);:FT=" " 5520 PRINT FT SPC(6) E1 5530 PRINT FT SPC(3) FG;:GOSUB 5580:PRINT FG 5540 PRINT FT SPC(3) FG;:GOSUB 5570:PRINT FG 5550 PRINT FT SPC(3) FG;:GOSUB 5580:PRINT FG 5560 PRINT FT SPC(3) E1;:RETURN 5570 L$=F7:GOSUB 5070:PRINT "= = = SHUFFLING = = =";:GOTO 5070 5580 L$=STRING$(35,32):GOTO 5070 5590 ' 6000 ' ************************************* ***** INKEY$ SUBROUTINES ***** ************************************* 6010 K$=INKEY$:I$="" 6020 I$=INKEY$:IF I$="" THEN 6020 ELSE RETURN 6030 ' 6040 PRINT F(24)" "E5" Press <RETURN> to ";FTEMP" "; 6050 K$=INKEY$:II="" 6060 II=INKEY$:IF II<>CHR$(13) THEN 6060 ELSE RETURN 6070 ' 7000 ' ************************************* ***** Set Up Variables ***** ************************************* 7005 FB=" "+STRING$(70,42):FL=" ***"+STRING$(64,32)+"***":GOSUB 100 7010 IJ=CHR$(187)+" Only ONE CARD dealt to each split Ace. "+CHR$(183) 7015 IJ=IJ+" Press <ANY KEY>":IK="OPTIONS: 1--HIT, 2--STAND" 7020 ITL=CHR$(213):ITM=STRING$(7,131):ITR=CHR$(215):IBL=CHR$(149) 7025 IBM=STRING$(7,176):IBR=CHR$(181):DOWN=CHR$(10)+STRING$(9,8) 7030 DL=STRING$(75,132):DJ="*** BLACKJACK ***":DCLEAR=CHR$(24):DSCR=CHR$(23) 7035 DS=STRING$(75,45):F=STRING$(6,32):F7=STRING$(7,32):FG=CHR$(42) 7040 FS=STRING$(60,12):ESC=CHR$(27):IE=ESC+"=":GOSUB 5020:E5=STRING$(7,132) 7045 FOR X=1 TO 24:F(X)=IE+CHR$(31+X)+" ":NEXT:DOWNR=CHR$(10)+STRING$(7,8) 7050 PS$(1)=F(4):PS$(2)=F(9):PS$(3)=F(15):INSUR$="INSURANCE 1=Yes/ 2=No " 7055 DEF FNF(X,Y)=IE+CHR$(X+31)+CHR$(Y+31):DEF FNRN(X)=INT(RND(X)*100) 7060 I1=FNF(4,5): I2=FNF(9,5): I3=FNF(15,5): DT="BOTH SPLITS ":D1=" ***** " 7065 F1=FNF(5,61):F2=FNF(10,61):F3=FNF(16,61):DDOWN=CHR$(10)+STRING$(7,8) 7070 D(7)="WIN/PUSH SPLITS":D(8)="LOSE/PUSH SPLITS":D(9)="WIN/LOSE SPLITS" 7075 D(1)="WIN":D(2)="LOSE":D(3)="PUSH":D(4)=DT+D(1):D(5)=DT+D(2):D(6)=DT+D(3) 7080 E1=STRING$(37,179):E2=FG+STRING$(35,32)+FG:I7=CHR$(7) 7085 E3=FG+F7+"= = = SHUFFLING = = = "+FG:RETURN 7090 ' (3) 7080 E1=STRING$(37,179):E2=FG+STRING$(35,32)+FG:I7=CHR$(7) 7085 E3=FG+F7+"= = = SHUFFLING = = = "+FG:RETURN 7 
