Allow toggling through faces

This commit is contained in:
heyarne 2021-04-13 23:45:51 +02:00
commit 9213548223
2 changed files with 55 additions and 37 deletions

View file

@ -2,6 +2,7 @@
cheshire/cheshire {:mvn/version "5.1.0"}
camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.2"}
quil/quil {:mvn/version "3.1.0"}
net.cgrand/xforms {:mvn/version "0.19.2"}
thi.ng/geom {:mvn/version "1.0.0-RC4"
:exclusions [org.jogamp.jogl/jogl-all
org.jogamp.gluegen/gluegen-rt]}}}

View file

@ -1,8 +1,10 @@
(ns heyarne.all-my-friends.core
(:require [quil.core :as q]
[quil.middlewares.pause-on-error :refer [pause-on-error]]
[camel-snake-kebab.core :refer [->kebab-case]]
[quil.middlewares.fun-mode :refer [fun-mode]]
[camel-snake-kebab.core :refer [->kebab-case-keyword]]
[cheshire.core :as json]
[net.cgrand.xforms :as x]
[thi.ng.geom.vector :as v]
[thi.ng.geom.core :as g]
[thi.ng.geom.matrix :as mat]
@ -12,29 +14,26 @@
[clojure.string :as str]))
;; TODO All PNGs are missing an extension
(defn parse-face [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
(def uploads
#?(:clj (->>
(map bean (file-seq (io/file "../uploads")))
(filter :file)
(remove :hidden)
(sort-by :name)
(partition-by #(first (str/split (:name %) #"\."))))
#?(:clj (sequence (comp (map bean)
(filter :file)
(remove :hidden)
(x/sort-by :name)
(partition-by #(first (str/split (:name %) #"\.")))
(map parse-face)
(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))
#_(def key-fn (comp keyword ->kebab-case))
(defn parse-most-recent [uploads]
(when-let [most-recent (last uploads)]
(let [[_image computational-gaze] most-recent]
#?(:clj
(with-open [rdr (io/reader (:path computational-gaze))]
(json/parse-stream rdr key-fn))
:cljs nil)))) ;; TODO
(def most-recent (parse-most-recent uploads))
;; "most-recent" now contains a seq of all faces detected in the most recently
;; uploaded picture
;; next we calculate a matrix to fit each point in the mesh into our
;; bounding box.
@ -46,13 +45,7 @@
[(min x x1) (min y y1)
(max x x2) (max y y2)])
[max-number max-number min-number min-number] pts)]
(r/rect (v/vec2 x1 y1) (v/vec2 x2 y2))))
(def face-bounds
(points->bounds (:scaled-mesh (first most-recent)))
#_(let [bbox (:bounding-box (first most-recent))]
(-> (concat (:top-left bbox) (:bottom-right bbox))
(points->bounds))))
(r/rect [x1 y1] [x2 y2])))
(def bounds (r/rect 0 0 500 500))
@ -70,17 +63,39 @@
(mat/matrix32 factor 0 0
0 factor 0)))
;; TODO: Combine matrices
(def transform-matrix (center-matrix bounds face-bounds))
(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)
(defn setup []
(q/frame-rate 1)
(q/frame-rate (if debug 1 30))
(q/ellipse-mode :center)
(q/color-mode :hsb))
(q/color-mode :hsb)
(pick-face (rand-nth uploads)))
(def debug true)
(defn find-index [xs x]
(first (keep-indexed (fn [idx item] (when (= x item) idx)) xs)))
(defn draw []
(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)]
(do
(println "index" idx)
(pick-face (nth uploads idx)))
state))
(defn draw [{:keys [current-faces face-bounds transform-matrix]}]
(q/clear)
(q/background 40 80 255)
(q/stroke 4 120 255)
@ -94,7 +109,7 @@
(take 4))]
(q/line (g/transform a transform-matrix) (g/transform b transform-matrix))))
(doseq [face most-recent
(doseq [face current-faces
p (:scaled-mesh face)
:let [p (g/transform (v/vec2 p) transform-matrix)]]
(q/ellipse (p :x) (p :y) 6 6)
@ -104,7 +119,9 @@
(q/defsketch all-my-friends
:title "These are all my friends"
:settings #(q/smooth 2)
:middleware [pause-on-error]
:middleware [pause-on-error
fun-mode]
:setup setup
:key-pressed key-pressed
:draw draw
:size (:size bounds))