summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/buffer.scm116
1 files changed, 59 insertions, 57 deletions
diff --git a/chickadee/graphics/buffer.scm b/chickadee/graphics/buffer.scm
index fb66d84..315d988 100644
--- a/chickadee/graphics/buffer.scm
+++ b/chickadee/graphics/buffer.scm
@@ -163,9 +163,11 @@
(eq? (buffer-target buffer) 'index))
(define (buffer-usage-gl buffer)
- (match (buffer-usage buffer)
- ('static (version-1-5 static-draw))
- ('stream (version-1-5 stream-draw))))
+ (case (buffer-usage buffer)
+ ((static)
+ (version-1-5 static-draw))
+ ((stream)
+ (version-1-5 stream-draw))))
(define (buffer-target-gl buffer)
(if (index-buffer? buffer)
@@ -298,24 +300,24 @@ resized."
;;;
(define (type-size type)
- (match type
- ('scalar 1)
- ('vec2 2)
- ('vec3 3)
- ((or 'color 'vec4 'mat2) 4)
- ('mat3 9)
- ('mat4 16)))
+ (case type
+ ((scalar) 1)
+ ((vec2) 2)
+ ((vec3) 3)
+ ((color vec4 mat2) 4)
+ ((mat3) 9)
+ ((mat4) 16)))
(define (component-type-size component-type)
- (match component-type
- ('byte 1)
- ('unsigned-byte 1)
- ('short 2)
- ('unsigned-short 2)
- ('int 4)
- ('unsigned-int 4)
- ('float 4)
- ('double 8)))
+ (case component-type
+ ((byte) 1)
+ ((unsigned-byte) 1)
+ ((short) 2)
+ ((unsigned-short) 2)
+ ((int) 4)
+ ((unsigned-int) 4)
+ ((float) 4)
+ ((double) 8)))
(define-record-type <vertex-attribute>
(%make-vertex-attribute name buffer offset offset-pointer component-type
@@ -409,15 +411,15 @@ element is used for 2 instances, and so on."
(buffer-data (vertex-attribute->buffer vertex-attribute)))
(define (vertex-attribute-type-gl vertex-attribute)
- (match (vertex-attribute-component-type vertex-attribute)
- ('byte (data-type byte))
- ('unsigned-byte (data-type unsigned-byte))
- ('short (data-type short))
- ('unsigned-short (data-type unsigned-short))
- ('int (data-type int))
- ('unsigned-int (data-type unsigned-int))
- ('float (data-type float))
- ('double (data-type double))))
+ (case (vertex-attribute-component-type vertex-attribute)
+ ((byte) (data-type byte))
+ ((unsigned-byte) (data-type unsigned-byte))
+ ((short) (data-type short))
+ ((unsigned-short) (data-type unsigned-short))
+ ((int) (data-type int))
+ ((unsigned-int) (data-type unsigned-int))
+ ((float) (data-type float))
+ ((double) (data-type double))))
(define* (apply-vertex-attribute vertex-attribute #:optional attribute-index)
(with-graphics-state! ((g:buffer (vertex-attribute->buffer vertex-attribute)))
@@ -515,14 +517,14 @@ argument may be overridden. The following values are supported:
array))
(define (vertex-array-mode-gl array)
- (match (vertex-array-mode array)
- ('points (begin-mode points))
- ('lines (begin-mode lines))
- ('line-loop (begin-mode line-loop))
- ('line-strip (begin-mode line-strip))
- ('triangles (begin-mode triangles))
- ('triangle-strip (begin-mode triangle-strip))
- ('triangle-fan (begin-mode triangle-fan))))
+ (case (vertex-array-mode array)
+ ((points) (begin-mode points))
+ ((lines) (begin-mode lines))
+ ((line-loop) (begin-mode line-loop))
+ ((line-strip) (begin-mode line-strip))
+ ((triangles) (begin-mode triangles))
+ ((triangle-strip) (begin-mode triangle-strip))
+ ((triangle-fan) (begin-mode triangle-fan))))
(define (render-vertices array count offset)
(with-graphics-state! ((g:vertex-array array))
@@ -818,36 +820,36 @@ argument may be overridden. The following values are supported:
(define-syntax define-geometry-type
(lambda (stx)
(define (type-size type)
- (match type
- ((or 'float 'int 'unsigned-int) 4)
- ('double 8)
- ('vec2 (* (type-size 'float) 2))
- ('vec3 (* (type-size 'float) 3))
- ('vec4 (* (type-size 'float) 4))))
+ (case type
+ ((float int unsigned-int) 4)
+ ((double) 8)
+ ((vec2) (* (type-size 'float) 2))
+ ((vec3) (* (type-size 'float) 3))
+ ((vec4) (* (type-size 'float) 4))))
(define (type-getter type)
- (match type
- ('float #'bytevector-ieee-single-native-ref)
- ('double #'bytevector-ieee-double-native-ref)
- ('int #'bytevector-s32-native-ref)
- ('unsigned-int #'bytevector-u32-native-ref)))
+ (case type
+ ((float) #'bytevector-ieee-single-native-ref)
+ ((double) #'bytevector-ieee-double-native-ref)
+ ((int) #'bytevector-s32-native-ref)
+ ((unsigned-int) #'bytevector-u32-native-ref)))
(define (type-setter type)
- (match type
- ('float #'bytevector-ieee-single-native-set!)
- ('double #'bytevector-ieee-double-native-set!)
- ('int #'bytevector-s32-native-set!)
- ('unsigned-int #'bytevector-u32-native-set!)))
+ (case type
+ ((float) #'bytevector-ieee-single-native-set!)
+ ((double) #'bytevector-ieee-double-native-set!)
+ ((int) #'bytevector-s32-native-set!)
+ ((unsigned-int) #'bytevector-u32-native-set!)))
(define (expand-attribute name type)
- (match type
- ((or 'float 'int 'unsigned-int)
+ (case type
+ ((float int unsigned-int)
(list (list name type)))
- ('vec2
+ ((vec2)
`((,(symbol-append name ':x) float)
(,(symbol-append name ':y) float)))
- ('vec3
+ ((vec3)
`((,(symbol-append name ':x) float)
(,(symbol-append name ':y) float)
(,(symbol-append name ':z) float)))
- ('vec4
+ ((vec4)
`((,(symbol-append name ':x) float)
(,(symbol-append name ':y) float)
(,(symbol-append name ':z) float)