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 ( a b c d e -- equiv )
	cells cardlookuptable + @ >r
	cells cardlookuptable + @ >r
	cells cardlookuptable + @ >r
	cells cardlookuptable + @ >r
	cells cardlookuptable + @
	r> r> r> r>
	( a' b' c' d' e' )
	(fivecardeval) \ the real work gets done here.
	;

:noname ( a b c d e -- equiv )
	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

Summary:
Author:
Mode:
Body: