diff --git a/collects/games/gl-board-game/gl-board.rkt b/collects/games/gl-board-game/gl-board.rkt index a7ac2f83d1..473352200c 100644 --- a/collects/games/gl-board-game/gl-board.rkt +++ b/collects/games/gl-board-game/gl-board.rkt @@ -427,15 +427,14 @@ (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))) + (super-new (style '(gl no-autoclear)) (gl-config cfg))) (unless (send (get-dc) get-gl-context) (message-box "Error" (format (string-append "~a 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.") + " the OpenGL context. Maybe OpenGL is not supported by" + " the current display.") who) #f '(ok stop)) diff --git a/collects/games/jewel/jewel.scm b/collects/games/jewel/jewel.scm index b976b0d3c2..58d630670f 100644 --- a/collects/games/jewel/jewel.scm +++ b/collects/games/jewel/jewel.scm @@ -310,15 +310,14 @@ (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))) + (super-new (style '(gl no-autoclear)) (gl-config cfg))) (inherit get-dc) (unless (send (get-dc) get-gl-context) (message-box "Error" (string-append "Jewel 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.") + " the OpenGL context. Maybe OpenGL is not supported by" + " the current display.") #f '(ok stop)) (exit)) diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 0f84f0ade3..5d82ff9d75 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -17,6 +17,7 @@ "client-window.rkt" "widget.rkt" "dc.rkt" + "gl-context.rkt" "combo.rkt" "pixbuf.rkt" "gcwin.rkt") @@ -186,7 +187,7 @@ x y w h style [ignored-name #f] - [gl-conf #f]) + [gl-config #f]) (inherit get-gtk set-size get-size get-client-size on-size get-top-win @@ -286,6 +287,9 @@ (define dc (new dc% [canvas this])) + (when (memq 'gl style) + (prepare-widget-gl-context client-gtk gl-config)) + (gtk_widget_realize gtk) (gtk_widget_realize client-gtk) @@ -337,9 +341,6 @@ (define/override (get-client-gtk) client-gtk) (define/override (handles-events? gtk) (not (ptr-equal? gtk combo-button-gtk))) - (define gl-config gl-conf) - (define/public (get-gl-config) gl-config) - (define/override (get-client-delta) (values margin margin)) diff --git a/collects/mred/private/wx/gtk/dc.rkt b/collects/mred/private/wx/gtk/dc.rkt index e6421f3b47..a3c410c99b 100644 --- a/collects/mred/private/wx/gtk/dc.rkt +++ b/collects/mred/private/wx/gtk/dc.rkt @@ -86,9 +86,9 @@ (define gl #f) (define/override (get-gl-context) (or gl - (create-widget-gl-context - (send canvas get-client-gtk) - (send canvas get-gl-config)))) + (let ([v (create-widget-gl-context (send canvas get-client-gtk))]) + (when v (set! gl v)) + v))) (define/override (make-backing-bitmap w h) (cond diff --git a/collects/mred/private/wx/gtk/gl-context.rkt b/collects/mred/private/wx/gtk/gl-context.rkt index 0ef54f59f3..e310c6871a 100644 --- a/collects/mred/private/wx/gtk/gl-context.rkt +++ b/collects/mred/private/wx/gtk/gl-context.rkt @@ -7,7 +7,8 @@ "types.rkt" "utils.rkt") -(provide create-widget-gl-context) +(provide prepare-widget-gl-context + create-widget-gl-context) (define gdkglext-lib (ffi-lib "libgdkglext-x11-1.0" '("0"))) @@ -30,6 +31,7 @@ (define-gtkglext gdk_gl_config_new (_fun (_list i _int) -> (_or-null _GdkGLConfig))) (define-gtkglext gdk_gl_config_new_for_screen (_fun _GdkScreen (_list i _int) -> (_or-null _GdkGLConfig))) + (define-gtk gtk_widget_get_screen (_fun _GtkWidget -> _GdkScreen)) (define-gtkglext gtk_widget_set_gl_capability (_fun _GtkWidget @@ -73,18 +75,20 @@ ;; ---------------------------------------- (define (config->GdkGLConfig d conf) - (gdk_gl_config_new_for_screen d - (list GDK_GL_USE_GL 1 - GDK_GL_DOUBLEBUFFER (if (send conf get-double-buffered) 1 0) - GDK_GL_STEREO (if (send conf get-stereo) 1 0) - GDK_GL_DEPTH_SIZE (send conf get-depth-size) - GDK_GL_STENCIL_SIZE (send conf get-stencil-size) - GDK_GL_ACCUM_RED_SIZE (send conf get-accum-size) - GDK_GL_ACCUM_GREEN_SIZE (send conf get-accum-size) - GDK_GL_ACCUM_BLUE_SIZE (send conf get-accum-size) - GDK_GL_ACCUM_ALPHA_SIZE (send conf get-accum-size) - GDK_GL_SAMPLES (send conf get-multisample-size) - GDK_GL_ATTRIB_LIST_NONE 0))) + (gdk_gl_config_new (append + (list GDK_GL_RGBA) + (if (send conf get-double-buffered) (list GDK_GL_DOUBLEBUFFER) null) + (if (send conf get-stereo) (list GDK_GL_STEREO) null) + (list + GDK_GL_DEPTH_SIZE (send conf get-depth-size) + GDK_GL_STENCIL_SIZE (send conf get-stencil-size) + GDK_GL_ACCUM_RED_SIZE (send conf get-accum-size) + GDK_GL_ACCUM_GREEN_SIZE (send conf get-accum-size) + GDK_GL_ACCUM_BLUE_SIZE (send conf get-accum-size) + GDK_GL_ACCUM_ALPHA_SIZE (send conf get-accum-size)) + #; + (list GDK_GL_SAMPLES (send conf get-multisample-size)) + (list GDK_GL_ATTRIB_LIST_NONE)))) ;; ---------------------------------------- @@ -96,7 +100,7 @@ (define/override (draw:do-call-as-current t) (dynamic-wind (lambda () - (gdk_gl_drawable_gl_begin gl drawable)) + (gdk_gl_drawable_gl_begin drawable gl)) t (lambda () (gdk_gl_drawable_gl_end drawable)))) @@ -114,19 +118,23 @@ (set! inited? #t) (gdk_gl_init 0 #f))) -(define (create-widget-gl-context gtk config) +(define (prepare-widget-gl-context gtk config) (init!) - (let ([config (config->GdkGLConfig (gtk_widget_get_screen gtk) + (let ([config (config->GdkGLConfig #f ; (gtk_widget_get_screen gtk) (or config (new gl-config%)))]) - (and config - (gtk_widget_set_gl_capability gtk - config - #f - #t - #f) - (let ([gl (gtk_widget_get_gl_context gtk)]) - (and gl - (new gl-context% - [gl gl] - [drawable (gtk_widget_get_gl_window gtk)])))))) + (when config + (gtk_widget_set_gl_capability gtk + config + #f + #t + 0)))) + +(define (create-widget-gl-context gtk) + (init!) + (let ([gl (gtk_widget_get_gl_context gtk)]) + (and gl + (new gl-context% + [gl gl] + [drawable (gtk_widget_get_gl_window gtk)])))) + diff --git a/collects/racket/draw/gl-config.rkt b/collects/racket/draw/gl-config.rkt index ec79cfbe27..5ab3971435 100644 --- a/collects/racket/draw/gl-config.rkt +++ b/collects/racket/draw/gl-config.rkt @@ -11,7 +11,7 @@ (define/public (get-double-buffered) double-buffered?) (define/public (set-double-buffered v) (set! double-buffered? (and v #t))) - (define stereo? #t) + (define stereo? #f) (define/public (get-stereo) stereo?) (define/public (set-stereo v) (set! stereo? (and v #t))) diff --git a/collects/racket/draw/gl-context.rkt b/collects/racket/draw/gl-context.rkt index cb9da20e6f..0863b64ac0 100644 --- a/collects/racket/draw/gl-context.rkt +++ b/collects/racket/draw/gl-context.rkt @@ -19,7 +19,7 @@ ;; Implemented by subclasses: (defclass gl-context% object% (define lock-thread #f) - (define lock (make-semaphore)) + (define lock (make-semaphore 1)) (define/private (with-gl-lock t) (if (eq? lock-thread (current-thread))