From cb06a58d371172b974ead9428730cc73021451d0 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sat, 30 Apr 2016 13:35:34 -0700
Subject: [PATCH] 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.
---
 src/gl/gl-glx.scm   | 20 +++++++++-----------
 src/gl/gl.scm       | 16 +++++++++-------
 src/gl/glxgears.pkg |  2 +-
 src/gl/glxgears.scm |  2 +-
 4 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/src/gl/gl-glx.scm b/src/gl/gl-glx.scm
index a00d62955..bf4b1851f 100644
--- 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 d30f35269..06468944c 100644
--- 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))
 
-(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 a21fa95a9..c534d42c1 100644
--- 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 a659b65bd..3da8eef91 100644
--- 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)
-- 
2.25.1