example.lisp

   1 (require :cl-v4l2)
   2
   3 (in-package :cl-v4l2)
   4
   5 (defmacro without-errors (&body body)
   6   `(handler-case ,@body
   7      (error ())))
   8
   9 (defun char-at (pos data)
  10   (code-char (ldb (byte 8 (* 8 pos)) data)))
  11
  12 (defun diagnose (fd)
  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)
  20                      v4l2-streamparm)
  21       (format t "frame skipping support: ~A~%"
  22               (not (zerop (foreign-slot-value
  23                            (foreign-slot-value
  24                             parm 'v4l2-streamparm-union 'capture)
  25                            'v4l2-captureparm 'capability)))))
  26     (when (v4l2-capable caps cap-tuner)
  27       (without-errors
  28         (loop for idx from 0 do
  29              (progn
  30                (v4l2-get-tuner-params fd idx)
  31                ;; show tuner params
  32                ))))
  33
  34     (without-errors
  35       (loop for idx from 0 do
  36            (with-ref-slots ((index name type tuner)
  37                             (v4l2-get-input-params fd idx)
  38                             v4l2-input)
  39              (format t "input [~D] name: ~A, type ~A~%"
  40                      index
  41                      (thef :string name)
  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))
  45
  46              (without-errors
  47                (loop for idx1 from 0 do
  48                     (with-ref-slots ((index name)
  49                                      (v4l2-get-input-standard fd idx1)
  50                                      v4l2-standard)
  51                       (format t "input [~D] std [~D] name: ~A~%"
  52                               idx index (thef :string name))))))))
  53
  54     (v4l2-set-input fd 0)               ; some cameras doesn't set input by default
  55
  56     (without-errors
  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)))))))
  65
  66 (defun device-init (fd)
  67   (v4l2-set-input fd 0)
  68   (v4l2-set-image-format fd 358 284 pix-fmt-sbggr8))
  69
  70 ;; Typical session:
  71
  72 (defun test ()
  73   (let ((fd (%sys-open "/dev/video0" o-rdwr))
  74         buffers frame)
  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))
  84                    address))
  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!~%")))
  90
  91 (test)
  92
  93 ;; (%sys-open "/dev/video0" o-rdwr)
  94 ;; (diagnose 4)
  95 ;; (device-init 4)
  96 ;; (setq a (v4l2-map-buffers 4 4))
  97 ;; (v4l2-stream-on 4 a)
  98 ;; (v4l2-get-frame 4)
  99 ;; (v4l2-put-frame 4 0)
 100 ;; (v4l2-stream-off 4 a)
 101 ;; (v4l2-unmap-buffers a)
 102 ;; (%sys-close 4)