0 | |
(load "cnc.lisp")
|
|
0 |
(load "package.lisp")
|
|
1 |
(load "bezier.lisp")
|
1 | 2 |
(in-package :so3-cnc)
|
2 | 3 |
|
3 | 4 |
(ql:quickload :alexandria)
|
|
51 | 52 |
)))
|
52 | 53 |
|
53 | 54 |
(defstruct (svg-machine (:conc-name svgm-))
|
54 | |
(current '(0 0)) ; current position
|
|
55 |
(current '(0 . 0)) ; current position
|
55 | 56 |
(last-start nil) ; last path start position
|
56 | 57 |
(gcode '())
|
57 | 58 |
)
|
58 | 59 |
|
59 | 60 |
(defun to-abs-xy (svgm mode pairs)
|
60 | 61 |
(let* ((cur-xy (svgm-current svgm))
|
61 | |
(cur-x (first cur-xy))
|
62 | |
(cur-y (second cur-xy)))
|
|
62 |
(cur-x (car cur-xy))
|
|
63 |
(cur-y (cdr cur-xy)))
|
63 | 64 |
(cons mode (loop for i from 1 to (length pairs)
|
64 | 65 |
for j in pairs
|
65 | 66 |
collect (+ j (if (= (mod i 2) 1) cur-x cur-y))
|
|
93 | 94 |
)))
|
94 | 95 |
|
95 | 96 |
(defun gcode-goto (xy &key (mode 1))
|
96 | |
(list (cons :G mode) (cons :X (first xy)) (cons :Y (second xy))))
|
|
97 |
(list (cons :G mode) (cons :X (car xy)) (cons :Y (cdr xy))))
|
|
98 |
|
|
99 |
(defun push-polyline (svgm xform pts)
|
|
100 |
(reduce (lambda (svgm p) (push-stanza svgm (list #\L (car p) (cdr p)) xform)) pts :initial-value svgm))
|
|
101 |
|
|
102 |
(setf *theta-steps* '(0.00 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70 0.75 0.80 0.85 0.90 0.95 1.00))
|
97 | 103 |
|
98 | 104 |
(defun push-stanza (svgm sraw xform)
|
99 | 105 |
"Creates and returns a new svg machine that includes the result of interpreting the given stanza"
|
|
105 | 111 |
(gcode (svgm-gcode svgm))
|
106 | 112 |
)
|
107 | 113 |
(alexandria:switch (mode)
|
108 | |
(#\M (make-svg-machine
|
109 | |
:current args :last-start args
|
110 | |
:gcode (append gcode (list '((:G . 0) (:Z . 1))
|
111 | |
(gcode-goto args :mode 0)
|
112 | |
'((:G . 0) (:Z . -1))))
|
113 | |
))
|
114 | |
(#\L (make-svg-machine
|
115 | |
:current args :last-start ls
|
116 | |
:gcode (append gcode (list (gcode-goto args)))
|
117 | |
))
|
|
114 |
(#\M (let ((p (cons (first args) (second args))))
|
|
115 |
(make-svg-machine
|
|
116 |
:current p :last-start p
|
|
117 |
:gcode (append gcode (list '((:G . 0) (:Z . 1))
|
|
118 |
(gcode-goto p :mode 0)
|
|
119 |
'((:G . 0) (:Z . -1))))
|
|
120 |
)))
|
|
121 |
(#\L (let ((p (cons (first args) (second args))))
|
|
122 |
(make-svg-machine
|
|
123 |
:current p :last-start (if (null ls) cur-xy ls)
|
|
124 |
:gcode (append gcode (list (gcode-goto p)))
|
|
125 |
)))
|
|
126 |
(#\C (push-polyline svgm xform
|
|
127 |
(loop for theta in *theta-steps*
|
|
128 |
collect (eval-bezier-cubic
|
|
129 |
theta
|
|
130 |
cur-xy
|
|
131 |
(cons (first args) (second args))
|
|
132 |
(cons (third args) (fourth args))
|
|
133 |
(cons (fifth args) (sixth args))
|
|
134 |
))))
|
118 | 135 |
(#\Z (progn
|
119 | 136 |
(when (null ls)
|
120 | 137 |
(error "got Z (close path) when there's no current path"))
|