make a command-line runner
haldean
4 years ago
1 | 1 | (:use :common-lisp) |
2 | 2 | (:export |
3 | 3 | :init |
4 | :get-pen | |
5 | :set-pen-rel | |
6 | :set-pen-abs | |
7 | 4 | :disable-motors |
8 | 5 | :set-zero |
9 | :center-x | |
10 | :center-y | |
11 | :rel-x | |
12 | :rel-y | |
13 | :abs-x | |
14 | :abs-y | |
15 | :draw-circle | |
16 | :start-buffer | |
17 | :flush-buffer)) | |
6 | :run-gcode-file)) | |
18 | 7 | |
19 | 8 | (in-package :so3-cnc) |
20 | 9 | |
28 | 17 | |
29 | 18 | (setf *width* 0) |
30 | 19 | (setf *height* 0) |
20 | (setf *units-per-mm* 50) | |
31 | 21 | (setq *pen-states* '("up" "draw")) |
32 | 22 | |
33 | 23 | (defun api-url (e) (format nil "http://saito:4242/~a" e)) |
44 | 34 | settings |
45 | 35 | )) |
46 | 36 | |
47 | (defun center-x () (when (= *width* 0) (init)) (/ *width* 2)) | |
48 | (defun center-y () (when (= *width* 0) (init)) (/ *height* 2)) | |
49 | 37 | (defun rel-x (x) (when (= *width* 0) (init)) (* 100 (/ x *width*))) |
50 | 38 | (defun rel-y (y) (when (= *width* 0) (init)) (* 100 (/ y *height*))) |
51 | 39 | (defun abs-x (x) (when (= *width* 0) (init)) (/ (* x *width*) 100)) |
52 | 40 | (defun abs-y (y) (when (= *width* 0) (init)) (/ (* y *height*) 100)) |
53 | 41 | |
54 | 42 | (defun get-pen-raw () (cdr (jsown:parse (s-http-client:do-http-request (api-url "v1/pen"))))) |
55 | ||
56 | 43 | (defun get-pen () |
57 | 44 | (let* ((pen-data (get-pen-raw)) |
58 | 45 | (extract-xyz |
68 | 55 | (defun set-pen-rel (x y z &key (wait-time 0)) |
69 | 56 | (send-put-request (api-url "v1/pen") (jsown:new-js ("state" (nth z *pen-states*)))) |
70 | 57 | (send-put-request (api-url "v1/pen") (jsown:new-js ("x" x) ("y" y)))) |
71 | (defun set-pen-abs (x y z &key (wait-time 0)) (set-pen-rel (rel-x x) (rel-y y) z :wait-time wait-time)) | |
72 | 58 | |
73 | 59 | (defun disable-motors () |
74 | 60 | (s-http-client:do-http-request (api-url "v1/motors") :method :DELETE)) |
75 | 61 | |
76 | 62 | (defun set-zero () |
77 | 63 | (send-put-request (api-url "v1/motors") (jsown:new-js ("reset" 1)))) |
78 | ||
79 | (defun draw-circle (cx cy r &key (seg 30)) | |
80 | (set-pen-abs cx (+ cy r) 0) | |
81 | (set-pen-abs cx (+ cy r) 1) | |
82 | (loop for theta from 0 to tau by (/ tau seg) | |
83 | do (let ((x (+ cx (* r (sin theta)))) | |
84 | (y (+ cy (* r (cos theta))))) | |
85 | (set-pen-abs x y 1))) | |
86 | (set-pen-abs cx (+ cy r) 1) | |
87 | ) | |
88 | 64 | |
89 | 65 | (defun start-buffer () |
90 | 66 | (send-put-request (api-url "v1/buffer") (jsown:new-js ("paused" t)))) |
134 | 110 | (z "unknown" :type string) |
135 | 111 | (dummy-file nil) |
136 | 112 | ) |
137 | ||
138 | (setf *units-per-mm* 50) | |
139 | 113 | |
140 | 114 | (defun x-from-gcode (x-mm) (- 100 (rel-x (* x-mm *units-per-mm*)))) |
141 | 115 | (defun y-from-gcode (y-mm) (rel-y (* y-mm *units-per-mm*))) |