Merge branch 'master' of git://factorcode.org/git/factor

extra/chess960/chess960.factor

@@ -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 ;

extra/math/affine-transforms/affine-transforms-tests.factor

@@ -33,6 +33,12 @@ IN: math.affine-transforms.tests
     dup inverse-transform a.
 ] unit-test
 
+{ 2.0 -1.0 } { -1.0 -2.0 } { 5.0 -6.0 } <affine-transform> 1array [
+    { 1.0 0.0 } { 0.0 -1.0 } { 0.0 0.0 } <affine-transform>
+    { 2.0 1.0 } { -1.0 2.0 } { 5.0 6.0 } <affine-transform>
+    a.
+] unit-test
+
 [ t ] [
     { 0.01  0.02  } { 0.03  0.04  } { 0.05  0.06  } <affine-transform>
     { 0.011 0.021 } { 0.031 0.041 } { 0.051 0.061 } <affine-transform> 0.01 a~

extra/math/affine-transforms/affine-transforms.factor

@@ -3,11 +3,14 @@ USING: accessors arrays combinators combinators.short-circuit kernel math math.v
 math.functions sequences ;
 IN: math.affine-transforms
 
-TUPLE: affine-transform x y origin ;
+TUPLE: affine-transform { x read-only } { y read-only } { origin read-only } ;
 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' )
+     [ x>> ] [ y>> ] bi { 0.0 0.0 } <affine-transform> ;
+
 : a.v ( a v -- v )
     [ [ x>> ] [ first  ] bi* v*n ]
     [ [ y>> ] [ second ] bi* v*n ]
@@ -23,7 +26,7 @@ CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0
     [ 0.0 2array ] [ 0.0 swap 2array ] bi* { 0.0 0.0 } <affine-transform> ;
 
 : center-rotation ( transform center -- transform )
-    [ clone dup ] dip [ vneg a.v ] [ v+ ] bi >>origin ;
+    [ [ x>> ] [ y>> ] [ ] tri ] dip [ vneg a.v ] [ v+ ] bi <affine-transform> ;
     
 : flatten-transform ( transform -- array )
     [ x>> ] [ y>> ] [ origin>> ] tri 3append ;
@@ -42,8 +45,8 @@ CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0
     (inverted-axes) { 0.0 0.0 } <affine-transform> ;
 
 : inverse-transform ( a -- a^-1 )
-    [ inverse-axes dup ] [ origin>> ] bi
-    a.v vneg >>origin ;
+    [ inverse-axes [ x>> ] [ y>> ] [ ] tri ] [ origin>> ] bi
+    a.v vneg <affine-transform> ;
 
 : transpose-axes ( a -- a^T )
     [ [ x>> first  ] [ y>> first  ] bi 2array ]
@@ -51,11 +54,11 @@ CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0
     [ origin>> ] tri <affine-transform> ;
 
 : a. ( a a -- a )
-    transpose-axes {
-        [ [ x>> ] [ x>> ] bi* v. ]
-        [ [ x>> ] [ y>> ] bi* v. ]
-        [ [ y>> ] [ x>> ] bi* v. ]
-        [ [ y>> ] [ y>> ] bi* v. ]
+    {
+        [ [ transpose-axes x>> ] [ x>> ] bi* v. ]
+        [ [ transpose-axes y>> ] [ x>> ] bi* v. ]
+        [ [ transpose-axes x>> ] [ y>> ] bi* v. ]
+        [ [ transpose-axes y>> ] [ y>> ] bi* v. ]
         [ origin>> a.v ]
     } 2cleave
     [ [ 2array ] 2bi@ ] dip <affine-transform> ;

extra/quadtrees/quadtrees.factor

@@ -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
 

extra/svg/svg-tests.factor

@@ -3,8 +3,8 @@ USING: accessors arrays literals math math.affine-transforms
 math.functions multiline sequences svg tools.test xml xml.traversal ;
 IN: svg.tests
 
-{ 1.0 2.25 } { -3.0 4.0 } { 5.5 0.000001 } <affine-transform> 1array [
-    "matrix ( 1 +2.25 -3  , 0.4e+1  ,5.5, 1e-6 )" svg-transform>affine-transform
+{ 1.0 2.25 } { -3.0 4.0 } { 5.5 0.5 } <affine-transform> 1array [
+    "matrix ( 1 +2.25 -3  , 0.4e+1  ,5.5, 5e-1 )" svg-transform>affine-transform
 ] unit-test
 
 { 1.0 0.0 } { 0.0 1.0 } { 5.0 10.0 } <affine-transform> 1array [
@@ -27,17 +27,22 @@ IN: svg.tests
     "scale(2.0 4.0)" svg-transform>affine-transform
 ] unit-test
 
-{ 1.0 0.0 } { $[ 45 degrees tan ] 1.0 } { 0.0 0.0 } <affine-transform> 1array [
+[ t ] [
     "skewX(45)" svg-transform>affine-transform
+    { 1.0 0.0 } { 1.0 1.0 } { 0.0 0.0 } <affine-transform> 0.001 a~
 ] unit-test
 
-{ 1.0 $[ -45 degrees tan ] } { 0.0 1.0 } { 0.0 0.0 } <affine-transform> 1array [
+[ t ] [
     "skewY(-4.5e1)" svg-transform>affine-transform
+    { 1.0 -1.0 } { 0.0 1.0 } { 0.0 0.0 } <affine-transform> 0.001 a~
 ] unit-test
 
-{ $[  30 degrees cos ] $[ 30 degrees sin ] }
-{ $[ -30 degrees sin ] $[ 30 degrees cos ] } { 0.0 0.0 } <affine-transform> 1array [
+[ t ] [
     "rotate(30)" svg-transform>affine-transform
+    { $[ 0.75 sqrt ] 0.5            }
+    { -0.5           $[ 0.75 sqrt ] }
+    {  0.0           0.0            } <affine-transform> 
+    0.001 a~
 ] unit-test
 
 [ t ] [