steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add documentation for poker vocab

db4
Aaron Schaefer 2009-04-07 18:34:20 -04:00
parent 7a9c0ce069
commit c101d389e3
2 changed files with 46 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
extra/poker/poker-docs.factor Normal file
View File

@ -0,0 +1,30 @@
USING: help.markup help.syntax strings ;
IN: poker
HELP: <hand>
{ $values { "str" string } { "hand" "a new hand" } }
{ $description "Creates a new poker hand containing the cards specified in " { $snippet "str" } "." }
{ $examples
{ $example "USING: kernel math.order poker prettyprint ;"
"\"AC KC QC JC TC\" \"7C 6D 5H 4S 2C\" [ <hand> ] bi@ <=> ." "+lt+" }
{ $example "USING: kernel poker prettyprint ;"
"\"TC 9C 8C 7C 6C\" \"TH 9H 8H 7H 6H\" [ <hand> ] bi@ = ." "t" }
}
{ $notes "Cards may be specified in any order. Hands are directly comparable to each other on the basis of their computed value. Two hands are considered equal when they would tie in a game (despite being composed of different cards)." } ;
HELP: >cards
{ $values { "hand" "a hand" } { "str" string } }
{ $description "Outputs a string representation of a hand's cards." }
{ $examples
{ $example "USING: poker prettyprint ;"
"\"AC KC QC JC TC\" <hand> >cards ." "\"AC KC QC JC TC\"" }
} ;
HELP: >value
{ $values { "hand" "a hand" } { "str" string } }
{ $description "Outputs a string representation of a hand's value." }
{ $examples
{ $example "USING: poker prettyprint ;"
"\"AC KC QC JC TC\" <hand> >value ." "\"Straight Flush\"" }
}
{ $notes "This should not be used as a basis for hand comparison." } ;

32
extra/poker/poker.factor
View File

@ -155,6 +155,19 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
[ drop "S" ]
} cond ;
: hand-rank ( hand -- rank )
value>> {
{ [ dup 6185 > ] [ drop HIGH_CARD ] } ! 1277 high card
{ [ dup 3325 > ] [ drop ONE_PAIR ] } ! 2860 one pair
{ [ dup 2467 > ] [ drop TWO_PAIR ] } ! 858 two pair
{ [ dup 1609 > ] [ drop THREE_OF_A_KIND ] } ! 858 three-kind
{ [ dup 1599 > ] [ drop STRAIGHT ] } ! 10 straights
{ [ dup 322 > ] [ drop FLUSH ] } ! 1277 flushes
{ [ dup 166 > ] [ drop FULL_HOUSE ] } ! 156 full house
{ [ dup 10 > ] [ drop FOUR_OF_A_KIND ] } ! 156 four-kind
[ drop STRAIGHT_FLUSH ] ! 10 straight-flushes
} cond ;
PRIVATE>
TUPLE: hand
@ -169,23 +182,10 @@ M: hand equal?
" " split [ >ckf ] map
dup hand-value hand boa ;
: hand-rank ( hand -- rank )
value>> {
{ [ dup 6185 > ] [ drop HIGH_CARD ] } ! 1277 high card
{ [ dup 3325 > ] [ drop ONE_PAIR ] } ! 2860 one pair
{ [ dup 2467 > ] [ drop TWO_PAIR ] } ! 858 two pair
{ [ dup 1609 > ] [ drop THREE_OF_A_KIND ] } ! 858 three-kind
{ [ dup 1599 > ] [ drop STRAIGHT ] } ! 10 straights
{ [ dup 322 > ] [ drop FLUSH ] } ! 1277 flushes
{ [ dup 166 > ] [ drop FULL_HOUSE ] } ! 156 full house
{ [ dup 10 > ] [ drop FOUR_OF_A_KIND ] } ! 156 four-kind
[ drop STRAIGHT_FLUSH ] ! 10 straight-flushes
} cond ;
: >value ( hand -- str )
hand-rank VALUE_STR nth ;
: >cards ( hand -- str )
cards>> [
[ >card-rank ] [ >card-suit ] bi append
] map " " join ;
: >value ( hand -- str )
hand-rank VALUE_STR nth ;