@lovelace_lol/polymer 0.0.7 → 0.0.9

package/src/polymer/tts/agency.cljs

@@ -1,503 +0,0 @@
-(ns polymer.tts.agency
-  (:require [polymer.stream :as stream]
-            [polymer.tts.azure :as azure]
-            [polymer.tts.planner :as planner]
-            [polymer.tts.runtime :refer [azure-cache-key
-                                          azure-voice-name
-                                          backend-url
-                                          callback-event
-                                          cleanup-audio!
-                                          clear-display-media-reference!
-                                          custom-provider
-                                          dispose-playback-resources!
-                                          ensure-web-speech-display-media-reference!
-                                          get-playback-reference-track
-                                          js-error
-                                          load-azure-voices!
-                                          load-web-speech-voices!
-                                          normalize-voices
-                                          now-ms
-                                          plan-failure-message
-                                          play-azure-audio!
-                                          prime-audio!
-                                          remember-cache
-                                          scalar->azure-percent
-                                          scalar->azure-pitch-percent
-                                          speak-web-speech!
-                                          speech-synthesis*
-                                          synthesize-azure!
-                                          stop-web-speech-handle!]]
-            [polymer.tts.scheduler :as scheduler]
-            [polymer.tts.state :as state]))
-
-;; TTS owns speech-provider side effects and emits plain data facts for LipSync.
-;; The impure browser/backend/audio calls live in `polymer.tts.runtime`; this
-;; namespace owns command planning, session state, and callback routing.
-
-(defn create-tts-agency
-  "Create a TTS agency that owns provider sessions and emits LipSync facts."
-  [config]
-  (let [initial-config (js->clj config :keywordize-keys true)
-        input-stream (stream/create-stream)
-        event-stream (stream/create-stream)
-        emit-input (:emit input-stream)
-        emit-event (:emit event-stream)
-        state-atom (atom (state/default-state initial-config))
-        resources (atom {:audio nil
-                         :audioUrl nil
-                         :audioSource nil
-                         :webSpeechHandle nil
-                         :audioContext nil
-                         :playbackReferenceDestination nil
-                         :mediaElementSource nil
-                         :playbackGain nil
-                         :displayMediaReferenceStream nil
-                         :displayMediaReferenceTrack nil})
-        session-scheduler (scheduler/create-scheduler)
-        azure-cache (atom {})
-        voice-load-seq (atom 0)
-        voice-load-requests (atom {})
-        playback-reference-listeners (atom #{})
-        disposed? (atom false)]
-    (letfn [(session-id []
-                ;; Every provider callback captures the session id active when
-                ;; it was registered. Replacements/stops increment the token so
-                ;; late callbacks cannot mutate state or emit stale LipSync data.
-              (:sessionId @state-atom))
-
-            (active-session? [id]
-              (and (not @disposed?) (= id (session-id))))
-
-            (notify-playback-reference-track! []
-              ;; Host-facing handle for barge-in. Stream messages stay plain data;
-              ;; MediaStreamTrack is exposed only through this imperative API.
-              (let [track (get-playback-reference-track resources)]
-                (doseq [listener @playback-reference-listeners]
-                  (listener track))
-                (emit-event {:type "ttsPlaybackReferenceChanged"
-                             :agency "tts"
-                             :available (boolean track)
-                             :at (now-ms)})
-                track))
-
-            (emit-status! []
-                ;; Status events are coarse facts, not animation ticks. The
-                ;; agency emits word/viseme progress through streams instead of
-                ;; making a host poll mutable state.
-              (emit-event {:type "ttsStatusChanged"
-                           :agency "tts"
-                           :state (state/visible-state @state-atom)}))
-
-            (emit-error! [message]
-              (swap! state-atom state/record-error message)
-              (emit-event {:type "error" :agency "tts" :message message})
-              (emit-status!))
-
-            (emit-lipsync! [command]
-                ;; This is an event-stream bridge inside Polymer. The agency
-                ;; system routes this command to LipSync, which then emits
-                ;; animation intent for the Animation agency.
-              (emit-event {:type "lipSync.command"
-                           :agency "tts"
-                           :command command}))
-
-            (active-speech? []
-              (contains? #{"loading" "speaking"} (:status @state-atom)))
-
-            (next-voice-load! [engine]
-              (let [request-id (swap! voice-load-seq inc)]
-                (swap! voice-load-requests assoc engine request-id)
-                request-id))
-
-            (active-voice-load? [engine request-id]
-              (and (not @disposed?)
-                   (= request-id (get @voice-load-requests engine))))
-
-            (cancel-voice-loads! []
-              (swap! voice-load-requests empty))
-
-            (stop-web-speech! []
-              (when-let [handle (:webSpeechHandle @resources)]
-                (stop-web-speech-handle! handle))
-              (swap! resources assoc :webSpeechHandle nil))
-
-            (configure-lipsync! [engine command]
-                ;; TTS knows provider timing and user speech controls; LipSync knows
-                ;; how those controls become mouth/jaw/tongue animation.
-              (let [config (:config @state-atom)]
-                (emit-lipsync! {:type "configure"
-                                :config {:intensity (:lipsyncIntensity config)
-                                         :jawScale (:jawScale config)
-                                         :tongueScale (:tongueScale config)
-                                         :speechRate (or (:rate command) (:rate config))
-                                         :visualLeadMs (or (:visualLeadMs command) (:visualLeadMs config))
-                                         :wordDriftThresholdSec (if (= engine "azure")
-                                                                  (:azureDriftThresholdSec config)
-                                                                  (:webSpeechDriftThresholdSec config))}})))
-
-            (stop-session! [reason]
-              ((:stop-active-session session-scheduler) reason)
-              (stop-web-speech!)
-              (cleanup-audio! resources)
-              (emit-lipsync! {:type "stop" :reason reason})
-              (swap! state-atom state/record-stopped (now-ms))
-              (emit-event {:type "ttsSpeechStopped"
-                           :agency "tts"
-                           :reason reason
-                           :stoppedAt (:endedAt @state-atom)})
-              (emit-status!))
-
-            (finish-session! [id]
-              (when (active-session? id)
-                (stop-session! "completed")
-                (emit-event {:type "ttsSpeechEnded"
-                             :agency "tts"
-                             :endedAt (:endedAt @state-atom)})))
-
-            (word-boundary! [id word observed-elapsed-sec host-elapsed-sec]
-              (when (and (active-session? id) (pos? (count (or word ""))))
-                (let [word-index (:wordIndex @state-atom)]
-                  (swap! state-atom state/record-word-boundary word-index)
-                  (emit-lipsync! {:type "wordBoundary"
-                                  :word word
-                                  :wordIndex word-index
-                                  :observedElapsedSec observed-elapsed-sec
-                                  :hostElapsedSec host-elapsed-sec})
-                  (emit-event {:type "ttsWordBoundary"
-                               :agency "tts"
-                               :word word
-                               :wordIndex word-index
-                               :observedElapsedSec observed-elapsed-sec
-                               :hostElapsedSec host-elapsed-sec}))))
-
-            (start-web-speech! [id command snippet-name]
-              (let [config (:config @state-atom)
-                    text (:text command)
-                    plan {:text text
-                          :voiceName (or (:voiceName command) (:voiceName config))
-                          :rate (or (:rate command) (:rate config))
-                          :pitch (or (:pitch command) (:pitch config))
-                          :volume (or (:volume command) (:volume config))
-                          :onAudioStarted (fn [_event]
-                                            (when (active-session? id)
-                                              (configure-lipsync! "webSpeech" command)
-                                              (emit-lipsync! {:type "startText"
-                                                              :name snippet-name
-                                                              :text text
-                                                              :source "webSpeech"})
-                                              (emit-lipsync! {:type "audioStarted"
-                                                              :name snippet-name
-                                                              :audioTimeSec 0})
-                                              (swap! state-atom state/record-speaking (now-ms))
-                                              (emit-event {:type "ttsSpeechStarted"
-                                                           :agency "tts"
-                                                           :engine "webSpeech"
-                                                           :name snippet-name
-                                                           :startedAt (:startedAt @state-atom)})
-                                              (emit-status!)))
-                          :onBoundary (fn [event]
-                                        (let [payload (callback-event event)]
-                                          (word-boundary! id
-                                                          (:word payload)
-                                                          (:observedElapsedSec payload)
-                                                          (:hostElapsedSec payload))))
-                          :onEnd (fn [] (finish-session! id))
-                          :onError (fn [error] (emit-error! (.-message error)))
-                          :scheduleStartFallback
-                          (fn [delay-ms callback]
-                            ((:schedule-start-fallback session-scheduler) id delay-ms callback))
-                          :cancelStartFallback
-                          (fn []
-                            ((:cancel-start-fallback session-scheduler) id))}]
-                (-> (speak-web-speech! config plan)
-                    (.then (fn [handle]
-                             (if (active-session? id)
-                               (swap! resources assoc :webSpeechHandle handle)
-                               (stop-web-speech-handle! handle))))
-                    (.catch (fn [error]
-                              (when (active-session? id)
-                                (emit-error! (.-message error))))))))
-
-            (start-azure! [id command snippet-name]
-              (let [config (:config @state-atom)
-                    text (:text command)
-                    voice-name (azure-voice-name config command)
-                    style (let [raw (or (:style command) (:azureStyle config))]
-                            (when (and (string? raw) (pos? (count (.trim raw)))) raw))
-                    rate (or (:rate command) (:rate config))
-                    pitch (or (:pitch command) (:pitch config))
-                    volume (or (:volume command) (:volume config))
-                    cache-key (azure-cache-key text voice-name style
-                                               (scalar->azure-percent rate)
-                                               (scalar->azure-pitch-percent pitch))
-                    cached (get @azure-cache cache-key)
-                    synth-promise (if cached
-                                    (js/Promise.resolve (clj->js cached))
-                                    (synthesize-azure! config (assoc command
-                                                                     :voiceName voice-name
-                                                                     :style style
-                                                                     :rate rate
-                                                                     :pitch pitch)))]
-                  ;; Prime synchronously while the click/user gesture is still
-                  ;; available. Synthesis may finish later, but the element is
-                  ;; already allowed to play in stricter browsers.
-                ;; Prime HTMLAudio for autoplay unlock only. Do not advertise the
-                ;; playback-reference track until real Azure audio is routed, or
-                ;; barge-in would arm against a silent muted unlock clip.
-                (prime-audio! resources volume)
-                (-> synth-promise
-                    (.then (fn [raw]
-                               ;; Provider/backend shapes are normalized before
-                               ;; any playback or LipSync command is emitted.
-                             (let [payload (azure/normalize-azure-synthesis
-                                            (if (map? raw)
-                                              raw
-                                              (js->clj raw :keywordize-keys true)))]
-                               (when-not cached
-                                 (swap! azure-cache remember-cache cache-key payload (:azureCacheLimit config)))
-                               ;; Audio is required. Visemes help LipSync but must not
-                               ;; block playback when Azure returns audio alone.
-                               (if (pos? (count (str (:audioBase64 payload))))
-                                 payload
-                                 (throw (js-error "Azure TTS returned no usable audio payload"))))))
-                    (.then (fn [payload]
-                             (when (active-session? id)
-                               (play-azure-audio! config resources
-                                                  (assoc payload
-                                                         :volume volume)))))
-                    (.then (fn [playback]
-                             (when (active-session? id)
-                               (let [payload (if cached cached (get @azure-cache cache-key))
-                                     duration-sec (or (:durationSec payload) (aget playback "durationSec") 0)
-                                     word-timings (:wordTimings payload)]
-                                 (configure-lipsync! "azure" command)
-                                 (emit-lipsync! (azure/azure-synthesis->lipsync-command
-                                                 snippet-name
-                                                 text
-                                                 (assoc payload :durationSec duration-sec)
-                                                 config))
-                                 (emit-lipsync! {:type "audioStarted"
-                                                 :name snippet-name
-                                                 :audioTimeSec 0})
-                                 (swap! state-atom state/record-speaking (now-ms))
-                                 (emit-event {:type "ttsSpeechStarted"
-                                              :agency "tts"
-                                              :engine "azure"
-                                              :name snippet-name
-                                              :startedAt (:startedAt @state-atom)})
-                                 (emit-status!)
-                                 (notify-playback-reference-track!)
-                                 (when-let [clock (or (:clock playback)
-                                                      (when (aget playback "clock")
-                                                        (js->clj (aget playback "clock") :keywordize-keys true)))]
-                                   ((:schedule-boundaries session-scheduler)
-                                    id
-                                    active-session?
-                                    clock
-                                    word-timings
-                                    (fn [event]
-                                      (word-boundary! id
-                                                      (:word event)
-                                                      (:observedElapsedSec event)
-                                                      nil))))
-                                 (when-let [audio (or (:audio playback) (aget playback "audio"))]
-                                   (set! (.-onended audio) #(finish-session! id)))))))
-                    (.catch (fn [error]
-                              (when (active-session? id)
-                                (emit-error! (.-message error))))))))
-
-            (speak! [command]
-              (let [config (:config @state-atom)
-                    engine (or (:engine command) (:engine config))
-                    text (:text command)
-                    snippet-name (or (:name command) (str "tts_" engine "_" (.now js/Date)))
-                    ;; Provider planning sees only capability facts. It does not
-                    ;; receive JS handles or secrets, and it never performs side
-                    ;; effects.
-                    world {:backendUrl (backend-url config command)
-                           :hasAzureSynthesize (boolean (custom-provider config :azureSynthesize))
-                           :hasWebSpeech (boolean (or (custom-provider config :webSpeechSpeak)
-                                                      (speech-synthesis*)))}
-                    plan (planner/plan-speech (assoc command :engine engine) config world)]
-                (swap! state-atom (fn [state]
-                                    (-> state
-                                        state/next-session
-                                        (state/record-plan plan)
-                                        (state/record-loading engine text snippet-name))))
-                (emit-event {:type "ttsPlanCreated"
-                             :agency "tts"
-                             :plan plan})
-                (emit-status!)
-                (if-not (:ok plan)
-                  (emit-error! (plan-failure-message plan))
-                  (do
-                    ((:start-session session-scheduler) (session-id) engine snippet-name)
-                    (case engine
-                      "azure" (start-azure! (session-id) command snippet-name)
-                      "webSpeech" (start-web-speech! (session-id) command snippet-name)
-                      (emit-error! (str "Unsupported TTS engine: " engine)))))))
-
-            (load-voices! [engine]
-              (let [config (:config @state-atom)
-                      ;; Voice loading has its own plan so missing backend/browser
-                      ;; support is visible before any provider request is made.
-                    request-id (next-voice-load! engine)
-                    world {:backendUrl (:backendUrl config)
-                           :hasAzureVoices (boolean (custom-provider config :azureVoices))
-                           :hasWebSpeech (boolean (or (custom-provider config :webSpeechVoices)
-                                                      (speech-synthesis*)))}
-                    plan (planner/plan-voice-load engine world)]
-                (emit-event {:type "ttsPlanCreated"
-                             :agency "tts"
-                             :plan plan})
-                (if-not (:ok plan)
-                  (do
-                    (when (= "azure" engine)
-                      (swap! state-atom
-                             state/record-azure-status
-                             "error"
-                             (plan-failure-message plan)
-                             []))
-                    (emit-error! (plan-failure-message plan)))
-                  (case engine
-                    "webSpeech"
-                    (-> (load-web-speech-voices! config)
-                        (.then (fn [voices]
-                                 (when (active-voice-load? engine request-id)
-                                   (let [normalized (normalize-voices
-                                                     (js->clj voices :keywordize-keys true)
-                                                     "webSpeech")]
-                                     (swap! state-atom state/record-web-speech-voices normalized)
-                                     (emit-event {:type "ttsVoicesLoaded"
-                                                  :agency "tts"
-                                                  :engine "webSpeech"
-                                                  :voices normalized})
-                                     (emit-status!)))))
-                        (.catch (fn [error]
-                                  (when (active-voice-load? engine request-id)
-                                    (emit-error! (.-message error))))))
-
-                    "azure"
-                    (-> (load-azure-voices! config)
-                        (.then (fn [response]
-                                 (when (active-voice-load? engine request-id)
-                                   (let [data (js->clj response :keywordize-keys true)
-                                         voices (normalize-voices (:voices data) "azure")
-                                         ready? (and (:valid data) (seq voices))
-                                         status (if ready? "ready" "error")
-                                         message (if ready?
-                                                   (str "Connected via backend environment (" (count voices) " voices).")
-                                                   (or (:message data) "Backend Azure credentials are not configured."))]
-                                     (swap! state-atom state/record-azure-status status message voices)
-                                     (emit-event {:type "ttsVoicesLoaded"
-                                                  :agency "tts"
-                                                  :engine "azure"
-                                                  :voices voices
-                                                  :status status
-                                                  :message message})
-                                     (emit-status!)))))
-                        (.catch (fn [error]
-                                  (when (active-voice-load? engine request-id)
-                                    (swap! state-atom state/record-azure-status "error" (.-message error) [])
-                                    (emit-error! (.-message error))))))
-
-                    (emit-error! (str "Unsupported voice provider: " engine))))))
-
-            (run-action! [action]
-              (case (:op action)
-                "cancel-voice-loads"
-                (cancel-voice-loads!)
-
-                "configure"
-                (do
-                  (swap! state-atom state/configure (:config action))
-                  (emit-status!))
-
-                "load-voices"
-                (load-voices! (:engine action))
-
-                "stop-active-session"
-                (when (active-speech?)
-                  (stop-session! (:reason action)))
-
-                "advance-session"
-                (swap! state-atom state/next-session)
-
-                "stop-session"
-                (stop-session! (:reason action))
-
-                "speak"
-                (speak! (:command action))
-
-                "reset"
-                (do
-                  (stop-web-speech!)
-                  ((:stop-all session-scheduler))
-                  (cleanup-audio! resources)
-                  (reset! state-atom (state/default-state nil))
-                  (emit-status!))
-
-                "error"
-                (emit-error! (:message action))
-
-                (emit-error! (str "Unknown TTS planner action: " (:op action)))))
-
-            (dispatch! [command]
-              (when-not @disposed?
-                (let [payload (js->clj command :keywordize-keys true)]
-                  (emit-input {:type "command"
-                               :agency "tts"
-                               :command payload})
-                  (doseq [action (planner/plan-command @state-atom payload)]
-                    (run-action! action)))))]
-      #js {:dispatch dispatch!
-           :snapshot (fn [] (state/visible-state @state-atom))
-           :schedulerQueue (fn [] (clj->js ((:queue session-scheduler))))
-           :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))
-           :configure (fn [next-config]
-                        (dispatch! #js {:type "configure" :config next-config})
-                        (when (= "none" (get-in @state-atom [:config :webSpeechReferenceMode]))
-                          (clear-display-media-reference! resources)
-                          (notify-playback-reference-track!)))
-           :loadVoices (fn
-                         ([] (dispatch! #js {:type "loadVoices"}))
-                         ([engine] (dispatch! #js {:type "loadVoices" :engine engine})))
-           :speak (fn [text] (dispatch! #js {:type "speak" :text text}))
-           :stop (fn [] (dispatch! #js {:type "stop"}))
-           :reset (fn [] (dispatch! #js {:type "reset"}))
-           :getPlaybackReferenceTrack (fn [] (get-playback-reference-track resources))
-           :onPlaybackReferenceTrackChange (fn [listener]
-                                             (swap! playback-reference-listeners conj listener)
-                                             (listener (get-playback-reference-track resources))
-                                             (fn []
-                                               (swap! playback-reference-listeners disj listener)))
-           :preparePlaybackReference (fn []
-                                       (let [config (:config @state-atom)]
-                                         (cond
-                                           (and (= "webSpeech" (:engine config))
-                                                (= "displayMedia" (:webSpeechReferenceMode config)))
-                                           (-> (ensure-web-speech-display-media-reference! resources)
-                                               (.then (fn [status]
-                                                        (notify-playback-reference-track!)
-                                                        status)))
-
-                                           (get-playback-reference-track resources)
-                                           (js/Promise.resolve "available")
-
-                                           :else
-                                           (js/Promise.resolve "unavailable"))))
-           :dispose (fn []
-                      (when-not @disposed?
-                        (reset! disposed? true)
-                        (cancel-voice-loads!)
-                        ((:dispose session-scheduler))
-                        (stop-web-speech!)
-                        (dispose-playback-resources! resources)
-                        (reset! playback-reference-listeners #{})
-                        ((:dispose input-stream))
-                        ((:dispose event-stream))))})))