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 / Pioneer-u.lisp < prev    next >
Encoding:
Text File  |  1992-01-30  |  3.9 KB  |  104 lines
  1. (in-package :oou)
  2. (oou-provide :Pioneer-u)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; Pioneer-u.lisp
  5. ;;
  6. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; utilities for working with Pioneer laserdisc players
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies
  15.  :serial-port
  16.  )
  17.  
  18. (export '(frame-to-hmmss hmmss-to-frame frame-to-hmmssff hmmssff-to-frame
  19.           Pioneer-player-info))
  20.  
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22.  
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24. ;;functions for converting among 3 Pioneer time formats
  25. ;; frame number                [0-65535] frames are 1/30 of a second
  26. ;; hours-minutes-seconds       [hmmss]
  27. ;; hours-minutes-seconds-frame [hmmssff]
  28.  
  29. (defun frame-to-hmmss (frame)
  30.   (multiple-value-bind (min sec) (floor (floor frame 30) 60)
  31.     (multiple-value-bind (hr min) (floor min 60)
  32.       (+ (* hr 10000) (* min 100) sec))))
  33.  
  34. (defun hmmss-to-frame (time)
  35.   (* 30 (+ (mod time 100)
  36.            (* 60 (mod (floor time 100) 100))
  37.            (* 3600 (floor time 10000)))))
  38.  
  39. (defun frame-to-hmmssff (frame)
  40.   (+ (* 100 (frame-to-hmmss frame)) (mod frame 30)))
  41.  
  42. (defun hmmssff-to-frame (time)
  43.   (+ (mod time 100)
  44.      (* 30 (+ (mod (floor time 100) 100)
  45.               (* 60 (mod (floor time 10000) 100))
  46.               (* 3600 (floor time 1000000))))))
  47.  
  48.  
  49. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  50.  
  51. (defun Pioneer-player-info (port &key (timeout 2))
  52.   (let ((sp (make-instance 'serial-port :port port :config-on-init-p nil)))
  53.     (dolist (data-bits '(8 7))
  54.       (set-data-bits sp data-bits :config-p nil)
  55.       (dolist (stop-bits '(1.0 2.0))
  56.         (set-stop-bits sp stop-bits :config-p nil)
  57.         (dolist (parity '(:none :even :odd))
  58.           (set-parity sp parity :config-p nil)
  59.           (dolist (baud '(4800 9600 1200))
  60.             (set-baud sp baud)
  61.             (sport-flush sp)
  62.             (sport-write-line sp "?X")
  63.             (sleep timeout)
  64.             (let ((response (sport-read-line sp :wait-p nil :wait-eoln-p t)))
  65.               (when (plusp (length response))
  66.                 (when (char-equal #\E (char response 0))
  67.                   ;sometimes the failed signals cause the ld to return an error initially
  68.                   (sport-flush sp)
  69.                   (sport-write-line sp "?X")
  70.                   (setf response (sport-read-line sp :wait-p t)))
  71.                 (return-from Pioneer-player-info (list :port      port
  72.                                                        :baud      baud
  73.                                                        :stop-bits stop-bits
  74.                                                        :parity    parity
  75.                                                        :data-bits data-bits
  76.                                                        :model     (ecase (char response 4)
  77.                                                                     (#\2 'P4200-vp)
  78.                                                                     (#\5 'P330-vp)
  79.                                                                     (#\6 'P8000-vp))))))))))))
  80.  
  81. (defun Pioneer-disk-format (port)
  82.   (let ((sp (make-instance 'serial-port :port port :config-on-init-p nil)))
  83.     (sport-flush sp)
  84.     (sport-write-line sp "SA?D")
  85.     (let ((response (sport-read-line sp :wait-p t)))
  86.       (if (char-equal #\1 (char response 0))
  87.         (ecase (char response 1)
  88.           (#\0 :CAV)
  89.           (#\1
  90.            ;there is no support for distinguishing CLV & CLV-E disks
  91.            ;so we hack it by trying frame mode, which errors on plain CLV
  92.            (sport-write-line sp "FR")
  93.            (ecase (char (sport-read-line sp :wait-p t) 0) 
  94.              (#\R :CLV-E)
  95.              (#\E :CLV)))
  96.           (#\X :unknown))
  97.         :no-disk))))
  98.  
  99. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  100. #|
  101. (Pioneer-player-info :modem)
  102. (Pioneer-disk-format :modem)
  103. |#
  104.