3 (defclass v4l2
(standard-class) ())
5 (defmethod validate-superclass ((obj v4l2
) (obj1 standard-class
)) t
)
7 (defun class-slot-definition (class slot
)
8 (dolist (s (class-direct-slots class
))
9 (when (equal slot
(slot-definition-name s
))
12 (defvar v4l2-slot-readers
(make-hash-table :test
'equal
))
13 (defvar v4l2-slot-writers
(make-hash-table :test
'equal
))
15 (defmethod slot-value-using-class ((class v4l2
) inst slot
)
16 (if (string= (string-upcase (slot-definition-name slot
)) "RAW")
17 (call-next-method class inst
)
18 (funcall (gethash (cons (class-name class
) (slot-definition-name slot
))
22 (defmethod (setf slot-value-using-class
) (new (class v4l2
) inst slot
)
23 (if (string= (string-upcase (slot-definition-name slot
)) "RAW")
24 (call-next-method new class inst
)
25 (funcall (gethash (cons (class-name class
) (slot-definition-name slot
)) v4l2-slot-writers
)
28 (defmacro define-wrapper
(class-and-type supers
&optional slots
)
29 (destructuring-bind (class-name &optional
(struct-type class-name
))
30 (cffi::ensure-list class-and-type
)
31 (let ((slots (or slots
(cffi::foreign-slot-names struct-type
)))
32 (raw-accessor (cffi::format-symbol t
"~A-RAW" class-name
)))
34 (defclass ,class-name
,supers
35 (,@(loop for slot in slots collect
37 (raw :accessor
,raw-accessor
))
40 ,@(loop for slot in slots
41 for slot-name
= (cffi::format-symbol t
"~A-~A" class-name slot
)
42 for slot-type
= (cffi::slot-type
(cffi::get-slot-info class-name slot
))
44 `(defun ,slot-name
(inst)
45 ,(if (or (eq slot-type
:char
) (eq slot-type
:uchar
))
46 `(cffi:convert-from-foreign
47 (cffi:foreign-slot-value
(,raw-accessor inst
) ',class-name
',slot
) :string
)
48 (if (cffi::aggregatep
(cffi::parse-type slot-type
))
49 `(make-instance ',slot-type
50 :pointer
(cffi:foreign-slot-value
(,raw-accessor inst
) ',class-name
',slot
))
51 `(cffi:foreign-slot-value
(,raw-accessor inst
) ',class-name
',slot
))))
53 `(setf (gethash (cons ',class-name
',slot
) v4l2-slot-readers
)
54 (fdefinition ',slot-name
))
57 `(defun (setf ,slot-name
) (new inst
)
58 (setf (cffi:foreign-slot-value
(,raw-accessor inst
) ',class-name
',slot
)
59 (cffi:convert-to-foreign new
',slot-type
)))
61 `(setf (gethash (cons ',class-name
',slot
) v4l2-slot-writers
)
62 (fdefinition '(setf ,slot-name
))))
64 (defmethod initialize-instance :after
((inst ,class-name
) &key pointer
)
65 (let ((obj (or pointer
(cffi:foreign-alloc
',class-name
))))
66 (setf (,raw-accessor inst
) obj
)
68 (tg:finalize inst
(lambda ()
69 (cl:format t
"finalize ~A~%" obj
)
70 (foreign-free obj
))))))
73 (defmacro def-c-struct
(name &rest args
)
77 (define-wrapper ,name
())))
79 (defmacro def-c-union
(name &rest args
)
83 (define-wrapper ,name
())))
85 (def-c-struct capability
86 (driver :uchar
:count
16)
87 (card :uchar
:count
32)
88 (bus-info :uchar
:count
32)
90 (capabilities :uint32
)
91 (reserved :uint32
:count
4))
95 (denominator :uint32
))
97 (def-c-struct captureparm
98 (capability :uint32
) ; Supported modes
99 (capturemode :uint32
) ; Current mode
100 (timeperframe fract
) ; Time per frame in .1us units
101 (extendedmode :uint32
) ; Driver-specific extensions
102 (readbuffers :uint32
) ; # of buffers for read
103 (reserved :uint32
:count
4))
105 (def-c-struct outputparm
106 (capability :uint32
) ; Supported modes
107 (outputmode :uint32
) ; Current mode
108 (timeperframe fract
) ; Time per frame in .1us units
109 (extendedmode :uint32
) ; Driver-specific extensions
110 (writebuffers :uint32
) ; # of buffers for write
111 (reserved :uint32
:count
4))
113 (def-c-union streamparm-union
114 (capture captureparm
)
116 (raw-data :uchar
:count
200))
119 (:buf-type-video-capture
1)
120 :buf-type-video-output
121 :buf-type-video-overlay
122 :buf-type-vbi-capture
124 :buf-type-sliced-vbi-capture
125 :buf-type-sliced-vbi-output
126 :buf-type-video-output-overlay
)
128 (def-c-struct streamparm
130 (parm streamparm-union
))
139 (name :uchar
:count
32)
148 (reserved :uint32
:count
4))
150 (def-c-struct standard
153 (name :uchar
:count
24)
156 (reserved :uint32
:count
4))
159 (index :uint32
) ; Which input
160 (name :uchar
:count
32) ; Label
161 (type :uint32
) ; Type of input
162 (audioset :uint32
) ; Associated audios (bitfield)
163 (tuner :uint32
) ; Associated tuner
166 (reserved :uint32
:count
4))
169 ;; F O R M A T E N U M E R A T I O N
171 (def-c-struct fmtdesc
172 (index :uint32
) ; Format number
173 (type buf-type
) ; buffer type
175 (description :uchar
:count
32) ; Description string
176 (pixelformat :uint32
) ; Format fourcc
177 (reserved :uint32
:count
4))
179 ;; Values for the 'type' field
180 (defconstant input-type-tuner
1)
182 (defconstant input-type-camera
2)
185 :field-any
; driver can choose from none
186 ; top, bottom, interlaced
187 ; depending on whatever it thinks
189 :field-none
; this device has no fields ...
190 :field-top
; top field only
191 :field-bottom
; bottom field only
192 :field-interlaced
; both fields interlaced
193 :field-seq-tb
; both fields sequential into one
194 ; buffer, top-bottom order
195 :field-seq-bt
; same as above + bottom-top order
196 :field-alternate
; both fields alternating into
198 :field-interlaced-tb
; both fields interlaced, top field
199 ; first and the top field is
201 :field-interlaced-bt
; both fields interlaced, top field
202 ; first and the bottom field is
207 (:colorspace-smpte170m
1) ; ITU-R 601 -- broadcast NTSC/PAL
208 :colorspace_smpte240m
; 1125-Line (US) HDTV
209 :colorspace-rec709
; HD and modern captures.
210 ; broken BT878 extents (601, luma range 16-253 instead of 16-235)
212 ; These should be useful. Assume 601 extents.
213 :colorspace-470-system-m
214 :colorspace-470-system-bg
216 ; I know there will be cameras that send this. So, this is
217 ; unspecified chromaticities and full 0-255 on each of the
221 ; For RGB colourspaces, this is probably a good start.
225 ;; V I D E O I M A G E F O R M A T
227 (def-c-struct pix-format
230 (pixelformat :uint32
)
232 (bytesperline :uint32
) ; for padding, zero if unused
234 (colorspace colorspace
)
235 (priv :uint32
)) ; private data, depends on pixelformat
237 ;; Stream data format
240 (def-c-struct timecode
247 (userbits :uchar
:count
4))
254 ;; M E M O R Y - M A P P I N G B U F F E R S
256 (def-c-struct requestbuffers
260 (reserved :uint32
:count
2))
262 (def-c-union buffer-union
283 (:ctrl-type-integer
1)
288 :ctrl-type-ctrl-class
)
290 ;; Used in the VIDIOC_QUERYCTRL ioctl for querying controls
291 (def-c-struct queryctrl
294 (name :uchar
:count
32)
298 (default-value :int32
)
300 (reserved :uint32
:count
2))
302 (def-c-struct control
306 (defcenum power-line-frequency
307 :cid-power-line-frequency-disabled
308 :cid-power-line-frequency-50hz
309 :cid-power-line-frequency-60hz
)
316 (defcenum exposure-auto-type
319 :exposure-shutter-priority
320 :exposure-aperture-priority
)