Deal cards for FreeCell: Difference between revisions
Content added Content deleted
(Added Fōrmulæ) |
(Add Factor example) |
||
Line 1,158: | Line 1,158: | ||
4S TS 2H 5D JC 6C JH QH |
4S TS 2H 5D JC 6C JH QH |
||
JD KS KC 4H |
JD KS KC 4H |
||
</pre> |
|||
=={{header|Factor}}== |
|||
<lang factor>USING: formatting grouping io kernel literals make math |
|||
math.functions namespaces qw sequences sequences.extras ; |
|||
IN: rosetta-code.freecell |
|||
CONSTANT: max-rand-ms $[ 1 15 shift 1 - ] |
|||
CONSTANT: suits qw{ C D H S } |
|||
CONSTANT: ranks qw{ A 2 3 4 5 6 7 8 9 T J Q K } |
|||
SYMBOL: seed |
|||
: (random) ( n1 n2 -- n3 ) seed get * + dup seed set ; |
|||
: rand-ms ( -- n ) |
|||
max-rand-ms 2531011 214013 (random) -16 shift bitand ; |
|||
: init-deck ( -- seq ) |
|||
ranks suits [ append ] cartesian-map concat V{ } like ; |
|||
: swap-cards ( seq -- seq' ) |
|||
rand-ms over length [ mod ] [ 1 - ] bi pick exchange ; |
|||
: (deal) ( seq -- seq' ) |
|||
[ [ swap-cards dup pop , ] until-empty ] { } make ; |
|||
: deal ( game# -- seq ) seed set init-deck (deal) ; |
|||
: .cards ( seq -- ) 8 group [ [ write bl ] each nl ] each nl ; |
|||
: .game ( game# -- ) dup "Game #%d\n" printf deal .cards ; |
|||
: freecell ( -- ) 1 617 [ .game ] bi@ ; |
|||
MAIN: freecell</lang> |
|||
{{out}} |
|||
<pre> |
|||
Game #1 |
|||
JD 2D 9H JC 5D 7H 7C 5H |
|||
KD KC 9S 5S AD QC KH 3H |
|||
2S KS 9D QD JS AS AH 3C |
|||
4C 5C TS QH 4H AC 4D 7S |
|||
3S TD 4S TH 8H 2C JH 7D |
|||
6D 8S 8D QS 6C 3D 8C TC |
|||
6S 9C 2H 6H |
|||
Game #617 |
|||
7D AD 5C 3S 5S 8C 2D AH |
|||
TD 7S QD AC 6D 8H AS KH |
|||
TH QC 3H 9D 6S 8D 3D TC |
|||
KD 5H 9S 3C 8S 7H 4D JS |
|||
4C QS 9C 9H 7C 6H 2C 2S |
|||
4S TS 2H 5D JC 6C JH QH |
|||
JD KS KC 4H |
|||
</pre> |
</pre> |
||