Change to video capture (which solves bad scaledPrediction)

src/heyarne/all_my_friends/core.cljs

@@ -1,48 +1,104 @@
 (ns heyarne.all-my-friends.core
   (:require ["@tensorflow/tfjs-core" :as tf]
             ["@tensorflow-models/facemesh" :as facemesh]
-            [applied-science.js-interop :as j]
-            [goog.dom :as dom]))
+            [applied-science.js-interop :as j]))
 
-(def img (js/document.querySelector "img"))
+(defonce state (atom {}))
 
-(defn draw-results [img predictions]
-  (let [bounds (j/lookup (.getBoundingClientRect img))
-        parent (dom/getParentElement img)
-        canvas (doto (dom/createElement "canvas")
-                 (.setAttribute "width" (:width bounds))
-                 (.setAttribute "height" (:height bounds))
-                 (.setAttribute "style" (str "display: block; "
-                                             "position: absolute; "
-                                             "top: " (:top bounds) "px; "
-                                             "left: " (:left bounds) "px")))
+(defn draw-results [elem predictions]
+  (let [canvas (.querySelector js/document "canvas#result")
         ctx (. canvas (getContext "2d"))]
     ;; remove previous results
-    (doseq [result-canvas (.querySelectorAll parent "canvas")]
-      (dom/removeNode result-canvas))
-    ;; draw and append new results
-    (set! (.-strokeStyle ctx) "white")
-    (doseq [prediction predictions
-            [x y _] (j/get prediction :scaledMesh)]
-      (.beginPath ctx)
-      (.ellipse ctx x y 2 2 0 0 (* 2 Math/PI))
-      (.stroke ctx))
-    (dom/appendChild parent canvas)))
+    (.clearRect ctx 0 0 (.. ctx -canvas -width) (.. ctx -canvas -height))
 
-(defn detect-faces [model]
-  (println "Facemesh loaded")
+    ;; draw and append new results
+
+    (doseq [prediction predictions
+            :let [[[t-x t-y]] (j/get-in prediction [:boundingBox :topLeft])
+                  [[b-x b-y]] (j/get-in prediction [:boundingBox :bottomRight])]]
+      (set! (.-strokeStyle ctx) "pink")
+
+      (comment
+        (.setLineDash ctx #js [2 2])
+
+        (.beginPath ctx)
+        (.moveTo ctx t-x t-y)
+        (.lineTo ctx t-x b-y)
+        (.lineTo ctx b-x b-y)
+        (.lineTo ctx b-x t-y)
+        (.lineTo ctx t-x t-y)
+        (.stroke ctx)
+
+        (.setLineDash ctx #js [])
+        (.beginPath ctx)
+        (.arc ctx  b-x b-y 2 0 (* 2 Math/PI))
+        (.stroke ctx))
+
+      (doseq [[x y _] (j/get prediction :scaledMesh)]
+        (.beginPath ctx)
+        (.arc ctx x y 1 0 (* 2 Math/PI))
+        (.stroke ctx))
+
+      (comment
+        (doseq [[x y _] (j/get prediction :mesh)]
+          (.beginPath ctx)
+          (.arc ctx x y 2 0 (* 2 Math/PI))
+          (.stroke ctx))))))
+
+(defn detect-faces [model elem]
   (.. model
-      (estimateFaces img)
+      (estimateFaces elem)
       (then (fn [predictions]
               (set! (.-predictions js/window) predictions)
               #_(println "Predictions" predictions)
-              (draw-results img predictions)))))
+              (draw-results elem predictions))))
+  (js/requestAnimationFrame #(detect-faces model elem)))
 
-(defonce
-  init
-  (do
+(defn start-capture [video-elem]
+  ;; set up webcam
+  (.. js/navigator
+      -mediaDevices
+      (getUserMedia #js {:audio false
+                         :video #js {:facingMode "user"
+                                     :width 320
+                                     :height 320}})
+      (then (fn [stream]
+              (set! (.-srcObject video-elem) stream))))
+  ;; return promise
+  (js/Promise.
+   (fn [resolve]
+     (set! (.-onloadedmetadata video-elem) #(resolve video-elem)))))
+
+;; TODO: Handle rejected permission request
+
+(defn init []
+  (swap! state ::status :webcam-init)
+  (let [video (.querySelector js/document "video#capture")
+        canvas (.querySelector js/document "canvas#result")
+        ctx (.getContext canvas "2d")]
+    (-> (start-capture video)
+        (.then (fn [video]
+                 (.play video)
+                 (println "video.videoWidth" (.-videoWidth video)
+                          "video.videoHeight" (.-videoHeight video))
+
+                 ;; initialize canvas
+                 (set! (.-width canvas) (.-videoWidth video))
+                 (set! (.-height canvas) (.-videoHeight video))
+                 #_(.translate ctx (.-width canvas) 0)
+                 #_(.scale ctx -1 1)
+
+                 ;; initalize model
+                 (swap! state ::status :model-init)
+                 (.. tf
+                     (setBackend "webgl")
+                     (then #(.load facemesh #js {:maxFaces 1}))
+                     (then #(detect-faces % video))))))))
+
+(defonce initialize (init)
+  #_(do
     (println "Initializing…")
     (.. tf
         (setBackend "webgl")
-        (then #(.load facemesh))
+        (then #(.load facemesh #js {:maxFaces 1}))
         (then detect-faces))))