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 / P330-vp.lisp next >
Encoding:
Text File  |  1992-05-17  |  2.0 KB  |  59 lines
  1. (in-package :oou)
  2. (oou-provide :P330-vp)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; P330-vp.lisp
  5. ;;
  6. ;; Copyright ⌐ 1991 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; video player object for Pioneer model 330 "JukeBox" laserdisc players
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies
  15.  :P4200-vp)
  16.  
  17. (export '(P330-vp))
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20.  
  21. (defclass P330-vp (P4200-vp)
  22.   ((current-disk :reader     current-disk
  23.                  :allocation :class)
  24.    (current-side :reader     current-side
  25.                  :initform   :A
  26.                  :allocation :class)))
  27.  
  28. (defmethod vp-load :before ((vp P330-vp) &key disk side)
  29.  (unless (and disk side)
  30.    (multiple-value-bind (cur-disk cur-side) (P330-current-disk vp)
  31.       (setf disk (or disk cur-disk))
  32.      (setf side (or side cur-side))))
  33.  (if (and disk side)
  34.      (P330-load-disc vp disk side)
  35.      (error "330's require a disk number and side to load")))
  36.   
  37. (defmethod vp-seek :before ((vp P330-vp) frame
  38.                             &key
  39.                             (disk (current-disk vp))
  40.                             (side (current-side vp)))
  41.   (declare (ignore frame))
  42.   (unless (and (= disk (current-disk vp)) (eq side (current-side vp)))
  43.     (vp-load vp :disk disk :side side)))
  44.  
  45. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46.  
  47. (defmethod P330-load-disc ((vp P330-vp) disk side)
  48.   (slot-makunbound vp 'current-disk)
  49.   (pld-cmd vp (ecase side (:A "ZA") (:B "ZB")) :arg disk)
  50.   (setf (slot-value vp 'current-side) side
  51.         (slot-value vp 'current-disk) disk))
  52.  
  53. (defmethod P330-current-disk ((vp P330-vp))
  54.  (when (char-equal #\1 (char (pld-cmd vp "?D") 0))
  55.    (let ((face-code (parse-integer (pld-cmd vp "?Z"))))
  56.      (values (ceiling face-code 2) (if (evenp face-code) :B :A)))))
  57.  
  58. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  59.