'file:      bj2
'program:   Atlantic City Blackjack
'language:  Amigabasic V1.2
'compiled:  bj2.run AC-Basic, Options A,N,R
'date:      Feb 1988
'Author:    John E. Burwell
'Copyright: JB Enterprises,Inc
DEFINT a-z
INITIALIZE:
 ScrId=2:dealer=8:dpositiony=23:which=0:boxindex=1:true=-1:main=10:mnbt=2
 numplayers=7:recsize=2:decks=8:speed=1:DBFlag=0:saveflag=0:sondflag=1
 playflag=0:Csd$="CHEHK":standard=0:underline=1:Bold=2:inversvid=4
 ValidStyles%=255:FontHeight&=8:Jam1=0:Jam2=1:italics=4
 DIM card%(276,28),msg$(15),textAttr&(1)
 DIM pposition(8),Htotal$(21),spflag(8),bjflag(8),How%(9)
 DIM dpositionx(9),cpositionx(7,9),cpositiony(7,9),SHOE(416)
 DIM work%(300),x1(10),y1(10),x2(10),y2(10)
 DIM player(8,2,9),handtotal(8,2),curtotal(8,2),Casino$(7)
 DIM cardhand(8,2),minbet(7),bank(7),Nam$(8),table$(7,2)
RESTORE CSond
 FOR x = 1 TO 9:READ How%(x):NEXT
RESTORE Htotal.data
  FOR i = 1 TO 21: READ a$: Htotal$(i)=a$ :NEXT 
Dposx.data:
  FOR x=1 TO 9:dpositionx(x)=(320-(15*x)):NEXT
RESTORE CP.data:
   FOR x=1 TO 7
     FOR y= 1 TO 9
      READ a$:cpositionx(x,y)=VAL(a$)
      READ a$:cpositiony(x,y)=VAL(a$)
   NEXT y:NEXT x
RESTORE messages
  FOR i = 1 TO 15: READ a$: msg$(i)=a$ :NEXT
RESTORE Cnames
   FOR x= 1 TO 7: READ a$: Casino$(x)=a$:NEXT
place$=Casino$(1)   
DEF FNa(handtotal)=handtotal+11*(handtotal>=22)
DECLARE FUNCTION OpenFont& LIBRARY
DECLARE FUNCTION AskSoftStyle& LIBRARY
LIBRARY "graphics.library" 'For text draw by pixel
LoadFont "topaz",8,topaz8ptr&
LoadFont "topaz",9,topaz9ptr&
  SCREEN 2,640,235,3,2         
  WINDOW 10,,,0,2
  PALETTE 0,0,.3,.2 'green background
  PALETTE 1,1,1,1  'white
  PALETTE 2,0,0,0  'black
  PALETTE 3,.5,.08,0 'red
  PALETTE 4,.7,.7,.7 'gray
  PALETTE 5,.1,.2,.5  'dark blue
  PALETTE 6,1,1,.13 'yellow
  PALETTE 7,0,0,0 ' black
 COLOR 0,0
 UseFont topaz9ptr& 
 GOSUB MenuSetup
 GOSUB loadplayers
 ON MENU GOSUB MenuHandler
  MENU ON
 WHILE playflag<>1:WEND 
 MENU OFF
 MENU 1,1,0
 MENU 1,2,0
SAY TRANSLATE$ (" ")
FOR y=1 TO 3: PALETTE y,0,.3,.2: NEXT
UseFont topaz9ptr&
SetMode Jam1:SetStyle italics
COLOR 7:At 165,87:Display msg$(10)
COLOR 6:At 167,86:Display msg$(10)
UseFont topaz8ptr&
SetMode Jam2:SetStyle standard
FOR x = 1 TO 26
IF x<10 THEN
temp$=RIGHT$(STR$(x),1)
ELSE
 temp$=RIGHT$(STR$(x),2)
END IF
OPEN "BLACKJACK/c."+temp$+"_image" FOR INPUT AS 1
OBJECT.SHAPE x,INPUT$(LOF(1),1)
CLOSE 1
OBJECT.X x,10:OBJECT.Y x,10
OBJECT.ON x
GET(10,10)-(54,39),card%(1,x)
OBJECT.CLOSE x
NEXT
OPEN "BLACKJACK/c.27_image"FOR INPUT AS 1
OBJECT.SHAPE 27,INPUT$(LOF(1),1)
CLOSE 1
OBJECT.X 27,10:OBJECT.Y 27,10
OBJECT.ON 27
GET(10,10)-(54,39),card%(1,27)
OBJECT.CLOSE 27
WINDOW OUTPUT main 
GET(560,170)-(604,199),card%(1,28)
  PALETTE 1,1,1,1  'white
  PALETTE 2,0,0,0  'black
  PALETTE 3,.5,.08,0 'red
SetUp:
 xx=(52*decks)
  WHILE xx<>0
   FOR y = 1 TO 13:SHOE(xx) = y:xx = xx-1: NEXT 
  WEND
 CLS:COLOR 0,0
 GOSUB Shuffle:GOTO SHOWTABLE
AnoCard: 
 c1 = c1+1:cd = SHOE(c1)
'*****COUNT SYSTEM Ken Uston's Professional Blackjack Adv. Point Count****** 
 SELECT CASE cd  
 CASE 1 
   acct=acct+1
 CASE 10,11,12,13
   tmp=tmp-3
 CASE 3,4,6,7
   tmp=tmp+2
 CASE 2,8
   tmp=tmp+1
 CASE 5 
   tmp=tmp+3
 CASE 9 
   tmp=tmp-1
