gl: Replace public with-gl-library with internal with-gl-context.

A mutex cannot be grabbed in Gtk draw callbacks because they cannot
suspend.  If ALL GL calls are made in Gtk callbacks, serial use of the
library is assured.  To ensure that the library is not used without a
current context, a parameter is used instead.

diff --git a/src/gl/gl-glx.scm b/src/gl/gl-glx.scm
index a00d62955bc0b5d284ffb06e66995e6b06a569bb..bf4b1851f439fe1bfb8d164e028cea09521737ae 100644 (file)
--- a/src/gl/gl-glx.scm
+++ b/src/gl/gl-glx.scm
@@ -27,17 +27,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (C-include "gl")
 
 (define (with-glx-widget widget thunk)
-  (with-gl-library
-   (lambda ()
-     (let ((xdisplay (glx-widget-xdisplay widget))
-          (xwindow (glx-widget-xwindow widget))
-          (glxcontext (glx-widget-glxcontext widget)))
-       (if (zero? (C-call "glXMakeCurrent" xdisplay xwindow glxcontext))
-          (error "glXMakeCurrent failed"))
-       (let ((value (thunk)))
-        (if (zero? (C-call "glXMakeCurrent" xdisplay (C-enum "None") 0))
-            (error "glXMakeCurrent NULL failed"))
-        value)))))
+  (let ((xdisplay (glx-widget-xdisplay widget))
+       (xwindow (glx-widget-xwindow widget))
+       (glxcontext (glx-widget-glxcontext widget)))
+    (if (zero? (C-call "glXMakeCurrent" xdisplay xwindow glxcontext))
+       (error "glXMakeCurrent failed"))
+    (let ((value (with-gl-context thunk)))
+      (if (zero? (C-call "glXMakeCurrent" xdisplay (C-enum "None") 0))
+         (error "glXMakeCurrent NULL failed"))
+      value)))
 
 (define (glx:swap-buffers widget)
   (let ((xdisplay (glx-widget-xdisplay widget))

diff --git a/src/gl/gl.scm b/src/gl/gl.scm
index d30f3526965ec1df7c038dc1464bcc0f812eb72f..06468944c193b155b07b0d06eba4f74e3e9cb55e 100644 (file)
--- a/src/gl/gl.scm
+++ b/src/gl/gl.scm
@@ -374,10 +374,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (guarantee-current 'GL:PERSPECTIVE)
   (C-call "gluPerspective" fovy aspect z-near z-far))
 \f
-(define gl-library-mutex)
+(define param:gl-context-current?)
 
 (define (init)
-  (set! gl-library-mutex (make-thread-mutex)))
+  (set! param:gl-context-current? (make-parameter #f)))
 
 (define (initialize-package!)
   (init)
@@ -386,13 +386,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (reset-gl)
   (init))
 
-(define (with-gl-library thunk)
-  (with-thread-mutex-lock gl-library-mutex thunk))
+(define (with-gl-context thunk)
+  (if (param:gl-context-current?)
+      (error "The GL library already has a context."))
+  (parameterize ((param:gl-context-current? #t))
+    (thunk)))
 
 (define (guarantee-current operator)
-  (if (not (eq? (current-thread)
-               (thread-mutex-owner gl-library-mutex)))
-      (error "The GL library has not been locked:" operator)))
+  (if (not (param:gl-context-current?))
+      (error "The GL library has no context:" operator)))
 
 (define (guarantee-flonum object operator)
   (if (not (flo:flonum? object))

diff --git a/src/gl/glxgears.pkg b/src/gl/glxgears.pkg
index a21fa95a9757f5dcc5114c33cddd9d45f89c3e90..c534d42c14cabe12a9b1531b7661bff4bcf79265 100644 (file)
--- a/src/gl/glxgears.pkg
+++ b/src/gl/glxgears.pkg
@@ -29,4 +29,4 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (files "glxgears")
   (parent (gl))
   (import (gl internals)
-         with-gl-library))
\ No newline at end of file
+         with-gl-context))
\ No newline at end of file

diff --git a/src/gl/glxgears.scm b/src/gl/glxgears.scm
index a659b65bd36346bf6abd661a249320129607a557..3da8eef916ac1dbe01965bd921532324bcc144d1 100644 (file)
--- a/src/gl/glxgears.scm
+++ b/src/gl/glxgears.scm
@@ -693,7 +693,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (%trace ";XMapWindow\n")
        (C-call "XMapWindow" dpy win)
 
-       (with-gl-library
+       (with-gl-context
         (lambda ()
           (%trace ";glXMakeCurrent\n")
           (C-call "glXMakeCurrent" dpy win ctx)