summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am1
-rw-r--r--sly/mesh.scm194
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)))))