@lovelace_lol/polymer 0.0.1

package/src/polymer/eye_head/agency.cljs

@@ -0,0 +1,75 @@
+(ns polymer.eye-head.agency
+  (:require [polymer.eye-head.domain :as domain]
+            [polymer.eye-head.goap :as goap]
+            [polymer.eye-head.scheduler :as scheduler]
+            [polymer.eye-head.state :as state]
+            [polymer.stream :as stream]))
+
+;; Eye/Head owns synchronized gaze movement. Peer agencies publish look
+;; requests; this agency plans and schedules eye/head AU snippets for Animation.
+
+(defn now-ms
+  []
+  (.now js/Date))
+
+(defn create-eye-head-tracking-agency
+  [config]
+  (let [input-stream (stream/create-stream)
+        event-stream (stream/create-stream)
+        state-atom (atom (state/config->state config))
+        disposed? (atom false)
+        emit-input (:emit input-stream)
+        emit-event (:emit event-stream)
+        scheduler-atom (atom nil)]
+    (letfn [(dispatch! [command]
+              (when-not @disposed?
+                (let [payload (domain/data-map command)
+                      plan (goap/plan-command payload @state-atom (now-ms))]
+                  (emit-input {:type "command"
+                               :agency "eyeHeadTracking"
+                               :command payload})
+                  (when-let [agency-scheduler @scheduler-atom]
+                    ((:schedule agency-scheduler) plan)))))
+
+            (dispatch-type! [type]
+              (dispatch! #js {:type type}))]
+      (let [agency-scheduler (scheduler/create-scheduler
+                              {:state-atom state-atom
+                               :emit-event emit-event})]
+        (reset! scheduler-atom agency-scheduler)
+        #js {:dispatch dispatch!
+             :snapshot (fn [] (state/visible-state @state-atom))
+             :input (stream/writable-port input-stream dispatch!)
+             :events (stream/readable-port event-stream)
+             :subscribeInput (fn [listener] ((:subscribe input-stream) listener))
+             :subscribeEvents (fn [listener] ((:subscribe event-stream) listener))
+             :subscribe (fn [listener] ((:subscribe event-stream) listener))
+             :subscribeStatus (fn [listener] ((:subscribe event-stream) listener))
+             :setTarget (fn [target]
+                          (dispatch! #js {:type "setTarget"
+                                          :target target}))
+             :configure (fn [config]
+                          (dispatch! #js {:type "configure"
+                                          :config config}))
+             :enable (fn [] (dispatch-type! "enable"))
+             :disable (fn [] (dispatch-type! "disable"))
+             :reset (fn
+                      ([] (dispatch-type! "reset"))
+                      ([duration-ms] (dispatch! #js {:type "reset"
+                                                     :durationMs duration-ms})))
+             :cancel (fn
+                       ([] (dispatch-type! "cancel"))
+                       ([reason] (dispatch! #js {:type "cancel"
+                                                 :reason reason})))
+             :flush (fn []
+                      (when-let [agency-scheduler @scheduler-atom]
+                        ((:flush agency-scheduler))))
+             :queue (fn []
+                      (when-let [agency-scheduler @scheduler-atom]
+                        (clj->js ((:queue agency-scheduler)))))
+             :dispose (fn []
+                        (when-not @disposed?
+                          (reset! disposed? true)
+                          ((:dispose agency-scheduler))
+                          ((:dispose input-stream))
+                          ((:dispose event-stream))))}))))

package/src/polymer/eye_head/domain.cljs

