summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/graphics/buffer.scm239
-rw-r--r--chickadee/graphics/mesh.scm28
-rw-r--r--chickadee/graphics/model.scm64
-rw-r--r--chickadee/graphics/skybox.scm12
4 files changed, 170 insertions, 173 deletions
diff --git a/chickadee/graphics/buffer.scm b/chickadee/graphics/buffer.scm
index 42b6286..369ec7b 100644
--- a/chickadee/graphics/buffer.scm
+++ b/chickadee/graphics/buffer.scm
@@ -53,32 +53,17 @@
unmap-buffer!
resize-buffer!
- make-dynamic-buffer
- dynamic-buffer?
- dynamic-buffer->buffer
- dynamic-buffer-data
- dynamic-buffer-capacity
- dynamic-buffer-count
- dynamic-buffer-next!
- dynamic-buffer-clear!
- dynamic-buffer-map!
- dynamic-buffer-unmap!
- dynamic-buffer-import!
-
- make-buffer-view
- buffer-view?
- buffer-view->buffer
- buffer-view-name
- buffer-view-offset
- buffer-view-component-type
- buffer-view-normalized?
- buffer-view-length
- buffer-view-type
- buffer-view-max
- buffer-view-min
- buffer-view-sparse
- buffer-view-data
- buffer-view-divisor
+ make-vertex-attribute
+ vertex-attribute?
+ vertex-attribute->buffer
+ vertex-attribute-name
+ vertex-attribute-offset
+ vertex-attribute-component-type
+ vertex-attribute-normalized?
+ vertex-attribute-length
+ vertex-attribute-type
+ vertex-attribute-data
+ vertex-attribute-divisor
make-vertex-array
vertex-array?
@@ -91,6 +76,18 @@
render-vertices
render-vertices/instanced
+ make-dynamic-buffer
+ dynamic-buffer?
+ dynamic-buffer->buffer
+ dynamic-buffer-data
+ dynamic-buffer-capacity
+ dynamic-buffer-count
+ dynamic-buffer-next!
+ dynamic-buffer-clear!
+ dynamic-buffer-map!
+ dynamic-buffer-unmap!
+ dynamic-buffer-import!
+
define-geometry-type
geometry-type?
geometry-type-attributes
@@ -356,7 +353,7 @@ resized."
;;;
-;;; Buffer Views
+;;; Vertex Attributes
;;;
(define (type-size type)
@@ -379,24 +376,24 @@ resized."
('float 4)
('double 8)))
-(define-record-type <buffer-view>
- (%make-buffer-view name buffer offset offset-pointer component-type
- normalized? length type divisor)
- buffer-view?
- (name buffer-view-name)
- (buffer buffer-view->buffer)
- (offset buffer-view-offset)
- (offset-pointer buffer-view-offset-pointer)
- (component-type buffer-view-component-type)
- (normalized? buffer-view-normalized?)
- (length buffer-view-length)
- (type buffer-view-type)
- (divisor buffer-view-divisor)) ; for instanced rendering
-
-(define (buffer-view-stride buffer-view)
- (or (buffer-stride (buffer-view->buffer buffer-view))
- (* (type-size (buffer-view-type buffer-view))
- (component-type-size (buffer-view-component-type buffer-view)))))
+(define-record-type <vertex-attribute>
+ (%make-vertex-attribute name buffer offset offset-pointer component-type
+ normalized? length type divisor)
+ vertex-attribute?
+ (name vertex-attribute-name)
+ (buffer vertex-attribute->buffer)
+ (offset vertex-attribute-offset)
+ (offset-pointer vertex-attribute-offset-pointer)
+ (component-type vertex-attribute-component-type)
+ (normalized? vertex-attribute-normalized?)
+ (length vertex-attribute-length)
+ (type vertex-attribute-type)
+ (divisor vertex-attribute-divisor)) ; for instanced rendering
+
+(define (vertex-attribute-stride vertex-attribute)
+ (or (buffer-stride (vertex-attribute->buffer vertex-attribute))
+ (* (type-size (vertex-attribute-type vertex-attribute))
+ (component-type-size (vertex-attribute-component-type vertex-attribute)))))
(define (num-elements byte-length byte-offset type component-type)
(inexact->exact
@@ -405,18 +402,18 @@ resized."
(* (component-type-size component-type)
(type-size type))))))
-(define* (make-buffer-view #:key
- (name "anonymous")
- buffer
- type
- component-type
- normalized?
- (offset 0)
- (length (num-elements (buffer-length buffer)
- offset
- type
- component-type))
- (divisor 0))
+(define* (make-vertex-attribute #:key
+ (name "anonymous")
+ buffer
+ type
+ component-type
+ normalized?
+ (offset 0)
+ (length (num-elements (buffer-length buffer)
+ offset
+ type
+ component-type))
+ (divisor 0))
"Return a new typed buffer view for BUFFER starting at byte index
OFFSET of LENGTH elements, where each element is of TYPE and composed
of COMPONENT-TYPE values.
@@ -449,29 +446,29 @@ and is used for the data being instanced. A divisor of 1 means that
each element is used for 1 instance. A divisor of 2 means that each
element is used for 2 instances, and so on."
(let ((offset-ptr (make-pointer offset)))
- (%make-buffer-view name buffer offset offset-ptr component-type
- normalized? length type divisor)))
+ (%make-vertex-attribute name buffer offset offset-ptr component-type
+ normalized? length type divisor)))
-(define (display-buffer-view buffer-view port)
- (format port "#<buffer-view name: ~s buffer: ~a type: ~s component-type: ~s length: ~d offset: ~d divisor: ~d>"
- (buffer-view-name buffer-view)
- (buffer-view->buffer buffer-view)
- (buffer-view-type buffer-view)
- (buffer-view-component-type buffer-view)
- (buffer-view-length buffer-view)
- (buffer-view-offset buffer-view)
- (buffer-view-divisor buffer-view)))
+(define (display-vertex-attribute vertex-attribute port)
+ (format port "#<vertex-attribute name: ~s buffer: ~a type: ~s component-type: ~s length: ~d offset: ~d divisor: ~d>"
+ (vertex-attribute-name vertex-attribute)
+ (vertex-attribute->buffer vertex-attribute)
+ (vertex-attribute-type vertex-attribute)
+ (vertex-attribute-component-type vertex-attribute)
+ (vertex-attribute-length vertex-attribute)
+ (vertex-attribute-offset vertex-attribute)
+ (vertex-attribute-divisor vertex-attribute)))
-(set-record-type-printer! <buffer-view> display-buffer-view)
+(set-record-type-printer! <vertex-attribute> display-vertex-attribute)
-(define (buffer-view-type-size buffer-view)
- (type-size (buffer-view-type buffer-view)))
+(define (vertex-attribute-type-size vertex-attribute)
+ (type-size (vertex-attribute-type vertex-attribute)))
-(define (buffer-view-data buffer-view)
- (buffer-data (buffer-view->buffer buffer-view)))
+(define (vertex-attribute-data vertex-attribute)
+ (buffer-data (vertex-attribute->buffer vertex-attribute)))
-(define (buffer-view-type-gl buffer-view)
- (match (buffer-view-component-type buffer-view)
+(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))
@@ -481,19 +478,19 @@ element is used for 2 instances, and so on."
('float (data-type float))
('double (data-type double))))
-(define* (apply-buffer-view buffer-view #:optional attribute-index)
- (with-graphics-state! ((g:buffer (buffer-view->buffer buffer-view)))
+(define* (apply-vertex-attribute vertex-attribute #:optional attribute-index)
+ (with-graphics-state! ((g:buffer (vertex-attribute->buffer vertex-attribute)))
;; If there is no attribute-index, we assume this is being bound for
;; use as an index buffer.
(when attribute-index
(gl-enable-vertex-attrib-array attribute-index)
(gl-vertex-attrib-pointer attribute-index
- (buffer-view-type-size buffer-view)
- (buffer-view-type-gl buffer-view)
- (buffer-view-normalized? buffer-view)
- (buffer-view-stride buffer-view)
- (buffer-view-offset-pointer buffer-view))
- (let ((divisor (buffer-view-divisor buffer-view)))
+ (vertex-attribute-type-size vertex-attribute)
+ (vertex-attribute-type-gl vertex-attribute)
+ (vertex-attribute-normalized? vertex-attribute)
+ (vertex-attribute-stride vertex-attribute)
+ (vertex-attribute-offset-pointer vertex-attribute))
+ (let ((divisor (vertex-attribute-divisor vertex-attribute)))
(when divisor
(gl-vertex-attrib-divisor attribute-index divisor))))))
@@ -568,10 +565,10 @@ argument may be overridden. The following values are supported:
(graphics-engine-guard! array)
(with-graphics-state! ((g:vertex-array array))
(for-each (match-lambda
- ((index . buffer-view)
- (apply-buffer-view buffer-view index)))
+ ((index . vertex-attribute)
+ (apply-vertex-attribute vertex-attribute index)))
attributes)
- (when indices (apply-buffer-view indices)))
+ (when indices (apply-vertex-attribute indices)))
;; Restore the old array. Is this needed?
;; (graphics-engine-commit!)
array))
@@ -591,16 +588,16 @@ argument may be overridden. The following values are supported:
(let ((indices (vertex-array-indices array)))
(if indices
(begin
- (apply-buffer-view indices)
+ (apply-vertex-attribute indices)
(gl-draw-elements (vertex-array-mode-gl array)
(or count
- (buffer-view-length indices))
- (buffer-view-type-gl indices)
- (buffer-view-offset-pointer indices)))
+ (vertex-attribute-length indices))
+ (vertex-attribute-type-gl indices)
+ (vertex-attribute-offset-pointer indices)))
(gl-draw-arrays (vertex-array-mode-gl array)
offset
(or count
- (buffer-view-length
+ (vertex-attribute-length
(assv-ref (vertex-array-attributes array)
0))))))))
@@ -609,12 +606,12 @@ argument may be overridden. The following values are supported:
(let ((indices (vertex-array-indices array)))
(if indices
(begin
- (apply-buffer-view indices)
+ (apply-vertex-attribute indices)
(gl-draw-elements-instanced (vertex-array-mode-gl array)
(or count
- (buffer-view-length indices))
- (buffer-view-type-gl indices)
- (buffer-view-offset-pointer indices)
+ (vertex-attribute-length indices))
+ (vertex-attribute-type-gl indices)
+ (vertex-attribute-offset-pointer indices)
instances))
(gl-draw-arrays-instanced (vertex-array-mode-gl array)
offset count instances)))))
@@ -657,8 +654,8 @@ argument may be overridden. The following values are supported:
(if (memq kw keep)
(cons* kw arg (loop rest))
(loop rest))))))
- (define (make-buffer-view* name type attr-type dbuffer offset args)
- (apply make-buffer-view
+ (define (make-vertex-attribute* name type attr-type dbuffer offset args)
+ (apply make-vertex-attribute
#:name (format #f "~s view" name)
#:buffer (dynamic-buffer->buffer dbuffer)
#:type (if (scalar-type? attr-type)
@@ -700,12 +697,12 @@ argument may be overridden. The following values are supported:
(loop rest location))
(((name attr-type offset) . rest)
(cons (cons location
- (make-buffer-view* name
- type
- attr-type
- (assq-ref buffers type)
- offset
- (filter-kwargs args '(#:divisor))))
+ (make-vertex-attribute* name
+ type
+ attr-type
+ (assq-ref buffers type)
+ offset
+ (filter-kwargs args '(#:divisor))))
(inner rest (+ location 1))))))))))
(let* ((index-buffer (and index?
(make-dynamic-buffer #:name "index"
@@ -714,11 +711,11 @@ argument may be overridden. The following values are supported:
#:stride 4
#:target 'index)))
(index-view (and index?
- (make-buffer-view #:name "index view"
- #:buffer (dynamic-buffer->buffer
- index-buffer)
- #:type 'scalar
- #:component-type 'unsigned-int)))
+ (make-vertex-attribute #:name "index view"
+ #:buffer (dynamic-buffer->buffer
+ index-buffer)
+ #:type 'scalar
+ #:component-type 'unsigned-int)))
(types (canonicalize-types))
(vertex-buffers (build-vertex-buffers types))
(vertex-views (build-views types vertex-buffers))
@@ -880,7 +877,7 @@ argument may be overridden. The following values are supported:
(case 'field
((field-name)
(field-getter (dynamic-buffer-data dbuffer
- (+ (* i type-stride) field-offset))))
+ (+ (* i type-stride) field-offset))))
...
(else (error "unknown field" 'field)))))
(define-syntax-rule (setter geometry field i x)
@@ -889,19 +886,19 @@ argument may be overridden. The following values are supported:
(case 'field
((field-name)
(field-setter (dynamic-buffer-data dbuffer)
- (+ (* i type-stride) field-offset)
- x))
+ (+ (* i type-stride) field-offset)
+ x))
...
(else (error "unknown field" 'field)))))
(define-syntax appender
(syntax-rules ::: ()
- ((_ geometry (field-name ...) :::)
- (let* ((dbuffer (geometry-vertex-buffer geometry type-name))
- (n (length '((field-name ...) :::)))
- (i (dynamic-buffer-next! dbuffer n))
- (bv (dynamic-buffer-data dbuffer)))
- (let ((offset (* i type-stride)))
- (field-setter bv (+ offset field-offset) field-name)
- ...
- (set! i (+ i 1)))
- :::)))))))))))
+ ((_ geometry (field-name ...) :::)
+ (let* ((dbuffer (geometry-vertex-buffer geometry type-name))
+ (n (length '((field-name ...) :::)))
+ (i (dynamic-buffer-next! dbuffer n))
+ (bv (dynamic-buffer-data dbuffer)))
+ (let ((offset (* i type-stride)))
+ (field-setter bv (+ offset field-offset) field-name)
+ ...
+ (set! i (+ i 1)))
+ :::)))))))))))
diff --git a/chickadee/graphics/mesh.scm b/chickadee/graphics/mesh.scm
index b0db1b4..14cd82a 100644
--- a/chickadee/graphics/mesh.scm
+++ b/chickadee/graphics/mesh.scm
@@ -274,22 +274,22 @@
(loop (+ i 1) rest))))
(let* ((vertex-buffer (make-buffer verts #:stride stride))
(index-buffer (make-buffer indices #:target 'index))
- (positions (make-buffer-view #:buffer vertex-buffer
- #:type 'vec3
- #:component-type 'float))
- (uvs (make-buffer-view #:buffer vertex-buffer
- #:offset 12
- #:type 'vec2
- #:component-type 'float))
- (normals (make-buffer-view #:buffer vertex-buffer
- #:offset 20
- #:type 'vec3
- #:component-type 'float))
+ (positions (make-vertex-attribute #:buffer vertex-buffer
+ #:type 'vec3
+ #:component-type 'float))
+ (uvs (make-vertex-attribute #:buffer vertex-buffer
+ #:offset 12
+ #:type 'vec2
+ #:component-type 'float))
+ (normals (make-vertex-attribute #:buffer vertex-buffer
+ #:offset 20
+ #:type 'vec3
+ #:component-type 'float))
(vertex-array
(make-vertex-array #:indices
- (make-buffer-view #:buffer index-buffer
- #:type 'scalar
- #:component-type 'unsigned-int)
+ (make-vertex-attribute #:buffer index-buffer
+ #:type 'scalar
+ #:component-type 'unsigned-int)
#:attributes `((0 . ,positions)
(1 . ,uvs)
(2 . ,normals)))))
diff --git a/chickadee/graphics/model.scm b/chickadee/graphics/model.scm
index 839ddd1..5e0857e 100644
--- a/chickadee/graphics/model.scm
+++ b/chickadee/graphics/model.scm
@@ -280,7 +280,7 @@
#:mag-filter 'linear
#:flip? #f)))
(loop (cons (cons 'ambient-map texture)
- opts))))
+ opts))))
(("map_Kd" . args) ; diffuse map
(let* ((diffuse-opts (parse-map-args args))
(file (scope-file (assq-ref diffuse-opts
@@ -332,9 +332,9 @@
(loop opts)))))))))
(define (parse-error message args)
(apply error (format #f "OBJ parser error @ ~a:~d: ~a"
- file-name
- (port-line port)
- message)
+ file-name
+ (port-line port)
+ message)
args))
(define (parse-vertex args)
(array-list-push! vertices
@@ -515,21 +515,21 @@
;; Construct vertex array.
;; TODO: Add names to buffers and views.
(let* ((index-buffer (make-buffer mesh-indices #:target 'index))
- (index-view (make-buffer-view #:type 'scalar
- #:component-type 'unsigned-int
- #:buffer index-buffer))
+ (index-view (make-vertex-attribute #:type 'scalar
+ #:component-type 'unsigned-int
+ #:buffer index-buffer))
(data-buffer (make-buffer mesh-data #:stride (* stride 4)))
- (vertex-view (make-buffer-view #:type 'vec3
- #:component-type 'float
- #:buffer data-buffer))
- (texcoord-view (make-buffer-view #:type 'vec2
- #:component-type 'float
- #:buffer data-buffer
- #:offset 12))
- (normal-view (make-buffer-view #:type 'vec3
- #:component-type 'float
- #:buffer data-buffer
- #:offset 20)))
+ (vertex-view (make-vertex-attribute #:type 'vec3
+ #:component-type 'float
+ #:buffer data-buffer))
+ (texcoord-view (make-vertex-attribute #:type 'vec2
+ #:component-type 'float
+ #:buffer data-buffer
+ #:offset 12))
+ (normal-view (make-vertex-attribute #:type 'vec3
+ #:component-type 'float
+ #:buffer data-buffer
+ #:offset 20)))
(make-primitive material
(make-vertex-array
#:indices index-view
@@ -725,7 +725,7 @@
(else
(make-bytevector length)))))
data))
- (define (parse-buffer-view obj i buffers index-ids)
+ (define (parse-vertex-attribute obj i buffers index-ids)
(let ((name (string-ref/optional obj "name"))
(data (vector-ref buffers (number-ref obj "buffer")))
(offset (or (number-ref/optional obj "byteOffset") 0))
@@ -745,7 +745,7 @@
#:length length
#:stride stride
#:target target)))
- (define (parse-accessor obj buffer-views)
+ (define (parse-accessor obj vertex-attributes)
(define (type-length type)
(match type
('scalar 1)
@@ -758,7 +758,7 @@
(let ((name (or (string-ref/optional obj "name") "anonymous"))
(view (match (number-ref/optional obj "bufferView")
(#f #f)
- (n (vector-ref buffer-views n))))
+ (n (vector-ref vertex-attributes n))))
(offset (or (number-ref/optional obj "byteOffset") 0))
(component-type (match (number-ref obj "componentType")
(5120 'byte)
@@ -794,13 +794,13 @@
(display "glTF: sparse accessors currently unsupported"
(current-error-port))
(newline (current-error-port)))
- (make-buffer-view #:name name
- #:buffer view
- #:offset offset
- #:component-type component-type
- #:normalized? normalized?
- #:length length
- #:type type)))
+ (make-vertex-attribute #:name name
+ #:buffer view
+ #:offset offset
+ #:component-type component-type
+ #:normalized? normalized?
+ #:length length
+ #:type type)))
(define (texture-filter n)
(match n
(9728 'nearest)
@@ -1056,11 +1056,11 @@
(parse-buffer obj))
(or (assoc-ref tree "buffers") #())))
(indices (index-ids tree))
- (buffer-views (vector-map (lambda (obj i)
- (parse-buffer-view obj i buffers indices))
- (or (assoc-ref tree "bufferViews") #())))
+ (vertex-attributes (vector-map (lambda (obj i)
+ (parse-vertex-attribute obj i buffers indices))
+ (or (assoc-ref tree "bufferViews") #())))
(accessors (vector-map (lambda (obj i)
- (parse-accessor obj buffer-views))
+ (parse-accessor obj vertex-attributes))
(or (assoc-ref tree "accessors") #())))
(images (or (assoc-ref tree "images") #()))
(samplers (or (assoc-ref tree "samplers") #(())))
diff --git a/chickadee/graphics/skybox.scm b/chickadee/graphics/skybox.scm
index aecba59..d7fe5d7 100644
--- a/chickadee/graphics/skybox.scm
+++ b/chickadee/graphics/skybox.scm
@@ -77,12 +77,12 @@
-1.0 1.0 -1.0))
(index-buffer (make-buffer index #:target 'index))
(vertex-buffer (make-buffer verts))
- (indices (make-buffer-view #:buffer index-buffer
- #:type 'scalar
- #:component-type 'unsigned-int))
- (positions (make-buffer-view #:buffer vertex-buffer
- #:type 'vec3
- #:component-type 'float))
+ (indices (make-vertex-attribute #:buffer index-buffer
+ #:type 'scalar
+ #:component-type 'unsigned-int))
+ (positions (make-vertex-attribute #:buffer vertex-buffer
+ #:type 'vec3
+ #:component-type 'float))
(va (make-vertex-array #:indices indices
#:attributes `((0 . ,positions)))))
(%make-skybox cube-map va)))