git.haldean.org plotter / b6aeb9b tri.lisp
b6aeb9b

Tree @b6aeb9b (Download .tar.gz)

tri.lisp @b6aeb9braw · history · blame

(load "package.lisp")
(load "bezier.lisp")
(load "svg.lisp")

(ql:quickload :alexandria)

(defun choose-edge-hlen () (+ 10.0 (- (random 19.8) 9.9)))
(defun base-len (edge-hlen) (* (tan (* pi (/ 60 180))) edge-hlen))
(defun random-ortho (v)
  "randomly pick and return one of the two unit vectors orthogonal to the given unit vector"
  (if (= 0 (random 2))
      (cons (cdr v) (- (car v)))
      (cons (- (cdr v)) (car v))
      ))

(defstruct state polys edges)

(defun add-tri (s p1 p2 p3)
  (make-state :polys (cons (list p1 p2 p3 p1) (state-polys s))
              :edges (list* (list p1 p2) (list p2 p3) (list p3 p1) (state-edges s))))

(defun new-tri (s)
  (let* ((seed (alexandria:random-elt (state-edges s)))
         (edge-hlen (choose-edge-hlen))
         (center (vec* 0.5 (vec+ (first seed) (second seed))))
         (v (normalize (vec- (second seed) (first seed))))
         (p1 (vec- center (vec* edge-hlen v)))
         (p2 (vec+ center (vec* edge-hlen v)))
         (p3 (vec+ center (vec* (base-len edge-hlen) (random-ortho v))))
        )
    (add-tri s p1 p2 p3)))

(defun base-state (origin)
  (add-tri (make-state)
           (vec- origin '(10 . 0))
           (vec+ origin '(10 . 0))
           (vec+ origin (cons 0 (base-len 10)))))

(defun make-tris (origin)
  (reduce
   (lambda (s ig) (new-tri s))
   (loop for i from 0 to (+ 1 (random 4)) collect i)
   :initial-value (base-state origin)
   ))

(defun make-clusters ()
  (reduce (lambda (polys ij)
            (append polys
                    (state-polys (make-tris (cons (* 70 (1+ (car ij))) (* 70 (1+ (cdr ij))))))))
          (gathering (loop for i from 0 to 4
                           do (loop for j from 0 to 4
                                    do (gather (cons i j)))))
          :initial-value nil))

(defun tri-x.svg() (x.svg (make-clusters)))