git.haldean.org plotter / 8d30a01
more tri stuff haldean 1 year, 6 months ago
2 changed file(s) with 33 addition(s) and 12 deletion(s). Raw diff Collapse all Expand all
55 '(
66 "<?xml version=\"1.0\" standalone=\"no\"?>"
77 "<!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 '(
8 "<svg version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">"
119 "<style>"
1210 "svg { background: #EEE; }"
1311 "* { fill:none; stroke:#000; stroke-width:0.3; }"
1614 (defparameter *svg-tail* '("</svg>"))
1715 (defparameter n 66)
1816
19 (defun write-svg (polys stream w h)
17 (defun write-svg (polys stream)
2018 (flet ((write-list (lst) (mapcar (lambda (l) (format stream l)) lst))
2119 (write-poly (poly) (progn
2220 (format stream "<polygon points=\"")
2523 )))
2624 (progn
2725 (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*)
3226 (mapcar #'write-poly polys)
3327 (write-list *svg-tail*)
3428 nil
3630
3731 (defun x.svg (polys)
3832 (with-open-file (x "x.svg" :direction :output :if-exists :supersede)
39 (write-svg polys x 210 210)))
33 (write-svg polys x)))
33
44 (ql:quickload :alexandria)
55
6 (defun add-edge (edges)
7 (let* ((seed (alexandria:random-elt edges))
6 (defun choose-edge-hlen () 1.0)
7 (defun base-len (edge-hlen) (* (tan (* pi (/ 60 180))) edge-hlen))
8 (defun random-ortho (v)
9 "randomly pick and return one of the two unit vectors orthogonal to the given unit vector"
10 (if (= 0 (random 2))
11 (cons (cdr v) (- (car v)))
12 (cons (- (cdr v)) (car v))
13 ))
14
15 (defstruct state polys edges)
16
17 (defun add-tri (s p1 p2 p3)
18 (make-state :polys (cons (list p1 p2 p3 p1) (state-polys s))
19 :edges (list* (list p1 p2) (list p2 p3) (list p3 p1) (state-edges s))))
20
21 (defun new-tri (s)
22 (let* ((seed (alexandria:random-elt (state-edges s)))
823 (edge-hlen (choose-edge-hlen))
924 (center (vec* 0.5 (vec+ (first seed) (second seed))))
1025 (v (normalize (vec- (second seed) (first seed))))
1126 (p1 (vec- center (vec* edge-hlen v)))
1227 (p2 (vec+ center (vec* edge-hlen v)))
28 (p3 (vec+ center (vec* (base-len edge-hlen) (random-ortho v))))
1329 )
30 (add-tri s p1 p2 p3)))
1431
15 ))
32 (defun base-state ()
33 (add-tri (make-state) '(-0.5 . 0) '(0.5 . 0) (cons 0 (base-len 0.5))))
34
35 (defun make-tris ()
36 (reduce
37 (lambda (s ig) (new-tri s))
38 (loop for i from 0 to 10 collect i)
39 :initial-value (base-state)
40 ))
41
42 (defun tri-x.svg() (x.svg (state-polys (make-tris))))