git.haldean.org plotter / 8571a00
add support for transformation stacks Haldean Brown 4 years ago
1 changed file(s) with 30 addition(s) and 7 deletion(s). Raw diff Collapse all Expand all
1111 (make-array '(2 3)
1212 :initial-contents (list (list (first vs) (second vs) (third vs))
1313 (list (fourth vs) (fifth vs) (sixth vs))))))
14 (defun point (xy) (clem:array->matrix
15 (make-array '(3 1)
16 :initial-contents (list (list (car xy))
17 (list (cdr xy))
18 '(1)))))
19
20 (defun vec (xy) (clem:array->matrix
21 (make-array '(3 1)
22 :initial-contents (list (list (car xy))
23 (list (cdr xy))
24 '(0)))))
25
26 (defun clem-to-list (v) (list (clem:val v 0 0) (clem:val v 1 0)))
1427
1528 (defun make-matrix (a b c d e f) (reshape-to-2x3 (list a b c d e f)))
1629 (defun make-translate (x &optional (y 0)) (reshape-to-2x3 (list 1 0 x 0 1 y)))
5366 ))
5467 ))
5568
56 (defun to-abs (s svgm)
57 (macrolet ((pairs () `(to-abs-xy svgm (char-upcase (first s)) (rest s))))
69 (defun apply-xforms (xform s)
70 (let* ((mode (first s))
71 (args (rest s))
72 (pairs (loop for i from 0 to (- (length args) 1) by 2
73 collect (cons (nth i args) (nth (+ i 1) args)))))
74 (cons mode
75 (reduce #'append
76 (mapcar (lambda (p) (clem-to-list (clem:mat-mult xform (point p)))) pairs)))))
77
78 (defun to-abs (s xform svgm)
79 (macrolet ((pairs () `(apply-xforms xform (to-abs-xy svgm (char-upcase (first s)) (rest s)))))
5880 (alexandria:switch ((first s))
5981 (#\m (pairs))
6082 (#\l (pairs))
6587 (#\h (to-abs-xy svgm #\L (list (second s) 0)))
6688 (#\v (to-abs-xy svgm #\L (list 0 (second s))))
6789 (#\a (error "relative arc moves not supported yet"))
90 (#\A s)
6891 (#\z '(#\Z)) ; z and Z are the same, but we upcase it to make conditionals simpler later
69 (otherwise s)
92 (otherwise (apply-xforms xform s))
7093 )))
7194
7295 (defun gcode-goto (xy &key (mode 1))
7396 (list (cons :G mode) (cons :X (first xy)) (cons :Y (second xy))))
7497
75 (defun push-stanza (svgm sraw)
98 (defun push-stanza (svgm sraw xform)
7699 "Creates and returns a new svg machine that includes the result of interpreting the given stanza"
77 (let* ((s (to-abs sraw svgm))
100 (let* ((s (to-abs sraw xform svgm))
78101 (mode (first s))
79102 (args (rest s))
80103 (cur-xy (svgm-current svgm))
102125 (otherwise (error "unsupported mode ~A" mode))
103126 )))
104127
105 (defun run-stanzas (stanzas svgm)
106 (reduce #'push-stanza stanzas :initial-value svgm))
128 (defun run-stanzas (stanzas xform svgm)
129 (reduce (lambda (svgm s) (push-stanza svgm s xform)) stanzas :initial-value svgm))
107130
108131 (defun normalize-stanza (s)
109132 "Takes a stanza of the form (MODE ARG0 ARG1 ARG2 ... ARGN) and returns a list of stanzas