From 747f2e628bc7e2b7eefe5f37aaa1cdfdbed2d6ff Mon Sep 17 00:00:00 2001
From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Sat, 25 Feb 2017 19:33:31 -0700
Subject: [PATCH] gl: Use bytevectors instead of strings.

---
 src/gl/gl-glx.scm   |  5 ++--
 src/gl/gl-tests.scm |  2 +-
 src/gl/gl.scm       | 58 +++++++++++++++++++++------------------------
 src/gl/glxgears.scm | 30 ++++++++++++-----------
 4 files changed, 47 insertions(+), 48 deletions(-)

diff --git a/src/gl/gl-glx.scm b/src/gl/gl-glx.scm
index da09426aa..480d016f2 100644
--- a/src/gl/gl-glx.scm
+++ b/src/gl/gl-glx.scm
@@ -175,7 +175,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	 (i 0 (fix:1+ i)))
 	((fix:= i len))
       (let ((attrib (car attribs)))
-	(guarantee-integer attrib 'make-attribs)
+	(guarantee integer? attrib 'make-attribs)
 	((ucode-primitive c-poke-int 3)
 	 alien
 	 (fix:* i (C-sizeof "int"))
@@ -198,7 +198,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	  (let* ((gerror (C-> gerror* "* GError"))
 		 (message
 		  (or (and (not (alien-null? gerror))
-			   (c-peek-cstring (C-> gerror "GError message")))
+			   (utf8->string
+			    (c-peek-cstring (C-> gerror "GError message"))))
 		      "GError pointer not set.")))
 	    (gerror-pointer-free gerror*)
 	    (error message))))))
diff --git a/src/gl/gl-tests.scm b/src/gl/gl-tests.scm
index 190de6c31..db98df78e 100644
--- a/src/gl/gl-tests.scm
+++ b/src/gl/gl-tests.scm
@@ -44,6 +44,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	       (map (lambda (elt)
 		      (let ((alien (weak-car elt)))
 			(if (eq? 'uchar (alien/ctype alien))
-			    (c-peek-cstring alien)
+			    (utf8->string (c-peek-cstring alien))
 			    alien)))
 		    (access malloced-aliens ffi))))))
