extra/chess960/chess960.factor

   1 USING: ranges kernel random sequences arrays combinators ;
   2 IN: chess960
   3
   4 SYMBOLS: pawn rook knight bishop queen king ;
   5
   6 : all-positions ( -- range ) 8 [0..b) ;
   7
   8 : black-bishop-positions ( -- range ) 0 6 2 <range> ;
   9 : white-bishop-positions ( -- range ) 1 7 2 <range> ;
  10
  11 : frisk ( position positions -- position positions' )
  12     [ drop ] [ remove ] 2bi ;
  13
  14 : white-bishop ( positions -- position positions' )
  15     [ white-bishop-positions random ] dip frisk ;
  16 : black-bishop ( positions -- position positions' )
  17     [ black-bishop-positions random ] dip frisk ;
  18
  19 : random-position ( positions -- position positions' )
  20     [ random ] keep frisk ;
  21
  22 : make-position ( white-bishop black-bishop knight knight queen {r,k,r} -- position )
  23     first3
  24     8 f <array> {
  25         [ [ rook ] 2dip set-nth ]
  26         [ [ king ] 2dip set-nth ]
  27         [ [ rook ] 2dip set-nth ]
  28         [ [ queen ] 2dip set-nth ]
  29         [ [ knight ] 2dip set-nth ]
  30         [ [ knight ] 2dip set-nth ]
  31         [ [ bishop ] 2dip set-nth ]
  32         [ [ bishop ] 2dip set-nth ]
  33         [ ]
  34     } cleave ;
  35
  36 : chess960-position ( -- position )
  37     all-positions
  38     white-bishop
  39     black-bishop
  40     random-position
  41     random-position
  42     random-position
  43     make-position ;