@lovelace_lol/polymer 0.0.1

package/src/polymer/tts/scheduler.cljs

@@ -0,0 +1,162 @@
+(ns polymer.tts.scheduler)
+
+;; TTS owns provider and audio side effects, but session callbacks should still
+;; be scheduled in one place. This scheduler queues Web Speech fallback-start
+;; callbacks and Azure audio-clock word-boundary polling. It does not synthesize
+;; speech, play audio, or call LipSync directly; the TTS agency supplies
+;; callbacks that translate scheduled facts into ordinary TTS/LipSync events.
+
+(defn window* []
+  (when (exists? js/window)
+    js/window))
+
+(defn now-ms []
+  (.now js/Date))
+
+(defn clear-timeout! [timer]
+  (when timer
+    (when-let [window (window*)]
+      (.clearTimeout window timer))))
+
+(defn clear-frame! [frame]
+  (when frame
+    (when-let [window (window*)]
+      (.cancelAnimationFrame window frame))))
+
+(defn create-scheduler []
+  (let [start-fallbacks (atom {})
+        boundary-frames (atom {})
+        active-session (atom nil)
+        queue (atom [])
+        disposed? (atom false)]
+    (letfn [(enqueue! [effect]
+              (let [entry (assoc effect
+                                 :queueIndex (count @queue)
+                                 :queuedAt (now-ms))]
+                (swap! queue conj entry)
+                entry))
+
+            (cancel-start-fallback! [session-id]
+              (when-let [timer (get @start-fallbacks session-id)]
+                (clear-timeout! timer)
+                (swap! start-fallbacks dissoc session-id)))
+
+            (cancel-boundaries! [session-id]
+              (when-let [frame (get @boundary-frames session-id)]
+                (clear-frame! frame)
+                (swap! boundary-frames dissoc session-id)))
+
+            (request-boundary-frame! [session-id tick]
+              (when-let [window (window*)]
+                (swap! boundary-frames assoc session-id (.requestAnimationFrame window tick))))
+
+            (stop-session! [session-id]
+              (cancel-start-fallback! session-id)
+              (cancel-boundaries! session-id))]
+      {:start-session
+       (fn [session-id engine snippet-name]
+         (when-not @disposed?
+           ;; Provider callbacks can arrive late, but the scheduler records the
+           ;; accepted session before browser/backend work begins. Stop/reset can
+           ;; then cancel the active scheduled work from one place.
+           (reset! active-session {:sessionId session-id
+                                   :engine engine
+                                   :snippetName snippet-name})
+           (enqueue! {:type "ttsSessionStarted"
+                      :agency "tts"
+                      :sessionId session-id
+                      :engine engine
+                      :snippetName snippet-name})))
+
+       :schedule-start-fallback
+       (fn [session-id delay-ms callback]
+         (when-not @disposed?
+           (cancel-start-fallback! session-id)
+           (enqueue! {:type "webSpeechStartFallback"
+                      :agency "tts"
+                      :sessionId session-id
+                      :delayMs delay-ms})
+           (when-let [window (window*)]
+             (swap! start-fallbacks
+                    assoc
+                    session-id
+                    (.setTimeout window
+                                 (fn []
+                                   (swap! start-fallbacks dissoc session-id)
+                                   (when-not @disposed?
+                                     (callback)))
+                                 delay-ms)))))
+
+       :cancel-start-fallback
+       (fn [session-id]
+         (cancel-start-fallback! session-id))
+
+       :schedule-boundaries
+       (fn [session-id active-session? clock word-timings on-boundary]
+         (when-not @disposed?
+           (cancel-boundaries! session-id)
+           (enqueue! {:type "audioBoundaryPolling"
+                      :agency "tts"
+                      :sessionId session-id
+                      :wordCount (count word-timings)})
+           (let [index (atom 0)
+                 tick (atom nil)]
+             (reset! tick
+                     (fn []
+                       (if (and (not @disposed?)
+                                (active-session? session-id)
+                                ((:shouldContinue clock)))
+                         (do
+                           (let [current-time ((:currentTime clock))]
+                             (while (and (< @index (count word-timings))
+                                         (<= (:startSec (nth word-timings @index)) (+ current-time 0.02)))
+                               (let [boundary (nth word-timings @index)]
+                                 (on-boundary {:word (:word boundary)
+                                               :observedElapsedSec current-time})
+                                 (swap! index inc))))
+                           (request-boundary-frame! session-id @tick))
+                         (cancel-boundaries! session-id))))
+             (request-boundary-frame! session-id @tick))))
+
+       :stop-session
+       (fn [session-id]
+         (stop-session! session-id))
+
+       :stop-active-session
+       (fn [reason]
+         (when-not @disposed?
+           (let [session @active-session
+                 session-id (:sessionId session)]
+             (when session-id
+               (stop-session! session-id)
+               (enqueue! {:type "ttsSessionStopped"
+                          :agency "tts"
+                          :sessionId session-id
+                          :engine (:engine session)
+                          :snippetName (:snippetName session)
+                          :reason reason}))
+             (reset! active-session nil))))
+
+       :stop-all
+       (fn []
+         (doseq [session-id (keys @start-fallbacks)]
+           (cancel-start-fallback! session-id))
+         (doseq [session-id (keys @boundary-frames)]
+           (cancel-boundaries! session-id))
+         (reset! active-session nil))
+
+       :queue
+       (fn []
+         @queue)
+
+       :dispose
+       (fn []
+         (reset! disposed? true)
+         (doseq [timer (vals @start-fallbacks)]
+           (clear-timeout! timer))
+         (doseq [frame (vals @boundary-frames)]
+           (clear-frame! frame))
+         (reset! active-session nil)
+         (reset! start-fallbacks {})
+         (reset! boundary-frames {})
+         (reset! queue []))})))

