From 2716edb7476b389635cac8a637fef923a58f37b0 Mon Sep 17 00:00:00 2001
From: arne <noreply@null.arnes.space>
Date: Sun, 5 May 2024 21:01:11 +0200
Subject: [PATCH] Add thi.ng.geom.physics based sketch

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

diff --git a/src/aphorisms/thirty_eight.clj b/src/aphorisms/thirty_eight.clj
new file mode 100644
index 0000000..dc98e43
--- /dev/null
+++ b/src/aphorisms/thirty_eight.clj
@@ -0,0 +1,107 @@
+(ns aphorisms.thirty-eight
+  (:require [thi.ng.geom.core :as g]
+            [thi.ng.geom.physics.core :as phys]
+            [thi.ng.geom.vector :as v]
+            [quil.core :as q]
+            [quil.middleware :as qm]
+            [thi.ng.geom.rect :as r]
+            [thi.ng.geom.circle :as c]))
+
+;; toying around with thi.ng.geom.physics; loosely based on
+;; https://piped.video/watch?v=3v7SsOdxxww, which explains toxiclibs verlet
+;; physics and trying to get close to the differential line growth algorithm
+;; described in https://inconvergent.net/generative/differential-line
+
+(def bounds (r/rect 500 500))
+(def radius 10)
+(def shape (-> (c/circle 100)
+               (g/translate (g/centroid bounds))
+               (g/as-polygon)))
+
+(defn world []
+  ;; play around with this, re-evaluate it and hit `r` in a running sketch!
+  (let [particles (mapv (fn [p]
+                         (phys/particle p 10)) (g/vertices shape))
+        edges (->> (cycle particles)
+                   (partition-all 2 1)
+                   (take (count particles)))]
+    (phys/physics
+     {:particles particles
+      :springs (mapv (fn [[a b]]
+                       (phys/spring a b (/ (g/circumference shape) (count particles) 2) 0.1)) edges)
+      :drag 1
+      :constraints {:bounds (phys/shape-constraint-inside bounds)}
+      #_#_:listeners {:iter (fn [world _n]
+                              ;; record a history of all particle positions
+                              (swap! state update :history conj (mapv phys/position (:particles world))))}})))
+
+(def tmp (world))
+
+(defn setup []
+  (q/frame-rate 30)
+  (q/color-mode :hsb 360 100 100)
+  (q/rect-mode :center)
+  (q/ellipse-mode :center)
+  (q/background 350)
+  {:world (world)})
+
+(defn mouse-pressed [state ev]
+  (let [rsq (* radius radius)
+        mouse (v/vec2 ev)
+        hits (into #{}
+                   (filter #(<= (g/dist-squared (phys/position %) mouse) rsq))
+                   (-> state :world :particles))]
+    (when hits
+      (doseq [hit hits] ; dirty dirty side effects
+        (phys/lock hit)))
+    (assoc state :hits hits)))
+
+(defn mouse-dragged [state ev]
+  (let [mouse (v/vec2 ev)]
+    (doseq [p (:hits state)] ; again, embracing the side-effects in thi.ng.geom.physics
+      (phys/set-position p mouse)))
+  state)
+
+(defn mouse-released [state _ev]
+  (doseq [hit (:hits state)] ; side effects everywhere
+    (phys/unlock hit))
+  (dissoc state :hits))
+
+(defn key-pressed [state ev]
+  (case (:key ev)
+    :r (assoc state :world (world))
+    state))
+
+(defn update-state [state]
+  (update state :world phys/timestep 1))
+
+(defn draw-state [state]
+  (q/background 180 0 98)
+  (q/no-stroke)
+  (doseq [particle (-> state :world :particles)]
+    (let [[x y] (phys/position particle)
+          color (if ((:hits state #{}) particle)
+                  [100 80 80]
+                  [100 20 80])]
+      (apply q/fill color)
+      (q/ellipse x y radius radius)))
+  (doseq [{pa :a pb :b} (-> state :world :springs)]
+    (let [color [100 20 80]]
+      (apply q/stroke color)
+      (q/line (phys/position pa) (phys/position pb)))))
+
+#_:clj-kondo/ignore
+(q/defsketch thirty-eight
+  :title "Thirty eight"
+  :size [(g/width bounds) (g/height bounds)]
+  :settings #(q/pixel-density (q/display-density))
+  :setup setup
+  :key-pressed key-pressed
+  :mouse-pressed mouse-pressed
+  :mouse-dragged mouse-dragged
+  :mouse-released mouse-released
+  :update update-state
+  :draw draw-state
+  #_#_:renderer :p2d
+  :features [:keep-on-top :no-bind-output]
+  :middleware [qm/pause-on-error qm/fun-mode])