[plt-scheme] gl-config% - Double buffering

Hi,

I'm a french student, and i'm trying to make a SHMUP (Shoot Them Up) game !
My project is on a good way, but i still have a problem to activate an
OpenGL double buffer.

I tried many things with the online help of DrScheme and i don't know what's
wrong with my code...

I made a simple example to show you what my code looks like and to get some
help ^^
You can download it here (1,78 Ko) :
http://dl.free.fr/Knxy41PR/trying-gl.rar

Or see it here :

------------------------------------------------------------
(require (lib "sgl.ss" "sgl"))

(define MOUSEX 0)
(define MOUSEY 0)
(define REDX 0) ; Red square X position
(define REDY 0) ; ---------- Y --------
(define Dblack (make-object color% "black"))

(define background (make-object bitmap% "greySqr.jpg" 'jpeg #f)) ;
Background
(define blackSqr (make-object bitmap% "blackSqr.bmp" 'bmp #f)) ; 10*10
pixels full Black
(define redSqr (make-object bitmap% "redSqr.bmp" 'bmp #f))        ;
----------------- Red

(define glTest (new gl-config%)) ; Gl-config

(define-syntax while ; While
  (syntax-rules ()
    ((while test e1 e2 ...) (do ()
                              ((not test) (void))
                              e1 e2 ...))))

(define frame (new frame%
                   (label "GL TEST")
                   (min-width 300)
                   (min-height 300)
                   (stretchable-width #f)
                   (stretchable-height #f)))

(define vpanel (new vertical-panel%
                    (parent frame)
                    (alignment '(center center))))

(define my-canvas%
  (class canvas%
    (define/override (on-event evt)
      (case (send evt get-event-type)
        ((motion) (set! MOUSEX (send evt get-x))
                  (set! MOUSEY (send evt get-y)))))
    (super-new)))

(define canvas (new my-canvas%
                    (parent vpanel)
                    (style '(border))
                    (min-width 300)
                    (min-height 30)
                    (gl-config glTest) ; Gl-config
                    (paint-callback
                     (lambda (obj dc)
                       (send dc get-gl-context)
                       (send dc draw-bitmap
                             background
                             0
                             0
                             'solid
                             Dblack
                             #f)
                       (send dc draw-bitmap
                             blackSqr
                             (- MOUSEX 5)
                             (- MOUSEY 5)
                             'solid
                             Dblack
                             #f)
                       (send dc draw-bitmap
                             redSqr
                             REDX
                             REDY
                             'solid
                             Dblack
                             #f)
                       ))))

(define Refresh (thread (lambda()
                          (while #t
                            (sleep 0.01)
                            (set! REDX (+ REDX 1))
                            (set! REDY (+ REDY 1))
                            (send canvas refresh)))))

(send frame show #t)
------------------------------------------------------------

Thanks !
Jonathan.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20070317/889113c3/attachment.html>