Normalize face coords to make them easier to work with

shell.nix

@@ -2,6 +2,7 @@ with import <nixpkgs> { };
 mkShell rec {
   name = "quil-env";
   buildInputs = with pkgs; [
+    clojure
     xorg_sys_opengl
   ];
   LD_LIBRARY_PATH = "${lib.makeLibraryPath buildInputs}";

src/heyarne/all_my_friends/core.cljc

@@ -4,74 +4,68 @@
             [camel-snake-kebab.core :refer [->kebab-case-keyword]]
             [cheshire.core :as json]
             [net.cgrand.xforms :as x]
+            [thi.ng.geom.aabb :as aabb]
             [thi.ng.geom.vector :as v]
             [thi.ng.geom.core :as g]
             [thi.ng.geom.line :as l]
-            [thi.ng.geom.matrix :as mat]
             [thi.ng.geom.rect :as r]
+            [thi.ng.geom.sphere :as s]
+            [thi.ng.geom.utils :as gu]
             [thi.ng.math.core :as m]
             [thi.ng.math.noise :as n]
             [clojure.java.io :as io]
             [clojure.string :as str]))
 
-;; TODO All PNGs are missing an extension
+
-(defn parse-face [upload]
+(def canvas (r/rect 0 0 500 500))
+
+(defn parse-faces [upload]
   (let [[_image computational-gaze] upload]
     #?(:clj
        (with-open [rdr (io/reader (:path computational-gaze))]
          (json/parse-stream rdr ->kebab-case-keyword))
        :cljs nil))) ;; TODO
 