END SELECT 
 hlfdks=(((decks*52)-c1)/26) 'half decks left
 apc=(tmp/hlfdks) 'adv. true count
 re.ace=((decks*4)-acct)
 ace.adj=(re.ace-(hlfdks*2))
 truct=((tmp+(3*ace.adj))/hlfdks)
 
 IF c1>=CUTCARD THEN CUTFLAG=1
 DisRack=c1 'TOTAL CARDS USED TO FILL DISCARD RACK
  RANDOMIZE TIMER
  suit=INT(2*RND)+1
  IF suit=1 THEN suit=0 ELSE suit = 13 
RETURN
         
EvalHands:
  curtotal(p,h)=0
 FOR Q2=1 TO cardhand(p,h)
   cd = player(p,h,Q2)
   GOSUB CDX.AD.CURTOTAL
 NEXT Q2
   handtotal(p,h)=curtotal(p,h)
RETURN 'TO HIT,ETC.
         
CDX.AD.CURTOTAL: 'SUBROUT TO ADD CARD TO TEMPTOTAL
    CD1=cd
  IF CD1>10 THEN CD1=10
      Q1 = curtotal(p,h) + CD1
  IF curtotal(p,h)>=11 THEN AD.CURTOTAL
  IF CD1>1 THEN DD.CURTOTAL
      curtotal(p,h)=curtotal(p,h)+11      
 RETURN ' TO EVALHANDS OR CARD.ROW.I
 
DD.CURTOTAL:
   curtotal(p,h)=Q1-11*(Q1>=11)
 RETURN ' TO EVALHANDS OR CARD.ROW.I
 
AD.CURTOTAL: 
     curtotal(p,h)=Q1-(curtotal(p,h)<=21 AND Q1>21)
 IF curtotal(p,h)<33 THEN RETURN
     curtotal(p,h) = -1
  RETURN ' TO EVALHANDS OR CARD.ROW.I
  
CARD.ROW.I:
   cardhand(p,h)=cardhand(p,h)+1
   player(p,h,(cardhand(p,h)))=cd
   curtotal(p,h)=handtotal(p,h)
        GOSUB CDX.AD.CURTOTAL
   handtotal(p,h)=curtotal(p,h)
 RETURN
     
LASTCARD: 
 IF CUTFLAG =1 THEN GOSUB Shuffle           
  FOR p = 1 TO dealer 
   IF Nam$(p)<>"" OR p=dealer THEN
     bet(p)=0:doubet(p)=0:splbet(p)=0:sdoubet(p)=0:bjflag(p)=0:insbet(p)=0
     IF spflag(p)<>0 THEN z=2 ELSE z=1
     FOR h = 1 TO z
      spflag(p)=0:handtotal(p,h)=0:curtotal(p,h)=0
       FOR c = 1 TO cardhand(p,h)
        cardhand(p,h)=0:player(p,h,c)=0
       NEXT c
     NEXT h
   END IF 
  NEXT p
IF Tflag =true THEN table  'skip to table if already shown
   
SHOWTABLE:
 
 RESTORE Win.data
  FOR p = 2 TO 8
   READ x1,y1,x2,y2
    IF Nam$(p-1)<>"" THEN
     COLOR 1,0
     WINDOW p,,(x1,y1)-(x2,y2),0,2
     WINDOW OUTPUT p
     COLOR 1,5: CLS
     PRINT "BET "
     PRINT USING "BANK $####";bank(p-1)
     SetMode Jam1
     COLOR 7:At 1,17:Display Nam$(p-1)
     COLOR 6:At 3,16:Display Nam$(p-1)
     SetMode Jam2
    END IF
  NEXT
 COLOR 1,0:Tflag =true
 
table: 
IF DBFlag=1 THEN GOSUB REV.DBOX
  FOR p = 1 TO 7
   IF Nam$(p)<>"" THEN
     WINDOW OUTPUT (p+1):COLOR 1,5
     LOCATE 1,1:PRINT TAB(6);"     "
   END IF
  NEXT
 WINDOW OUTPUT main
 UseFont topaz9ptr&
 SetMode Jam1:SetStyle underline
 COLOR 7:At 270,9:Display place$
 SetStyle standard
 COLOR 6:At 272,8:Display place$
 UseFont topaz8ptr&
 SetMode Jam2:SetStyle standard
 COLOR 1,0
 LINE (150,2)-(159,45),2,bf :LINE (150,43)-(190,45),2,bf
 FOR x = 2 TO 37 STEP 7: LINE (156,x)-(159,x),1: NEXT

BETS:
 MENU ON
 IF sondflag=1 THEN 
   SAY "BEYTZ PLIY4Z"
 END IF  
 WINDOW 9,,(525,180)-(620,190),0,ScrId
 PAINT (1,1),4,1
  FOR p = 1 TO 7
   IF Nam$(p)<>"" THEN   
    WINDOW OUTPUT (p+1)
    COLOR ,3: CLS
    PRINT "BET "
    PRINT USING "BANK $####.##";bank(p)
    GOSUB PrPlayer
REDO:
    WINDOW OUTPUT 9
    COLOR 2,4
    CALL actrequest("1","2","3","?",which)
      IF which = 4 THEN
        CLS:LOCATE 2,2
        INPUT "BET ";TempBet(p)
        CLS
      END IF
   IF which <4 THEN TempBet(p)=which*minbet(p)
    IF TempBet(p)<0 OR TempBet(p)>1000 OR TempBet(p)> bank(p) THEN GOTO REDO
    bet(p) = TempBet(p) :bank(p)=bank(p)-bet(p)
    WINDOW OUTPUT (p+1)
    COLOR 1,5: CLS
    PRINT USING "BET  $####";bet(p)
    PRINT USING "BANK $####.##";bank(p)
    GOSUB PrPlayer
  END IF
NEXT 
    which =0: WINDOW OUTPUT 9:CLS
    pause&=TIMER:WHILE TIMER<pause&+speed:WEND
    WINDOW CLOSE 20
    MENU OFF
