summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/math/vector.scm28
-rw-r--r--sly/mesh.scm24
-rw-r--r--sly/transform.scm50
3 files changed, 44 insertions, 58 deletions
diff --git a/sly/math/vector.scm b/sly/math/vector.scm
index d2554fe..b9e0302 100644
--- a/sly/math/vector.scm
+++ b/sly/math/vector.scm
@@ -26,9 +26,10 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (sly math)
- #:export (vector2
- vector3
- vector4
+ #:export (<vector2>
+ <vector3>
+ <vector4>
+ vector2 vector3 vector4
vector2? vector3? vector4?
vx vy vz vw
v+ v- v* vdot vcross
@@ -57,27 +58,22 @@
(define vx
(match-lambda
- (($ <vector2> x _)
- x)
- (($ <vector3> x _ _)
- x)
- (($ <vector4> x _ _ _)
+ ((or ($ <vector2> x _)
+ ($ <vector3> x _ _)
+ ($ <vector4> x _ _ _))
x)))
(define vy
(match-lambda
- (($ <vector2> _ y)
- y)
- (($ <vector3> _ y _)
- y)
- (($ <vector4> _ y _ _)
+ ((or ($ <vector2> _ y)
+ ($ <vector3> _ y _)
+ ($ <vector4> _ y _ _))
y)))
(define vz
(match-lambda
- (($ <vector3> _ _ z)
- z)
- (($ <vector4> _ _ z _)
+ ((or ($ <vector3> _ _ z)
+ ($ <vector4> _ _ z _))
z)))
(define vw vector4-w)
diff --git a/sly/mesh.scm b/sly/mesh.scm
index 65154a7..c00d602 100644
--- a/sly/mesh.scm
+++ b/sly/mesh.scm
@@ -81,21 +81,21 @@
(match-lambda*
((i (? number? k))
(setter bv i k))
- ((i (? vector2? v))
+ ((i ($ <vector2> x y))
(let ((offset (* i 2)))
- (setter bv offset (vx v))
- (setter bv (1+ offset) (vy v))))
- ((i (? vector3? v))
+ (setter bv offset x)
+ (setter bv (1+ offset) y)))
+ ((i ($ <vector3> x y z))
(let ((offset (* i 3)))
- (setter bv offset (vx v))
- (setter bv (1+ offset) (vy v))
- (setter bv (+ offset 2) (vz v))))
- ((i (? vector4? v))
+ (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 (vx v))
- (setter bv (1+ offset) (vy v))
- (setter bv (+ offset 2) (vz v))
- (setter bv (+ offset 3) (vw v))))
+ (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))
diff --git a/sly/transform.scm b/sly/transform.scm
index 3b82c2e..95324ed 100644
--- a/sly/transform.scm
+++ b/sly/transform.scm
@@ -132,21 +132,16 @@ identity-transform if called without any arguments."
(define translate
(match-lambda
- ((? vector2? v)
- (let ((x (vx v))
- (y (vy v)))
- (make-transform 1 0 0 0
- 0 1 0 0
- 0 0 1 0
- x y 0 1)))
- ((? vector3? v)
- (let ((x (vx v))
- (y (vy v))
- (z (vz v)))
- (make-transform 1 0 0 0
- 0 1 0 0
- 0 0 1 0
- x y z 1)))
+ (($ <vector2> x y)
+ (make-transform 1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ x y 0 1))
+ (($ <vector3> x y z)
+ (make-transform 1 0 0 0
+ 0 1 0 0
+ 0 0 1 0
+ x y z 1))
(v (error "Invalid translation vector: " v))))
(define scale
@@ -156,21 +151,16 @@ identity-transform if called without any arguments."
0 v 0 0
0 0 v 0
0 0 0 1))
- ((? vector2? v)
- (let ((x (vx v))
- (y (vy v)))
- (make-transform x 0 0 0
- 0 y 0 0
- 0 0 1 0
- 0 0 0 1)))
- ((? vector3? v)
- (let ((x (vx v))
- (y (vy v))
- (z (vz v)))
- (make-transform x 0 0 0
- 0 y 0 0
- 0 0 z 0
- 0 0 0 1)))
+ (($ <vector2> x y)
+ (make-transform x 0 0 0
+ 0 y 0 0
+ 0 0 1 0
+ 0 0 0 1))
+ (($ <vector3> x y z)
+ (make-transform x 0 0 0
+ 0 y 0 0
+ 0 0 z 0
+ 0 0 0 1))
(v (error "Invalid scaling vector: " v))))
(define (rotate-x angle)