home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / work-in-progress / NEC-PC-VCR.lisp < prev    next >
Encoding:
Text File  |  1992-02-07  |  8.2 KB  |  276 lines
  1. (in-package :oou)
  2. (oou-provide :NEC-PC-VCR-vp)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; NEC-PC-VCR-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 class for controling Pioneer laserdisc players
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies :video-player
  15.                   :serial-port
  16.                   )
  17.  
  18. (export '(NEC-PC-VCR-vp
  19.            ))
  20.  
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22.  
  23. (defclass NEC-PC-VCR-vp (serial-port video-player)
  24.   ((tape-format          :reader tape-format)
  25.    (stop-frame)
  26.    (check-tape-on-load-p :accessor check-tape-on-load-p
  27.                          :initarg :check-tape-on-load-p))
  28.   (:default-initargs
  29.     :check-tape-on-load-p t
  30.     :open-on-init-p nil
  31.     :baud 1200))
  32.  
  33. (defmethod vp-features ((vp NEC-PC-VCR-vp))
  34.   '(:freeze :step-forward :scan))
  35.  
  36. (defmethod vp-init :after ((vp NEC-PC-VCR-vp))
  37.   (sport-open vp :flush-p nil)
  38.   (npv-cmd vp "PW" :arg 1))
  39.  
  40. (defmethod vp-dispose :after ((vp NEC-PC-VCR-vp))
  41.   (sport-close vp))
  42.  
  43. (defmethod vp-load ((vp NEC-PC-VCR-vp) &key)
  44.   (when (eq :no-tape (npv-cur-state vp)) (error "no tape in PC-VCR"))
  45.   (when (check-tape-on-load-p vp)
  46.     (let ((header-str (npv-cmd vp "HR" :error-p nil)))
  47.       (when (char= #\E (char header-str 0))
  48.         (error "tape does not have address codes (~s)" header-str))))
  49.   (let ((fmt-string (npv-cmd vp "DS" :arg 7)))
  50.     (setf (slot-value vp 'tape-format)
  51.           (cond ((string= fmt-string "STANDARD") :SP)
  52.                 ((string= fmt-string "EXTENDED") :EP)
  53.                 (t (error "unknown tape format ~s" fmt-string)))))
  54.   (vp-seek vp 90)
  55.   (vp-play vp)
  56.   (vp-freeze vp)
  57.   (setf (slot-value vp 'stop-frame) (npv-cur-frame vp))
  58.   t)
  59.  
  60. (defmethod vp-loaded-p ((vp NEC-PC-VCR-vp))
  61.   (and (slot-boundp vp 'tape-format)
  62.        (not (eq :no-tape (npv-cur-state vp)))))
  63.  
  64. (defmethod vp-max-frame ((vp NEC-PC-VCR-vp)) 999999)
  65.  
  66. (defmethod vp-min-frame ((vp NEC-PC-VCR-vp)) 90)
  67.  
  68. (defmethod vp-current-frame ((vp NEC-PC-VCR-vp))
  69.   (let ((state (npv-cur-state vp)))
  70.     (if (eq state :stop)
  71.       (slot-value vp 'stop-frame)
  72.       (let ((addr (npv-cur-addr vp))
  73.             (fr (if (eq state :play-ps) (npv-cur-rel-frame vp) 0)))
  74.         (+ (* 30 addr) fr)))))
  75.  
  76. (defmethod vp-seek ((vp NEC-PC-VCR-vp) frame &key &allow-other-keys)
  77.   (npv-cmd vp "JF" :frame frame :format :frame)
  78.   t)
  79.  
  80. (defmethod vp-play ((vp NEC-PC-VCR-vp))
  81.   (if (frame-limit-p vp)
  82.     (npv-cmd vp "SP" :frame (max-frame-limit vp) :format :addr+fr))
  83.   (npv-cmd vp "PL")
  84.   t)
  85.  
  86. ;before we stop - we must record our frame number cause the PC-VCR
  87. ;won't give it to us once we're stopped.
  88. (defmethod vp-stop :before ((vp NEC-PC-VCR-vp))
  89.   (case (npv-cur-state vp)
  90.     (:stop )
  91.     (:play-ps  (setf (slot-value vp 'stop-frame) (npv-cur-frame vp)))
  92.     (otherwise (npv-cmd vp "PS")
  93.                (setf (slot-value vp 'stop-frame) (npv-cur-frame vp)))))
  94.  
  95. (defmethod vp-stop ((vp NEC-PC-VCR-vp))
  96.   (case (npv-cur-state vp)
  97.     (:stop )
  98.     (:play-ps  (npv-cmd vp "ST"))
  99.     (otherwise (npv-cmd vp "ST")))
  100. t)
  101.  
  102. (defmethod vp-freeze ((vp NEC-PC-VCR-vp))
  103.   (case (npv-cur-state vp)
  104.     (:play-ps )
  105.     (:stop    )
  106.     (otherwise (npv-cmd vp "PS")))
  107.   t)
  108.  
  109. (defmethod vp-step ((vp NEC-PC-VCR-vp) direction)
  110.   (ecase direction
  111.     (:forward
  112.      (npv-ensure-paused vp)
  113.      (npv-cmd vp "FS"))
  114.     (:reverse
  115.      (error "NEC-PC-VCR doesn't support reverse stepping.")))
  116.   t)
  117.  
  118.  
  119. ;;SL can be improved
  120. (defmethod vp-scan ((vp NEC-PC-VCR-vp) direction speed-x)
  121.   (flet ((pick-high-speed (req-speed tape-format)
  122.            (ecase tape-format
  123.              (:SP (if (< req-speed 8) 1 2))
  124.              (:EP (if (< req-speed 19) 1 2)))))
  125.     (ecase direction
  126.       (:forward
  127.        (cond
  128.         ((> speed-x 1)
  129.          (npv-cmd vp "FF" :arg (pick-high-speed speed-x (tape-format vp))))
  130.         ((< speed-x 1)
  131.          (vp-play vp)
  132.          (npv-cmd vp "SL"))
  133.         (t
  134.          (vp-play vp))))
  135.       (:reverse
  136.        (npv-cmd vp "RW" :arg (pick-high-speed speed-x (tape-format vp)))))
  137.     t))
  138.  
  139. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  140.  
  141. (defvar *npv-error-strings*
  142.   #("(0) PC-VCR not powered on"
  143.     "(1) tape address read incorrectly"
  144.     "(2) no tape in unit"
  145.     "(3) unused error code"
  146.     "(4) syntax error (unrecognized command)"
  147.     "(5) invalid, missing, or excess parameters"
  148.     "(6) command buffer overflow"
  149.     "(7) unused error code"
  150.     "(8) tape header read incorrectly"
  151.     "(9) command execution failed or current mode prevented execution"
  152.   ))
  153.  
  154.  
  155. (defun npv-echeck (result-string cmd-string verbose-p)
  156.   (when (char= #\E (char result-string 0))
  157.     (when verbose-p
  158.       (error "~s :~s ~%      >~s"
  159.              cmd-string
  160.              result-string
  161.              (svref *npv-error-strings* (parse-integer result-string :start 2)))))
  162.   t)
  163.  
  164. (defvar *npv-status-keys*
  165.   #(
  166.     :no-tape :stop      :rec       :rec-ps   :ff
  167.     :j-srch  :p-srch    :play      :unused   :play-ps
  168.     :rp-srch :rj-srch   :rew       :sc-ff    :sc-play
  169.     :sc-rew  :slow-1/30 :slow-1/10 :slow-1/5 :pi-ps
  170.     :pi-play :ad-ps     :ad-play   :ai-ps    :ai-play
  171.   ))
  172.  
  173. (defmethod npv-cur-state ((vp NEC-PC-VCR-vp))
  174.   (let ((state-code-str (npv-cmd vp "DS")))
  175.     (unless (and (char= #\S (char state-code-str 0)) (char= #\S (char state-code-str 1)))
  176.       (error "malformed state code ~s." state-code-str))
  177.     (svref  *npv-status-keys* (parse-integer state-code-str :start 2))))
  178.  
  179. ;can only be called from :play-ps or :play state
  180. (defmethod npv-cur-addr ((vp NEC-PC-VCR-vp))
  181.   (parse-integer (npv-cmd vp "RP" :arg 0) :start 2))
  182.  
  183. ;can only be called from :play-ps state
  184. (defmethod npv-cur-rel-frame ((vp NEC-PC-VCR-vp))
  185.   (parse-integer (npv-cmd vp "RF") :start 2) 0)
  186.  
  187. ;can only be called from :play-ps state
  188. (defmethod npv-cur-frame ((vp NEC-PC-VCR-vp))
  189.   (+ (* 30 (npv-cur-addr vp)) (npv-cur-rel-frame vp)))
  190.  
  191.  
  192. ;;this is useful because certain commands can only be issued from this state
  193. (defmethod npv-ensure-paused ((vp NEC-PC-VCR-vp))
  194.   (case (npv-cur-state vp)
  195.     (:play-ps)
  196.     (:play
  197.      (npv-cmd vp "PS"))
  198.     (:stop
  199.      (npv-cmd vp "PL")
  200.      (npv-cmd vp "PS"))
  201.     (otherwise
  202.      (npv-cmd vp "PS")))
  203.   t)
  204.  
  205.  
  206. (defmethod npv-addr-string ((vp NEC-PC-VCR-vp) frame format)
  207.   (setf frame (min (max frame 0) (vp-max-frame vp)))
  208.   (ecase format
  209.     (:frame   (princ-to-string frame))
  210.     (:addr    (princ-to-string (round frame 30)))
  211.     (:addr+fr (multiple-value-bind (addr fr) (floor frame 30)
  212.                 (format nil "~a:~a"  addr fr)))))
  213.  
  214. (defmethod npv-cmd ((vp NEC-PC-VCR-vp) code-string
  215.                     &key
  216.                     (arg "")
  217.                     (frame nil)
  218.                     (format nil)
  219.                     (response-p t)
  220.                     (error-p t)
  221.                     (flush-p t))
  222.   (let ((cmd-string (if frame
  223.                       (format nil "~a~a" code-string (npv-addr-string vp frame format))
  224.                       (format nil "~a~a" code-string arg))))
  225.     (when (or flush-p response-p) (npv-flush vp))
  226.     (sport-write-line vp cmd-string)
  227.     (let ((1st-response (npv-read vp :wait-p t)))
  228.       (unless (npv-echeck 1st-response cmd-string error-p)
  229.         (return-from npv-cmd 1st-response))
  230.       (when response-p
  231.         (let ((2nd-response (npv-read vp :wait-p t)))
  232.           (unless (npv-echeck 2nd-response cmd-string error-p)
  233.             (return-from npv-cmd 2nd-response))
  234.           (unless (string= 2nd-response "AO")
  235.             (let ((3rd-response (npv-read vp :wait-p t)))
  236.               (unless (npv-echeck 3rd-response cmd-string error-p)
  237.                 (return-from npv-cmd 3rd-response))))
  238.           2nd-response)))))
  239.  
  240. (defmethod npv-read ((vp NEC-PC-VCR-vp) &key (wait-p nil))
  241.   (multiple-value-bind (str eoln-p) (sport-read-line vp :wait-p wait-p)
  242.     (if eoln-p str (error "partial response (~s) read" str))))
  243.  
  244. (defmethod npv-flush ((vp NEC-PC-VCR-vp))
  245.   (sport-flush vp))
  246.  
  247. #|
  248.  
  249. (setf vp (make-instance 'NEC-PC-VCR-vp :port :printer))
  250. (vp-init vp)
  251. (vp-load vp)
  252. (vp-loaded-p vp)
  253.  
  254. (npv-cur-rel-frame vp)
  255. (npv-ensure-paused vp)
  256.  
  257. (npv-cur-state vp)
  258.  
  259. (vp-current-frame vp)
  260.  
  261. (vp-play vp)
  262. (vp-freeze vp)
  263. (vp-stop vp)
  264. (vp-scan vp :forward 2)
  265. (vp-scan vp :reverse 2)
  266.  
  267. (progn
  268. (vp-step vp :forward)
  269. (vp-current-frame vp))
  270.  
  271.  
  272.  
  273.  
  274. (npv-cmd p "ST")
  275.  
  276. |#