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

From: Richard Cleis (rcleis at mac.com)
Date: Sat Mar 17 00:48:14 EDT 2007

I believe you need to

(inherit swap-gl-buffers
          with-gl-context)

and

(define/override  (on-paint)
    (with-gl-context
     (lambda ()
       (draw-it)
       (swap-gl-buffers))))

The function draw-it is where you can unleash your hounds.

rac


On Mar 16, 2007, at 6:14 PM, Jonathan Thann wrote:

> 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.
> _________________________________________________
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20070316/0f16b35f/attachment.html>

Posted on the users mailing list.