diff --git a/shell.nix b/shell.nix index 4d7cb30..6543a51 100644 --- a/shell.nix +++ b/shell.nix @@ -2,6 +2,7 @@ with import { }; mkShell rec { name = "quil-env"; buildInputs = with pkgs; [ + clojure xorg_sys_opengl ]; LD_LIBRARY_PATH = "${lib.makeLibraryPath buildInputs}"; diff --git a/src/heyarne/all_my_friends/core.cljc b/src/heyarne/all_my_friends/core.cljc index 8f828ec..9771bdd 100644 --- a/src/heyarne/all_my_friends/core.cljc +++ b/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)) - \- (mod (dec (find-index uploads (:current-faces state))) (count uploads)) - nil)] + \newline (rand-int (count uploads)) + \+ (advance uploads (:current-faces state) inc) + \- (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 - (doseq [[a b] (->> (g/vertices face-bounds) - (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) - :let [p (g/transform (v/vec2 p) transform-matrix) - t (m/* (v/randvec2) (* 1.5 (+ 1 (n/noise1 (* 0.002 (q/millis)))))) - {[a b] :points} (l/line2 (g/translate p (m/- t)) (g/translate p t))]] - (q/line a b))) + (q/with-translation [(/ (q/width) 2) + (/ (q/height) 2)] + (doseq [face current-faces + [x y z] face + :let [d (* 5 (- 1 (+ 0.5 z)))]] + (q/ellipse (* scale x) (* scale y) d d)))) #_: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))