[plt-scheme] SGL app flashes when it changes canvases

From: Ben Goetter (goetter at mazama.net)
Date: Sun Nov 2 04:50:47 EST 2008

Environment: 4.1.2 [3m], Windows XP (and Vista), various GPUs

When the following application changes canvases (on any mouse 
button-down or -up), its window flashes white or partly-white briefly, 
despite my best efforts via change-children.   How can I prevent it from 
flashing so?

(The obvious solution is never to change canvases.  This is a greatly 
distilled version of a larger application that keeps very different UI 
logic in its two canvases.  I would prefer to maintain that structure if 
I can.)

Thanks for your time,

---this is flashbug.ss---

#lang scheme/gui
(require sgl)

(define my-frame%
  (class* frame% ()
    (define/augment (on-close)
      (when a-canvas
    (send a-canvas cleanup))
      (when b-canvas
    (send b-canvas cleanup))
      (inner (void) on-close))

    (define/public (change-state)
       (lambda ()
     (if (or (not current-canvas) (not (eq? current-canvas a-canvas)))

    (super-instantiate ("sgl flashing bug") )

(define my-canvas%
  (class* canvas% ()
    (inherit with-gl-context swap-gl-buffers get-top-level-window refresh)

    (define/override (on-paint)
       (lambda ()
     (gl-matrix-mode 'modelview)
     (gl-matrix-mode 'projection)
     (gl-ortho 0 1 0 1 -1 1)
     (gl-depth-mask #f)
     (gl-shade-model 'smooth)
     (gl-polygon-mode 'front 'fill)
     (gl-begin 'quads)
     (gl-color (/ 199.0 255.0) (/ 199.0 255.0) (/ 219.0 255.0))
     (gl-vertex 0 0 0)
     (gl-vertex 1 0 0)
     (gl-color (/ 48.0 255.0) (/ 48.0 255.0) (/ 48.0 255.0))
     (gl-vertex 1 1 0)
     (gl-vertex 0 1 0)
     (gl-depth-mask #t)
     (gl-matrix-mode 'modelview)
     (swap-gl-buffers) )) )

    (define/override (on-size w h)
       (lambda ()
     (gl-viewport 0 0 w h))))

    (define/public (cleanup)
      (queue-callback (lambda () (send this shake-heap)) #f) )

    (define/public (shake-heap)
      (with-gl-context collect-garbage))

    (define/override (on-event e)
      (when (send e button-changed?)
    (send (get-top-level-window) change-state)))

    (super-instantiate ()
               (style '(gl no-autoclear))
               (min-width 600) (min-height 600))

(define a-canvas #f)
(define b-canvas #f)
(define current-canvas #f)

(define f (instantiate my-frame% () ))

(define (setup-a-canvas)
  (send f begin-container-sequence)
  (unless a-canvas
    (set! a-canvas (instantiate my-canvas% (f)  )))
  (send f change-children (lambda (k) (list a-canvas)))
  (set! current-canvas a-canvas)
  (send f end-container-sequence)
;;   (when b-canvas
;;     (send b-canvas cleanup)
;;     (set! b-canvas #f))

(define (setup-b-canvas)
  (send f begin-container-sequence)
  (unless b-canvas
    (set! b-canvas (instantiate my-canvas% (f)  )))
  (send f change-children (lambda (k) (list b-canvas)))
  (set! current-canvas b-canvas)
  (send f end-container-sequence)
;;   (when a-canvas
;;     (send a-canvas cleanup)
;;     (set! a-canvas #f))

(send f show #t)

---end of flashbug.ss---

Posted on the users mailing list.