5 (defmacro without-errors
(&body body
)
9 (defun char-at (pos data
)
10 (code-char (ldb (byte 8 (* 8 pos
)) data
)))
13 (let ((caps (v4l2-query-capabilities fd
)))
14 (format t
(v4l2-%device-info caps
))
15 (unless (v4l2-capable caps cap-video-capture
)
16 (error "not a capture device"))
17 (unless (v4l2-capable caps cap-streaming
)
18 (error "not a streaming device"))
19 (with-ref-slots ((parm) (v4l2-get-stream-params fd
:buf-type-video-capture
)
21 (format t
"frame skipping support: ~A~%"
22 (not (zerop (foreign-slot-value
24 parm
'v4l2-streamparm-union
'capture
)
25 'v4l2-captureparm
'capability
)))))
26 (when (v4l2-capable caps cap-tuner
)
28 (loop for idx from
0 do
30 (v4l2-get-tuner-params fd idx
)
35 (loop for idx from
0 do
36 (with-ref-slots ((index name type tuner
)
37 (v4l2-get-input-params fd idx
)
39 (format t
"input [~D] name: ~A, type ~A~%"
42 (if (= type v4l2-input-type-tuner
) "tuner" "camera"))
43 (when (= type v4l2-input-type-tuner
)
44 (format t
"input [~D] connected to tuner ~D~%" index tuner
))
47 (loop for idx1 from
0 do
48 (with-ref-slots ((index name
)
49 (v4l2-get-input-standard fd idx1
)
51 (format t
"input [~D] std [~D] name: ~A~%"
52 idx index
(thef :string name
))))))))
54 (v4l2-set-input fd
0) ; some cameras doesn't set input by default
57 (loop for idx from
0 do
58 (with-ref-slots ((index pixelformat
)
59 (v4l2-get-format fd idx
) v4l2-fmtdesc
)
60 (format t
"format [~D] ~A~A~A~A~%" index
61 (char-at 0 pixelformat
)
62 (char-at 1 pixelformat
)
63 (char-at 2 pixelformat
)
64 (char-at 3 pixelformat
)))))))
66 (defun device-init (fd)
68 (v4l2-set-image-format fd
358 284 pix-fmt-sbggr8
))
73 (let ((fd (%sys-open
"/dev/video0" o-rdwr
))
75 (diagnose fd
) ; what is at video0
76 (device-init fd
) ; setup
77 (setq buffers
(v4l2-map-buffers fd
2)) ; map 2 buffers into memory
78 (v4l2-stream-on fd buffers
) ; start capturing
79 (loop for i from
0 below
10 do
; capture 10 frames
80 (setq frame
(v4l2-get-frame fd
)) ; get one frame from driver
81 (format t
"got frame ~D, data is at address ~A~%" frame
; process frame
82 (multiple-value-bind (buffer address length
)
83 (values-list (nth frame buffers
))
85 (v4l2-put-frame fd frame
)) ; put frame back to driver
86 (v4l2-stream-off fd buffers
) ; stop capturing
87 (v4l2-unmap-buffers buffers
) ; throw away buffers from memory
88 (%sys-close fd
) ; close device
89 (format t
"that's all!~%")))
93 ;; (%sys-open "/dev/video0" o-rdwr)
96 ;; (setq a (v4l2-map-buffers 4 4))
97 ;; (v4l2-stream-on 4 a)
99 ;; (v4l2-put-frame 4 0)
100 ;; (v4l2-stream-off 4 a)
101 ;; (v4l2-unmap-buffers a)