DEAL:   
 h=1: WINDOW OUTPUT main
  FOR c= 1 TO 2
   FOR p = 1 TO dealer
    IF Nam$(p)<>""AND bet(p)<>0 OR p=dealer  THEN
      GOSUB AnoCard
      player(p,h,c)=cd 'ASSIGN CARD TO CURRENT HAND
      IF sondflag=1 THEN SAY Csd$,How%
      FOR x=1 TO (speed * 750):NEXT
       IF p=dealer AND c=1 THEN
         PUT ((dpositionx(1)+35),dpositiony),card%(1,27)
       ELSEIF p=dealer AND c=2 THEN
         PUT (dpositionx(2),dpositiony),card%(1,cd+suit),PSET
       ELSE
         PUT (cpositionx(p,c),cpositiony(p,c)),card%(1,cd+suit),PSET
       END IF
    END IF
   NEXT p
  NEXT c
 h=1 
  FOR p = 1 TO dealer
   IF Nam$(p)<>""AND bet(p)<>0 OR p = dealer THEN
    cardhand(p,h)=2
    GOSUB EvalHands
   END IF 
  NEXT
'IF player(dealer,1,2)=1 THEN GOSUB INSURANCE 'IF DEALER UP CARD  AN ACE
'Insurance not implemented in this version,rarely a good bet     
START:      
 FOR p =7 TO 1 STEP -1
  IF Nam$(p)<>"" AND bet(p)>0 THEN
    IF FNa(handtotal(p,1))=21 THEN
       IF player(dealer,1,2)<>1 AND player(dealer,1,2)<10 THEN
        bank(p)=bank(p)+(2.5*(bet(p))):bjflag(p)=1
        SAY TRANSLATE$("BLACKJACK!")
        GOSUB EraCards
        cardhand(p,1)=0:handtotal(p,1)=0
       END IF  
     bjflag(p)=1
     WINDOW OUTPUT (p+1)
     FOR x=1 TO 2
      COLOR 5,5:At 56,0:Display " BJ"
      pause&=TIMER:WHILE TIMER<pause&+1:WEND
      COLOR 6,5:At 56,0:Display " BJ"
      pause&=TIMER:WHILE TIMER<pause&+1:WEND
     NEXT
    PRINT
     COLOR 1,5
     PRINT USING "BANK $####.#";bank(p)
     
    END IF
  END IF 
 NEXT  
FOR p = 1 TO 7
 IF Nam$(p)<>"" AND bjflag(p)<>1 AND bet(p)<>0 THEN
  WINDOW OUTPUT (p+1):COLOR ,3:CLS
  PRINT USING "BET  $####";bet(p)
  PRINT USING "BANK $####.##";bank(p)
  GOSUB PrPlayer
  GOSUB Say.Total
  L1=player(p,h,1):IF L1>10 THEN L1=10
  L2=player(p,h,2):IF L2>10 THEN L2=10
 IF bank(p)=0 THEN
  WINDOW OUTPUT 9:CLS
  CALL hittrequest("H","S",which)
 ELSEIF L1=L2 AND bank(p)>=bet(p) THEN 
  WINDOW OUTPUT 9
  CALL actrequest("H","S","D","P",which)
 ELSE
 WINDOW OUTPUT 9
again:
 CALL actrequest("H","S","D","-",which)
 IF which = 4 THEN which =0:GOTO again
 END IF
   ON which GOSUB HIT,STAND,DOUBLE,SPLIT
END IF
NEXT  
GOSUB PLAYDEALER   
GOTO LASTCARD          
HIT:
  GOSUB AnoCard:GOSUB CARD.ROW.I:WINDOW OUTPUT main
 PUT (cpositionx(p,cardhand(p,h)),cpositiony(p,cardhand(p,h))),card%(1,cd+suit),PSET 
  IF sondflag=1 THEN
    SAY Csd$,How%
     END IF
  IF handtotal(p,h)<0 THEN
   GOSUB Busted
   IF spflag(p)<>1 THEN GOSUB EraCards ELSE RETURN
  ELSEIF FNa(handtotal(p,h))<>21 THEN 
   GOSUB Say.Total
   WINDOW OUTPUT 9:CLS
   CALL hittrequest("H","S",which)   
    ON which GOTO HIT
   GOSUB  STAND
  ELSE
   GOSUB Say.Total
   WINDOW OUTPUT (p+1):COLOR ,5:CLS
   PRINT USING "BET  $####";bet(p)
   PRINT USING "BANK $####.##";bank(p)
   GOSUB PrPlayer
  END IF
RETURN
    
DOUBLE:
 GOSUB AnoCard
 IF bet(p)>bank(p) THEN temp=bank(p) ELSE temp=bet(p)
 bank(p)= bank(p)-temp
 IF h=2 THEN sdoubet(p)=temp ELSE doubet(p)=temp
 WINDOW OUTPUT (p+1):COLOR ,3:CLS
 IF h=2 THEN 
  PRINT USING "BET  $####";(splbet(p)+sdoubet(p))
 ELSE 
  PRINT USING "BET  $####";(bet(p)+doubet(p))
 END IF
  PRINT USING "BANK $####";bank(p)
  GOSUB PrPlayer
  GOSUB CARD.ROW.I:WINDOW OUTPUT main
   PUT (cpositionx(p,3),cpositiony(p,3)),card%(1,cd+suit),PSET
   IF sondflag=1 THEN 
    SAY Csd$,How%
   END IF
 IF handtotal(p,h)>0 THEN 
   GOSUB Say.Total
   WINDOW OUTPUT (p+1):COLOR ,5:CLS
   PRINT USING "BET  $####";(bet(p)+splbet(p)+doubet(p)+sdoubet(p))
   PRINT USING "BANK $####.##";bank(p)
   GOSUB PrPlayer
 ELSE
   GOSUB Busted
   IF spflag(p)<>1 THEN GOSUB EraCards ELSE RETURN
 END IF
RETURN

