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

chess960 buddy

db4
Joe Groff 2009-02-28 16:16:09 -06:00
parent e4a9276c43
commit 3636a4f05f
1 changed files with 43 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
extra/chess960/chess960.factor Normal file
View File

@ -0,0 +1,43 @@
USING: math.ranges kernel random sequences arrays combinators ;
IN: chess960
SYMBOLS: pawn rook knight bishop queen king ;
: all-positions ( -- range ) 0 8 [a,b) ;
: black-bishop-positions ( -- range ) 0 6 2 <range> ;
: white-bishop-positions ( -- range ) 1 7 2 <range> ;
: frisk ( position positions -- position positions' )
[ drop ] [ remove ] 2bi ;
: white-bishop ( positions -- position positions' )
[ white-bishop-positions random ] dip frisk ;
: black-bishop ( positions -- position positions' )
[ black-bishop-positions random ] dip frisk ;
: random-position ( positions -- position positions' )
[ random ] keep frisk ;
: make-position ( white-bishop black-bishop knight knight queen {r,k,r} -- position )
first3
8 f <array> {
[ [ rook ] 2dip set-nth ]
[ [ king ] 2dip set-nth ]
[ [ rook ] 2dip set-nth ]
[ [ queen ] 2dip set-nth ]
[ [ knight ] 2dip set-nth ]
[ [ knight ] 2dip set-nth ]
[ [ bishop ] 2dip set-nth ]
[ [ bishop ] 2dip set-nth ]
[ ]
} cleave ;
: chess960-position ( -- position )
all-positions
white-bishop
black-bishop
random-position
random-position
random-position
make-position ;