[WIP] Begin implementing drawing the tree
This commit is contained in:
parent
9155083cad
commit
d739f75316
@ -8,7 +8,7 @@
|
||||
|
||||
;; 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
|
||||
;; A segment has an x1, y1, x2, y2
|
||||
;; 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
|
||||
@ -61,49 +61,6 @@
|
||||
: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
|
||||
@ -124,59 +81,37 @@
|
||||
: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})
|
||||
]
|
||||
:l-system l-system})]
|
||||
{:tree tree
|
||||
;; :to-draw lines
|
||||
;; :drawing []
|
||||
}))
|
||||
:current-branches [{:branch tree
|
||||
:i 0}]
|
||||
:drawn-branches []
|
||||
:to-draw []
|
||||
:drawing []
|
||||
:drawn []}))
|
||||
|
||||
(defn old-update-state [{:keys [to-draw drawing] :as state}]
|
||||
(let [batch-size 10]
|
||||
(if (> (count to-draw) 0)
|
||||
(defn update-state [state]
|
||||
(let [drawn (concat (mapcat :segments (:drawn-branches state))
|
||||
(mapcat #(let [i (:i %)
|
||||
segs (get-in % [:branch :segments])]
|
||||
(subvec segs i))
|
||||
(:current-branches state)))]
|
||||
(assoc state
|
||||
:to-draw (vec (drop batch-size to-draw))
|
||||
:drawing (vec (concat drawing (take batch-size to-draw))))
|
||||
state)))
|
||||
:drawn drawn)))
|
||||
|
||||
(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)))
|
||||
{:drawing [{:x1 10 :y1 15 :x2 20 :y2 25 :lerp 0.4}]
|
||||
:drawn []
|
||||
:to-draw []}
|
||||
|
||||
(defn old-draw [{:keys [to-draw drawing]}]
|
||||
(defn draw [{:keys [drawing drawn to-draw]}]
|
||||
(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)))
|
||||
(doseq [{:keys [x1 y1 x2 y2]} drawn]
|
||||
(q/line x1 y1 x2 y2))
|
||||
(doseq [{:keys [x1 y1 x2 y2 lerp]} drawing]
|
||||
(let [x2 (q/lerp x1 x2 lerp)
|
||||
y2 (q/lerp y1 y2 lerp)]
|
||||
(q/line x1 y1 x2 y2))))
|
||||
|
||||
(defn sketch
|
||||
[{:keys [host size]}]
|
||||
@ -185,5 +120,5 @@
|
||||
:middleware [m/fun-mode]
|
||||
:size size
|
||||
:setup setup
|
||||
;; :update update-state
|
||||
:update update-state
|
||||
:draw draw))
|
||||
|
Loading…
Reference in New Issue
Block a user