Paste: excerpt of the poker hand code
Author: | DocPlatypus |
Mode: | forth |
Date: | Tue, 30 Sep 2008 06:06:48 |
Plain Text |
\ hand is the hand type.
\ equiv is the equivalence class rank.
\ later we convert equivalence class rank to hand and qualifier.
: fivecardeval
cells cardlookuptable + @ >r
cells cardlookuptable + @ >r
cells cardlookuptable + @ >r
cells cardlookuptable + @ >r
cells cardlookuptable + @
r> r> r> r>
(fivecardeval) \ the real work gets done here.
;
:noname
fivecards!
1
5 0 do
i cells pad + @ $FF and *
loop
dup rh !
\ look for straights. store the straight qualifier in rf.
0 rf !
11 0 do
dup i cells primerankstraights + @ =
if
i 1+ rf ! leave
then
loop
drop
\ look for flushes. store the flush qualifier in rg.
$F000 \ all suit bits
5 0 do
i cells pad + @ and
loop
rg !
rf @ 0<> if \ straight
5854 rf @ 1- +
rg @ if \ straight flush!
[ 7462 5854 - ] literal +
then
exit
then
\ first, how many different ranks do we have?
\ five: bupkis or flush (we've taken care of straights)
\ less is a pairing type hand, specifically:
\ four: one pair.
\ three: trips or two pair.
\ two: quads or a full house.
\ the last three are combined in one gigantic table, so we
\ only split between flush/bupkis and pairing hands.
0
5 0 do
pad i cells + @ 16 rshift or
loop
countbits
5 = if
rh @ primeranknpns primeranknpnslength
binaryranksearch
rg @ if
[ 5864 1 - ] literal +
then
else
rh @ primerankpairinghands primerankpairinghandslength
binaryranksearch
then
nip nip \ no idea where these are coming from.
;
is (fivecardeval)
New Annotation