heyarne.aphorisms/src/aphorisms/thirty_four.clj

120 lines
4 KiB
Clojure

(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 7.0)
(def min-size 4.0)
(def shrink 0.8) ;; factor by which size decreases at each step
(def spaciousness 2.5) ;; size of neighbor-check for each node
(def max-path-length 30) ;; how long are the strings of nodes?
(def num-paths 45) ;; 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 path]
(let [cur (peek path)]
(->> (repeatedly 10 (fn []
(-> (update cur :shape (fn [c]
(-> (update c :r #(Math/max (* % shrink) min-size))
(update :p #(g/translate % (m/* (:direction cur) (* 2 (:r c))))))))
(update :direction wobble))))
(filter (fn [node]
(and (nice-place? quadtree node)
;; avoid self-intersections
(every? (fn [other]
;; (prn other)
;; (prn (g/dist (-> node :shape :p) (-> other :shape :p)))
;; (prn )
(>= (g/dist (-> node :shape :p) (-> other :shape :p))
(* 0.99 (+ (-> node :shape :r) (-> other :shape :r))))) path)))) ;; floating point errors?
(first))))
(comment
(make-path (st/quadtree bounds))
)
;; let's generate different paths of hyphae, each at most `max-path-length` nodes long
(defn make-path [quadtree]
(when-let [seed (pick-start quadtree)]
(->>
(iterate (fn [path]
(if-let [next (next-node quadtree path)]
(conj path next)
path))
(list seed))
(partition 2)
(filter (fn [[a b]] (= a b)))
(ffirst)
(take-last max-path-length))))
(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 (* 2 r) (* 2 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])
)