gl: Use bytevectors instead of strings.

diff --git a/src/gl/gl-glx.scm b/src/gl/gl-glx.scm
index da09426aa9bda7fa06d5bacdcf4117d13614d96e..480d016f2911215a97471fae7b0b9adc8b79c02b 100644 (file)
--- 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 190de6c31a7817625896ef34f40f77397a5007c3..db98df78ecaf577737bfada55481297ab8360373 100644 (file)
--- 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 f0451368a54e8f0d0df582b61f2a34f128ca6d3c..7411727173fa2cc55bc4a6b2b74cbadbd75ddb2f 100644 (file)
--- 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 26296407fafa925b92458a6f075651d8920aabb8..acd43c7e711be129b02920403208ff8270987183 100644 (file)
--- 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)