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-digitizers / RO-vd.lisp < prev    next >
Encoding:
Text File  |  1992-02-05  |  24.4 KB  |  660 lines
  1. (in-package :oou)
  2. (oou-provide :RO-vd)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; RO-vd.Lisp
  5. ;;
  6. ;; Copyright ⌐ 1990 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; class on which RasterOps video digitizer objects are based
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies
  15.  :video-digitizer
  16.  :+Devices
  17.  :GDevice-u
  18.  )
  19.  
  20. (export '(
  21.            ))
  22.  
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24.  
  25. (eval-when (:compile-toplevel :load-toplevel :execute)
  26.   
  27.   (defrecord (ROCsParam :pointer)
  28.     ;;ROCsParam records are passed into Control calls to the RasterOps
  29.     ;;driver. This argument is a pointer to a 22 block of memory which
  30.     ;;corresponds to the csParam field of a ParamBlockRec which is
  31.     ;;defined as: array[0..10] of integer. The use of these 22 bytes
  32.     ;;varies, depending on the csCode.
  33.     (variant
  34.      ((csParam (array :integer 11)))
  35.      ((ptr pointer))))
  36.  
  37.   (defconstant CB364-board-id    #x028A)
  38.   (defconstant RO24STV-board-id  #x03A5)
  39.   (defconstant RO24XLTV-board-id #x03C9)
  40.   (defconstant ROMT-board-id     #x0406 "RasterOps MediaTime")
  41.   
  42.   (defconstant RO-error-code-alist
  43.     '((-9000 . "The requested RasterOps board is not present.")
  44.       (-8999 . "XCMD has wrong number of parameters.")
  45.       (-8998 . "Not a RasterOps real-time video board.")
  46.       (-8997 . "Board order parameter not in range (1-6).")
  47.       (-8996 . "No driver loaded.")
  48.       (-8995 . "Video board not in 8-bit mode.")
  49.       (-8994 . "Requested 'clut' resource not found.")
  50.       (-8993 . "Cancelled by user.")
  51.       (-8992 . "Failed recording PICT to Clipboard.")
  52.       (-8991 . "Rectangle not on RasterOps screen.")
  53.       (-8990 . "Recording pixel depth not 0,1,2,4,8,16, or 32.")
  54.       (-8989 . "32-Bit QuickDraw is not installed.")
  55.       (-8988 . "Out of memory.")
  56.       (-8987 . "No such video source.")
  57.       (-8986 . "Bad recording rectangle.")
  58.       (-8985 . "Not a RasterOps video function.")
  59.       (-8984 . "No HyperCard document window found.")
  60.       (-8043 . "Get digitize LUT pointer NIL.")
  61.       (-8042 . "DMSD register out of range.")
  62.       (-8041 . "Color value out of range.")
  63.       (-8040 . "Color key mask rectangle out of range.")
  64.       (-8039 . "Aperture out of range.")
  65.       (-8038 . "Coring out of range.")
  66.       (-8037 . "Bandpass type out of range.")
  67.       (-8036 . "Vertical noise reduction mode out of range.")
  68.       (-8035 . "LUMA delay compensation out of range.")
  69.       (-8034 . "AGC response out of range.")
  70.       (-8033 . "Load digitze LUT pointer NIL.")
  71.       (-8032 . "DMSD register or data out of range.")
  72.       (-8031 . "Board not available.")
  73.       (-8030 . "Input type not valid.")
  74.       (-8022 . "Color table handle too small or NIL.")
  75.       (-8021 . "Board already reserved.")
  76.       (-8020 . "Byte offset not in range.")
  77.       (-8019 . "Board bit depth is less than 8 bits per pixel.")
  78.       (-8018 . "Timed out with WaitTillDone.")
  79.       (-8017 . "NuBus delay not in range.")
  80.       (-8016 . "Top position must be even.")
  81.       (-8015 . "Screen position not in frame buffer.")
  82.       (-8014 . "Control flag not in range.")
  83.       (-8013 . "Source video top and bottom positions must be even.")
  84.       (-8012 . "Vertical size must be even.")
  85.       (-8011 . "Vertical size not in range.")
  86.       (-8010 . "Horizontal size not in range.")
  87.       (-8009 . "Source video rectangle out of range.")
  88.       (-8008 . "Black level not in range.")
  89.       (-8007 . "White level not in range.")
  90.       (-8006 . "Contrast not in range.")
  91.       (-8005 . "Brightness not in range.")
  92.       (-8004 . "Saturation not in range.")
  93.       (-8003 . "Hue not in range.")
  94.       (-8002 . "Pan position out of range.")
  95.       (-8001 . "Zoom factor not 1,2,4, or 8.")
  96.       (-18   . "Driver status error.")
  97.       (-17   . "Driver control error."))
  98.     )
  99.  
  100.   )
  101.  
  102.  
  103. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  104.  
  105. (defclass RO-vd (video-digitizer)
  106.   ((board-id         :initarg  :board-id
  107.                      :reader   board-id)
  108.    (drvr-refnum      :reader   drvr-refnum)
  109.    (frame-topLeft    :reader   frame-topLeft)
  110.    (alternate-PLL    :initarg :alternate-PLL
  111.                      :accessor alternate-PLL)
  112.    (h-flip           :initarg :h-flip
  113.                      :accessor h-flip)
  114.    (v-flip           :initarg :v-flip
  115.                      :accessor v-flip)
  116.    (reverse-fields   :initarg :reverse-fields
  117.                      :accessor reverse-fields)
  118.    (digitizing-speed :initarg :digitizing-speed
  119.                      :accessor digitizing-speed)
  120.    (control-flag     :initarg :control-flag
  121.                      :accessor control-flag))
  122.   (:default-initargs
  123.     :alternate-PLL t
  124.     :h-flip nil
  125.     :v-flip nil
  126.     :reverse-fields nil
  127.     :digitizing-speed :full
  128.     :control-flag :both
  129.     ))
  130.  
  131. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  132. ;; RasterOps coordinate conversion functions
  133. ;;  RasterOps boards use frame coordinates where #@(0 0) is the topLeft
  134. ;;  of the RasterOps driven screen.
  135.  
  136.  
  137. (defmethod ROvd-global-frame-corners ((vd RO-vd))
  138. ;returns the topLeft and botRight of the RasterOps driven screen
  139.   (with-macptrs ((gd (ROvd-get-GDevice vd)))
  140.     (values (href gd :GDevice.gdRect.topLeft)
  141.             (href gd :GDevice.gdRect.botRight))))
  142.  
  143. (defmethod ROvd-local-to-frame ((vd RO-vd) h &optional v)
  144.   (rlet ((pt :point))
  145.     (%put-point pt (make-point h v))
  146.     (#_LocalToGlobal pt)
  147.     (subtract-points (%get-point pt) (frame-topLeft vd))))
  148.  
  149. (defmethod ROvd-frame-to-local ((vd RO-vd) h &optional v)
  150.   (add-points (make-point h v) (frame-topLeft vd))
  151.   (rlet ((pt :point ))
  152.     (#_GlobalToLocal pt)
  153.     (%get-point pt)))
  154.  
  155. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  156.  
  157. (defmethod vd-error-code-alist ((vd RO-vd))
  158.   (declare (ignore vd))
  159.   RO-error-code-alist)
  160.  
  161. (defmethod vd-init :after ((vd RO-vd))
  162.   (setf (slot-value vd 'frame-topLeft) (ROvd-global-frame-corners vd)))
  163.  
  164. ;;vd-dispose
  165.  
  166. (defmethod vd-GDevice ((vd RO-vd))
  167.   (ROvd-get-GDevice vd))
  168.  
  169. (defmethod vd-max-src-rect-corners ((vd RO-vd))
  170.   (ROvd-get-max-source-rect vd))
  171.  
  172. (defmethod vd-digitizing-p ((vd RO-vd))
  173.   (and (call-next-method) (ROvd-continuous-p vd)))
  174.  
  175. (defmethod vd-start-digitizing :after ((vd RO-vd))
  176.   (ROvd-set-continuous vd t))
  177.  
  178. (defmethod vd-stop-digitizing :after ((vd RO-vd))
  179.   (ROvd-set-continuous vd nil))
  180.  
  181. (defmethod vd-grab-one-frame :after ((vd RO-vd))
  182.   (ROvd-one-shot vd))
  183.  
  184. (defmethod vd-install-settings :after ((vd RO-vd))
  185.   (ROvd-set-alternate-PLL   vd (alternate-PLL vd))
  186.   (ROvd-set-horizontal-flip vd (h-flip vd))
  187.   (ROvd-set-vertical-flip   vd (v-flip vd))
  188.   (ROvd-set-reverse-fields  vd (reverse-fields vd))
  189.   (ROvd-set-speed           vd (digitizing-speed vd))
  190.   (ROvd-set-control-flag    vd (control-flag vd)))
  191.  
  192. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  193. ;;; set functions for video control values
  194.  
  195. ;;vd-set-src-rect
  196. ;;RasterOps boards don't support a distinct a source & digitizer rect
  197.  
  198. (defmethod vd-set-dig-rect ((vd RO-vd) topLeft botRight)
  199.  (ROvd-set-video-source-rect vd topLeft botRight))
  200.  
  201. (defmethod vd-set-dest-rect ((vd RO-vd) topLeft botRight)
  202.   (ROvd-set-video-destination-rect vd topLeft botRight))
  203.  
  204. (defmethod vd-set-input-format ((vd RO-vd) format)
  205.   (ROvd-set-video-source vd format)
  206.   format)
  207.  
  208. (defmethod vd-get-input-format ((vd RO-vd))
  209.   (ROvd-get-current-video-source vd))
  210.  
  211.  
  212. ;;vd-set-input-standard - 24STV only
  213. ;;vd-get-input-standard - 24STV only
  214.  
  215. ;;vd-set-contrast   - 364 only
  216. ;;vd-get-contrast   - 364 only
  217. ;;vd-set-hue        - model specific value range
  218. ;;vd-get-hue        - model specific value range
  219. ;;vd-set-saturation - model specific value range
  220. ;;vd-get-saturation - model specific value range
  221.  
  222. (defmethod vd-install-settings :before ((vd RO-vd))
  223.   (ROvd-reset vd))
  224.  
  225. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  226. ;;RO specific settings
  227.  
  228. (defmethod (setf alternate-PLL) :after (on-p (vd RO-vd))
  229.   (when (vd-digitizing-p vd)
  230.     (ROvd-set-alternate-PLL vd on-p)))
  231.  
  232. (defmethod (setf vertical-flip) :after (flip-p (vd RO-vd))
  233.   (when (vd-digitizing-p vd)
  234.     (ROvd-set-vertical-flip vd flip-p)))
  235.  
  236. (defmethod (setf horizontal-flip) :after (flip-p (vd RO-vd))
  237.   (when (vd-digitizing-p vd)
  238.     (ROvd-set-horizontal-flip vd flip-p)))
  239.  
  240. (defmethod (setf reverse-fields) :after (on-p (vd RO-vd))
  241.   (when (vd-digitizing-p vd)
  242.     (ROvd-set-reverse-fields vd on-p)))
  243.  
  244. (defmethod (setf digitizing-speed) :after (speed (vd RO-vd))
  245.   (when (vd-digitizing-p vd)
  246.     (ROvd-set-speed vd speed)))
  247.  
  248. (defmethod (setf control-flag) :after (flag (vd RO-vd))
  249.   (when (vd-digitizing-p vd)
  250.     (ROvd-set-control-flag vd flag)))
  251.  
  252.  
  253. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  254. ;; RasterOps functions
  255.  
  256. (defun ROvd-get-GDevice-list (board-id)
  257.   (flet ((find-gd (slot)
  258.            (flet ((find-it (gd)
  259.                     (with-macptrs ((aDCE (#~GetDCtlEntry (href gd :GDevice.gdRefNum))))
  260.                       (when (= slot (href aDCE :AuxDCE.dCtlSlot))
  261.                         (return-from find-gd gd)))))
  262.              (declare (dynamic-extent #'find-it))
  263.              (mapc-GDevices #'find-it))))
  264.     (declare (dynamic-extent #'find-gd))
  265.     (rlet ((spb :SpBlock))
  266.       (let (gd-list)
  267.         (dotimes (slot 16 (nreverse gd-list))
  268.           (pset spb :SpBlock.spSlot   slot)
  269.           (pset spb :SpBlock.spId     0)
  270.           (pset spb :SpBlock.spExtDev 0)
  271.           (unless (zerop (#_SNextSRsrc spb)) (return gd-list))
  272.           (let ((gd (find-gd slot)))
  273.             (when gd
  274.               (pset spb :SpBlock.spID #$BoardId)
  275.               (when (and (zerop (#_SReadWord spb))
  276.                          (= board-id (#_LoWord (pref spb :SpBlock.spResult))))
  277.                 (setf gd-list (cons gd gd-list))))))))))
  278.  
  279. (defmethod ROvd-get-GDevice ((vd RO-vd))
  280.   (elt (ROvd-get-GDevice-list (board-id vd)) (1- (card-num vd))))
  281.  
  282.  
  283. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  284. ;;Control calls
  285.  
  286.  
  287. (defmethod ROvd-set-alternate-PLL ((vd RO-vd) on-p)
  288. ;enable/disable the use of an alternate Phase Lock Loop component
  289.   (rlet ((csParamPtr :ROCsParam
  290.                      (:csParam 0) (if on-p 1 0)))
  291.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9034 csParamPtr))))
  292.  
  293.  
  294.  
  295. (defmethod ROvd-set-continuous ((vd RO-vd) on-p &optional (wait-p nil))
  296. ;starts continuous digitizing & display
  297.   (rlet ((csParamPtr :ROCsParam
  298.                      (:csParam 0) (if on-p 1 0)
  299.                      (:csParam 1) (if (and (not on-p) wait-p) 1 0)))
  300.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9025 csParamPtr))))
  301.  
  302.  
  303. (defmethod ROvd-erase-frame-buffer ((vd RO-vd) red-byte blue-byte green-byte)
  304. ;erase the entire frame buffer to the specified color value
  305.   (rlet ((csParamPtr :ROCsParam
  306.                      (:csParam 0) (logior (ash (logand #xFF red-byte) 16)
  307.                                           (ash (logand #xFF green-byte) 8)
  308.                                           (logand #xFF blue-byte))))
  309.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9000 csParamPtr))))
  310.  
  311.  
  312. (defmethod ROvd-set-horizontal-flip ((vd RO-vd) flipped-p)
  313. ;sets the horizontal orientation of the next digitized image
  314.   (unless (eq (ROvd-flipped-horizontally-p vd) flipped-p)
  315.     (rlet ((csParamPtr :ROCsParam))
  316.         (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9028 csParamPtr)))))
  317.  
  318.  
  319. (defmethod ROvd-set-vertical-flip ((vd RO-vd) flipped-p)
  320. ;sets the vertical orientation of the next digitized image
  321.   (unless (eq (ROvd-flipped-vertically-p vd) flipped-p)
  322.     (rlet ((csParamPtr :ROCsParam))
  323.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9029 csParamPtr)))))
  324.  
  325.  
  326. (defmethod ROvd-set-hue ((vd RO-vd) value)
  327. ;value in [0-63 for 364] or [0-255 for 24STV]
  328. ;controls the hue of the digitized video image
  329.   (rlet ((csParamPtr :ROCsParam
  330.                      (:csParam 0) value))
  331.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9006 csParamPtr))))
  332.  
  333.  
  334. (defmethod ROvd-set-NuBus-delay ((vd RO-vd) delay)
  335. ;delay = [0-255]
  336. ;controls how long the NuBus is held off before QuickDraw can write to the
  337. ;frame buffer while live video is being digitized
  338.   (rlet ((csParamPtr :ROCsParam
  339.                      (:csParam 0) delay))
  340.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9016 csParamPtr))))
  341.  
  342.  
  343. (defmethod ROvd-one-shot ((vd RO-vd) &optional (wait-p t))
  344. ;causes the hardware to digitize & display a single frame or field
  345.   (rlet ((csParamPtr :ROCsParam
  346.                      (:csParam 0) (if wait-p 1 0)))
  347.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9026 csParamPtr))))
  348.  
  349.  
  350. (defmethod ROvd-set-pan-position ((vd RO-vd) point &optional (sync-p t))
  351. ;sets the pan position of the screen display
  352.   (rlet ((csParamPtr :ROCsParam
  353.                      (:csParam 0) (point-h point)
  354.                      (:csParam 1) (point-v point)
  355.                      (:csParam 2) (if sync-p 1 0)))
  356.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9002 csParamPtr))))
  357.  
  358.  
  359. (defmethod ROvd-set-reserve ((vd RO-vd) on-p)
  360. ;reserve/un-reserve the digitizing board (to lock out other applications)
  361.   (rlet ((csParamPtr :ROCsParam
  362.                      (:csParam 0) (if on-p 1 0)))
  363.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9033 csParamPtr))))
  364.  
  365.  
  366. (defmethod ROvd-reset ((vd RO-vd))
  367. ;resets the digitizing board to its power-up settings
  368.   (rlet ((csParamPtr :ROCsParam))
  369.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9027 csParamPtr))))
  370.  
  371.  
  372. (defmethod ROvd-set-reverse-fields ((vd RO-vd) on-p)
  373. ;enabling reverse-field may remove scanline incoherence errors on video images
  374.   (rlet ((csParamPtr :ROCsParam
  375.                      (:csParam 0) (if on-p 1 0)))
  376.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9035 csParamPtr))))
  377.  
  378.  
  379. (defmethod ROvd-set-saturation ((vd RO-vd) value)
  380. ; value = [0-63/364] or [0-255/24STV]
  381. ;controls the saturation of the digitized video image
  382.   (rlet ((csParamPtr :ROCsParam
  383.                      (:csParam 0) value))
  384.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9007 csParamPtr))))
  385.  
  386.  
  387. (defmethod ROvd-set-speed ((vd RO-vd) new-speed)
  388. ; new-speed = :full or :half
  389. ;controls  digitizing speed (30 fps)/half(15 fps)
  390.   (rlet ((csParamPtr :ROCsParam
  391.                      (:csParam 0) (ecase new-speed
  392.                                     (:full 1)
  393.                                     (:half 0))))
  394.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9024 csParamPtr))))
  395.  
  396. (defmethod ROvd-set-video-destination-position ((vd RO-vd) h &optional v)
  397. ;sets the top-left position for the live video image
  398.   (let ((point (ROvd-local-to-frame vd h v)))
  399.     (unless (evenp (point-v point))
  400.       (setf point (add-points point #@(0 1))))
  401.     (rlet ((csParamPtr :ROCsParam
  402.                        (:csParam 0) (point-v point)
  403.                        (:csParam 1) (point-h point)))
  404.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9015 csParamPtr)))))
  405.  
  406.  
  407. (defmethod ROvd-set-video-source-rect ((vd RO-vd) topLeft botRight)
  408. ;sets the source rectangle to digitize
  409.   (rlet ((csParamPtr :ROCsParam))
  410.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9012 csParamPtr))
  411.     (pset csParamPtr (:ROCsParam.csParam 0) (point-v topLeft))
  412.     (pset csParamPtr (:ROCsParam.csParam 1) (point-h topLeft))
  413.     (pset csParamPtr (:ROCsParam.csParam 2) (point-v botRight))
  414.     (pset csParamPtr (:ROCsParam.csParam 3) (point-h botRight))
  415.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9012 csParamPtr))))
  416.  
  417.  
  418. (defmethod ROvd-set-control-flag ((vd RO-vd) new-control-flag)
  419. ; new-control-flag = :both, :odd, or :even
  420. ;sets the control flag. Allowed flag values:
  421. ;  :both     - use both fields starting with even
  422. ;  :odd      - use odd field for half-size or less
  423. ;  :even     - use even field for half-size or less
  424. ;  :both-dls - both fields & double line skipping for half-size or less
  425. ;  :odd-sls  - use both fields and single line skipping
  426. ;  :even-sls - use both fields and single line skipping
  427.   (rlet ((csParamPtr :ROCsParam))
  428.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9012 csParamPtr))
  429.     (pset csParamPtr (:ROCsParam.csParam 6) (ecase new-control-flag
  430.                                               (:both     0)
  431.                                               (:odd      1)
  432.                                               (:even     2)
  433.                                               (:both-dls 4)
  434.                                               (:odd-sls  5)
  435.                                               (:even-sls 6)))
  436.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9012 csParamPtr))))
  437.  
  438.  
  439. (defmethod ROvd-set-video-destination-size ((vd RO-vd) h &optional v)
  440. ; destSize: h = [0-652], v = [0-510]
  441. ;sets the display image size
  442.   (let ((destSize (make-point h v)))
  443.     (rlet ((csParamPtr :ROCsParam))
  444.       (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9012 csParamPtr))
  445.       (pset csParamPtr (:ROCsParam.csParam 4) (point-h destSize))
  446.       (pset csParamPtr (:ROCsParam.csParam 5) (point-v destSize))
  447.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9012 csParamPtr)))))
  448.  
  449.  
  450. (defmethod ROvd-set-video-destination-rect ((vd RO-vd) topLeft botRight)
  451. ;sets the destination rectangle of the digitized image
  452.   (ROvd-set-video-destination-position vd topLeft)
  453.   (ROvd-set-video-destination-size vd (subtract-points botRight topLeft)))
  454.  
  455.  
  456. (defmethod ROvd-set-video-source ((vd RO-vd) source)
  457. ; source = :composite or :s-video
  458. ;sets the ColorBoard 364 hardware to use the composite/s-video connector for input
  459.   (rlet ((csParamPtr :ROCsParam
  460.                      (:csParam 0) (ecase source
  461.                                     (:composite 0)
  462.                                     (:s-video 1))))
  463.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9005 csParamPtr))))
  464.  
  465.  
  466. (defmethod ROvd-set-zoom ((vd RO-vd) zoom-factor)
  467. ; zoom-factor = 1, 2, 4, or 8
  468. ;set the hardware zoom factor to 1x, 2x, 4x, or 8x
  469.   (rlet ((csParamPtr :ROCsParam
  470.                      (:csParam 0) zoom-factor))
  471.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9001 csParamPtr))))
  472.  
  473.  
  474. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  475. ;;Status calls
  476.  
  477.  
  478. (defmethod ROvd-active-p ((vd RO-vd) &optional (wait-p t))
  479. ;returns in whether the ColorBoard 364 is currently digitizing a frame or field.
  480. ;   nil        - not active
  481. ;  :one-shot   - active doing OneShot
  482. ;  :continuous - active doing continuous digitizing
  483.   (rlet ((csParamPtr :ROCsParam
  484.                      (:csParam 0) (if wait-p 1 0)))
  485.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9026 csParamPtr))
  486.     (ecase (pref csParamPtr (:ROCsParam.csParam 0))
  487.            (0  nil)
  488.            (1 :one-shot)
  489.            (2 :continuous))))
  490.  
  491.  
  492. (defmethod ROvd-alternate-pll-p ((vd RO-vd))
  493. ;returns t if alternate Phase Lock Loop components are in use
  494.   (rlet ((csParamPtr :ROCsParam))
  495.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9034 csParamPtr))
  496.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  497.  
  498.  
  499. (defmethod ROvd-get-current-video-source ((vd RO-vd))
  500. ;returns which connector is the current video source (:composite / :s-video)
  501.   (rlet ((csParamPtr :ROCsParam))
  502.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9005 csParamPtr))
  503.     (ecase (pref csParamPtr (:ROCsParam.csParam 1))
  504.            (0 :composite)
  505.            (1 :s-video))))
  506.  
  507.  
  508. (defmethod ROvd-get-available-video-sources ((vd RO-vd))
  509. ;returns a list of which connectors have active video source
  510.   (rlet ((csParamPtr :ROCsParam))
  511.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9005 csParamPtr))
  512.     (ecase (pref csParamPtr (:ROCsParam.csParam 0))
  513.            (0 nil)
  514.            (1 '(:composite))
  515.            (2 '(:s-video))
  516.            (3 '(:composite :s-video)))))
  517.  
  518.  
  519. (defmethod ROvd-continuous-p ((vd RO-vd))
  520. ;returns t if continuous digitizing is on
  521.   (rlet ((csParamPtr :ROCsParam))
  522.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9025 csParamPtr))
  523.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  524.  
  525.  
  526. (defmethod ROvd-get-video-destination-rect ((vd RO-vd))
  527. ;returns two values, the topLeft and botRight, of the digitized image Rect (view window coords)
  528.   (rlet ((csParamPtr :ROCsParam))
  529.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9029 csParamPtr))
  530.     (values
  531.      (ROvd-frame-to-local vd
  532.                           (pref csParamPtr (:ROCsParam.csParam 1))
  533.                           (pref csParamPtr (:ROCsParam.csParam 0)))
  534.      (ROvd-frame-to-local vd
  535.                           (pref csParamPtr (:ROCsParam.csParam 3))
  536.                           (pref csParamPtr (:ROCsParam.csParam 2))))))
  537.  
  538.  
  539. (defmethod ROvd-flipped-horizontally-p ((vd RO-vd))
  540. ;returns t if pixels are being written in right-to-left order
  541.   (rlet ((csParamPtr :ROCsParam))
  542.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9017 csParamPtr))
  543.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  544.  
  545.  
  546. (defmethod ROvd-flipped-vertically-p ((vd RO-vd))
  547. ;returns t if scan lines are being written in bottom-to-top order
  548.   (rlet ((csParamPtr :ROCsParam))
  549.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9018 csParamPtr))
  550.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  551.  
  552.  
  553. (defmethod ROvd-genlocked-p ((vd RO-vd))
  554. ;returns t if an external source is being used to sync
  555.   (rlet ((csParamPtr :ROCsParam))
  556.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9004 csParamPtr))
  557.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  558.  
  559.  
  560. (defmethod ROvd-get-hue ((vd RO-vd))
  561. ;returns the hue[0-63 for 364] or [0-255 for 24STV]
  562.   (rlet ((csParamPtr :ROCsParam))
  563.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9006 csParamPtr))
  564.     (pref csParamPtr (:ROCsParam.csParam 0))))
  565.  
  566.  
  567. (defmethod ROvd-interlaced-p ((vd RO-vd))
  568. ;returns t if an interlaced video signal is being generated
  569.   (rlet ((csParamPtr :ROCsParam))
  570.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9003 csParamPtr))
  571.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  572.  
  573.  
  574. (defmethod ROvd-get-max-source-rect ((vd RO-vd))
  575. ;returns two values, the topLeft and botRight, of the limit rectangle of source that can be digitized
  576.   (rlet ((csParamPtr :ROCsParam))
  577.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9028 csParamPtr))
  578.     (values
  579.      (make-point (pref csParamPtr (:ROCsParam.csParam 1))
  580.                  (pref csParamPtr (:ROCsParam.csParam 0)))
  581.      (make-point (pref csParamPtr (:ROCsParam.csParam 3))
  582.                  (pref csParamPtr (:ROCsParam.csParam 2))))))
  583.  
  584.  
  585. (defmethod ROvd-get-NuBus-delay ((vd RO-vd))
  586. ;returns the current NuBus delay value
  587.   (rlet ((csParamPtr :ROCsParam))
  588.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9016 csParamPtr))
  589.     (pref csParamPtr (:ROCsParam.csParam 0))))
  590.  
  591.  
  592. (defmethod ROvd-get-pan-position ((vd RO-vd))
  593. ;returns the pan position (a point) of the screen display
  594.   (rlet ((csParamPtr :ROCsParam))
  595.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9002 csParamPtr))
  596.     (make-point (pref csParamPtr (:ROCsParam.csParam 0))
  597.                 (pref csParamPtr (:ROCsParam.csParam 1)))))
  598.  
  599.  
  600. (defmethod ROvd-reverse-fields-p ((vd RO-vd))
  601. ;returns t if the board is in reverse-field mode
  602.   (rlet ((csParamPtr :ROCsParam))
  603.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9035 csParamPtr))
  604.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  605.  
  606.  
  607. (defmethod ROvd-get-saturation ((vd RO-vd))
  608. ;returns the saturation [0-63 for 364] or [0-255 for 24STV]
  609.   (rlet ((csParamPtr :ROCsParam))
  610.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9007 csParamPtr))
  611.     (pref csParamPtr (:ROCsParam.csParam 0))))
  612.  
  613.  
  614. (defmethod ROvd-get-speed ((vd RO-vd))
  615. ;returns digitizing speed[:full(30 fps),:half(15 fps)]
  616.   (rlet ((csParamPtr :ROCsParam))
  617.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9024 csParamPtr))
  618.     (ecase (pref csParamPtr (:ROCsParam.csParam 0))
  619.            (0 :half)
  620.            (1 :full))))
  621.  
  622.  
  623. (defmethod ROvd-get-video-source-rect ((vd RO-vd))
  624. ;returns two values, the topLeft and botRight, of the digitized image source rectangle
  625.   (rlet ((csParamPtr :ROCsParam))
  626.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9012 csParamPtr))
  627.     (values
  628.      (make-point (pref csParamPtr (:ROCsParam.csParam 1))
  629.                  (pref csParamPtr (:ROCsParam.csParam 0)))
  630.      (make-point (pref csParamPtr (:ROCsParam.csParam 3))
  631.                  (pref csParamPtr (:ROCsParam.csParam 2))))))
  632.  
  633.  
  634. (defmethod ROvd-get-destination-size ((vd RO-vd))
  635. ;returns size of the digitized image as a point
  636.   (rlet ((csParamPtr :ROCsParam))
  637.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9012 csParamPtr))
  638.     (make-point (pref csParamPtr (:ROCsParam.csParam 4))
  639.                 (pref csParamPtr (:ROCsParam.csParam 5)))))
  640.  
  641.  
  642. (defmethod ROvd-get-control-flag ((vd RO-vd))
  643. ;returns the control flag value
  644.   (rlet ((csParamPtr :ROCsParam))
  645.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9012 csParamPtr))
  646.     (ecase (pref csParamPtr (:ROCsParam.csParam 6))
  647.       (0 :both)
  648.       (1 :odd)
  649.       (2 :even)
  650.       (4 :both-dls)
  651.       (5 :odd-sls)
  652.       (6 :even-sls))))
  653.  
  654.  
  655. (defmethod ROvd-get-zoom ((vd RO-vd))
  656. ;returns the zoom factor[1x,2x,4x,8x]
  657.   (rlet ((csParamPtr :ROCsParam))
  658.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9001 csParamPtr))
  659.     (pref csParamPtr (:ROCsParam.csParam 0))))
  660.