;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; LUSH Lisp Universal Shell
;;;   Copyright (C) 2002 Leon Bottou, Yann Le Cun, AT&T Corp, NECI.
;;; Includes parts of TL3:
;;;   Copyright (C) 1987-1999 Leon Bottou and Neuristique.
;;; Includes selected parts of SN3.2:
;;;   Copyright (C) 1991-2001 AT&T Corp.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; $Id: play.lsh,v 1.2 2004/02/04 21:16:57 leonb Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(libload "ffmpeg")

;;; ----------------------------------------

#? ** Lush Video Player
;; Function <av-play> provides a simple video player.

;;; ----------------------------------------

#? (av-play <filename> [<mag> [<speedup> [<osd>]]])
;; Play the video file <filename>.
;; Argument <mag> is a display maginification.
;; Argument <speedup> changes the play rate.
;; Setting argument <osd> to <t> prints the time stamp 
;; on the upper left corner of the window.

(de av-play(filename &optional (mag 1) (fast 1) (osd ()))
  (let* ((window ())
	 (image ())
	 (timer (new AvTimer))
	 (src (av-open-video-source filename))
	 (w :src:frame-width)
	 (h :src:frame-height)
	 (pts (==> src get-frame-pts)) 
	 (oldpts pts) )
    (new-window 0 0 (* mag w) (* mag h) "Lush video player")
    (when osd (when font-18 (font-18)) (color-rgb 0 0.7 0))
    (while (==> src nextframe)
      (setq pts (==> src get-frame-pts))
      (setq image (==> src get-frame-rgba))
      (==> timer sleep (/ (- pts oldpts) fast))
      (rgb-draw-matrix 0 0 image mag mag)
      (when osd (gprintf 5 20 "%08.3f" pts))
      (setq oldpts pts) )
    window ) )


;;; ----------------------------------------


(defclass AvTimer Object
  last )

(defmethod AvTimer AvTimer()
  (setq last (time)) )

(defmethod AvTimer sleep(delay)
  (if (functionp create-timer-absolute)
      ;; count delay since last time we woke up.
      (let* ((now (time))
	     (dat (max now (+ last delay))) )
	(when (> dat now)
	  (create-timer-absolute this dat)	  
	  (let ((h ()))
	    (while (<> (setq h (waitevent)) this)
	      (while (checkevent h) t) )
	    (checkevent this) ) )
	(setq last dat) )
    ;; otherwise use function <sleep>
    (sleep delay) )
  () )

