[cells-gtk-devel] can't run testprogram

[Peter Hildebrandt]

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 <kielhorn.martin at googlemail.com>:
>
>
> 2008/10/27 Peter Hildebrandt <peter.hildebrandt at gmail.com>
>>
>> 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
>