[plt-scheme] Re: gl-config% - Double buffering
Your canvas calls draw-it when it expects the content to be painted,
(e.g. when the refresh thread requires it or when the window
containing the canvas is resized.) When you do gl commands in draw-
it, the environment will apply the commands to the right place. I
don't think you want to (or are permitted to) send more messages to
canvas from in there.
Hopefully I am not confusing you. I am not familiar with the higher
level drawing capabilities such as the ones you are trying to use in
draw-it.
rac
On Mar 17, 2007, at 6:49 AM, tfnood at gmail.com wrote:
> 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
>
> _________________________________________________
> For list-related administrative tasks:
> http://list.cs.brown.edu/mailman/listinfo/plt-scheme
![[logo]](/logo.png){kind=logo}
