summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--sly/mesh.scm165
-rw-r--r--sly/shape.scm156
-rw-r--r--sly/sprite.scm29
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 <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 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 <mesh>
- (%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 <<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))
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-23 02:30:29 +0000