Untested clip triggers

animation/clip.lisp

@@ -7,7 +7,9 @@
    (end-time :initform 0f0 :accessor end-time)
    (next-clip :accessor next-clip)
    (blocking-p :initform NIL :accessor blocking-p)
-   (blend-duration :initarg :blend-duration :initform 0.2f0 :accessor blend-duration)))
+   (blend-duration :initarg :blend-duration :initform 0.2f0 :accessor blend-duration)
+   (triggers :initform #() :accessor triggers)
+   (next-trigger :initform 0 :accessor next-trigger)))
 
 (defmethod shared-initialize :after ((clip clip) slots &key tracks (loop-p NIL loop-pp) (next-clip NIL next-clip-p))
   (when tracks
@@ -128,6 +130,26 @@
            time)
          0.0)))
 
+(defmethod sample :after (target (clip clip) time &key)
+  (let* ((time (fit-to-clip clip time))
+         (triggers (triggers clip))
+         (next-idx (the (unsigned-byte 16) (next-trigger clip)))
+         (next (if (<= (length triggers) next-idx)
+                   most-positive-single-float
+                   (car (aref triggers next-idx)))))
+    (declare (type single-float time next))
+    (declare (type simple-vector triggers))
+    (when (< next time)
+      (loop for i of-type (unsigned-byte 16) from next-idx below (length triggers)
+            for (trigger-time . trigger) = (aref triggers i)
+            do (cond ((< trigger-time time)
+                      (activate-trigger target trigger))
+                     (T
+                      (setf (next-trigger clip) i)
+                      (return)))
+            finally (setf (next-trigger clip)
+                          (if (loop-p clip) 0 (length triggers)))))))
+
 (%define-sampler-method sequences:sequence (elt thing name))
 (%define-sampler-method vector (aref thing name))
 (%define-sampler-method hash-table (gethash name thing))

formats/gltf.lisp

@@ -5,7 +5,10 @@
    (#:gltf #:org.shirakumo.fraf.gltf)
    (#:sequences #:org.shirakumo.trivial-extensible-sequences)
    (#:v #:org.shirakumo.verbose))
-  (:export))
+  (:export
+   #:translate-track-pointer
+   #:translate-effect
+   #:define-trigger-translation))
 (in-package #:org.shirakumo.fraf.trial.gltf)
 
 (defun gltf-name (thing)
@@ -105,6 +108,15 @@
                 :slot-name pointer
                 :name (name track)))
 
+(defgeneric translate-effect (name effect gltf))
+
+(defmethod translate-effect ((name string) effect gltf)
+  (translate-effect (lispify-name name) effect gltf))
+
+(defmethod translate-effect (name effect gltf)
+  (v:warn :trial.gltf "Unknown effect name: ~s, ignoring." name)
+  NIL)
+
 ;; FIXME: How do we actually translate the pointer to the corresponding lisp-side object slot?
 ;;        it's unlikely to be what's pointed to by the json pointer, since objects are transformed
 ;;        to more fitting native representations that should be manipulated instead.
@@ -130,7 +142,7 @@
                 (load-animation-track track sampler))
                (T (v:warn :trial.gltf "Unknown animation channel target path: ~s on ~s, ignoring."
                           (gltf:path (gltf:target channel)) (gltf-name animation)))))
-    ;; KLUDGE: extra handling for custom properties
+    ;; Extra handling for custom properties
     (let* ((extras (gltf:extensions animation))
            (trial (when extras (gethash "SHIRAKUMO_trial" extras)))
            (tracks (when trial (gethash "extraTracks" trial))))
@@ -152,6 +164,11 @@
         (setf (next-clip clip) (trial:lispify-name (gltf:next animation)))
         (setf (loop-p clip) (gltf:loop-p animation)))
     (setf (blend-duration clip) (gltf:blend-duration animation))
+    (setf (trial::triggers clip)
+          (coerce (loop for effect across (gltf:effects animation)
+                        for trigger = (translate-effect (gltf:name effect) effect gltf)
+                        when trigger collect trigger)
+                  'simple-vector))
     clip))
 
 (defun load-clips (gltf &optional (table (make-hash-table :test 'equal)))

physics/trigger.lisp

@@ -243,3 +243,14 @@
 (define-transfer checkpoint-trigger spawn-point)
 
 (defmethod activate-trigger (a (trigger checkpoint-trigger)))
+
+(defclass audio-trigger (type-filtered-trigger-volume)
+  ((audio :initarg :audio :accessor audio)))
+
+(define-transfer audio-trigger audio)
+
+(defmethod stage :after ((trigger audio-trigger) (area staging-area))
+  (stage (audio trigger) area))
+
+(defmethod activate-trigger (thing (trigger audio-trigger))
+  (play (audio trigger) thing))