SPLIT:
 GOSUB EraCards
 spflag(p)=1: player(p,2,1)=player(p,h,2):splbet(p)=bet(p)
 bank(p)=bank(p)-splbet(p)
 WINDOW OUTPUT main
 FOR h = 1 TO 2
   GOSUB AnoCard
   player(p,h,2)=cd:cardhand(p,h)=2
   GOSUB EvalHands
  FOR x=1 TO cardhand(p,h)
   PUT(cpositionx(p,x),cpositiony(p,x)),card%(1,player(p,h,x)),PSET
   IF sondflag=1 THEN 
    SAY Csd$,How%
   END IF  
  NEXT x 'show both cards hand 1 then hand 2
   pause&=TIMER:WHILE TIMER<pause&+speed:WEND
NEXT
 IF player(p,1,1)<>1 THEN
   FOR h = 1 TO 2
    WINDOW OUTPUT (p+1):COLOR ,3 :CLS
    PRINT USING "BET  $####";(bet(p)+splbet(p))
    PRINT USING "BANK $####.##";bank(p)
    GOSUB PrPlayer
    WINDOW OUTPUT main
    FOR x= 1 TO cardhand(p,h)
     PUT(cpositionx(p,x),cpositiony(p,x)),card%(1,player(p,h,x)),PSET    
     IF sondflag=1 THEN
     SAY Csd$,How%
     END IF
    NEXT 'replace hand 1
    GOSUB Say.Total
PSplit:
   WINDOW OUTPUT 9
   CALL actrequest("H","S","D","-",which)
   IF which >3 THEN GOTO PSplit
      ON which GOSUB HIT,STAND,DOUBLE
      pause&=TIMER:WHILE TIMER<pause&+speed:WEND
      WINDOW OUTPUT main      
    FOR x = 1 TO cardhand(p,h)
         PUT(cpositionx(p,x),cpositiony(p,x)),card%(1,28),PSET
    NEXT 'erase first hand then second hand
  NEXT h
 ELSEIF player(p,1,1)=1 THEN
     FOR x = 1 TO 2                  
       PUT(cpositionx(p,x),cpositiony(p,x)),card%(1,28),PSET
     NEXT 'erase second ace split hand
 END IF
          'ace split end and regular end    
FOR h = 1 TO 2
  FOR x = 1 TO cardhand(p,h)
    IF h =1 THEN
     PUT((cpositionx(p,x)+28),cpositiony(p,x)),card%(1,player(p,h,x)),PSET
    ELSE
     PUT((cpositionx(p,x)-28),cpositiony(p,x)),card%(1,player(p,h,x)),PSET
    END IF
   IF sondflag=1 THEN
    SAY Csd$,How% 
   END IF
  NEXT
   IF FNa(handtotal(p,h))>0 THEN
     GOSUB Say.Total
   ELSE
     SAY TRANSLATE$("BUSTED!")
   END IF
NEXT
 WINDOW OUTPUT (p+1):COLOR ,5:CLS 'blue
 PRINT USING "BET  $####";(bet(p)+splbet(p)+doubet(p)+sdoubet(p))
 PRINT USING "BANK $####.#";bank(p)
 GOSUB PrPlayer
 h=1
RETURN

Busted:
 SAY TRANSLATE$ ("BUST!")
 WINDOW OUTPUT (p+1):COLOR ,5:CLS
 PRINT "BET   ";
 COLOR 6,5: PRINT "BUST"
 COLOR 1,5: PRINT USING "BANK $####.##";bank(p)
 GOSUB PrPlayer
RETURN          
  
STAND:
 WINDOW OUTPUT (p+1):COLOR ,5:CLS
 PRINT USING "BET  $####";bet(p)
 PRINT USING "BANK $####.##";bank(p)
 GOSUB PrPlayer
RETURN

PrPlayer:
   SetMode Jam1
     COLOR 7:At 1,17:Display Nam$(p)
     COLOR 6:At 3,16:Display Nam$(p)
   SetMode Jam2
   COLOR 1,0
RETURN

PLAYDEALER:
 WINDOW CLOSE 9: WINDOW OUTPUT main:h=1
  pause&=TIMER:WHILE TIMER<pause&+speed:WEND
  PUT ((dpositionx(1)+35),dpositiony),card%(1,(player(dealer,1,1))),PSET
  IF sondflag=1 THEN SAY Csd$,How%
  pause&=TIMER: WHILE TIMER<pause&+speed:WEND
   IF FNa(handtotal(dealer,h))=21 THEN
     bjflag(8)=1
     SAY TRANSLATE$ ("BLACKJACK!"):pause&=TIMER:WHILE TIMER<pause&+speed:WEND 
   ELSEIF FNa(handtotal(dealer,h))<>21 THEN
    FOR p = 7 TO 1 STEP -1
      IF Nam$(p)<>"" THEN
        IF bjflag(p)=1 AND cardhand(p,1)<>0 THEN
         WINDOW OUTPUT (p+1)
         SAY TRANSLATE$("BLACKJACK!") 
         bank(p)=bank(p)+(2.5*bet(p))
         FOR x=1 TO 2
          COLOR 5,5:At 56,0:Display " BJ"
          pause&=TIMER:WHILE TIMER<pause&+1:WEND
          COLOR 6,5:At 56,0:Display " BJ"
          pause&=TIMER:WHILE TIMER<pause&+1:WEND
        NEXT
        PRINT
     COLOR 1,5
         PRINT USING "BANK $####.##";bank(p)
         GOSUB EraCards
         cardhand(p,1)=0:handtotal(p,1)=0
        END IF
      END IF
    NEXT
lft=0
  FOR p = 1 TO 7
    FOR h = 1 TO 2
      IF cardhand(p,h)>0 OR handtotal(p,h)>0 THEN lft=1
    NEXT h 
  NEXT p
END IF
  
