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 / RO364-vd.lisp < prev    next >
Encoding:
Text File  |  1992-02-05  |  10.2 KB  |  302 lines
  1. (in-package :oou)
  2. (oou-provide :RO364-vd)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; RO364-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. ;; video digitizer object for controling RasterOps 364 video digitizer boards
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies
  15.  :+Devices
  16.  :RO-vd
  17.  :Records-u
  18.  )
  19.  
  20. (export '(RO364-vd RO364vd-install-332-table
  21.            ))
  22.  
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24.  
  25.  
  26. (defclass RO364-vd (RO-vd)
  27.   ((brightness    :initarg :brightness
  28.                   :accessor brightness)
  29.    (red-inhibit   :initarg :red-inhibit
  30.                   :accessor red-inhibit)
  31.    (green-inhibit :initarg :green-inhibit
  32.                   :accessor green-inhibit)
  33.    (blue-inhibit  :initarg :blue-inhibit
  34.                   :accessor blue-inhibit))
  35.   (:default-initargs
  36.     :board-id CB364-board-id
  37.     ;default values determined empically
  38.     :black-level   #.(ash 29 10)
  39.     :white-level   #.(ash 56 10)
  40.     :contrast      #.(ash 32 10)
  41.     :hue           #.(ash 32 10)
  42.     :saturation    #.(ash 32 10)
  43.     :brightness    32
  44.     :red-inhibit   nil
  45.     :green-inhibit nil
  46.     :blue-inhibit  nil
  47.     ))
  48.  
  49.  
  50. (defmethod vd-init :before ((vd RO364-vd))
  51.   (setf (slot-value vd 'drvr-refnum) (RO364-get-drvr-refnum (card-num vd))))
  52.  
  53. ;;;;;;;;;;
  54. ;;RO364 uses a 0-63 range for black-level,white-level,contrast,hue,saturation
  55. ;; ash +/- 10 converts to/from the QuickTime range (0-65535)
  56.  
  57. (defmethod vd-set-black-level ((vd RO364-vd) level)
  58.   (RO364vd-set-black-level vd (ash level -10))
  59.   level)
  60.  
  61. (defmethod vd-get-black-level ((vd RO364-vd))
  62.   (ash (RO364vd-get-black-level vd) 10))
  63.  
  64. (defmethod vd-set-white-level ((vd RO364-vd) level)
  65.   (RO364vd-set-white-level vd (ash level -10))
  66.   level)
  67.  
  68. (defmethod vd-get-white-level ((vd RO364-vd))
  69.   (ash (RO364vd-get-white-level vd) 10))
  70.  
  71. (defmethod vd-set-contrast ((vd RO364-vd) contrast)
  72.   (RO364vd-set-contrast vd (ash contrast -10))
  73.   contrast)
  74.  
  75. (defmethod vd-get-contrast ((vd RO364-vd))
  76.   (ash (RO364vd-get-contrast vd) 10))
  77.  
  78. (defmethod vd-set-hue ((vd RO364-vd) hue)
  79.   (ROvd-set-hue vd (ash hue -10))
  80.   hue)
  81.  
  82. (defmethod vd-get-hue ((vd RO364-vd))
  83.   (ash (ROvd-get-hue vd) 10))
  84.  
  85. (defmethod vd-set-saturation ((vd RO364-vd) saturation)
  86.   (ROvd-set-saturation vd (ash saturation -10))
  87.   saturation)
  88.  
  89. (defmethod vd-get-saturation ((vd RO364-vd))
  90.   (ash (ROvd-get-saturation vd) 10))
  91.  
  92. (defmethod vd-install-settings :after ((vd RO364-vd))
  93.   (RO364vd-set-brightness vd (brightness vd))
  94.   (RO364vd-set-red-inhibit   vd (red-inhibit vd))
  95.   (RO364vd-set-green-inhibit vd (green-inhibit vd))
  96.   (RO364vd-set-blue-inhibit  vd (blue-inhibit vd)))
  97.  
  98. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  99. ;;RO364 specific settings
  100.  
  101. (defmethod (setf brightness) :after (brightness (vd RO364-vd))
  102.   (when (vd-digitizing-p vd)
  103.     (RO364vd-set-brightness vd brightness)))
  104.  
  105. (defmethod (setf red-inhibit) :after (inhibit-p (vd RO364-vd))
  106.   (when (vd-digitizing-p vd)
  107.     (RO364vd-set-red-inhibit vd inhibit-p)))
  108.  
  109. (defmethod (setf green-inhibit) :after (inhibit-p (vd RO364-vd))
  110.   (when (vd-digitizing-p vd)
  111.     (RO364vd-set-green-inhibit vd inhibit-p)))
  112.  
  113. (defmethod (setf blue-inhibit) :after (inhibit-p (vd RO364-vd))
  114.   (when (vd-digitizing-p vd)
  115.     (RO364vd-set-blue-inhibit vd inhibit-p)))
  116.  
  117. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  118. ;; RO364 functions
  119.  
  120.  
  121. (defun RO364-get-drvr-refnum (card-num)
  122. ;returns the driver reference number of the specified RO364 card
  123.   (rlet ((spb :SpBlock
  124.               :spSlot   0
  125.               :spID     0
  126.               :spExtDev 0
  127.               :spHwDev  0
  128.               :spTBMask #x000E
  129.               :spDrvrHW #x026F))
  130.     (dotimes (i card-num (pref spb :SpBlock.spRefNum))
  131.       (unless (zerop (#_SNextTypeSRsrc spb)) (return nil)))))
  132.  
  133. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  134. ;;Control calls
  135.  
  136. (defmethod RO364vd-set-contrast ((vd RO364-vd) value)
  137. ; value = [0-63]
  138. ;controls the contrast of the digitized video image
  139.   (rlet ((csParamPtr :ROCsParam
  140.                      (:csParam 0) value))
  141.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9009 csParamPtr))))
  142.  
  143.  
  144. (defmethod RO364vd-set-black-level ((vd RO364-vd) value)
  145. ; value = [0-63]
  146. ;controls the black level of the digitized video image
  147.   (rlet ((csParamPtr :ROCsParam
  148.                      (:csParam 0) value))
  149.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9011 csParamPtr))))
  150.  
  151.  
  152. (defmethod RO364vd-set-brightness ((vd RO364-vd) value)
  153. ; value = [0-63]
  154. ;controls the brightness of the digitized video image
  155.   (rlet ((csParamPtr :ROCsParam
  156.                      (:csParam 0) value))
  157.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9008 csParamPtr))))
  158.  
  159.  
  160. (defmethod RO364vd-set-red-inhibit ((vd RO364-vd) inhibit-p)
  161. ;controls writing of the red video component
  162.   (rlet ((csParamPtr :ROCsParam
  163.                      (:csParam 0) (if inhibit-p 1 0)))
  164.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9019 csParamPtr))))
  165.  
  166.  
  167. (defmethod RO364vd-set-green-inhibit ((vd RO364-vd) inhibit-p)
  168. ;controls writing the green video component
  169.   (rlet ((csParamPtr :ROCsParam
  170.                      (:csParam 0) (if inhibit-p 1 0)))
  171.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9020 csParamPtr))))
  172.  
  173.  
  174. (defmethod RO364vd-set-blue-inhibit ((vd RO364-vd) inhibit-p)
  175. ;conrols writing the blue video component
  176.   (rlet ((csParamPtr :ROCsParam
  177.                      (:csParam 0) (if inhibit-p 1 0)))
  178.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9021 csParamPtr))))
  179.  
  180.  
  181. (defmethod RO364vd-set-white-level ((vd RO364-vd) value)
  182. ; value = [0-63]
  183. ;controls the white-level of the digitized video image
  184.   (rlet ((csParamPtr :ROCsParam
  185.                      (:csParam 0) value))
  186.       (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9010 csParamPtr))))
  187.  
  188. (defmethod RO364vd-write-nvram ((vd RO364-vd) byte-offset byte-value)
  189. ; offset = [0-63], value = [0-255]
  190. ;write the low-order byte of byte-value into nonvolatile RAM at byte-offset
  191.   (rlet ((csParamPtr :ROCsParam
  192.                      (:csParam 0) byte-offset
  193.                      (:csParam 1) byte-value))
  194.     (vd-nz-error-check vd (#~Control (drvr-refnum vd) 9032 csParamPtr))))
  195.  
  196.  
  197. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  198. ;;Status calls
  199.  
  200. (defmethod RO364vd-get-black-level ((vd RO364-vd))
  201. ;returns the black level [0-63]
  202.   (rlet ((csParamPtr :ROCsParam))
  203.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9011 csParamPtr))
  204.     (pref csParamPtr (:ROCsParam.csParam 0))))
  205.  
  206. (defmethod RO364vd-get-brightness ((vd RO364-vd))
  207. ;returns the brightness level [0-63]
  208.   (rlet ((csParamPtr :ROCsParam))
  209.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9008 csParamPtr))
  210.     (pref csParamPtr (:ROCsParam.csParam 0))))
  211.  
  212. (defmethod RO364vd-get-contrast ((vd RO364-vd))
  213. ;returns the contrast level [0-63]
  214.   (rlet ((csParamPtr :ROCsParam))
  215.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9009 csParamPtr))
  216.     (pref csParamPtr (:ROCsParam.csParam 0))))
  217.  
  218. (defmethod RO364vd-get-white-level ((vd RO364-vd))
  219. ;returns the white-level [0-63]
  220.   (rlet ((csParamPtr :ROCsParam))
  221.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9010 csParamPtr))
  222.     (pref csParamPtr (:ROCsParam.csParam 0))))
  223.  
  224. (defmethod RO364vd-read-NVRam ((vd RO364-vd) byte-offset)
  225. ;returns the byte at offset from nonvolatile RAM
  226.   (rlet ((csParamPtr :ROCsParam
  227.                      (:csParam 0) byte-offset))
  228.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9031 csParamPtr))
  229.     (pref csParamPtr (:ROCsParam.csParam 1))))
  230.  
  231. (defmethod RO364vd-red-inhibited-p ((vd RO364-vd))
  232. ;returns t if the red video component is inhibited
  233.   (rlet ((csParamPtr :ROCsParam))
  234.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9019 csParamPtr))
  235.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  236.  
  237. (defmethod RO364vd-green-inhibited-p ((vd RO364-vd))
  238. ;returns t if the green video component is inhibited
  239.   (rlet ((csParamPtr :ROCsParam))
  240.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9020 csParamPtr))
  241.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  242.  
  243. (defmethod RO364vd-blue-inhibited-p ((vd RO364-vd))
  244. ;returns t if the blue video component is inhibited
  245.   (rlet ((csParamPtr :ROCsParam))
  246.     (vd-nz-error-check vd (#~Status (drvr-refnum vd) 9021 csParamPtr))
  247.     (= 1 (pref csParamPtr (:ROCsParam.csParam 0)))))
  248.  
  249. (defmethod RO364vd-install-332-table ((vd RO364-vd))
  250.   (%stack-block ((ctTable (* 8 256)))
  251.     (with-macptrs ((old-GD (#_GetGDevice)))
  252.       (unwind-protect
  253.         (progn
  254.           (with-macptrs ((color-spec ctTable))
  255.             (dotimes (i 256)
  256.               (pset color-spec :colorSpec.value i)
  257.               (let ((j (- 255 i)))
  258.                 (pset color-spec :colorSpec.rgb.red   (* #x0101 (truncate (* 255 (logand (ash j -5) 7)) 7)))
  259.                 (pset color-spec :colorSpec.rgb.green (* #x0101 (truncate (* 255 (logand (ash j -2) 7)) 7)))
  260.                 (pset color-spec :colorSpec.rgb.blue  (* #x0101 (truncate (* 255 (logand (ash j  0) 3)) 3))))
  261.               (%incf-ptr color-spec (rlength :ColorSpec))))
  262.           (#_SetGDevice (ROvd-get-GDevice vd))
  263.           (#_SetEntries 0 255 ctTable))
  264.         (#_SetGDevice old-GD)))))
  265.  
  266. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  267.  
  268. #|
  269.  
  270. ;; a modest example
  271.  
  272. (oou-dependencies :video-digitizer-svm)
  273.  
  274. (defclass vsview (video-digitizer-svm simple-view) () )
  275.  
  276. (progn
  277.   (setf *test-w*
  278.         (make-instance 'window
  279.                        :window-type :document
  280.                        :view-position #@(10 40)
  281.                        :view-size #@(320 300)
  282.                        :window-title "video demo"
  283.                        :color-p t
  284.                        ))
  285.   (add-subviews *test-w* (make-instance 'vsview
  286.                                         :view-position #@(10 10)
  287.                                         :view-size #@(300 250)                  
  288.                                         :view-nick-name :vview
  289.                                         :digitizer-class 'RO364-vd
  290.                                         )))
  291.  
  292. (start-digitizing (view-named :vview *test-w*))
  293.  
  294. (stop-digitizing (view-named :vview *test-w*))
  295.  
  296. ;; set the monitor to 8-bit and see what a dif this makes
  297. (let* ((v (view-named :vview *test-w*))
  298.        (vd (digitizer-object v)))
  299.   (RO364vd-install-332-table vd))
  300.  
  301.  
  302. |#