1 ! (c)2009 Joe Groff, see BSD license
2 USING: accessors arrays combinators combinators.short-circuit kernel math math.vectors
3 math.functions sequences ;
4 IN: math.affine-transforms
6 TUPLE: affine-transform { x read-only } { y read-only } { origin read-only } ;
7 C: <affine-transform> affine-transform
9 CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0 0.0 } }
12 [ x>> ] [ y>> ] bi { 0.0 0.0 } <affine-transform> ;
15 [ [ x>> ] [ first ] bi* v*n ]
16 [ [ y>> ] [ second ] bi* v*n ]
17 [ drop origin>> ] 2tri
21 { 1.0 0.0 } { 0.0 1.0 } { 0.0 0.0 } <affine-transform> ;
22 : <translation> ( origin -- a )
23 [ { 1.0 0.0 } { 0.0 1.0 } ] dip <affine-transform> ;
24 : <rotation> ( theta -- transform )
26 [ 2array ] [ neg swap 2array ] 2bi { 0.0 0.0 } <affine-transform> ;
27 : <scale> ( x y -- transform )
28 [ 0.0 2array ] [ 0.0 swap 2array ] bi* { 0.0 0.0 } <affine-transform> ;
30 : center-rotation ( transform center -- transform )
31 [ [ x>> ] [ y>> ] [ ] tri ] dip [ vneg a.v ] [ v+ ] bi <affine-transform> ;
33 : flatten-transform ( transform -- array )
34 [ x>> ] [ y>> ] [ origin>> ] tri 3append ;
37 [ [ x>> first ] [ y>> second ] bi * ]
38 [ [ x>> second ] [ y>> first ] bi * ] bi - ;
40 : (inverted-axes) ( a -- x y )
41 [ [ y>> second ] [ x>> second neg ] bi 2array ]
42 [ [ y>> first neg ] [ x>> first ] bi 2array ]
46 : inverse-axes ( a -- a^-1 )
47 (inverted-axes) { 0.0 0.0 } <affine-transform> ;
49 : inverse-transform ( a -- a^-1 )
50 [ inverse-axes [ x>> ] [ y>> ] [ ] tri ] [ origin>> ] bi
51 a.v vneg <affine-transform> ;
53 : transpose-axes ( a -- a^T )
54 [ [ x>> first ] [ y>> first ] bi 2array ]
55 [ [ x>> second ] [ y>> second ] bi 2array ]
56 [ origin>> ] tri <affine-transform> ;
60 [ [ transpose-axes x>> ] [ x>> ] bi* v. ]
61 [ [ transpose-axes y>> ] [ x>> ] bi* v. ]
62 [ [ transpose-axes x>> ] [ y>> ] bi* v. ]
63 [ [ transpose-axes y>> ] [ y>> ] bi* v. ]
66 [ [ 2array ] 2bi@ ] dip <affine-transform> ;
68 : a~ ( a b epsilon -- ? )
70 [ [ [ x>> ] bi@ ] dip v~ ]
71 [ [ [ y>> ] bi@ ] dip v~ ]
72 [ [ [ origin>> ] bi@ ] dip v~ ]