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 / video-digitizer.lisp < prev   
Encoding:
Text File  |  1992-01-30  |  9.1 KB  |  273 lines
  1. (in-package :oou)
  2. (oou-provide :video-digitizer)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; video-digitizer.lisp
  5. ;;
  6. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; object for controling a video digitizer
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (export '(vd-nz-error-check
  15.           vd-error-code-alist
  16.  
  17.           vd-init
  18.           vd-dispose
  19.           vd-install-settings
  20.           vd-grab-one-frame
  21.           vd-start-digitizing
  22.           vd-stop-digitizing
  23.           vd-digitizing-p
  24.           
  25.           src-rect-topLeft
  26.           src-rect-botRight
  27.           dig-rect-topLeft
  28.           dig-rect-botRight
  29.           dest-rect-topLeft
  30.           dest-rect-botRight
  31.           input-format
  32.           input-standard
  33.           black-level
  34.           white-level
  35.           contrast
  36.           hue
  37.           saturation
  38.           sharpness
  39.           
  40.           vd-set-src-rect
  41.           vd-set-dig-rect
  42.           vd-set-dest-rect
  43.           vd-set-input-format
  44.           vd-set-input-standard
  45.           vd-set-black-level
  46.           vd-set-white-level
  47.           vd-set-contrast
  48.           vd-set-hue
  49.           vd-set-saturation
  50.           vd-set-sharpness
  51.           ))
  52.  
  53. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  54.  
  55.  
  56. (defclass video-digitizer ()
  57.   ((card-num           :initarg  :card-num
  58.                        :reader   card-num)
  59.    (dest-wptr          :initarg  :dest-wptr
  60.                        :reader   dest-wptr)
  61.    (digitizing-flag    :initform nil)
  62.    (vd-init-flag       :initform nil)
  63.  
  64.    (src-rect-topLeft   :initarg :src-rect-topLeft
  65.                        :accessor src-rect-topLeft)
  66.    (src-rect-botRight  :initarg :src-rect-botRight
  67.                        :accessor src-rect-botRight)
  68.    (dig-rect-topLeft   :initarg :dig-rect-topLeft
  69.                        :accessor dig-rect-topLeft)
  70.    (dig-rect-botRight  :initarg :dig-rect-botRight
  71.                        :accessor dig-rect-botRight)
  72.    (dest-rect-topLeft  :initarg :dest-rect-topLeft
  73.                        :accessor dest-rect-topLeft)
  74.    (dest-rect-botRight :initarg :dest-rect-botRight
  75.                        :accessor dest-rect-botRight)
  76.    
  77.  
  78.    (input-format       :initarg :input-format
  79.                        :accessor input-format)
  80.    (input-standard     :initarg :input-standard
  81.                        :accessor input-standard) 
  82.    
  83.    (black-level        :initarg :black-level
  84.                        :accessor black-level) 
  85.    (white-level        :initarg :white-level
  86.                        :accessor white-level)
  87.    (contrast           :initarg :contrast
  88.                        :accessor contrast)
  89.    (hue                :initarg :hue
  90.                        :accessor hue)
  91.    (saturation         :initarg :saturation
  92.                        :accessor saturation)
  93.    (sharpness          :initarg :sharpness
  94.                        :accessor sharpness))
  95.  
  96.   (:default-initargs
  97.     :card-num           1
  98.     :input-format       :composite
  99.     :input-standard     :NTSC
  100.     :black-level        :unsupported
  101.     :white-level        :unsupported
  102.     :contrast           :unsupported
  103.     :hue                :unsupported
  104.     :saturation         :unsupported
  105.     :sharpness          :unsupported
  106.    ))
  107.  
  108.  
  109. (defmethod vd-nz-error-check ((vd video-digitizer) error-code)
  110.   (unless (zerop error-code)
  111.     (error "(~a) ~a"
  112.            error-code
  113.            (or (rest (assoc error-code (vd-error-code-alist vd) :test #'eql))
  114.                "unknown error code"))))
  115.  
  116. (defmethod vd-error-code-alist ((vd video-digitizer)))
  117.  
  118. (defmethod vd-init ((vd video-digitizer))
  119.   (multiple-value-bind (max-tl max-br) (vd-max-src-rect-corners vd)
  120.     (unless (slot-boundp vd 'src-rect-topLeft)
  121.       (setf (src-rect-topLeft vd) max-tl))
  122.     (unless (slot-boundp vd 'src-rect-botRight)
  123.       (setf (src-rect-botRight vd) max-br))
  124.     (unless (slot-boundp vd 'dig-rect-topLeft)
  125.       (setf (dig-rect-topLeft vd) max-tl))
  126.     (unless (slot-boundp vd 'dig-rect-botRight)
  127.       (setf (dig-rect-botRight vd) max-br))))
  128.  
  129. (defmethod vd-init :after ((vd video-digitizer))
  130.   (setf (slot-value vd 'vd-init-flag) t))
  131.  
  132. (defmethod vd-dispose ((vd video-digitizer))
  133.   (when (vd-digitizing-p vd) (vd-stop-digitizing vd)))
  134.  
  135. (defmethod vd-dispose :after ((vd video-digitizer))
  136.   (setf (slot-value vd 'vd-init-flag) nil))
  137.  
  138. (defgeneric vd-GDevice (vd))
  139.  
  140. (defmethod vd-max-src-rect-corners ((vd video-digitizer))
  141.   (declare (ignore vd)))
  142.  
  143. (defmethod vd-grab-one-frame ((vd video-digitizer))
  144.   (vd-install-settings vd))
  145.  
  146. (defmethod vd-start-digitizing ((vd video-digitizer))
  147.   (vd-install-settings vd)
  148.   (setf (slot-value vd 'digitizing-flag) t))
  149.  
  150. (defmethod vd-stop-digitizing ((vd video-digitizer))
  151.   (setf (slot-value vd 'digitizing-flag) nil))
  152.  
  153. (defmethod vd-digitizing-p ((vd video-digitizer))
  154.   (and (slot-value vd 'vd-init-flag) (slot-value vd 'digitizing-flag)))
  155.  
  156. (defmethod vd-install-settings ((vd video-digitizer))
  157.   (vd-set-src-rect  vd (src-rect-topLeft vd)  (src-rect-botRight vd))
  158.   (vd-set-dig-rect  vd (dig-rect-topLeft vd)  (dig-rect-botRight vd))
  159.   (vd-set-dest-rect vd (dest-rect-topLeft vd) (dest-rect-botRight vd))
  160.   
  161.   (vd-set-input-format   vd (input-format vd))
  162.   (vd-set-input-standard vd (input-standard vd))
  163.   
  164.   (vd-set-black-level vd (black-level vd))
  165.   (vd-set-white-level vd (white-level vd))
  166.   (vd-set-contrast    vd (contrast vd))
  167.   (vd-set-hue         vd (hue vd))
  168.   (vd-set-saturation  vd (saturation vd))
  169.   (vd-set-sharpness   vd (sharpness vd)))
  170.  
  171.  
  172. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  173. ;;; set functions for video control values on the digitizer board
  174. ;;; the defaults do nothing for it's up to the board specific specializations
  175.  
  176. (defmethod vd-set-src-rect ((vd video-digitizer) topLeft botRight)
  177.   (declare (ignore vd topLeft botRight)))
  178.  
  179. (defmethod vd-set-dig-rect ((vd video-digitizer) topLeft botRight)
  180.   (declare (ignore vd topLeft botRight)))
  181.  
  182. (defmethod vd-set-dest-rect ((vd video-digitizer) topLeft botRight)
  183.   (declare (ignore vd topLeft botRight)))
  184.  
  185. (defmethod vd-set-input-format ((vd video-digitizer) format)
  186.   (declare (ignore vd format)))
  187.  
  188. (defmethod vd-set-input-standard ((vd video-digitizer) standard)
  189.   (declare (ignore vd standard)))
  190.  
  191. (defmethod vd-set-black-level ((vd video-digitizer) level)
  192.   (declare (ignore vd level)))
  193.  
  194. (defmethod vd-set-white-level ((vd video-digitizer) level)
  195.   (declare (ignore vd level)))
  196.  
  197. (defmethod vd-set-contrast ((vd video-digitizer) contrast)
  198.   (declare (ignore vd contrast)))
  199.  
  200. (defmethod vd-set-hue ((vd video-digitizer) hue)
  201.   (declare (ignore vd hue)))
  202.  
  203. (defmethod vd-set-saturation ((vd video-digitizer) saturation)
  204.   (declare (ignore vd saturation)))
  205.  
  206. (defmethod vd-set-sharpness ((vd video-digitizer) sharpness)
  207.   (declare (ignore vd sharpness)))
  208.  
  209.  
  210. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  211. ;;; after methods for slot setf accessors
  212. ;;; (handle updating current board settings if the board is currently digitizing)
  213.  
  214. (defmethod (setf src-rect-topLeft) :after (new-topLeft (vd video-digitizer))
  215.   (when (vd-digitizing-p vd)
  216.     (vd-set-src-rect vd new-topLeft (src-rect-botRight vd))))
  217.  
  218. (defmethod (setf src-rect-botRight) :after (new-botRight (vd video-digitizer))
  219.   (when (vd-digitizing-p vd)
  220.     (vd-set-src-rect vd (src-rect-topLeft vd) new-botRight)))
  221.  
  222. (defmethod (setf dig-rect-topLeft) :after (new-topLeft (vd video-digitizer))
  223.   (when (vd-digitizing-p vd)
  224.     (vd-set-dig-rect vd new-topLeft (dig-rect-botRight vd))))
  225.  
  226. (defmethod (setf dig-rect-botRight) :after (new-botRight (vd video-digitizer))
  227.   (when (vd-digitizing-p vd)
  228.     (vd-set-dig-rect vd (dig-rect-topLeft vd) new-botRight)))
  229.  
  230. (defmethod (setf dest-rect-topLeft) :after (new-topLeft (vd video-digitizer))
  231.   (when (vd-digitizing-p vd)
  232.     (vd-set-dest-rect vd new-topLeft (dest-rect-botRight vd))))
  233.  
  234. (defmethod (setf dest-rect-botRight) :after (new-botRight (vd video-digitizer))
  235.   (when (vd-digitizing-p vd)
  236.     (vd-set-dest-rect vd (dest-rect-topLeft vd) new-botRight)))
  237.  
  238. (defmethod (setf input-format) :after (new-format (vd video-digitizer))
  239.   (when (vd-digitizing-p vd)
  240.     (vd-set-input-format vd new-format)))
  241.  
  242. (defmethod (setf input-standard) :after (new-standard (vd video-digitizer))
  243.   (when (vd-digitizing-p vd)
  244.     (vd-set-input-standard vd new-standard)))
  245.  
  246. (defmethod (setf black-level) :after (new-level (vd video-digitizer))
  247.   (when (vd-digitizing-p vd)
  248.     (vd-set-black-level vd new-level)))
  249.  
  250. (defmethod (setf white-level) :after (new-level (vd video-digitizer))
  251.   (when (vd-digitizing-p vd)
  252.     (vd-set-white-level vd new-level)))
  253.  
  254. (defmethod (setf contrast) :after (new-contrast (vd video-digitizer))
  255.   (when (vd-digitizing-p vd)
  256.     (vd-set-contrast vd new-contrast)))
  257.  
  258. (defmethod (setf hue) :after (new-hue (vd video-digitizer))
  259.   (when (vd-digitizing-p vd)
  260.     (vd-set-hue vd new-hue)))
  261.  
  262. (defmethod (setf saturation) :after (new-saturation (vd video-digitizer))
  263.   (when (vd-digitizing-p vd)
  264.     (vd-set-saturation vd new-saturation)))
  265.  
  266. (defmethod (setf sharpness) :after (new-sharpness (vd video-digitizer))
  267.   (when (vd-digitizing-p vd)
  268.     (vd-set-sharpness vd new-sharpness)))
  269.  
  270. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  271. #|
  272. examples can be found in the board specific -vd files
  273. |#