Actualize example.
authorVitaly Mayatskikh <v.mayatskih@gmail.com>
Thu, 17 Sep 2009 19:36:51 +0000 (17 21:36 +0200)
committerVitaly Mayatskikh <v.mayatskih@gmail.com>
Thu, 17 Sep 2009 19:36:51 +0000 (17 21:36 +0200)
Previous version was slightly outdated against current API.

example.lisp

index 5c34229..2e46c0f 100644 (file)
@@ -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)
 
 (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)
 
 (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
               (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))
   (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)
 
                                   :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)
 ;; 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