Add quil renderer for thi.ng-hiccup scenes

src/aphorisms/quil/drawable.clj

@@ -0,0 +1,53 @@
+(ns aphorisms.quil.drawable
+  (:require [quil.core :as q]
+            [thi.ng.geom.types])
+  (:import [thi.ng.geom.types Circle2 Line2 Polygon2]))
+
+(defn quil-attrs! [attrs]
+  (when-let [color (:stroke/color attrs)] (apply q/stroke color))
+  (when-let [weight (:stroke/weight attrs)] (q/stroke-weight weight))
+  (when-let [stroke-cap (:stroke/line-cap attrs)] (q/stroke-cap stroke-cap))
+  (when-let [stroke-join (:stroke/line-join attrs)] (q/stroke-join stroke-join))
+  (when-let [color (:fill/color attrs)] (apply q/fill color)))
+
+(defprotocol QuilDrawable
+  (draw [shape] [shape attrs]))
+
+(extend-protocol QuilDrawable
+  Circle2
+  (draw
+    ([circle] (draw circle {}))
+    ([{[x y] :p r :r} attrs]
+     (quil-attrs! attrs)
+     (q/ellipse x y r r)))
+
+  Polygon2
+  (draw
+    ([poly] (draw poly {}))
+    ([poly attrs]
+     (quil-attrs! attrs)
+     (doseq [[a b] (partition 2 1 (:points poly))]
+       (q/line a b))))
+
+  Line2
+  (draw
+    ([line] (draw line {}))
+    ([line attrs]
+     (quil-attrs! attrs)
+     (apply q/line (:points line)))))
+
+(defn draw-scene! [scene]
+  (let [[f & rs] scene
+        [attrs & rrs] rs]
+    (when f
+      (if (sequential? f)
+        (do
+          (draw-scene! f)
+          (recur rs))
+        (if (map? attrs)
+          (do
+            (draw f attrs)
+            (recur rrs))
+          (do
+            (draw f)
+            (recur rs)))))))

src/aphorisms/thirty_three.clj

@@ -0,0 +1,64 @@
+(ns aphorisms.thirty-three
+  (: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.vector :as v]
+            [thi.ng.geom.line :as l]
+            [thi.ng.geom.polygon :as p]
+
+            [aphorisms.quil.drawable :as qd]))
+
+(def bounds (r/rect 750 500))
+(def canvas (g/scale bounds 0.92))
+
+(def circ (c/circle 375))
+
+(defn setup []
+  (q/ellipse-mode :center)
+  (q/rect-mode :corners)
+  (q/color-mode :hsb 255)
+  {})
+
+(def scene
+  (let [c1 (assoc circ :p (v/vec2 275 260)),
+        c2 (assoc circ :p (v/vec2 475 240))]
+    [[c1 {:stroke/color [255 255 255]}]
+     [c2 {:stroke/color [125 255 255]}]
+
+     (mapv (fn [y]
+             [(-> (l/line2 [-1000 0] [1000 0])
+                 (g/rotate (-> (* Math/PI 2) (/ 360) (* 33)))
+                 (g/translate [0 y])
+                 :points
+                 p/polygon2
+                 (g/clip-with (g/scale circ 0.55))
+                 (g/translate (:p c1))) {:stroke/color [255 255 255]}])
+           (range 0 101 10))
+
+     (mapv (fn [y]
+             [(-> (l/line2 [-1000 0] [1000 0])
+                 (g/rotate (-> (* Math/PI 2) (/ 360) (* -40)))
+                 (g/translate [0 y])
+                 :points
+                 p/polygon2
+                 (g/clip-with (g/scale circ 0.6))
+                 (g/translate (:p c2))) {:stroke/color [125 255 255]}])
+           (range 100 -101 -10))]))
+
+(defn draw-state [_]
+  (q/background 255)
+  (q/no-fill)
+  (qd/draw-scene! scene))
+
+#_:clj-kondo/ignore
+(q/defsketch thirty-three
+  :title "Thirty-Three"
+  :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])