suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gtk: fix gl canvas painting

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-13 17:45:03 -06:00
parent 3d9f52a4d1
commit bc509c86cd
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -287,7 +287,8 @@
(define dc (new dc% [canvas this])) (define dc (new dc% [canvas this]))
(when (memq 'gl style) (define for-gl? (memq 'gl style))
(when for-gl?
(prepare-widget-gl-context client-gtk gl-config)) (prepare-widget-gl-context client-gtk gl-config))
(gtk_widget_realize gtk) (gtk_widget_realize gtk)
@ -355,12 +356,14 @@
(queue-window-refresh-event this thunk)) (queue-window-refresh-event this thunk))
(define/public (paint-or-queue-paint) (define/public (paint-or-queue-paint)
(or (do-backing-flush this dc (if is-combo? (if for-gl?
(get-subwindow client-gtk) (queue-paint)
(widget-window client-gtk))) (or (do-backing-flush this dc (if is-combo?
(begin (get-subwindow client-gtk)
(queue-paint) (widget-window client-gtk)))
#f))) (begin
(queue-paint)
#f))))
(define/public (on-paint) (void)) (define/public (on-paint) (void))
@ -376,7 +379,8 @@
(define/public (queue-backing-flush) (define/public (queue-backing-flush)
;; called atomically (not expecting exceptions) ;; called atomically (not expecting exceptions)
(gtk_widget_queue_draw client-gtk)) (unless for-gl?
(gtk_widget_queue_draw client-gtk)))
(define/override (reset-child-dcs) (define/override (reset-child-dcs)
(when (dc . is-a? . dc%) (when (dc . is-a? . dc%)