3 ;; Generate wrapper classes for all structures.
4 ;; Slot access is overtaken via MOP. This allows to utilize usual `with-slots'
5 ;; macro. This is slow, 'cause it uses hash lookup tables.
7 ;; Better access speed can be achieved using generated accessors
8 ;; named like <class-name>-<slot-name>, e.g. `capability-driver'.
10 (defclass v4l2
(standard-class) ())
12 (defmethod validate-superclass ((obj v4l2
) (obj1 standard-class
)) t
)
14 (defun class-slot-definition (class slot
)
15 (dolist (s (class-direct-slots class
))
16 (when (equal slot
(slot-definition-name s
))
19 (defvar *v4l2-slot-readers
* (make-hash-table :test
'equal
))
20 (defvar *v4l2-slot-writers
* (make-hash-table :test
'equal
))
22 (defmethod slot-value-using-class ((class v4l2
) inst slot
)
23 (if (string= (string-upcase (slot-definition-name slot
)) "RAW")
24 (call-next-method class inst
)
25 (funcall (gethash (cons (class-name class
) (slot-definition-name slot
))
29 (defmethod (setf slot-value-using-class
) (new (class v4l2
) inst slot
)
30 (if (string= (string-upcase (slot-definition-name slot
)) "RAW")
31 (call-next-method new class inst
)
32 (funcall (gethash (cons (class-name class
) (slot-definition-name slot
))
36 (defmacro define-wrapper
(class-and-type supers
&optional slots
)
37 (destructuring-bind (class-name &optional
(struct-type class-name
))
38 (cffi::ensure-list class-and-type
)
39 (let ((slots (or slots
(cffi::foreign-slot-names struct-type
)))
40 (raw-accessor (cffi::format-symbol t
"~A-RAW" class-name
)))
42 (defclass ,class-name
,supers
43 (,@(loop for slot in slots collect
45 (raw :accessor
,raw-accessor
))
48 ,@(loop for slot in slots
49 for slot-name
= (cffi::format-symbol t
"~A-~A" class-name slot
)
50 for slot-type
= (cffi::slot-type
(cffi::get-slot-info class-name slot
))
52 `(defun ,slot-name
(inst)
53 ,(if (or (eq slot-type
:char
) (eq slot-type
:uchar
))
54 `(convert-from-foreign
55 (foreign-slot-value (,raw-accessor inst
) ',class-name
',slot
) :string
)
56 (if (cffi::aggregatep
(cffi::parse-type slot-type
))
57 `(make-instance ',slot-type
58 :pointer
(foreign-slot-value (,raw-accessor inst
) ',class-name
',slot
))
59 `(foreign-slot-value (,raw-accessor inst
) ',class-name
',slot
))))
61 `(setf (gethash (cons ',class-name
',slot
) *v4l2-slot-readers
*)
62 (fdefinition ',slot-name
))
65 `(defun (setf ,slot-name
) (new inst
)
66 (setf (foreign-slot-value (,raw-accessor inst
) ',class-name
',slot
)
67 (convert-to-foreign new
',slot-type
)))
69 `(setf (gethash (cons ',class-name
',slot
) *v4l2-slot-writers
*)
70 (fdefinition '(setf ,slot-name
))))
72 (defmethod initialize-instance :after
((inst ,class-name
) &key pointer
)
73 (let ((obj (or pointer
(foreign-alloc ',class-name
))))
74 (setf (,raw-accessor inst
) obj
)
76 (finalize inst
(lambda ()
77 (cl:format t
"finalize ~A~%" obj
)
78 (foreign-free obj
))))))
81 (defmacro def-c-struct
(name &rest args
)
82 "Define cffi struct and generate wrapper"
86 (define-wrapper ,name
())))
88 (defmacro def-c-union
(name &rest args
)
89 "Define cffi union and generate wrapper"
93 (define-wrapper ,name
())))
95 (def-c-struct capability
96 (driver :uchar
:count
16)
97 (card :uchar
:count
32)
98 (bus-info :uchar
:count
32)
100 (capabilities :uint32
)
101 (reserved :uint32
:count
4))
105 (denominator :uint32
))
107 (def-c-struct captureparm
108 (capability :uint32
) ; Supported modes
109 (capturemode :uint32
) ; Current mode
110 (timeperframe fract
) ; Time per frame in .1us units
111 (extendedmode :uint32
) ; Driver-specific extensions
112 (readbuffers :uint32
) ; # of buffers for read
113 (reserved :uint32
:count
4))
115 (def-c-struct outputparm
116 (capability :uint32
) ; Supported modes
117 (outputmode :uint32
) ; Current mode
118 (timeperframe fract
) ; Time per frame in .1us units
119 (extendedmode :uint32
) ; Driver-specific extensions
120 (writebuffers :uint32
) ; # of buffers for write
121 (reserved :uint32
:count
4))
123 (def-c-union streamparm-union
124 (capture captureparm
)
126 (raw-data :uchar
:count
200))
129 (:buf-type-video-capture
1)
130 :buf-type-video-output
131 :buf-type-video-overlay
132 :buf-type-vbi-capture
134 :buf-type-sliced-vbi-capture
135 :buf-type-sliced-vbi-output
136 :buf-type-video-output-overlay
)
138 (def-c-struct streamparm
140 (parm streamparm-union
))
149 (name :uchar
:count
32)
158 (reserved :uint32
:count
4))
160 (def-c-struct standard
163 (name :uchar
:count
24)
166 (reserved :uint32
:count
4))
169 (index :uint32
) ; Which input
170 (name :uchar
:count
32) ; Label
171 (type :uint32
) ; Type of input
172 (audioset :uint32
) ; Associated audios (bitfield)
173 (tuner :uint32
) ; Associated tuner
176 (reserved :uint32
:count
4))
179 ;; F O R M A T E N U M E R A T I O N
181 (def-c-struct fmtdesc
182 (index :uint32
) ; Format number
183 (type buf-type
) ; buffer type
185 (description :uchar
:count
32) ; Description string
186 (pixelformat :uint32
) ; Format fourcc
187 (reserved :uint32
:count
4))
189 ;; Values for the 'type' field
190 (defconstant input-type-tuner
1)
192 (defconstant input-type-camera
2)
195 :field-any
; driver can choose from none
196 ; top, bottom, interlaced
197 ; depending on whatever it thinks
199 :field-none
; this device has no fields ...
200 :field-top
; top field only
201 :field-bottom
; bottom field only
202 :field-interlaced
; both fields interlaced
203 :field-seq-tb
; both fields sequential into one
204 ; buffer, top-bottom order
205 :field-seq-bt
; same as above + bottom-top order
206 :field-alternate
; both fields alternating into
208 :field-interlaced-tb
; both fields interlaced, top field
209 ; first and the top field is
211 :field-interlaced-bt
; both fields interlaced, top field
212 ; first and the bottom field is
217 (:colorspace-smpte170m
1) ; ITU-R 601 -- broadcast NTSC/PAL
218 :colorspace_smpte240m
; 1125-Line (US) HDTV
219 :colorspace-rec709
; HD and modern captures.
220 ; broken BT878 extents (601, luma range 16-253 instead of 16-235)
222 ; These should be useful. Assume 601 extents.
223 :colorspace-470-system-m
224 :colorspace-470-system-bg
226 ; I know there will be cameras that send this. So, this is
227 ; unspecified chromaticities and full 0-255 on each of the
231 ; For RGB colourspaces, this is probably a good start.
235 ;; V I D E O I M A G E F O R M A T
237 (def-c-struct pix-format
240 (pixelformat :uint32
)
242 (bytesperline :uint32
) ; for padding, zero if unused
244 (colorspace colorspace
)
245 (priv :uint32
)) ; private data, depends on pixelformat
247 ;; Stream data format
250 (def-c-struct timecode
257 (userbits :uchar
:count
4))
264 ;; M E M O R Y - M A P P I N G B U F F E R S
266 (def-c-struct requestbuffers
270 (reserved :uint32
:count
2))
272 (def-c-union buffer-union
293 (:ctrl-type-integer
1)
298 :ctrl-type-ctrl-class
)
300 ;; Used in the VIDIOC_QUERYCTRL ioctl for querying controls
301 (def-c-struct queryctrl
304 (name :uchar
:count
32)
308 (default-value :int32
)
310 (reserved :uint32
:count
2))
312 (def-c-struct control
316 (defcenum power-line-frequency
317 :cid-power-line-frequency-disabled
318 :cid-power-line-frequency-50hz
319 :cid-power-line-frequency-60hz
)
326 (defcenum exposure-auto-type
329 :exposure-shutter-priority
330 :exposure-aperture-priority
)