Commit a2462ef3539c8eb306972f6a3f606ca8f1298338 - plotter

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

+22

-23

svgcam.lisp less more

38	38	)))
39	39
40	40	(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 '())
45	44	)
46	45
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
53	46	(defun to-abs-xy (svgm mode pairs)
54		(let* ((cur-xy (svgm-cur-xy svgm))
	47	(let* ((cur-xy (svgm-current svgm))
55	48	(cur-x (first cur-xy))
56	49	(cur-y (second cur-xy)))
57	50	(cons mode (loop for i from 1 to (length pairs)

76	69	(otherwise s)
77	70	)))
78	71
	72	(defun gcode-goto (xy &key (mode 1))
	73	(list (cons :G mode) (cons :X (first xy)) (cons :Y (second xy))))
	74
79	75	(defun push-stanza (svgm sraw)
80	76	"Creates and returns a new svg machine that includes the result of interpreting the given stanza"
81	77	(let* ((s (to-abs sraw svgm))
82	78	(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))
87	83	)
88	84	(alexandria:switch (mode)
89	85	(#\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))))
92	90	))
93	91	(#\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	))
96	95	(#\Z (progn
97		(when (null current)
	96	(when (null ls)
98	97	(error "got Z (close path) when there's no current path"))
99	98	(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	)))
103	102	(otherwise (error "unsupported mode ~A" mode))
104	103	)))
105	104