git.haldean.org plotter / fe1d7f3
wow sooo many improvements wowow i forgot this was a git repo Haldean Brown 8 months ago
5 changed file(s) with 110 addition(s) and 34 deletion(s). Raw diff Collapse all Expand all
2424 (defun eval-bezier-quadratic (theta p0 p1 p2)
2525 (eval-bezier theta (list p0 p1 p2)))
2626
27 (defun linspace (a b step)
28 (let ((steps (abs (ceiling (/ (- b a) step)))))
29 (divspace a b steps)))
30
31 (defun divspace (a b steps)
32 (let* ((s (/ (- b a) steps)))
33 (loop for i from 0 to steps collect (+ a (* s i)))))
34
35 (defun linterp-bezier (pts &optional (points-per-mm 0.55))
36 (let ((npts (ceiling
37 (* points-per-mm
38 (reduce
39 (lambda (sum point-pair)
40 (+ sum (sqrt (+ (expt (- (caar point-pair) (caadr point-pair)) 2)
41 (expt (- (cdar point-pair) (cdadr point-pair)) 2)))))
42 (mapcar #'list pts (rest pts))
43 :initial-value 0)))))
44 (loop for theta in (divspace 0 1 npts) collect (eval-bezier theta pts))))
45
46 (defun linterp-bezier-cubic (p0 p1 p2 p3)
47 (linterp-bezier (list p0 p1 p2 p3)))
48 (defun linterp-bezier-quadratic (p0 p1 p2)
49 (linterp-bezier (list p0 p1 p2)))
50
2751 (defun angle-between (v0 v1)
2852 (* (if (< 0 (- (* (car v0) (cdr v1)) (* (cdr v0) (car v1)))) 1.0d0 -1.0d0)
2953 (acos (/ (dot v0 v1) (* (norm v0) (norm v1))))
00 (load "package.lisp")
11 (load "bezier.lisp")
2 (load "stringutil.lisp")
23 (in-package :so3-cnc)
34
45 (ql:quickload :alexandria)
89 (ql:quickload :s-http-client)
910
1011 ; width of the work area, in stepper steps
11 (setf *width* 0)
12 (defparameter *width* 0)
1213 ; 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)
1617
1718 ; these are the states that cncserver recognizes
18 (setq *pen-states* '("up" "draw"))
19 (defparameter *pen-states* '("up" "draw"))
1920
2021 (defparameter *cnc-host* "192.168.1.129")
2122 (defun api-url (e) (format nil "http://~a:4242/~a" *cnc-host* e))
2930 (setf *height* (parse-integer (jsown:val max-area "height")))
3031 (send-put-request (api-url "v1/settings/global")
3132 (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)))
3235 settings
3336 ))
3437
6467 (send-put-request (api-url "v1/buffer") (jsown:new-js ("paused" t))))
6568 (defun flush-buffer ()
6669 (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))
7370
7471 (defun gcode-remove-comments (line)
7572 (if (equal (char line 0) #\#) ""
106103 (x 0.0 :type float)
107104 (y 0.0 :type float)
108105 (z "unknown" :type string)
106 (global-translate '(0 . 0))
109107 (dummy-file nil)
110108 )
111109
125123 (reverse (theta-steps-ccw end start)))
126124
127125 (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)))
131133
132134 (defun run-gcode-circle (g x y i j old-x old-y)
133135 (let* ((cx (+ old-x i))
139141 (theta-end (atan (- nj) (- ni)))
140142 (theta-start (atan (- j) (- i)))
141143 )
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)))))
146150 (run-gcode-linear g tx ty)))
147151 (run-gcode-linear g x y))))
148152
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
149159 (defun run-gcode-linear (g x y)
150160 (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))
155164 ))
156165
157166 (defun run-gcode-movement (g old-x old-y)
168177 (send-put-request (api-url "v1/pen") (jsown:new-js ("state" new-state-name)))
169178 )))
170179
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))
174182 (new-state (assoc :Z terms))
175183 (new-x (assoc :X terms))
176184 (new-y (assoc :Y terms))
186194 (unless (null new-j) (setf (gvm-j g) (cdr new-j)))
187195 (run-gcode-movement g old-x old-y)))
188196
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
189211 (defun run-gcode-file-on-gvm (g fname)
190212 (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 ))))
194221
195222 (defun run-gcode-file (file &key (dummy-file nil))
196223 (if (null dummy-file) (run-gcode-file-on-gvm (make-gvm) file)
0 (load "package.lisp")
1 (load "stringutil.lisp")
2
3 (in-package :so3-cnc)
4
5 (ql:quickload :parse-float)
6 (ql:quickload :split-sequence)
7
8 (defun parse-paths-line (l)
9 (let* ((coords-strs (split-sequence:split-sequence #\Space l))
10 (coords (mapcar (lambda (s)
11 (mapcar #'parse-float:parse-float (split-sequence:split-sequence #\Comma s)))
12 coords-strs)))
13 coords
14 ))
0 (load "package.lisp")
1 (in-package :so3-cnc)
2
3 (defun split-by-one-space (string)
4 (loop for i = 0 then (1+ j)
5 as j = (position #\Space string :start i)
6 collect (subseq string i j)
7 while j))
292292 (#\C (let* ((c1 (cons (first args) (second args)))
293293 (c2 (cons (third args) (fourth args)))
294294 (p2 (cons (fifth args) (sixth args)))
295 (svg-poly (push-polyline svgm (loop for theta in (linspace 0 1 0.05)
296 collect (eval-bezier-cubic theta cur-xy c1 c2 p2)))))
295 (svg-poly (push-polyline svgm (linterp-bezier-cubic cur-xy c1 c2 p2))))
297296 (make-svg-machine
298297 :current (svgm-current svg-poly) :last-start (svgm-last-start svg-poly)
299298 :gcode (svgm-gcode svg-poly) :gcode-unxf (svgm-gcode-unxf svg-poly)
307306 ; quadratic beziers
308307 (#\Q (let* ((c (cons (first args) (second args)))
309308 (p2 (cons (third args) (fourth args)))
310 (svg-poly (push-polyline svgm (loop for theta in (linspace 0 1 0.05)
311 collect (eval-bezier-quadratic theta cur-xy c p2)))))
309 (svg-poly (push-polyline svgm (linterp-bezier-quadratic cur-xy c p2))))
312310 (make-svg-machine
313311 :current (svgm-current svg-poly) :last-start (svgm-last-start svg-poly)
314312 :gcode (svgm-gcode svg-poly) :gcode-unxf (svgm-gcode-unxf svg-poly)
412410 (xform-gcode xform (svgm-gcode-unxf svgm)))))
413411
414412 (defun a (attr data)
415 (parse-float:parse-float (cadr (assoc attr (cadr data) :test #'string-equal))))
413 (let ((attr-str (cadr (assoc attr (cadr data) :test #'string-equal))))
414 (if attr-str (parse-float:parse-float attr-str) 0)))
416415
417416 (defun load-unxf-path (svgm data)
418417 (run-stanzas (load-path-data (cadr (assoc "d" (cadr data) :test #'string-equal))) svgm))
499498 )
500499 svgm))
501500
501 (defun svg-load (svgdata)
502 (load-svg-from-xml svgdata (make-svg-machine) (list point-to-mm-xform)))
503
502504 (defun svg-to-gcode (fname gcode-out)
503505 (with-open-file (outf gcode-out :direction :output :if-exists :supersede)
504506 (let* ((svgtxt (alexandria:read-file-into-string fname))
505507 (svgdata (xmls:parse svgtxt)))
506 (svgm-emit-gcode outf (load-svg-from-xml svgdata (make-svg-machine) (list point-to-mm-xform))))))
508 (svgm-emit-gcode outf (svg-load svgdata)))))
507509
508510 (defun svgm-emit-gcode (outstream svgm)
509511 (labels ((gcode-number (n) (if (< (abs (- (round n) n)) 0.001)