gtk: more gl

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 OpenGL context. Maybe OpenGL is not supported by" 
-			      " the current display, or it was disabled when PLT Scheme was"
+			      " the current display.")
-			      " configured and compiled.")
 			     who)
 		     #f
 		     '(ok stop))

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 OpenGL context. Maybe OpenGL is not supported by" 
-				    " the current display, or it was disabled when PLT Scheme was"
+				    " the current display.")
-				    " configured and compiled.")
 		     #f
 		     '(ok stop))
 	(exit))

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))
 

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
+          (let ([v (create-widget-gl-context (send canvas get-client-gtk))])
-           (send canvas get-client-gtk)
+	    (when v (set! gl v))
-           (send canvas get-gl-config))))
+	    v)))
 
     (define/override (make-backing-bitmap w h)
       (cond

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
+  (gdk_gl_config_new (append
-                                (list GDK_GL_USE_GL 1
+		      (list GDK_GL_RGBA)
-                                      GDK_GL_DOUBLEBUFFER (if (send conf get-double-buffered) 1 0)
+		      (if (send conf get-double-buffered) (list GDK_GL_DOUBLEBUFFER) null)
-                                      GDK_GL_STEREO (if (send conf get-stereo) 1 0)
+		      (if (send conf get-stereo) (list GDK_GL_STEREO) null)
-                                      GDK_GL_DEPTH_SIZE (send conf get-depth-size)
+		      (list
-                                      GDK_GL_STENCIL_SIZE (send conf get-stencil-size)
+		       GDK_GL_DEPTH_SIZE (send conf get-depth-size)
-                                      GDK_GL_ACCUM_RED_SIZE (send conf get-accum-size)
+		       GDK_GL_STENCIL_SIZE (send conf get-stencil-size)
-                                      GDK_GL_ACCUM_GREEN_SIZE (send conf get-accum-size)
+		       GDK_GL_ACCUM_RED_SIZE (send conf get-accum-size)
-                                      GDK_GL_ACCUM_BLUE_SIZE (send conf get-accum-size)
+		       GDK_GL_ACCUM_GREEN_SIZE (send conf get-accum-size)
-                                      GDK_GL_ACCUM_ALPHA_SIZE (send conf get-accum-size)
+		       GDK_GL_ACCUM_BLUE_SIZE (send conf get-accum-size)
-                                      GDK_GL_SAMPLES (send conf get-multisample-size)
+		       GDK_GL_ACCUM_ALPHA_SIZE (send conf get-accum-size))
-                                      GDK_GL_ATTRIB_LIST_NONE 0)))
+		      #;
+		      (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
+    (when config
-         (gtk_widget_set_gl_capability gtk
+	  (gtk_widget_set_gl_capability gtk
-                                       config
+					config
-                                       #f
+					#f
-                                       #t
+					#t
-                                       #f)
+					0))))
-         (let ([gl (gtk_widget_get_gl_context gtk)])
+
-           (and gl
+(define (create-widget-gl-context gtk)
-              (new gl-context% 
+  (init!)
-                   [gl gl]
+  (let ([gl (gtk_widget_get_gl_context gtk)])
-                   [drawable (gtk_widget_get_gl_window gtk)]))))))
+    (and gl
+	 (new gl-context% 
+	      [gl gl]
+	      [drawable (gtk_widget_get_gl_window gtk)]))))
+

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)))
 

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))