summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--sly/mesh.scm16
-rw-r--r--sly/scene.scm55
-rw-r--r--sly/shape.scm159
-rw-r--r--sly/sprite.scm29
4 files changed, 130 insertions, 129 deletions
diff --git a/sly/mesh.scm b/sly/mesh.scm
index c00d602..89e700c 100644
--- a/sly/mesh.scm
+++ b/sly/mesh.scm
@@ -17,8 +17,7 @@
;;; Commentary:
;;
-;; A mesh is a 2D/3D model comprised of a texture, shader, and vertex
-;; buffers.
+;; A mesh is a 2D/3D model comprised of a shader and vertex buffers.
;;
;;; Code:
@@ -157,14 +156,13 @@
;;;
(define-record-type <mesh>
- (%make-mesh vao length shader texture)
+ (%make-mesh vao length shader)
mesh?
(vao mesh-vao)
(length mesh-length)
- (shader mesh-shader)
- (texture mesh-texture))
+ (shader mesh-shader))
-(define* (make-mesh #:optional #:key shader texture indices data)
+(define* (make-mesh #:optional #:key shader indices data)
(let ((vao (generate-vertex-array)))
(with-vertex-array vao
(let loop ((data data))
@@ -175,7 +173,7 @@
(loop rest))
(() #f)))
(bind-vertex-buffer (make-vertex-buffer indices #t)))
- (%make-mesh vao (vector-length indices) shader texture)))
+ (%make-mesh vao (vector-length indices) shader)))
(define (draw-mesh mesh uniforms)
(define (draw)
@@ -192,6 +190,4 @@
(signal-ref-maybe value)))))
uniforms)
(with-vertex-array (mesh-vao mesh)
- (if (texture? (mesh-texture mesh))
- (with-texture (mesh-texture mesh) (draw))
- (draw)))))
+ (draw))))
diff --git a/sly/scene.scm b/sly/scene.scm
index a8b90b4..a06efd9 100644
--- a/sly/scene.scm
+++ b/sly/scene.scm
@@ -22,19 +22,21 @@
;;; Code:
(define-module (sly scene)
+ #:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (sly camera)
#:use-module (sly mesh)
#:use-module (sly quaternion)
#:use-module (sly signal)
+ #:use-module (sly texture)
#:use-module (sly transform)
#:use-module (sly transition)
#:use-module (sly math vector)
#:export (scene-node
make-scene-node
scene-node?
- scene-node-position scene-node-scale scene-node-rotation
+ scene-node-transform scene-node-texture
scene-node-uniforms scene-node-children
update-scene-node draw-scene-node
make-scene
@@ -43,32 +45,32 @@
update-scene draw-scene))
(define-record-type <scene-node>
- (%make-scene-node position scale rotation uniforms children)
+ (%make-scene-node transform texture uniforms children)
scene-node?
- (position scene-node-position)
- (scale scene-node-scale)
- (rotation scene-node-rotation)
+ (transform scene-node-transform)
+ (texture scene-node-texture)
(uniforms scene-node-uniforms)
(children scene-node-children))
(define* (make-scene-node #:optional #:key
- (position (vector2 0 0))
- (scale 1)
- (rotation identity-quaternion)
- (uniforms '())
- (children '())
- #:allow-other-keys)
- (%make-scene-node position scale rotation uniforms children))
+ (transform identity-transform)
+ (texture #f)
+ (uniforms '())
+ (children '())
+ #:allow-other-keys)
+ (match children
+ ((or (children ...)
+ (= list children))
+ (%make-scene-node transform texture uniforms children))))
(define-syntax-rule (scene-node (field val) ...)
(apply make-scene-node
(append (list (symbol->keyword 'field) val) ...)))
-(define (interpolate current prev alpha)
- (if (or (not prev)
- (equal? current prev))
- current
- (vector-interpolate prev current alpha)))
+(define-syntax-rule (with-texture-maybe texture body ...)
+ (if (texture? texture)
+ (with-texture texture body ...)
+ (begin body ...)))
(define* (draw-scene-node node alpha transform #:optional (uniforms '()))
(signal-let ((node node))
@@ -76,17 +78,14 @@
(draw-mesh node `(("mvp" ,transform)
,@uniforms))
(signal-let ((children (scene-node-children node))
- (position (scene-node-position node))
- (%scale (scene-node-scale node))
- (rotation (scene-node-rotation node)))
- (let ((node-transform (transform*
- (translate position)
- (scale %scale)
- (quaternion->transform rotation))))
- (for-each (cut draw-scene-node <> alpha
- (transform* transform node-transform)
- (scene-node-uniforms node))
- children))))))
+ (local-transform (scene-node-transform node))
+ (texture (scene-node-texture node)))
+ (with-texture-maybe texture
+ (let ((transform (transform* transform local-transform))
+ ;; FIXME: properly merge uniform alists together.
+ (uniforms (append uniforms (scene-node-uniforms node))))
+ (for-each (cut draw-scene-node <> alpha transform uniforms)
+ children)))))))
;;;
;;; Scene
diff --git a/sly/shape.scm b/sly/shape.scm
index 8283875..b71f59c 100644
--- a/sly/shape.scm
+++ b/sly/shape.scm
@@ -24,6 +24,7 @@
(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)
@@ -32,88 +33,90 @@
(define* (make-cube size #:optional #:key (texture #f)
(shader (load-default-shader)))
(let ((half-size (half size)))
- (make-mesh
- #:shader shader
+ (make-scene-node
#:texture texture
- #: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)
- #:data `(("position" ,(vector
+ #:children
+ (make-mesh
+ #:shader shader
+ #: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)
+ #: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
- (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))
+ (vector2 s1 t1)
+ (vector2 s2 t1)
+ (vector2 s2 t2)
+ (vector2 s1 t2)
;; 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)
+ (vector2 s1 t1)
+ (vector2 s2 t1)
+ (vector2 s2 t2)
+ (vector2 s1 t2)
;; 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)
+ (vector2 s1 t1)
+ (vector2 s2 t1)
+ (vector2 s2 t2)
+ (vector2 s1 t2)
;; 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)
+ (vector2 s1 t1)
+ (vector2 s2 t1)
+ (vector2 s2 t2)
+ (vector2 s1 t2)
;; 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)
+ (vector2 s1 t1)
+ (vector2 s2 t1)
+ (vector2 s2 t2)
+ (vector2 s1 t2)
;; 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)))))
- '())))))
+ (vector2 s1 t1)
+ (vector2 s2 t1)
+ (vector2 s2 t2)
+ (vector2 s1 t2)))))
+ '()))))))
diff --git a/sly/sprite.scm b/sly/sprite.scm
index 5b4ee81..644d766 100644
--- a/sly/sprite.scm
+++ b/sly/sprite.scm
@@ -34,6 +34,7 @@
#: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)
@@ -62,20 +63,22 @@ custom SHADER can be specified."
(t1 (texture-t1 texture))
(s2 (texture-s2 texture))
(t2 (texture-t2 texture)))
- (make-mesh
- #:shader shader
+ (make-scene-node
#:texture texture
- #: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)))))))
+ #: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))))))))
(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 03:35:31 +0000