git.haldean.org plotter / c058670
support for S paths haldean 4 years ago
2 changed file(s) with 34 addition(s) and 20 deletion(s). Raw diff Collapse all Expand all
+1
-0
bezier.lisp less more
22 (in-package :so3-cnc)
33
44 (defun vec+ (v1 v2) (cons (+ (car v1) (car v2)) (+ (cdr v1) (cdr v2))))
5 (defun vec- (v1 v2) (cons (- (car v1) (car v2)) (- (cdr v1) (cdr v2))))
56 (defun vec* (s v) (cons (* s (car v)) (* s (cdr v))))
67
78 (defun eval-bezier (theta pts)
+33
-20
svgcam.lisp less more
99
1010 (defun reshape-to-2x3 (vs)
1111 (clem:array->matrix
12 (make-array '(2 3)
12 (make-array '(3 3)
1313 :initial-contents (list (list (first vs) (second vs) (third vs))
14 (list (fourth vs) (fifth vs) (sixth vs))))))
14 (list (fourth vs) (fifth vs) (sixth vs))
15 '(0 0 1)))))
1516 (defun point (xy) (clem:array->matrix
1617 (make-array '(3 1)
1718 :initial-contents (list (list (car xy))
5455 (defstruct (svg-machine (:conc-name svgm-))
5556 (current '(0 . 0)) ; current position
5657 (last-start nil) ; last path start position
58 (last-ctrl-point nil) ; the last control point used in any curve operation, for S paths
5759 (gcode '())
5860 )
5961
123125 :current p :last-start (if (null ls) cur-xy ls)
124126 :gcode (append gcode (list (gcode-goto p)))
125127 )))
126 (#\C (push-polyline svgm xform
127 (loop for theta in *theta-steps*
128 collect (eval-bezier-cubic
129 theta
130 cur-xy
131 (cons (first args) (second args))
132 (cons (third args) (fourth args))
133 (cons (fifth args) (sixth args))
134 ))))
128 (#\C (let* ((c1 (cons (first args) (second args)))
129 (c2 (cons (third args) (fourth args)))
130 (p2 (cons (fifth args) (sixth args)))
131 (svg-poly (push-polyline svgm xform (loop for theta in *theta-steps*
132 collect (eval-bezier-cubic theta cur-xy c1 c2 p2)))))
133 (make-svg-machine
134 :current (svgm-current svg-poly) :last-start (svgm-last-start svg-poly)
135 :gcode (svgm-gcode svg-poly) :last-ctrl-point c2
136 )))
137 (#\S (let* ((lcp? (svgm-last-ctrl-point svgm))
138 (lcp (if (null lcp?) cur-xy lcp?))
139 (c1 (vec+ cur-xy (vec- cur-xy lcp))))
140 (push-stanza svgm (append (list #\C (car c1) (cdr c1)) args) xform)))
135141 (#\Z (progn
136142 (when (null ls)
137143 (error "got Z (close path) when there's no current path"))
190196 (load-path-stanzas (subseq d end)))
191197 )))
192198
193 (defun load-path-data (d xform-stack)
199 (defun load-path-data (d)
194200 (reduce #'append (mapcar #'normalize-stanza (load-path-stanzas d))))
195201
196 (defun load-svg-from-xml (data &key (xform-stack nil))
197 (when (listp data)
202 (defun load-svg-from-xml (data svgm xform-stack)
203 (if (listp data)
198204 (let* ((tag (car data))
199205 (attributes (cadr data))
200206 (xform-attr (assoc "transform" attributes :test #'string-equal))
201207 (new-xform-stack (if (null xform-attr)
202208 xform-stack
203209 (cons (parse-transform (cadr xform-attr)) xform-stack)))
210 (xform (reduce #'clem:mat-mult new-xform-stack
211 :initial-value (clem:identity-matrix 3)))
204212 (children (cddr data))
205213 (pathdata (when (string-equal (car tag) "path")
206 (load-path-data (cadr (assoc "d" attributes :test #'string-equal)) new-xform-stack))))
207 (append pathdata (reduce #'append (mapcar #'load-svg-from-xml children)))
208 )))
209
210 (defun load-svg (fname)
214 (load-path-data (cadr (assoc "d" attributes :test #'string-equal)))))
215 (svgm-new (if (null pathdata) svgm (run-stanzas pathdata xform svgm))))
216 (reduce (lambda (asvgm child)
217 (load-svg-from-xml child asvgm new-xform-stack))
218 children
219 :initial-value svgm-new)
220 )
221 svgm))
222
223 (defun svg-to-gcode (fname)
211224 (let* ((svgtxt (alexandria:read-file-into-string fname))
212225 (svgdata (xmls:parse svgtxt)))
213 (load-svg-from-xml svgdata)))
226 (svgm-gcode (load-svg-from-xml svgdata (make-svg-machine) nil))))