Paste: BlackJack (old version)

VARIABLE rnd   HERE rnd !
: RANDOM rnd @ 31421 *  6927 +  DUP rnd ! ;
: CHOOSE RANDOM UM*  NIP ;

: ? @ . ;

VARIABLE DECK 312 CELLS ALLOT
( VARIABLE K )

: DECKINIT
  6 0 DO
    ( I K ! )
    4 0 DO
      13 0 DO
        I 10 < IF I 1+ ELSE 10 THEN
          DECK K ( @ ) 52 * J 13 * I + + CELLS + !
      LOOP
    LOOP
  LOOP
;


: SWITCH
  DUP @ >R
  SWAP DUP
  SWAP @ >R
  SWAP
  R> SWAP ! R> SWAP !
;

: SHUFFLE
  0 312 DO
    DECK I CHOOSE CELLS + DECK I CELLS +
    SWITCH
  -1 +LOOP
;

VARIABLE #SHOE
: RESET#SHOE 311 #SHOE ! ;
: -#SHOE #SHOE @ 1 - #SHOE ! ; 

: NEWSHOE
  DECKINIT
  SHUFFLE
  RESET#SHOE
;

VARIABLE TEMPCARD

: SHOEPEN
  #SHOE @ 77 = IF
    NEWSHOE
    CR ." The shoe has been reset!"
  THEN
;

: DRAW
  DECK #SHOE @ CELLS + @
  #SHOE @ TEMPCARD !
  -#SHOE
  SHOEPEN
;


VARIABLE ACE
VARIABLE SACE
VARIABLE DACE
: -ACE 0 ACE ! ;
: +ACE 1 ACE ! ;
: -SACE 0 SACE ! ;
: +SACE 1 SACE ! ;
: -DACE 0 DACE ! ;
: +DACE 1 DACE ! ;

: ACECHECK  DECK TEMPCARD @ CELLS + @ 1 = IF +ACE  THEN ;
: SACECHECK DECK TEMPCARD @ CELLS + @ 1 = IF +SACE THEN ;
: DACECHECK DECK TEMPCARD @ CELLS + @ 1 = IF +DACE THEN ;


VARIABLE #HAND
VARIABLE #DHAND

VARIABLE HAND 20 CELLS ALLOT
VARIABLE DHAND 10 CELLS ALLOT


VARIABLE SPLITD
: +SPLITD 1 SPLITD ! ;
: -SPLITD 0 SPLITD ! ;


: +#HAND #HAND @ 1+ #HAND ! ;
: -#HAND 0 #HAND ! ;
: +#DHAND #DHAND @ 1+ #DHAND ! ;
: -#DHAND 0 #DHAND ! ;


: CARDX HAND #HAND @ 1- CELLS + ! ;
: SCARDX HAND #HAND @ 9 + CELLS + ! ;
: DCARDX DHAND #DHAND @ 1- CELLS + ! ;

: HIT
  +#HAND DRAW ACECHECK
  SPLITD @ 1 = IF
    SCARDX
  ELSE
    CARDX
  THEN
;

: DHIT +#DHAND DRAW DACECHECK DCARDX ;


VARIABLE SPLITACE
VARIABLE SPLITX
: +SPLITX 1 SPLITX ! ;
: -SPLITX 0 SPLITX ! ;
: +SPLITACE 1 SPLITACE ! ;
: -SPLITACE 0 SPLITACE ! ;

: SPLITCHECK
  HAND @ HAND 1 CELLS + @ = IF +SPLITX ELSE -SPLITX THEN
;


: DEAL -ACE -#HAND HIT HIT SPLITCHECK ;
: DDEAL -DACE -#DHAND DHIT DHIT ;


0 NEGATE 1- CONSTANT (ERROR)
 
: >NUM
  0. ROT DUP 1+ C@ [CHAR] - = >R COUNT R@ IF 1 
  THEN >NUMBER NIP 0= IF D>S R> IF NEGATE THEN ELSE R> DROP
  2DROP (ERROR) THEN
;


VARIABLE $BET
VARIABLE $POOL

VARIABLE READLOOP 
: READ
  0 READLOOP !
  BEGIN
    CR ." ->"
    REFILL DROP
    BL WORD
    >NUM DUP
    DUP (ERROR) = OR 0 <= IF                              
      CR ." You didn't enter a valid number, try again!" DROP CR
    ELSE
      DUP $POOL @ > IF
        CR ." Not enough money, try again!" DROP
      ELSE
        DUP 5 < IF
          CR ." Table minimum is: $5, try again!" DROP
        ELSE
          1 READLOOP ! CR
        THEN
      THEN
    THEN
  READLOOP @ UNTIL
