git.haldean.org plotter / b5f3e26
quadratic beziers (Q/T) are basically the same as C/S haldean 4 years ago
2 changed file(s) with 30 addition(s) and 7 deletion(s). Raw diff Collapse all Expand all
+2
-0
bezier.lisp less more
1414
1515 (defun eval-bezier-cubic (theta p0 p1 p2 p3)
1616 (eval-bezier theta (list p0 p1 p2 p3)))
17 (defun eval-bezier-quadratic (theta p0 p1 p2)
18 (eval-bezier theta (list p0 p1 p2)))
+28
-7
svgcam.lisp less more
113113 (gcode (svgm-gcode svgm))
114114 )
115115 (alexandria:switch (mode)
116 ; path start/end
116117 (#\M (let ((p (cons (first args) (second args))))
117118 (make-svg-machine
118119 :current p :last-start p
120121 (gcode-goto p :mode 0)
121122 '((:G . 0) (:Z . -1))))
122123 )))
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
123133 (#\L (let ((p (cons (first args) (second args))))
124134 (make-svg-machine
125135 :current p :last-start (if (null ls) cur-xy ls)
126136 :gcode (append gcode (list (gcode-goto p)))
127137 )))
138
139 ; cubic beziers
128140 (#\C (let* ((c1 (cons (first args) (second args)))
129141 (c2 (cons (third args) (fourth args)))
130142 (p2 (cons (fifth args) (sixth args)))
138150 (lcp (if (null lcp?) cur-xy lcp?))
139151 (c1 (vec+ cur-xy (vec- cur-xy lcp))))
140152 (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
148169 (otherwise (error "unsupported mode ~A" mode))
149170 )))
150171