From 09b5512295a083f1623b632f3c1d3d8e4af5fef3 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 26 Oct 2014 08:12:11 -0400 Subject: mesh: Use new renderer API. * sly/mesh.scm (, %make-vertex-buffer, vertex-buffer?, vertex-buffer-id, vertex-buffer-type, vertex-buffer-attr-size, vertex-buffer-length, generate-vertex-buffer, bind-vertex-buffer, with-vertex-buffer, vertices-bytevector, attribute-size, gl-buffer-type, make-vertex-buffer, generate-vertex-array, with-vertex-array, vertex-attrib-pointer): Remove old vertex buffer/array procedures. (mesh-length, draw-mesh): Delete. (mesh-shader): New procedure. (make-mesh): Reimplement. (draw): New method. * sly/shape.scm (make-cube): Decouple from scene node. Use new mesh constructor. * sly/sprite.scm (make-sprite): Likewise. --- sly/mesh.scm | 165 +++++++-------------------------------------------------- sly/shape.scm | 156 ++++++++++++++++++++++++++--------------------------- sly/sprite.scm | 29 +++++----- 3 files changed, 108 insertions(+), 242 deletions(-) diff --git a/sly/mesh.scm b/sly/mesh.scm index 89e700c..568aa90 100644 --- a/sly/mesh.scm +++ b/sly/mesh.scm @@ -22,10 +22,9 @@ ;;; Code: (define-module (sly mesh) + #:use-module (oop goops) #: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) @@ -35,159 +34,35 @@ #:use-module (sly texture) #:use-module (sly math vector) #:use-module (sly signal) + #:use-module (sly transform) + #:use-module (sly render utils) + #:use-module (sly render vertex-array) + #:use-module (sly render renderer) #:export (make-mesh mesh? mesh-length mesh-shader mesh-texture - draw-mesh)) - -;;; -;;; Vertex Buffers and Vertex Arrays -;;; - -(define-record-type - (%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 ($ x y)) - (let ((offset (* i 2))) - (setter bv offset x) - (setter bv (1+ offset) y))) - ((i ($ x y z)) - (let ((offset (* i 3))) - (setter bv offset x) - (setter bv (1+ offset) y) - (setter bv (+ offset 2) z))) - ((i ($ 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 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 (vertex-attrib-pointer shader attribute vbo) - (let ((location (shader-program-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->render-op)) ;;; ;;; Mesh ;;; (define-record-type - (%make-mesh vao length shader) + (%make-mesh vao shader texture) mesh? (vao mesh-vao) - (length mesh-length) - (shader mesh-shader)) - -(define* (make-mesh #:optional #:key shader 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))) - -(define (draw-mesh mesh uniforms) - (define (draw) - (glDrawElements (begin-mode triangles) - (mesh-length mesh) - (data-type unsigned-int) - %null-pointer)) - - (with-shader-program (mesh-shader mesh) - (for-each (lambda (uniform) - (match uniform - ((name value) - (uniform-set! (mesh-shader mesh) name - (signal-ref-maybe value))))) - uniforms) - (with-vertex-array (mesh-vao mesh) - (draw)))) + (shader mesh-shader) + (texture mesh-texture)) + +(define* (make-mesh #:optional #:key shader texture indices positions textures) + (%make-mesh (make-vertex-array indices positions textures) + shader texture)) + +(define-method (draw (mesh <>) transform) + (make-render-op #:vertex-array (mesh-vao mesh) + #:texture (mesh-texture mesh) + #:shader (mesh-shader mesh) + #:uniforms `(("color" ,white)) + #:transform transform)) diff --git a/sly/shape.scm b/sly/shape.scm index b71f59c..ed9e440 100644 --- a/sly/shape.scm +++ b/sly/shape.scm @@ -24,7 +24,6 @@ (define-module (sly shape) #:use-module (sly math) #:use-module (sly mesh) - #:use-module (sly scene) #:use-module (sly shader) #:use-module (sly texture) #:use-module (sly math vector) @@ -33,90 +32,85 @@ (define* (make-cube size #:optional #:key (texture #f) (shader (load-default-shader))) (let ((half-size (half size))) - (make-scene-node + (make-mesh + #:shader shader #:texture texture - #:children - (make-mesh - #:shader shader - #:indices #( + #:indices #( + ;; Front + 0 3 2 0 2 1 + ;; Back + 4 6 7 4 5 6 + ;; Top + 8 11 10 8 10 9 + ;; Bottom + 12 14 15 12 13 14 + ;; Left + 16 19 18 16 18 17 + ;; Right + 20 22 23 20 21 22) + #:positions (vector ;; Front - 0 3 2 0 2 1 + (vector3 (- half-size) (- half-size) (- half-size)) + (vector3 half-size (- half-size) (- half-size)) + (vector3 half-size half-size (- half-size)) + (vector3 (- half-size) half-size (- half-size)) ;; Back - 4 6 7 4 5 6 + (vector3 (- half-size) (- half-size) half-size) + (vector3 half-size (- half-size) half-size) + (vector3 half-size half-size half-size) + (vector3 (- half-size) half-size half-size) ;; Top - 8 11 10 8 10 9 + (vector3 (- half-size) half-size (- half-size)) + (vector3 half-size half-size (- half-size)) + (vector3 half-size half-size half-size) + (vector3 (- half-size) half-size half-size) ;; Bottom - 12 14 15 12 13 14 + (vector3 (- half-size) (- half-size) (- half-size)) + (vector3 half-size (- half-size) (- half-size)) + (vector3 half-size (- half-size) half-size) + (vector3 (- half-size) (- half-size) half-size) ;; Left - 16 19 18 16 18 17 + (vector3 (- half-size) (- half-size) (- half-size)) + (vector3 (- half-size) half-size (- half-size)) + (vector3 (- half-size) half-size half-size) + (vector3 (- half-size) (- half-size) half-size) ;; Right - 20 22 23 20 21 22) - #:data `(("position" ,(vector - ;; Front - (vector3 (- half-size) (- half-size) (- half-size)) - (vector3 half-size (- half-size) (- half-size)) - (vector3 half-size half-size (- half-size)) - (vector3 (- half-size) half-size (- half-size)) - ;; Back - (vector3 (- half-size) (- half-size) half-size) - (vector3 half-size (- half-size) half-size) - (vector3 half-size half-size half-size) - (vector3 (- half-size) half-size half-size) - ;; Top - (vector3 (- half-size) half-size (- half-size)) - (vector3 half-size half-size (- half-size)) - (vector3 half-size half-size half-size) - (vector3 (- half-size) half-size half-size) - ;; Bottom - (vector3 (- half-size) (- half-size) (- half-size)) - (vector3 half-size (- half-size) (- half-size)) - (vector3 half-size (- half-size) half-size) - (vector3 (- half-size) (- half-size) half-size) - ;; Left - (vector3 (- half-size) (- half-size) (- half-size)) - (vector3 (- half-size) half-size (- half-size)) - (vector3 (- half-size) half-size half-size) - (vector3 (- half-size) (- half-size) half-size) - ;; Right - (vector3 half-size (- half-size) (- half-size)) - (vector3 half-size half-size (- half-size)) - (vector3 half-size half-size half-size) - (vector3 half-size (- half-size) half-size))) - ,@(if texture - (let ((s1 (texture-s1 texture)) - (t1 (texture-t1 texture)) - (s2 (texture-s2 texture)) - (t2 (texture-t2 texture))) - `(("tex" - ,(vector - ;; Front - (vector2 s1 t1) - (vector2 s2 t1) - (vector2 s2 t2) - (vector2 s1 t2) - ;; Back - (vector2 s1 t1) - (vector2 s2 t1) - (vector2 s2 t2) - (vector2 s1 t2) - ;; Top - (vector2 s1 t1) - (vector2 s2 t1) - (vector2 s2 t2) - (vector2 s1 t2) - ;; Bottom - (vector2 s1 t1) - (vector2 s2 t1) - (vector2 s2 t2) - (vector2 s1 t2) - ;; Left - (vector2 s1 t1) - (vector2 s2 t1) - (vector2 s2 t2) - (vector2 s1 t2) - ;; Right - (vector2 s1 t1) - (vector2 s2 t1) - (vector2 s2 t2) - (vector2 s1 t2))))) - '())))))) + (vector3 half-size (- half-size) (- half-size)) + (vector3 half-size half-size (- half-size)) + (vector3 half-size half-size half-size) + (vector3 half-size (- half-size) half-size)) + #:textures (let ((s1 (texture-s1 texture)) + (t1 (texture-t1 texture)) + (s2 (texture-s2 texture)) + (t2 (texture-t2 texture))) + (vector + ;; Front + (vector2 s1 t1) + (vector2 s2 t1) + (vector2 s2 t2) + (vector2 s1 t2) + ;; Back + (vector2 s1 t1) + (vector2 s2 t1) + (vector2 s2 t2) + (vector2 s1 t2) + ;; Top + (vector2 s1 t1) + (vector2 s2 t1) + (vector2 s2 t2) + (vector2 s1 t2) + ;; Bottom + (vector2 s1 t1) + (vector2 s2 t1) + (vector2 s2 t2) + (vector2 s1 t2) + ;; Left + (vector2 s1 t1) + (vector2 s2 t1) + (vector2 s2 t2) + (vector2 s1 t2) + ;; Right + (vector2 s1 t1) + (vector2 s2 t1) + (vector2 s2 t2) + (vector2 s1 t2)))))) diff --git a/sly/sprite.scm b/sly/sprite.scm index 644d766..f6f2d78 100644 --- a/sly/sprite.scm +++ b/sly/sprite.scm @@ -34,7 +34,6 @@ #:use-module (sly helpers) #:use-module (sly math) #:use-module (sly mesh) - #:use-module (sly scene) #:use-module (sly shader) #:use-module (sly signal) #:use-module (sly texture) @@ -63,22 +62,20 @@ custom SHADER can be specified." (t1 (texture-t1 texture)) (s2 (texture-s2 texture)) (t2 (texture-t2 texture))) - (make-scene-node + (make-mesh + #:shader shader #:texture texture - #:children - (make-mesh - #:shader shader - #:indices #(0 3 2 0 2 1) - #:data `(("position" ,(vector - (vector3 x1 y1 0) - (vector3 x2 y1 0) - (vector3 x2 y2 0) - (vector3 x1 y2 0))) - ("tex" ,(vector - (vector2 s1 t1) - (vector2 s2 t1) - (vector2 s2 t2) - (vector2 s1 t2)))))))) + #:indices #(0 3 2 0 2 1) + #:positions (vector + (vector3 x1 y1 0) + (vector3 x2 y1 0) + (vector3 x2 y2 0) + (vector3 x1 y2 0)) + #:textures (vector + (vector2 s1 t1) + (vector2 s2 t1) + (vector2 s2 t2) + (vector2 s1 t2))))) (define* (load-sprite file-name #:optional #:key (shader (load-default-shader)) (anchor 'center) (color white)) -- cgit v1.2.3