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

Thanks for the answer rac,

With your help and the \PLT-369.8\collects\games\jewel\jewel.scm
source, i made a new version but this time, the canvas is scrambled :
http://dl.free.fr/p2n3d2La/GLtest.png

We can sometimes see the red square moving !

Here is the new version : http://dl.free.fr/F4jcRZnT/trying-gl2.rar

Code :
-------------------------------------------
; VERSION 0.2

(require (lib "sgl.ss" "sgl")) ; I don't really know if this is
necessary

(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-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 (draw-it)
  (send (send canvas get-dc) draw-bitmap
        background
        0
        0
        'solid
        Dblack
        #f)
  (send (send canvas get-dc) draw-bitmap
        blackSqr
        (- MOUSEX 5)
        (- MOUSEY 5)
        'solid
        Dblack
        #f)
  (send (send canvas get-dc) draw-bitmap
        redSqr
        REDX
        REDY
        'solid
        Dblack
        #f))

(define my-canvas%
  (class* canvas% ()
    (inherit with-gl-context swap-gl-buffers)

    (define/override (on-event evt)
      (with-gl-context
       (lambda ()
         (case (send evt get-event-type)
           ((motion) (set! MOUSEX (send evt get-x))
                     (set! MOUSEY (send evt get-y)))))))

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

    (let ([cfg (new gl-config%)])
      (send cfg set-multisample-size 4)
      (send cfg set-stencil-size 1)
      (super-new (style '(no-autoclear)) (gl-config cfg)))

    (inherit get-dc)

    (unless (send (get-dc) get-gl-context)
      (message-box "Error"
                   (string-append "GT TEST requires OpenGL, but there
was an error initializing"
                                  " the OpenGL context. Probably
OpenGL is not supported by"
                                  " the current display, or it was
disabled when PLT Scheme was"
                                  " configured and compiled.")
                   #f
                   '(ok stop))
      (exit))))

(define canvas (new my-canvas%
                    (parent vpanel)
                    (min-width 300)
                    (min-height 30)))

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

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

On 17 mar, 05:48, Richard Cleis <rcl... at mac.com> wrote:
> 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
>
>
>
> _________________________________________________
>   For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme