diff options
Diffstat (limited to 'chickadee/graphics/buffer.scm')
-rw-r--r-- | chickadee/graphics/buffer.scm | 239 |
1 files changed, 118 insertions, 121 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))) + :::))))))))))) |