%%HP:T(3)A(D)F(.);
@ BLACKJAC
@ by David Sprenkle
DIR
  PRO1
    \<< 1.5 'BP' STO
STD 0 'DDOWN' STO 1
'S17' STO 1 'DECKS'
STO COVER \->LCD 3
FREEZE { { "DECKS"
} { "D HIT" } {
"D DWN" } { "B-PAY"
} { "START" } }
TMENU
      DO -1 WAIT
MPAR
      UNTIL 15.1 ==
      END PRO2
SINFO
    \>>
  PRO2
    \<< CLEAR 1 1 1 \->
I J K
      \<< 1 DECKS
        FOR I 1 4
          FOR J 1
13
            FOR K K
J .1 * +
            NEXT
          NEXT
        NEXT 1
DECKS 4 13 * *
        FOR K DECKS
13 4 * * RAND * 0
TRNC 1 + ROLL K 3
MOD NOT
          \<< DEPTH
ROLL
          \>> IFT
        NEXT DECKS
4 13 * * RAND .15 *
.2 + * 0 TRNC 'CUT'
STO DROP
      \>>
    \>>
  PRO3
    \<< DROP 2 \->LIST
'DEALER' STO 2
\->LIST 'PLAYER' STO
    \>>
  CARDS
    DIR
      H
GROB 13 11 8130CB70CF70CF70CF708F308F300F100E0004000000
      D
GROB 13 11 04000E000F108F30CF70EFF0CF708F300F100E000400
      S
GROB 13 11 04000E000F108F30CF70CF70CF70853004000E000F10
      C
GROB 13 11 0E000F100F100E0064C0FEE1FFF1FEE164C00E008F30
      J
GROB 13 6 00003E817FD1FFF1DB71FFF1
      Q
GROB 13 8 1401140134816EC0EFF0CB70CB708F30
      K
GROB 13 8 140114013E813E817FD1DB71DB71FFF1
      PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
      BLAN
GROB 21 27 CFFF70200080100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001100001200080CFFF70
      SPADE
GROB 5 5 40E0F1F140
      DIAM
GROB 5 5 40E0F1E040
      CLUB
GROB 5 5 E051F15140
      HEART
GROB 5 5 A0F1F1E040
      BACK
