From f0fe47d68dd44eb002d345d4087f5fe62931ccff Mon Sep 17 00:00:00 2001
From: Vitaly Mayatskikh <vitaly@gravicappa.englab.brq.redhat.com>
Date: Fri, 31 Jul 2009 20:55:32 +0200
Subject: [PATCH] Added example

---
 example.lisp | 102 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 102 insertions(+)
 create mode 100644 example.lisp

diff --git a/example.lisp b/example.lisp
new file mode 100644
index 0000000..ea03bbc
--- /dev/null
+++ b/example.lisp
@@ -0,0 +1,102 @@
+(require :cl-v4l2)
+
+(in-package :cl-v4l2)
+
+(defmacro without-errors (&body body)
+  `(handler-case ,@body
+     (error ())))
+
+(defun char-at (pos data)
+  (code-char (ldb (byte 8 (* 8 pos)) data)))
+
+(defun diagnose (fd)
+  (let ((caps (v4l2-query-capabilities fd)))
+    (format t (v4l2-%device-info caps))
+    (unless (v4l2-capable caps cap-video-capture)
+      (error "not a capture device"))
+    (unless (v4l2-capable caps cap-streaming)
+      (error "not a streaming device"))
+    (with-ref-slots ((parm) (v4l2-get-stream-params fd :buf-type-video-capture)
+		     v4l2-streamparm)
+      (format t "frame skipping support: ~A~%"
+	      (not (zerop (foreign-slot-value
+			   (foreign-slot-value
+			    parm 'v4l2-streamparm-union 'capture)
+			   'v4l2-captureparm 'capability)))))
+    (when (v4l2-capable caps cap-tuner)
+      (without-errors
+	(loop for idx from 0 do
+	     (progn
+	       (v4l2-get-tuner-params fd idx)
+	       ;; show tuner params
+	       ))))
+
+    (without-errors
+      (loop for idx from 0 do
+	   (with-ref-slots ((index name type tuner)
+			    (v4l2-get-input-params fd idx)
+			    v4l2-input)
+	     (format t "input [~D] name: ~A, type ~A~%"
+		     index
+		     (thef :string name)
+		     (if (= type v4l2-input-type-tuner) "tuner" "camera"))
+	     (when (= type v4l2-input-type-tuner)
+	       (format t "input [~D] connected to tuner ~D~%" index tuner))
+
+	     (without-errors
+	       (loop for idx1 from 0 do
+		    (with-ref-slots ((index name)
+				     (v4l2-get-input-standard fd idx1)
+				     v4l2-standard)
+		      (format t "input [~D] std [~D] name: ~A~%"
+			      idx index (thef :string name))))))))
+
+    (v4l2-set-input fd 0)		; some cameras doesn't set input by default
+
+    (without-errors
+      (loop for idx from 0 do
+	   (with-ref-slots ((index pixelformat)
+			    (v4l2-get-format fd idx) v4l2-fmtdesc)
+	     (format t "format [~D] ~A~A~A~A~%" index
+		     (char-at 0 pixelformat)
+		     (char-at 1 pixelformat)
+		     (char-at 2 pixelformat)
+		     (char-at 3 pixelformat)))))))
+
+(defun device-init (fd)
+  (v4l2-set-input fd 0)
+  (v4l2-set-image-format fd 358 284 pix-fmt-sbggr8))
+
+;; Typical session:
+
+(defun test ()
+  (let ((fd (%sys-open "/dev/video0" o-rdwr))
+	buffers frame)
+    (diagnose fd)				; what is at video0
+    (device-init fd)				; setup
+    (setq buffers (v4l2-map-buffers fd 2))	; map 2 buffers into memory
+    (v4l2-stream-on fd buffers)			; start capturing
+    (loop for i from 0 below 10 do		; capture 10 frames
+	 (setq frame (v4l2-get-frame fd))	; get one frame from driver
+	 (format t "got frame ~D, data is at address ~A~%" frame	; process frame
+		 (multiple-value-bind (buffer address length)
+		     (values-list (nth frame buffers))
+		   address))
+	 (v4l2-put-frame fd frame))		; put frame back to driver
+    (v4l2-stream-off fd buffers)		; stop capturing
+    (v4l2-unmap-buffers buffers)		; throw away buffers from memory
+    (%sys-close fd)				; close device
+    (format t "that's all!~%")))
+
+(test)
+
+;; (%sys-open "/dev/video0" o-rdwr)
+;; (diagnose 4)
+;; (device-init 4)
+;; (setq a (v4l2-map-buffers 4 4))
+;; (v4l2-stream-on 4 a)
+;; (v4l2-get-frame 4)
+;; (v4l2-put-frame 4 0)
+;; (v4l2-stream-off 4 a)
+;; (v4l2-unmap-buffers a)
+;; (%sys-close 4)
-- 
2.11.4.GIT