190 lines
8.0 KiB
Clojure
190 lines
8.0 KiB
Clojure
(ns jeremy-website.sketches.tree
|
|
(:require [jeremy-website.l-system :as l-system :include-macros true]
|
|
[quil.core :as q]
|
|
[quil.middleware :as m]))
|
|
|
|
(defn degrees->radians [deg]
|
|
(* deg (/ js/Math.PI 180)))
|
|
|
|
;; The tree branch object
|
|
;; A branch has a coordinate, a list of segments and a map of child branches
|
|
;; A segment has an angle and a length
|
|
;; The child branch map's keys are the segment index at which the
|
|
;; child branch originates, and the values are the child branch itself
|
|
(defn l-system-tree
|
|
[{:keys [segment-length initial-angle initial-x initial-y l-system]}]
|
|
(let [make-tree
|
|
(fn make-tree [segment-length x y angle symbols branch idx]
|
|
(let [[symbol & rest-symbols] symbols]
|
|
(condp = symbol
|
|
nil [branch rest-symbols]
|
|
"F" (let [new-x (+ x (* segment-length
|
|
(js/Math.cos (degrees->radians angle))))
|
|
new-y (+ y (* (- segment-length)
|
|
(js/Math.sin (degrees->radians angle))))
|
|
branch (assoc branch
|
|
:segments
|
|
(conj (:segments branch)
|
|
{:x1 x
|
|
:y1 y
|
|
:x2 new-x
|
|
:y2 new-y}))]
|
|
(recur segment-length new-x new-y angle rest-symbols branch (inc idx)))
|
|
"+" (recur segment-length x y (+ angle 25) rest-symbols branch idx)
|
|
"-" (recur segment-length x y (- angle 25) rest-symbols branch idx)
|
|
"*" (recur segment-length x y (+ angle 20) rest-symbols branch idx)
|
|
"/" (recur segment-length x y (- angle 20) rest-symbols branch idx)
|
|
">" (recur segment-length x y (+ angle 15) rest-symbols branch idx)
|
|
"<" (recur segment-length x y (- angle 15) rest-symbols branch idx)
|
|
"[" (let [[new-branch rest-symbols] (make-tree segment-length
|
|
x
|
|
y
|
|
angle
|
|
rest-symbols
|
|
{:x x
|
|
:y y
|
|
:segments []
|
|
:children {}}
|
|
0)
|
|
branch (assoc-in branch [:children idx] new-branch)]
|
|
(recur segment-length x y angle rest-symbols branch idx))
|
|
"]" [branch rest-symbols] ;; stop processing current branch and pop to parent call
|
|
(recur segment-length x y angle rest-symbols branch idx))))]
|
|
(first (make-tree segment-length
|
|
initial-x
|
|
initial-y
|
|
initial-angle
|
|
(:state l-system)
|
|
{:x initial-x
|
|
:y initial-y
|
|
:segments []
|
|
:children {}}
|
|
0))))
|
|
|
|
(defn l-system-lines
|
|
[{:keys [segment-length initial-angle initial-x initial-y l-system]}]
|
|
(vec
|
|
(:lines
|
|
(reduce
|
|
(fn [{:keys [x y angle angle-stack position-stack depth lines] :as state}
|
|
symbol]
|
|
(condp = symbol
|
|
"F" (let [new-x (+ x (* segment-length
|
|
(js/Math.cos (degrees->radians angle))))
|
|
new-y (+ y (* (- segment-length)
|
|
(js/Math.sin (degrees->radians angle))))
|
|
line {:x1 x :y1 y :x2 new-x :y2 new-y}]
|
|
(assoc state
|
|
:x new-x
|
|
:y new-y
|
|
:lines (conj lines (assoc line :depth depth))))
|
|
"+" (assoc state :angle (+ angle 25))
|
|
"-" (assoc state :angle (- angle 25))
|
|
"*" (assoc state :angle (+ angle 20))
|
|
"/" (assoc state :angle (- angle 20))
|
|
">" (assoc state :angle (+ angle 15))
|
|
"<" (assoc state :angle (- angle 15))
|
|
"[" (assoc state
|
|
:angle-stack (conj angle-stack angle)
|
|
:position-stack (conj position-stack [x y])
|
|
:depth (inc depth))
|
|
"]" (assoc state
|
|
:angle (peek angle-stack)
|
|
:angle-stack (pop angle-stack)
|
|
:x (first (peek position-stack))
|
|
:y (second (peek position-stack))
|
|
:position-stack (pop position-stack)
|
|
:depth (dec depth))
|
|
state))
|
|
{:angle initial-angle
|
|
:angle-stack [initial-angle]
|
|
:x initial-x
|
|
:y initial-y
|
|
:position-stack [[initial-x initial-y]]
|
|
:depth 0
|
|
:lines []}
|
|
(:state l-system)))))
|
|
|
|
(defn setup []
|
|
;; Hue goes from 0-360, saturation/brightness from 0-100
|
|
(q/color-mode :hsb 360 100 100)
|
|
(q/frame-rate 60)
|
|
(q/random-seed (or (-> (js/URLSearchParams. js/window.location.search)
|
|
(.get "seed"))
|
|
(.now js/Date)))
|
|
(let [l-system (-> (l-system/instantiate {:axiom "X"
|
|
:rules (l-system/rules
|
|
"X(0.4)" -> "F+[[X]-X]-F[-FX]+X"
|
|
"X(0.4)" -> "F*[[X]/X]/F[/FX]*X"
|
|
"X(0.2)" -> "F>[[X]<X]<F[<FX]>X"
|
|
"F" -> "FF")
|
|
:random-fn (partial q/random 1)})
|
|
((apply comp (repeat 6 l-system/step))))
|
|
tree (l-system-tree {:initial-angle (- 90 25)
|
|
:segment-length 6
|
|
:initial-x (* (q/width) 0.1)
|
|
:initial-y (* (q/height) 0.95)
|
|
:l-system l-system})
|
|
;; lines (l-system-lines {:initial-angle (- 90 25)
|
|
;; :segment-length 6
|
|
;; :initial-x (* (q/width) 0.1)
|
|
;; :initial-y (* (q/height) 0.95)
|
|
;; :l-system l-system})
|
|
]
|
|
{:tree tree
|
|
;; :to-draw lines
|
|
;; :drawing []
|
|
}))
|
|
|
|
(defn old-update-state [{:keys [to-draw drawing] :as state}]
|
|
(let [batch-size 10]
|
|
(if (> (count to-draw) 0)
|
|
(assoc state
|
|
:to-draw (vec (drop batch-size to-draw))
|
|
:drawing (vec (concat drawing (take batch-size to-draw))))
|
|
state)))
|
|
|
|
(defn dedupe-lines [lines]
|
|
(:lines
|
|
(reduce (fn [{:keys [lines already-seen] :as state} line]
|
|
(if-not (contains? already-seen ((juxt :x1 :y1 :x2 :y2) line))
|
|
(assoc state
|
|
:already-seen (conj already-seen ((juxt :x1 :y1 :x2 :y2) line))
|
|
:lines (conj lines line))
|
|
state))
|
|
{:lines []
|
|
:already-seen #{}}
|
|
lines)))
|
|
|
|
(defn old-draw [{:keys [to-draw drawing]}]
|
|
(q/background 0 0 100)
|
|
(q/fill 0 0 0)
|
|
(let [lines (dedupe-lines drawing)]
|
|
(doseq [line lines]
|
|
(q/stroke-weight (- 1.75 (* 0.1 (:depth line))))
|
|
(q/stroke 240 0 (+ 65 (* 2 (:depth line))))
|
|
(apply q/line ((juxt :x1 :y1 :x2 :y2) line))))
|
|
(when (= (count to-draw) 0)
|
|
(q/no-loop)))
|
|
|
|
(defn draw [{:keys [tree]}]
|
|
(q/background 0 0 100)
|
|
(let [draw-tree
|
|
(fn draw-tree [branch]
|
|
(doseq [segment (:segments branch)]
|
|
(q/line (:x1 segment) (:y1 segment) (:x2 segment) (:y2 segment)))
|
|
(doseq [child (vals (:children branch))]
|
|
(draw-tree child)))]
|
|
(draw-tree tree)
|
|
(q/no-loop)))
|
|
|
|
(defn sketch
|
|
[{:keys [host size]}]
|
|
(q/sketch
|
|
:host host
|
|
:middleware [m/fun-mode]
|
|
:size size
|
|
:setup setup
|
|
;; :update update-state
|
|
:draw draw))
|