package/src/polymer/tts/state.cljs

@@ -0,0 +1,191 @@
+(ns polymer.tts.state)
+
+;; The TTS agency state is intentionally separate from LipSync state.
+;; TTS owns provider/session facts; LipSync owns mouth planning.
+
+(defn finite-number?
+  "Return true only for real numeric values that can safely enter timing math."
+  [value]
+  (and (number? value)
+       (not (js/isNaN value))
+       (js/isFinite value)))
+
+(defn clamp
+  "Clamp a number into an inclusive range, using fallback when input is absent."
+  [minimum maximum value fallback]
+  (let [candidate (if (finite-number? value) value fallback)]
+    (min maximum (max minimum candidate))))
+
+(defn string-or
+  "Keep non-blank string configuration values; treat nil/blank as missing."
+  [value fallback]
+  (if (and (string? value) (pos? (count (.trim value))))
+    value
+    fallback))
+
+(defn bool-or
+  "Normalize optional booleans without treating false as missing."
+  [value fallback]
+  (if (nil? value) fallback (boolean value)))
+
+(def default-config
+  ;; Defaults mirror the old Latticework TTS defaults and the current UI defaults.
+  {:engine "webSpeech"
+   :backendUrl ""
+   :voiceName ""
+   :azureVoiceName "en-US-JennyNeural"
+   :azureStyle ""
+   :azureStyleDegree nil
+   :rate 1
+   :pitch 1
+   :volume 1
+   :visualLeadMs 35
+   :lipsyncIntensity 1
+   :jawScale 1
+   :tongueScale 1
+   ;; Web Speech does not expose provider viseme timings. Polymer builds an
+   ;; utterance-level fallback timeline from text, then receives coarse browser
+   ;; word-boundary callbacks. A tight correction threshold makes that fallback
+   ;; clip jump at every boundary, which reads as choppy lip sync. Keep Azure
+   ;; tighter because Azure sends real viseme timings; keep Web Speech loose so
+   ;; boundaries correct only material drift.
+   :webSpeechDriftThresholdSec 0.35
+   :azureDriftThresholdSec 0.04
+   :azureCacheLimit 8
+   :debug false
+   ;; none | displayMedia — experimental Web Speech barge-in reference capture.
+   :webSpeechReferenceMode "none"
+   :providers nil})
+
+(defn normalize-config
+  "Create the public, clamped TTS config map used by all agency decisions."
+  [config]
+  (let [input (merge default-config (or config {}))
+        reference-mode (string-or (:webSpeechReferenceMode input)
+                                  (:webSpeechReferenceMode default-config))]
+    {:engine (string-or (:engine input) (:engine default-config))
+     :backendUrl (string-or (:backendUrl input) (:backendUrl default-config))
+     :voiceName (string-or (:voiceName input) (:voiceName default-config))
+     :azureVoiceName (string-or (:azureVoiceName input) (:azureVoiceName default-config))
+     :azureStyle (string-or (:azureStyle input) (:azureStyle default-config))
+     :azureStyleDegree (:azureStyleDegree input)
+     :rate (clamp 0.5 2.0 (:rate input) (:rate default-config))
+     :pitch (clamp 0.5 2.0 (:pitch input) (:pitch default-config))
+     :volume (clamp 0 1 (:volume input) (:volume default-config))
+     :visualLeadMs (clamp 0 250 (:visualLeadMs input) (:visualLeadMs default-config))
+     :lipsyncIntensity (clamp 0 2 (:lipsyncIntensity input) (:lipsyncIntensity default-config))
+     :jawScale (clamp 0 2 (:jawScale input) (:jawScale default-config))
+     :tongueScale (clamp 0 2 (:tongueScale input) (:tongueScale default-config))
+     :webSpeechDriftThresholdSec (clamp 0 1 (:webSpeechDriftThresholdSec input) (:webSpeechDriftThresholdSec default-config))
+     :azureDriftThresholdSec (clamp 0 1 (:azureDriftThresholdSec input) (:azureDriftThresholdSec default-config))
+     :azureCacheLimit (int (clamp 0 64 (:azureCacheLimit input) (:azureCacheLimit default-config)))
+     :debug (bool-or (:debug input) false)
+     :webSpeechReferenceMode (if (#{"none" "displayMedia"} reference-mode)
+                               reference-mode
+                               "none")
+     :providers (:providers input)}))
+
+(defn default-state
+  "Build a fresh state ledger for one TTS agency instance."
+  [config]
+  (let [normalized-config (normalize-config config)]
+    {:agency "tts"
+     :status "idle"
+     :engine (:engine normalized-config)
+     :speaking false
+     :currentText nil
+     :snippetName nil
+     :sessionId 0
+     :startedAt nil
+     :endedAt nil
+     :wordIndex 0
+     :webSpeechVoices []
+     :azureVoices []
+     :azureStatus "checking"
+     :azureStatusMessage "Azure voices have not been checked yet."
+     :lastPlan nil
+     :lastError nil
+     :config normalized-config}))
+
+(defn visible-state
+  "Expose serializable state without private JS handles or provider functions."
+  [state]
+  (update-in state [:config] dissoc :providers))
+
+(defn configure
+  "Merge public config into state and keep status/session fields untouched."
+  [state config]
+  (let [next-config (normalize-config (merge (:config state) (or config {})))]
+    (assoc state
+           :engine (:engine next-config)
+           :config next-config)))
+
+(defn next-session
+  "Advance the session token so late provider callbacks can be ignored."
+  [state]
+  (update state :sessionId inc))
+
+(defn record-plan
+  "Store provider-plan data that explains how this speech command will execute."
+  [state plan]
+  (assoc state :lastPlan plan))
+
+(defn record-loading
+  "Mark speech synthesis/playback setup as active."
+  [state engine text snippet-name]
+  (assoc state
+         :status "loading"
+         :engine engine
+         :currentText text
+         :snippetName snippet-name
+         :speaking false
+         :startedAt nil
+         :endedAt nil
+         :wordIndex 0
+         :lastError nil))
+
+(defn record-speaking
+  "Mark real audio playback as started."
+  [state started-at]
+  (assoc state
+         :status "speaking"
+         :speaking true
+         :startedAt started-at
+         :endedAt nil
+         :lastError nil))
+
+(defn record-word-boundary
+  "Remember the latest provider word boundary without making host code poll state."
+  [state word-index]
+  (assoc state :wordIndex (inc (max 0 (int word-index)))))
+
+(defn record-stopped
+  "Return the agency to idle after stop, end, or replacement."
+  [state ended-at]
+  (assoc state
+         :status "idle"
+         :speaking false
+         :currentText nil
+         :snippetName nil
+         :endedAt ended-at))
+
+(defn record-error
+  "Move the agency into an error state while keeping the last useful context."
+  [state message]
+  (assoc state
+         :status "error"
+         :speaking false
+         :lastError message))
+
+(defn record-web-speech-voices
+  "Store normalized browser voice choices for UI consumers."
+  [state voices]
+  (assoc state :webSpeechVoices (vec voices)))
+
+(defn record-azure-status
+  "Store backend Azure availability separately from the active speech status."
+  [state status message voices]
+  (cond-> (assoc state
+                 :azureStatus status
+                 :azureStatusMessage message)
+    voices (assoc :azureVoices (vec voices))))

package/src/polymer/worker.cljs

@@ -0,0 +1,70 @@
+(ns polymer.worker
+  (:require [polymer.core :as polymer]))
+
+;; This namespace is an opt-in transport around the existing character API.
+;; It proves that Polymer can compile for a real Worker and exchange plain-data
+;; messages across that boundary. The character network still owns all
+;; cross-agency routing, planning, scheduling, and private effectors.
+
+(defonce systems (atom {}))
+
+(defn- post! [message]
+  (.postMessage js/self (clj->js message)))
+
+(defn- post-error! [id message]
+  (post! {:id id
+          :stream "events"
+          :event {:type "error"
+                  :agency "character"
+                  :message message}}))
+
+(defn- dispose-system! [id]
+  (when-let [system (get @systems id)]
+    (.dispose ^js system)
+    (swap! systems dissoc id)
+    true))
+
+(defn- create-system! [id config]
+  (dispose-system! id)
+  (let [system (polymer/createCharacterAgencies (clj->js (or config {})))]
+    ;; Mirror only character-level events. The worker must not become a second
+    ;; message bus between individual agencies.
+    (.subscribeEvents
+     ^js system
+     #(post! {:id id
+              :stream "events"
+              :event (js->clj % :keywordize-keys true)}))
+    (swap! systems assoc id system)
+    (post! {:id id
+            :stream "events"
+            :event {:type "ready"
+                    :agency "character"}})))
+
+(defn- dispatch! [id message]
+  (if-let [system (get @systems id)]
+    (.dispatch ^js system (clj->js message))
+    (post-error! id "Unknown Polymer agency system id")))
+
+(defn- snapshot! [id]
+  (if-let [system (get @systems id)]
+    (post! {:id id
+            :stream "snapshot"
+            :snapshot (js->clj (.snapshot ^js system) :keywordize-keys true)})
+    (post-error! id "Unknown Polymer agency system id")))
+
+(defn- handle-message [message]
+  (let [payload (js->clj (.-data message) :keywordize-keys true)
+        id (or (:id payload) "character")]
+    (case (:type payload)
+      "createCharacterAgencies" (create-system! id (:config payload))
+      "dispatch" (dispatch! id (:message payload))
+      "snapshot" (snapshot! id)
+      "dispose" (do
+                  (dispose-system! id)
+                  (post! {:id id
+                          :stream "lifecycle"
+                          :event {:type "disposed"}}))
+      (post-error! id (str "Unknown worker message: " (:type payload))))))
+
+(defn init []
+  (.addEventListener js/self "message" handle-message))