IF FNa(handtotal(dealer,1))<17 AND lft=1 THEN
      p=dealer:h=1
      GOSUB Say.Total
      GOSUB musthit
ELSE
     p=dealer:h=1
     IF bjflag(8)<>1 THEN GOSUB Say.Total 
END IF
   GOSUB tally
RETURN

musthit:
  GOSUB AnoCard
  GOSUB CARD.ROW.I:WINDOW OUTPUT main
   PUT (dpositionx(cardhand(p,h)),dpositiony),card%(1,cd+suit),PSET
    IF sondflag=1 THEN SAY Csd$,How%
    pause&=TIMER:WHILE TIMER<pause&+speed:WEND
    IF handtotal(p,h)>0 AND FNa(handtotal(p,h))<17 THEN
     GOSUB Say.Total
     GOTO musthit
    ELSEIF FNa(handtotal(p,h))=-1 THEN
     SAY TRANSLATE$ ("BUST!")
    ELSE
     GOSUB Say.Total
    END IF
RETURN
      
tally:
 FOR p=7 TO 1 STEP -1
  IF Nam$(p)<>"" THEN
    IF spflag(p)<>1 THEN z=1 ELSE z=2
     FOR h = z TO 1 STEP -1
      IF cardhand(p,h)<>0 THEN
        IF FNa(handtotal(p,h))>0 AND bjflag(8)<>1 THEN
          IF FNa(handtotal(p,h))<FNa(handtotal(8,1)) THEN
            outcome$(p)=" LOSE"
            GOSUB EraCards
            GOSUB PrtOutcome
          ELSEIF  FNa(handtotal(p,h))>FNa(handtotal(8,1)) THEN
            IF h = 2 THEN bank(p)=bank(p)+(2*(sdoubet(p)+splbet(p)))
            IF h = 1 THEN bank(p)=bank(p)+(2*(bet(p)+doubet(p)))
            outcome$(p)="  WIN"
            GOSUB EraCards
            GOSUB PrtOutcome
          ELSEIF FNa(handtotal(p,h))=FNa(handtotal(8,1)) THEN
            IF h = 2 THEN bank(p)=bank(p)+sdoubet(p)+splbet(p)
            IF h = 1 THEN bank(p)=bank(p)+bet(p)+doubet(p)
             outcome$(p)=" PUSH"
             GOSUB EraCards
             GOSUB PrtOutcome
          END IF
     ELSEIF bjflag(p)<>1 THEN
         IF h = 2 THEN bank(p)=bank(p)+splbet(p)+sdoubet(p)
         IF h = 1 THEN bank(p)= bank(p)+doubet(p)
         'give back all but orig bet + win insurance
         outcome$(p)=" LOSE"
         GOSUB EraCards
         GOSUB PrtOutcome
     ELSEIF bjflag(p)=1 THEN
        bank(p)=bank(p)+bet(p)
        outcome$(p)=" PUSH"
        GOSUB EraCards
        GOSUB PrtOutcome
       END IF
    END IF 
   NEXT h
  END IF
 NEXT p
 FOR p=7 TO 1 STEP -1
   IF Nam$(p)<>"" THEN
     IF bank(p) = 0 THEN
       WINDOW CLOSE (p+1)
       Nam$(p)=""
     END IF
   END IF
 NEXT
    
WINDOW OUTPUT main
FOR x = cardhand(8,1) TO 1 STEP -1
  PUT(dpositionx(x),dpositiony),card%(1,28),PSET
NEXT 
  PUT ((dpositionx(1)+35),dpositiony),card%(1,28),PSET
  WINDOW OUTPUT main
 GOSUB DCard.Rack 
RETURN 

EraCards:
WINDOW OUTPUT main
x=cardhand(p,h)
 WHILE x<>0
  IF spflag(p)<>1 THEN 
   PUT (cpositionx(p,x),cpositiony(p,x)),card%(1,28),PSET
  ELSEIF h = 1 THEN
   PUT((cpositionx(p,x)+28),cpositiony(p,x)),card%(1,28),PSET
  ELSE 
   PUT((cpositionx(p,x)-28),cpositiony(p,x)),card%(1,28),PSET
  END IF
 x=x-1
WEND 
IF spflag(p)<>1 THEN cardhand(p,1)=0
RETURN
  
PrtOutcome:
  WINDOW OUTPUT (p+1)
  LOCATE 1,1: COLOR 6,5: PRINT TAB (6);outcome$(p)
  COLOR 1,5: PRINT USING "BANK $####.##";bank(p)
  pause&=TIMER:WHILE TIMER<pause&+speed:WEND   
RETURN 

Say.Total:
 IF sondflag=1 THEN
 Cttal=FNa(handtotal(p,h))
 SAY TRANSLATE$ (Htotal$(Cttal))
 END IF
RETURN

REV.DBOX:
  WINDOW 20,,(242,60)-(365,118),0,2 
  WINDOW OUTPUT 20: COLOR 2,4 :CLS
 LOCATE 2,1
  PRINT USING " DISCARDS  ###";c1
  PRINT USING " HALF DKS   ##";hlfdks
  PRINT USING " ACES USED  ##";acct
  PRINT USING " ACES  +/- ###";ace.adj
  PRINT USING " RUN CT.   ###";tmp
  PRINT USING " TRUE CT.  ###";apc
  PRINT USING " TRUE BET  ###";truct;
  COLOR 1,0
RETURN

Shuffle:
IF Tflag=true THEN
  CLS
  SetMode Jam1
  COLOR 7:At 215,88:Display msg$(9)
  COLOR 6:At 217,87:Display msg$(9)
  SetMode Jam2
  SAY TRANSLATE$("Shuf-fling")