@@ -0,0 +1,133 @@
+(ns polymer.eye-head.domain)
+
+;; Eye/Head domain code normalizes incoming gaze requests and configuration.
+;; It stays pure so movement policy can be tested without any animation runtime.
+
+(def zero-target {:x 0 :y 0 :z 0})
+
+(defn finite-number?
+  [value]
+  (and (number? value) (js/isFinite value)))
+
+(defn number-or
+  [value fallback]
+  (if (finite-number? value) value fallback))
+
+(defn clamp
+  [lo hi value]
+  (min hi (max lo value)))
+
+(defn data-map
+  [value]
+  (cond
+    (map? value) value
+    value (js->clj value :keywordize-keys true)
+    :else {}))
+
+(defn normalize-target
+  ([value] (normalize-target value zero-target))
+  ([value fallback]
+   (let [input (data-map value)
+         fallback (merge zero-target fallback)]
+     {:x (clamp -1 1 (number-or (:x input) (:x fallback)))
+      :y (clamp -1 1 (number-or (:y input) (:y fallback)))
+      :z (number-or (:z input) (:z fallback))})))
+
+(defn request-id
+  [prefix now-ms]
+  (str prefix ":" now-ms ":" (rand-int 1000000)))
+
+(defn requested-target
+  [command]
+  (let [payload (data-map command)]
+    (or (:target payload)
+        (:gazeTarget payload)
+        (:lookTarget payload)
+        (:value payload))))
+
+(defn has-requested-target?
+  [command]
+  (some? (requested-target command)))
+
+(defn request-source
+  [command]
+  (let [payload (data-map command)]
+    (or (:source payload)
+        (:agency payload)
+        "gaze")))
+
+(defn normalize-gaze-request
+  [command state now-ms]
+  (let [payload (data-map command)
+        config (:config state)
+        target (normalize-target (requested-target payload))
+        eye-enabled (if (contains? payload :eyeEnabled)
+                      (boolean (:eyeEnabled payload))
+                      true)
+        head-enabled (if (contains? payload :headEnabled)
+                       (boolean (:headEnabled payload))
+                       true)
+        head-follow-eyes (if (contains? payload :headFollowEyes)
+                           (boolean (:headFollowEyes payload))
+                           (:headFollowEyes config))]
+    {:type "eyeHeadTracking.requestGaze"
+     :agency "eyeHeadTracking"
+     :sourceAgency (request-source payload)
+     :requestId (or (:requestId payload) (request-id "eyeHeadTracking" now-ms))
+     :target target
+     :rawTarget (normalize-target (:rawTarget payload) target)
+     :mode (or (:mode payload) (:mode state) "manual")
+     :eyeEnabled (and (:eyeTrackingEnabled config) eye-enabled)
+     :headEnabled (and (:headTrackingEnabled config) head-enabled)
+     :headFollowEyes head-follow-eyes
+     :eyeIntensity (number-or (:eyeIntensity payload) (:eyeIntensity config))
+     :headIntensity (number-or (:headIntensity payload) (:headIntensity config))
+     :headRoll (number-or (:headRoll payload) (:headRoll config))
+     :eyeDurationMs (number-or (:eyeDurationMs payload)
+                               (:transitionDurationMs config))
+     :headDurationMs (number-or (:headDurationMs payload)
+                                (:transitionDurationMs config))
+     :createdAt (or (:createdAt payload) now-ms)}))
+
+(defn movement-enabled?
+  [request]
+  (or (:eyeEnabled request)
+      (and (:headEnabled request) (:headFollowEyes request))))
+
+(defn normalize-reset-request
+  [command state now-ms]
+  (let [payload (data-map command)
+        config (:config state)
+        duration (number-or (:durationMs payload)
+                            (number-or (:duration-ms payload)
+                                       (:returnToCenterDurationMs config)))]
+    {:type "eyeHeadTracking.requestReset"
+     :agency "eyeHeadTracking"
+     :sourceAgency (request-source payload)
+     :requestId (or (:requestId payload) (request-id "eyeHeadTracking:reset" now-ms))
+     :target zero-target
+     :rawTarget zero-target
+     :mode (:mode state)
+     :eyeEnabled (if (contains? payload :eyes)
+                   (and (:eyeTrackingEnabled config) (boolean (:eyes payload)))
+                   (:eyeTrackingEnabled config))
+     :headEnabled (if (contains? payload :head)
+                    (and (:headTrackingEnabled config) (boolean (:head payload)))
+                    (:headTrackingEnabled config))
+     :headFollowEyes true
+     :eyeIntensity (:eyeIntensity config)
+     :headIntensity (:headIntensity config)
+     :headRoll 0
+     :eyeDurationMs duration
+     :headDurationMs duration
+     :createdAt now-ms}))
+
+(defn normalize-cancel-request
+  [command now-ms]
+  (let [payload (data-map command)]
+    {:type "eyeHeadTracking.requestCancel"
+     :agency "eyeHeadTracking"
+     :sourceAgency (request-source payload)
+     :requestId (or (:requestId payload) (request-id "eyeHeadTracking:cancel" now-ms))
+     :reason (or (:reason payload) "cancelled")
+     :createdAt now-ms}))

package/src/polymer/eye_head/goap.cljs

