[plt-scheme] SGL app flashes when it changes canvases
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,
Ben
---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)
(queue-callback
(lambda ()
(if (or (not current-canvas) (not (eq? current-canvas a-canvas)))
(setup-a-canvas)
(setup-b-canvas)))
#f))
(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)
(with-gl-context
(lambda ()
(gl-matrix-mode 'modelview)
(gl-push-matrix)
(gl-load-identity)
(gl-matrix-mode 'projection)
(gl-push-matrix)
(gl-load-identity)
(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-end)
(gl-depth-mask #t)
(gl-pop-matrix)
(gl-matrix-mode 'modelview)
(gl-pop-matrix)
(swap-gl-buffers) )) )
(define/override (on-size w h)
(with-gl-context
(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))
)
(setup-a-canvas)
(send f show #t)
---end of flashbug.ss---