+(defn cubify-aabb
+  "Creates a cube wrapping an aabb such that the original aabb is centered
+  within it."
+  [aabb]
+  (let [longest (apply max (map #(Math/abs %) (:size aabb)))
+        new-size (v/vec3 longest)]
+    (-> (assoc aabb :size new-size)
+        (update :p (fn [[p-x p-y p-z]]
+                     (let [size (:size aabb)
+                           [d-x d-y d-z] (m/*! (m/abs! (m/- size new-size)) 0.5)]
+                       (v/vec3 (- p-x d-x)
+                               (- p-y d-y)
+                               (- p-z d-z))))))))
+
+(defn normalize-faces [upload]
+  (let [faces (->> (map :scaled-mesh upload)
+                   (map #(into [] (map v/vec3) %)))
+        bounds (->> (map gu/bounding-box faces)
+                    (reduce m/union)
+                    (cubify-aabb))
+        normalized (map #(map (comp (partial g/translate (v/vec3 -0.5 -0.5 -0.5))
+                                    (partial g/map-point bounds)) %) faces)]
+    normalized))
+
+;; uploads are whatever is coming from the server. it is a json document
+;; containing information about the faces which were detected along with a
+;; png that was captured by the webcam.
+
 (def uploads
   #?(:clj (sequence (comp (map bean)
                           (filter :file)
                           (remove :hidden)
                           (x/sort-by :name)
                           (partition-by #(first (str/split (:name %) #"\.")))
-                          (map parse-face)
+                          (map parse-faces)
+                          (map normalize-faces)
                           (dedupe)) ;; TODO: The user interface seems too wonky so people upload multiple times :)
                     (file-seq (io/file "../uploads")))
      :cljs [])) ;; TODO
 
-#_(def key-fn (comp keyword ->kebab-case))
-
-;; next we calculate a matrix to fit each point in the mesh into our
-;; bounding box.
-
-(def max-number #?(:clj Float/MAX_VALUE :cljs js/Infinity))
-(def min-number #?(:clj Float/MIN_VALUE :cljs js/-Infinity))
-
-(defn points->bounds [pts]
-  (let [[x1 y1 x2 y2] (reduce (fn [[x1 y1 x2 y2] [x y]]
-                                [(min x x1) (min y y1)
-                                 (max x x2) (max y y2)])
-                              [max-number max-number min-number min-number] pts)]
-    (r/rect [x1 y1] [x2 y2])))
-
-(def bounds (r/rect 0 0 500 500))
-
-(defn center-matrix [dst-bounds src-bounds]
-  (let [delta (m/- (m/+ (:p dst-bounds) (m/* (:size dst-bounds) 0.5))
-                   (m/+ (:p src-bounds) (m/* (:size src-bounds) 0.5)))]
-    (g/translate (mat/matrix32) delta)))
-
-(defn fit-matrix
-  "Returns an affine matrix than can be used to fit and center all points
-  described by the bounding box `src-bounds` into `dst-bounds`."
-  [dst-bounds src-bounds]
-  (let [factor (min (/ (-> dst-bounds :size :x) (-> src-bounds :size :x))
-                    (/ (-> dst-bounds :size :y) (-> src-bounds :size :y)))]
-    (mat/matrix32 factor 0 0
-                  0 factor 0)))
-
-(defn pick-face [upload]
-  (let [pick upload
-        face-bounds (points->bounds (:scaled-mesh (first pick)))] ;; TODO: We might have multiple faces
-    {:current-faces pick
-     :face-bounds face-bounds
-     ;; TODO: Combine matrices
-     :transform-matrix (center-matrix bounds face-bounds)}))
-
 ;; the following functions are the ones directly responsible for drawing
 
 (def debug false)
@@ -80,42 +74,40 @@
   (q/frame-rate (if debug 1 30))
   (q/ellipse-mode :center)
   (q/color-mode :hsb)
-  (pick-face (rand-nth uploads)))
+  {:current-faces (rand-nth uploads)})
 
 (defn find-index [xs x]
   (first (keep-indexed (fn [idx item] (when (= x item) idx)) xs)))
 
+(defn advance [uploads current op]
+  (mod (op (find-index uploads current)) (count uploads)))
+
 (defn key-pressed [state ev]
   (if-let [idx (case (:raw-key ev)
                  \newline (rand-int (count uploads))
-                   \+ (mod (inc (find-index uploads (:current-faces state))) (count uploads))
+                 \+ (advance uploads (:current-faces state) inc)
-                   \- (mod (dec (find-index uploads (:current-faces state))) (count uploads))
+                 \- (advance uploads (:current-faces state) dec)
                  nil)]
     (do
       (println "index" idx)
-      (pick-face (nth uploads idx)))
+      (assoc state :current-faces (nth uploads idx)))
     state))
 
-(defn draw [{:keys [current-faces face-bounds transform-matrix]}]
+(def scale 200)
+
+(defn draw [{:keys [current-faces]}]
   (q/clear)
   (q/background 40 80 255)
   (q/stroke 4 120 255)
   (q/no-fill)
   (q/stroke-weight 1)
 
-  (when debug
+  (q/with-translation [(/ (q/width) 2)
-    (doseq [[a b] (->> (g/vertices face-bounds)
+                       (/ (q/height) 2)]
-                       (cycle)
-                       (partition-all 2 1)
-                       (take 4))]
-      (q/line (g/transform a transform-matrix) (g/transform b transform-matrix))))
-
     (doseq [face current-faces
-          p (:scaled-mesh face)
+            [x y z] face
-          :let [p (g/transform (v/vec2 p) transform-matrix)
+            :let [d (* 5 (- 1 (+ 0.5 z)))]]
-                t (m/* (v/randvec2) (* 1.5 (+ 1 (n/noise1 (* 0.002 (q/millis))))))
+      (q/ellipse (* scale x) (* scale y) d d))))
-                {[a b] :points} (l/line2 (g/translate p (m/- t)) (g/translate p t))]]
-    (q/line a b)))
 
 #_:clj-kondo/ignore
 (q/defsketch all-my-friends
@@ -126,4 +118,4 @@
   :setup setup
   :key-pressed key-pressed
   :draw draw
-  :size (:size bounds))
+  :size (:size canvas))