diff options
| -rw-r--r-- | chickadee/graphics/buffer.scm | 239 | ||||
| -rw-r--r-- | chickadee/graphics/mesh.scm | 28 | ||||
| -rw-r--r-- | chickadee/graphics/model.scm | 64 | ||||
| -rw-r--r-- | chickadee/graphics/skybox.scm | 12 |
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))) |