END IF 
 COLOR 1,0
 RANDOMIZE TIMER
 CUTFLAG=0:DisRack=0 'FOR LATER USE TO UPDATE DISCARD RACK
  FOR c1=(52*decks )TO 1 STEP -1
    C2 = INT(RND(1) * (c1))+1       
      C3=SHOE(C2)
        SHOE(C2) = SHOE(c1)
         SHOE(c1) = C3
  NEXT c1
 CUTCARD=(decks*39)
  acct=0:apc=0:truct=0:tmp=0:ace.adj=0:hlfdks=0:re.ace=0
  CLS
RETURN

DCard.Rack:
 FOR x=1 TO INT(DisRack/8):LINE(160,43-x)-(190,43-x),1:NEXT
RETURN 
 
MenuSetup:
 'Design custom menu bar.
 MENU 1,0,1,"  GAME  "  
 MENU 1,1,1,"Play BJ "
 MENU 1,2,1,"Rules   "
 MENU 1,3,1,"Quit    "
 MENU 2,0,1,"OPTIONS    "
 MENU 2,1,1,"Edit  Players?"
 MENU 2,2,1,"Decks  8 "
 MENU 2,3,1,"Speed  1 "
 MENU 2,4,1, msg$(6)
 MENU 2,5,1, msg$(7)
 MENU 2,6,1,"MIN.BET $  2"
 MENU 3,0,1,"   CASINOS   "
 MENU 3,1,2, SPACE$(2)+Casino$(1)
 MENU 3,2,1, SPACE$(2)+Casino$(2)
 MENU 3,3,1, SPACE$(2)+Casino$(3)
 MENU 3,4,1, SPACE$(2)+Casino$(4)
 MENU 3,5,1, SPACE$(2)+Casino$(5)
 MENU 3,6,1, SPACE$(2)+Casino$(6)
 MENU 3,7,1, SPACE$(2)+Casino$(7)
 MENU 4,0,0,""
RETURN

MenuHandler:
  MenuId=MENU(0)
  MenuItem=MENU(1)
 ON MenuId GOTO GameMenu,OptionsMenu,CasinoMenu
 
GameMenu:
 ON MenuItem GOTO PlayBJ,Rules,Quit
OptionsMenu:
 ON MenuItem GOTO EditPlayers,NumDecks,DealSpeed,DataBox,sond,min.bet
 
PlayBJ:
 IF  saveflag=0 THEN
  CALL Getrequest (msg$(12),"SAVE","NO",which)
  IF which=1 THEN GOSUB saveit
 END IF
 FOR p = 1 TO 7
  Nam$(p)=UCASE$(table$(p,1))
  bank(p)=VAL(table$(p,2))
  minbet(p)=mnbt
 NEXT
 MENU 2,1,0
 MENU 2,2,0
 MENU 3,0,0
 COLOR 1,0: CLS
 saveflag=0:playflag=1
RETURN 'go to game 
Rules:
 COLOR 6,0:CLS
 UseFont topaz8ptr&
 OPEN "BLACKJACK/bj.rules" FOR INPUT AS #1
  WHILE NOT EOF(1)
    LINE INPUT #1,a$
    Display a$
    PRINT
  WEND
 CLOSE #1
 WHILE MOUSE(0)=0:WEND
 COLOR 1,0
 UseFont topaz9ptr&
 GOSUB Pri.screen
RETURN  
         
EditPlayers:
 IF saveflag=0 THEN
 CALL Getrequest (msg$(15),"YES","NO",which)
 END IF
 IF which=2 THEN
   GOSUB Pri.screen 'CANCEL was selected.
 ELSE
   saveflag=0 
 MENU 2,1,0:CLS
SetMode Jam1
COLOR 7:At 170,20:Display msg$(13)
COLOR 6:At 172,18:Display msg$(13)
COLOR 7:At 150,30:Display msg$(14)
COLOR 6:At 152,28:Display msg$(14)
COLOR 7:At 175,60:Display msg$(1)
COLOR 6:At 177,58:Display msg$(1)
SetMode Jam2
entryloop:
LOCATE 9,1
COLOR 6,2
PRINT TAB(14);" SEAT ";TAB(27);"   NAME   ";TAB(44);" BANK ";
FOR numplayers= 1 TO 7    
  COLOR 1,0: LOCATE (10+numplayers),16:PRINT STR$(numplayers)+".";
  FOR y = 1 TO 2
   ypos = 10+numplayers
   IF y = 1 THEN xpos=27 ELSE xpos = 45
   IF y = 1 THEN maxlen =9 ELSE maxlen = 4
   answer$=""
   CALL getplayer(xpos,ypos,answer$,maxlen)
   table$(numplayers,y)=answer$
    IF table$(numplayers,1)="" THEN 
     table$(numplayers,2)=""
     COLOR 0,0
     PRINT CHR$(8):PRINT" "
     y=y+1
    END IF
 NEXT
 NEXT
COLOR 1,0 
GOSUB Pri.screen
COLOR ,2
SetMode Jam1
COLOR 7:At 90,170:Display msg$(11)
COLOR 6:At 92,168:Display msg$(11)
saveflag=0 'This update is not yet saved on disk.
COLOR 1,0  
END IF
RETURN

saveplayers:
 'Saves players,and bank to disk. Default filename = "Players"
 CALL Getrequest (msg$(12),"YES","NO",which)
  ON which GOSUB saveit
 RETURN 
saveit:
 OPEN "BLACKJACK/Players" FOR OUTPUT AS #1
  IF playflag=0 THEN
   FOR j=1 TO 7 'Save records on disk...
    FOR k=1 TO 2
       PRINT# 1,table$(j,k)
    NEXT k
   NEXT j
  ELSE
      FOR j=1 TO 7
       PRINT# 1,Nam$(j)
       PRINT# 1,STR$(bank(j))
      NEXT 
   END IF 
 CLOSE# 1
 saveflag=1 'players in memory saved.
 pause&=TIMER 'Wait for drive to finish.
 WHILE TIMER<pause&+6:WEND 'Six seconds...
 RETURN 
