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

(ql:quickload :alexandria)

(defconstant m 11)
(defconstant n 4)
(defconstant tspace 25)
(defconstant tcenter 5.0)
(defconstant tspread 3.5)
(defconstant tdiffmin 0.25)

(defun choose-edge-hlen (existing)
  (let ((new-len (+ tcenter (- (random (* 2.0 tspread)) tspread))))
    (if (< (abs (- existing new-len)) tdiffmin)
        (choose-edge-hlen existing)
        new-len)))

(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))
      ))

(defun random-signed (v)
  (* (random v) (if (= 0 (random 2)) -1 1)))

(defun pick-base (hlen seed)
  (let* ((seed-hlen (* 0.5 (norm (vec- (first seed) (second seed)))))
         (slop (abs (- seed-hlen hlen)))
         (offset (if (< slop 0) 0 (random-signed (float slop))))
         (d (normalize (vec- (second seed) (first seed))))
         (c (vec* 0.5 (vec+ (second seed) (first seed))))
         )
    (vec+ c (vec* offset d))
    ))

(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)
  (if (null s)
      (add-tri (make-state)
               (cons (/ tcenter 2.0) 0)
               (cons (/ tcenter -2.0) 0)
               (cons 0 (- (base-len (/ tcenter 2.0)))))
      (let* ((seed (alexandria:random-elt (state-edges s)))
             (edge-hlen (choose-edge-hlen (* 0.5 (norm (vec- (first seed) (second seed))))))
             (center (pick-base edge-hlen 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 translate-polys (v polys)
  (mapcar (lambda (p) (mapcar (lambda (x) (vec+ x v)) p)) polys))

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

(defun space-fill-z (z) (cons (mod z n) (floor (/ z n))))

(defun make-clusters ()
  (cdr (reduce (lambda (state-poly-pair z)
                 (let* ((old-state (car state-poly-pair))
                        (old-polys (cdr state-poly-pair))
                        (new-state (new-tri old-state))
                        (ij (space-fill-z z))
                        (Tij (cons (* tspace (1+ (car ij))) (* tspace (1+ (cdr ij)))))
                        (new-polys (translate-polys Tij (state-polys new-state)))
                        )
                   (cons new-state (append new-polys old-polys))))
               (loop for z from 0 to (1- (* m n)) collect z)
               :initial-value nil)))

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