From fd12c8f0a13607aaac00110d08a113e870bd509c Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Thu, 2 Oct 2014 23:07:20 -0400
Subject: 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.
---
 sly/math/vector.scm | 28 ++++++++++++----------------
 sly/mesh.scm        | 24 ++++++++++++------------
 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)
-- 
cgit v1.2.3