GROB 21 27 CFFF706555D05555515555515DF751575D5155F551DD577157FD517D57D1F5F5F1DF5F715DF751555551FFFFF15555515DF751DF5F71F5F5F17D57D157FD51DD577155F551575D515DF7516555D0CFFF70
      N1
        \<< BLAN {
# 3h # 3h } "A" 1
\->GROB REPL { # Fh
# 13h } "A" 1 \->GROB
REPL { # 4h # 8h }
ROT GOR
        \>>
      N2
        \<< DUP BLAN
{ # 8h # 4h } ROT
GOR { # 8h # 12h }
ROT GOR { # 9h # Bh
}
GROB 4 6 704070107000
GOR
        \>>
      N3
        \<< DUP DUP
BLAN { # 8h # 4h }
ROT GOR { # 8h # Bh
} ROT GOR { # 8h
# 12h } ROT GOR {
# 3h # 6h }
GROB 4 6 704070407000
GOR
        \>>
      N4
        \<< DUP DUP
DUP BLAN { # 2h
# 4h } ROT GOR {
# Eh # 4h } ROT GOR
{ # 2h # 12h } ROT
GOR { # Eh # 12h }
ROT GOR { # 9h # 4h
}
GROB 4 6 505070404000
GOR
        \>>
      N5
        \<< DUP DUP
DUP DUP BLAN { # 2h
# 4h } ROT GOR {
# Eh # 4h } ROT GOR
{ # 8h # Bh } ROT
GOR { # 2h # 12h }
ROT GOR { # Eh
# 12h } ROT GOR {
# 9h # 4h }
GROB 4 6 701070407000
GOR
        \>>
      N6
        \<< DUP DUP
DUP DUP DUP BLAN {
# 2h # 2h } ROT GOR
{ # Eh # 2h } ROT
GOR { # 2h # Bh }
ROT GOR { # Eh # Bh
} ROT GOR { # 2h
# 14h } ROT GOR {
# Eh # 14h } ROT
GOR { # 9h # 6h }
GROB 4 6 601070507000
GOR
        \>>
      N7
        \<< DUP DUP
DUP DUP DUP DUP
BLAN { # 2h # 2h }
ROT GOR { # Eh # 2h
} ROT GOR { # 2h
# Bh } ROT GOR {
# Eh # Bh } ROT GOR
{ # 2h # 14h } ROT
GOR { # 8h # Fh }
ROT GOR { # Eh
# 14h } ROT GOR {
# 9h # 6h }
GROB 4 6 704020101000
GOR
        \>>
      N8
        \<< DUP DUP
DUP DUP DUP DUP DUP
BLAN { # 2h # 2h }
ROT GOR { # Eh # 2h
} ROT GOR { # 8h
# 5h } ROT GOR {
# 2h # Bh } ROT GOR
{ # Eh # Bh } ROT
GOR { # 2h # 14h }
ROT GOR { # 8h
# 11h } ROT GOR {
# Eh # 14h } ROT
GOR { # 9h # Bh }
GROB 4 6 705070507000
GOR
        \>>
      N9
        \<< DUP DUP
DUP DUP DUP DUP DUP
DUP BLAN { # 2h
# 2h } ROT GOR {
# Eh # 2h } ROT GOR
{ # 2h # 14h } ROT
GOR { # Eh # 14h }
ROT GOR { # 2h # 8h
} ROT GOR { # Eh
# 8h } ROT GOR {
# 2h # Eh } ROT GOR
{ # 8h # Bh } ROT
GOR { # Eh # Eh }
ROT GOR { # 9h # 4h
}
GROB 4 6 705070407000
GOR
        \>>
      N10
        \<< DUP DUP
DUP DUP DUP DUP DUP
DUP DUP BLAN { # 2h
# 2h } ROT GOR {
# Eh # 2h } ROT GOR
{ # 2h # 14h } ROT
GOR { # Eh # 14h }
ROT GOR { # 8h # 5h
} ROT GOR { # 2h
# 8h } ROT GOR {
# Eh # 8h } ROT GOR
{ # 2h # Eh } ROT
GOR { # 8h # 11h }
ROT GOR { # Eh # Eh
} ROT GOR { # 8h
# Bh }
GROB 5 5 D1515151D1
GOR
        \>>
      N11
        \<< DUP BLAN
{ # 3h # 4h } ROT
GOR { # Dh # 13h }
ROT GOR { # 4h # Bh
} J GOR
        \>>
      N12
        \<< DUP BLAN
{ # 3h # 4h } ROT
GOR { # Dh # 13h }
ROT GOR { # 4h # Ah
} Q GOR
        \>>
      N13
        \<< DUP BLAN
{ # 3h # 4h } ROT
GOR { # Dh # 13h }
ROT GOR { # 4h # Ah
} K GOR
        \>>
    END
  BP 1.5
  INSU
    \<<
      IF DEALER
OBJ\-> DROP DROP 0
TRNC 1 == SPLITY 0
== PLAYER SIZE 2 ==
AND AND
      THEN
        IF DEALER
CTOT 21 ==
        THEN DEALER
DCP LCD\-> { # 2Ch
# Bh }
"INSURANCE PAYS" 2
\->GROB REPL \->LCD
CONTM
        ELSE LCD\->
DUP { # 1Ch # Bh }
"INSURANCE LOSES" 2
\->GROB REPL \->LCD 3
WAIT \->LCD 3 FREEZE
'LOOT' TBET 2 /
STO-
        END
      ELSE CANTDO
      END
    \>>
  CONTM
    \<< { { "CONT" }
} TMENU
      DO -1 WAIT
        IF DUP 11.1
==
        THEN 99
SWAP
        END
      UNTIL 11.1 ==
      END
    \>>
  BLACK
    \<<
      IF DEALER
CTOT 21 == PLAYER
SIZE 2 == PLAYER
CTOT 21 == SPLITY 0
== AND AND XOR
      THEN
        CASE DEALER
CTOT 21 ==
          THEN
DEALER DCP LCD\-> {
# 32h # Ah }
"D BLACK JACK" 3
\->GROB REPL \->LCD 3
FREEZE
            IF
SPLITY 0 ==
            THEN
'LOOT' TBET STO-
            ELSE
'LOOT' TBET 2 *
STO-
            END
CONTM
          END
PLAYER CTOT 21 ==
          THEN LCD\->
{ # 32h # 26h }
"P BLACKJACK" 3
\->GROB REPL \->LCD
TBET BP * 'LOOT'
STO+ CONTM
          END DHIT
        END
      ELSE DHIT
      END
    \>>
  CUT 17
  SINFO
    \<<
      DO { { "DEAL"
} { "C BET" } {
"CLOOT" } { "END" }
} TMENU CLLCD LCD\->
{ # Ah # Ah }
"LOOT=" LOOT + 3
\->GROB REPL { # Ah
# 26h } "BET=" BET
+ 3 \->GROB REPL \->LCD
3 FREEZE -1 WAIT M1
      UNTIL 14.1 ==
      END UPDIR
CLEAR 2 MENU KILL
    \>>
  PUSH
    \<< LCD\-> { # 5Ch
# 1Fh } "PUSH" 3
\->GROB REPL \->LCD 3
FREEZE
    \>>
  PWINS
    \<< TBET 'LOOT'
STO+ LCD\-> { # 5Ch
# 1Fh } "PLAYER" 3
\->GROB REPL { # 5Ch
# 29h } "WINS" 3
\->GROB REPL \->LCD 3
FREEZE
    \>>
  DWINS
    \<< 'LOOT' TBET
STO- LCD\-> { # 5Ch
# 3h } "DEALER" 3
\->GROB REPL { # 5Ch
# Dh } "WINS" 3
\->GROB REPL \->LCD 3
FREEZE
    \>>
  DEAL
    \<<
      IF DEPTH CUT
\<=
      THEN CLLCD
LCD\-> { # 14h # 14h
} "SHUFFLING" 3
\->GROB REPL \->LCD
PRO2
      END SINFO
    \>>
  Z 1
  DHIT
    \<<
      WHILE DEALER
CTOT DUP 17 < B 1
== ROT 17 S17 + <
AND OR
      REPEAT
'DEALER' SWAP STO+
DEALER DCP
      END
      IF DEALER
CTOT 21 >
      THEN LCD\-> {
# 5Ch # 3h }
"DEALER" 3 \->GROB
REPL { # 5Ch # Dh }
"BUSTED" 3 \->GROB
REPL \->LCD
        IF SPLITY 0
==
        THEN 'LOOT'
TBET STO+
        ELSE 'LOOT'
TBET 2 * STO+
        END CONTM
      ELSE PFINISH
      END
    \>>
  TSPLIT 0
  CSPLIT
    \<<
      IF SPLITY 1
==
      THEN TSPLIT
PLAYER 'TSPLIT' STO
2 'SPLITY' STO
'PLAYER' STO CLLCD
DFP PLAYER PCP DFP
      ELSE DEALER
DCP BLACK
      END
    \>>
  CANTDO
    \<< LCD\-> DUP {
# 32h # Ah }
"CAN'T DO!" 3 \->GROB
REPL \->LCD 2 WAIT
\->LCD 3 FREEZE
    \>>
  TBET 10
  DD
    \<<
      IF PLAYER
SIZE 2 ==
      THEN
        IF SPLITY 0
== PLAYER LIST\->
DROP + DUP DDOWN \>=
SWAP 12 < AND AND
        THEN
'PLAYER' SWAP STO+
2 'TBET' STO*
PLAYER PCP CSPLIT
        ELSE CANTDO
        END
      ELSE CANTDO
      END
    \>>
  PFINISH
    \<< TSPLIT CTOT
'TSPLIT' STO PLAYER
CTOT 'PLAYER' STO
DEALER CTOT
'DEALER' STO
      IF SPLITY 0
==
      THEN
        CASE DEALER
PLAYER >
          THEN
DWINS
          END
PLAYER DEALER >
          THEN
PWINS
          END
DEALER PLAYER ==
          THEN PUSH
          END
        END
      ELSE
        CASE TSPLIT
DEALER < PLAYER
DEALER < AND
          THEN 2
'TBET' STO* DWINS
          END
TSPLIT DEALER >
PLAYER DEALER > AND
          THEN 2
'TBET' STO* PWINS
          END
TSPLIT DEALER \=/
PLAYER DEALER \=/ AND
          THEN
DWINS PWINS
          END
TSPLIT DEALER ==
PLAYER DEALER ==
AND
          THEN PUSH
          END
TSPLIT DEALER >
PLAYER DEALER > OR
          THEN
PWINS
          END DWINS
        END
      END CONTM
    \>>
  SPLITY 0
  SPLIT
    \<<
      IF PLAYER
SIZE 2 == SPLITY 0
== AND
      THEN
        IF PLAYER
LIST\-> DROP 0 TRNC
SWAP 0 TRNC ==
PLAYER LIST\-> DROP +
20 > OR
        THEN PLAYER
LIST\-> DROP ROT 2
\->LIST 'TSPLIT' STO
SWAP 2 \->LIST
'PLAYER' STO 1
'SPLITY' STO PLAYER
PCP 3 FREEZE
        ELSE CANTDO
        END
      ELSE CANTDO
      END
    \>>
  MBET
    \<< DROP
"How much do you want
to bet?"
"" INPUT OBJ\-> ABS
IP 'BET' STO
      IF BET LOOT >
LOOT 0 > AND
      THEN MBET
      END
    \>>
  SMONEY
    \<< DROP
"How much money do you
want to have?"
"" INPUT OBJ\-> ABS
IP 'LOOT' STO
      IF LOOT 1000
>
      THEN SMONEY
      END
    \>>
  BET 10
  LOOT 110
  HIT
    \<< 'PLAYER' SWAP
STO+ PLAYER PCP
      IF PLAYER
CTOT 21 >
      THEN LCD\-> {
# 32h # Ah }
"BUSTED" 3 \->GROB
REPL \->LCD 'LOOT'
TBET STO-
        IF SPLITY 0
==
        THEN DEALER
DCP CONTM
        ELSE
          IF SPLITY
1 ==
          THEN 2
WAIT TSPLIT
'PLAYER' STO CLLCD
PLAYER PCP DFP 0
'SPLITY' STO
          ELSE
TSPLIT 'PLAYER' STO
0 'SPLITY' STO
CSPLIT 2 WAIT
          END
        END
      END
    \>>
  BMENU
    \<< { { "STAND" }
{ "HIT" } { "SPLIT"
} { "DD" } { "INSU"
} } TMENU
    \>>
  DFP
    \<< DEALER OBJ\->
DROP DROP PCP1 PCP2
LCD\-> { # 0h # 0h }
ROT REPL { # 16h
# 0h } CARDS BACK
UPDIR REPL \->LCD
    \>>
  DCP
    \<< OBJ\->
      CASE DUP 2 ==
        THEN DROP
PCP1 PCP2 LCD\-> {
# 16h # 0h } ROT
REPL \->LCD DROP
        END DUP 3
ROLLD DUP DUP 3 \>=
SWAP 6 \<= AND
        THEN SWAP
PCP1 PCP2 LCD\-> ROT
1 - 22 * R\->B 0 R\->B
2 \->LIST ROT REPL
\->LCD 1 - DROPN
        END
      END 3 FREEZE
    \>>
  PCP2
    \<< CARDS "N"
SWAP + STR\-> EVAL
UPDIR
    \>>
  PCP1
    \<< DUP DUP
      IF IP 1 \=/
      THEN FP CARDS
        CASE DUP .1
==
          THEN
SPADE
          END DUP
.2 ==
          THEN
HEART
          END DUP
.3 ==
          THEN CLUB
          END DUP
.4 ==
          THEN DIAM
          END
        END
      ELSE FP CARDS
        CASE DUP .1
==
          THEN S
          END DUP
.2 ==
          THEN H
          END DUP
.3 ==
          THEN C
          END D
        END
      END SWAP DROP
SWAP UPDIR 0 TRNC
    \>>
  PCP
    \<< OBJ\->
      CASE DUP 2 ==
        THEN DROP
PCP1 PCP2 SWAP PCP1
PCP2 { # 0h # 1Ch }
LCD\-> SWAP ROT REPL
{ # 16h # 1Ch } ROT
REPL \->LCD
        END DUP 3
ROLLD DUP DUP 3 \>=
SWAP 6 \<= AND
        THEN SWAP
PCP1 PCP2 LCD\-> ROT
1 - 22 * R\->B 28 R\->B
2 \->LIST ROT REPL
\->LCD 1 - DROPN
        END
      END 3 FREEZE
    \>>
  CTOT
    \<< 0 'B' STO 0
'Z' STO OBJ\-> 0 SWAP
1 SWAP
      START SWAP 0
TRNC
        IF DUP 10 >
        THEN DROP
10
        END
        IF DUP 1 ==
        THEN 1 'Z'
STO
        END +
      NEXT
      IF DUP 11 \<= Z
1 == AND
      THEN 10 + 1
'B' STO
      END
    \>>
  DEALER 21
  PLAYER 20
  SURRENDER 0
  S17 1
  DDOWN 0
  DECKS 1
  COVER
GROB 131 56 CFFF700000000000000000000000000000200080000000000000000000000000000010000100000000000000000000000000001000010000000000000000000000000000120001000000000000000000000000000017000100000000000000000000000000009F000100000000000000000000000000009F00010000000000000000000000000000120001000000000000000000000000000010000100000000000000000000000000001000010000000000000000000000000000100001000000000000000000000000000013E811000000000000000000000000000017FD1100000000000000000000000000001FFF1100000000000000000000000000001DB71100000000000000000000000000001FFF11000000000000000000000000000010000100000000000000000000000000001008FFFF00000000000000000000000000100400001000000000000000000000000010020000200000000000000000000000001002200020000000000000000000000000100250002000000000000000000000000010027000A7C0008000800020000000000010025000A880008000800020000000000020025000A8800080008000200000000000CFF30360A8807CB4008C1F210000000000000287F0A78082840080A021000000000000028FF0A880F282088CB0A0000000000000028FF0A88882810882A060000000000000028FF0A88882820882A0A0000000000000020F70A7C1FCB4007C3F21000000000000020F702000000000000000000000000000020E302000000000000000000000000000020C102000000000000000000000000000020800200000000000000000000000000002000020000000000000000000000000000200022000000350325D08DDC5A41700000200052000000550555514455CA21100000200072000000320575518CDCDB117000002000520000005205525105454B21100000200052000000320352D0C44D5A47700000200002000000000000000000000000000040000100000000000000000000000000008FFFF000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF300000004000002000000100000000000000303769450637A910980912839238383000205115450124AA28A809228AAA00202000205713470222AA28B809128B3118BB3000205115450421AA28A809A2882120280000603769450371A918AB3993882918383000
  TEST
    \<< BET 'TBET'
STO 0 'SPLITY' STO
{ 0 0 } 'TSPLIT'
STO BMENU CLLCD
PRO3 PLAYER PCP DFP
      DO -1 WAIT
BM2
      UNTIL 99 ==
      END DEAL
    \>>
  B 0
  BY
"PROGRAM BY DAVID
 SPRENKLE,
2565 N PARK AVE #19,
TUCSON, AZ 85719"
  BM2
    \<< \-> a
      \<<
        CASE a 11.1
==
          THEN
CSPLIT
          END a
12.1 ==
          THEN HIT
          END a
13.1 ==
          THEN
SPLIT
          END a
14.1 ==
          THEN DD
          END a
15.1 ==
          THEN INSU
          END
        END DUP 99
\=/ 55 IFT
      \>>
    \>>
  M1
    \<<
      CASE DUP 11.1
==
        THEN TEST
        END DUP
12.1 ==
        THEN MBET
SINFO
        END DUP
13.1 ==
        THEN SMONEY
SINFO
        END
      END
    \>>
  MPAR
    \<<
      CASE DUP 11.1
==
        THEN
          IF DECKS
6 <
          THEN 1
'DECKS' STO+
          ELSE 1
'DECKS' STO
          END LCD\->
{ # 0h # 33h }
DECKS " DECK" + 1
\->GROB REPL \->LCD 3
FREEZE
        END DUP
12.1 ==
        THEN
          IF S17 1
==
          THEN 0
'S17' STO "S S17"
          ELSE 1
'S17' STO "H S17"
          END 1
\->GROB LCD\-> { # 1Ch
# 33h } ROT REPL
\->LCD 3 FREEZE
        END DUP
13.1 ==
        THEN
          CASE
DDOWN 0 ==
            THEN 9
'DDOWN' STO
"DD 9\>= "
            END
DDOWN 9 ==
            THEN 10
'DDOWN' STO
"DD 10\>="
            END
DDOWN 10 ==
            THEN 11
'DDOWN' STO
"DD 11 "
            END 0
'DDOWN' STO
"DD ALL"
          END 1
\->GROB LCD\-> { # 33h
# 33h } ROT REPL
\->LCD 3 FREEZE
        END DUP
14.1 ==
        THEN LCD\->
          IF BP 1.5
==
          THEN 2
'BP' STO
"BJ PAYS 2-1" 1
\->GROB
          ELSE 1.5
'BP' STO
"BJ PAYS 3-2" 1
\->GROB
          END {
# 4Fh # 33h } SWAP
REPL \->LCD 3 FREEZE
        END
      END
    \>>
END