\ No newline at end of file
diff --git a/src/gl/gl.scm b/src/gl/gl.scm
index f0451368a..741172717 100644
--- a/src/gl/gl.scm
+++ b/src/gl/gl.scm
@@ -156,9 +156,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gl:scale kx ky kz)
   (guarantee-current 'GL:SCALE)
-  (guarantee-flonum kx 'GL:SCALE)
-  (guarantee-flonum ky 'GL:SCALE)
-  (guarantee-flonum kz 'GL:SCALE)
+  (guarantee flo:flonum? kx 'GL:SCALE)
+  (guarantee flo:flonum? ky 'GL:SCALE)
+  (guarantee flo:flonum? kz 'GL:SCALE)
   (C-call "glScaled" kx ky kz))
 
 (define (gl:begin mode)
@@ -193,7 +193,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gl:call-list lst)
   (guarantee-current 'GL:CALL-LIST)
-  (guarantee-integer lst 'GL:CALL-LIST)
+  (guarantee integer? lst 'GL:CALL-LIST)
   (C-call "glCallList" lst))
 
 (define (gl:draw-buffer buffer)
@@ -206,17 +206,17 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gl:frustum left right bottom top near-val far-val)
   (guarantee-current 'GL:DRAW-BUFFER)
-  (guarantee-flonum left 'GL:DRAW-BUFFER)
-  (guarantee-flonum right 'GL:DRAW-BUFFER)
-  (guarantee-flonum bottom 'GL:DRAW-BUFFER)
-  (guarantee-flonum top 'GL:DRAW-BUFFER)
-  (guarantee-flonum near-val 'GL:DRAW-BUFFER)
-  (guarantee-flonum far-val 'GL:DRAW-BUFFER)
+  (guarantee flo:flonum? left 'GL:DRAW-BUFFER)
+  (guarantee flo:flonum? right 'GL:DRAW-BUFFER)
+  (guarantee flo:flonum? bottom 'GL:DRAW-BUFFER)
+  (guarantee flo:flonum? top 'GL:DRAW-BUFFER)
+  (guarantee flo:flonum? near-val 'GL:DRAW-BUFFER)
+  (guarantee flo:flonum? far-val 'GL:DRAW-BUFFER)
   (C-call "glFrustum" left right bottom top near-val far-val))
 
 (define (gl:gen-lists range)
   (guarantee-current 'GL:GEN-LISTS)
-  (guarantee-integer range 'GL:GEN-LISTS)
+  (guarantee integer? range 'GL:GEN-LISTS)
   (C-call "glGenLists" range))
 
 (define (gl:light light param values)
@@ -251,7 +251,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (gl:light-model param value)
   (case param
     ((LOCAL-VIEWER)
-     (guarantee-flonum value 'gl:light-model)
+     (guarantee flo:flonum? value 'gl:light-model)
      (C-call "glLightModelf" (C-enum "GL_LIGHT_MODEL_LOCAL_VIEWER") value))
     ((COLOR-CONTROL)
      (C-call "glLightModeli" (C-enum "GL_LIGHT_MODEL_COLOR_CONTROL")
@@ -260,7 +260,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	       ((SINGLE-COLOR) (C-enum "GL_SINGLE_COLOR"))
 	       (else (error "gl:light-model: Unknown color-control:" value)))))
     ((TWO-SIDE)
-     (guarantee-flonum value 'gl:light-model)
+     (guarantee flo:flonum? value 'gl:light-model)
      (C-call "glLightModelf" (C-enum "GL_LIGHT_MODEL_TWO_SIDE") value))
     ((AMBIENT)
      (guarantee-4d value 'gl:light-model)
@@ -290,7 +290,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	     (guarantee-4d values 'GL:MATERIAL)
 	     (C-enum "GL_EMISSION"))
 	    ((SHININESS)
-	     (guarantee-flonum values 'GL:MATERIAL)
+	     (guarantee flo:flonum? values 'GL:MATERIAL)
 	     (C-enum "GL_SHININESS"))
 	    ((AMBIENT-AND-DIFFUSE)
 	     (guarantee-4d values 'GL:MATERIAL)
@@ -311,7 +311,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gl:new-list lst mode)
   (guarantee-current 'GL:NEW-LIST)
-  (guarantee-integer lst 'GL:NEW-LIST)
+  (guarantee integer? lst 'GL:NEW-LIST)
   (C-call "glNewList"
 	  lst
 	  (case mode
@@ -323,8 +323,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gl:delete-lists lst range)
   (guarantee-current 'GL:DELETE-LISTS)
-  (guarantee-integer lst 'GL:DELETE-LISTS)
-  (guarantee-integer range 'GL:DELETE-LISTS)
+  (guarantee integer? lst 'GL:DELETE-LISTS)
+  (guarantee integer? range 'GL:DELETE-LISTS)
   (C-call "glDeleteLists" lst range))
 
 (define (gl:normal 3d)
@@ -342,24 +342,24 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gl:rotate angle x y z)
   (guarantee-current 'GL:ROTATE)
-  (guarantee-flonum x 'GL:ROTATE)
-  (guarantee-flonum y 'GL:ROTATE)
-  (guarantee-flonum z 'GL:ROTATE)
+  (guarantee flo:flonum? x 'GL:ROTATE)
+  (guarantee flo:flonum? y 'GL:ROTATE)
+  (guarantee flo:flonum? z 'GL:ROTATE)
   (C-call "glRotated" angle x y z))
 
 (define (gl:translate x y z)
   (guarantee-current 'GL:TRANSLATE)
-  (guarantee-flonum x 'GL:TRANSLATE)
-  (guarantee-flonum y 'GL:TRANSLATE)
-  (guarantee-flonum z 'GL:TRANSLATE)
+  (guarantee flo:flonum? x 'GL:TRANSLATE)
+  (guarantee flo:flonum? y 'GL:TRANSLATE)
+  (guarantee flo:flonum? z 'GL:TRANSLATE)
   (C-call "glTranslated" x y z))
 
 (define (gl:viewport x y width height)
   (guarantee-current 'GL:VIEWPORT)
-  (guarantee-integer x 'GL:VIEWPORT)
-  (guarantee-integer y 'GL:VIEWPORT)
-  (guarantee-integer width 'GL:VIEWPORT)
-  (guarantee-integer height 'GL:VIEWPORT)
+  (guarantee integer? x 'GL:VIEWPORT)
+  (guarantee integer? y 'GL:VIEWPORT)
+  (guarantee integer? width 'GL:VIEWPORT)
+  (guarantee integer? height 'GL:VIEWPORT)
   (C-call "glViewport" x y width height))
 
 (define (gl:flush)
@@ -396,10 +396,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (if (not (param:gl-context-current?))
       (error "The GL library has no context:" operator)))
 
-(define (guarantee-flonum object operator)
-  (if (not (flo:flonum? object))
-      (error:wrong-type-argument object "a flonum" operator)))
-
 (define (guarantee-color object operator)
   (if (not (and (flo:flonum? object)
 		(fix:= 4 (flo:vector-length object))))
diff --git a/src/gl/glxgears.scm b/src/gl/glxgears.scm
index 26296407f..acd43c7e7 100644
--- a/src/gl/glxgears.scm
+++ b/src/gl/glxgears.scm
@@ -676,9 +676,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 		      (cadr entry)
 		      (error "Display not specified."))
 		  0)))
-	   (dpy (C-call "XOpenDisplay" (make-alien '|Display|) dpyName)))
+	   (dpy (C-call "XOpenDisplay" (make-alien '|Display|)
+			(if (string? dpyName) (string->utf8 dpyName) 0))))
       (if (alien-null? dpy)
-	  (error "couldn't open display:" (if (zero? dpyName) "" dpyName)))
+	  (error "couldn't open display:" (if (string? dpyName) dpyName "")))
 
       (if fullscreen
 	  (let ((scrnum (C-call "DefaultScreen" dpy)))
@@ -754,18 +755,19 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define c-poke-int (make-primitive-procedure 'C-POKE-INT 3))
 
 (define (get-string symbol)
-  (c-peek-cstring
-   (case symbol
-     ((renderer)
-      (C-call "glGetString" (make-alien 'char) (C-enum "GL_RENDERER")))
-     ((version)
-      (C-call "glGetString" (make-alien 'char) (C-enum "GL_VERSION")))
-     ((vendor)
-      (C-call "glGetString" (make-alien 'char) (C-enum "GL_VENDOR")))
-     ((extensions)
-      (C-call "glGetString" (make-alien 'char) (C-enum "GL_EXTENSIONS")))
-     (else
-      (error "Unknown gl String:" symbol)))))
+  (utf8->string
+   (c-peek-cstring
+    (case symbol
+      ((renderer)
+       (C-call "glGetString" (make-alien 'char) (C-enum "GL_RENDERER")))
+      ((version)
+       (C-call "glGetString" (make-alien 'char) (C-enum "GL_VERSION")))
+      ((vendor)
+       (C-call "glGetString" (make-alien 'char) (C-enum "GL_VENDOR")))
+      ((extensions)
+       (C-call "glGetString" (make-alien 'char) (C-enum "GL_EXTENSIONS")))
+      (else
+       (error "Unknown gl String:" symbol))))))
 
 (define %trace? #f)
 
-- 
2.25.1