diff options
| author | David Thompson <dthompson2@worcester.edu> | 2014-10-02 23:07:20 -0400 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2014-10-02 23:07:20 -0400 |
| commit | fd12c8f0a13607aaac00110d08a113e870bd509c (patch) | |
| tree | c4dbebb79ebcfcfad894e13c65998b7ffcf046df | |
| parent | 0735ffb5a06e71a27b215ab342522557bb51b7d1 (diff) | |
Export vector record type identifiers for destructuring via 'match'.
* sly/match/vector.scm: Export <vector2>, <vector3> and <vector4>.
(vx, vy, vz): Use 'match' more wisely.
* sly/mesh.scm (vertices-bytevector): Destructure vectors.
* sly/transform.scm (translate, scale): Ditto.
| -rw-r--r-- | sly/math/vector.scm | 28 | ||||
| -rw-r--r-- | sly/mesh.scm | 24 | ||||
| -rw-r--r-- | sly/transform.scm | 50 |
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) |