(ql:quickload :cl-svg)
(ql:quickload :cl-randist)

(setf w 300)
(setf h 300)
(setf c-x (/ w 2))
(setf c-y (/ h 2))

(setf iso-x-delta 20)
(setf iso-y-delta 6)

(setf bg "#124")
(setf fg "#FF0")

(setf n-x-dots (floor (/ w iso-x-delta)))
(setf n-y-dots (floor (/ h iso-y-delta)))
(setf xdlo (+ 1 (ceiling (- (/ n-x-dots 3)))))
(setf xdhi (floor (/ n-x-dots 3)))
(setf ydlo (+ 2 (ceiling (- (/ n-y-dots 4)))))
(setf ydhi (- (floor (/ n-y-dots 4)) 1))

(defun line (scene p1 p2 ox oy color)
  (let ((x1 (first p1)) (y1 (second p1))
        (x2 (first p2)) (y2 (second p2)))
    (cl-svg:draw
        scene
        (:line :x1 (+ x1 ox) :y1 (+ y1 oy) :x2 (+ x2 ox) :y2 (+ y2 oy))
        :stroke color :stroke-width 1 :stroke-linecap :round)))

(defun line-end (l)
  (let* ((i (caar l))
         (j (cadar l))
         (d (second l))
         (dx (cond
               ((= d 0) 0)
               ((= d 1) 1)
               ((= d 2) 1)
               ((= d 3) 0)
               ((= d 4) -1)
               ((= d 5) -1)))
         (dy (cond
               ((= d 0) -1)
               ((= d 1) 0)
               ((= d 2) 0)
               ((= d 3) 1)
               ((= d 4) 0)
               ((= d 5) 0)
               )))
    (list (+ i dx) (+ j dy))))

(defun gline (scene l &optional (ox 0) (oy 0) (c fg))
  (let* ((le (line-end l))
         (p1 (iso-grid (caar l) (cadar l)))
         (p2 (iso-grid (first le) (second le))))
    (line scene p1 p2 ox oy c)))

(defun dot (scene d)
  (let ((p (iso-grid (first d) (second d))))
    (let ((x (first p)) (y (second p)))
      (cl-svg:draw
          scene
          (:circle :cx x :cy y :r 2.5)
          :stroke fg :stroke-width 1 :fill bg))))

(defun iso-grid (x y)
  (let ((x_ (* iso-x-delta x))
        (y_ (* iso-y-delta (+ (* 2 y) (if (= (mod x 2) 0) 1 0)))))
    (list (+ (/ w 2) x_) (+ (/ h 2) y_))))

(defun dist (p1 p2)
  (sqrt (+ (expt (- (first p1) (first p2)) 2)
           (expt (- (second p1) (second p2)) 2))))

(defun nearest-on-grid (x y)
  (let* ((i (round (/ (- x (/ w 2)) iso-x-delta)))
         (tst (loop for j from ydlo to ydhi
                    collect (list (dist (iso-grid i j) (list x y)) (list i j)))))
    (second (reduce (lambda (a b) (if (< (first a) (first b)) a b)) tst))))

(defun random-point-normal ()
  (let* ((angle (random (* 2 pi)))
         (radius (randist:random-normal-ziggurat (/ (min w h) 3.0d0) 60.0d0)))
    (nearest-on-grid
     (+ c-x (* radius (cos angle)))
     (+ c-y (* radius (sin angle))))))
(defun random-point-uniform ()
  (list (+ xdlo (random (- xdhi xdlo)))
        (+ ydlo (random (- ydhi ydlo)))))
(defun random-point () (random-point-normal))

(defun dedupe (x &optional (accum '()))
  (cond
    ((null x) accum)
    ((member (car x) accum :test #'equal) (dedupe (cdr x) accum))
    (t (dedupe (cdr x) (cons (car x) accum)))
    ))

(defun gen-dots ()
  (dedupe (loop for i from 0 to 200 collect (random-point))))

(defun random-choice (lst) (nth (random (length lst)) lst))

(defun random-line-point (dots lines)
  (let ((line-ends (mapcar #'line-end lines)))
    (cond
      ((and (not (null line-ends)) (< (random 1.0) 0.4)) (random-choice line-ends))
      ((< (random 1.0) 0.7) (random-choice dots))
      (t (random-point))
      )))

(defun gen-lines (dots n attach)
  (dedupe
   (reduce
    (lambda (all ign) (cons (list (random-line-point dots all) (random 6)) all))
    (loop for i from 0 to n collect i)
    :initial-value nil)))

(defun gen (scene &key (use-dots t) (use-lines t))
  (let* ((dots (gen-dots))
         (root (cl-svg:make-group scene () nil)))
    (when use-lines (mapcar (lambda (l) (gline root l)) (gen-lines dots 200 nil)))
    (when use-dots (mapcar (lambda (d) (dot root d)) dots))
    root
    ))

(let ((scene (cl-svg:make-svg-toplevel 'cl-svg:svg-1.1-toplevel :height h :width w)))
  ; draw background
  (cl-svg:draw scene (:rect :x 0 :y 0 :width w :height h) :fill bg)
  (gen scene)
  (with-open-file (s #p"test.svg" :direction :output :if-exists :supersede)
    (cl-svg:stream-out s scene)))