;

: -$POOL  $POOL @ SWAP - $POOL ! ;

: BET1  ." Enter a bet: " READ $BET ! ;
: BET2  $BET @ -$POOL ;
: BET
  CR ." Your current money: $" $POOL ? CR
  BET1 BET2 ." Your bet is: $" $BET ?
  ." Your remaining money: $" $POOL ? CR
;


( VARIABLE SBET )
(  : STRING 32 ALLOT SWAP ! ; )
(  : READ @ 32 CR ." ->" ACCEPT CR ; )
(  : PRINT @ CR ." '" TYPE ." '" CR ; )
(  : >NUMBER  ATOI ; )
(  SBET STRING )


: DISPLAYHAND
  CR ." Your hand has the card values: "
  #HAND @ 0 DO HAND I CELLS + ? ."  " LOOP
;

: SDISPLAY
  CR ." Your hand has the card values: "
  #HAND @ 0 DO HAND I 10 + CELLS + ? ."  " LOOP
;

: DISPLAY$
  CR ." Your current money: $" $POOL ?
  CR ." Your current bet: $" $BET ?
;

: SPDISPLAY  ( SHOW CARDS DEALT OR REMAIN? )
  CR ." Shoe penetration: " 311 #SHOE @ - .
  ." /312 cards dealt ( " 311 #SHOE @ - 100 * 312 / . ." % )"
  CR ." New shoe in: " #SHOE @ 77 - . ." cards"
;

: DISPLAY
  PAGE CR
  ." Dealer up-card: " DHAND ? CR
  SPLITD @ 1 = IF
    SDISPLAY
  ELSE
    DISPLAYHAND
  THEN
  SPDISPLAY
  CR DISPLAY$ CR
;

VARIABLE PSCORE
0 PSCORE !

VARIABLE DSCORE
0 DSCORE !


: SOFT
  0 #HAND @ 0 DO
    HAND
    SPLITD @ 1 = IF
      I 10 +
    ELSE
      I
    THEN
    CELLS + @ +
  LOOP
;

: HARD
  0 #HAND @  0 DO
    HAND
    SPLITD @ 1 = IF
      I 10 +
    ELSE
      I
    THEN
    CELLS + @ +
  LOOP

  SPLITD @ 1 = IF
    SACE @ 1 = IF
      10 +
    THEN
  THEN

  SPLITD @ 0 = IF
    ACE @ 1 = IF
      10 +  
    THEN
  THEN
;


: PLRVALUE
  HARD SOFT > IF
    HARD 22 < IF HARD ELSE
    SOFT THEN
  ELSE
    SOFT
  THEN
  PSCORE !
;


: DSOFT
  0 #DHAND @ 0 DO DHAND I CELLS + @ + LOOP
;

: DHARD
  0 #DHAND @  0 DO DHAND I CELLS + @ + LOOP
  DACE @ 1 = IF 10 + THEN
;


: DLRVALUE
  DHARD DSOFT > IF
    DHARD 22 < IF DHARD ELSE
    DSOFT THEN
  ELSE
    DSOFT
  THEN
  DSCORE !
;

VARIABLE DHITX
: -DHITX 0 DHITX ! ;


: DHIT?
  -DHITX
  BEGIN
    DLRVALUE
    DSCORE @ 17 < IF DHIT ELSE 1 DHITX ! THEN
  DHITX @ UNTIL
;


: DOUBLE
  $BET @ $POOL @ <= IF
    $BET @ -$POOL
    $BET @ 2 * $BET !
    HIT
  ELSE
    CR ." You don't have the money to Double, so you Hit" cr
    HIT
  THEN
;


VARIABLE KEYENT
0 KEYENT !

: GETKEY KEY KEYENT ! ;

VARIABLE #ILOOP
: -#ILOOP 0 #ILOOP ! ;
: +#ILOOP 1 #ILOOP ! ;

: INPUT
  SPLITACE @ 1 = IF
    CR ." Split Aces must stand." +#ILOOP
  ELSE
    [CHAR] 1 KEYENT @ = IF +#ILOOP THEN
    [CHAR] 2 KEYENT @ = IF HIT THEN
    [CHAR] 3 KEYENT @ = IF DOUBLE +#ILOOP THEN
    [CHAR] Q KEYENT @ = IF QUIT THEN
  THEN
