@lovelace_lol/polymer 0.0.1

package/src/polymer/society.cljs

@@ -0,0 +1,239 @@
+(ns polymer.society)
+
+;; Default agencySociety seed for hosts and character profiles.
+;;
+;; Mirrors today's hardcoded polymer.character routing. When character.cljs
+;; gains or drops a route, update this seed in the same change.
+;;
+;; See docs/agency-architecture.md (Agency Society Config) and issues #63/#64.
+
+(def agency-names
+  ["animation"
+   "blink"
+   "gaze"
+   "eyeHeadTracking"
+   "gesture"
+   "cameraContext"
+   "transcription"
+   "conversation"
+   "tts"
+   "lipSync"
+   "prosodic"])
+
+(def required-agency-names
+  #{"animation" "transcription" "tts" "lipSync" "conversation"})
+
+(defn- agency-entry [name]
+  {:required (contains? required-agency-names name)
+   :enabled true
+   :priors {}
+   :configure {}})
+
+(defn- edge
+  ([id from type to required]
+   (edge id from type to required nil))
+  ([id from type to required match]
+   (cond-> {:id id
+            :from from
+            :type type
+            :to to
+            :required required
+            :enabled true
+            :credit 1.0}
+     match (assoc :match match))))
+
+(def default-edges
+  [;; Perception → gaze → motor
+   (edge "cameraContext.camera.fact→gaze" "cameraContext" "camera.fact" "gaze" true)
+   (edge "cameraContext.camera.stale→gaze" "cameraContext" "camera.stale" "gaze" true)
+   (edge "gaze.eyeHeadTracking.requestGaze→eyeHeadTracking" "gaze" "eyeHeadTracking.requestGaze" "eyeHeadTracking" true)
+   (edge "gaze.eyeHeadTracking.requestReset→eyeHeadTracking" "gaze" "eyeHeadTracking.requestReset" "eyeHeadTracking" true)
+   (edge "gaze.eyeHeadTracking.requestCancel→eyeHeadTracking" "gaze" "eyeHeadTracking.requestCancel" "eyeHeadTracking" true)
+
+   ;; Embodiment → animation apply gate
+   (edge "blink.animation.requestScheduleSnippet→animation" "blink" "animation.requestScheduleSnippet" "animation" true)
+   (edge "eyeHeadTracking.animation.requestScheduleSnippet→animation" "eyeHeadTracking" "animation.requestScheduleSnippet" "animation" true)
+   (edge "eyeHeadTracking.animation.requestRemoveSnippet→animation" "eyeHeadTracking" "animation.requestRemoveSnippet" "animation" true)
+   (edge "gesture.animation.requestScheduleSnippet→animation" "gesture" "animation.requestScheduleSnippet" "animation" true)
+   (edge "gesture.animation.requestRemoveSnippet→animation" "gesture" "animation.requestRemoveSnippet" "animation" true)
+   (edge "lipSync.animation.requestScheduleSnippet→animation" "lipSync" "animation.requestScheduleSnippet" "animation" true)
+   (edge "lipSync.animation.requestRemoveSnippet→animation" "lipSync" "animation.requestRemoveSnippet" "animation" true)
+   (edge "lipSync.animation.requestSeekSnippet→animation" "lipSync" "animation.requestSeekSnippet" "animation" true)
+   (edge "prosodic.animation.requestScheduleSnippet→animation" "prosodic" "animation.requestScheduleSnippet" "animation" true)
+   (edge "prosodic.animation.requestRemoveSnippet→animation" "prosodic" "animation.requestRemoveSnippet" "animation" true)
+
+   ;; Blink ↔ prosodic coupling (seeded; not required — may be disabled per character)
+   (edge "blink.signal.blink-fast→prosodic" "blink" "signal" "prosodic" false {:signal "blink-fast"})
+
+   ;; Speech discourse (required cores)
+   (edge "transcription.transcription.final→conversation" "transcription" "transcription.final" "conversation" true)
+   (edge "transcription.transcription.interruption→conversation" "transcription" "transcription.interruption" "conversation" true)
+   (edge "transcription.transcription.audioInterruption→conversation" "transcription" "transcription.audioInterruption" "conversation" true)
+   (edge "conversation.conversation.userUtterance→prosodic" "conversation" "conversation.userUtterance" "prosodic" false)
+   (edge "conversation.conversation.userUtterance→gaze" "conversation" "conversation.userUtterance" "gaze" false)
+   (edge "conversation.conversation.agentUtterance→prosodic" "conversation" "conversation.agentUtterance" "prosodic" false)
+   (edge "conversation.conversation.agentUtterance→gaze" "conversation" "conversation.agentUtterance" "gaze" false)
+   (edge "conversation.conversation.requestResponse→prosodic" "conversation" "conversation.requestResponse" "prosodic" false)
+   (edge "conversation.tts.requestSpeak→tts" "conversation" "tts.requestSpeak" "tts" true)
+   (edge "conversation.conversation.cancelRequested→tts" "conversation" "conversation.cancelRequested" "tts" true)
+   (edge "conversation.conversation.cancelRequested→prosodic" "conversation" "conversation.cancelRequested" "prosodic" false)
+   (edge "conversation.conversation.cancelRequested→gaze" "conversation" "conversation.cancelRequested" "gaze" false)
+   (edge "tts.lipSync.command→lipSync" "tts" "lipSync.command" "lipSync" true)
+   (edge "tts.ttsStatusChanged→conversation" "tts" "ttsStatusChanged" "conversation" true)
+   (edge "tts.ttsStatusChanged→transcription" "tts" "ttsStatusChanged" "transcription" true)
+   (edge "tts.ttsSpeechStarted→prosodic" "tts" "ttsSpeechStarted" "prosodic" true)
+   (edge "tts.ttsSpeechStarted→transcription" "tts" "ttsSpeechStarted" "transcription" true)
+   (edge "tts.ttsSpeechStarted→conversation" "tts" "ttsSpeechStarted" "conversation" true)
+   (edge "tts.ttsWordBoundary→prosodic" "tts" "ttsWordBoundary" "prosodic" true)
+   (edge "tts.ttsSpeechStopped→prosodic" "tts" "ttsSpeechStopped" "prosodic" true)
+   (edge "tts.ttsSpeechStopped→transcription" "tts" "ttsSpeechStopped" "transcription" true)
+   (edge "tts.ttsSpeechStopped→conversation" "tts" "ttsSpeechStopped" "conversation" true)
+   (edge "tts.ttsSpeechEnded→prosodic" "tts" "ttsSpeechEnded" "prosodic" true)
+   (edge "tts.ttsSpeechEnded→transcription" "tts" "ttsSpeechEnded" "transcription" true)
+   (edge "tts.ttsSpeechEnded→conversation" "tts" "ttsSpeechEnded" "conversation" true)])
+
+(def default-agency-society
+  {:version 1
+   :agencies (into {} (map (fn [name] [name (agency-entry name)]) agency-names))
+   :edges default-edges
+   :kLines []
+   :cb5t {:E 0.5 :N 0.5 :C 0.5 :A 0.5 :O 0.5}
+   :personaPackId nil
+   :characterRollup {:type "weightedSum"}})
+
+(def DEFAULT_AGENCY_SOCIETY
+  "JS-facing default agencySociety seed (plain JS object)."
+  (clj->js default-agency-society))
+
+(defn default-edge-ids
+  "Return the set of default edge ids for sync tests."
+  []
+  (set (map :id default-edges)))
+
+(defn value->clj [value]
+  (cond
+    (nil? value) nil
+    (map? value) value
+    :else (js->clj value :keywordize-keys true)))
+
+(defn finite-number? [value]
+  (and (number? value) (js/isFinite value)))
+
+(defn clamp-credit [value]
+  (if (finite-number? value)
+    (max 0 (min 1 value))
+    1.0))
+
+(defn normalize-map [value]
+  (let [resolved (value->clj value)]
+    (if (map? resolved) resolved {})))
+
+(defn normalize-agency-entry [name provided]
+  (let [base (agency-entry name)
+        merged (merge base (normalize-map provided))
+        required? (contains? required-agency-names name)]
+    (assoc merged
+           :required required?
+           :enabled (if required? true (not (false? (:enabled merged))))
+           :priors (normalize-map (:priors merged))
+           :configure (normalize-map (:configure merged)))))
+
+(defn valid-edge? [edge]
+  (and (string? (:id edge))
+       (string? (:from edge))
+       (string? (:type edge))
+       (string? (:to edge))))
+
+(defn normalize-edge [base provided]
+  (let [merged (merge base (normalize-map provided))
+        required? (true? (:required base))
+        requested-credit (clamp-credit (:credit merged))
+        credit (if (and required? (not (pos? requested-credit)))
+                 (clamp-credit (:credit base))
+                 requested-credit)]
+    (assoc merged
+           :required required?
+           :enabled (if required? true (not (false? (:enabled merged))))
+           :credit credit
+           :match (normalize-map (:match merged)))))
+
+(defn normalize-agency-society
+  "Merge a profile society document over the canonical seed.
+
+  Required agencies and edges cannot be disabled by profile data. Optional
+  custom edges are retained when they have a complete data shape."
+  [value]
+  (let [provided (normalize-map value)
+        provided-agencies (normalize-map (:agencies provided))
+        provided-edges (->> (or (:edges provided) [])
+                            (map normalize-map)
+                            (filter #(string? (:id %))))
+        provided-by-id (into {} (map (juxt :id identity) provided-edges))
+        default-ids (default-edge-ids)
+        normalized-defaults (mapv (fn [base]
+                                    (normalize-edge base (get provided-by-id (:id base))))
+                                  default-edges)
+        custom-edges (->> provided-edges
+                          (remove #(contains? default-ids (:id %)))
+                          (filter valid-edge?)
+                          (mapv #(normalize-edge {} %)))]
+    (-> default-agency-society
+        (merge (select-keys provided [:kLines :cb5t :personaPackId :characterRollup]))
+        (assoc :version 1
+               :agencies (into {}
+                               (map (fn [name]
+                                      [name (normalize-agency-entry
+                                             name
+                                             (or (get provided-agencies name)
+                                                 (get provided-agencies (keyword name))))])
+                                    agency-names))
+               :edges (into normalized-defaults custom-edges)))))
+
+(defn agency-entry-for [society name]
+  (get-in society [:agencies name]))
+
+(defn agency-enabled? [society name]
+  (true? (:enabled (agency-entry-for society name))))
+
+(defn agency-configure [society name]
+  (:configure (agency-entry-for society name)))
+
+(defn agency-priors [society name]
+  (:priors (agency-entry-for society name)))
+
+(defn match-event? [match event]
+  (every? (fn [[key expected]] (= expected (get event key))) match))
+
+(defn route-context
+  "Return the accepted edge metadata for one outgoing domain event.
+
+  A nil result means the topology, agency enablement, match predicate, or edge
+  credit rejected the route before it reached the receiving agency."
+  [society from event to]
+  (when (and (agency-enabled? society from)
+             (agency-enabled? society to))
+    (some (fn [edge]
+            (when (and (= from (:from edge))
+                       (= to (:to edge))
+                       (= (:type event) (:type edge))
+                       (:enabled edge)
+                       (pos? (:credit edge))
+                       (match-event? (:match edge) event))
+              {:edgeId (:id edge)
+               :from from
+               :to to
+               :credit (:credit edge)}))
+          (:edges society))))
+
+(defn agency-config
+  "Create one JS agency config without converting runtime/provider handles.
+
+  Direct constructor options supply runtime objects. Profile `configure`
+  values override operational knobs, and `priors` are attached as plain data
+  for each agency's local planner."
+  [root-config society name]
+  (let [direct (when root-config (aget root-config name))
+        output (js/Object.assign #js {} (or direct #js {})
+                                 (clj->js (agency-configure society name)))]
+    (aset output "priors" (clj->js (agency-priors society name)))
+    output))

package/src/polymer/stream.cljs

@@ -0,0 +1,130 @@
+(ns polymer.stream)
+
+;; Polymer keeps its stream primitive deliberately small.
+;;
+;; The important architectural point is not this particular implementation.
+;; The important point is the boundary shape: agencies exchange plain immutable
+;; data. A specific agency, such as Animation, may own a runtime side effect,
+;; but a host application should not become the cross-agency router.
+
+(defn- default-listener-error-reporter
+  [{:keys [error]}]
+  (.error js/console "[Polymer stream] listener failed" error))
+
+(defn- report-listener-error!
+  [reporter listener payload error]
+  (try
+    (reporter {:type :stream/listener-error
+               :listener listener
+               :event payload
+               :error error})
+    (catch :default reporter-error
+      ;; A broken diagnostic callback must not turn an isolated listener failure
+      ;; back into a failed delivery pass.
+      (.error js/console
+              "[Polymer stream] listener error reporter failed"
+              reporter-error
+              error))))
+
+(defn create-stream
+  "Create a synchronous in-process stream.
+
+  Listeners receive JavaScript objects because this is the public package
+  boundary. Inside Polymer we keep using Clojure maps so agency code stays
+  simple and data-oriented.
+
+  An optional :on-listener-error callback receives a Clojure map describing a
+  failed listener. Errors are isolated from later listeners and are not emitted
+  as a generic public stream."
+  ([]
+   (create-stream {}))
+  ([{:keys [on-listener-error]}]
+   (let [listeners (atom [])
+         next-listener-id (atom 0)
+         pending-events (atom cljs.core/PersistentQueue.EMPTY)
+         draining? (atom false)
+         reporter (or on-listener-error default-listener-error-reporter)]
+     (letfn [(deliver! [event]
+               (let [payload (clj->js event)
+                     ;; A listener added during this pass starts with the next
+                     ;; event. Each record still has a live flag so a listener
+                     ;; removed before its turn is skipped immediately.
+                     delivery-listeners @listeners]
+                 (doseq [{:keys [listener active?]} delivery-listeners]
+                   (when @active?
+                     (try
+                       (listener payload)
+                       (catch :default error
+                         (report-listener-error!
+                          reporter listener payload error)))))))
+
+             (drain! []
+               ;; Reentrant emits only append to the queue. The outer drain loop
+               ;; completes the current event before processing nested events,
+               ;; avoiding recursive delivery and preserving FIFO order.
+               (when-not @draining?
+                 (reset! draining? true)
+                 (try
+                   (loop []
+                     (when (seq @pending-events)
+                       (let [event (peek @pending-events)]
+                         (swap! pending-events pop)
+                         (deliver! event)
+                         (recur))))
+                   (finally
+                     (reset! draining? false)))))]
+       {:emit
+        (fn [event]
+          (swap! pending-events conj event)
+          (drain!))
+
+        :subscribe
+        (fn [listener]
+          ;; Subscription records preserve registration order and allow the same
+          ;; callback to be subscribed independently more than once.
+          (let [listener-id (swap! next-listener-id inc)
+                active? (atom true)]
+            (swap! listeners conj {:id listener-id
+                                   :listener listener
+                                   :active? active?})
+            (fn []
+              ;; compare-and-set! gives each subscription an idempotent cleanup
+              ;; even when several owners race to tear down the same port.
+              (when (compare-and-set! active? true false)
+                (swap! listeners
+                       (fn [current]
+                         (into []
+                               (remove #(= listener-id (:id %)))
+                               current)))))))
+
+        :dispose
+        (fn []
+          ;; Mark the current delivery snapshot inactive before clearing storage
+          ;; so disposal during a callback skips later listeners and queued work.
+          (doseq [{:keys [active?]} @listeners]
+            (reset! active? false))
+          (reset! listeners [])
+          (reset! pending-events cljs.core/PersistentQueue.EMPTY))}))))
+
+(defn readable-port
+  "Expose a JS-facing read-only stream port."
+  [stream]
+  #js {:subscribe (fn [listener] ((:subscribe stream) listener))})
+
+(defn writable-port
+  "Expose a JS-facing writable stream port.
+
+  The write function is supplied by the owning agency/system because writing to
+  input usually means validating and routing a command, not blindly broadcasting
+  data."
+  [stream write!]
+  #js {:write write!
+       :subscribe (fn [listener] ((:subscribe stream) listener))})
+
+(defn subscribe-many
+  "Subscribe one listener to several streams and return one unsubscriber."
+  [streams listener]
+  (let [unsubscribers (mapv #((:subscribe %) listener) streams)]
+    (fn []
+      (doseq [unsubscribe unsubscribers]
+        (unsubscribe)))))

package/src/polymer/transcription/agency.cljs

@@ -0,0 +1,69 @@
+(ns polymer.transcription.agency
+  (:require [polymer.stream :as stream]
+            [polymer.transcription.domain :as domain]
+            [polymer.transcription.effector :as effector]
+            [polymer.transcription.planner :as planner]
+            [polymer.transcription.scheduler :as scheduler]
+            [polymer.transcription.state :as state]))
+
+;; Transcription turns provider recognition callbacks into stable speech facts.
+;; Peer agencies only see data: partial/final transcripts, status, diagnostics,
+;; and provider lifecycle requests. Browser work is private to the effector
+;; reached through this agency's planner and scheduler.
+
+(defn now-ms
+  []
+  (.now js/Date))
+
+(defn create-transcription-agency
+  ([config]
+   (create-transcription-agency config nil))
+  ([config runtime]
+   (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 (planner/plan-command payload @state-atom (now-ms))]
+                   (emit-input {:type "command"
+                                :agency "transcription"
+                                :command payload})
+                   (when-let [agency-scheduler @scheduler-atom]
+                     ((:schedule agency-scheduler) payload plan)))))
+             (dispatch-type! [type]
+               (dispatch! #js {:type type}))]
+       (let [provider-effector (effector/create-effector
+                                {:dispatch dispatch!
+                                 :get-state #(deref state-atom)
+                                 :runtime runtime})
+             agency-scheduler (scheduler/create-scheduler
+                               {:state-atom state-atom
+                                :emit-event emit-event
+                                :effector provider-effector})]
+         (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))
+               :start (fn [] (dispatch-type! "start"))
+               :stop (fn [] (dispatch-type! "stop"))
+               :reset (fn [] (dispatch-type! "reset"))
+               :setAgentAudioReferenceTrack
+               (fn [track]
+                 ((:set-reference-track agency-scheduler) track))
+               :queue (fn [] (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/transcription/domain.cljs

@@ -0,0 +1,68 @@
+(ns polymer.transcription.domain
+  (:require [clojure.string :as str]))
+
+;; Pure Transcription transforms live here. Provider/browser work stays outside
+;; this namespace; these helpers only normalize command data and transcript text.
+
+(defn data-map
+  [value]
+  (cond
+    (map? value) value
+    value (js->clj value :keywordize-keys true)
+    :else {}))
+
+(defn clean-text
+  [value]
+  (let [text (str/trim (or value ""))]
+    (when (pos? (count text))
+      text)))
+
+(defn text-or
+  [value fallback]
+  (or (clean-text value) fallback))
+
+(defn transcript-text
+  [command]
+  (clean-text (or (:text command) (:transcript command))))
+
+(defn agent-source?
+  [command]
+  (contains? #{"agent" "tts" "speaker" "system"}
+             (str/lower-case (or (:source command) (:speaker command) ""))))
+
+(defn word-tokens
+  [text]
+  (->> (str/split (str/lower-case (or text "")) #"\s+")
+       (remove str/blank?)
+       vec))
+
+(defn word-set
+  [text]
+  (set (word-tokens text)))
+
+(defn agent-echo?
+  [command current-state]
+  (let [text (or (transcript-text command) "")
+        tokens (word-tokens text)
+        words (set tokens)
+        agent-words (:agentWords current-state)
+        script (:agentScript current-state)
+        overlap (count (filter agent-words words))]
+    (and (get-in current-state [:config :agentFilteringEnabled])
+         (:agentSpeaking current-state)
+         (seq tokens)
+         (or (every? agent-words tokens)
+             (and (seq script) (str/starts-with? script (str/lower-case text)))
+             (and (seq words)
+                  (pos? overlap)
+                  (>= (/ overlap (count words)) 0.65))))))
+
+(defn boundary-events
+  [text now-ms]
+  (->> (str/split (or text "") #"\s+")
+       (remove str/blank?)
+       (map-indexed (fn [index word]
+                      {:word word
+                       :index index
+                       :timestamp now-ms
+                       :speaker "user"}))))