10 OPTION BASE 1
20 DEFINT CY
30 DIM A[52],CARD[52],HAND[10]
40 DIM EXPTIME[4]
50 DIM DHAND[10],DHANDV[10],DHANDS[10],PHAND[10],PHANDV[10],PHANDS[10]
60 DIM FORM[1001],INIT[4],EXIT[8]
70 FORMFH=0:MODE=0
80 DHVAL=0:PHVAL=0:PHCOUNT=0:DHCOUNT=0:TOPCARD=0:FFLAG=0
90 W=0:H=0:Q=0:F=0:WORD=0:S=0:FONTFH=0:ERC=0
100 TOTAL=0:NACES=0:HIHAND=0
110 IV=0:SUIT=0:V=0:I=0:P=0
120 FORMFILE$=<GAMES>BLACKJACK.FORM
130 FORMF$=BLACKJACK
140 TDH$=STRING$(35, ):BDH$=STRING$(35, )
150 TPH$=STRING$(35,H20):BPH$=STRING$(35,H20)
160 MSG1$=STRING$(73,H20):MSG2$=STRING$(73,H20)
170 BET$=STRING$(4,H20):BET=0
180 MC$=STRING$(5,H20)
190 INITDOLVAL=1000
200 TYPE$=character.
210 CBREAD=0
220 YOURTOTAL=INITDOLVAL
230 DEALERTOTAL=INITDOLVAL
240 YOURTOTAL=YOURTOTAL
250 DEALERTOTAL=DEALERTOTAL
260 '
270 FONT$=<games>CARD.FONT
280 GOSUB 3000  'LOADFONTRAM SUBROUTINE                
290 '
300 GOSUB 3280  'GET DATETIME
310  SEED=YEAR+DATE+MIN+SEC+10000
320 RANDOMIZE SEED
330 GOSUB 2230   ' SHUFFLE CARDS
340 TOPCARD=1
350 IF YOURTOTAL<=0 THEN 2020  ELSE IF DEALERTOTAL<=0 THEN 2020
360 FOR X=1 TO 10
370   DHAND[X]=0:PHAND[X]=0
380   DHANDV[X]=0:PHANDV[X]=0
390   DHANDS[X]=0:PHANDS[X]=0
400 NEXT X
410 MODE=H6D72 'mr
420 ERC=OPENFILE(PTR(FORMFH),PTR(FORMFILE$),LEN(FORMFILE$),,MODE)
430         IF ERC<>0 THEN 2950
440 ERC=OPENFORM(FORMFH,PTR(FORMF$),LEN(FORMF$),PTR(FORM[1]),2000)
450 ERC2=CLOSEFILE(FORMFH)
460         IF ERC<>0 THEN 2950
470         IF ERC2<>0 THEN 2950
480 ' CLEAR SCREEN  DISPLAY FORM CENTERED
490 PRINT CHR$(255)+PF+CHR$(255)+VF+CHR$(HC);
500 ERC=DISPLAYFORM(PTR(FORM[1]),0,255,255)
510           IF ERC<>0 THEN 2950
520  TYPE$=Binary.
530 ERC=WRITEFIELD(PTR(FORM[1]),PLAYERTOTAL,0,PTR(YOURTOTAL),2,PTR(TYPE$))
540         IF ERC<>0 THEN 2950
550 ERC=WRITEFIELD(PTR(FORM[1]),DEALERTOTAL,0,PTR(DEALERTOTAL),2,PTR(TYPE$))
560         IF ERC<>0 THEN 2950
570  TYPE$=Character.
580 '
590 ERC=USERFILLFIELD(PTR(FORM[1]),BET,0,PTR(INIT[1]),PTR(EXIT[1]))
600           IF ERC<>0 THEN 2950
610 ERC=READFIELD(PTR(FORM[1]),BET,0,PTR(BET$),4,PTR(CBREAD),PTR(TYPE$))
620           IF ERC<>0 THEN 2950
630 BET=VAL(BET$)                                                             
640 IF BET<0 THEN 2020
650 NOTE$=I'M SORRY YOU CANNOT BET MORE THAN YOU HAVE
660 IF BET<=YOURTOTAL THEN 720
670  MID$(MSG2$,1,LEN(NOTE$))=NOTE$
680 ERC=WRITEFIELD(PTR(FORM[1]),MESSAGELINE2,0,PTR(MSG2$),LEN(MSG2$),PTR(TYPE$))
690         IF ERC<>0 THEN 2950
700  MID$(MSG2$,1,LEN(NOTE$))=SPACE$(LEN(NOTE$))
710 GOTO 590
720 ERC=WRITEFIELD(PTR(FORM[1]),MESSAGELINE2,0,PTR(MSG2$),LEN(MSG2$),PTR(TYPE$))
730         IF ERC<>0 THEN 2950
740 'DEAL CARDS
750    PHAND[1]=CARD[TOPCARD]:PHAND[2]=CARD[TOPCARD+1]
760    DHAND[1]=CARD[TOPCARD+2]:DHAND[2]=CARD[TOPCARD+3]
770    PHCOUNT=2:DHCOUNT=2
780    TOPCARD=TOPCARD+4
790 FFLAG=0
800 'GET VALUE  SUIT FOR CARDS
810 FOR X=1 TO 10
820   IV=PHAND[X]
830   GOSUB 2460  'BREAK CARD INTO VALUE  SUIT
840   PHANDV[X]=V:PHANDS[X]=SUIT
850   IV=DHAND[X]
860   GOSUB 2460  'BREAK CARD INTO VALUE  SUIT
870   DHANDV[X]=V:DHANDS[X]=SUIT
880 NEXT X
890 '
900 TPH$=SPACE$(35):BPH$=SPACE$(35)
910 TDH$=SPACE$(35):BDH$=SPACE$(35)
920 '
930 ' DISPLAY CARDS
940     C1=159+2*PHANDV[1]:C2=159+2*PHANDV[2]
950   MID$(TPH$,1,6)=CHR$(C1)+CHR$(C1+1)+ +CHR$(C2)+CHR$(C2+1)+ 
960     C1=185+2*PHANDS[1]:C2=185+2*PHANDS[2]
970   MID$(BPH$,1,6)=CHR$(C1)+CHR$(C1+1)+ +CHR$(C2)+CHR$(C2+1)+ 
980     C1=255:C2=159+2*DHANDV[2]
990   MID$(TDH$,1,6)=CHR$(C1)+CHR$(C1)+ +CHR$(C2)+CHR$(C2+1)+ 
1000     C1=255:C2=185+2*DHANDS[2]
1010   MID$(BDH$,1,6)=CHR$(C1)+CHR$(C1)+ +CHR$(C2)+CHR$(C2+1)+ 
1020 GOSUB 2740  'PRINT HANDS
1030 '
1040 'GET PHAND VALUE IE: 20,21,22
1050  FOR X=1 TO 10
1060    HAND[X]=PHANDV[X]
1070  NEXT X
1080  GOSUB 2600  'GET VALUE OF HAND
1090  PHVAL=TOTAL
1100 '
1110  IF FFLAG<>0 THEN 1240
1120   FFLAG=1
1130 'GET DHAND VALUE
1140  FOR X=1 TO 10
1150    HAND[X]=DHANDV[X]
1160  NEXT X
1170 GOSUB 2600  'GET VALUE OF HAND
1180 DHVAL=TOTAL
1190 ' GOSUB PRINT DEALER'S FIRST CARD IF GAME IS OVER
1200 IF DHVAL=21 THEN IF PHVAL=21 THEN : GOSUB 2860 : GOTO 1830  'DRAW
1210 IF DHVAL=21 THEN GOSUB 2860 : GOTO 1730  'DEALER WINS
1220 IF PHVAL=21 THEN BET=BET*1.5 : GOSUB 2860 : GOTO 1780  'PLAYER WINS
1230 '
1240 ' INPUT MORE CARDS?  MC$
1250 IF PHVAL>21 THEN 1730    'DEALER WINS
1260 ERC=USERFILLFIELD(PTR(FORM[1]),MORECARDS,0,PTR(INIT[1]),PTR(EXIT[1]))
1270         IF ERC<>0 THEN 2950
1280 ERC=READFIELD(PTR(FORM[1]),MORECARDS,0,PTR(MC$),5,PTR(CBREAD),PTR(TYPE$))
1290         IF ERC<>0 THEN 2950
1300 IF MID$(MC$,1,2)=ST THEN 1460
1310 IF MID$(MC$,1,2)=HI THEN 1350
1320 GOTO 1240
1330 '
1340 'DEAL PLAYER ANOTHER CARD
1350   PHAND[PHCOUNT+1]=CARD[TOPCARD]
1360   PHCOUNT=PHCOUNT+1
1370   TOPCARD=TOPCARD+1
1380   IV=PHAND[PHCOUNT]
1390  GOSUB 2460  'GET VALUE AND SUIT
1400  PHANDV[PHCOUNT]=V:PHANDS[PHCOUNT]=SUIT
1410     C1=159+2*PHANDV[PHCOUNT]:C2=185+2*PHANDS[PHCOUNT]
1420   MID$(TPH$,3*PHCOUNT2,3)=CHR$(C1)+CHR$(C1+1)+CHR$(32)
1430   MID$(BPH$,3*PHCOUNT2,3)=CHR$(C2)+CHR$(C2+1)+CHR$(32)
1440  GOTO 1020     ' GOTO DISPLAY FORM
1450 '
1460 GOSUB 2860  'DISPLAY DEALER'S FIRST CARD
1470 'ADD CARDS TO DEALER HAND IF NEEDED. 
1480 IF DHVAL>16 THEN 1670
1490    DHAND[DHCOUNT+1]=CARD[TOPCARD]
1500    DHCOUNT=DHCOUNT+1
1510    TOPCARD=TOPCARD+1
1520   IV=DHAND[DHCOUNT]
1530  GOSUB 2460   'GET VALUE AND SUIT
1540    DHANDV[DHCOUNT]=V:DHANDS[DHCOUNT]=SUIT
1550 '
1560     C1=159+2*DHANDV[DHCOUNT]: C2=185+2*PHANDS[PHCOUNT]
1570    MID$(TDH$,3*DHCOUNT2,3)=CHR$(C1)+CHR$(C1+1)+CHR$(32)
1580    MID$(BDH$,3*DHCOUNT2,3)=CHR$(C2)+CHR$(C2+1)+CHR$(32)
1590   FOR X=1 TO 10
1600     HAND[X]=DHANDV[X]
1610   NEXT X
1620  GOSUB 2600   ' GET VALUE OF HAND
1630   DHVAL=TOTAL
1640  GOSUB 2740 'PRINT HANDS
1650  GOTO 1480
1660 '
1670 ' ALL HANDS ARE COMPLETE
1680 ' PLAYER HAND HAS ALREADY BEEN CHECKED FOR > 21
1690  IF DHVAL>21 THEN 1780   'PLAYER WINS
1700  IF DHVAL<PHVAL THEN 1780 ' PLAYER WINS
1710  IF DHVAL=PHVAL THEN 1830 ' DRAW
1720 '
1730 '   DEALER WINS 
1740    MID$(MSG1$,1,10)=I WIN
1750    YOURTOTAL=YOURTOTALBET
1760    DEALERTOTAL=DEALERTOTAL+BET
1770  GOTO 1850
1780 '   PLAYER WINS 
1790    MID$(MSG1$,1,10)=YOU WIN...
1800    YOURTOTAL=YOURTOTAL+BET
1810    DEALERTOTAL=DEALERTOTALBET
1820  GOTO 1850
1830 '   DRAW 
1840    MID$(MSG1$,1,10)=DRAW......
1850 'GAME OVER
1860 IF YOURTOTLAL<0 THEN 2020
1870 IF DEALERTOTAL<0 THEN 2020
1880 YOURTOTAL=YOURTOTAL:DEALERTOTAL=DEALERTOTAL
1890 TYPE$=character.
1900 ERC=WRITEFIELD(PTR(FORM[1]),MESSAGELINE1,0,PTR(MSG1$),73,PTR(TYPE$))
1910         IF ERC<>0 THEN 2950
1920  TYPE$=Binary.
1930 ERC=WRITEFIELD(PTR(FORM[1]),PLAYERTOTAL,0,PTR(YOURTOTAL),2,PTR(TYPE$))
1940         IF ERC<>0 THEN 2950
1950 ERC=WRITEFIELD(PTR(FORM[1]),DEALERTOTAL,0,PTR(DEALERTOTAL),2,PTR(TYPE$))
1960         IF ERC<>0 THEN 2950
1970  TYPE$=Character.
1980 ERC=DELAY(40)
1990          IF ERC<>0 THEN 2950
2000  IF TOPCARD<35 THEN 350
2010 GOTO 300
2020 ' CLEAR SCREEN  DISPLAY FORM CENTERED
2030 PRINT CHR$(255)+PF+CHR$(255)+VF+CHR$(HC);
2040 PRINT
2050 PRINT YOUR FINAL TOTAL WAS $;YOURTOTAL
2060 PRINT
2070 PRINT MY FINAL TOTAL WAS $;DEALERTOTAL
2080 PRINT
2090 PRINT  YOUR NET GAIN IS $;YOURTOTALINITDOLVAL
2100 PRINT      
2110 IF YOURTOTAL<DEALERTOTAL THEN 2150
2120 PRINT I GUESS YOU WON THIS TIME
2130 PRINT 
2140 GOTO 2170
2150 PRINT I'M SORRY YOU LOST.     BUT, I'M GLAD I WON
2160 PRINT
2170 FONT$=[SYS]<SYS>t1sys.FONT
2180 PRINT
2190 SYSTEM
2200 GOSUB 3000 'LOAD CTOS FONT
2210 SYSTEM
2220 '************************************************************************
2230 'SUBROUTINE TO INITIALIZE A DECK { CARD[152] }, THEN SHUFFLE THE DECK.
2240 'SEED=<SEED FOR RANDOM NUMBER GENERATOR>
2250 ' I , J , K , ARE USED AS INDEXES IN FOR  NEXT LOOPS
2260 'A(152) ARE TEMPORARY VALUES USED
2270 ' CARD[ ] IS THE DECK
2280 PRINT SHUFFLING CARDS   SEED=;SEED
2290 FOR I=1 TO 52
2300   CARD[I]=I
2310 NEXT I
2320 I=52
2330 FOR J=1 TO 52
2340  P=INT(RND(SEED)*I+1)
2350  A[J]=CARD[P]
2360  FOR K=P TO I1
2370    CARD[K]=CARD[K+1]
2380   NEXT K
2390  I=I1
2400 NEXT J
2410 FOR I=1 TO 52
2420   CARD[I]=A[I]
2430 NEXT I
2440 RETURN
2450 '************************************************************************
2460 'SUBROUTINE TO ASSIGN A VALUE FROM 1 TO 13 TO A CARD. ie:remove the suit.
2470 'THE CARD SHOULD BE INPUT AS VARIABLE IV .
2480 'THE VALUE (113) WILL BE RETURNED AS V.
2490 ' ACE=1, 2=2, 3=3, ..., 10=10, J=11, Q=12, K=13.
2500 'THEN SUIT WILL BE RETURNED AS SUIT.
2510 ' SPADES=1, HEARTS=2, DIAMONDS=3, CLUBS=4
2520 IF IV<14 THEN V=IV: SUIT=1: GOTO 2580
2530 IF IV<27 THEN V=IV13: SUIT=2: GOTO 2580
2540 IF IV<40 THEN V=IV26: SUIT=3: GOTO 2580
2550 IF IV<53 THEN V=IV39: SUIT=4: GOTO 2580
2560 PRINT INVALID CARD NUMBER, CARD[ ]=;IV
2570 PRINT ERROR FOND IN VALUE FINDING SUBROUTINE
2580 RETURN
2590 '************************************************************************
2600 'SUBROUTINE TO GET THE VALUE OF A HAND.
2610 'INPUT THE HAND AS HAND[]. THE VALUE IS RETURNED AS TOTAL
2620 TOTAL=0
2630 NACES=0
2640  FOR I=1 TO 10
2650    IF HAND[I]>10 THEN CARDVALUE=10 ELSE CARDVALUE=HAND[I]
2660    TOTAL=TOTAL+CARDVALUE
2670    IF HAND[I]=1 THEN NACES=NACES+1
2680  NEXT I
2690 IF NACES=0 THEN RETURN
2700 HIHAND=TOTAL+10
2710 IF HIHAND<22 THEN TOTAL=HIHAND
2720 RETURN
2730 '***********************************************************************
2740 'WRITE HANDS
2750 TYPE$=character.
2760 ERC=WRITEFIELD(PTR(FORM[1]),PLAYERTOPOFCARD,0,PTR(TPH$),35,PTR(TYPE$))
2770     IF ERC<>0 THEN 2950
2780 ERC=WRITEFIELD(PTR(FORM[1]),PLAYERBOTTOMOFCARD,0,PTR(BPH$),35,PTR(TYPE$))
2790     IF ERC<>0 THEN 2950
2800 ERC=WRITEFIELD(PTR(FORM[1]),DEALERTOPOFCARD,0,PTR(TDH$),35,PTR(TYPE$))
2810     IF ERC<>0 THEN 2950
2820 ERC=WRITEFIELD(PTR(FORM[1]),DEALERBOTTOMOFCARD,0,PTR(BDH$),35,PTR(TYPE$))
2830    IF ERC<>0 THEN 2950
2840 RETURN
2850 '***********************************************************************
2860 ' SUBROUTINE TO DISPLAY DEALER'S FIRST CARD
2870 'DISPLAY DEALER'S FIRST CARD
2880    C1=159+2*DHANDV[1]
2890  MID$(TDH$,1,2)=CHR$(C1)+CHR$(C1+1)
2900    C1=185+2*DHANDS[1]
2910  MID$(BDH$,1,2)=CHR$(C1)+CHR$(C1+1)
2920 GOSUB 2740
2930 RETURN
2940 '***********************************************************************
2950 'ERROR HANDLER
2960 IF ERC = 501 THEN PRINT BlackJack can not be played on a B21 workstation : FOR I = 1 TO 3000:NEXT I:SYSTEM
2970 PRINT ERC=;ERC
2980 STOP
2990 '***********************************************************************
3000 'LOAD FONT RAM {FONT$}
3010 WORD=0
3020 F=HFFFF
3030 S=H2020
3040 MODE=H6D72  'mr
3050 H=0
3060 Q=0
3070 FONTFH=0
3080 ERC=OPENFILE(PTR(FONTFH),FONT$,,MODE)
3090 IF ERC<>0 THEN STOP '2950
3100 ERC=ALLOCMEMORYLL(8704,PTR(H))
3110 IF ERC<>0 THEN STOP '2950
3120 ERC=LOADFONTRAM(FONTFH,H,8704)
3130 IF ERC<>0 THEN STOP '2950
3140 ERC=RESETVIDEO(80,28,F,S,PTR(WORD))
3150 IF ERC<>0 THEN STOP '2950
3160 ERC=INITVIDFRAME(0,0,0,80,28,0,S,0,0,0)
3170 IF ERC<>0 THEN STOP '2950
3180 ERC=INITCHARMAP(Q,WORD)
3190 IF ERC<>0 THEN STOP '2950
3200 ERC=SETSCREENVIDATTR(1,F)
3210 IF ERC<>0 THEN STOP '2950
3220 ERC=CLOSEFILE(FONTFH)
3230 IF ERC<>0 THEN STOP '2950
3240 ERC=DEALLOCMEMORYLL(H,8704)
3250 IF ERC<>0 THEN STOP '2950
3260 RETURN
3270 '********************************************************************** 
3280 'This Subroutine reads the SYSTEM current date  time in packed form.
3290 '  Converts the packed date  time to expanded form.
3300 '  Then converts the expanded form to basic variables.
3310 '
3320 TIME=0
3330 '
3340 ' Get packed form.
3350 '
3360 ERC=GETDATETIME(PTR(TIME))
3370   IF ERC<>0 THEN 2950
3380 '
3390 'Convert to expanded form.
3400 '
3410 ERC=EXPANDDATETIME(TIME,PTR(EXPTIME[1]))
3420   IF ERC<>0 THEN 2950
3430 '
3440 '  Expanded DateTime Format
3450 '******************************************************************
3460 '*      offset   field   size    description                      *
3470 '**
3480 '*	0	year     2    	19522042 (0=null datetime)    *
3490 '*	2	month    1	0=Jan,11=Dec                    *
3500 '*	3   day of mon.  1	131                            *
3510 '*	4   day of week  1	0=Sun., 6=Sat.                  *
3520 '*	5       hour     1	023                            *
3530 '*	6	minute   1	059                            *
3540 '*	7	second   1	059                            *
3550 '******************************************************************
3560 '
3570 'Convert expanded form to BASIC variables.
3580 '
3590   YEAR=EXPTIME[1]
3600   DATE=INT(EXPTIME[2]256)
3610   MONTH=EXPTIME[2]DATE*256
3620   HOUR=INT(EXPTIME[3]256)
3630   DAY=EXPTIME[3]HOUR*256
3640   SEC=INT(EXPTIME[4]256)
3650   MIN=EXPTIME[4]SEC*256
3660  RETURN
3670 '************************************************************************
3680 END
