Paste: BlackJack v0.5

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

: ? @ . ;

VARIABLE DECK 312 CELLS ALLOT

: DECKINIT
  6 0 DO
    I >R
    4 0 DO
      13 0 DO
        I 10 < IF I 1+ ELSE 10 THEN
          DECK R> 52 * J 13 * I + + CELLS + !
      LOOP
    LOOP
  LOOP
;


: SWITCH
  DUP @ >R
  SWAP
  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
0 TEMPCARD !

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


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

: ACE? ACE ? ;
: ACECHECK DECK TEMPCARD @ CELLS + @ 1 = IF +ACE THEN ;


VARIABLE #HAND
0 #HAND !

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

: HIT +#HAND DRAW ACECHECK ;

VARIABLE HAND 10 CELLS ALLOT
: CARD1 HAND ! ;
: CARD2 HAND 1 CELLS + ! ;
: CARDX HAND #HAND @ 1- CELLS + ! ;


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

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


: DEAL -ACE -#HAND HIT CARD1 HIT CARD2 SPLITCHECK ;
: HITME HIT CARDX ;


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


: SOFTV 0 #HAND @ 0 DO HAND I CELLS + @ +   LOOP ;

: HARDV 0 #HAND @  0 DO HAND I CELLS + @ + LOOP ACE @ 1 = IF 10 + THEN ;


: SPLIT?
  SPLITX @ 1 = IF
    ( ALL SPLIT RELATED WORDS )
  THEN
;


VARIABLE $BET
VARIABLE $POOL
VARIABLE SBET
: STRING 32 ALLOT SWAP ! ;
: READ @ 32 CR ." ->" ACCEPT CR ;
: PRINT @ CR ." '" TYPE ." '" CR ;
: >NUM @ ATOI ;
SBET STRING
: -$POOL $POOL @ SWAP - $POOL ! ;

: BET1 ." ENTER A BET: " SBET READ SBET >NUM $BET !;
: BET2 $BET @ $POOL @ > IF ." NOT ENOUGH MONEY, TRY AGAIN!" ELSE   $BET @ -$POOL THEN ;
: BET CR BET1 BET2 ." YOUR BET IS: $" $BET ? ." YOUR REMAINING MONEY: $" $POOL ? CR ;


VARIABLE PSCORE
0 PSCORE !

VARIABLE DSCORE
0 DSCORE !

 
: 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
;

VARIABLE DHITX
0 DHITX !
: -DHITX 0 DHITX ! ;

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

VARIABLE WIN

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


: WIN?
  DSCORE > 21 IF PSCORE 22 < IF 1 WIN ! THEN
  DSCORE PSCORE < IF PSCORE 22 < IF 1 WIN ! THEN
    
  DSCORE PSCORE = IF 3 WIN ! THEN
  
  BJCHECK

  WIN @ 0 > INVERT IF 0 WIN ! THEN
;

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


: WIN?? WIN? ( ... ) ;

: ENDROUNDDISPLAY
  
;


VAR KEYENT
0 KEYENT !

: GETKEY KEY KEYENT ! ;


: INPUT
  [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
;

: 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
;

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

: BUSTCHECK  PSCORE 21 > IF +#ILOOP THEN ;

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

( SPLIT IS A SEPERATE INPUT QUERY BEFORE INPUT )


VARIABLE ROUNDOVER
VARIABLE GAMEOVER
0 ROUNDOVER !
0 GAMEOVER !

: BLACKJACK
  BEGIN
    INITIALIZE
    INITDISPLAY
    BEGIN
      BET
      DEAL 
      DISPLAY
    ( SPLIT? SPLITALL )
      DDEAL ( INSURANCE? )
      INPUT?
      INPUT DHIT?
      DISPLAY
      XWIN??   ( BRANCHES INTO WIN?? OR SWIN?? IF SPLIT )
    ROUNDOVER UNTIL
    ENDROUNDDISPLAY PLAYAGAIN?
  GAMEOVER UNTIL
  HIGHSCORE
;


: GETNAME1 ." ENTER 3 INITIALS:" CR ." ->"
  KEY DUP EMIT KEY DUP EMIT KEY DUP EMIT
;

VARIABLE TEMPNAM

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

: GETNAME GETNAME1 GETNAME2 ;


( REPLACE TEMPNAM WITH HSNAME ARRAY WITH I CELLS )

: PRINTNAME
  TEMPNAM @ 10000 / DUP EMIT 10000 * TEMPNAM @
  SWAP - DUP 100 / DUP EMIT 100 * - EMIT ;
;


VARIABLE NAM 10 CELLS ALLOT
VARIABLE SCORES 10 CELLS ALLOT


: SCOREDISPLAY
  CR
  CR ." ********************************"
  CR ." * ======== HIGHSCORES ======== *"
  CR ." ********************************"
  CR ." *                              *"
  10 0 DO
    (  CR ." * " ADEC NAM I CELLS + @ . DECIMAL )
    ." -------------------- " SCORES I CELLS + @ 
    10 * 5 U.R ."  *"
  LOOP
  CR ." *                              *"
  CR ." ********************************"
  CR
;