diff options
Diffstat (limited to 'sly/render/mesh.scm')
-rw-r--r-- | sly/render/mesh.scm | 158 |
1 files changed, 143 insertions, 15 deletions
diff --git a/sly/render/mesh.scm b/sly/render/mesh.scm index 992ef85..98510d3 100644 --- a/sly/render/mesh.scm +++ b/sly/render/mesh.scm @@ -17,29 +17,157 @@ ;;; Commentary: ;; -;; A mesh is a 2D/3D model comprised of a shader and vertex buffers. +;; Meshes encapsulate the geometry for a single OpenGL draw call. ;; ;;; Code: (define-module (sly render mesh) - #:use-module (oop goops) + #:use-module (system foreign) #:use-module (ice-9 match) #:use-module (srfi srfi-9) - #:use-module (system foreign) + #:use-module (srfi srfi-43) + #:use-module (rnrs bytevectors) #:use-module (gl) #:use-module (gl low-level) #:use-module (sly wrappers gl) + #:use-module (sly math vector) #:use-module (sly render color) #:use-module (sly render shader) - #:use-module (sly render texture) - #:use-module (sly math vector) - #:use-module (sly signal) - #:use-module (sly math transform) - #:use-module (sly render utils) - #:use-module (sly render vertex-array) - #:use-module (sly render model) - #:export (make-mesh)) - -(define* (make-mesh #:optional #:key shader texture indices positions textures) - (make-model #:shader shader #:texture texture - #:mesh (make-vertex-array indices positions textures))) + #:export (make-mesh + mesh? + mesh-id mesh-length + apply-mesh with-mesh)) + +;;; +;;; Vertex Buffer +;;; + +(define-record-type <vertex-buffer> + (%make-vertex-buffer id type attr-size length) + vertex-buffer? + (id vertex-buffer-id) + (type vertex-buffer-type) + (attr-size vertex-buffer-attr-size) + (length vertex-buffer-length)) + +(define (generate-vertex-buffer) + (let ((bv (u32vector 1))) + (glGenBuffers 1 (bytevector->pointer bv)) + (u32vector-ref bv 0))) + +(define (bind-vertex-buffer vbo) + (glBindBuffer (vertex-buffer-type vbo) + (vertex-buffer-id vbo))) + +(define-syntax-rule (with-vertex-buffer vbo body ...) + (let ((type (vertex-buffer-type vbo))) + (glBindBuffer type (vertex-buffer-id vbo)) + body ... + (glBindBuffer type 0))) + +(define (vertices-bytevector vertices index?) + (let* ((elem (vector-ref vertices 0)) + (bv (if index? + (make-u32vector (vector-length vertices)) + (make-f32vector (* (vector-length vertices) + (attribute-size elem))))) + (setter (if index? u32vector-set! f32vector-set!))) + (vector-for-each + (match-lambda* + ((i (? number? k)) + (setter bv i k)) + ((i ($ <vector2> x y)) + (let ((offset (* i 2))) + (setter bv offset x) + (setter bv (1+ offset) y))) + ((i ($ <vector3> x y z)) + (let ((offset (* i 3))) + (setter bv offset x) + (setter bv (1+ offset) y) + (setter bv (+ offset 2) z))) + ((i ($ <vector4> x y z w)) + (let ((offset (* i 4))) + (setter bv offset x) + (setter bv (1+ offset) y) + (setter bv (+ offset 2) z) + (setter bv (+ offset 3) w))) + ((i (color? c)) + (let ((offset (* i 4))) + (setter bv offset (color-r c)) + (setter bv (1+ offset) (color-g c)) + (setter bv (+ offset 2) (color-b c)) + (setter bv (+ offset 3) (color-a c))))) + vertices) + bv)) + +(define attribute-size + (match-lambda + ((? number? _) 1) + ((? vector2? _) 2) + ((? vector3? _) 3) + ((or (? vector4? _) + (? color? _)) + 4) + (attr + (error "Unsupported vertex buffer attribute: " attr)))) + +(define (gl-buffer-type index?) + (if index? + (arb-vertex-buffer-object element-array-buffer-arb) + (arb-vertex-buffer-object array-buffer-arb))) + +(define* (make-vertex-buffer vertices #:optional (index? #f)) + (let ((bv (vertices-bytevector vertices index?)) + (vbo (%make-vertex-buffer (generate-vertex-buffer) + (gl-buffer-type index?) + (attribute-size (vector-ref vertices 0)) + (vector-length vertices)))) + (with-vertex-buffer vbo + (glBufferData (vertex-buffer-type vbo) + (bytevector-length bv) + (bytevector->pointer bv) + (arb-vertex-buffer-object static-draw-arb))) + vbo)) + +;;; +;;; Mesh +;;; + +(define-record-type <mesh> + (%make-mesh id length) + mesh? + (id mesh-id) + (length mesh-length)) + +(define (generate-vertex-array) + (let ((bv (u32vector 1))) + (glGenVertexArrays 1 (bytevector->pointer bv)) + (u32vector-ref bv 0))) + +(define (apply-mesh vao) + (glBindVertexArray (mesh-id vao))) + +;; emacs: (put 'with-mesh 'scheme-indent-function 1) +(define-syntax-rule (with-mesh vao body ...) + (begin + (apply-mesh vao) + body ... + (glBindVertexArray 0))) + +(define (vertex-attrib-pointer location vbo) + (glEnableVertexAttribArray location) + (with-vertex-buffer vbo + (glVertexAttribPointer location (vertex-buffer-attr-size vbo) + (data-type float) #f 0 %null-pointer))) + +(define (make-mesh indices positions textures) + (let ((mesh (%make-mesh (generate-vertex-array) + (vector-length indices))) + (positions (make-vertex-buffer positions)) + (textures (make-vertex-buffer textures))) + (with-mesh mesh + (vertex-attrib-pointer vertex-position-location positions) + (if textures + (vertex-attrib-pointer vertex-texture-location textures)) + (bind-vertex-buffer (make-vertex-buffer indices #t))) + mesh)) |