From: Matt Birkholz Date: Sun, 26 Feb 2017 02:33:31 +0000 (-0700) Subject: gl: Use bytevectors instead of strings. X-Git-Tag: mit-scheme-pucked-9.2.12~210 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=747f2e628bc7e2b7eefe5f37aaa1cdfdbed2d6ff;p=mit-scheme.git gl: Use bytevectors instead of strings. --- 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)