]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorJoe Groff <arcata@gmail.com>
Fri, 6 Mar 2009 21:23:28 +0000 (15:23 -0600)
committerJoe Groff <arcata@gmail.com>
Fri, 6 Mar 2009 21:23:28 +0000 (15:23 -0600)
extra/chess960/chess960.factor [new file with mode: 0644]
extra/math/affine-transforms/affine-transforms.factor
extra/quadtrees/quadtrees.factor

diff --git a/extra/chess960/chess960.factor b/extra/chess960/chess960.factor
new file mode 100644 (file)
index 0000000..6535cc1
--- /dev/null
@@ -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 ;
index 822af51614eb7f1d61c49882864a2697f122a215..132082fdbad44b6b77757175122fcf177ecf249d 100644 (file)
@@ -8,6 +8,9 @@ C: <affine-transform> affine-transform
 
 CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0 0.0 } }
 
+: axes ( a -- a' )
+    clone { 0.0 0.0 } >>origin ;
+
 : a.v ( a v -- v )
     [ [ x>> ] [ first  ] bi* v*n ]
     [ [ y>> ] [ second ] bi* v*n ]
index 1a916c74f4aa79ef01c03a29b26982add1842006..6fe361b556c565ae6a39052a925fde8243909f57 100644 (file)
@@ -194,5 +194,5 @@ M: quadtree clear-assoc ( assoc -- )
 : swizzle ( sequence quot -- sequence' )
     [ dup ] dip map
     [ zip ] [ rect-containing <quadtree> ] bi
-    [ '[ first2 _ set-at ] each ] [ values ] bi ;
+    [ '[ first2 _ set-at ] each ] [ values ] bi ; inline