diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | sly/mesh.scm | 194 |
2 files changed, 195 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am index ed5cb6b..468c42f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -35,6 +35,7 @@ SOURCES = \ sly/keyboard.scm \ sly/live-reload.scm \ sly/math.scm \ + sly/mesh.scm \ sly/mouse.scm \ sly/rect.scm \ sly/repl.scm \ diff --git a/sly/mesh.scm b/sly/mesh.scm new file mode 100644 index 0000000..76f0993 --- /dev/null +++ b/sly/mesh.scm @@ -0,0 +1,194 @@ +;;; Sly +;;; Copyright (C) 2014 David Thompson <davet@gnu.org> +;;; +;;; Sly is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; Sly is distributed in the hope that it will be useful, but WITHOUT +;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +;;; License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; A mesh is a 2D/3D model comprised of a texture, shader, and vertex +;; buffers. +;; +;;; Code: + +(define-module (sly mesh) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-43) + #:use-module (system foreign) + #:use-module (gl) + #:use-module (gl low-level) + #:use-module (sly wrappers gl) + #:use-module (sly color) + #:use-module (sly shader) + #:use-module (sly texture) + #:use-module (sly vector) + #:export (make-mesh + mesh? + mesh-length + mesh-shader + mesh-texture + draw-mesh)) + +;;; +;;; Vertex Buffers and Vertex Arrays +;;; + +(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 + (cond + ((number? elem) + (lambda (i k) + (setter bv i k))) + ((or (vector2? elem) + (vector3? elem) + (vector4? elem)) + (let ((dimensions (vector-length elem))) + (lambda (i v) + (let ((offset (* i dimensions))) + (vector-for-each + (lambda (j n) + (setter bv (+ offset j) n)) + v))))) + ((color? elem) + (lambda (i 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 attr) + (cond + ((number? attr) 1) + ((vector2? attr) 2) + ((vector3? attr) 3) + ((or (vector4? attr) + (color? attr)) + 4) + (else + (error "Unsupported 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)) + +(define (generate-vertex-array) + (let ((bv (u32vector 1))) + (glGenVertexArrays 1 (bytevector->pointer bv)) + (u32vector-ref bv 0))) + +(define-syntax-rule (with-vertex-array vao body ...) + (begin + (glBindVertexArray vao) + body ... + (glBindVertexArray 0))) + +(define (attribute-location shader-program name) + "Retrieve the location for the uniform NAME within SHADER-PROGRAM." + (glGetAttribLocation (shader-program-id shader-program) name)) + +(define (vertex-attrib-pointer shader attribute vbo) + (let ((location (attribute-location shader attribute))) + (glEnableVertexAttribArray location) + (with-vertex-buffer vbo + (glVertexAttribPointer location (vertex-buffer-attr-size vbo) + (data-type float) #f 0 %null-pointer)))) + +;;; +;;; Mesh +;;; + +(define-record-type <mesh> + (%make-mesh vao length shader texture) + mesh? + (vao mesh-vao) + (length mesh-length) + (shader mesh-shader) + (texture mesh-texture)) + +(define* (make-mesh #:optional #:key shader texture indices data) + (let ((vao (generate-vertex-array))) + (with-vertex-array vao + (let loop ((data data)) + (match data + (((attribute vertices) . rest) + (vertex-attrib-pointer shader attribute + (make-vertex-buffer vertices)) + (loop rest)) + (() #f))) + (bind-vertex-buffer (make-vertex-buffer indices #t))) + (%make-mesh vao (vector-length indices) shader texture))) + +(define (draw-mesh mesh uniforms) + (with-shader-program (mesh-shader mesh) + (for-each (lambda (uniform) + (match uniform + ((name value) + ((@@ (sly shader) uniform-set!) + (mesh-shader mesh) + name value)))) + uniforms) + (with-vertex-array (mesh-vao mesh) + (with-texture (mesh-texture mesh) + (glDrawElements (begin-mode triangles) + (mesh-length mesh) + (data-type unsigned-int) + %null-pointer))))) |