@lovelace_lol/polymer 0.0.1

package/src/polymer/gesture/snippet.cljs

@@ -0,0 +1,198 @@
+(ns polymer.gesture.snippet
+  (:require [polymer.gesture.state :as state]))
+
+;; Gesture snippet construction is pure. It turns LoomLarge-authored arm/hand
+;; snapshots into typed Animation snippets; Animation owns the eventual Embody
+;; runtime side effect.
+
+(def eps 0.000001)
+(def rotation-channels ["rx" "ry" "rz"])
+(def position-channels ["tx" "ty" "tz"])
+
+(defn abs-value [value]
+  (js/Math.abs value))
+
+(defn radians->degrees [value]
+  (* value (/ 180 js/Math.PI)))
+
+(defn degrees->radians [value]
+  (* value (/ js/Math.PI 180)))
+
+(defn quaternion->euler [[x y z w]]
+  (let [sinr-cosp (* 2 (+ (* w x) (* y z)))
+        cosr-cosp (- 1 (* 2 (+ (* x x) (* y y))))
+        roll (js/Math.atan2 sinr-cosp cosr-cosp)
+        sinp (* 2 (- (* w y) (* z x)))
+        pitch (if (>= (abs-value sinp) 1)
+                (* (if (neg? sinp) -1 1) (/ js/Math.PI 2))
+                (js/Math.asin sinp))
+        siny-cosp (* 2 (+ (* w z) (* x y)))
+        cosy-cosp (- 1 (* 2 (+ (* y y) (* z z))))
+        yaw (js/Math.atan2 siny-cosp cosy-cosp)]
+    [roll pitch yaw]))
+
+(defn authored-euler->channels [rotation-euler]
+  ;; LoomLarge stores captured gesture rotations as local-axis Euler degrees.
+  ;; Animation snippets also address local rx/ry/rz channels, so preserve those
+  ;; authored axes directly instead of round-tripping through a quaternion.
+  (let [pitch (:pitch rotation-euler)
+        yaw (:yaw rotation-euler)
+        roll (:roll rotation-euler)]
+    (when (every? state/finite-number? [pitch yaw roll])
+      (zipmap rotation-channels
+              (map degrees->radians [pitch yaw roll])))))
+
+(defn finite-values [values expected-count]
+  (let [items (vec values)]
+    (when (and (= expected-count (count items))
+               (every? state/finite-number? items))
+      items)))
+
+(defn transform-values [transform]
+  (let [rotation (or (authored-euler->channels (:rotationEuler transform))
+                     (when-let [q (finite-values (:rotation transform) 4)]
+                       (zipmap rotation-channels (quaternion->euler q))))
+        position (when-let [p (finite-values (:position transform) 3)]
+                   (zipmap position-channels p))]
+    (merge rotation position)))
+
+(defn channel-kind [channel]
+  (if (#{"rx" "ry" "rz"} channel) :rotation :position))
+
+(defn target-value->channel [bone-id channel value curve]
+  (let [rotation? (= :rotation (channel-kind channel))
+        metric (if rotation? (abs-value (radians->degrees value)) (abs-value value))
+        target (cond->
+                {:type "bone"
+                 :id bone-id
+                 :channel channel
+                 :scale (if (neg? value) -1 1)}
+                 rotation? (assoc :maxDegrees metric)
+                 (not rotation?) (assoc :maxUnits metric))]
+    {:target target
+     :keyframes curve}))
+
+(defn static-curve [duration-sec ramp-ratio hold-ratio return?]
+  (let [ramp-end (min duration-sec (max 0.01 (* duration-sec ramp-ratio)))
+        hold-end (min duration-sec (+ ramp-end (* duration-sec hold-ratio)))]
+    (cond-> [{:time 0 :intensity 0}
+             {:time ramp-end :intensity 1}
+             {:time hold-end :intensity 1}]
+      return? (conj {:time duration-sec :intensity 0})
+      (not return?) (conj {:time duration-sec :intensity 1}))))
+
+(defn static-bone-channels [gesture config]
+  (let [duration-sec (/ (state/number-or (:durationMs gesture) (:defaultDurationMs config)) 1000)
+        return? (if (contains? gesture :returnToBase)
+                  (not (false? (:returnToBase gesture)))
+                  (:returnToBase config))
+        curve (static-curve duration-sec
+                            (:rampRatio config)
+                            (:holdRatio config)
+                            return?)]
+    (->> (:bones gesture)
+         (mapcat (fn [[bone-id transform]]
+                   (->> (transform-values transform)
+                        (keep (fn [[channel value]]
+                                (when (> (abs-value value) eps)
+                                  (target-value->channel bone-id channel value curve)))))))
+         vec)))
+
+(defn keyframe-values [gesture]
+  (->> (:keyframes gesture)
+       (mapcat (fn [keyframe]
+                 (let [time-sec (/ (state/number-or (:timeMs keyframe) 0) 1000)]
+                   (mapcat
+                    (fn [[bone-id transform]]
+                      (map (fn [[channel value]]
+                             {:boneId bone-id
+                              :channel channel
+                              :time time-sec
+                              :value value})
+                           (transform-values transform)))
+                    (:bones keyframe)))))
+       (remove #(<= (abs-value (:value %)) eps))
+       vec))
+
+(defn group-keyframe-values [values]
+  (reduce (fn [acc value]
+            (update acc [(:boneId value) (:channel value)] conj value))
+          {}
+          values))
+
+(defn dynamic-channel [[bone-id channel] values duration-sec return?]
+  (let [pivot (apply max-key #(abs-value (:value %)) values)
+        pivot-value (:value pivot)
+        max-value (abs-value pivot-value)
+        rotation? (= :rotation (channel-kind channel))
+        target (cond->
+                {:type "bone"
+                 :id bone-id
+                 :channel channel
+                 :scale (if (neg? pivot-value) -1 1)}
+                 rotation? (assoc :maxDegrees (abs-value (radians->degrees pivot-value)))
+                 (not rotation?) (assoc :maxUnits max-value))
+        signed-scale (:scale target)
+        curve (->> values
+                   (map (fn [value]
+                          {:time (:time value)
+                           :intensity (/ (* signed-scale (:value value)) max-value)}))
+                   (sort-by :time)
+                   vec)
+        with-start (if (zero? (:time (first curve)))
+                     curve
+                     (into [{:time 0 :intensity 0}] curve))
+        with-end (if return?
+                   (conj with-start {:time duration-sec :intensity 0})
+                   with-start)]
+    {:target target
+     :keyframes with-end}))
+
+(defn dynamic-bone-channels [gesture config]
+  (let [duration-sec (/ (state/number-or (:durationMs gesture) (:defaultDurationMs config)) 1000)
+        return? (if (contains? gesture :returnToBase)
+                  (not (false? (:returnToBase gesture)))
+                  (:returnToBase config))
+        values (keyframe-values gesture)]
+    (->> (group-keyframe-values values)
+         (map (fn [[key values]]
+                (dynamic-channel key values duration-sec return?)))
+         vec)))
+
+(defn gesture-name [gesture now]
+  (str "polymer:gesture:" (:id gesture) ":" now))
+
+(defn build-gesture-snippet [gesture config context]
+  (let [now (state/now-ms)
+        channels (if (seq (:keyframes gesture))
+                   (dynamic-bone-channels gesture config)
+                   (static-bone-channels gesture config))
+        duration-ms (state/number-or (:durationMs gesture) (:defaultDurationMs config))
+        duration-sec (/ duration-ms 1000)]
+    (when (seq channels)
+      {:name (or (:name context) (gesture-name gesture now))
+       :channels channels
+       :maxTime duration-sec
+       :loop (boolean (:loop gesture))
+       :snippetPriority (int (state/number-or (:priority gesture) (:priority config)))
+       :snippetPlaybackRate 1
+       :snippetIntensityScale (state/number-or (:intensity context) (:intensity config))
+       :metadata {:agency "gesture"
+                  :gestureId (:id gesture)
+                  :gestureName (:name gesture)
+                  :description (:description gesture)
+                  :emoji (:emoji gesture)
+                  :trigger (:trigger context)
+                  :intent (:intent context)
+                  :goal (:goal context)
+                  :selection (:selection context)
+                  :scope (:scope gesture)
+                  :captureSource (:captureSource gesture)
+                  :sourceText (:sourceText gesture)
+                  :textRepresentation (:textRepresentation gesture)
+                  :createdAt (:createdAt gesture)
+                  :updatedAt (:updatedAt gesture)
+                  :durationMs duration-ms
+                  :tags (:tags gesture)
+                  :affectedBones (:affectedBones gesture)
+                  :affectedAUs (:affectedAUs gesture)}})))

package/src/polymer/gesture/state.cljs

@@ -0,0 +1,273 @@
+(ns polymer.gesture.state
+  (:require [clojure.string :as str]))
+
+;; Gesture state is the local ledger for authored arm/hand gesticulations. The
+;; saved gesture library may come from a host, but Polymer keeps only data here:
+;; no scene handles, storage, host UI state, or animation runtime objects.
+
+(def default-config
+  {:enabled true
+   :intensity 1
+   :priority 45
+   :defaultDurationMs 700
+   :cooldownMs 0
+   :rampRatio 0.25
+   :holdRatio 0.55
+   :returnToBase true
+   :replaceActive true
+   :maxActive 1})
+
+(def default-state
+  {:agency "gesture"
+   :gestures {}
+   :emojiMappings {}
+   :activeSnippets {}
+   :lastPlayedByGesture {}
+   :scheduledCount 0
+   :removedCount 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 js-data [value]
+  (cond
+    (nil? value) nil
+    (or (map? value) (sequential? value)) value
+    :else (js->clj value :keywordize-keys true)))
+
+(defn string-key [value]
+  (cond
+    (nil? value) nil
+    (keyword? value) (name value)
+    :else (str value)))
+
+(defn clean-string [value]
+  (when-let [key (string-key value)]
+    (let [trimmed (str/trim key)]
+      (when (pos? (count trimmed)) trimmed))))
+
+(defn clean-strings [values]
+  (->> (or values [])
+       (keep clean-string)
+       distinct
+       vec))
+
+(defn sanitize-config [config]
+  (let [merged (merge default-config (or config {}))]
+    {:enabled (not (false? (:enabled merged)))
+     :intensity (clamp 0 2 (number-or (:intensity merged) (:intensity default-config)))
+     :priority (int (clamp -1000 1000 (number-or (:priority merged) (:priority default-config))))
+     :defaultDurationMs (clamp 80 10000 (number-or (:defaultDurationMs merged)
+                                                   (:defaultDurationMs default-config)))
+     :cooldownMs (clamp 0 10000 (number-or (:cooldownMs merged) (:cooldownMs default-config)))
+     :rampRatio (clamp 0.05 0.8 (number-or (:rampRatio merged) (:rampRatio default-config)))
+     :holdRatio (clamp 0 0.9 (number-or (:holdRatio merged) (:holdRatio default-config)))
+     :returnToBase (not (false? (:returnToBase merged)))
+     :replaceActive (not (false? (:replaceActive merged)))
+     :maxActive (int (clamp 1 12 (number-or (:maxActive merged) (:maxActive default-config))))}))
+
+(defn normalize-bones [bones]
+  (into {}
+        (keep (fn [[bone-id transform]]
+                (when-let [id (clean-string bone-id)]
+                  [id transform])))
+        (or bones {})))
+
+(defn normalize-keyframe [keyframe]
+  (let [time-ms (number-or (:timeMs keyframe) 0)
+        bones (normalize-bones (:bones keyframe))]
+    (when (seq bones)
+      {:timeMs (max 0 time-ms)
+       :bones bones})))
+
+(defn normalize-keyframes [keyframes]
+  (->> (or keyframes [])
+       (keep normalize-keyframe)
+       (sort-by :timeMs)
+       vec))
+
+(defn keyframe-bone-names [keyframes]
+  (->> keyframes
+       (mapcat #(keys (:bones %)))
+       (keep clean-string)
+       distinct
+       vec))
+
+(defn normalize-gesture [fallback-id gesture]
+  (let [input (or gesture {})
+        id (clean-string (or (:id input) fallback-id))
+        bones (normalize-bones (:bones input))
+        keyframes (normalize-keyframes (:keyframes input))
+        duration-ms (when (contains? input :durationMs)
+                      (clamp 80 10000
+                             (number-or (:durationMs input)
+                                        (:defaultDurationMs default-config))))
+        priority (when (contains? input :priority)
+                   (int (clamp -1000 1000
+                               (number-or (:priority input)
+                                          (:priority default-config)))))
+        affected-bones (or (seq (clean-strings (:affectedBones input)))
+                           (seq (keys bones))
+                           (seq (keyframe-bone-names keyframes)))]
+    (when id
+      (-> input
+          (assoc :id id
+                 :name (or (clean-string (:name input)) id)
+                 :affectedBones (vec affected-bones)
+                 :affectedAUs (clean-strings (:affectedAUs input))
+                 :bones bones)
+          (cond->
+           duration-ms (assoc :durationMs duration-ms)
+           priority (assoc :priority priority)
+           (seq keyframes) (assoc :keyframes keyframes)
+           (clean-string (:description input)) (assoc :description (clean-string (:description input)))
+           (clean-string (:captureSource input)) (assoc :captureSource (clean-string (:captureSource input)))
+           (clean-string (:sourceText input)) (assoc :sourceText (clean-string (:sourceText input)))
+           (clean-string (:textRepresentation input)) (assoc :textRepresentation (clean-string (:textRepresentation input)))
+           (clean-string (:emoji input)) (assoc :emoji (clean-string (:emoji input)))
+           (seq (:tags input)) (assoc :tags (clean-strings (:tags input))))))))
+
+(defn normalize-gesture-library [gestures]
+  (into {}
+        (keep (fn [[gesture-id gesture]]
+                (when-let [normalized (normalize-gesture gesture-id gesture)]
+                  [(:id normalized) normalized])))
+        (or gestures {})))
+
+(defn gesture-emoji-mappings [gestures]
+  (into {}
+        (keep (fn [[gesture-id gesture]]
+                (when-let [emoji (clean-string (:emoji gesture))]
+                  [emoji gesture-id])))
+        gestures))
+
+(defn normalize-emoji-mappings [emoji-mappings gestures]
+  (merge
+   (gesture-emoji-mappings gestures)
+   (into {}
+         (keep (fn [[emoji gesture-id]]
+                 (when-let [clean-emoji (clean-string emoji)]
+                   (when-let [clean-id (clean-string gesture-id)]
+                     [clean-emoji clean-id]))))
+         (or emoji-mappings {}))))
+
+(defn library-from-config [config]
+  (normalize-gesture-library (or (:gestures config)
+                                 (:characterGestures config)
+                                 (:gestureLibrary config))))
+
+(defn emoji-mappings-from-config [config gestures]
+  (normalize-emoji-mappings (or (:emojiMappings config)
+                                (:gestureEmojiMappings config))
+                            gestures))
+
+(defn config->state [config]
+  (let [data (or (js-data config) {})
+        gestures (library-from-config data)]
+    (assoc default-state
+           :gestures gestures
+           :emojiMappings (emoji-mappings-from-config data gestures)
+           :config (sanitize-config data))))
+
+(defn configure [state config]
+  (let [data (or (js-data config) {})
+        configured (update state :config #(sanitize-config (merge % data)))]
+    (if (or (contains? data :gestures)
+            (contains? data :characterGestures)
+            (contains? data :gestureLibrary)
+            (contains? data :emojiMappings)
+            (contains? data :gestureEmojiMappings))
+      (let [gestures (if (or (contains? data :gestures)
+                             (contains? data :characterGestures)
+                             (contains? data :gestureLibrary))
+                       (library-from-config data)
+                       (:gestures configured))
+            mapping-input (if (or (contains? data :gestures)
+                                  (contains? data :characterGestures)
+                                  (contains? data :gestureLibrary))
+                            (or (:emojiMappings data) (:gestureEmojiMappings data))
+                            (or (:emojiMappings data)
+                                (:gestureEmojiMappings data)
+                                (:emojiMappings configured)))]
+        (assoc configured
+               :gestures gestures
+               :emojiMappings (normalize-emoji-mappings mapping-input gestures)))
+      configured)))
+
+(defn load-gestures [state gestures emoji-mappings loaded-at]
+  (let [library (normalize-gesture-library (or (js-data gestures) {}))]
+    (-> state
+        (assoc :gestures library
+               :emojiMappings (normalize-emoji-mappings (js-data emoji-mappings) library))
+        (assoc :lastEvent {:type "gestureLibraryUpdated"
+                           :gestureCount (count library)
+                           :emojiCount (count (normalize-emoji-mappings (js-data emoji-mappings) library))
+                           :at loaded-at}))))
+
+(defn gesture-ready? [state gesture-id now]
+  (let [cooldown-ms (get-in state [:config :cooldownMs])
+        last-played (get-in state [:lastPlayedByGesture gesture-id] 0)]
+    (or (zero? cooldown-ms)
+        (>= (- now last-played) cooldown-ms))))
+
+(defn active-names [state]
+  (vec (keys (:activeSnippets state))))
+
+(defn active-names-for-gesture [state gesture-id]
+  (->> (:activeSnippets state)
+       (keep (fn [[name active]]
+               (when (= gesture-id (:gestureId active)) name)))
+       vec))
+
+(defn record-schedule [state gesture snippet scheduled-at]
+  (let [name (:name snippet)
+        gesture-id (:id gesture)]
+    (-> state
+        (assoc-in [:activeSnippets name]
+                  {:name name
+                   :gestureId gesture-id
+                   :gestureName (:name gesture)
+                   :emoji (:emoji gesture)
+                   :scope (:scope gesture)
+                   :affectedBones (:affectedBones gesture)
+                   :maxTime (:maxTime snippet)
+                   :loop (:loop snippet)
+                   :priority (:snippetPriority snippet)
+                   :trigger (get-in snippet [:metadata :trigger])
+                   :intent (get-in snippet [:metadata :intent])
+                   :scheduledAt scheduled-at})
+        (assoc-in [:lastPlayedByGesture gesture-id] scheduled-at)
+        (update :scheduledCount inc)
+        (assoc :lastEvent {:type "gestureScheduled"
+                           :name name
+                           :gestureId gesture-id
+                           :at scheduled-at}))))
+
+(defn record-remove [state name reason removed-at]
+  (-> state
+      (update :activeSnippets dissoc name)
+      (update :removedCount inc)
+      (assoc :lastEvent {:type "gestureRemoved"
+                         :name name
+                         :reason reason
+                         :at removed-at})))
+
+(defn visible-state-map [state]
+  (assoc state
+         :gestureCount (count (:gestures state))
+         :emojiCount (count (:emojiMappings state))
+         :gestures (vec (keys (:gestures state)))))
+
+(defn visible-state [state]
+  (clj->js (visible-state-map state)))