@lovelace_lol/polymer 0.0.7 → 0.0.9

package/src/polymer/society.cljs

@@ -1,253 +0,0 @@
-(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 accepted-edge-context
-  [edge]
-  {:edgeId (:id edge)
-   :from (:from edge)
-   :to (:to edge)
-   :credit (:credit edge)})
-
-(defn route-contexts
-  "Return all accepted edge metadata for one outgoing domain event.
-
-  An empty result means the topology, agency enablement, match predicate, or edge
-  credit rejected all candidate routes before they reached receiving agencies."
-  [society from event]
-  (if-not (agency-enabled? society from)
-    []
-    (into []
-          (keep (fn [edge]
-                  (when (and (= from (:from edge))
-                             (= (:type event) (:type edge))
-                             (agency-enabled? society (:to edge))
-                             (:enabled edge)
-                             (pos? (:credit edge))
-                             (match-event? (:match edge) event))
-                    (accepted-edge-context edge))))
-          (:edges society))))
-
-(defn route-context
-  "Return one accepted edge metadata entry for an outgoing event and target.
-
-  A nil result means the route was rejected before it reached the receiving
-  agency."
-  [society from event to]
-  (some #(when (= to (:to %)) %)
-        (route-contexts society from event)))
-
-(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

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

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

@@ -1,68 +0,0 @@
-(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"}))))