From ffc4bff955b119b1238042cff4aaa43d37d16044 Mon Sep 17 00:00:00 2001
From: arne <noreply@null.arnes.space>
Date: Sun, 18 Dec 2022 12:15:06 +0100
Subject: [PATCH] First working implementation of
 https://inconvergent.net/generative/hyphae/ :)

---
 src/aphorisms/thirty_four.clj | 108 ++++++++++++++++++++++++++++++++++
 1 file changed, 108 insertions(+)
 create mode 100644 src/aphorisms/thirty_four.clj

diff --git a/src/aphorisms/thirty_four.clj b/src/aphorisms/thirty_four.clj
new file mode 100644
index 0000000..8ed76d6
--- /dev/null
+++ b/src/aphorisms/thirty_four.clj
@@ -0,0 +1,108 @@
+(ns aphorisms.thirty-four
+  (:require [quil.core :as q]
+            [quil.middleware :as qm]
+            [thi.ng.geom.rect :as r]
+            [thi.ng.geom.core :as g]
+            [thi.ng.geom.circle :as c]
+            [thi.ng.geom.spatialtree :as st]
+            [thi.ng.math.core :as m]))
+
+;; attempt to implement the hyphae algorithm described in
+;; https://inconvergent.net/generative/hyphae/
+
+(def bounds (r/rect 750 500))
+(def canvas (g/scale bounds 0.92))
+
+;; parameters to influence how the end result looks
+
+(def start-size 12.0)
+(def min-size 8.0)
+(def shrink 0.8)         ;; factor by which size decreases at each step
+(def spaciousness 2.0)   ;; size of neighbor-check for each node
+
+(def max-path-length 50) ;; how long are the strings of nodes?
+(def num-paths 25)       ;; how many strings should be generated max?
+
+;; all nodes look like this: {:shape circ, :direction vec2}
+
+(defn empty-neighborhood? [quadtree node]
+  (empty? (st/select-with-shape quadtree (g/scale-size (:shape node) spaciousness))))
+
+(defn nice-place? [quadtree node]
+  (and (g/contains-point? (g/scale-size bounds 0.8) (-> node :shape :p))
+       (empty-neighborhood? quadtree node)))
+
+(defn wobble [v]
+  (g/rotate v (m/radians (m/random -20 20))))
+
+(defn pick-start [quadtree]
+  (->> (repeatedly 10 (fn []
+                        (let [pt (g/random-point-inside (g/scale-size bounds 0.5))
+                              dir (wobble (m/normalize (m/- (g/centroid bounds) pt)))]
+                          {:shape (c/circle pt start-size)
+                           :direction dir})))
+       (filter #(nice-place? quadtree (update % :shape (fn [circ]
+                                                         (g/scale-size circ 1.5)))))
+       (first)))
+
+(defn next-node [quadtree cur]
+  (->> (repeatedly 10 (fn []
+                        (-> (update cur :shape (fn [c]
+                                                 (-> (update c :r #(Math/max (* % shrink) min-size))
+                                                     (update :p #(g/translate % (m/* (:direction cur) (:r c)))))))
+                            (update :direction wobble))))
+       (filter (fn [node]
+                 (when-not (nice-place? quadtree node)
+                   (prn node))
+                 (nice-place? quadtree node)))
+       (first)))
+
+
+;; let's generate different paths of hyphae, each a most 50 nodes long
+
+(defn make-path [quadtree]
+  (when-let [seed (pick-start quadtree)]
+    (->>
+     (iterate (fn [[head & _ :as path]]
+                (if-let [next (next-node quadtree head)]
+                  (conj path next)
+                  path))
+              (list seed))
+     (partition 2)
+     (filter (fn [[a b]] (= a b)))
+     (ffirst))))
+
+(def paths
+  (let [qt (st/quadtree bounds)]
+   (for [_ (range num-paths)
+         :let [path (make-path qt)]]
+     (do
+       (reduce #(g/add-point %1 (-> %2 :shape :p) %2) qt path) ;; add-point is mutable
+       path))))
+
+(defn setup []
+  (q/ellipse-mode :center)
+  (q/rect-mode :corners)
+  (q/color-mode :hsb 255)
+  {})
+
+(defn draw-state [_]
+  (q/background 255)
+  (q/no-fill)
+
+  (doseq [path paths
+          {{[x y] :p r :r} :shape} path]
+    (q/ellipse x y r r))
+  #_(qd/draw-scene! scene))
+
+(when-not (resolve 'thirty-four)
+  #_:clj-kondo/ignore
+  (q/defsketch thirty-four
+    :title "Thirty-Four"
+    :size (:size bounds)
+    :settings #(q/pixel-density (q/display-density))
+    :features [:keep-on-top]
+    :setup setup
+    :update identity
+    :draw draw-state
+    :middleware [qm/pause-on-error #_(screenshottable) qm/fun-mode]))