Basic video playback

examples/video.lisp

@@ -11,13 +11,17 @@
          (setf (state video-player) :paused)
          (setf (state video-player) :playing)))
     ((#\r)
-     )))
+     (setf (clock video-player) 0.0))
+    ((#\l)
+     (setf (loop-p video-player) (not (loop-p video-player))))))
 
 (define-example video
   (gl:clear-color 0 0 0 0)
   (enter (make-instance 'display-controller) scene)
   (enter (make-instance 'video-player :asset (assets:asset :hello) :location (vec 0 2 0) :scaling (vec 5 5 5)) scene)
-  (observe! (clock (node :video T)) :title "Time")
+  (observe! (clock (node :video T)) :title "Time [r]")
+  (observe! (state (node :video T)) :title "State [p]")
+  (observe! (loop-p (node :video T)) :title "Loop [l]")
   (enter (make-instance 'vertex-entity :vertex-array (// 'trial 'grid)) scene)
   (enter (make-instance 'editor-camera :location (VEC3 0.0 2 7) :fov 50 :move-speed 0.1) scene)
   (enter (make-instance 'phong-render-pass) scene))

formats/theora.lisp

@@ -76,3 +76,16 @@
           (update (resource asset :u))
           (update (resource asset :v)))))
     fc))
+
+(defmethod done-p ((asset asset))
+  (org.shirakumo.fraf.theora:done-p (file asset)))
+
+(defmethod duration ((asset asset))
+  (implement!))
+
+(defmethod seek ((asset asset) to)
+  (cond ((= 0 to)
+         (org.shirakumo.fraf.theora:reset (file asset))
+         0.0)
+        (T
+         (implement!))))

package.lisp

@@ -1721,7 +1721,10 @@
   (:export
    #:video
    #:clock
-   #:state))
+   #:state
+   #:duration
+   #:seek
+   #:done-p))
 
 (defpackage #:cl+trial
   (:nicknames #:org.shirakumo.fraf.trial.cl+trial)

video.lisp

@@ -5,9 +5,10 @@
 (define-shader-entity video (vertex-entity listener)
   ((textures :accessor textures)
    (asset :initarg :asset)
-   (clock :initform 0f0 :accessor clock)
+   (clock :initform 0f0 :reader clock)
    (frame :initform 0 :accessor frame)
-   (state :initarg :state :initform :paused :accessor state)))
+   (state :initarg :state :initform :paused :accessor state)
+   (loop-p :initform NIL :accessor loop-p)))
 
 (defmethod shared-initialize :after ((video video) slots &key asset)
   (when asset
@@ -31,11 +32,30 @@
   (setf (uniform program "U_plane") 1)
   (setf (uniform program "V_plane") 2))
 
+(defmethod (setf clock) (new (video video))
+  (seek video new))
+
+(defmethod duration ((video video))
+  (duration (slot-value video 'asset)))
+
+(defmethod seek ((video video) to)
+  (setf (slot-value video 'clock) (seek (slot-value video 'asset) to))
+  (setf (frame video) 0))
+
+(defmethod done-p ((video video))
+  (done-p (slot-value video 'asset)))
+
 (define-handler (video tick) (dt)
   (when (eql :playing (state video))
-    (let* ((tt (incf (clock video) dt))
-           (fc (update (slot-value video 'asset) tt dt (frame video))))
-      (setf (frame video) fc))))
+    (let* ((asset (slot-value video 'asset))
+           (tt (+ (clock video) dt))
+           (fc (update asset tt dt (frame video))))
+      (setf (slot-value video 'clock) tt)
+      (setf (frame video) fc)
+      (when (done-p asset)
+        (if (loop-p video)
+            (setf (clock video) 0.0)
+            (setf (state video) :paused))))))
 
 (define-class-shader (video :vertex-shader)
   "layout (location = 2) in vec2 in_uv;