git.haldean.org plotter / 01e5e20
field lines piece Haldean Brown 3 years ago
4 changed file(s) with 101 addition(s) and 1 deletion(s). Raw diff Collapse all Expand all
165165 (let ((new-state-name (nth (if (> state 0) 0 1) *pen-states*)))
166166 (unless (or (not (null (gvm-dummy-file g))) (eq new-state-name (gvm-z g)))
167167 (send-put-request (api-url "v1/pen") (jsown:new-js ("state" new-state-name)))
168 (sleep 0.1))))
168 )))
169169
170170 (defun run-gcode-line (line g)
171171 (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)))