Commit fe1d7f37e8109d96eacdc3af16304a21935384e1 - plotter

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

+24

-0

bezier.lisp less more

24	24	(defun eval-bezier-quadratic (theta p0 p1 p2)
25	25	(eval-bezier theta (list p0 p1 p2)))
26	26
	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
27	51	(defun angle-between (v0 v1)
28	52	(* (if (< 0 (- (* (car v0) (cdr v1)) (* (cdr v0) (car v1)))) 1.0d0 -1.0d0)
29	53	(acos (/ (dot v0 v1) (* (norm v0) (norm v1))))

+55

-28

cnc.lisp less more

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)

+15

-0

plotpaths.lisp less more

	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

stringutil.lisp less more

	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))

-6

svgcam.lisp less more

292	292	(#\C (let* ((c1 (cons (first args) (second args)))
293	293	(c2 (cons (third args) (fourth args)))
294	294	(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))))
297	296	(make-svg-machine
298	297	:current (svgm-current svg-poly) :last-start (svgm-last-start svg-poly)
299	298	:gcode (svgm-gcode svg-poly) :gcode-unxf (svgm-gcode-unxf svg-poly)

307	306	; quadratic beziers
308	307	(#\Q (let* ((c (cons (first args) (second args)))
309	308	(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))))
312	310	(make-svg-machine
313	311	:current (svgm-current svg-poly) :last-start (svgm-last-start svg-poly)
314	312	:gcode (svgm-gcode svg-poly) :gcode-unxf (svgm-gcode-unxf svg-poly)

412	410	(xform-gcode xform (svgm-gcode-unxf svgm)))))
413	411
414	412	(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)))
416	415
417	416	(defun load-unxf-path (svgm data)
418	417	(run-stanzas (load-path-data (cadr (assoc "d" (cadr data) :test #'string-equal))) svgm))

499	498	)
500	499	svgm))
501	500
	501	(defun svg-load (svgdata)
	502	(load-svg-from-xml svgdata (make-svg-machine) (list point-to-mm-xform)))
	503
502	504	(defun svg-to-gcode (fname gcode-out)
503	505	(with-open-file (outf gcode-out :direction :output :if-exists :supersede)
504	506	(let* ((svgtxt (alexandria:read-file-into-string fname))
505	507	(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)))))
507	509
508	510	(defun svgm-emit-gcode (outstream svgm)
509	511	(labels ((gcode-number (n) (if (< (abs (- (round n) n)) 0.001)