;

: IDISPLAY ( INPUT DISPLAY )
  ." Please enter a key for the action you wish to take:"
  CR ." 1 - Stand, 2 - Hit, 3 Double, Q - Quit Game"
;

: INPUT?
  CR IDISPLAY
  CR ." ->" GETKEY
  INPUT
;

: BUSTCHECK  PSCORE @ 21 > IF +#ILOOP THEN ;

VARIABLE HANDSCORE 2 CELLS ALLOT

: INPUTLOOP
  -#ILOOP
  BEGIN
    DISPLAY
    INPUT?
    PLRVALUE
    BUSTCHECK
  #ILOOP @ UNTIL
;

: PLAYERHAND
  INPUTLOOP
  PSCORE @ HANDSCORE !
;


: HANDSPLIT
  HAND 1 CELLS + @ HAND 10 CELLS + !
  0 HAND 1 CELLS + !
  DRAW DUP CARDX ACECHECK
  CR . ." was dealt to one of the split cards
  DRAW DUP SCARDX SACECHECK
  CR . ." was dealt to one of the split cards"

  ( WAIT X TICKS? )
;

: SPLIT?
  SPLITX @ 1 = IF
    DISPLAY
    CR ." You have a pair, would you like to split?"
    CR ." Please enter a key for the action you wish to take"
    CR ." 1 - Yes, 2 - No"
    CR ." ->" GETKEY

    [CHAR] 1 KEYENT @ = IF 
      +SPLITD

      ACE @ 1 = IF
        +SPLITACE
      ELSE
        -SPLITACE
      THEN

      HANDSPLIT
      INPUTLOOP
      HANDSCORE 1 CELLS + PSCORE @ !
      2 #HAND !
    ELSE
      -SPLITX
    THEN
    -SPLITD
  THEN
;


VARIABLE WIN

: BJCHECK
  PSCORE @ 21 = IF
    #HAND @ 2 = IF
      2 WIN !
      #DHAND @ 2 = IF
        DSCORE @ 21 = IF 3 WIN !
        THEN
      THEN
    THEN
  THEN
;


: WIN?
  0 WIN !
  PLRVALUE
  DLRVALUE

  DSCORE @ PSCORE @ = IF
    PSCORE @ 22 < IF
      3 WIN !
    THEN
  THEN

  PSCORE @ 22 < IF
    DSCORE @ 21 > PSCORE @ DSCORE @ > OR IF
      1 WIN !
    THEN
  THEN

  BJCHECK
;

( WIN: 0= LOSE, 1= WIN, 2= BLACKJACK, 3= PUSH )


: +$POOL $POOL @ + $POOL ! ;


: WDECISIONS
  WIN @ 0 = IF
    CR ." You lost this hand"
  THEN
  WIN @ 1 = IF
    CR ." You won this hand, winning: $" $BET ?
    $BET @ +$POOL
    $BET @ +$POOL
  THEN
  WIN @ 2 = IF
    $BET @ +$POOL
    CR ." BLACKJACK! Blackjack pays 3:2, you won: $"
    $BET @ 3 * 2 / $BET ! $BET ?
    $BET @ +$POOL
  THEN
  WIN @ 3 = IF
    CR ." This hand was a push, your bet was returned"
    $BET @ +$POOL
  THEN
;

: WIN??
  CR ." The Dealer has the card values: "
  #DHAND @ 0 DO DHAND I CELLS + ? ."  " LOOP
  CR

  CR ." Your hand had the following outcome:" CR
  HANDSCORE @ PSCORE ! ( DEFAULT HAND )
  WIN?
  WDECISIONS
  
  SPLITX @ 1 = IF
    CR CR ." Your other hand:" CR
    HANDSCORE 1 CELLS + @ PSCORE ! ( SPLIT HAND )
    WIN?
    WDECISIONS
  THEN
  CR ." Your remaining money after this round: $" $POOL ? CR
;


VARIABLE NAM 10 CELLS ALLOT
VARIABLE SCORES 10 CELLS ALLOT

: GETNAME1 ." Enter 3 initials:" CR ." ->"
  KEY DUP EMIT KEY DUP EMIT KEY DUP EMIT
;

VARIABLE TEMPNAM
VARIABLE PIX

