near/heyarne.all-my-friends.vis
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Normalize face coords to make them easier to work with

Browse source
This commit is contained in:
heyarne 2021-04-24 19:29:10 +02:00
commit e8b7075974
2 changed files with 57 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

1
shell.nix
View file

@ -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}";

120
src/heyarne/all_my_friends/core.cljc
View file

@ -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))