From 1783b00d2cc5a2c9d4dbc201425a0e40acc043f0 Mon Sep 17 00:00:00 2001 From: heyarne Date: Sat, 2 May 2020 20:37:55 +0200 Subject: [PATCH] Change to video capture (which solves bad `scaledPrediction`) --- resources/public/index.html | 3 +- src/heyarne/all_my_friends/core.cljs | 118 ++++++++++++++++++++------- 2 files changed, 89 insertions(+), 32 deletions(-) diff --git a/resources/public/index.html b/resources/public/index.html index 5a41ef4..77ffe4f 100644 --- a/resources/public/index.html +++ b/resources/public/index.html @@ -2,7 +2,8 @@ - Example webcam picture + + diff --git a/src/heyarne/all_my_friends/core.cljs b/src/heyarne/all_my_friends/core.cljs index 5bd7c05..9e29e63 100644 --- a/src/heyarne/all_my_friends/core.cljs +++ b/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))))