113 | 113 |
(gcode (svgm-gcode svgm))
|
114 | 114 |
)
|
115 | 115 |
(alexandria:switch (mode)
|
|
116 |
; path start/end
|
116 | 117 |
(#\M (let ((p (cons (first args) (second args))))
|
117 | 118 |
(make-svg-machine
|
118 | 119 |
:current p :last-start p
|
|
120 | 121 |
(gcode-goto p :mode 0)
|
121 | 122 |
'((:G . 0) (:Z . -1))))
|
122 | 123 |
)))
|
|
124 |
(#\Z (progn
|
|
125 |
(when (null ls)
|
|
126 |
(error "got Z (close path) when there's no current path"))
|
|
127 |
(make-svg-machine
|
|
128 |
:current ls :last-start ls
|
|
129 |
:gcode (append gcode (list (gcode-goto ls)))
|
|
130 |
)))
|
|
131 |
|
|
132 |
; lines
|
123 | 133 |
(#\L (let ((p (cons (first args) (second args))))
|
124 | 134 |
(make-svg-machine
|
125 | 135 |
:current p :last-start (if (null ls) cur-xy ls)
|
126 | 136 |
:gcode (append gcode (list (gcode-goto p)))
|
127 | 137 |
)))
|
|
138 |
|
|
139 |
; cubic beziers
|
128 | 140 |
(#\C (let* ((c1 (cons (first args) (second args)))
|
129 | 141 |
(c2 (cons (third args) (fourth args)))
|
130 | 142 |
(p2 (cons (fifth args) (sixth args)))
|
|
138 | 150 |
(lcp (if (null lcp?) cur-xy lcp?))
|
139 | 151 |
(c1 (vec+ cur-xy (vec- cur-xy lcp))))
|
140 | 152 |
(push-stanza svgm (append (list #\C (car c1) (cdr c1)) args) xform)))
|
141 | |
(#\Z (progn
|
142 | |
(when (null ls)
|
143 | |
(error "got Z (close path) when there's no current path"))
|
144 | |
(make-svg-machine
|
145 | |
:current ls :last-start ls
|
146 | |
:gcode (append gcode (list (gcode-goto ls)))
|
147 | |
)))
|
|
153 |
|
|
154 |
; quadratic beziers
|
|
155 |
(#\Q (let* ((c (cons (first args) (second args)))
|
|
156 |
(p2 (cons (fifth args) (sixth args)))
|
|
157 |
(svg-poly (push-polyline svgm xform (loop for theta in *theta-steps*
|
|
158 |
collect (eval-bezier-quadratic theta cur-xy c p2)))))
|
|
159 |
(make-svg-machine
|
|
160 |
:current (svgm-current svg-poly) :last-start (svgm-last-start svg-poly)
|
|
161 |
:gcode (svgm-gcode svg-poly) :last-ctrl-point c
|
|
162 |
)))
|
|
163 |
(#\T (let* ((lcp? (svgm-last-ctrl-point svgm))
|
|
164 |
(lcp (if (null lcp?) cur-xy lcp?))
|
|
165 |
(c (vec+ cur-xy (vec- cur-xy lcp))))
|
|
166 |
(push-stanza svgm (append (list #\Q (car c) (cdr c)) args) xform)))
|
|
167 |
|
|
168 |
; arcs
|
148 | 169 |
(otherwise (error "unsupported mode ~A" mode))
|
149 | 170 |
)))
|
150 | 171 |
|