NumDecks:
  IF decks =4 THEN decks=8 ELSE decks=4
  deck$=STR$(decks)
  MENU 2,2,1,"DECKS "+deck$
  RETURN  
DealSpeed:
  speed = speed-1
  IF speed <1 THEN speed=3 
  speed$=STR$(speed)
  MENU 2,3,1,"SPEED "+speed$
  RETURN
min.bet:
  IF mnbt=2 THEN
     mnbt=5
  ELSEIF mnbt=5 THEN
     mnbt=10
  ELSEIF mnbt=10 THEN
     mnbt=25
  ELSE
     mnbt=2
  END IF
  mbt$=STR$(mnbt)
  MENU 2,6,1,"MIN.BET $"+mbt$
  FOR x = 1 TO 7
    minbet(x)=mnbt
  NEXT  
  RETURN        
DataBox:
   IF DBFlag=0 THEN
     DBFlag=1 'constant databox on
     MENU 2,4,1, msg$(5)
   ELSE
     DBFlag=0 'constant databox off
     MENU 2,4,1, msg$(6) 
   END IF
  RETURN  
sond:
   IF sondflag=1 THEN
     sondflag=0 'sound off
     MENU 2,5,1, msg$(8)
   ELSE
     sondflag=1 'sound on
     MENU 2,5,1, msg$(7)
   END IF
  RETURN 
CasinoMenu:
  FOR x = 1 TO 7
    MENU 3,x,1   'remove check from all items
  NEXT
  MENU 3,(MENU(1)),2   ' place check at correct item
  place$=Casino$(MENU(1))
  RETURN  
Quit:
  WINDOW CLOSE 9
   IF saveflag=0 THEN GOSUB saveplayers
   SCREEN CLOSE ScrId
   SYSTEM
loadplayers:
 CLOSE# 1:OPEN "BLACKJACK/Players" FOR INPUT AS #1
 numplayers=7:recsize=2
 FOR j=1 TO numplayers 'Read records from disk...
  FOR k=1 TO recsize
   INPUT #1,table$(j,k)
  NEXT k
 NEXT j
 CLOSE #1
 saveflag=1 'Reset saved flag. 
Pri.screen: 
COLOR 1,0:CLS
SetMode Jam1
COLOR 7:At 95,20:Display msg$(3)
COLOR 6:At 97,18:Display msg$(3)
COLOR 7:At 95,30:Display msg$(4)
COLOR 6:At 97,28:Display msg$(4)
COLOR 7:At 175,60:Display msg$(1)
COLOR 6:At 177,58:Display msg$(1)
SetMode Jam2
LOCATE 9,1: COLOR 6,2
PRINT TAB(14);" SEAT ";TAB(27);"   NAME   ";TAB(44);" BANK ";
COLOR 1,0
numplayers=1
WHILE numplayers<8 
LOCATE (10+numplayers),16:PRINT STR$(numplayers)+".";
 temp=1
 WHILE temp <3
  IF temp = 1 AND table$(numplayers,temp)="" THEN temp=3
  IF temp =1 THEN
   uname$=UCASE$(table$(numplayers,temp))
    LOCATE (10+numplayers),28:PRINT uname$;
  ELSEIF temp=2 THEN 
    LOCATE (10+numplayers),46:PRINT table$(numplayers,temp)
   END IF
    temp=temp+1
WEND
  numplayers=numplayers+1
WEND 
RETURN

Win.data:  
DATA 520,66,600,81,520,146,600,161,400,176,480,191,270,179,350,194
DATA 140,176,220,191,30,146,110,161,30,66,110,81

Htotal.data:  
DATA "1","2","3","4","5","6","7","8","9","ten","elehven"
DATA "twelve","thirteen","forteen","fifteen"
DATA "sixteen","seventeen","eighteen","nine-teen","twenty","twentyone"

CSond:
DATA 80,1,350,0,22200,50,10,0,0
Cnames:
DATA "CASTLE","CLARIDGE","HARRAH'S","NUGGET","RESORT'S","SANDS","TROPICANA"

CP.data:
DATA  555,33,545,30,535,27,525,24,535,19,545,16,555,13,560,10,575,10 
DATA  555,113,545,110,535,107,525,104,535,99,545,96,555,93,565,93,575,93
DATA  435,143,425,140,415,137,405,134,395,131,395,128,395,125,405,120,415,120
DATA  305,147,295,144,285,141,275,138,265,135,265,131,265,128,275,123,285,123
DATA  175,143,165,140,155,137,145,134,135,131,135,128,135,125,145,120,155,120
DATA  65,113,55,110,45,107,35,104,45,99,55,96,65,93,75,93,85,93 
DATA  65,33,55,30,45,27,35,24,45,19,55,16,65,13,75,10,85,10 
 
messages: 
 DATA "**** BLACKJACK PLAYERS ****"," ","      *Select Choices from Menu bar.*"
 DATA "*You may use these players without changes.*","DATA BOX ON "
 DATA "DATA BOX OFF","SOUND  ON  ","SOUND  OFF ","**** SHUFFLING ****"
 DATA "ONE MOMENT PLEASE. SHUFFLING..."
 DATA "***Review other Menu Choices or Play Blackjack***","SAVE PLAYERS?"
 DATA "Enter player's first name. ","Enter starting bank up to $5000."
 DATA "ERASE PLAYERS?"

