0 | 0 |
(load "package.lisp")
|
1 | 1 |
(load "bezier.lisp")
|
|
2 |
(load "stringutil.lisp")
|
2 | 3 |
(in-package :so3-cnc)
|
3 | 4 |
|
4 | 5 |
(ql:quickload :alexandria)
|
|
8 | 9 |
(ql:quickload :s-http-client)
|
9 | 10 |
|
10 | 11 |
; width of the work area, in stepper steps
|
11 | |
(setf *width* 0)
|
|
12 |
(defparameter *width* 0)
|
12 | 13 |
; height of the work area, in stepper steps
|
13 | |
(setf *height* 0)
|
14 | |
|
15 | |
(setf *steps-per-mm* 50)
|
|
14 |
(defparameter *height* 0)
|
|
15 |
|
|
16 |
(defparameter *steps-per-mm* 46)
|
16 | 17 |
|
17 | 18 |
; these are the states that cncserver recognizes
|
18 | |
(setq *pen-states* '("up" "draw"))
|
|
19 |
(defparameter *pen-states* '("up" "draw"))
|
19 | 20 |
|
20 | 21 |
(defparameter *cnc-host* "192.168.1.129")
|
21 | 22 |
(defun api-url (e) (format nil "http://~a:4242/~a" *cnc-host* e))
|
|
29 | 30 |
(setf *height* (parse-integer (jsown:val max-area "height")))
|
30 | 31 |
(send-put-request (api-url "v1/settings/global")
|
31 | 32 |
(jsown:new-js ("invertAxis" (jsown:new-js ("x" :f) ("y" :f)))))
|
|
33 |
(send-put-request (api-url "v1/settings/bot")
|
|
34 |
(jsown:new-js ("speed:drawing" 8) ("speed:moving" 50)))
|
32 | 35 |
settings
|
33 | 36 |
))
|
34 | 37 |
|
|
64 | 67 |
(send-put-request (api-url "v1/buffer") (jsown:new-js ("paused" t))))
|
65 | 68 |
(defun flush-buffer ()
|
66 | 69 |
(send-put-request (api-url "v1/buffer") (jsown:new-js ("paused" :f))))
|
67 | |
|
68 | |
(defun split-by-one-space (string)
|
69 | |
(loop for i = 0 then (1+ j)
|
70 | |
as j = (position #\Space string :start i)
|
71 | |
collect (subseq string i j)
|
72 | |
while j))
|
73 | 70 |
|
74 | 71 |
(defun gcode-remove-comments (line)
|
75 | 72 |
(if (equal (char line 0) #\#) ""
|
|
106 | 103 |
(x 0.0 :type float)
|
107 | 104 |
(y 0.0 :type float)
|
108 | 105 |
(z "unknown" :type string)
|
|
106 |
(global-translate '(0 . 0))
|
109 | 107 |
(dummy-file nil)
|
110 | 108 |
)
|
111 | 109 |
|
|
125 | 123 |
(reverse (theta-steps-ccw end start)))
|
126 | 124 |
|
127 | 125 |
(defun theta-steps (mode start end)
|
128 | |
(funcall (alexandria:switch (mode)
|
129 | |
(2 #'theta-steps-cw)
|
130 | |
(3 #'theta-steps-ccw)) start end))
|
|
126 |
(let* ((thetas (funcall (alexandria:switch (mode)
|
|
127 |
(2 #'theta-steps-cw)
|
|
128 |
(3 #'theta-steps-ccw)) start end))
|
|
129 |
(nt (length thetas)))
|
|
130 |
(mapcar (lambda (i th) (cons (/ i (float nt)) th))
|
|
131 |
(loop for i from 0 to nt collect i)
|
|
132 |
thetas)))
|
131 | 133 |
|
132 | 134 |
(defun run-gcode-circle (g x y i j old-x old-y)
|
133 | 135 |
(let* ((cx (+ old-x i))
|
|
139 | 141 |
(theta-end (atan (- nj) (- ni)))
|
140 | 142 |
(theta-start (atan (- j) (- i)))
|
141 | 143 |
)
|
142 | |
(unless (> (abs (- r-end r)) 0.001)
|
143 | |
(loop for theta in (theta-steps (gvm-mode g) theta-start theta-end)
|
144 | |
do (let ((tx (+ cx (* r (cos theta))))
|
145 | |
(ty (+ cy (* r (sin theta)))))
|
|
144 |
(progn
|
|
145 |
(loop for ft in (theta-steps (gvm-mode g) theta-start theta-end)
|
|
146 |
do (let* ((theta (cdr ft))
|
|
147 |
(rad (+ r (* (car ft) (- r-end r))))
|
|
148 |
(tx (+ cx (* rad (cos theta))))
|
|
149 |
(ty (+ cy (* rad (sin theta)))))
|
146 | 150 |
(run-gcode-linear g tx ty)))
|
147 | 151 |
(run-gcode-linear g x y))))
|
148 | 152 |
|
|
153 |
(defun send-goto (xrel yrel)
|
|
154 |
(format t "send ~a ~a~%" xrel yrel)
|
|
155 |
(send-put-request
|
|
156 |
(api-url "v1/pen")
|
|
157 |
(jsown:new-js ("x" xrel) ("y" yrel) ("ignoreTimeout" 1))))
|
|
158 |
|
149 | 159 |
(defun run-gcode-linear (g x y)
|
150 | 160 |
(if (null (gvm-dummy-file g))
|
151 | |
(send-put-request
|
152 | |
(api-url "v1/pen")
|
153 | |
(jsown:new-js ("x" (x-from-gcode x)) ("y" (y-from-gcode y)) ("ignoreTimeout" 1)))
|
154 | |
(format (gvm-dummy-file g) "~f,~f~%" (x-from-gcode x) (y-from-gcode y))
|
|
161 |
(send-goto (x-from-gcode (+ (car (gvm-global-translate g)) x))
|
|
162 |
(y-from-gcode (+ (cdr (gvm-global-translate g)) y)))
|
|
163 |
(format (gvm-dummy-file g) "G1 X~f Y~f~%" (x-from-gcode x) (y-from-gcode y))
|
155 | 164 |
))
|
156 | 165 |
|
157 | 166 |
(defun run-gcode-movement (g old-x old-y)
|
|
168 | 177 |
(send-put-request (api-url "v1/pen") (jsown:new-js ("state" new-state-name)))
|
169 | 178 |
)))
|
170 | 179 |
|
171 | |
(defun run-gcode-line (line g)
|
172 | |
(let* ((terms (gcode-assign-parse line))
|
173 | |
(new-mode (assoc :G terms))
|
|
180 |
(defun run-gcode-line (terms g)
|
|
181 |
(let* ((new-mode (assoc :G terms))
|
174 | 182 |
(new-state (assoc :Z terms))
|
175 | 183 |
(new-x (assoc :X terms))
|
176 | 184 |
(new-y (assoc :Y terms))
|
|
186 | 194 |
(unless (null new-j) (setf (gvm-j g) (cdr new-j)))
|
187 | 195 |
(run-gcode-movement g old-x old-y)))
|
188 | 196 |
|
|
197 |
(defun gcode-bounds (terms)
|
|
198 |
(let ((xs (remove nil (mapcar (lambda (g) (cdr (assoc :X g))) terms)))
|
|
199 |
(ys (remove nil (mapcar (lambda (g) (cdr (assoc :Y g))) terms))))
|
|
200 |
(list
|
|
201 |
(alexandria:extremum xs #'<) (alexandria:extremum ys #'<)
|
|
202 |
(alexandria:extremum xs #'>) (alexandria:extremum ys #'>))))
|
|
203 |
|
|
204 |
(defun find-gcode-translate (terms)
|
|
205 |
(when (null *width*) (init))
|
|
206 |
(let* ((bounds (gcode-bounds terms))
|
|
207 |
(width-mm (/ *width* *steps-per-mm*))
|
|
208 |
(xdiff (- width-mm (- (third bounds) (first bounds)))))
|
|
209 |
(cons (- (/ xdiff 2) (first bounds)) 0)))
|
|
210 |
|
189 | 211 |
(defun run-gcode-file-on-gvm (g fname)
|
190 | 212 |
(with-open-file (stream fname :direction :input)
|
191 | |
(do ((l (read-line stream) (read-line stream nil 'eof)))
|
192 | |
((eq l 'eof) nil)
|
193 | |
(run-gcode-line l g))))
|
|
213 |
(let* ((lines (loop for line = (read-line stream nil 'eof)
|
|
214 |
while (not (equal line 'eof)) collect line))
|
|
215 |
(termslist (mapcar #'gcode-assign-parse lines)))
|
|
216 |
(progn
|
|
217 |
(setf (gvm-global-translate g) (find-gcode-translate termslist))
|
|
218 |
(format t "global offset set to ~a for x-centering~%" (gvm-global-translate g))
|
|
219 |
(loop for terms in termslist do (run-gcode-line terms g))
|
|
220 |
))))
|
194 | 221 |
|
195 | 222 |
(defun run-gcode-file (file &key (dummy-file nil))
|
196 | 223 |
(if (null dummy-file) (run-gcode-file-on-gvm (make-gvm) file)
|