Commit 8571a0023582ca1e105a90b973ca03e8645b2b64 - plotter

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

+30

-7

svgcam.lisp less more

11	11	(make-array '(2 3)
12	12	:initial-contents (list (list (first vs) (second vs) (third vs))
13	13	(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)))
14	27
15	28	(defun make-matrix (a b c d e f) (reshape-to-2x3 (list a b c d e f)))
16	29	(defun make-translate (x &optional (y 0)) (reshape-to-2x3 (list 1 0 x 0 1 y)))

53	66	))
54	67	))
55	68
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)))))
58	80	(alexandria:switch ((first s))
59	81	(#\m (pairs))
60	82	(#\l (pairs))

65	87	(#\h (to-abs-xy svgm #\L (list (second s) 0)))
66	88	(#\v (to-abs-xy svgm #\L (list 0 (second s))))
67	89	(#\a (error "relative arc moves not supported yet"))
	90	(#\A s)
68	91	(#\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))
70	93	)))
71	94
72	95	(defun gcode-goto (xy &key (mode 1))
73	96	(list (cons :G mode) (cons :X (first xy)) (cons :Y (second xy))))
74	97
75		(defun push-stanza (svgm sraw)
	98	(defun push-stanza (svgm sraw xform)
76	99	"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))
78	101	(mode (first s))
79	102	(args (rest s))
80	103	(cur-xy (svgm-current svgm))

102	125	(otherwise (error "unsupported mode ~A" mode))
103	126	)))
104	127
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))
107	130
108	131	(defun normalize-stanza (s)
109	132	"Takes a stanza of the form (MODE ARG0 ARG1 ARG2 ... ARGN) and returns a list of stanzas