From peter.hildebrandt at gmail.com Wed Nov 19 20:37:48 2008 From: peter.hildebrandt at gmail.com (Peter Hildebrandt) Date: Wed, 19 Nov 2008 21:37:48 +0100 Subject: [cells-gtk-devel] can't run testprogram In-Reply-To: <1ae41e820810301118o66c0d2c6n14c516a616d70fa6@mail.gmail.com> References: <1ae41e820810220924vb5293b7k58f5df1bb5694747@mail.gmail.com> <1ae41e820810230204o12b1c45dy1ad15fc996509c28@mail.gmail.com> <7758b2680810230251x302b8010p8f3f7935e0c3cb95@mail.gmail.com> <1ae41e820810240932n340a7dc6mf70a8bfd69af1774@mail.gmail.com> <7758b2680810271041q1d494995p29033fbc7eac7194@mail.gmail.com> <1ae41e820810301118o66c0d2c6n14c516a616d70fa6@mail.gmail.com> Message-ID: <7758b2680811191237x985d322g48aad30fdf411118@mail.gmail.com> Hello Martin, as to (1), I think creating your own model derived from gl-drawing-area is the right approach, and I'd leave it as it is. As to (2), you might like (timeout-add ...) Check test-gtk/test-display.lisp for an exemplary usage. HTH, Peter 2008/10/30 Martin Kielhorn : > > > 2008/10/27 Peter Hildebrandt >> >> Lemme know if I can help. > > Right now I figure out if it is feasible to control a microscope with cells. > In the end I would capture from a camera, move the focus, change > objectives... > > But for the beginning I just try to create something similar to baudline > (http://www.baudline.com/). > Just capture sound, fft and display in an opengl texture. That should be > easier as there is not as > much hardware involved. > > What I've come up with is the following code. And I have several questions: > > 1) Can how somehow prevent the introduction of the extra defmodel graphics > with the > cell rotation and just connect my the hscale value to the gl-rotate? > > 2) What's the best way to continuously call the draw function in graphics, > so that the > display gets updated with 30 Hz? I searched the graphics instance with > (inspect *win*) > but I didn't find it. Otherwise I could have called (redraw (graphics > (vbox *win*))) from an endless > loop in another thread. > > Ideally I want to have the application running in several threads. One > thread should capture sound and fill it in a queue. > That should be easy in sbcl: > http://www.sbcl.org/manual/Waitqueue_002fcondition-variables.html#Waitqueue_002fcondition-variables > when 2) is solved. > > remark: > I think :resize isn't called when my program starts. (In early versions of > my program it was called. I don't know what > change introduced this bug) > > (require :asdf) > (require :cells-gtk) > (require :sb-simple-audio) > > (defpackage :martin (:use :cl :cgtk :cells)) > > (in-package :martin) > > (defparameter *tex* #x0) > (defparameter *field* (cffi:make-shareable-byte-vector (* 256 256 3))) > (defparameter *sound-buf-n* 1024) > (defparameter *sound-buf* (make-array *sound-buf-n*)) > (defparameter *sound-stream* (sb-simple-audio:open-audio :sample-rate 8000 > :direction :input)) > > > (defun plot (x y r g b) > (setf (aref *field* (+ 0 (* 3 (+ x (* 256 y))))) r) > (setf (aref *field* (+ 1 (* 3 (+ x (* 256 y))))) g) > (setf (aref *field* (+ 2 (* 3 (+ x (* 256 y))))) b)) > > (defmodel graphics (gl-drawing-area) > ((rotation :cell t :initarg :rotation :initform 0 :accessor rotation)) > (:default-initargs > :expand t :fill t > :init #'(lambda (self) > ;;(declare (ignorable self)) > (loop for i below 256 do > (loop for j below 256 do > (plot i j i j 0))) > (setf *tex* (first (gl:gen-textures 1))) > (gl:bind-texture :texture-2d *tex*) > (gl:tex-parameter :texture-2d :texture-mag-filter :nearest) > (gl:tex-parameter :texture-2d :texture-min-filter :nearest) > (cffi::with-pointer-to-vector-data (addr *field*) > (gl:tex-image-2d :texture-2d 0 :rgba 256 256 0 :rgb > :unsigned-byte addr))) > :resize #'(lambda (self) > (format t "RESIZE~%") > (with-matrix-mode (:projection) > (glu:perspective 50 (/ (allocated-width self) > (allocated-height self)) > .5 20))) > :draw #'(lambda (self) > (declare (ignorable self)) > (gl:clear :color-buffer-bit) > (gl:load-identity) > ;(gl:translate 0 0 -5) > (gl:rotate (* 360 (rotation self)) 0 0 1) > (gl:color 1 1 1) > (gl:enable :texture-2d) > (gl:with-primitive :quads > (gl:tex-coord 0 0)(gl:vertex 0 0) > (gl:tex-coord 1 0)(gl:vertex 1 0) > (gl:tex-coord 1 1)(gl:vertex 1 1) > (gl:tex-coord 0 1)(gl:vertex 0 1)) > (read-sequence *sound-buf* *sound-stream*) > ;;(format t "~a~%" *sound-buf*) > (gl:disable :texture-2d) > (gl:with-primitive :points > (loop for i below *sound-buf-n* do > (gl:vertex (/ i *sound-buf-n*) > (/ (aref *sound-buf* i) 5000)))) > (gl:flush)))) > > > (defobserver rotation ((self graphics)) > (redraw self)) > > (defmodel my-app (gtk-app) > () > (:default-initargs :title "minimal gl control test" > :position :center :width 500 :height 380 > :kids > (kids-list? (mk-vbox :kids > (kids-list? > (mk-hscale :md-name :scale :value-type 'single-float > :min .01 :max 1. :step .01 :init .5) > (make-kid 'graphics :md-name :graphics > :height 300 > :rotation (c? (widget-value :scale)))))))) > > (cells-gtk-init) > > ;(defparameter *win* (start-win 'my-app)) > > (start-app 'my-app) > > (* > (inspect *win*) > (sb-thread:list-all-threads) > (make-thread (lambda () (write-line "test"))) > *) > > _______________________________________________ > cells-gtk-devel site list > cells-gtk-devel at common-lisp.net > http://common-lisp.net/mailman/listinfo/cells-gtk-devel >