%%HP: T(3)A(D)F(.);
@
@ Playing Card Routines - By Stanley H.H.Lui 1/22/2000
@ This file contains the following common routines to be used in card games
@
@ 1. card dealing routine
@ 2. reset deck routine
@ 3. display-a-card routine
@
@
\<<

 \-> ri  \<<
CASE

ri 1 == THEN
@
@ card dealing routine:
@ input:  ndk  dd
@           ndk : number of decks used
@           dd : [deck data]  An array of numbers.  The size must be 52 * number of decks used
@ output: cs cn dd
@   cs - card suit:  1 (club),  2 (diamond), 3 (heart), and 4 (spade)
@   cn - card number : 1 (for Ace), 2 - 13 ( for 2 to King)
@   dd - the updated deck data
 0 0 0 \-> ndk dd   cn cs  c \<<

    WHILE dd RAND ndk 52 * * IP 1 + 'c' STO c GET 0 \=/ REPEAT
    END 

    dd c 1 PUT 'dd' STO

    IF c 52 MOD DUP NOT THEN DROP 52 END 'c' STO c
    1 - 13 / IP 1 +
    DUP c SWAP 1 - 13 * -
    dd
 \>>
END

ri 2 == THEN
@ Reset to use a new set of decks of cards (up to 8 decks)
@ input: none
@ output: [deck data] , all set to zeros

   [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
     0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ]

END

ri 3 == THEN
@ display a card (either face up or down) 
@ input:   x y cs cn cup rc
@           x:   x position of upper left hand corner of card in binary
@           y:   y position of upper left hand corner of card in binary
@           cs:  suit of card to display
@           cn:  number (Ace to King) of card to display
@           cup:  1 - draw card up, else draw card down
@           rc:   1 - draw round corners, 0 - draw square corners

GROB 11 12 020007008E0007004210EF30DF70EA3042100700CC10EF30

GROB 11 11 020007008F004F10AF30DF70AF304F108E0005000200

GROB 13 11 C06061F0BAF1DFF1BFF16FF0CE7085300B100E000400

GROB 11 12 020007008E004F10AF30DF705F70BA7062300700CC10EF30

GROB 19 27 FFFF70100040DCCC40DCCC40100040DCCC40DCCC40100040DCCC40DCCC40100040DCCC40DCCC40100040DCCC40DCCC40100040DCCC40DCCC40100040DCCC40DCCC40100040DCCC40DCCC40100040FFFF70

    0 \-> x y cs cn cup rc    club diamond heart spade bcard   
        cng \<<

     IF cn 2 \>= cn 10 \<= AND THEN
        cn \->STR 'cng' STO
        IF cng cng SIZE DUP SUB "." == THEN cng 1 cng SIZE 1 - SUB ELSE cng END
     ELSE
        CASE
            cn 1 == THEN "A" END
            cn 11 == THEN "J" END
            cn 12 == THEN "Q" END
            cn 13 == THEN "K" END
        END
     END 1 \->GROB 'cng' STO
     
     IF cup NOT THEN
        PICT x y 2 \->LIST bcard REPL
     ELSE
        PICT x y 2 \->LIST # 19d # 27d BLANK REPL
        x y 2 \->LIST x #18d + y #26d + 2 \->LIST BOX
        PICT x #2d + y #2d + 2 \->LIST cng REPL
        PICT x {#4d #4d #3d #4d} cs GET + y {#7d #8d #8d #7d} cs GET + 2 \->LIST
        CASE
          cs 1 == THEN club END
          cs 2 == THEN diamond END
          cs 3 == THEN heart END
          cs 4 == THEN spade END
        END  REPL
        PICT x 
        CASE
           cn 10 <  cn 11 == OR THEN #14d  END
           cn 12 ==  cn 13 == OR THEN #13d END
           cn 10 == THEN #10d END
        END
        +  y #20d + 2 \->LIST cng REPL
     END 
     IF rc THEN
        x y 2 \->LIST PIXOFF
        x #18d + y #26d + 2 \->LIST PIXOFF
        x #18d + y  2 \->LIST PIXOFF
        x  y #26d + 2 \->LIST PIXOFF
     END
   \>>
END


@ end of CASE
END


\>>
\>>



