From 3636a4f05fa500bfe553612047621ab7944af76e Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 28 Feb 2009 16:16:09 -0600 Subject: [PATCH 1/3] chess960 buddy --- extra/chess960/chess960.factor | 43 ++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 extra/chess960/chess960.factor diff --git a/extra/chess960/chess960.factor b/extra/chess960/chess960.factor new file mode 100644 index 0000000000..6535cc1925 --- /dev/null +++ b/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 ; +: white-bishop-positions ( -- range ) 1 7 2 ; + +: 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 { + [ [ 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 ; From 4f156348d37f4e1ff13426ecb320fff71af6fe7e Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 4 Mar 2009 11:44:24 -0600 Subject: [PATCH 2/3] inline quadtrees:swizzle. add axes word to math.affine-transforms to remove translation from transform --- extra/math/affine-transforms/affine-transforms.factor | 3 +++ extra/quadtrees/quadtrees.factor | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/extra/math/affine-transforms/affine-transforms.factor b/extra/math/affine-transforms/affine-transforms.factor index 822af51614..132082fdba 100644 --- a/extra/math/affine-transforms/affine-transforms.factor +++ b/extra/math/affine-transforms/affine-transforms.factor @@ -8,6 +8,9 @@ C: 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 ] diff --git a/extra/quadtrees/quadtrees.factor b/extra/quadtrees/quadtrees.factor index d9bdbe4aeb..9ce8003736 100644 --- a/extra/quadtrees/quadtrees.factor +++ b/extra/quadtrees/quadtrees.factor @@ -195,5 +195,5 @@ M: quadtree clear-assoc ( assoc -- ) : swizzle ( sequence quot -- sequence' ) [ dup ] dip map [ zip ] [ rect-containing ] bi - [ '[ first2 _ set-at ] each ] [ values ] bi ; + [ '[ first2 _ set-at ] each ] [ values ] bi ; inline From 2b458476493495eaed21fe4a99d47ef0c7c1ce05 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 17 Mar 2009 16:18:56 -0500 Subject: [PATCH 3/3] linear algebra fail --- .../affine-transforms-tests.factor | 6 ++++++ .../affine-transforms.factor | 20 +++++++++---------- extra/svg/svg-tests.factor | 17 ++++++++++------ 3 files changed, 27 insertions(+), 16 deletions(-) diff --git a/extra/math/affine-transforms/affine-transforms-tests.factor b/extra/math/affine-transforms/affine-transforms-tests.factor index 1d10e07cea..cdbd5eef39 100644 --- a/extra/math/affine-transforms/affine-transforms-tests.factor +++ b/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 } 1array [ + { 1.0 0.0 } { 0.0 -1.0 } { 0.0 0.0 } + { 2.0 1.0 } { -1.0 2.0 } { 5.0 6.0 } + a. +] unit-test + [ t ] [ { 0.01 0.02 } { 0.03 0.04 } { 0.05 0.06 } { 0.011 0.021 } { 0.031 0.041 } { 0.051 0.061 } 0.01 a~ diff --git a/extra/math/affine-transforms/affine-transforms.factor b/extra/math/affine-transforms/affine-transforms.factor index 132082fdba..20b73ba678 100644 --- a/extra/math/affine-transforms/affine-transforms.factor +++ b/extra/math/affine-transforms/affine-transforms.factor @@ -3,13 +3,13 @@ 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 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 ; + [ x>> ] [ y>> ] bi { 0.0 0.0 } ; : a.v ( a v -- v ) [ [ x>> ] [ first ] bi* v*n ] @@ -26,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 } ; : center-rotation ( transform center -- transform ) - [ clone dup ] dip [ vneg a.v ] [ v+ ] bi >>origin ; + [ [ x>> ] [ y>> ] [ ] tri ] dip [ vneg a.v ] [ v+ ] bi ; : flatten-transform ( transform -- array ) [ x>> ] [ y>> ] [ origin>> ] tri 3append ; @@ -45,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 } ; : inverse-transform ( a -- a^-1 ) - [ inverse-axes dup ] [ origin>> ] bi - a.v vneg >>origin ; + [ inverse-axes [ x>> ] [ y>> ] [ ] tri ] [ origin>> ] bi + a.v vneg ; : transpose-axes ( a -- a^T ) [ [ x>> first ] [ y>> first ] bi 2array ] @@ -54,11 +54,11 @@ CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0 [ origin>> ] tri ; : 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 ; diff --git a/extra/svg/svg-tests.factor b/extra/svg/svg-tests.factor index 0f0c349b8e..932904eff4 100644 --- a/extra/svg/svg-tests.factor +++ b/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 } 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 } 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 } 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 } 1array [ +[ t ] [ "skewX(45)" svg-transform>affine-transform + { 1.0 0.0 } { 1.0 1.0 } { 0.0 0.0 } 0.001 a~ ] unit-test -{ 1.0 $[ -45 degrees tan ] } { 0.0 1.0 } { 0.0 0.0 } 1array [ +[ t ] [ "skewY(-4.5e1)" svg-transform>affine-transform + { 1.0 -1.0 } { 0.0 1.0 } { 0.0 0.0 } 0.001 a~ ] unit-test -{ $[ 30 degrees cos ] $[ 30 degrees sin ] } -{ $[ -30 degrees sin ] $[ 30 degrees cos ] } { 0.0 0.0 } 1array [ +[ t ] [ "rotate(30)" svg-transform>affine-transform + { $[ 0.75 sqrt ] 0.5 } + { -0.5 $[ 0.75 sqrt ] } + { 0.0 0.0 } + 0.001 a~ ] unit-test [ t ] [