Add deck generation and shuffling to poker vocab

diff --git a/extra/poker/poker-tests.factor b/extra/poker/poker-tests.factor
index ad371a6bff6d8084d68e554bd7a71665eea9f12a..e2d89620e63e22de25b32b37ebdbee45c7b6c4db 100644 (file)
--- a/extra/poker/poker-tests.factor
+++ b/extra/poker/poker-tests.factor
@@ -1,4 +1,4 @@
-USING: accessors poker poker.private tools.test math.order kernel ;
+USING: accessors kernel math.order poker poker.private tools.test ;
 IN: poker.tests
 
 [ 134236965 ] [ "KD" >ckf ] unit-test

diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor
index e8e9fa23c5e9cf25ded89c01c287ffe5c35eca2b..15e9a96d42f55d52d9a43f8ce991db7eca164fae 100644 (file)
--- a/extra/poker/poker.factor
+++ b/extra/poker/poker.factor
@@ -1,7 +1,9 @@
-! Copyright (c) 2009 Aaron Schaefer.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors ascii binary-search combinators kernel locals math
-    math.bitwise math.order poker.arrays sequences splitting ;
+! Copyright (c) 2009 Aaron Schaefer. All rights reserved.
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: accessors arrays ascii binary-search combinators kernel locals math
+    math.bitwise math.order poker.arrays random sequences sequences.product
+    splitting ;
 IN: poker
 
 ! The algorithm used is based on Cactus Kev's Poker Hand Evaluator with
@@ -57,6 +59,8 @@ CONSTANT: TWO_PAIR         7
 CONSTANT: ONE_PAIR         8
 CONSTANT: HIGH_CARD        9
 
+CONSTANT: SUIT_STR { "C" "D" "H" "S" }
+
 CONSTANT: RANK_STR { "2" "3" "4" "5" "6" "7" "8" "9" "T" "J" "Q" "K" "A" }
 
 CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
@@ -108,6 +112,9 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
     #! Cactus Kev Format
     >upper 1 cut (>ckf) ;
 
+: parse-cards ( str -- seq )
+    " " split [ >ckf ] map ;
+
 : flush? ( cards -- ? )
     HEX: F000 [ bitand ] reduce 0 = not ;
 
@@ -165,6 +172,9 @@ CONSTANT: VALUE_STR { "" "Straight Flush" "Four of a Kind" "Full House" "Flush"
         [ drop STRAIGHT_FLUSH ]                      !   10 straight-flushes
     } cond ;
 
+: card>string ( card -- str )
+    [ >card-rank ] [ >card-suit ] bi append ;
+
 PRIVATE>
 
 TUPLE: hand
@@ -176,13 +186,16 @@ M: hand equal?
     over hand? [ [ value>> ] bi@ = ] [ 2drop f ] if ;
 
 : <hand> ( str -- hand )
-    " " split [ >ckf ] map
-    dup hand-value hand boa ;
+    parse-cards dup hand-value hand boa ;
 
 : >cards ( hand -- str )
-    cards>> [
-        [ >card-rank ] [ >card-suit ] bi append
-    ] map " " join ;
+    cards>> [ card>string ] map " " join ;
 
 : >value ( hand -- str )
     hand-rank VALUE_STR nth ;
+
+: <deck> ( -- deck )
+    RANK_STR SUIT_STR 2array [ concat >ckf ] product-map ;
+
+ALIAS: shuffle randomize
+