From: Vitaly Mayatskikh <v.mayatskih@gmail.com>
Date: Thu, 17 Sep 2009 19:36:51 +0000 (+0200)
Subject: Actualize example.
X-Git-Url: https://repo.or.cz/w/cl-v4l2.git/commitdiff_plain/e23b8f19b58bc30c3f0312a2b11381ccd30126a9

Actualize example.

Previous version was slightly outdated against current API.
---

diff --git a/example.lisp b/example.lisp
index 5c34229..2e46c0f 100644
--- a/example.lisp
+++ b/example.lisp
@@ -1,6 +1,3 @@
-;;
-;; CL-V4L2 example
-;;
 ;; $ LD_PRELOAD=/usr/lib64/libv4l/v4l2convert.so sbcl --load example.lisp
 
 (asdf:oos 'asdf:load-op :cl-v4l2)
@@ -13,9 +10,14 @@
 
 (in-package :test-v4l2)
 
-(defvar *capture-device* "/dev/video1")
-(defvar *want-width* 640)
-(defvar *want-height* 480)
+(defvar *capture-device* "/dev/video0")
+(defparameter *capture-fd* nil)
+
+;; what we want from camera
+(defvar *want-width* 352)
+(defvar *want-height* 288)
+
+;; what we really get
 (defparameter *got-width* nil)
 (defparameter *got-height* nil)
 
@@ -29,7 +31,7 @@
 (defparameter *render-thread-lock* (bt:make-lock "Render thread lock"))
 
 (defmacro without-errors (&body body)
-  `(handler-case ,@body
+  `(handler-case (progn ,@body)
      (error (c) (format t "suppressed error: ~A~%" c) nil)))
 
 (defun char-at (pos data)
@@ -103,6 +105,7 @@
 
 (defun video-init (device)
   (let ((fd (%sys-open device o-rdwr)))
+    (setq *capture-fd* fd)
     (diagnose fd)					; info about device
     (device-init fd)					; setup
     (let ((buffers (v4l2:map-buffers fd 4)))		; map 4 buffers into memory
@@ -129,13 +132,17 @@
 	       (bt:with-lock-held (*camera-data-lock*)
 		 (declare (optimize (speed 3) (debug 0) (safety 0)))
 		 (loop for i fixnum from 0 below (* *got-width* *got-height*) do
-		      (setf (aref *camera-data* (+ (* 4 i) 0)) (cffi:mem-aref address :uchar (+ (* 3 i) 0))
-			    (aref *camera-data* (+ (* 4 i) 1)) (cffi:mem-aref address :uchar (+ (* 3 i) 1))
-			    (aref *camera-data* (+ (* 4 i) 2)) (cffi:mem-aref address :uchar (+ (* 3 i) 2))))))
+		      (let ((r (cffi:mem-aref address :uchar (+ (* 3 i) 0)))
+			    (g (cffi:mem-aref address :uchar (+ (* 3 i) 1)))
+			    (b (cffi:mem-aref address :uchar (+ (* 3 i) 2))))
+
+			(setf (aref *camera-data* (+ (* 4 i) 0)) r
+			      (aref *camera-data* (+ (* 4 i) 1)) g
+			      (aref *camera-data* (+ (* 4 i) 2)) b)))))
 
 	     (when *camera-widget*
 	       (with-main-loop
-		 (widget-queue-draw *camera-widget*)))
+		   (widget-queue-draw *camera-widget*)))
 
 	     (v4l2:put-frame fd frame))))	; put frame back to driver
     (video-uninit fd buffers))
@@ -177,7 +184,7 @@
   (gl:flush))
 
 (defun camera-draw (widget event)
-  (declare (ignore event))
+  (declare (ignore widget event))
   (gl:clear :color-buffer-bit :depth-buffer-bit)
   (gl:bind-texture :texture-rectangle-arb 0)
 
@@ -227,7 +234,31 @@
 				   :window-position :center
 				   :title "Hello world!"
 				   :default-width *want-width*
-				   :default-height *want-height*)))
+				   :default-height *want-height*))
+	    (hbox (make-instance 'h-box))
+	    (vbox (make-instance 'v-box))
+	    (quit-button (make-instance 'button :label "Quit"))
+	    (bright-spin (make-instance 'spin-button :label "Brightness"
+					:adjustment (make-instance 'adjustment
+								   :lower 0d0
+								   :upper 100d0
+								   :step-increment 1d0))))
+
+
+	(gobject:connect-signal bright-spin "value-changed"
+				(lambda (widget)
+				  (let ((value (adjustment-value (spin-button-adjustment bright-spin))))
+				    (format t "~A changed value to ~F~%" widget value)
+				    (unless (without-errors
+						(format t "Previous value was: ~F~%"
+							(v4l2:get-control *capture-fd* v4l2:cid-brightness))
+					      (v4l2:set-control *capture-fd* v4l2:cid-brightness (/ value 100)))
+				      (v4l2:set-control *capture-fd* v4l2:cid-exposure (/ value 100))))))
+
+	(gobject:connect-signal quit-button "clicked"
+				(lambda (widget)
+				  (declare (ignore widget))
+				  (bt:condition-notify *render-thread-stop*)))
 
 	(gobject:connect-signal window "destroy"
 				(lambda (widget)
@@ -237,8 +268,12 @@
 ;; Capture process needs to know which widget to ask for redraw
 	(setq *camera-widget* (make-instance 'gl-drawing-area
 					     :on-init #'camera-init
-					     :on-draw #'camera-draw))
-	(container-add window *camera-widget*)
+					     :on-expose #'camera-draw))
+	(box-pack-start hbox vbox :expand nil)
+	(box-pack-start hbox *camera-widget* :expand t)
+	(box-pack-start vbox quit-button :expand nil)
+	(box-pack-start vbox bright-spin :expand nil)
+	(container-add window hbox)
 	(widget-show window :all t)))
 
 ;; Wait for window destruction