SUB getplayer(xpos,ypos,Default$,maxlen) STATIC
 csr=LEN(Default$)+1:k$=""
 WHILE k$<>CHR$(13) AND LEN(k$)<maxlen
   LOCATE ypos,xpos+1:PRINT Default$;"_";
   LOCATE ypos,xpos+csr
   PRINT MID$(Default$+"_",csr,1);
   LOCATE ypos,xpos+csr:k$=""
     WHILE k$="":k$=INPUT$(1):WEND
      LOCATE ypos,xpos+1:PRINT Default$;"_";
      k=ASC(k$)
        IF k >=32 AND k<127 THEN
        Default$=LEFT$(Default$,csr-1)+k$+MID$(Default$,csr)
        Default$=LEFT$(Default$,maxlen)
        csr=csr-(csr<maxlen)
        END IF
     IF k=31 OR k=8 THEN csr=csr+(csr>1)
     IF k=127 OR k=8 THEN
     Default$=LEFT$(Default$,csr-1)+MID$(Default$,csr+1)
     END IF
     IF k = 30 THEN csr=csr-(csr<=LEN(Default$))
     WEND
  END SUB

'**** Credit Tom R. Halfhill and Charles Brannan "Advanced AmigaBasic", Compute Publications *****

SUB Getrequest(tt$,b1$,b2$,which)' STATIC
SHARED boxindex,ScrId
SHARED x1(),y1(),x2(),y2()
boxindex=1:height =PEEKW(WINDOW(8)+38)
winwidth=20*(8-2*(height=9))+30
WINDOW 15,,(0,0)-(winwidth,30),0,ScrId 
PRINT :PRINT TAB(11-LEN(tt$)/2);tt$
PRINT
LOCATE ,3:TxBox b1$
PRINT TAB(20-LEN(b2$));
TxBox b2$: which=0
CALL WaitBox(which)
CALL FlashRelease(which)
WINDOW CLOSE 15
END SUB

SUB FlashRelease(which) STATIC
SHARED x1(),y1(),x2(),y2(),work%()
GET (x1(which),y1(which))-(x2(which),y2(which)),work%
PUT (x1(which),y1(which)),work%,PRESET
ix=MOUSE(1):iy=MOUSE(2)
WHILE MOUSE(0)<>0:WEND
PUT (x1(which),y1(which)),work%,PSET
END SUB

SUB TxBox(msg$) STATIC
SHARED x1(),y1(),x2(),y2(),boxindex
x1=WINDOW(4):y1=WINDOW(5)-10
PRINT " ";msg$; " ";
x2=WINDOW(4):y2=y1+14
CALL Box(boxindex,x1,y1,x2,y2)
boxindex=boxindex+1
END SUB

SUB Box(i,x1,y1,x2,y2) STATIC
SHARED x1(),y1(),x2(),y2()
IF x2<x1 THEN SWAP x1,x2
LINE (x1,y1)-(x2,y2),1-(WINDOW(6)>1),b
LINE (x1,y1)-(x2-1,y2-1),1,b
x1(i)=x1:y1(i)=y1:x2(i)=x2:y2(i)=y2
END SUB

SUB WaitBox(which)'STATIC
which=0
WHILE which=0
  CALL WhichBox(which)'delete to use numkeys only
  CALL WhichKey(which)
WEND
END SUB

SUB WhichBox(which) 'STATIC
SHARED x1(),y1(),x2(),y2(),boxindex
IF MOUSE(0)=0 THEN EXIT SUB
x=MOUSE(1):y=MOUSE(2):i=1
WHILE i<boxindex AND NOT (x>x1(i) AND x<x2(i) AND y>y1(i) AND y<y2(i))
  i=i+1
WEND
which = i: IF i=boxindex THEN which=0
END SUB

SUB WhichKey(which) 'STATIC
key$=INKEY$
IF key$="" OR ASC(key$)<49 OR ASC(key$)>52 THEN EXIT SUB
which = (ASC(key$)-48)
key$=""
END SUB

SUB actrequest(b1$,b2$,b3$,b4$,which) STATIC
SHARED boxindex,ScrId
SHARED x1(),y1(),x2(),y2()
boxindex=1
LOCATE 2,1:TxBox b1$:TxBox b2$:TxBox b3$:TxBox b4$
    CALL WaitBox (which)
    CALL FlashRelease(which)
END SUB

SUB hittrequest(b1$,b2$,which) STATIC
SHARED boxindex,ScrId
SHARED x1(),y1(),x2(),y2()
boxindex=1
LOCATE 2,1:TxBox b1$ :TxBox b2$
    CALL WaitBox (which)
    CALL FlashRelease(which)
END SUB

'***** Credit Bryan Catley, "Amazing Computing" *******

SUB SetStyle (style) STATIC
SHARED ValidStyles%
style%=style
CALL SetSoftStyle&(WINDOW(8),style%,ValidStyles%)
END SUB

SUB SetMode (mode) STATIC
mode&=mode
CALL SetDrMd&(WINDOW(8),mode&)
END SUB

SUB At (x%,y%) STATIC
SHARED FontHeight&
x&=x%:y&=y%+INT(FontHeight&*.75)
CALL Move&(WINDOW(8),x&,y&)
END SUB

SUB Display (Txt$) STATIC
  CALL Text$(WINDOW(8),SADD(Txt$),LEN(Txt$))
END SUB

SUB LoadFont (FontName$,FontHeight%,FontPtr&) STATIC
SHARED FontHeight&,textAttr&()
FontHeight&=FontHeight%
textAttr&(0)=SADD(FontName$+".font"+CHR$(0))
textAttr&(1)=FontHeight&*65536&
IF (FontName$="topaz") AND (FontHeight%=8 OR FontHeight%=9) THEN
  FontPtr&=OpenFont&(VARPTR(textAttr&(0)))
ELSE
  FontPtr&=OpenDiskFont&(VARPTR(textAttr&(0)))
END IF
END SUB

SUB UseFont (FontPtr&) STATIC
SHARED ValidStyles%
CALL SetFont&(WINDOW(8),FontPtr&)
ValidStyles%=AskSoftStyle&(WINDOW(8))
END SUB

SUB EndFont (FontPtr&) STATIC
CALL CloseFont&(FontPtr&)
END SUB