math.affine-transforms, sequences.squish, and svg vocabs

db4
Joe Groff 2009-01-30 09:39:15 -06:00
parent a3ee1d9488
commit aad17e43ef
5 changed files with 448 additions and 0 deletions

View File

@ -0,0 +1,48 @@
USING: arrays kernel literals tools.test math math.affine-transforms
math.constants math.functions ;
IN: math.affine-transforms.tests
[ { 7.25 4.25 } ] [
{ 0.75 0.75 } { 0.75 -0.75 } { 5.0 5.0 } <affine-transform>
{ 1.0 2.0 } a.v
] unit-test
[ -1.125 ] [
{ 0.75 0.75 } { 0.75 -0.75 } { 5.0 5.0 } <affine-transform>
|a|
] unit-test
{ 1.0 3.0 } { 2.0 4.0 } { 5.0 6.0 } <affine-transform> 1array [
{ 1.0 2.0 } { 3.0 4.0 } { 5.0 6.0 } <affine-transform>
transpose-axes
] unit-test
{ 1.0 -1.0 } { 1.0 1.0 } { 0.0 0.0 } <affine-transform> 1array [
{ 0.5 0.5 } { -0.5 0.5 } { 5.0 5.0 } <affine-transform>
inverse-axes
] unit-test
{ 1.0 -1.0 } { 1.0 1.0 } { -10.0 0.0 } <affine-transform> 1array [
{ 0.5 0.5 } { -0.5 0.5 } { 5.0 5.0 } <affine-transform>
inverse-transform
] unit-test
{ 1.0 0.0 } { 0.0 1.0 } { 0.0 0.0 } <affine-transform> 1array [
{ 0.5 0.5 } { -0.5 0.5 } { 5.0 5.0 } <affine-transform>
dup inverse-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~
] unit-test
{ 1.0 0.0 } { 0.0 1.0 } { 5.0 10.0 } <affine-transform> 1array [
{ 5.0 10.0 } <translation>
] unit-test
{ $[ pi 0.25 * cos ] $[ pi 0.25 * sin ] }
{ $[ pi -0.25 * sin ] $[ pi 0.25 * cos ] }
{ 0.0 0.0 } <affine-transform> 1array [
pi 0.25 * <rotation>
] unit-test

View File

@ -0,0 +1,70 @@
USING: accessors arrays combinators combinators.short-circuit kernel math math.vectors
math.functions sequences ;
IN: math.affine-transforms
TUPLE: affine-transform x y origin ;
C: <affine-transform> affine-transform
CONSTANT: identity-transform T{ affine-transform f { 1.0 0.0 } { 0.0 1.0 } { 0.0 0.0 } }
: a.v ( a v -- v )
[ [ x>> ] [ first ] bi* v*n ]
[ [ y>> ] [ second ] bi* v*n ]
[ drop origin>> ] 2tri
v+ v+ ;
: <translation> ( origin -- a )
[ { 1.0 0.0 } { 0.0 1.0 } ] dip <affine-transform> ;
: <rotation> ( theta -- transform )
[ cos ] [ sin ] bi
[ 2array ] [ neg swap 2array ] 2bi { 0.0 0.0 } <affine-transform> ;
: <scale> ( x y -- transform )
[ 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 ;
: flatten-transform ( transform -- array )
[ x>> ] [ y>> ] [ origin>> ] tri 3append ;
: |a| ( a -- det )
[ [ x>> first ] [ y>> second ] bi * ]
[ [ x>> second ] [ y>> first ] bi * ] bi - ;
: (inverted-axes) ( a -- x y )
[ [ y>> second ] [ x>> second neg ] bi 2array ]
[ [ y>> first neg ] [ x>> first ] bi 2array ]
[ |a| ] tri
tuck [ v/n ] 2bi@ ;
: inverse-axes ( a -- a^-1 )
(inverted-axes) { 0.0 0.0 } <affine-transform> ;
: inverse-transform ( a -- a^-1 )
[ inverse-axes dup ] [ origin>> ] bi
a.v vneg >>origin ;
: transpose-axes ( a -- a^T )
[ [ x>> first ] [ y>> first ] bi 2array ]
[ [ x>> second ] [ y>> second ] bi 2array ]
[ 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. ]
[ origin>> a.v ]
} 2cleave
[ [ 2array ] 2bi@ ] dip <affine-transform> ;
: v~ ( a b epsilon -- ? )
[ ~ ] curry 2all? ;
: a~ ( a b epsilon -- ? )
{
[ [ [ x>> ] bi@ ] dip v~ ]
[ [ [ y>> ] bi@ ] dip v~ ]
[ [ [ origin>> ] bi@ ] dip v~ ]
} 3&& ;

