extra/svg/svg.factor

   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.syntax ;
   5 IN: svg
   6
   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
  11
  12 : svg-string>number ( string -- number )
  13     { { CHAR: E CHAR: e } } substitute "e" split1
  14     [ string>number ] [ [ string>number 10^ ] [ 1 ] if* ] bi* *
  15     >float ;
  16
  17 : degrees ( deg -- rad ) pi * 180.0 / ;
  18
  19 EBNF: svg-transform>affine-transform
  20
  21 transforms =
  22     transform:m comma-wsp+ transforms:n => [[ m n a. ]]
  23     | transform
  24 transform =
  25     matrix
  26     | translate
  27     | scale
  28     | rotate
  29     | skewX
  30     | skewY
  31 matrix =
  32     "matrix" wsp* "(" wsp*
  33        number:xx comma-wsp
  34        number:xy comma-wsp
  35        number:yx comma-wsp
  36        number:yy comma-wsp
  37        number:ox comma-wsp
  38        number:oy wsp* ")"
  39         => [[ { xx xy } { yx yy } { ox oy } <affine-transform> ]]
  40 translate =
  41     "translate" wsp* "(" wsp* number:tx ( comma-wsp number:ty => [[ ty ]] )?:ty wsp* ")"
  42         => [[ tx ty 0.0 or 2array <translation> ]]
  43 scale =
  44     "scale" wsp* "(" wsp* number:sx ( comma-wsp number:sy => [[ sy ]] )?:sy wsp* ")"
  45         => [[ sx sy sx or <scale> ]]
  46 rotate =
  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* ]]
  49 skewX =
  50     "skewX" wsp* "(" wsp* number:a wsp* ")"
  51         => [[ { 1.0 0.0 } a degrees tan 1.0 2array { 0.0 0.0 } <affine-transform> ]]
  52 skewY =
  53     "skewY" wsp* "(" wsp* number:a wsp* ")"
  54         => [[ 1.0 a degrees tan 2array { 0.0 1.0 } { 0.0 0.0 } <affine-transform> ]]
  55 number =
  56     sign? (floating-point-constant | integer-constant) => [[ squish-strings svg-string>number ]]
  57 comma-wsp =
  58     (wsp+ comma? wsp*) | (comma wsp*)
  59 comma =
  60     ","
  61 integer-constant =
  62     digit-sequence
  63 floating-point-constant =
  64     fractional-constant exponent?
  65     | digit-sequence exponent
  66 fractional-constant =
  67     digit-sequence? "." digit-sequence
  68     | digit-sequence "."
  69 exponent =
  70     ( "e" | "E" ) sign? digit-sequence
  71 sign =
  72     "+" => [[ f ]] | "-"
  73 digit-sequence = [0-9]+ => [[ >string ]]
  74 wsp = (" " | "\t" | "\r" | "\n")
  75
  76 transform-list = wsp* transforms?:t wsp*
  77     => [[ t [ identity-transform ] unless* ]]
  78
  79 ;EBNF
  80
  81 : tag-transform ( tag -- transform )
  82     "transform" svg-name attr svg-transform>affine-transform ;
  83
  84 TUPLE: moveto p relative? ;
  85 TUPLE: closepath ;
  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? ;
  94
  95 : (set-relative) ( args rel -- args )
  96     '[ [ _ >>relative? drop ] each ] keep ;
  97
  98 EBNF: svg-path>array
  99
 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 ]]
 106 drawto-commands =
 107     drawto-command:first wsp* drawto-commands:rest => [[ first rest append ]]
 108     | drawto-command
 109 drawto-command =
 110     closepath
 111     | lineto
 112     | horizontal-lineto
 113     | vertical-lineto
 114     | curveto
 115     | smooth-curveto
 116     | quadratic-bezier-curveto
 117     | smooth-quadratic-bezier-curveto
 118     | elliptical-arc
 119 moveto =
 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 ]]
 127 closepath =
 128     ("Z" | "z") => [[ drop closepath boa 1array ]]
 129 lineto =
 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 ]]
 137 horizontal-lineto =
 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 ]]
 145 vertical-lineto =
 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 ]]
 153 curveto =
 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 ]]
 160 curveto-argument =
 161     coordinate-pair:pone comma-wsp? coordinate-pair:ptwo comma-wsp? coordinate-pair:p
 162         => [[ pone ptwo p f curveto boa ]]
 163 smooth-curveto =
 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 ]]
 192 elliptical-arc =
 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 ]]
 205 coordinate = number
 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*)
 210 comma = ","
 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")
 218
 219 svg-path = wsp* moveto-drawto-command-groups?:x wsp* => [[ x ]]
 220
 221 ;EBNF
 222
 223 : tag-d ( tag -- d )
 224     "d" svg-name attr svg-path>array ;