git.haldean.org plotter / a2462ef
actually generate g-code Haldean Brown 4 years ago
1 changed file(s) with 22 addition(s) and 23 deletion(s). Raw diff Collapse all Expand all
3838 )))
3939
4040 (defstruct (svg-machine (:conc-name svgm-))
41 (finished-paths '())
42 (current-path-rev '()) ; note: current path is actually the reversed current path,
43 ; with the most recent point being the first element. This is
44 ; done so that it's fast to add new stuff onto the list
41 (current '(0 0)) ; current position
42 (last-start nil) ; last path start position
43 (gcode '())
4544 )
4645
47 (defun svgm-cur-xy (svgm)
48 (if (null (svgm-current-path-rev svgm))
49 (if (null (svgm-finished-paths svgm)) '(0.0 0.0)
50 (car (last (first (svgm-finished-paths svgm)))))
51 (first (svgm-current-path-rev svgm))))
52
5346 (defun to-abs-xy (svgm mode pairs)
54 (let* ((cur-xy (svgm-cur-xy svgm))
47 (let* ((cur-xy (svgm-current svgm))
5548 (cur-x (first cur-xy))
5649 (cur-y (second cur-xy)))
5750 (cons mode (loop for i from 1 to (length pairs)
7669 (otherwise s)
7770 )))
7871
72 (defun gcode-goto (xy &key (mode 1))
73 (list (cons :G mode) (cons :X (first xy)) (cons :Y (second xy))))
74
7975 (defun push-stanza (svgm sraw)
8076 "Creates and returns a new svg machine that includes the result of interpreting the given stanza"
8177 (let* ((s (to-abs sraw svgm))
8278 (mode (first s))
83 (finished (svgm-finished-paths svgm))
84 (current (svgm-current-path-rev svgm))
85 (cur-xy (svgm-cur-xy svgm))
86 (nonempty-current (if (null current) (list cur-xy) current))
79 (args (rest s))
80 (cur-xy (svgm-current svgm))
81 (ls (svgm-last-start svgm))
82 (gcode (svgm-gcode svgm))
8783 )
8884 (alexandria:switch (mode)
8985 (#\M (make-svg-machine
90 :finished-paths (if (null current) finished (cons (reverse current) finished))
91 :current-path-rev (list (cdr s))
86 :current args :last-start args
87 :gcode (append gcode (list '((:G . 0) (:Z . 1))
88 (gcode-goto args :mode 0)
89 '((:G . 0) (:Z . -1))))
9290 ))
9391 (#\L (make-svg-machine
94 :finished-paths finished
95 :current-path-rev (cons (cdr s) nonempty-current)))
92 :current args :last-start ls
93 :gcode (append gcode (list (gcode-goto args)))
94 ))
9695 (#\Z (progn
97 (when (null current)
96 (when (null ls)
9897 (error "got Z (close path) when there's no current path"))
9998 (make-svg-machine
100 :current-path-rev '()
101 :finished-paths (cons (reverse (cons (car (last current)) current)) finished)
102 )))
99 :current ls :last-start ls
100 :gcode (append gcode (list (gcode-goto ls)))
101 )))
103102 (otherwise (error "unsupported mode ~A" mode))
104103 )))
105104