@@ -0,0 +1,106 @@
+(ns polymer.eye-head.goap
+  (:require [polymer.eye-head.domain :as domain]
+            [polymer.eye-head.snippet :as snippet]))
+
+;; Eye/Head planning accepts gaze requests from peer agencies and turns them
+;; into local movement work. Animation requests are produced only after the
+;; scheduler accepts the plan.
+
+(def supported-command-types
+  #{"configure"
+    "enable"
+    "disable"
+    "setTarget"
+    "set-target"
+    "requestGaze"
+    "eyeHeadTracking.requestGaze"
+    "reset"
+    "eyeHeadTracking.requestReset"
+    "cancel"
+    "eyeHeadTracking.requestCancel"})
+
+(defn command-type
+  [command]
+  (:type command))
+
+(defn plan-gaze
+  [command state now-ms]
+  (if-not (domain/has-requested-target? command)
+    [{:op "fail"
+      :reason "missing-target"
+      :commandType (command-type command)}]
+    (let [request (domain/normalize-gaze-request command state now-ms)]
+      (cond
+      (not (get-in state [:config :enabled]))
+      [{:op "ignore-request"
+        :request request
+        :reason "disabled"}]
+
+      (not (domain/movement-enabled? request))
+      [{:op "ignore-request"
+        :request request
+        :reason "movement-disabled"}]
+
+      :else
+      [{:op "queue-gaze"
+        :request request
+        :snippet (snippet/build-gaze-snippet request (:config state))}]))))
+
+(defn plan-reset
+  [command state now-ms]
+  (let [request (domain/normalize-reset-request command state now-ms)]
+    (if (domain/movement-enabled? request)
+      [{:op "queue-reset"
+        :request request
+        :snippet (snippet/build-gaze-snippet request (:config state))}]
+      [{:op "ignore-request"
+        :request request
+        :reason "movement-disabled"}])))
+
+(defn plan-cancel
+  [command now-ms]
+  [{:op "cancel-active"
+    :request (domain/normalize-cancel-request command now-ms)}])
+
+(defn command-steps
+  [command state now-ms]
+  (let [type (command-type command)]
+    (cond
+      (not (contains? supported-command-types type))
+      [{:op "fail"
+        :reason "unsupported-command"
+        :commandType type}]
+
+      (= "configure" type)
+      [{:op "apply-config" :config (:config command)}
+       {:op "publish-status" :reason "configured"}]
+
+      (= "enable" type)
+      [{:op "set-enabled" :enabled true}
+       {:op "publish-status" :reason "enabled"}]
+
+      (= "disable" type)
+      [{:op "set-enabled" :enabled false}
+       {:op "cancel-active"
+        :request (domain/normalize-cancel-request
+                  (assoc command :reason "disabled")
+                  now-ms)}
+       {:op "publish-status" :reason "disabled"}]
+
+      (#{"reset" "eyeHeadTracking.requestReset"} type)
+      (plan-reset command state now-ms)
+
+      (#{"cancel" "eyeHeadTracking.requestCancel"} type)
+      (plan-cancel command now-ms)
+
+      :else
+      (plan-gaze command state now-ms))))
+
+(defn plan-command
+  [command state now-ms]
+  (let [steps (command-steps command state now-ms)]
+    {:agency "eyeHeadTracking"
+     :commandType (command-type command)
+     :createdAt now-ms
+     :ok (not= "fail" (:op (first steps)))
+     :steps steps}))

package/src/polymer/eye_head/scheduler.cljs

@@ -0,0 +1,176 @@
+(ns polymer.eye-head.scheduler
+  (:require [polymer.eye-head.state :as state]))
+
+;; The Eye/Head scheduler is the boundary that replaces or cancels movement
+;; snippets. It publishes animation requests as data; the Animation agency owns
+;; the runtime side effect of playing those snippets.
+
+(defn now-ms
+  []
+  (.now js/Date))
+
+(defn clear-timeout!
+  [timeout-atom]
+  (when-let [timeout @timeout-atom]
+    (js/clearTimeout timeout)
+    (reset! timeout-atom nil)))
+
+(defn queue-entry
+  [step index]
+  (assoc step
+         :agency "eyeHeadTracking"
+         :queueIndex index
+         :queuedAt (now-ms)))
+
+(defn create-scheduler
+  [{:keys [state-atom emit-event]}]
+  (let [coalesce-timeout (atom nil)
+        pending-work (atom nil)
+        queue (atom [])
+        disposed? (atom false)]
+    (letfn [(enqueue! [step]
+              (let [entry (queue-entry step (count @queue))]
+                (swap! queue conj entry)
+                entry))
+
+            (emit-status! [reason]
+              (emit-event {:type "eyeHeadTracking.status"
+                           :agency "eyeHeadTracking"
+                           :status (:status @state-atom)
+                           :enabled (get-in @state-atom [:config :enabled])
+                           :activeSnippetNames (:activeSnippetNames @state-atom)
+                           :reason reason
+                           :at (now-ms)}))
+
+            (emit-remove-active! [reason]
+              (doseq [name (:activeSnippetNames @state-atom)]
+                (let [removed-at (now-ms)]
+                  (swap! state-atom state/record-removed name reason removed-at)
+                  (emit-event {:type "animation.requestRemoveSnippet"
+                               :agency "eyeHeadTracking"
+                               :requestId (str "eyeHeadTracking:remove:" removed-at)
+                               :name name
+                               :reason reason
+                               :queuedAt removed-at}))))
+
+            (publish-work-now! []
+              (when-not @disposed?
+                (clear-timeout! coalesce-timeout)
+                (when-let [{:keys [kind request snippet]} @pending-work]
+                  (reset! pending-work nil)
+                  (when (get-in @state-atom [:config :replaceExisting])
+                    (emit-remove-active! "replaced"))
+                  (let [published-at (now-ms)]
+                    (enqueue! {:op "publish-animation"
+                               :requestId (:requestId request)
+                               :name (:name snippet)})
+                    (if (= kind "reset")
+                      (swap! state-atom state/record-reset request snippet published-at)
+                      (swap! state-atom state/record-scheduled request snippet published-at))
+                    (emit-event {:type "animation.requestScheduleSnippet"
+                                 :agency "eyeHeadTracking"
+                                 :requestId (:requestId request)
+                                 :snippet snippet
+                                 :options {:autoPlay true
+                                           :sourceAgency "eyeHeadTracking"}})))))
+
+            (queue-work! [kind request snippet]
+              (when-not @disposed?
+                (let [queued-at (now-ms)
+                      work {:kind kind
+                            :request (assoc request :queuedAt queued-at)
+                            :snippet snippet}
+                      delay-ms (get-in @state-atom [:config :coalesceMs])]
+                  (reset! pending-work work)
+                  (swap! state-atom state/record-pending (:request work))
+                  (clear-timeout! coalesce-timeout)
+                  (enqueue! {:op "coalesce-work"
+                             :kind kind
+                             :requestId (:requestId request)
+                             :coalesceMs delay-ms})
+                  (if (pos? delay-ms)
+                    (reset! coalesce-timeout
+                            (js/setTimeout publish-work-now! delay-ms))
+                    (publish-work-now!)))))
+
+            (cancel-pending! []
+              (clear-timeout! coalesce-timeout)
+              (reset! pending-work nil)
+              (swap! state-atom assoc :pendingRequest nil))
+
+            (ignore-request! [request reason]
+              (let [ignored {:type "eyeHeadTracking.requestIgnored"
+                             :agency "eyeHeadTracking"
+                             :requestId (:requestId request)
+                             :reason reason
+                             :target (:target request)
+                             :ignoredAt (now-ms)}]
+                (cancel-pending!)
+                (swap! state-atom state/record-ignored ignored)
+                (emit-event ignored)))
+
+            (cancel-active! [request]
+              (cancel-pending!)
+              (emit-remove-active! (:reason request))
+              (swap! state-atom state/record-cancel request)
+              (emit-event {:type "eyeHeadTracking.cancelled"
+                           :agency "eyeHeadTracking"
+                           :requestId (:requestId request)
+                           :reason (:reason request)
+                           :at (now-ms)}))
+
+            (execute-step! [step]
+              (enqueue! step)
+              (case (:op step)
+                "apply-config"
+                (do
+                  (swap! state-atom state/configure (:config step))
+                  (emit-status! (:reason step)))
+
+                "set-enabled"
+                (do
+                  (swap! state-atom state/set-enabled (:enabled step))
+                  (emit-status! (if (:enabled step) "enabled" "disabled")))
+
+                "publish-status"
+                (emit-status! (:reason step))
+
+                "queue-gaze"
+                (queue-work! "gaze" (:request step) (:snippet step))
+
+                "queue-reset"
+                (queue-work! "reset" (:request step) (:snippet step))
+
+                "cancel-active"
+                (cancel-active! (:request step))
+
+                "ignore-request"
+                (ignore-request! (:request step) (:reason step))
+
+                "fail"
+                (emit-event {:type "error"
+                             :agency "eyeHeadTracking"
+                             :message (:reason step)
+                             :commandType (:commandType step)})
+
+                nil))]
+      {:schedule
+       (fn [plan]
+         (when-not @disposed?
+           (swap! state-atom state/record-plan plan)
+           (doseq [step (:steps plan)]
+             (execute-step! step))))
+
+       :flush
+       (fn []
+         (publish-work-now!))
+
+       :queue
+       (fn []
+         @queue)
+
+       :dispose
+       (fn []
+         (reset! disposed? true)
+         (cancel-pending!)
+         (reset! queue []))})))