extra/svg/svg.factor

   1 ! (c)2009 Joe Groff, see BSD license
   2
   3 USING: accessors arrays assocs kernel math
   4 math.affine-transforms math.functions math.parser math.trig
   5 peg.ebnf sequences sequences.squish splitting strings xml.data
   6 xml.syntax multiline ;
   7
   8 IN: svg
   9
  10 XML-NS: svg-name http://www.w3.org/2000/svg
  11 XML-NS: xlink-name http://www.w3.org/1999/xlink
  12 XML-NS: sodipodi-name http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd
  13 XML-NS: inkscape-name http://www.inkscape.org/namespaces/inkscape
  14
  15 : svg-string>number ( string -- number )
  16     H{ { CHAR: E CHAR: e } } substitute "e" split1
  17     [ string>number ] [ [ string>number 10^ ] [ 1 ] if* ] bi* *
  18     >float ;
  19
  20 EBNF: svg-transform>affine-transform [=[
  21
  22 transforms =
  23     transform:m comma-wsp+ transforms:n => [[ m n a. ]]
  24     | transform
  25 transform =
  26     matrix
  27     | translate
  28     | scale
  29     | rotate
  30     | skewX
  31     | skewY
  32 matrix =
  33     "matrix" wsp* "(" wsp*
  34        number:xx comma-wsp
  35        number:xy comma-wsp
  36        number:yx comma-wsp
  37        number:yy comma-wsp
  38        number:ox comma-wsp
  39        number:oy wsp* ")"
  40         => [[ { xx xy } { yx yy } { ox oy } <affine-transform> ]]
  41 translate =
  42     "translate" wsp* "(" wsp* number:tx ( comma-wsp number:ty => [[ ty ]] )?:ty wsp* ")"
  43         => [[ tx ty 0.0 or 2array <translation> ]]
  44 scale =
  45     "scale" wsp* "(" wsp* number:sx ( comma-wsp number:sy => [[ sy ]] )?:sy wsp* ")"
  46         => [[ sx sy sx or <scale> ]]
  47 rotate =
  48     "rotate" wsp* "(" wsp* number:a ( comma-wsp number:cx comma-wsp number:cy => [[ cx cy 2array ]])?:c wsp* ")"
  49         => [[ a deg>rad <rotation> c [ center-rotation ] when* ]]
  50 skewX =
  51     "skewX" wsp* "(" wsp* number:a wsp* ")"
  52         => [[ { 1.0 0.0 } a deg>rad tan 1.0 2array { 0.0 0.0 } <affine-transform> ]]
  53 skewY =
  54     "skewY" wsp* "(" wsp* number:a wsp* ")"
  55         => [[ 1.0 a deg>rad tan 2array { 0.0 1.0 } { 0.0 0.0 } <affine-transform> ]]
  56 number =
  57     sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
  58 comma-wsp =
  59     (wsp+ comma? wsp*) | (comma wsp*)
  60 comma =
  61     ","
  62 integer-constant =
  63     digit-sequence
  64 floating-point-constant =
  65     fractional-constant exponent?
  66     | digit-sequence exponent
  67 fractional-constant =
  68     digit-sequence? "." digit-sequence
  69     | digit-sequence "."
  70 exponent =
  71     ( "e" | "E" ) sign? digit-sequence
  72 sign =
  73     "+" => [[ f ]] | "-"
  74 digit-sequence = [0-9]+ => [[ >string ]]
  75 wsp = [ \t\r\n]
  76
  77 transform-list = wsp* transforms?:t wsp*
  78     => [[ t [ identity-transform ] unless* ]]
  79
  80 ]=]
  81
  82 : tag-transform ( tag -- transform )
  83     "transform" svg-name attr svg-transform>affine-transform ;
  84
  85 TUPLE: moveto p relative? ;
  86 TUPLE: closepath ;
  87 TUPLE: lineto p relative? ;
  88 TUPLE: horizontal-lineto x relative? ;
  89 TUPLE: vertical-lineto y relative? ;
  90 TUPLE: curveto p1 p2 p relative? ;
  91 TUPLE: smooth-curveto p2 p relative? ;
  92 TUPLE: quadratic-bezier-curveto p1 p relative? ;
  93 TUPLE: smooth-quadratic-bezier-curveto p relative? ;
  94 TUPLE: elliptical-arc radii x-axis-rotation large-arc? sweep? p relative? ;
  95
  96 : (set-relative) ( args rel -- args )
  97     '[ [ _ >>relative? drop ] each ] keep ;
  98
  99 EBNF: svg-path>array [=[
 100
 101 moveto-drawto-command-groups =
 102     moveto-drawto-command-group:first wsp* moveto-drawto-command-groups:rest
 103         => [[ first rest append ]]
 104     | moveto-drawto-command-group
 105 moveto-drawto-command-group =
 106     moveto:m wsp* drawto-commands?:d => [[ m d append ]]
 107 drawto-commands =
 108     drawto-command:first wsp* drawto-commands:rest => [[ first rest append ]]
 109     | drawto-command
 110 drawto-command =
 111     closepath
 112     | lineto
 113     | horizontal-lineto
 114     | vertical-lineto
 115     | curveto
 116     | smooth-curveto
 117     | quadratic-bezier-curveto
 118     | smooth-quadratic-bezier-curveto
 119     | elliptical-arc
 120 moveto =
 121     ("M" => [[ f ]] | "m" => [[ t ]]):rel wsp* moveto-argument-sequence:args
 122         => [[ args rel (set-relative) ]]
 123 moveto-argument = coordinate-pair => [[ f moveto boa ]]
 124 moveto-argument-sequence =
 125     moveto-argument:first comma-wsp? lineto-argument-sequence:rest
 126         => [[ rest first prefix ]]
 127     | moveto-argument => [[ 1array ]]
 128 closepath =
 129     ("Z" | "z") => [[ drop closepath boa 1array ]]
 130 lineto =
 131     ("L" => [[ f ]] | "l" => [[ t ]]):rel wsp* lineto-argument-sequence:args
 132         => [[ args rel (set-relative) ]]
 133 lineto-argument = coordinate-pair => [[ f lineto boa ]]
 134 lineto-argument-sequence =
 135     lineto-argument:first comma-wsp? lineto-argument-sequence:rest
 136         => [[ rest first prefix ]]
 137     | lineto-argument => [[ 1array ]]
 138 horizontal-lineto =
 139     ( "H" => [[ f ]] | "h" => [[ t ]]):rel wsp* horizontal-lineto-argument-sequence:args
 140         => [[ args rel (set-relative) ]]
 141 horizontal-lineto-argument = coordinate => [[ f horizontal-lineto boa ]]
 142 horizontal-lineto-argument-sequence =
 143     horizontal-lineto-argument:first comma-wsp? horizontal-lineto-argument-sequence:rest
 144         => [[ rest first prefix ]]
 145     | horizontal-lineto-argument => [[ 1array ]]
 146 vertical-lineto =
 147     ( "V" => [[ f ]] | "v" => [[ t ]]):rel wsp* vertical-lineto-argument-sequence:args
 148         => [[ args rel (set-relative) ]]
 149 vertical-lineto-argument = coordinate => [[ f vertical-lineto boa ]]
 150 vertical-lineto-argument-sequence =
 151     vertical-lineto-argument:first comma-wsp? vertical-lineto-argument-sequence:rest
 152         => [[ rest first prefix ]]
 153     | vertical-lineto-argument => [[ 1array ]]
 154 curveto =
 155     ( "C" => [[ f ]] | "c" => [[ t ]]):rel wsp* curveto-argument-sequence:args
 156         => [[ args rel (set-relative) ]]
 157 curveto-argument-sequence =
 158     curveto-argument:first comma-wsp? curveto-argument-sequence:rest
 159         => [[ rest first prefix ]]
 160     | curveto-argument => [[ 1array ]]
 161 curveto-argument =
 162     coordinate-pair:pone comma-wsp? coordinate-pair:ptwo comma-wsp? coordinate-pair:p
 163         => [[ pone ptwo p f curveto boa ]]
 164 smooth-curveto =
 165     ( "S" => [[ f ]] | "s" => [[ t ]] ):rel wsp* smooth-curveto-argument-sequence:args
 166         => [[ args rel (set-relative) ]]
 167 smooth-curveto-argument-sequence =
 168     smooth-curveto-argument:first comma-wsp? smooth-curveto-argument-sequence:rest
 169         => [[ rest first prefix ]]
 170     | smooth-curveto-argument => [[ 1array ]]
 171 smooth-curveto-argument =
 172     coordinate-pair:ptwo comma-wsp? coordinate-pair:p
 173         => [[ ptwo p f smooth-curveto boa ]]
 174 quadratic-bezier-curveto =
 175     ( "Q" => [[ f ]] | "q" => [[ t ]] ):rel wsp* quadratic-bezier-curveto-argument-sequence:args
 176         => [[ args rel (set-relative) ]]
 177 quadratic-bezier-curveto-argument-sequence =
 178     quadratic-bezier-curveto-argument:first comma-wsp?
 179         quadratic-bezier-curveto-argument-sequence:rest
 180         => [[ rest first prefix ]]
 181     | quadratic-bezier-curveto-argument => [[ 1array ]]
 182 quadratic-bezier-curveto-argument =
 183     coordinate-pair:pone comma-wsp? coordinate-pair:p
 184         => [[ pone p f quadratic-bezier-curveto boa ]]
 185 smooth-quadratic-bezier-curveto =
 186     ( "T" => [[ f ]] | "t" => [[ t ]] ):rel wsp* smooth-quadratic-bezier-curveto-argument-sequence:args
 187         => [[ args rel (set-relative) ]]
 188 smooth-quadratic-bezier-curveto-argument-sequence =
 189     smooth-quadratic-bezier-curveto-argument:first comma-wsp? smooth-quadratic-bezier-curveto-argument-sequence:rest
 190         => [[ rest first prefix ]]
 191     | smooth-quadratic-bezier-curveto-argument => [[ 1array ]]
 192 smooth-quadratic-bezier-curveto-argument = coordinate-pair => [[ f smooth-quadratic-bezier-curveto boa ]]
 193 elliptical-arc =
 194     ( "A" => [[ f ]] | "a" => [[ t ]] ):rel wsp* elliptical-arc-argument-sequence:args
 195         => [[ args rel (set-relative) ]]
 196 elliptical-arc-argument-sequence =
 197     elliptical-arc-argument:first comma-wsp? elliptical-arc-argument-sequence:rest
 198         => [[ rest first prefix ]]
 199     | elliptical-arc-argument => [[ 1array ]]
 200 elliptical-arc-argument =
 201     nonnegative-number:radiix comma-wsp? nonnegative-number:radiiy comma-wsp?
 202         number:xrot comma-wsp flag:large comma-wsp flag:sweep
 203         comma-wsp coordinate-pair:p
 204         => [[ radiix radiiy 2array xrot large sweep p f elliptical-arc boa ]]
 205 coordinate-pair = coordinate:x comma-wsp? coordinate:y => [[ x y 2array ]]
 206 coordinate = number
 207 nonnegative-number = (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
 208 number = sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
 209 flag = "0" => [[ f ]] | "1" => [[ t ]]
 210 comma-wsp = (wsp+ comma? wsp*) | (comma wsp*)
 211 comma = ","
 212 integer-constant = digit-sequence
 213 floating-point-constant = fractional-constant exponent?  | digit-sequence exponent
 214 fractional-constant = digit-sequence? "." digit-sequence | digit-sequence "."
 215 exponent = ( "e" | "E" ) sign? digit-sequence
 216 sign = "+" => [[ drop f ]] | "-"
 217 digit-sequence = [0-9]+ => [[ >string ]]
 218 wsp = [ \t\r\n]
 219
 220 svg-path = wsp* moveto-drawto-command-groups?:x wsp* => [[ x ]]
 221
 222 ]=]
 223
 224 : tag-d ( tag -- d )
 225     "d" svg-name attr svg-path>array ;