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-svm.lisp < prev    next >
Encoding:
Text File  |  1992-07-10  |  3.4 KB  |  100 lines
  1. (in-package :oou)
  2. (oou-provide :video-svm)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; :video-svm.lisp
  5. ;;
  6. ;; Copyright ⌐ 1991 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; mixin for adding video to views
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies :video-player
  15.                   :video-digitizer-svm
  16.                   )
  17.  
  18. (export '(video-svm video-view player-object))
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21.  
  22. (defclass video-svm (video-digitizer-svm)
  23.   ((player-class           :initarg :player-class)
  24.    (player-object          :initarg :player-object
  25.                            :accessor player-object)
  26.    (dispose-vp-on-remove-p :initarg :dispose-vp-on-remove-p)
  27.    )
  28.   (:default-initargs
  29.     :dispose-vp-on-remove-p t))
  30.  
  31. (defclass video-view (video-svm simple-view) ())
  32.  
  33. (defmethod initialize-instance :after ((sv video-svm) &rest initargs
  34.                                        &key 
  35.                                        &allow-other-keys)
  36.   (declare (dynamic-extent initargs))
  37.   (unless (slot-boundp sv 'player-object)
  38.     (setf (player-object sv)
  39.           (apply 'make-instance (slot-value sv 'player-class)
  40.                  :allow-other-keys t
  41.                  initargs))))
  42.  
  43. (defmethod install-view-in-window :after ((sv video-svm) window)
  44.   (declare (ignore window))
  45.   (vp-init (player-object sv)))
  46.  
  47. (defmethod remove-view-from-window :before ((sv video-svm))
  48.   (with-slots ((vp player-object)) sv
  49.     (vp-stop vp)
  50.     (when (slot-value sv 'dispose-vp-on-remove-p) (vp-dispose vp))))
  51.  
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53.  
  54. (defmethod vp-load ((sv video-svm) &rest rest &key &allow-other-keys)
  55.   (apply 'vp-load (player-object sv) rest))
  56.   
  57. (defmethod vp-loaded-p ((sv video-svm))
  58.   (funcall 'vp-loaded-p (player-object sv)))
  59.   
  60. (defmethod vp-features ((sv video-svm))
  61.   (funcall 'vp-features (player-object sv)))
  62.   
  63. (defmethod vp-seek ((sv video-svm) frame &rest rest &key &allow-other-keys)
  64.  (apply 'vp-seek (player-object sv) frame rest))
  65.  
  66. (defmethod vp-play ((sv video-svm))
  67.   (funcall 'vp-play (player-object sv))
  68.   (unless (digitizing-p sv) (start-digitizing sv)))
  69.  
  70. (defmethod vp-limit ((sv video-svm)  min-frame max-frame)
  71.   (funcall 'vp-limit (player-object sv) min-frame max-frame))
  72.  
  73. (defmethod vp-play-clip ((sv video-svm) start-frame end-frame &rest rest &key &allow-other-keys)
  74.   (apply 'vp-play-clip (player-object sv) start-frame end-frame rest)
  75.   (unless (digitizing-p sv) (start-digitizing sv)))
  76.  
  77. (defmethod vp-scan ((sv video-svm) direction speed-x)
  78.   (funcall 'vp-scan (player-object sv) direction speed-x)
  79.   (unless (digitizing-p sv) (start-digitizing sv)))
  80.  
  81. (defmethod vp-jump ((sv video-svm) direction frame-count)
  82.   (funcall 'vp-jump (player-object sv) direction frame-count)
  83.   (unless (digitizing-p sv) (grab-one-frame sv)))
  84.  
  85. (defmethod vp-step ((sv video-svm) direction)
  86.   (funcall 'vp-step (player-object sv) direction)
  87.   (unless (digitizing-p sv) (grab-one-frame sv)))
  88.  
  89. (defmethod vp-stop ((sv video-svm))
  90.   (when (digitizing-p sv) (stop-digitizing sv))
  91.   (funcall 'vp-stop (player-object sv)))
  92.  
  93. (defmethod vp-freeze ((sv video-svm))
  94.   (when (digitizing-p sv) (stop-digitizing sv))
  95.   (funcall 'vp-freeze (player-object sv)))
  96.  
  97. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  98. #|
  99.    an example can be found in video-example.lisp
  100. |#