@lovelace_lol/polymer 0.0.1

package/src/polymer/camera_context/agency.cljs

@@ -0,0 +1,132 @@
+(ns polymer.camera-context.agency
+  (:require [polymer.camera-context.domain :as domain]
+            [polymer.camera-context.planner :as planner]
+            [polymer.camera-context.scheduler :as scheduler]
+            [polymer.camera-context.state :as state]
+            [polymer.stream :as stream]))
+
+;; Camera Context publishes stable camera-relative facts. It does not own gaze
+;; behavior and does not import a rendering engine. Runtime-specific code can
+;; observe the camera and send plain pose/target facts into this agency.
+
+(defn now-ms
+  []
+  (.now js/Date))
+
+(defn create-camera-context-agency
+  [config]
+  (let [input-stream (stream/create-stream)
+        event-stream (stream/create-stream)
+        state-atom (atom (state/config->state config))
+        sequence (atom 0)
+        disposed? (atom false)
+        emit-input (:emit input-stream)
+        emit-event (:emit event-stream)
+        scheduler-atom (atom nil)]
+    (letfn [(publish-fact! [fact]
+              (let [published-at (now-ms)
+                    payload (assoc fact
+                                   :type "camera.fact"
+                                   :publishedAt published-at)]
+                (swap! state-atom state/record-published fact published-at)
+                (emit-event payload)))
+
+            (invalidate-stale! [reason]
+              (when (state/can-invalidate? @state-atom)
+                (let [invalidated-at (now-ms)]
+                  (swap! state-atom state/record-stale invalidated-at reason)
+                  (emit-event (assoc (:lastInvalidation @state-atom)
+                                     :type "camera.stale")))))
+
+            (emit-status! [status reason]
+              (emit-event (cond-> {:type "camera.status"
+                                   :agency "cameraContext"
+                                   :status status
+                                   :stale (:stale @state-atom)
+                                   :at (now-ms)}
+                            reason (assoc :reason reason))))
+
+            (schedule-camera-update! [payload]
+              (let [id (swap! sequence inc)
+                    observed-at (now-ms)
+                    fact (domain/normalize-camera-fact payload
+                                                       (:config @state-atom)
+                                                       observed-at
+                                                       id)]
+                (swap! state-atom state/record-camera-update fact)
+                (when-let [agency-scheduler @scheduler-atom]
+                  ((:schedule-camera-update agency-scheduler) fact))))
+
+            (dispatch! [command]
+              (when-not @disposed?
+                (let [payload (domain/data-map command)
+                      plan (planner/plan-command payload @state-atom (now-ms))
+                      failure (first (filter #(= "fail" (:op %)) (:steps plan)))]
+                  (emit-input {:type "command"
+                               :agency "cameraContext"
+                               :command payload})
+                  (swap! state-atom state/record-plan plan)
+                  (if failure
+                    (emit-event {:type "error"
+                                 :agency "cameraContext"
+                                 :message (:reason failure)
+                                 :commandType (:commandType failure)})
+                    (case (:type payload)
+                      "configure"
+                      (do
+                        (swap! state-atom state/configure (:config payload))
+                        (emit-status! (:status @state-atom) "configured"))
+
+                      "updateCamera"
+                      (schedule-camera-update! payload)
+
+                      "publishCameraFacts"
+                      (when-let [agency-scheduler @scheduler-atom]
+                        ((:publish-now agency-scheduler)))
+
+                      "invalidateStale"
+                      (when-let [agency-scheduler @scheduler-atom]
+                        ((:invalidate-stale agency-scheduler)
+                         (or (:reason payload) "manual")))
+
+                      "reset"
+                      (do
+                        (when-let [agency-scheduler @scheduler-atom]
+                          ((:reset agency-scheduler)))
+                        (swap! state-atom state/reset-state)
+                        (emit-status! "idle" "reset"))
+
+                      nil)))))
+
+            (dispatch-type! [type]
+              (dispatch! #js {:type type}))]
+      (let [agency-scheduler (scheduler/create-scheduler
+                              {:state-atom state-atom
+                               :publish-fact! publish-fact!
+                               :invalidate-stale! invalidate-stale!})]
+        (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))
+             :updateCamera (fn [facts]
+                             (dispatch! #js {:type "updateCamera"
+                                             :facts facts}))
+             :invalidateStale (fn
+                                ([] (dispatch-type! "invalidateStale"))
+                                ([reason] (dispatch! #js {:type "invalidateStale"
+                                                          :reason reason})))
+             :reset (fn [] (dispatch-type! "reset"))
+             :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/camera_context/domain.cljs

@@ -0,0 +1,186 @@
+(ns polymer.camera-context.domain)
+
+;; Camera Context intentionally works with plain data, not Three.js objects.
+;; The host/runtime boundary can read camera, controls, and model handles, then
+;; pass stable vector/quaternion facts into Polymer. Everything below is pure
+;; math over those facts so Gaze, Eye/Head, and future agencies can consume the
+;; same camera-relative context without inheriting a rendering-engine import.
+
+(def default-epsilon 1.0e-4)
+(def default-yaw-weight 0.35)
+(def default-pitch-weight 0.2)
+
+(def zero-vector3 {:x 0 :y 0 :z 0})
+(def identity-quaternion {:x 0 :y 0 :z 0 :w 1})
+(def zero-offset {:x 0 :y 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-vector3
+  ([value] (normalize-vector3 value zero-vector3))
+  ([value fallback]
+   (let [input (data-map value)
+         fallback (merge zero-vector3 fallback)]
+     {:x (number-or (:x input) (:x fallback))
+      :y (number-or (:y input) (:y fallback))
+      :z (number-or (:z input) (:z fallback))})))
+
+(defn normalize-quaternion
+  [value]
+  (let [input (data-map value)
+        raw {:x (number-or (:x input) 0)
+             :y (number-or (:y input) 0)
+             :z (number-or (:z input) 0)
+             :w (number-or (:w input) 1)}
+        length (js/Math.hypot (:x raw) (:y raw) (:z raw) (:w raw))]
+    (if (< length default-epsilon)
+      identity-quaternion
+      {:x (/ (:x raw) length)
+       :y (/ (:y raw) length)
+       :z (/ (:z raw) length)
+       :w (/ (:w raw) length)})))
+
+(defn subtract-vector3
+  [a b]
+  {:x (- (:x a) (:x b))
+   :y (- (:y a) (:y b))
+   :z (- (:z a) (:z b))})
+
+(defn length-sq
+  [v]
+  (+ (* (:x v) (:x v))
+     (* (:y v) (:y v))
+     (* (:z v) (:z v))))
+
+(defn normalize-direction
+  [v epsilon]
+  (let [length (js/Math.sqrt (length-sq v))]
+    (if (< length epsilon)
+      zero-vector3
+      {:x (/ (:x v) length)
+       :y (/ (:y v) length)
+       :z (/ (:z v) length)})))
+
+(defn invert-unit-quaternion
+  [q]
+  {:x (- (:x q))
+   :y (- (:y q))
+   :z (- (:z q))
+   :w (:w q)})
+
+(defn apply-quaternion
+  [v q]
+  ;; This mirrors Three.js Vector3.applyQuaternion, but stays independent from
+  ;; Three so the agency can run in workers and tests with only CLJS data.
+  (let [x (:x v)
+        y (:y v)
+        z (:z v)
+        qx (:x q)
+        qy (:y q)
+        qz (:z q)
+        qw (:w q)
+        ix (+ (* qw x) (* qy z) (- (* qz y)))
+        iy (+ (* qw y) (* qz x) (- (* qx z)))
+        iz (+ (* qw z) (* qx y) (- (* qy x)))
+        iw (- 0 (* qx x) (* qy y) (* qz z))]
+    {:x (+ (* ix qw) (* iw (- qx)) (* iy (- qz)) (- (* iz (- qy))))
+     :y (+ (* iy qw) (* iw (- qy)) (* iz (- qx)) (- (* ix (- qz))))
+     :z (+ (* iz qw) (* iw (- qz)) (* ix (- qy)) (- (* iy (- qx))))}))
+
+(defn compute-camera-relative-offset
+  "Return a normalized gaze offset from camera position relative to a target.
+
+  Positive x means the camera is toward the model's local right side. Positive y
+  means the camera is above the target. The weights match the Latticework helper
+  defaults, while the inputs are portable data facts instead of Three objects."
+  ([camera-position target-position model-quaternion]
+   (compute-camera-relative-offset camera-position target-position model-quaternion {}))
+  ([camera-position target-position model-quaternion options]
+   (let [options (data-map options)
+         epsilon (number-or (:epsilon options) default-epsilon)
+         yaw-weight (number-or (:yawWeight options)
+                               (number-or (:yaw-weight options) default-yaw-weight))
+         pitch-weight (number-or (:pitchWeight options)
+                                 (number-or (:pitch-weight options) default-pitch-weight))
+         camera-position (normalize-vector3 camera-position)
+         target-position (normalize-vector3 target-position)
+         world-offset (subtract-vector3 camera-position target-position)]
+     (if (< (length-sq world-offset) epsilon)
+       zero-offset
+       (let [world-direction (normalize-direction world-offset epsilon)
+             local-direction (normalize-direction
+                              (apply-quaternion world-direction
+                                                (invert-unit-quaternion
+                                                 (normalize-quaternion model-quaternion)))
+                              epsilon)
+             yaw-angle (js/Math.atan2 (:x local-direction) (:z local-direction))
+             pitch-angle (js/Math.atan2
+                          (:y local-direction)
+                          (max (js/Math.hypot (:x local-direction) (:z local-direction))
+                               epsilon))
+             half-pi (/ (.-PI js/Math) 2)
+             third-pi (/ (.-PI js/Math) 3)]
+         {:x (* (clamp -1 1 (/ yaw-angle half-pi)) yaw-weight)
+          :y (* (clamp -1 1 (/ pitch-angle third-pi)) pitch-weight)})))))
+
+(defn camera-payload
+  [command]
+  (let [payload (data-map command)
+        facts (data-map (:facts payload))]
+    (merge facts payload)))
+
+(defn normalize-camera-fact
+  "Create the stable fact payload published by the agency.
+
+  The command can either put facts at the top level or under :facts. Keeping the
+  shape forgiving lets tests, workers, and runtime adapters evolve without
+  changing the internal fact contract."
+  [command config observed-at sequence]
+  (let [payload (camera-payload command)
+        camera-position (normalize-vector3
+                         (or (:cameraPosition payload)
+                             (:camera-position payload)
+                             (get-in payload [:camera :position])
+                             (:position payload)))
+        target-position (normalize-vector3
+                         (or (:targetPosition payload)
+                             (:target-position payload)
+                             (get-in payload [:controls :target])
+                             (:target payload)))
+        model-quaternion (normalize-quaternion
+                          (or (:modelQuaternion payload)
+                              (:model-quaternion payload)
+                              (get-in payload [:model :quaternion])
+                              (get-in payload [:model :worldQuaternion])
+                              (:worldQuaternion payload)))
+        offset (compute-camera-relative-offset camera-position
+                                               target-position
+                                               model-quaternion
+                                               config)]
+    {:kind "camera.relative"
+     :agency "cameraContext"
+     :sequence sequence
+     :source (or (:source payload) "runtime")
+     :observedAt observed-at
+     :cameraPosition camera-position
+     :targetPosition target-position
+     :modelQuaternion model-quaternion
+     :relativeOffset offset
+     :stale false}))

package/src/polymer/camera_context/planner.cljs

@@ -0,0 +1,50 @@
+(ns polymer.camera-context.planner)
+
+;; The first Camera Context planner is deliberately small. It validates the
+;; command vocabulary and produces auditable action data; the agency and
+;; scheduler still execute those actions explicitly.
+
+(def supported-command-types
+  #{"configure"
+    "updateCamera"
+    "publishCameraFacts"
+    "invalidateStale"
+    "reset"})
+
+(defn command-goal
+  [command state now-ms]
+  {:type (:type command)
+   :hasPublishedFact (boolean (:lastPublishedAt state))
+   :stale (:stale state)
+   :nowMs now-ms})
+
+(defn failure-step
+  [goal]
+  (when-not (contains? supported-command-types (:type goal))
+    {:op "fail"
+     :reason "unsupported-command"
+     :commandType (:type goal)}))
+
+(defn command-steps
+  [goal]
+  (if-let [failure (failure-step goal)]
+    [failure]
+    (case (:type goal)
+      "configure" [{:op "apply-config"}]
+      "updateCamera" [{:op "stabilize/coalesce-update"}
+                      {:op "publish-camera-facts"}]
+      "publishCameraFacts" [{:op "publish-camera-facts"}]
+      "invalidateStale" [{:op "invalidate-stale"}]
+      "reset" [{:op "reset-state"}])))
+
+(defn plan-ok?
+  [steps]
+  (not= "fail" (:op (first steps))))
+
+(defn plan-command
+  [command state now-ms]
+  (let [goal (command-goal command state now-ms)
+        steps (command-steps goal)]
+    {:goal goal
+     :steps steps
+     :ok (plan-ok? steps)}))

package/src/polymer/camera_context/scheduler.cljs

@@ -0,0 +1,113 @@
+(ns polymer.camera-context.scheduler)
+
+;; The scheduler is the only Camera Context namespace that owns timers. Runtime
+;; camera notifications can arrive at frame cadence, but the agency should only
+;; publish stabilized facts after this coalescing boundary.
+
+(defn now-ms
+  []
+  (.now js/Date))
+
+(defn clear-timeout!
+  [timer-atom]
+  (when-let [timer @timer-atom]
+    (js/clearTimeout timer)
+    (reset! timer-atom nil)))
+
+(defn queue-entry
+  [effect index]
+  (assoc effect
+         :queueIndex index
+         :queuedAt (now-ms)))
+
+(defn create-scheduler
+  [{:keys [state-atom publish-fact! invalidate-stale!]}]
+  (let [publish-timer (atom nil)
+        stale-timer (atom nil)
+        pending-fact (atom nil)
+        queue (atom [])
+        disposed? (atom false)]
+    (letfn [(enqueue! [effect]
+              (let [entry (queue-entry effect (count @queue))]
+                (swap! queue conj entry)
+                entry))
+
+            (schedule-stale! []
+              (clear-timeout! stale-timer)
+              (when-not @disposed?
+                (let [delay-ms (get-in @state-atom [:config :staleAfterMs])
+                      published-at (:lastPublishedAt @state-atom)]
+                  (when (pos? delay-ms)
+                    (reset! stale-timer
+                            (js/setTimeout
+                             (fn []
+                               (reset! stale-timer nil)
+                               (when (and (not @disposed?)
+                                          (nil? @pending-fact)
+                                          (= published-at (:lastPublishedAt @state-atom)))
+                                 (enqueue! {:type "invalidateStale"
+                                            :agency "cameraContext"
+                                            :reason "timeout"})
+                                 (invalidate-stale! "timeout")))
+                             delay-ms))))))
+
+            (publish-now! []
+              (when-not @disposed?
+                (clear-timeout! publish-timer)
+                (when-let [fact @pending-fact]
+                  (reset! pending-fact nil)
+                  (enqueue! {:type "publishCameraFact"
+                             :agency "cameraContext"
+                             :sequence (:sequence fact)})
+                  (publish-fact! fact)
+                  (schedule-stale!))))
+
+            (schedule-publish! [fact]
+              (when-not @disposed?
+                (reset! pending-fact fact)
+                (clear-timeout! publish-timer)
+                (clear-timeout! stale-timer)
+                (let [delay-ms (get-in @state-atom [:config :coalesceMs])]
+                  (enqueue! {:type "coalesceCameraFact"
+                             :agency "cameraContext"
+                             :sequence (:sequence fact)
+                             :coalesceMs delay-ms})
+                  (if (pos? delay-ms)
+                    (reset! publish-timer
+                            (js/setTimeout publish-now! delay-ms))
+                    (publish-now!)))))]
+      {:schedule-camera-update
+       (fn [fact]
+         (schedule-publish! fact))
+
+       :publish-now
+       (fn []
+         (publish-now!))
+
+       :invalidate-stale
+       (fn [reason]
+         (when-not @disposed?
+           (clear-timeout! stale-timer)
+           (enqueue! {:type "invalidateStale"
+                      :agency "cameraContext"
+                      :reason reason})
+           (invalidate-stale! reason)))
+
+       :reset
+       (fn []
+         (clear-timeout! publish-timer)
+         (clear-timeout! stale-timer)
+         (reset! pending-fact nil)
+         (reset! queue []))
+
+       :queue
+       (fn []
+         @queue)
+
+       :dispose
+       (fn []
+         (reset! disposed? true)
+         (clear-timeout! publish-timer)
+         (clear-timeout! stale-timer)
+         (reset! pending-fact nil)
+         (reset! queue []))})))

package/src/polymer/camera_context/state.cljs

@@ -0,0 +1,121 @@
+(ns polymer.camera-context.state
+  (:require [polymer.camera-context.domain :as domain]))
+
+;; Camera Context state is the local ledger of stable runtime facts. The agency
+;; may observe many camera updates, but only scheduler-approved facts become
+;; published stream data for peer agencies.
+
+(def default-config
+  {:coalesceMs 16
+   :staleAfterMs 1000
+   :epsilon domain/default-epsilon
+   :yawWeight domain/default-yaw-weight
+   :pitchWeight domain/default-pitch-weight})
+
+(defn normalize-config
+  [config]
+  (let [input (merge default-config (domain/data-map config))]
+    {:coalesceMs (int (domain/clamp 0 1000
+                                    (domain/number-or (:coalesceMs input)
+                                                      (:coalesceMs default-config))))
+     :staleAfterMs (int (domain/clamp 0 60000
+                                      (domain/number-or (:staleAfterMs input)
+                                                        (:staleAfterMs default-config))))
+     :epsilon (domain/clamp 1.0e-9 1
+                             (domain/number-or (:epsilon input)
+                                               (:epsilon default-config)))
+     :yawWeight (domain/clamp 0 1
+                              (domain/number-or (:yawWeight input)
+                                                (:yawWeight default-config)))
+     :pitchWeight (domain/clamp 0 1
+                                (domain/number-or (:pitchWeight input)
+                                                  (:pitchWeight default-config)))}))
+
+(defn default-state
+  [config]
+  {:agency "cameraContext"
+   :status "idle"
+   :cameraPosition nil
+   :targetPosition nil
+   :modelQuaternion domain/identity-quaternion
+   :relativeOffset domain/zero-offset
+   :lastUpdatedAt nil
+   :lastPublishedAt nil
+   :lastFact nil
+   :lastPlan nil
+   :lastInvalidation nil
+   :stale false
+   :invalidated false
+   :updateCount 0
+   :publishedCount 0
+   :config (normalize-config config)})
+
+(defn config->state
+  [config]
+  (default-state config))
+
+(defn visible-state
+  [state]
+  (clj->js state))
+
+(defn configure
+  [state config]
+  (assoc state :config (normalize-config (merge (:config state)
+                                                (domain/data-map config)))))
+
+(defn reset-state
+  [state]
+  ;; Reset clears camera facts and counters while preserving the normalized
+  ;; runtime cadence supplied when this agency was created or configured.
+  (default-state (:config state)))
+
+(defn record-plan
+  [state plan]
+  (assoc state :lastPlan plan))
+
+(defn record-camera-update
+  [state fact]
+  (-> state
+      (assoc :status "pending"
+             :cameraPosition (:cameraPosition fact)
+             :targetPosition (:targetPosition fact)
+             :modelQuaternion (:modelQuaternion fact)
+             :relativeOffset (:relativeOffset fact)
+             :lastUpdatedAt (:observedAt fact)
+             :stale false
+             :invalidated false)
+      (update :updateCount inc)))
+
+(defn record-published
+  [state fact published-at]
+  (-> state
+      (assoc :status "fresh"
+             :lastFact (assoc fact :publishedAt published-at)
+             :lastPublishedAt published-at
+             :stale false
+             :invalidated false)
+      (update :publishedCount inc)))
+
+(defn stale-fact
+  [state invalidated-at reason]
+  {:kind "camera.stale"
+   :agency "cameraContext"
+   :status "stale"
+   :reason reason
+   :invalidatedAt invalidated-at
+   :lastPublishedAt (:lastPublishedAt state)
+   :lastObservedAt (:lastUpdatedAt state)
+   :lastRelativeOffset (:relativeOffset state)})
+
+(defn can-invalidate?
+  [state]
+  (and (:lastPublishedAt state) (not (:stale state))))
+
+(defn record-stale
+  [state invalidated-at reason]
+  (let [fact (stale-fact state invalidated-at reason)]
+    (assoc state
+           :status "stale"
+           :stale true
+           :invalidated true
+           :lastInvalidation fact)))