field lines piece
Haldean Brown
4 years ago
| 165 | 165 |
(let ((new-state-name (nth (if (> state 0) 0 1) *pen-states*)))
|
| 166 | 166 |
(unless (or (not (null (gvm-dummy-file g))) (eq new-state-name (gvm-z g)))
|
| 167 | 167 |
(send-put-request (api-url "v1/pen") (jsown:new-js ("state" new-state-name)))
|
| 168 | |
(sleep 0.1))))
|
|
168 |
)))
|
| 169 | 169 |
|
| 170 | 170 |
(defun run-gcode-line (line g)
|
| 171 | 171 |
(let* ((terms (gcode-assign-parse line))
|
|
0 |
(load "package.lisp")
|
|
1 |
(load "svg.lisp")
|
|
2 |
(in-package :so3-cnc)
|
|
3 |
|
|
4 |
(defun L (i j)
|
|
5 |
(let* ((x (* (1+ i) 3))
|
|
6 |
(y (* (1+ j) 3))
|
|
7 |
(theta (* pi (/ (+ j) n) (+ 1 (expt (/ i 174) 0.8))))
|
|
8 |
(dx (* 1.0 (sin theta)))
|
|
9 |
(dy (* 1.0 (cos theta))))
|
|
10 |
(list (cons (- x dx) (- y dy)) (cons (+ x dx) (+ y dy)))
|
|
11 |
))
|
|
12 |
|
|
13 |
(defun Ls ()
|
|
14 |
(gathering
|
|
15 |
(loop for i from 0 to n
|
|
16 |
do (loop for j from 0 to n do (gather (L i j))))))
|
|
17 |
|
|
18 |
(defun ill-x.svg () (x.svg (Ls)))
|
|
0 |
(ql:quickload :alexandria)
|
|
1 |
(in-package :so3-cnc)
|
|
2 |
|
|
3 |
(defmacro gathering (&body body)
|
|
4 |
"Run `body` to gather some things and return a fresh list of them.
|
|
5 |
|
|
6 |
`body` will be executed with the symbol `gather` bound to a
|
|
7 |
function of one argument. Once `body` has finished, a list of
|
|
8 |
everything `gather` was called on will be returned.
|
|
9 |
|
|
10 |
It's handy for pulling results out of code that executes
|
|
11 |
procedurally and doesn't return anything, like `maphash` or
|
|
12 |
Alexandria's `map-permutations`.
|
|
13 |
|
|
14 |
The `gather` function can be passed to other functions, but should
|
|
15 |
not be retained once the `gathering` form has returned (it would
|
|
16 |
be useless to do so anyway).
|
|
17 |
|
|
18 |
Examples:
|
|
19 |
|
|
20 |
(gathering
|
|
21 |
(dotimes (i 5)
|
|
22 |
(gather i))
|
|
23 |
=>
|
|
24 |
(0 1 2 3 4)
|
|
25 |
|
|
26 |
(gathering
|
|
27 |
(mapc #'gather '(1 2 3))
|
|
28 |
(mapc #'gather '(a b)))
|
|
29 |
=>
|
|
30 |
(1 2 3 a b)
|
|
31 |
|
|
32 |
"
|
|
33 |
(alexandria:with-gensyms (result)
|
|
34 |
`(let ((,result nil))
|
|
35 |
(flet ((gather (item)
|
|
36 |
(push item ,result)
|
|
37 |
item))
|
|
38 |
,@body)
|
|
39 |
(nreverse ,result))))
|
|
40 |
|
|
0 |
(load "package.lisp")
|
|
1 |
(load "gathering.lisp")
|
|
2 |
(in-package :so3-cnc)
|
|
3 |
|
|
4 |
(defparameter *svg-head*
|
|
5 |
'(
|
|
6 |
"<?xml version=\"1.0\" standalone=\"no\"?>"
|
|
7 |
"<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">"
|
|
8 |
))
|
|
9 |
(defparameter *svg-style*
|
|
10 |
'(
|
|
11 |
"<style>"
|
|
12 |
"svg { background: #EEE; }"
|
|
13 |
"* { fill:none; stroke:#000; stroke-width:0.3; }"
|
|
14 |
"</style>"
|
|
15 |
))
|
|
16 |
(defparameter *svg-tail* '("</svg>"))
|
|
17 |
(defparameter n 66)
|
|
18 |
|
|
19 |
(defun write-svg (polys stream w h)
|
|
20 |
(flet ((write-list (lst) (mapcar (lambda (l) (format stream l)) lst))
|
|
21 |
(write-poly (poly) (progn
|
|
22 |
(format stream "<polygon points=\"")
|
|
23 |
(dolist (p poly) (format stream "~,2F ~,2F " (car p) (cdr p)))
|
|
24 |
(format stream "\"/>")
|
|
25 |
)))
|
|
26 |
(progn
|
|
27 |
(write-list *svg-head*)
|
|
28 |
(format stream
|
|
29 |
"<svg viewBox=\"0 0 ~,2F ~,2F\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">"
|
|
30 |
w h)
|
|
31 |
(write-list *svg-style*)
|
|
32 |
(mapcar #'write-poly polys)
|
|
33 |
(write-list *svg-tail*)
|
|
34 |
nil
|
|
35 |
)))
|
|
36 |
|
|
37 |
(defun x.svg (polys)
|
|
38 |
(with-open-file (x "x.svg" :direction :output :if-exists :supersede)
|
|
39 |
(write-svg polys x 210 210)))
|