1 ! (c)2009 Joe Groff, see BSD license
2 USING: accessors arrays assocs fry kernel math math.affine-transforms math.constants
3 math.functions math.parser math.vectors memoize peg.ebnf sequences sequences.squish
4 splitting strings xml.data xml.utilities ;
7 XML-NS: svg-name http://www.w3.org/2000/svg
8 XML-NS: xlink-name http://www.w3.org/1999/xlink
9 XML-NS: sodipodi-name http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd
10 XML-NS: inkscape-name http://www.inkscape.org/namespaces/inkscape
12 : svg-string>number ( string -- number )
13 { { CHAR: E CHAR: e } } substitute "e" split1
14 [ string>number ] [ [ string>number 10 swap ^ ] [ 1 ] if* ] bi* *
17 : degrees ( deg -- rad ) pi * 180.0 / ;
19 EBNF: svg-transform>affine-transform
22 transform:m comma-wsp+ transforms:n => [[ m n a. ]]
32 "matrix" wsp* "(" wsp*
39 => [[ { xx xy } { yx yy } { ox oy } <affine-transform> ]]
41 "translate" wsp* "(" wsp* number:tx ( comma-wsp number:ty => [[ ty ]] )?:ty wsp* ")"
42 => [[ tx ty 0.0 or 2array <translation> ]]
44 "scale" wsp* "(" wsp* number:sx ( comma-wsp number:sy => [[ sy ]] )?:sy wsp* ")"
45 => [[ sx sy sx or <scale> ]]
47 "rotate" wsp* "(" wsp* number:a ( comma-wsp number:cx comma-wsp number:cy => [[ cx cy 2array ]])?:c wsp* ")"
48 => [[ a degrees <rotation> c [ center-rotation ] when* ]]
50 "skewX" wsp* "(" wsp* number:a wsp* ")"
51 => [[ { 1.0 0.0 } a degrees tan 1.0 2array { 0.0 0.0 } <affine-transform> ]]
53 "skewY" wsp* "(" wsp* number:a wsp* ")"
54 => [[ 1.0 a degrees tan 2array { 0.0 1.0 } { 0.0 0.0 } <affine-transform> ]]
56 sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
58 (wsp+ comma? wsp*) | (comma wsp*)
63 floating-point-constant =
64 fractional-constant exponent?
65 | digit-sequence exponent
67 digit-sequence? "." digit-sequence
70 ( "e" | "E" ) sign? digit-sequence
73 digit-sequence = [0-9]+ => [[ >string ]]
74 wsp = (" " | "\t" | "\r" | "\n")
76 transform-list = wsp* transforms?:t wsp*
77 => [[ t [ identity-transform ] unless* ]]
81 : tag-transform ( tag -- transform )
82 "transform" svg-name attr svg-transform>affine-transform ;
84 TUPLE: moveto p relative? ;
86 TUPLE: lineto p relative? ;
87 TUPLE: horizontal-lineto x relative? ;
88 TUPLE: vertical-lineto y relative? ;
89 TUPLE: curveto p1 p2 p relative? ;
90 TUPLE: smooth-curveto p2 p relative? ;
91 TUPLE: quadratic-bezier-curveto p1 p relative? ;
92 TUPLE: smooth-quadratic-bezier-curveto p relative? ;
93 TUPLE: elliptical-arc radii x-axis-rotation large-arc? sweep? p relative? ;
95 : (set-relative) ( args rel -- args )
96 '[ [ _ >>relative? drop ] each ] keep ;
100 moveto-drawto-command-groups =
101 moveto-drawto-command-group:first wsp* moveto-drawto-command-groups:rest
102 => [[ first rest append ]]
103 | moveto-drawto-command-group
104 moveto-drawto-command-group =
105 moveto:m wsp* drawto-commands?:d => [[ m d append ]]
107 drawto-command:first wsp* drawto-commands:rest => [[ first rest append ]]
116 | quadratic-bezier-curveto
117 | smooth-quadratic-bezier-curveto
120 ("M" => [[ f ]] | "m" => [[ t ]]):rel wsp* moveto-argument-sequence:args
121 => [[ args rel (set-relative) ]]
122 moveto-argument = coordinate-pair => [[ f moveto boa ]]
123 moveto-argument-sequence =
124 moveto-argument:first comma-wsp? lineto-argument-sequence:rest
125 => [[ rest first prefix ]]
126 | moveto-argument => [[ 1array ]]
128 ("Z" | "z") => [[ drop closepath boa 1array ]]
130 ("L" => [[ f ]] | "l" => [[ t ]]):rel wsp* lineto-argument-sequence:args
131 => [[ args rel (set-relative) ]]
132 lineto-argument = coordinate-pair => [[ f lineto boa ]]
133 lineto-argument-sequence =
134 lineto-argument:first comma-wsp? lineto-argument-sequence:rest
135 => [[ rest first prefix ]]
136 | lineto-argument => [[ 1array ]]
138 ( "H" => [[ f ]] | "h" => [[ t ]]):rel wsp* horizontal-lineto-argument-sequence:args
139 => [[ args rel (set-relative) ]]
140 horizontal-lineto-argument = coordinate => [[ f horizontal-lineto boa ]]
141 horizontal-lineto-argument-sequence =
142 horizontal-lineto-argument:first comma-wsp? horizontal-lineto-argument-sequence:rest
143 => [[ rest first prefix ]]
144 | horizontal-lineto-argument => [[ 1array ]]
146 ( "V" => [[ f ]] | "v" => [[ t ]]):rel wsp* vertical-lineto-argument-sequence:args
147 => [[ args rel (set-relative) ]]
148 vertical-lineto-argument = coordinate => [[ f vertical-lineto boa ]]
149 vertical-lineto-argument-sequence =
150 vertical-lineto-argument:first comma-wsp? vertical-lineto-argument-sequence:rest
151 => [[ rest first prefix ]]
152 | vertical-lineto-argument => [[ 1array ]]
154 ( "C" => [[ f ]] | "c" => [[ t ]]):rel wsp* curveto-argument-sequence:args
155 => [[ args rel (set-relative) ]]
156 curveto-argument-sequence =
157 curveto-argument:first comma-wsp? curveto-argument-sequence:rest
158 => [[ rest first prefix ]]
159 | curveto-argument => [[ 1array ]]
161 coordinate-pair:pone comma-wsp? coordinate-pair:ptwo comma-wsp? coordinate-pair:p
162 => [[ pone ptwo p f curveto boa ]]
164 ( "S" => [[ f ]] | "s" => [[ t ]] ):rel wsp* smooth-curveto-argument-sequence:args
165 => [[ args rel (set-relative) ]]
166 smooth-curveto-argument-sequence =
167 smooth-curveto-argument:first comma-wsp? smooth-curveto-argument-sequence:rest
168 => [[ rest first prefix ]]
169 | smooth-curveto-argument => [[ 1array ]]
170 smooth-curveto-argument =
171 coordinate-pair:ptwo comma-wsp? coordinate-pair:p
172 => [[ ptwo p f smooth-curveto boa ]]
173 quadratic-bezier-curveto =
174 ( "Q" => [[ f ]] | "q" => [[ t ]] ):rel wsp* quadratic-bezier-curveto-argument-sequence:args
175 => [[ args rel (set-relative) ]]
176 quadratic-bezier-curveto-argument-sequence =
177 quadratic-bezier-curveto-argument:first comma-wsp?
178 quadratic-bezier-curveto-argument-sequence:rest
179 => [[ rest first prefix ]]
180 | quadratic-bezier-curveto-argument => [[ 1array ]]
181 quadratic-bezier-curveto-argument =
182 coordinate-pair:pone comma-wsp? coordinate-pair:p
183 => [[ pone p f quadratic-bezier-curveto boa ]]
184 smooth-quadratic-bezier-curveto =
185 ( "T" => [[ f ]] | "t" => [[ t ]] ):rel wsp* smooth-quadratic-bezier-curveto-argument-sequence:args
186 => [[ args rel (set-relative) ]]
187 smooth-quadratic-bezier-curveto-argument-sequence =
188 smooth-quadratic-bezier-curveto-argument:first comma-wsp? smooth-quadratic-bezier-curveto-argument-sequence:rest
189 => [[ rest first prefix ]]
190 | smooth-quadratic-bezier-curveto-argument => [[ 1array ]]
191 smooth-quadratic-bezier-curveto-argument = coordinate-pair => [[ f smooth-quadratic-bezier-curveto boa ]]
193 ( "A" => [[ f ]] | "a" => [[ t ]] ):rel wsp* elliptical-arc-argument-sequence:args
194 => [[ args rel (set-relative) ]]
195 elliptical-arc-argument-sequence =
196 elliptical-arc-argument:first comma-wsp? elliptical-arc-argument-sequence:rest
197 => [[ rest first prefix ]]
198 | elliptical-arc-argument => [[ 1array ]]
199 elliptical-arc-argument =
200 nonnegative-number:radiix comma-wsp? nonnegative-number:radiiy comma-wsp?
201 number:xrot comma-wsp flag:large comma-wsp flag:sweep
202 comma-wsp coordinate-pair:p
203 => [[ radiix radiiy 2array xrot large sweep p f elliptical-arc boa ]]
204 coordinate-pair = coordinate:x comma-wsp? coordinate:y => [[ x y 2array ]]
206 nonnegative-number = (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
207 number = sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
208 flag = "0" => [[ f ]] | "1" => [[ t ]]
209 comma-wsp = (wsp+ comma? wsp*) | (comma wsp*)
211 integer-constant = digit-sequence
212 floating-point-constant = fractional-constant exponent? | digit-sequence exponent
213 fractional-constant = digit-sequence? "." digit-sequence | digit-sequence "."
214 exponent = ( "e" | "E" ) sign? digit-sequence
215 sign = "+" => [[ drop f ]] | "-"
216 digit-sequence = [0-9]+ => [[ >string ]]
217 wsp = (" " | "\t" | "\r" | "\n")
219 svg-path = wsp* moveto-drawto-command-groups?:x wsp* => [[ x ]]
224 "d" svg-name attr svg-path>array ;