@lovelace_lol/polymer 0.0.7 → 0.0.9

package/src/polymer/eye_head/agency.cljs

@@ -1,75 +0,0 @@
-(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

@@ -1,133 +0,0 @@
-(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

@@ -1,106 +0,0 @@
-(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

@@ -1,176 +0,0 @@
-(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 []))})))