: GETNAME2
  TEMPNAM ! 100 * TEMPNAM @ + TEMPNAM !
  10000 * TEMPNAM @ + TEMPNAM ! TEMPNAM @
;

: GETNAME GETNAME1 GETNAME2 SWAP NAM CELLS + ! ;


: PRINTNAME
  PIX !
  NAM PIX CELLS + @ 0 = IF
    ."    "
  ELSE
    NAM PIX CELLS + @ 10000 / DUP EMIT 10000 * NAM PIX CELLS + @
    SWAP - DUP 100 / DUP EMIT 100 * - EMIT
  THEN
;


: SCOREDISPLAY
  CR
  CR ." ********************************"
  CR ." * ======== HIGHSCORES ======== *"
  CR ." ********************************"
  CR ." *                              *"
  10 0 DO
     CR ." * " I PRINTNAME
    ." -------------------- " SCORES I CELLS + @ 
    5 U.R ." *"
  LOOP
  CR ." *                              *"
  CR ." ********************************"
  CR
;

VARIABLE HSI

: HIGHSCORE
  0 HSI !
  0 10 DO
    $POOL SCORES I CELLS + @ > IF I HSI ! THEN
  -1 +LOOP
  HSI @ 0 > IF
    PAGE ." NEW HIGHSCORE! " CR
    HSI @ GETNAME
  THEN
  PAGE SCOREDISPLAY
;


VARIABLE INS

: INSINPUT
  [CHAR] 1 KEYENT @ = IF
    CR ." You can make an Insurance bet up to: " $BET @ 2 / .
    CR ." Enter an Insurance bet:" READ INS !

    INS @ $BET @ 2 / > IF
      CR ." You entered a number above your allowed Insurance, correct amount"
      ."  applied"
      $BET @ 2 / INS !
    THEN

    CR ." Your Insurance bet is: " INS ? CR
    INS @ -$POOL

  ELSE
    0 INS !
  THEN
;

: INSURANCE
  DHAND 0 CELLS + @ 1 = IF
    DISPLAY
    CR ." The Dealer has a face-up Ace, would you like Insurance?"
    CR ." Please enter a key for the action you wish to take:"
    CR ." 1 - Yes, Any other key - No"
    CR ." ->" GETKEY
    INSINPUT
  THEN
;

: INSCHECK
  #DHAND @ 2 = DSCORE @ 21 = AND IF
    INS 0 > IF
      INS @ 2 * +$POOL
      CR ." You have received an Insurance pay-out of: " INS @ 2 * . CR
    THEN
  THEN
;


VARIABLE GAMEOVER

( : MEMORY )
(  4096 HEAP STUFF )
( ; ) ( MEMORY IN ROUNDINIT? )

: ROUNDINIT
  -ACE -SACE -DACE
  -#HAND -#DHAND
  -SPLITX -SPLITACE -SPLITD
  0 $BET !
  20 0 DO 0 HAND I CELLS + ! LOOP
  10 0 DO 0 DHAND I CELLS + ! LOOP
   2 0 DO 0 HANDSCORE I CELLS + ! LOOP
  0 KEYENT !
  0 GAMEOVER !
;

: INITIALIZE
  ROUNDINIT
  100 $POOL !
  NEWSHOE
;

: INITDISPLAY
  PAGE CR ." BLACKJACK version 0.9"
  CR ." Press any key to continue"
  CR ." ->" KEY DROP
;


: PLAYAGAIN?
  CR
  $POOL @ 5 < IF
    CR ." You have run out of money, game over!"
    CR ." Press any key to end the game"
    CR ." ->" KEY DROP
    1 GAMEOVER !
  ELSE
    CR ." Would you like to play another hand, or leave the table?"
    CR
    CR ." Please enter a key for the action you wish to take:"
    CR ." 1 - New hand, Any other key - Leave table"
    CR ." ->" GETKEY
    [CHAR] 1 KEYENT @ = IF
      0 GAMEOVER !
    ELSE
      1 GAMEOVER !
    THEN
  THEN
;


: BLACKJACK
  INITIALIZE
  INITDISPLAY
  BEGIN
    ROUNDINIT
    BET
    DEAL
    DDEAL
    SPLIT?
    PLAYERHAND
    INSURANCE
    DHIT?
    DISPLAY
    INSCHECK
    WIN??
    PLAYAGAIN?
  GAMEOVER @ UNTIL
  HIGHSCORE
  CR ." Press any key to quit to terminal"
  CR ." ->" KEY DROP PAGE QUIT
;