home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / MCLs-funniest-home-videos / video-players / video-player.lisp < prev   
Encoding:
Text File  |  1992-02-13  |  7.6 KB  |  226 lines
  1. (in-package :oou)
  2. (oou-provide :video-player)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; video-player.lisp
  5. ;;
  6. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; object for controling video players
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies
  15.  :serial-port
  16.  )
  17.  
  18. (export '(video-player
  19.           vp-init vp-dispose vp-load vp-loaded-p vp-features
  20.           vp-max-frame vp-min-frame vp-current-frame
  21.           vp-seek vp-play vp-play-clip vp-limit
  22.           vp-stop vp-freeze vp-step vp-scan vp-jump))
  23.  
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (defclass video-player ()
  27.   ((framehook-fn    :initarg :framehook-fn
  28.                     :reader   framehook-fn)
  29.    (fh-install-fn   :accessor fh-install-fn)
  30.    (fh-remove-fn    :accessor fh-remove-fn)
  31.    (frame-limit-p   :initform nil
  32.                     :accessor frame-limit-p)
  33.    (min-frame-limit :accessor min-frame-limit)
  34.    (max-frame-limit :accessor max-frame-limit))
  35.   )
  36.  
  37. (defmethod initialize-instance :after ((vp video-player) &rest initargs)
  38.   (declare (ignore initargs))
  39.   (framehook-init vp))
  40.  
  41.  
  42. ;;;;;;;;;;;;;;;;;;;;
  43. ;;
  44.  
  45. (defmethod  vp-init    ((vp video-player)) t)
  46. (defmethod  vp-dispose ((vp video-player)) t)
  47.  
  48. (defgeneric vp-load     (vp &key &allow-other-keys))
  49. (defgeneric vp-loaded-p (vp))
  50.  
  51. (defmethod  vp-features ((vp video-player)) nil)
  52.  
  53.  
  54. ;;;;;;;;;;;;;;;;;;;;
  55. ;;core feature control methods
  56.  
  57. (defgeneric vp-max-frame (vp))
  58. (defgeneric vp-min-frame (vp))
  59. (defgeneric vp-current-frame (vp))
  60.  
  61. (defmethod vp-seek :around ((vp video-player) frame &key &allow-other-keys)
  62.   (declare (ignore frame))
  63.   (with-cursor *watch-cursor*
  64.     (call-next-method)))
  65.  
  66. (defmethod vp-play :around ((vp video-player))
  67.   (when (vp-limit-check-p vp :forward) (call-next-method)))
  68.  
  69. (defmethod vp-play :after ((vp video-player))
  70.   (vp-framehook-install vp))
  71.  
  72. (defmethod vp-stop :after ((vp video-player))
  73.   (vp-framehook-remove vp)
  74.   (vp-fix-overshoot vp)
  75.   (vp-framehook vp))
  76.  
  77.  
  78. ;;;;;;;;;;;;;;;;;;;;
  79. ;;optional feature control methods
  80.  
  81. (defmethod vp-freeze :after ((vp video-player))
  82.   (vp-framehook-remove vp)
  83.   (vp-fix-overshoot vp)
  84.   (vp-framehook vp))
  85.  
  86. (defmethod vp-step :around ((vp video-player) direction)
  87.   (when (vp-limit-check-p vp direction) (call-next-method)))
  88.  
  89. (defmethod vp-step :after ((vp video-player) direction)
  90.   (declare (ignore direction))
  91.   (vp-framehook vp))
  92.  
  93. (defmethod vp-scan :around ((vp video-player) direction speed-x)
  94.   (declare (ignore speed-x))
  95.   (when (vp-limit-check-p vp direction) (call-next-method)))
  96.  
  97. (defmethod vp-scan :after ((vp video-player) direction speed-x)
  98.   (declare (ignore direction speed-x))
  99.   (vp-framehook-install vp))
  100.  
  101.  
  102. ;;;;;;;;;;;;;;;;;;;;
  103. ;;high level feature control methods
  104.  
  105. (defmethod vp-jump :around ((vp video-player) direction frame-count)
  106.   (let ((max-jump (ecase direction
  107.                     (:forward
  108.                      (- (if (frame-limit-p vp) (max-frame-limit vp) (vp-max-frame vp))
  109.                         (vp-current-frame vp)))
  110.                     (:reverse
  111.                      (- (vp-current-frame vp)
  112.                         (if (frame-limit-p vp) (min-frame-limit vp) (vp-min-frame vp)))))))
  113.     (when (plusp max-jump)
  114.       (call-next-method vp direction frame-count))))
  115.  
  116. (defmethod vp-jump :after ((vp video-player) direction frame-count)
  117.   (declare (ignore direction frame-count))
  118.   (vp-fix-overshoot vp)
  119.   (vp-framehook vp))
  120.  
  121. (defmethod vp-jump ((vp video-player) direction frame-count)
  122.   (vp-seek vp (ecase direction
  123.                 (:forward (+ (vp-current-frame vp) frame-count))
  124.                 (:reverse (- (vp-current-frame vp) frame-count)))))
  125.  
  126. (defmethod vp-play-clip :around ((vp video-player) start-frame end-frame &rest rest &key &allow-other-keys)
  127.   (declare (ignore rest))
  128.   (let ((old-min-limit (when (frame-limit-p vp) (min-frame-limit vp)))
  129.         (old-max-limit (when (frame-limit-p vp) (max-frame-limit vp))))
  130.     (prog2
  131.      (vp-limit vp start-frame end-frame)
  132.      (call-next-method)
  133.      (vp-limit vp old-min-limit old-max-limit))))
  134.  
  135. (defmethod vp-play-clip ((vp video-player) start-frame end-frame &rest rest &key &allow-other-keys)
  136.   (declare (ignore end-frame))
  137.   (apply 'vp-seek vp start-frame rest)
  138.   (vp-play vp)
  139.   t)
  140.  
  141.  
  142. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  143. ;; frame limit methods
  144.  
  145. (defmethod vp-limit ((vp video-player) min-frame max-frame)
  146.   (if (or min-frame max-frame)
  147.     (setf (min-frame-limit vp) (or min-frame (vp-min-frame vp))
  148.           (max-frame-limit vp) (or max-frame (vp-max-frame vp))
  149.           (frame-limit-p vp)   t)
  150.     (setf (frame-limit-p vp) nil)))
  151.  
  152. (defmethod vp-limit-check-p ((vp video-player) direction)
  153.   (or (not (frame-limit-p vp))
  154.       (let ((cur-frame (vp-current-frame vp)))
  155.         (with-slots (max-frame-limit min-frame-limit) vp
  156.           (ecase direction
  157.             (:forward  (< cur-frame max-frame-limit))
  158.             (:reverse  (> cur-frame min-frame-limit)))))))
  159.  
  160. (defmethod vp-fix-overshoot ((vp video-player))
  161.   (when (frame-limit-p vp)
  162.     (with-slots (max-frame-limit min-frame-limit) vp
  163.       (let ((cur-frame (vp-current-frame vp)))
  164.         (if (> cur-frame max-frame-limit)
  165.           (vp-seek vp max-frame-limit)
  166.           (when (< cur-frame min-frame-limit)
  167.             (vp-seek vp min-frame-limit)))))))
  168.  
  169.  
  170. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  171. ;; framehook mechanism
  172.  
  173. (defmethod framehook-init ((vp video-player))
  174.   (let ((eventhook-save nil)
  175.         (installed-p nil)
  176.         (last-frame -1)
  177.         (min-frame 0)
  178.         (max-frame most-positive-fixnum)
  179.         (freeze-p nil))
  180.     (flet ((fh-limit ()
  181.              (let ((cur-frame (vp-current-frame vp)))
  182.                (unless (= cur-frame last-frame)
  183.                  (setf last-frame cur-frame)
  184.                  (if (or (<= cur-frame min-frame) (>= cur-frame max-frame))
  185.                    (if freeze-p (vp-freeze vp) (vp-stop vp))
  186.                    (vp-framehook vp cur-frame)))
  187.                (when eventhook-save (funcall eventhook-save))))
  188.            (fh-update ()
  189.              (let ((cur-frame (vp-current-frame vp)))
  190.                (unless (= cur-frame last-frame)
  191.                  (setf last-frame cur-frame)
  192.                  (vp-framehook vp cur-frame))
  193.                (when eventhook-save (funcall eventhook-save)))))
  194.       (flet ((fh-install ()
  195.                (unless installed-p
  196.                  (setf installed-p t)
  197.                  (setf eventhook-save *eventhook*)
  198.                  (setf last-frame -1)
  199.                  (setf freeze-p (find :freeze (vp-features vp)))
  200.                  (if (frame-limit-p vp)
  201.                    (setf min-frame (min-frame-limit vp)
  202.                          max-frame (max-frame-limit vp)
  203.                          *eventhook* #'fh-limit)
  204.                    (setf *eventhook* #'fh-update))))
  205.              (fh-remove ()
  206.                (when installed-p
  207.                  (setf *eventhook* eventhook-save)
  208.                  (setf installed-p nil))))
  209.         (setf (fh-install-fn vp) #'fh-install
  210.               (fh-remove-fn vp)  #'fh-remove)))))
  211.  
  212. (defmethod vp-framehook ((vp video-player) &optional (current-frame (vp-current-frame vp)))
  213.   (when (slot-boundp vp 'framehook-fn)
  214.     (funcall (framehook-fn vp) current-frame)))
  215.  
  216. (defmethod vp-framehook-install ((vp video-player))
  217.   (when (or (slot-boundp vp 'framehook-fn) (frame-limit-p vp))
  218.     (funcall (fh-install-fn vp))))
  219.  
  220. (defmethod vp-framehook-remove ((vp video-player))
  221.   (funcall (fh-remove-fn vp)))
  222.  
  223. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  224. #|
  225. examples can be found in the player specific -vp files
  226. |#