@lovelace_lol/polymer 0.0.1

package/src/polymer/lipsync/scheduler.cljs

@@ -0,0 +1,302 @@
+(ns polymer.lipsync.scheduler
+  (:require [clojure.string :as str]))
+
+;; LipSync's scheduler owns the effector queue for one utterance.
+;;
+;; The LipSync agency decides what speech timeline is active and records state.
+;; The scheduler owns the ordered work produced by that decision:
+;; schedule the combined lip/jaw/tongue snippet, seek it when audio or word
+;; boundaries reveal drift, remove it when the utterance is stopped/replaced, and
+;; fire the local finish callback after the snippet should be done. It still does
+;; not call Embody directly; it emits animation intent as data for Polymer
+;; Animation to execute.
+
+(def cleanup-buffer-ms 80)
+
+(defn now-ms []
+  (.now js/Date))
+
+(defn finite-positive? [value]
+  (and (number? value) (js/isFinite value) (pos? value)))
+
+(def tongue-au-ids #{37 38 39 40 41 42 73 74 76 77})
+
+(defn clear-timeout! [timer-atom]
+  (when-let [timer @timer-atom]
+    (js/clearTimeout timer)
+    (reset! timer-atom nil)))
+
+(defn effector-target [channel]
+  (let [target (:target channel)
+        target-type (:type target)]
+    (case target-type
+      "viseme" "lip"
+      "au" (case (:id target)
+             26 "jaw"
+             (if (contains? tongue-au-ids (:id target)) "tongue" "au"))
+      "bone" (case (:id target)
+               "JAW" "jaw"
+               "TONGUE" "tongue"
+               "bone")
+      target-type)))
+
+(defn snippet-effectors [snippet]
+  (->> (:channels snippet)
+       (keep effector-target)
+       distinct
+       vec))
+
+(defn queue-entry [effect queue-index]
+  (assoc effect
+         :queueIndex queue-index
+         :queuedAt (now-ms)))
+
+(defn promise-like? [value]
+  (boolean (and value (fn? (aget value "then")))))
+
+(defn create-scheduler
+  [{:keys [emit-event on-finished pronunciation-effector on-text-ready]}]
+  (let [finish-timer (atom nil)
+        active-timeline (atom nil)
+        pronunciation-dictionary (atom nil)
+        text-plan-token (atom 0)
+        queue (atom [])
+        disposed? (atom false)]
+    (letfn [(enqueue! [effect]
+              (let [entry (queue-entry effect (count @queue))]
+                (swap! queue conj entry)
+                entry))
+
+            (schedule-finished! [max-time-sec]
+              (clear-timeout! finish-timer)
+              (when (and (not @disposed?) (finite-positive? max-time-sec))
+                (reset! finish-timer
+                        (js/setTimeout
+                         (fn []
+                           (reset! finish-timer nil)
+                           (when-not @disposed?
+                             (enqueue! {:type "finishTimeline"
+                                        :agency "lipSync"
+                                        :reason "completed"})
+                             (on-finished)))
+                         (+ (* max-time-sec 1000) cleanup-buffer-ms)))))
+
+            (schedule-animation! [snippet-data options]
+              (let [effectors (snippet-effectors snippet-data)
+                    entry (enqueue! {:type "scheduleAnimation"
+                                     :agency "lipSync"
+                                     :requestId (:name snippet-data)
+                                     :snippetName (:name snippet-data)
+                                     :effectors effectors})]
+                (emit-event {:type "animation.requestScheduleSnippet"
+                             :agency "lipSync"
+                             :requestId (:requestId entry)
+                             :snippet snippet-data
+                             :options options
+                             :effectors effectors
+                             :queueIndex (:queueIndex entry)
+                             :queuedAt (:queuedAt entry)})
+                (schedule-finished! (:maxTime snippet-data))))
+
+            (report-pronunciation-error! [error]
+              (emit-event {:type "error"
+                           :agency "lipSync"
+                           :message (or (.-message error)
+                                        "Unable to load LipSync pronunciation data")}))
+
+            (load-pronunciations! [on-loaded on-error]
+              (try
+                (let [result ((:load pronunciation-effector))]
+                  (if (promise-like? result)
+                    (-> result
+                        (.then on-loaded)
+                        (.catch on-error))
+                    (on-loaded result)))
+                (catch :default error
+                  (on-error error))))
+
+            (accept-pronunciations! [dictionary]
+              (when dictionary
+                (when (nil? @pronunciation-dictionary)
+                  (reset! pronunciation-dictionary dictionary)
+                  (enqueue! {:type "pronunciationLexiconReady"
+                             :agency "lipSync"})))
+              dictionary)
+
+            (preload-pronunciations! []
+              (when (and (not @disposed?)
+                         (nil? @pronunciation-dictionary))
+                (if-let [dictionary ((:peek pronunciation-effector))]
+                  (reset! pronunciation-dictionary dictionary)
+                  (do
+                    (enqueue! {:type "loadPronunciationLexicon"
+                               :agency "lipSync"
+                               :reason "preload"})
+                    (load-pronunciations!
+                     (fn [dictionary]
+                       (when-not @disposed?
+                         (accept-pronunciations! dictionary)))
+                     (fn [_]
+                       ;; Preload is opportunistic. A later startText retries and
+                       ;; reports an error only if speech actually needs the data.
+                       nil))))))
+
+            (prepare-text! [payload]
+              (let [token (swap! text-plan-token inc)]
+                (if-let [dictionary @pronunciation-dictionary]
+                  (on-text-ready payload dictionary)
+                  (do
+                    (enqueue! {:type "loadPronunciationLexicon"
+                               :agency "lipSync"
+                               :reason "startText"
+                               :requestToken token})
+                    (load-pronunciations!
+                     (fn [dictionary]
+                       (when (and (not @disposed?)
+                                  (= token @text-plan-token))
+                         (if-let [accepted (accept-pronunciations! dictionary)]
+                           (on-text-ready payload accepted)
+                           (report-pronunciation-error!
+                            (js/Error.
+                             "LipSync pronunciation module has no dictionary export")))))
+                     (fn [error]
+                       (when (and (not @disposed?)
+                                  (= token @text-plan-token))
+                         (report-pronunciation-error! error))))))))
+
+            (remove-animation! [name reason]
+              (let [entry (enqueue! {:type "removeAnimation"
+                                     :agency "lipSync"
+                                     :requestId name
+                                     :name name
+                                     :reason reason})]
+                (emit-event {:type "animation.requestRemoveSnippet"
+                             :agency "lipSync"
+                             :requestId name
+                             :name name
+                             :reason reason
+                             :queueIndex (:queueIndex entry)
+                             :queuedAt (:queuedAt entry)})))
+
+            (seek-animation! [name offset-sec reason]
+              (let [request-id (str name ":seek:" (str/replace (str (now-ms)) "." "_"))
+                    entry (enqueue! {:type "seekAnimation"
+                                     :agency "lipSync"
+                                     :requestId request-id
+                                     :name name
+                                     :offsetSec offset-sec
+                                     :reason reason})]
+                (emit-event {:type "animation.requestSeekSnippet"
+                             :agency "lipSync"
+                             :requestId request-id
+                             :name name
+                             :offsetSec offset-sec
+                             :reason reason
+                             :queueIndex (:queueIndex entry)
+                             :queuedAt (:queuedAt entry)})))
+
+            (start-timeline! [snippet-data options]
+              (swap! text-plan-token inc)
+              (let [name (:name snippet-data)
+                    effectors (snippet-effectors snippet-data)
+                    replaced-name (:name @active-timeline)
+                    replacement? (and replaced-name (not= replaced-name name))]
+                ;; A new utterance owns the same mouth/jaw/tongue effectors as
+                ;; the previous utterance, so the scheduler removes the previous
+                ;; animation request before accepting the next start. That keeps
+                ;; replacement ordering in one queue instead of scattering it
+                ;; through agency command handlers.
+                (when replacement?
+                  (remove-animation! replaced-name "replaced"))
+                (reset! active-timeline {:name name
+                                         :maxTime (:maxTime snippet-data)
+                                         :effectors effectors})
+                (enqueue! {:type "startTimeline"
+                           :agency "lipSync"
+                           :requestId name
+                           :snippetName name
+                           :effectors effectors
+                           :maxTime (:maxTime snippet-data)
+                           :replacedName (when replacement? replaced-name)})
+                (schedule-animation! snippet-data options)
+                {:name name
+                 :replacedName (when replacement? replaced-name)
+                 :effectors effectors}))
+
+            (stop-timeline! [reason remove?]
+              (swap! text-plan-token inc)
+              (clear-timeout! finish-timer)
+              (let [current @active-timeline
+                    name (:name current)]
+                (when name
+                  (enqueue! {:type "stopTimeline"
+                             :agency "lipSync"
+                             :requestId name
+                             :snippetName name
+                             :reason reason
+                             :remove? remove?})
+                  (when remove?
+                    (remove-animation! name reason)))
+                (reset! active-timeline nil)
+                {:name name
+                 :reason reason
+                 :remove? remove?}))]
+      {:start-timeline
+       (fn [snippet-data options]
+         (when-not @disposed?
+           (start-timeline! snippet-data options)))
+
+       :preload-pronunciations
+       (fn []
+         (preload-pronunciations!))
+
+       :prepare-text
+       (fn [payload]
+         (when-not @disposed?
+           (prepare-text! payload)))
+
+       :schedule-timeline
+       (fn [snippet-data options]
+         (when-not @disposed?
+           (schedule-animation! snippet-data options)))
+
+       :remove
+       (fn [name reason]
+         (when-not @disposed?
+           (remove-animation! name reason)))
+
+       :seek
+       (fn [name offset-sec reason]
+         (when-not @disposed?
+           (seek-animation! name offset-sec reason)))
+
+       :schedule-finished
+       (fn [max-time-sec]
+         (when-not @disposed?
+           (schedule-finished! max-time-sec)))
+
+       :stop
+       (fn []
+         ;; Replacement/explicit stop cancels only pending local finish. Remove
+         ;; requests are separate queued effector operations.
+         (clear-timeout! finish-timer))
+
+       :stop-timeline
+       (fn [reason remove?]
+         (when-not @disposed?
+           (stop-timeline! reason remove?)))
+
+       :queue
+       (fn []
+         @queue)
+
+       :dispose
+       (fn []
+         ;; Disposal is final for this scheduler instance; late callbacks are
+         ;; guarded by disposed? even if a host implementation fails to clear.
+         (reset! disposed? true)
+         (swap! text-plan-token inc)
+         (clear-timeout! finish-timer)
+         (reset! active-timeline nil)
+         (reset! pronunciation-dictionary nil)
+         (reset! queue []))})))

package/src/polymer/lipsync/state.cljs

@@ -0,0 +1,202 @@
+(ns polymer.lipsync.state
+  (:require [clojure.string :as str]))
+
+;; LipSync state is the agency-local ledger for one character's speech
+;; animation timeline. Provider credentials, audio playback, HTTP, LiveKit, and
+;; browser APIs stay outside Polymer; this state only tracks the deterministic
+;; timing data needed to schedule and correct viseme animation.
+
+(def default-config
+  {:intensity 1
+   :speechRate 1
+   :jawScale 1
+   :tongueScale 1
+   :rampMs 15
+   :holdMs 40
+   :priority 50
+   :visualLeadMs 0
+   :wordDriftThresholdSec 0.06})
+
+(def default-state
+  {:agency "lipSync"
+   :speaking false
+   :currentWord nil
+   :currentViseme nil
+   :snippetName nil
+   :source nil
+   :text nil
+   :startTime nil
+   :audioStartedAt nil
+   :audioTimeSec nil
+   :maxTime 0
+   :wordIndex 0
+   :wordTimings []
+   :scheduledCount 0
+   :stoppedCount 0
+   :syncCorrectionCount 0
+   :config default-config
+   :lastEvent nil})
+
+(defn now-ms []
+  (.now js/Date))
+
+(defn finite-number? [value]
+  (and (number? value) (js/isFinite value)))
+
+(defn clamp [lo hi value]
+  (-> value (max lo) (min hi)))
+
+(defn number-or [value fallback]
+  (if (finite-number? value) value fallback))
+
+(defn sanitize-config [config]
+  ;; This is the only place public config gets clamped. The rest of the agency
+  ;; can then treat config as ordinary data, whether it came from LoomLarge UI,
+  ;; another Polymer agency, or a worker message.
+  (let [merged (merge default-config config)]
+    {:intensity (clamp 0 2 (number-or (:intensity merged) (:intensity default-config)))
+     :speechRate (clamp 0.2 3 (number-or (:speechRate merged) (:speechRate default-config)))
+     :jawScale (clamp 0 2 (number-or (:jawScale merged) (:jawScale default-config)))
+     :tongueScale (clamp 0 2 (number-or (:tongueScale merged) (:tongueScale default-config)))
+     :rampMs (clamp 0 200 (number-or (:rampMs merged) (:rampMs default-config)))
+     :holdMs (clamp 0 500 (number-or (:holdMs merged) (:holdMs default-config)))
+     :priority (int (clamp -1000 1000 (number-or (:priority merged) (:priority default-config))))
+     :visualLeadMs (clamp 0 250 (number-or (:visualLeadMs merged) (:visualLeadMs default-config)))
+     :wordDriftThresholdSec (clamp 0.01 0.5 (number-or (:wordDriftThresholdSec merged)
+                                                       (:wordDriftThresholdSec default-config)))}))
+
+(defn js-config [config]
+  (if config (js->clj config :keywordize-keys true) {}))
+
+(defn config->state [config]
+  (assoc default-state :config (sanitize-config (js-config config))))
+
+(defn configure [state config]
+  (update state :config #(sanitize-config (merge % (js-config config)))))
+
+(defn clean-word [word]
+  (when word
+    (let [value (str/trim (str word))]
+      (when (pos? (count value)) value))))
+
+(defn word-start-sec [timing]
+  (number-or (or (:startSec timing)
+                 (:start timing)
+                 (:start_time timing))
+             0))
+
+(defn word-end-sec [timing]
+  (number-or (or (:endSec timing)
+                 (:end timing)
+                 (:end_time timing))
+             (word-start-sec timing)))
+
+(defn normalize-word-timing [timing]
+  ;; Provider word-boundary messages are not perfectly standardized. Normalize
+  ;; both the LiveKit-style start/end shape and the Azure-style start_time/end_time
+  ;; shape into the one state shape used for drift correction.
+  (let [word (clean-word (:word timing))
+        start-sec (max 0 (word-start-sec timing))
+        end-sec (max start-sec (word-end-sec timing))]
+    (when word
+      {:word word
+       :startSec start-sec
+       :endSec end-sec})))
+
+(defn normalize-word-timings [word-timings]
+  ;; This is a pure row-normalization pass: normalize every provider timing row
+  ;; and drop malformed/empty words. A local transducer keeps that one pass
+  ;; explicit without creating a separate namespace for a tiny transformation.
+  (into [] (keep normalize-word-timing) (or word-timings [])))
+
+(defn record-start [state timeline snippet-name started-at max-time]
+  ;; A timeline starts as one utterance-level animation snippet. Word timings are
+  ;; retained only for drift correction; they are not used to create per-word
+  ;; snippets that can pile up or fight each other.
+  (let [visemes (:visemes timeline)
+        first-viseme (:visemeId (first visemes))]
+    (-> state
+        (assoc :speaking true
+               :currentWord nil
+               :currentViseme first-viseme
+               :snippetName snippet-name
+               :source (or (:source timeline) "unknown")
+               :text (:text timeline)
+               :startTime started-at
+               :audioStartedAt nil
+               :audioTimeSec nil
+               :maxTime max-time
+               :wordIndex 0
+               :wordTimings (normalize-word-timings (:wordTimings timeline)))
+        (update :scheduledCount inc)
+        (assoc :lastEvent {:type "lipSyncTimelineStarted"
+                           :name snippet-name
+                           :source (or (:source timeline) "unknown")
+                           :at started-at}))))
+
+(defn record-stop [state stopped-at reason]
+  (-> state
+      (assoc :speaking false
+             :currentWord nil
+             :currentViseme nil
+             :snippetName nil
+             :source nil
+             :text nil
+             :startTime nil
+             :audioStartedAt nil
+             :audioTimeSec nil
+             :maxTime 0
+             :wordIndex 0
+             :wordTimings [])
+      (update :stoppedCount inc)
+      (assoc :lastEvent {:type "lipSyncTimelineStopped"
+                         :reason reason
+                         :at stopped-at})))
+
+(defn record-word-boundary [state word word-index observed-at]
+  (-> state
+      (assoc :currentWord word
+             :wordIndex (inc (or word-index (:wordIndex state) 0)))
+      (assoc :lastEvent {:type "lipSyncWordBoundary"
+                         :word word
+                         :wordIndex word-index
+                         :at observed-at})))
+
+(defn record-word-timings [state word-timings updated-at]
+  ;; Provider timing metadata can arrive after viseme data. Updating it in the
+  ;; agency keeps later word-boundary drift correction accurate without asking
+  ;; LoomLarge to manage any LipSync internals.
+  (-> state
+      (assoc :wordTimings (normalize-word-timings word-timings)
+             :wordIndex 0)
+      (assoc :lastEvent {:type "lipSyncWordTimingsUpdated"
+                         :count (count (normalize-word-timings word-timings))
+                         :at updated-at})))
+
+(defn record-sync-correction [state name offset-sec corrected-at]
+  (-> state
+      (update :syncCorrectionCount inc)
+      (assoc :lastEvent {:type "lipSyncSyncCorrection"
+                         :name name
+                         :offsetSec offset-sec
+                         :at corrected-at})))
+
+(defn record-audio-started [state audio-time-sec observed-at]
+  ;; Audio remains a host side effect; LipSync only records the host clock value
+  ;; that should drive the already-scheduled animation timeline.
+  (-> state
+      (assoc :audioStartedAt observed-at
+             :audioTimeSec (max 0 (number-or audio-time-sec 0)))
+      (assoc :lastEvent {:type "lipSyncAudioStarted"
+                         :audioTimeSec (max 0 (number-or audio-time-sec 0))
+                         :at observed-at})))
+
+(defn record-audio-time [state audio-time-sec observed-at]
+  (-> state
+      (assoc :audioTimeSec (max 0 (number-or audio-time-sec 0)))
+      (assoc :lastEvent {:type "lipSyncAudioTime"
+                         :audioTimeSec (max 0 (number-or audio-time-sec 0))
+                         :at observed-at})))
+
+(defn visible-state [state]
+  (clj->js state))

package/src/polymer/nlp/phonemes.cljs

@@ -0,0 +1,164 @@
+(ns polymer.nlp.phonemes
+  (:require [clojure.string :as str]))
+
+;; The CMU dictionary is browser-compatible ESM and provides exact ARPABET for
+;; more than 134,000 English entries. It is deliberately a lexicon, not a G2P
+;; model: lookup misses stay explicit and neutral instead of becoming guessed
+;; phoneme sequences.
+(def unresolved-prefix "UNRESOLVED_WORD:")
+
+(def punctuation #{"." "," ";" ":" "!" "?"})
+
+(def supported-phonemes
+  #{"AA" "AE" "AH" "AO" "AW" "AX" "AY"
+    "B" "CH" "D" "DH" "EH" "ER" "EY"
+    "F" "G" "HH" "IH" "IY" "JH" "K"
+    "L" "M" "N" "NG" "OW" "OY" "P"
+    "R" "S" "SH" "T" "TH" "UH" "UW"
+    "V" "W" "Y" "Z" "ZH"})
+
+(def arpabet-aliases
+  {"EL" "L"
+   "EM" "M"
+   "EN" "N"
+   "AXR" "ER"
+   "UX" "UW"
+   "HV" "HH"
+   "WH" "W"
+   "DX" "D"})
+
+(def arpabet-expansions
+  {"TS" ["T" "S"]
+   "DZ" ["D" "Z"]})
+
+(defn clean-word [word]
+  (-> (or word "")
+      str
+      str/lower-case
+      (str/replace #"[^a-z']" "")))
+
+(defn pause-token [token]
+  (case token
+    "," "PAUSE_COMMA"
+    ";" "PAUSE_SEMICOLON"
+    ":" "PAUSE_COLON"
+    "." "PAUSE_PERIOD"
+    "?" "PAUSE_QUESTION"
+    "!" "PAUSE_EXCLAMATION"
+    "PAUSE_SPACE"))
+
+(defn tokenize [text]
+  (vec (re-seq #"[A-Za-z']+|[,.;:!?]|\s+" (or text ""))))
+
+(defn unresolved-token [word]
+  (str unresolved-prefix (max 1 (count (clean-word word)))))
+
+(defn unresolved-token? [phoneme]
+  (str/starts-with? (or phoneme "") unresolved-prefix))
+
+(defn unresolved-token-length [phoneme]
+  (let [text (or phoneme "")
+        parsed (js/parseInt (subs text (min (count unresolved-prefix)
+                                            (count text)))
+                            10)]
+    (if (js/isFinite parsed) (max 1 parsed) 1)))
+
+(defn normalize-arpabet-token [token]
+  (let [normalized (-> (or token "")
+                       str/upper-case
+                       (str/replace #"[0-9]" ""))
+        aliased (get arpabet-aliases normalized normalized)]
+    (or (get arpabet-expansions aliased)
+        (when (contains? supported-phonemes aliased)
+          [aliased]))))
+
+(defn arpabet->phonemes
+  "Validate a complete ARPABET word. One unknown token invalidates the word."
+  [arpabet]
+  (let [tokens (vec (if (string? arpabet)
+                      (remove str/blank? (str/split arpabet #"\s+"))
+                      (or arpabet [])))
+        normalized (mapv normalize-arpabet-token tokens)
+        unmapped (into []
+                       (keep-indexed (fn [index expansion]
+                                       (when (nil? expansion)
+                                         (nth tokens index))))
+                       normalized)]
+    {:phonemes (into [] (comp (keep identity) cat) normalized)
+     :unmappedTokens unmapped}))
+
+(defn unresolved-pronunciation [word unmapped]
+  {:word word
+   :source "unresolved"
+   :phonemes [(unresolved-token word)]
+   :unmappedTokens (vec unmapped)})
+
+(defn dictionary-value [dictionary word]
+  (when dictionary
+    (aget dictionary word)))
+
+(defn dictionary-pronunciations
+  "Return CMU's canonical entry and numbered alternatives for one spelling."
+  [dictionary word]
+  (let [cleaned (clean-word word)
+        canonical (dictionary-value dictionary cleaned)]
+    (loop [index 2
+           entries (cond-> [] canonical (conj canonical))]
+      (if-let [alternative (dictionary-value dictionary
+                                             (str cleaned "(" index ")"))]
+        (recur (inc index) (conj entries alternative))
+        entries))))
+
+(defn pronunciation-from-arpabet [word variant arpabet]
+  (let [converted (arpabet->phonemes arpabet)]
+    (if (and (seq (:phonemes converted))
+             (empty? (:unmappedTokens converted)))
+      (assoc converted
+             :word word
+             :source "cmuLexicon"
+             :variant variant
+             :arpabet arpabet)
+      (unresolved-pronunciation word (:unmappedTokens converted)))))
+
+(defn word-pronunciations
+  "Return every validated CMU pronunciation for a spelling."
+  [dictionary word]
+  (let [cleaned (clean-word word)
+        entries (dictionary-pronunciations dictionary cleaned)]
+    (if (seq entries)
+      (mapv #(pronunciation-from-arpabet cleaned %1 %2)
+            (range 1 (inc (count entries)))
+            entries)
+      [(unresolved-pronunciation cleaned [])])))
+
+(defn word-pronunciation
+  "Return CMU's canonical pronunciation, or an explicit neutral miss."
+  [dictionary word]
+  (let [cleaned (clean-word word)]
+    (if (str/blank? cleaned)
+      {:word cleaned :source "empty" :phonemes [] :unmappedTokens []}
+      (first (word-pronunciations dictionary cleaned)))))
+
+(defn word->phonemes [dictionary word]
+  (:phonemes (word-pronunciation dictionary word)))
+
+(defn text-pronunciations
+  "Look up each word independently; no context-sensitive choice is invented."
+  [dictionary text]
+  (into []
+        (keep (fn [token]
+                (cond
+                  (re-matches #"[A-Za-z']+" token)
+                  (word-pronunciation dictionary token)
+
+                  (contains? punctuation token)
+                  {:word token
+                   :source "punctuation"
+                   :phonemes [(pause-token token)]
+                   :unmappedTokens []}
+
+                  :else nil)))
+        (tokenize text)))
+
+(defn text->phonemes [dictionary text]
+  (into [] (mapcat :phonemes) (text-pronunciations dictionary text)))