View File

@ -0,0 +1,12 @@
USING: combinators.short-circuit fry make math kernel sequences ;
IN: sequences.squish
: (squish) ( seq quot: ( obj -- ? ) -- )
2dup call [ '[ _ (squish) ] each ] [ drop , ] if ; inline recursive
: squish ( seq quot exemplar -- seq' )
[ [ (squish) ] ] dip make ; inline
: squish-strings ( seq -- seq' )
[ { [ sequence? ] [ integer? not ] } 1&& ] "" squish ;

View File

@ -0,0 +1,95 @@
USING: arrays literals math math.affine-transforms math.functions multiline
svg tools.test ;
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
] unit-test
{ 1.0 0.0 } { 0.0 1.0 } { 5.0 10.0 } <affine-transform> 1array [
"translate(5.0, 1e1 )" svg-transform>affine-transform
] unit-test
{ 1.0 0.0 } { 0.0 1.0 } { 5.0 10.0 } <affine-transform> 1array [
"translate( 5.0 1e+1)" svg-transform>affine-transform
] unit-test
{ 2.0 0.0 } { 0.0 2.0 } { 0.0 0.0 } <affine-transform> 1array [
"scale(2.0)" svg-transform>affine-transform
] unit-test
{ 2.0 0.0 } { 0.0 4.0 } { 0.0 0.0 } <affine-transform> 1array [
"scale(2.0 4.0)" svg-transform>affine-transform
] unit-test
{ 2.0 0.0 } { 0.0 4.0 } { 0.0 0.0 } <affine-transform> 1array [
"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 [
"skewX(45)" svg-transform>affine-transform
] unit-test
{ 1.0 $[ -45 degrees tan ] } { 0.0 1.0 } { 0.0 0.0 } <affine-transform> 1array [
"skewY(-4.5e1)" svg-transform>affine-transform
] unit-test
{ $[ 30 degrees cos ] $[ 30 degrees sin ] }
{ $[ -30 degrees sin ] $[ 30 degrees cos ] } { 0.0 0.0 } <affine-transform> 1array [
"rotate(30)" svg-transform>affine-transform
] unit-test
[ t ] [
"rotate(30 1.0,2.0)" svg-transform>affine-transform
{ $[ 30 degrees cos ] $[ 30 degrees sin ] }
{ $[ -30 degrees sin ] $[ 30 degrees cos ] } {
$[ 1.0 30 degrees cos 1.0 * - 30 degrees sin 2.0 * + ]
$[ 2.0 30 degrees cos 2.0 * - 30 degrees sin 1.0 * - ]
} <affine-transform> 0.001 a~
] unit-test
{ $[ 30 degrees cos ] $[ 30 degrees sin ] }
{ $[ -30 degrees sin ] $[ 30 degrees cos ] }
{ 1.0 2.0 } <affine-transform> 1array [
"translate(1 2) rotate(30)" svg-transform>affine-transform
] unit-test
[ {
T{ moveto f { 1.0 1.0 } f }
T{ lineto f { 3.0 -1.0 } f }
T{ lineto f { 2.0 2.0 } t }
T{ lineto f { 2.0 -2.0 } t }
T{ lineto f { 2.0 2.0 } t }
T{ vertical-lineto f -9.0 t }
T{ vertical-lineto f 1.0 t }
T{ horizontal-lineto f 9.0 f }
T{ horizontal-lineto f 8.0 f }
T{ closepath }
T{ moveto f { 0.0 0.0 } f }
T{ curveto f { -4.0 0.0 } { -8.0 4.0 } { -8.0 8.0 } f }
T{ curveto f { -8.0 4.0 } { -12.0 8.0 } { -16.0 8.0 } f }
T{ smooth-curveto f { 0.0 2.0 } { 2.0 0.0 } t }
T{ quadratic-bezier-curveto f { -2.0 0.0 } { 0.0 -2.0 } f }
T{ quadratic-bezier-curveto f { -3.0 0.0 } { 0.0 3.0 } f }
T{ smooth-quadratic-bezier-curveto f { 1.0 2.0 } t }
T{ smooth-quadratic-bezier-curveto f { 3.0 4.0 } t }
T{ elliptical-arc f { 5.0 6.0 } 7.0 t f { 8.0 9.0 } f }
} ] [
<"
M 1.0,+1 3,-10e-1 l 2 2, 2 -2, 2 2 v -9 1 H 9 8 z
M 0 0 C -4.0 0.0 -8.0 4.0 -8.0 8.0 -8.0 4.0 -12.0 8.0 -16.0 8.0
s 0.0,2.0 2.0,0.0
Q -2 0 0 -2 -3. 0 0 3
t 1 2 3 4
A 5 6 7 1 0 8 9
"> svg-path>array
] unit-test

223
extra/svg/svg.factor Normal file
View File

@ -0,0 +1,223 @@
USING: accessors arrays assocs fry kernel math math.affine-transforms math.constants
math.functions math.parser math.vectors memoize peg.ebnf sequences sequences.squish
splitting strings xml.data xml.utilities ;
IN: svg
XML-NS: svg-name http://www.w3.org/2000/svg
XML-NS: xlink-name http://www.w3.org/1999/xlink
XML-NS: sodipodi-name http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd
XML-NS: inkscape-name http://www.inkscape.org/namespaces/inkscape
: svg-string>number ( string -- number )
{ { CHAR: E CHAR: e } } substitute "e" split1
[ string>number ] [ [ string>number 10 swap ^ ] [ 1 ] if* ] bi* *
>float ;
: degrees ( deg -- rad ) pi * 180.0 / ;
EBNF: svg-transform>affine-transform
transforms =
transform:m comma-wsp+ transforms:n => [[ m n a. ]]
| transform
transform =
matrix
| translate
| scale
| rotate
| skewX
| skewY
matrix =
"matrix" wsp* "(" wsp*
number:xx comma-wsp
number:xy comma-wsp
number:yx comma-wsp
number:yy comma-wsp
number:ox comma-wsp
number:oy wsp* ")"
=> [[ { xx xy } { yx yy } { ox oy } <affine-transform> ]]
translate =
"translate" wsp* "(" wsp* number:tx ( comma-wsp number:ty => [[ ty ]] )?:ty wsp* ")"
=> [[ tx ty 0.0 or 2array <translation> ]]
scale =
"scale" wsp* "(" wsp* number:sx ( comma-wsp number:sy => [[ sy ]] )?:sy wsp* ")"
=> [[ sx sy sx or <scale> ]]
rotate =
"rotate" wsp* "(" wsp* number:a ( comma-wsp number:cx comma-wsp number:cy => [[ cx cy 2array ]])?:c wsp* ")"
=> [[ a degrees <rotation> c [ center-rotation ] when* ]]
skewX =
"skewX" wsp* "(" wsp* number:a wsp* ")"
=> [[ { 1.0 0.0 } a degrees tan 1.0 2array { 0.0 0.0 } <affine-transform> ]]
skewY =
"skewY" wsp* "(" wsp* number:a wsp* ")"
=> [[ 1.0 a degrees tan 2array { 0.0 1.0 } { 0.0 0.0 } <affine-transform> ]]
number =
sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
comma-wsp =
(wsp+ comma? wsp*) | (comma wsp*)
comma =
","
integer-constant =
digit-sequence
floating-point-constant =
fractional-constant exponent?
| digit-sequence exponent
fractional-constant =
digit-sequence? "." digit-sequence
| digit-sequence "."
exponent =
( "e" | "E" ) sign? digit-sequence
sign =
"+" => [[ f ]] | "-"
digit-sequence = [0-9]+ => [[ >string ]]
wsp = (" " | "\t" | "\r" | "\n")
transform-list = wsp* transforms?:t wsp*
=> [[ t [ identity-transform ] unless* ]]
;EBNF
: tag-transform ( tag -- transform )
"transform" svg-name swap at svg-transform>affine-transform ;
TUPLE: moveto p relative? ;
TUPLE: closepath ;
TUPLE: lineto p relative? ;
TUPLE: horizontal-lineto x relative? ;
TUPLE: vertical-lineto y relative? ;
TUPLE: curveto p1 p2 p relative? ;
TUPLE: smooth-curveto p2 p relative? ;
TUPLE: quadratic-bezier-curveto p1 p relative? ;
TUPLE: smooth-quadratic-bezier-curveto p relative? ;
TUPLE: elliptical-arc radii x-axis-rotation large-arc? sweep? p relative? ;
: (set-relative) ( args rel -- args )
'[ [ _ >>relative? drop ] each ] keep ;
EBNF: svg-path>array
moveto-drawto-command-groups =
moveto-drawto-command-group:first wsp* moveto-drawto-command-groups:rest
=> [[ first rest append ]]
| moveto-drawto-command-group
moveto-drawto-command-group =
moveto:m wsp* drawto-commands?:d => [[ m d append ]]
drawto-commands =
drawto-command:first wsp* drawto-commands:rest => [[ first rest append ]]
| drawto-command
drawto-command =
closepath
| lineto
| horizontal-lineto
| vertical-lineto
| curveto
| smooth-curveto
| quadratic-bezier-curveto
| smooth-quadratic-bezier-curveto
| elliptical-arc
moveto =
("M" => [[ f ]] | "m" => [[ t ]]):rel wsp* moveto-argument-sequence:args
=> [[ args rel (set-relative) ]]
moveto-argument = coordinate-pair => [[ f moveto boa ]]
moveto-argument-sequence =
moveto-argument:first comma-wsp? lineto-argument-sequence:rest
=> [[ rest first prefix ]]
| moveto-argument => [[ 1array ]]
closepath =
("Z" | "z") => [[ drop closepath boa 1array ]]
lineto =
("L" => [[ f ]] | "l" => [[ t ]]):rel wsp* lineto-argument-sequence:args
=> [[ args rel (set-relative) ]]
lineto-argument = coordinate-pair => [[ f lineto boa ]]
lineto-argument-sequence =
lineto-argument:first comma-wsp? lineto-argument-sequence:rest
=> [[ rest first prefix ]]
| lineto-argument => [[ 1array ]]
horizontal-lineto =
( "H" => [[ f ]] | "h" => [[ t ]]):rel wsp* horizontal-lineto-argument-sequence:args
=> [[ args rel (set-relative) ]]
horizontal-lineto-argument = coordinate => [[ f horizontal-lineto boa ]]
horizontal-lineto-argument-sequence =
horizontal-lineto-argument:first comma-wsp? horizontal-lineto-argument-sequence:rest
=> [[ rest first prefix ]]
| horizontal-lineto-argument => [[ 1array ]]
vertical-lineto =
( "V" => [[ f ]] | "v" => [[ t ]]):rel wsp* vertical-lineto-argument-sequence:args
=> [[ args rel (set-relative) ]]
vertical-lineto-argument = coordinate => [[ f vertical-lineto boa ]]
vertical-lineto-argument-sequence =
vertical-lineto-argument:first comma-wsp? vertical-lineto-argument-sequence:rest
=> [[ rest first prefix ]]
| vertical-lineto-argument => [[ 1array ]]
curveto =
( "C" => [[ f ]] | "c" => [[ t ]]):rel wsp* curveto-argument-sequence:args
=> [[ args rel (set-relative) ]]
curveto-argument-sequence =
curveto-argument:first comma-wsp? curveto-argument-sequence:rest
=> [[ rest first prefix ]]
| curveto-argument => [[ 1array ]]
curveto-argument =
coordinate-pair:pone comma-wsp? coordinate-pair:ptwo comma-wsp? coordinate-pair:p
=> [[ pone ptwo p f curveto boa ]]
smooth-curveto =
( "S" => [[ f ]] | "s" => [[ t ]] ):rel wsp* smooth-curveto-argument-sequence:args
=> [[ args rel (set-relative) ]]
smooth-curveto-argument-sequence =
smooth-curveto-argument:first comma-wsp? smooth-curveto-argument-sequence:rest
=> [[ rest first prefix ]]
| smooth-curveto-argument => [[ 1array ]]
smooth-curveto-argument =
coordinate-pair:ptwo comma-wsp? coordinate-pair:p
=> [[ ptwo p f smooth-curveto boa ]]
quadratic-bezier-curveto =
( "Q" => [[ f ]] | "q" => [[ t ]] ):rel wsp* quadratic-bezier-curveto-argument-sequence:args
=> [[ args rel (set-relative) ]]
quadratic-bezier-curveto-argument-sequence =
quadratic-bezier-curveto-argument:first comma-wsp?
quadratic-bezier-curveto-argument-sequence:rest
=> [[ rest first prefix ]]
| quadratic-bezier-curveto-argument => [[ 1array ]]
quadratic-bezier-curveto-argument =
coordinate-pair:pone comma-wsp? coordinate-pair:p
=> [[ pone p f quadratic-bezier-curveto boa ]]
smooth-quadratic-bezier-curveto =
( "T" => [[ f ]] | "t" => [[ t ]] ):rel wsp* smooth-quadratic-bezier-curveto-argument-sequence:args
=> [[ args rel (set-relative) ]]
smooth-quadratic-bezier-curveto-argument-sequence =
smooth-quadratic-bezier-curveto-argument:first comma-wsp? smooth-quadratic-bezier-curveto-argument-sequence:rest
=> [[ rest first prefix ]]
| smooth-quadratic-bezier-curveto-argument => [[ 1array ]]
smooth-quadratic-bezier-curveto-argument = coordinate-pair => [[ f smooth-quadratic-bezier-curveto boa ]]
elliptical-arc =
( "A" => [[ f ]] | "a" => [[ t ]] ):rel wsp* elliptical-arc-argument-sequence:args
=> [[ args rel (set-relative) ]]
elliptical-arc-argument-sequence =
elliptical-arc-argument:first comma-wsp? elliptical-arc-argument-sequence:rest
=> [[ rest first prefix ]]
| elliptical-arc-argument => [[ 1array ]]
elliptical-arc-argument =
nonnegative-number:radiix comma-wsp? nonnegative-number:radiiy comma-wsp?
number:xrot comma-wsp flag:large comma-wsp flag:sweep
comma-wsp coordinate-pair:p
=> [[ radiix radiiy 2array xrot large sweep p f elliptical-arc boa ]]
coordinate-pair = coordinate:x comma-wsp? coordinate:y => [[ x y 2array ]]
coordinate = number
nonnegative-number = (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
number = sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
flag = "0" => [[ f ]] | "1" => [[ t ]]
comma-wsp = (wsp+ comma? wsp*) | (comma wsp*)
comma = ","
integer-constant = digit-sequence
floating-point-constant = fractional-constant exponent? | digit-sequence exponent
fractional-constant = digit-sequence? "." digit-sequence | digit-sequence "."
exponent = ( "e" | "E" ) sign? digit-sequence
sign = "+" => [[ drop f ]] | "-"
digit-sequence = [0-9]+ => [[ >string ]]
wsp = (" " | "\t" | "\r" | "\n")
svg-path = wsp* moveto-drawto-command-groups?:x wsp* => [[ x ]]
;EBNF
: tag-d ( tag -- d )
"d" svg-name swap at svg-path>array ;