diff options
Diffstat (limited to 'static/src/assets/viz/2/viz/core.cljs')
| -rw-r--r-- | static/src/assets/viz/2/viz/core.cljs | 264 |
1 files changed, 264 insertions, 0 deletions
diff --git a/static/src/assets/viz/2/viz/core.cljs b/static/src/assets/viz/2/viz/core.cljs new file mode 100644 index 0000000..caeb386 --- /dev/null +++ b/static/src/assets/viz/2/viz/core.cljs @@ -0,0 +1,264 @@ +(ns viz.core + (:require [quil.core :as q] + [quil.middleware :as m] + [viz.forest :as forest] + [viz.grid :as grid] + [viz.ghost :as ghost] + [viz.dial :as dial] + [goog.string :as gstring] + [goog.string.format] + )) + +(defn- debug [& args] + (.log js/console (clojure.string/join " " (map str args)))) +(defn- observe [v] (debug v) v) + +(defn- positive [n] (if (> 0 n) (- n) n)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; initialization + +(defn- window-partial [k] + (int (aget js/document "documentElement" k))) + +(def window-size + (let [w (int (min 1024 (window-partial "clientWidth")))] + [w (int (min (* w 0.75) (window-partial "clientHeight")))])) + +(def window-half-size (apply vector (map #(float (/ %1 2)) window-size))) + +(defn- set-grid-size [state] + (let [h (int (* (window-size 1) + (float (/ (:grid-width state) (window-size 0)))))] + (assoc state :grid-size [(:grid-width state) h]))) + +(defn- add-ghost [state ghost-def] + (let [[forest id] (forest/add-node (:forest state) (:start-pos ghost-def)) + ghost (-> (ghost/new-ghost) + (ghost/add-active-node id) + (assoc :ghost-def ghost-def)) + ] + (assoc state + :forest forest + :ghosts (cons ghost (:ghosts state))))) + +(defn- new-state [] + (-> {:frame-rate 15 + :color-cycle-period 8 + :tail-length 7 + :frame 0 + :grid-width 45 ; from the center + :forest (forest/new-forest grid/isometric) + } + (set-grid-size) + (add-ghost {:start-pos [-10 -10] + :color-fn (fn [state] + (let [frames-per-color-cycle + (* (:color-cycle-period state) (:frame-rate state))] + (q/color + (/ (mod (:frame state) frames-per-color-cycle) + frames-per-color-cycle) + 1 1))) + }) + )) + +(defn setup [] + (q/color-mode :hsb 1 1 1) + (new-state)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; scaling and unit conversion related + +(defn- curr-second [state] + (float (/ (:frame state) (:frame-rate state)))) + +(defn- scale [grid-size xy] + (map-indexed #(* %2 (float (/ (window-half-size %1) + (grid-size %1)))) xy)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; poss-fn + +(def bounds-buffer 1) + +(defn- in-bounds? [grid-size pos] + (let [[w h] (apply vector (map #(- % bounds-buffer) grid-size))] + (every? + #(and (>= (% 1) (- (% 0))) (<= (% 1) (% 0))) + (map vector [w h] pos)))) + +(defn- dist-from-sqr [pos1 pos2] + (reduce + (map #(* % %) (map - pos1 pos2)))) + +(defn- dist-from [pos1 pos2] + (q/sqrt (dist-from-sqr pos1 pos2))) + +(defn take-adj-poss [grid-width pos adj-poss] + (let [dist-from-center (dist-from [0 0] pos) + width grid-width + dist-ratio (/ (- width dist-from-center) width) + ] + (take + (int (* (q/map-range (rand) 0 1 0.75 1) + dist-ratio + (count adj-poss))) + adj-poss))) + +(defn- mk-poss-fn [state] + (let [grid-size (:grid-size state)] + (fn [pos adj-poss] + (->> adj-poss + (filter #(in-bounds? grid-size %)) + (sort-by #(dist-from-sqr % [0 0])) + (take-adj-poss (grid-size 0) pos))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; update + +(defn- update-ghost-forest [state update-fn] + (let [[ghosts forest] + (reduce (fn [[ghosts forest] ghost] + (let [[ghost forest] (update-fn ghost forest)] + [(cons ghost ghosts) forest])) + [nil (:forest state)] + (:ghosts state))] + (assoc state :ghosts (reverse ghosts) :forest forest))) + +(defn- ghost-incr [state poss-fn] + (update-ghost-forest state #(ghost/incr %1 %2 poss-fn))) + +(defn rm-nodes [state node-ids] + (update-ghost-forest state (fn [ghost forest] + [(reduce ghost/rm-active-node ghost node-ids) + (reduce forest/remove-node forest node-ids)]))) + +(defn- maybe-remove-roots [state] + (if (>= (:tail-length state) (:frame state)) + state + (rm-nodes state (map :id (forest/roots (:forest state)))))) + +(defn- ghost-set-color [state] + (update-ghost-forest state (fn [ghost forest] + (let [color ((get-in ghost [:ghost-def :color-fn]) state)] + [(assoc ghost :color color) forest])))) + +(defn update-state [state] + (let [poss-fn (mk-poss-fn state)] + (-> state + (ghost-set-color) + (ghost-incr poss-fn) + (maybe-remove-roots) + (update-in [:frame] inc) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; draw + +(defn- draw-ellipse [pos size scale-fn] ; size is [w h] + (let [scaled-pos (scale-fn pos) + scaled-size (map int (scale-fn size))] + (apply q/ellipse (concat scaled-pos scaled-size)))) + +(defn- in-line? [& nodes] + (apply = (map #(apply map - %1) + (partition 2 1 (map :pos nodes))))) + +(defn- draw-node [node active? scale-fn] + (let [pos (:pos node) + stroke (get-in node [:meta :color]) + fill (if active? stroke 0xFFFFFFFF) + ] + (q/stroke stroke) + (q/fill fill) + (draw-ellipse pos [0.30 0.30] scale-fn))) + +(defn- draw-line [node parent scale-fn] + (let [node-color (get-in node [:meta :color]) + parent-color (get-in node [:meta :color]) + color (q/lerp-color node-color parent-color 0.5) + ] + (q/stroke color) + (q/stroke-weight 1) + (apply q/line (map scale-fn (map :pos (list parent node)))))) + +(defn- draw-lines [forest parent node scale-fn] + "Draws the lines of all children leading from the node, recursively" + (let [children (map #(forest/get-node forest %) (:child-ids node))] + + (if-not parent + (doseq [child children] (draw-lines forest node child scale-fn)) + (let [in-line-child (some #(if (in-line? parent node %) %) children) + ] + (doseq [child children] + (if (and in-line-child (= in-line-child child)) + (draw-lines forest parent child scale-fn) + (draw-lines forest node child scale-fn))) + (when-not in-line-child + (draw-line node parent scale-fn)) + )) + + ; we also take the opportunity to draw the leaves + (when (empty? children) + (draw-node node false scale-fn)) + )) + +(defn draw-dial [state dial posL posR] + (let [dial-norm (q/norm (:val dial) (:min dial) (:max dial)) + dial-pos (map #(q/lerp %1 %2 dial-norm) posL posR)] + (q/stroke 0xFF000000) + (q/stroke-weight 1) + (q/fill 0xFF000000) + (apply q/line (concat posL posR)) + (apply q/ellipse (concat dial-pos [5 5])) + )) + +(defn draw-state [state] + ; Clear the sketch by filling it with light-grey color. + (q/background 0xFFFFFFFF) + (q/with-translation window-half-size + + (let [grid-size (:grid-size state) + scale-fn #(scale grid-size %) + ghost (:ghost state) + forest (:forest state) + roots (forest/roots forest) + ] + + (doseq [root roots] + (draw-lines forest nil root scale-fn)) + + (doseq [ghost (:ghosts state)] + (doseq [active-node (map #(forest/get-node forest %) + (:active-node-ids ghost))] + (draw-node active-node true scale-fn))) + + )) + + ;(draw-dial state (:dial state) [30 30] [100 30]) + + ;(q/text (clojure.string/join + ; "\n" + ; (list + ; (gstring/format "frame:%d" (:frame state)) + ; (gstring/format "second:%f" (curr-second state)) + ; (gstring/format "spawn-chance:%d" (spawn-chance state)))) + ; 30 30) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; def + +(q/defsketch viz + :title "" + :host "viz" + :size window-size + ; setup function called only once, during sketch initialization. + :setup setup + ; update-state is called on each iteration before draw-state. + :update update-state + :draw draw-state + :features [:keep-on-top] + ; This sketch uses functional-mode middleware. + ; Check quil wiki for more info about middlewares and particularly + ; fun-mode. + :middleware [m/fun-mode]) |