From 0735ffb5a06e71a27b215ab342522557bb51b7d1 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 1 Oct 2014 20:52:09 -0400
Subject: Rewrite vector math module.

* .gitignore: Ignore '*.log' files.
* sly/vector.scm: Delete file.
* sly/math/vector.scm: New file.
* tests/math/vector.scm: New file.
* Makefile.am: Add new file and remove the old one.
* sly/font.scm: Remove import.
* sly/game.scm: Change import.
* sly/joystick.scm (make-directional-signal-raw, make-directional): Use
  'vector2'.
* sly/keyboard.scm (key-directions): Use 'vector2'.
* sly/mesh.scm (vertices-bytevector): Use new vector procedures.
* sly/mouse.scm (mouse-position): Use 'vector2'.
* sly/quaternion.scm (axis-angle->quaternion, quaternion->vector,
  vector->quaternion): Use new vector procedures.
* sly/rect.scm (rect-position, rect-top-right, rect-bottom-left,
  rect-bottom-right, rect-center, rect-size): Use 'vector2'.
* sly/scene.scm (make-scene-node): Use 'vector2'.
* sly/shader.scm: Change import.
* sly/shape.scm (make-cube): Use new vector procedures.
* sly/sprite.scm (make-sprite): Use new vector procedures.
* sly/texture.scm (anchor-texture): Use 'vector2'.
* sly/transform.scm (transform-vector2): Use 'vector2'.
  (translate, scale): Use new vector procedures.
* sly/transition.scm (guess-interpolator): Use new vector procedures.
* sly/window.scm (make-window, window-size, open-window): Use 'vector2'.
---
 .gitignore            |   1 +
 Makefile.am           |   2 +-
 sly/font.scm          |   1 -
 sly/game.scm          |   2 +-
 sly/joystick.scm      |   8 +--
 sly/keyboard.scm      |  10 ++--
 sly/math/vector.scm   | 159 ++++++++++++++++++++++++++++++++++++++++++++++++++
 sly/mesh.scm          |  47 ++++++++-------
 sly/mouse.scm         |   7 +--
 sly/quaternion.scm    |  12 ++--
 sly/rect.scm          |  26 ++++-----
 sly/scene.scm         |   3 +-
 sly/shader.scm        |   2 +-
 sly/shape.scm         |  97 +++++++++++++++---------------
 sly/sprite.scm        |  18 +++---
 sly/texture.scm       |  20 +++----
 sly/transform.scm     |  83 ++++++++++++++------------
 sly/transition.scm    |   6 +-
 sly/vector.scm        | 157 -------------------------------------------------
 sly/window.scm        |  11 ++--
 tests/math/vector.scm | 128 ++++++++++++++++++++++++++++++++++++++++
 21 files changed, 471 insertions(+), 329 deletions(-)
 create mode 100644 sly/math/vector.scm
 delete mode 100644 sly/vector.scm
 create mode 100644 tests/math/vector.scm

diff --git a/.gitignore b/.gitignore
index e0df7c2..f5c9fba 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,7 @@
 *~
 .#*
 *.go
+*.log
 autom4te.cache/
 build-aux/
 Makefile
diff --git a/Makefile.am b/Makefile.am
index 14adfa5..84653e4 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -36,6 +36,7 @@ SOURCES = 					\
   sly/keyboard.scm				\
   sly/live-reload.scm				\
   sly/math.scm					\
+  sly/math/vector.scm				\
   sly/mesh.scm					\
   sly/mouse.scm					\
   sly/quaternion.scm				\
@@ -50,7 +51,6 @@ SOURCES = 					\
   sly/tileset.scm				\
   sly/transform.scm				\
   sly/transition.scm				\
-  sly/vector.scm					\
   sly/window.scm					\
   sly/joystick.scm				\
   $(WRAPPER_SOURCES)
diff --git a/sly/font.scm b/sly/font.scm
index 51ae329..3a3a5f8 100644
--- a/sly/font.scm
+++ b/sly/font.scm
@@ -35,7 +35,6 @@
   #:use-module (sly shader)
   #:use-module (sly sprite)
   #:use-module (sly texture)
-  #:use-module (sly vector)
   #:export (enable-fonts
             load-font
             load-default-font
diff --git a/sly/game.scm b/sly/game.scm
index 729c586..efc092b 100644
--- a/sly/game.scm
+++ b/sly/game.scm
@@ -34,7 +34,7 @@
   #:use-module (sly math)
   #:use-module (sly scene)
   #:use-module (sly signal)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:use-module (sly window)
   #:export (draw-hook
             after-game-loop-error-hook
diff --git a/sly/joystick.scm b/sly/joystick.scm
index c6b8189..b94a883 100644
--- a/sly/joystick.scm
+++ b/sly/joystick.scm
@@ -25,7 +25,7 @@
   #:use-module ((sdl sdl) #:prefix SDL:)
   #:use-module (sly event)
   #:use-module (sly signal)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:re-export ((SDL:joystick-name . joystick-name)
@@ -126,7 +126,7 @@ values range from [-32768,32767]."
 (define (make-directional-signal-raw idx x-axis y-axis)
   "Create a signal for a Dpad or Analog stick with X and Y axes;
 values range from [-32768,32767]."
-  (signal-map vector
+  (signal-map vector2
               (axis-value-raw idx x-axis)
               (axis-value-raw idx y-axis)))
 
@@ -148,8 +148,8 @@ values are scaled to [-1,1]."
   "Create a signal for a Dpad or Analog stick with X and Y axes;
 values are scaled to [-1,1]."
   (signal-map (lambda (v)
-                (vector (axis-scale (vx v))
-                        (axis-scale (vy v))))
+                (vector2 (axis-scale (vx v))
+                         (axis-scale (vy v))))
               (make-directional-signal-raw idx x-axis y-axis)))
 
 (define-signal button-last-down
diff --git a/sly/keyboard.scm b/sly/keyboard.scm
index 65ad940..b6db9c2 100644
--- a/sly/keyboard.scm
+++ b/sly/keyboard.scm
@@ -25,7 +25,7 @@
   #:use-module ((sdl sdl) #:prefix SDL:)
   #:use-module (sly event)
   #:use-module (sly signal)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:export (key-press-hook
             key-release-hook
             key-last-down
@@ -75,10 +75,10 @@ KEY is pressed or #f otherwise."
 
 (define (key-directions up down left right)
   (signal-map (lambda (up? down? left? right?)
-                (vector (+ (if left? -1 0)
-                           (if right? 1 0))
-                        (+ (if up? -1 0)
-                           (if down? 1 0))))
+                (vector2 (+ (if left? -1 0)
+                            (if right? 1 0))
+                         (+ (if up? -1 0)
+                            (if down? 1 0))))
               (key-down? up)
               (key-down? down)
               (key-down? left)
diff --git a/sly/math/vector.scm b/sly/math/vector.scm
new file mode 100644
index 0000000..d2554fe
--- /dev/null
+++ b/sly/math/vector.scm
@@ -0,0 +1,159 @@
+;;; Sly
+;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Vector math.
+;;
+;;; Code:
+
+(define-module (sly math vector)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (sly math)
+  #:export (vector2
+            vector3
+            vector4
+            vector2? vector3? vector4?
+            vx vy vz vw
+            v+ v- v* vdot vcross
+            magnitude normalize))
+
+(define-record-type <vector2>
+  (vector2 x y)
+  vector2?
+  (x vector2-x)
+  (y vector2-y))
+
+(define-record-type <vector3>
+  (vector3 x y z)
+  vector3?
+  (x vector3-x)
+  (y vector3-y)
+  (z vector3-z))
+
+(define-record-type <vector4>
+  (vector4 x y z w)
+  vector4?
+  (x vector4-x)
+  (y vector4-y)
+  (z vector4-z)
+  (w vector4-w))
+
+(define vx
+  (match-lambda
+   (($ <vector2> x _)
+    x)
+   (($ <vector3> x _ _)
+    x)
+   (($ <vector4> x _ _ _)
+    x)))
+
+(define vy
+  (match-lambda
+   (($ <vector2> _ y)
+    y)
+   (($ <vector3> _ y _)
+    y)
+   (($ <vector4> _ y _ _)
+    y)))
+
+(define vz
+  (match-lambda
+   (($ <vector3> _ _ z)
+    z)
+   (($ <vector4> _ _ z _)
+    z)))
+
+(define vw vector4-w)
+
+(define-syntax-rule (vector-lambda proc)
+  (match-lambda*
+   ((($ <vector2> x1 y1) ($ <vector2> x2 y2))
+    (vector2 (proc x1 x2) (proc y1 y2)))
+   ((($ <vector2> x y) (? number? k))
+    (vector2 (proc x k) (proc y k)))
+   (((? number? k) ($ <vector2> x y))
+    (vector2 (proc k x) (proc k y)))
+   ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
+    (vector3 (proc x1 x2) (proc y1 y2) (proc z1 z2)))
+   ((($ <vector3> x y z) (? number? k))
+    (vector3 (proc x k) (proc y k) (proc z k)))
+   (((? number? k) ($ <vector3> x y z))
+    (vector3 (proc k x) (proc k y) (proc k z)))
+   ((($ <vector4> x1 y1 z1 w1) ($ <vector4> x2 y2 z2 w2))
+    (vector4 (proc x1 x2) (proc y1 y2) (proc z1 z2) (proc w1 w2)))
+   ((($ <vector4> x y z w) (? number? k))
+    (vector4 (proc x k) (proc y k) (proc z k) (proc w k)))
+   (((? number? k) ($ <vector4> x y z w))
+    (vector4 (proc k x) (proc k y) (proc k z) (proc k w)))))
+
+(define (v+ . vectors)
+  (reduce (vector-lambda +) 0 vectors))
+
+(define v-
+  (match-lambda*
+   ((v) (v- 0 v))
+   ((v v* ...)
+    (fold-right (let ((- (vector-lambda -)))
+                  (lambda (prev v)
+                    (- v prev)))
+                v v*))))
+
+(define (v* . vectors)
+  (reduce (vector-lambda *) 1 vectors))
+
+(define vdot
+  (match-lambda*
+   ((($ <vector2> x1 y1) ($ <vector2> x2 y2))
+    (+ (* x1 x2) (* y1 y2)))
+   ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
+    (+ (* x1 x2) (* y1 y2) (* z1 z2)))
+   ((($ <vector4> x1 y1 z1 w1) ($ <vector4> x2 y2 z2 w2))
+    (+ (* x1 x2) (* y1 y2) (* z1 z2) (* w1 w2)))))
+
+(define vcross
+  (match-lambda*
+   ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
+    (vector3 (- (* y1 z2) (* z1 y2))
+             (- (* z1 x2) (* x1 z2))
+             (- (* x1 y2) (* y1 x2))))))
+
+(define (magnitude v)
+  "Return the magnitude of the vector V."
+  (sqrt
+   (match v
+     (($ <vector2> x y)
+      (+ (square x) (square y)))
+     (($ <vector3> x y z)
+      (+ (square x) (square y) (square z)))
+     (($ <vector4> x y z w)
+      (+ (square x) (square y) (square z) (square w))))))
+
+(define (normalize v)
+  "Return the normalized form of the vector V."
+  (let ((m (magnitude v)))
+    (if (zero? m)
+        v
+        (match v
+          (($ <vector2> x y)
+           (vector2 (/ x m) (/ y m)))
+          (($ <vector3> x y z)
+           (vector3 (/ x m) (/ y m) (/ z m)))
+          (($ <vector4> x y z w)
+           (vector4 (/ x m) (/ y m) (/ z m) (/ w m)))))))
diff --git a/sly/mesh.scm b/sly/mesh.scm
index 1d7d89c..65154a7 100644
--- a/sly/mesh.scm
+++ b/sly/mesh.scm
@@ -34,7 +34,7 @@
   #:use-module (sly color)
   #:use-module (sly shader)
   #:use-module (sly texture)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:use-module (sly signal)
   #:export (make-mesh
             mesh?
@@ -78,27 +78,30 @@
                                     (attribute-size elem)))))
          (setter (if index? u32vector-set! f32vector-set!)))
     (vector-for-each
-     (cond
-      ((number? elem)
-       (lambda (i k)
-         (setter bv i k)))
-      ((or (vector2? elem)
-           (vector3? elem)
-           (vector4? elem))
-       (let ((dimensions (vector-length elem)))
-         (lambda (i v)
-           (let ((offset (* i dimensions)))
-             (vector-for-each
-              (lambda (j n)
-                (setter bv (+ offset j) n))
-              v)))))
-      ((color? elem)
-       (lambda (i 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))))))
+     (match-lambda*
+      ((i (? number? k))
+       (setter bv i k))
+      ((i (? vector2? v))
+       (let ((offset (* i 2)))
+         (setter bv offset (vx v))
+         (setter bv (1+ offset) (vy v))))
+      ((i (? vector3? v))
+       (let ((offset (* i 3)))
+         (setter bv offset (vx v))
+         (setter bv (1+ offset) (vy v))
+         (setter bv (+ offset 2) (vz v))))
+      ((i (? vector4? v))
+       (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))))
+      ((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))
 
diff --git a/sly/mouse.scm b/sly/mouse.scm
index 6ac56d2..1b4885a 100644
--- a/sly/mouse.scm
+++ b/sly/mouse.scm
@@ -25,7 +25,7 @@
   #:use-module ((sdl sdl) #:prefix SDL:)
   #:use-module (sly event)
   #:use-module (sly signal)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:export (mouse-move-hook
             mouse-press-hook
             mouse-click-hook
@@ -47,9 +47,8 @@
 
 (define-signal mouse-position
   (hook->signal mouse-move-hook
-                #(0 0)
-                (lambda (x y)
-                  (vector x y))))
+                (vector2 0 0)
+                vector2))
 
 (define-signal mouse-x (signal-map vx mouse-position))
 (define-signal mouse-y (signal-map vy mouse-position))
diff --git a/sly/quaternion.scm b/sly/quaternion.scm
index 68dd660..9bf9427 100644
--- a/sly/quaternion.scm
+++ b/sly/quaternion.scm
@@ -27,7 +27,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (sly math)
   #:use-module (sly transform)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:export (make-quaternion
             quaternion?
             quaternion-w quaternion-x quaternion-y quaternion-z
@@ -97,20 +97,20 @@ AXIS must be a 3D vector."
   (let* ((cos (cos (/ theta 2)))
          (sin (sin (/ theta 2))))
     (match axis
-      (#(x y z)
-       (make-quaternion cos (* x sin) (* y sin) (* z sin))))))
+      ((? vector3? v)
+       (make-quaternion cos (* (vx v) sin) (* (vy v) sin) (* (vz v) sin))))))
 
 (define (quaternion->vector q)
   "Convert the quaternion Q into a 4D vector."
   (match q
     (($ <quaternion> w x y z)
-     (vector w x y z))))
+     (vector4 w x y z))))
 
 (define (vector->quaternion v)
   "Convert the 4D vector V into a quaternion."
   (match v
-    (#(w x y z)
-     (make-quaternion w x y z))))
+    ((? vector4? v)
+     (make-quaternion (vx v) (vy v) (vz v) (vw v)))))
 
 (define (quaternion->transform q)
   "Convert the quaternion Q into a 4x4 transformation matrix."
diff --git a/sly/rect.scm b/sly/rect.scm
index 9b61299..fbe4654 100644
--- a/sly/rect.scm
+++ b/sly/rect.scm
@@ -24,7 +24,7 @@
 
 (define-module (sly rect)
   #:use-module (srfi srfi-9)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:export (<rect>
             make-rect
             null-rect
@@ -93,22 +93,22 @@
 
 (define (rect-position rect)
   "Return the top-left corner of RECT as a vector."
-  (vector (rect-x rect)
-          (rect-y rect)))
+  (vector2 (rect-x rect)
+           (rect-y rect)))
 
 (define rect-top-left rect-position)
 
 (define (rect-top-right rect)
-  (vector (rect-right rect)
-          (rect-top   rect)))
+  (vector2 (rect-right rect)
+           (rect-top   rect)))
 
 (define (rect-bottom-left rect)
-  (vector (rect-left   rect)
-          (rect-bottom rect)))
+  (vector2 (rect-left   rect)
+           (rect-bottom rect)))
 
 (define (rect-bottom-right rect)
-  (vector (rect-right  rect)
-          (rect-bottom rect)))
+  (vector2 (rect-right  rect)
+           (rect-bottom rect)))
 
 (define (rect-center-x rect)
   (+ (rect-x rect) (rect-half-width rect)))
@@ -117,8 +117,8 @@
   (+ (rect-y rect) (rect-half-height rect)))
 
 (define (rect-center rect)
-  (vector (rect-center-x rect)
-          (rect-center-y rect)))
+  (vector2 (rect-center-x rect)
+           (rect-center-y rect)))
 
 (define (rect-half-width rect)
   (/ (rect-width rect) 2))
@@ -128,8 +128,8 @@
 
 (define (rect-size rect)
   "Return the size of RECT as a vector."
-  (vector (rect-width rect)
-          (rect-height rect)))
+  (vector2 (rect-width rect)
+           (rect-height rect)))
 
 (define (%rect-move rect x y)
   "Move RECT by the offset X, Y."
diff --git a/sly/scene.scm b/sly/scene.scm
index bb748ca..a8b90b4 100644
--- a/sly/scene.scm
+++ b/sly/scene.scm
@@ -30,6 +30,7 @@
   #:use-module (sly signal)
   #:use-module (sly transform)
   #:use-module (sly transition)
+  #:use-module (sly math vector)
   #:export (scene-node
             make-scene-node
             scene-node?
@@ -51,7 +52,7 @@
   (children scene-node-children))
 
 (define* (make-scene-node #:optional #:key
-                           (position #(0 0))
+                           (position (vector2 0 0))
                            (scale 1)
                            (rotation identity-quaternion)
                            (uniforms '())
diff --git a/sly/shader.scm b/sly/shader.scm
index f12e0bb..2973010 100644
--- a/sly/shader.scm
+++ b/sly/shader.scm
@@ -27,7 +27,7 @@
   #:use-module (gl low-level)
   #:use-module (sly helpers)
   #:use-module (sly transform)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:use-module (sly color)
   #:use-module (sly config)
   #:use-module (sly wrappers gl)
diff --git a/sly/shape.scm b/sly/shape.scm
index 8ffe185..8283875 100644
--- a/sly/shape.scm
+++ b/sly/shape.scm
@@ -26,6 +26,7 @@
   #:use-module (sly mesh)
   #:use-module (sly shader)
   #:use-module (sly texture)
+  #:use-module (sly math vector)
   #:export (make-cube))
 
 (define* (make-cube size #:optional #:key (texture #f)
@@ -49,35 +50,35 @@
                    20 22 23 20 21 22)
      #:data `(("position" ,(vector
                             ;; Front
-                            (vector (- half-size) (- half-size) (- half-size))
-                            (vector half-size (- half-size) (- half-size))
-                            (vector half-size half-size (- half-size))
-                            (vector (- 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))
+                            (vector3 (- half-size) half-size (- half-size))
                             ;; Back
-                            (vector (- half-size) (- half-size) half-size)
-                            (vector half-size (- half-size) half-size)
-                            (vector half-size half-size half-size)
-                            (vector (- 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)
+                            (vector3 (- half-size) half-size half-size)
                             ;; Top
-                            (vector (- half-size) half-size (- half-size))
-                            (vector half-size half-size (- half-size))
-                            (vector half-size half-size half-size)
-                            (vector (- 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)
+                            (vector3 (- half-size) half-size half-size)
                             ;; Bottom
-                            (vector (- half-size) (- half-size) (- half-size))
-                            (vector half-size (- half-size) (- half-size))
-                            (vector half-size (- half-size) half-size)
-                            (vector (- 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)
+                            (vector3 (- half-size) (- half-size) half-size)
                             ;; Left
-                            (vector (- half-size) (- half-size) (- half-size))
-                            (vector (- half-size) half-size (- half-size))
-                            (vector (- half-size) half-size half-size)
-                            (vector (- 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)
+                            (vector3 (- half-size) (- half-size) half-size)
                             ;; Right
-                            (vector half-size (- half-size) (- half-size))
-                            (vector half-size half-size (- half-size))
-                            (vector half-size half-size half-size)
-                            (vector 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)
+                            (vector3 half-size (- half-size) half-size)))
               ,@(if texture
                    (let ((s1 (texture-s1 texture))
                          (t1 (texture-t1 texture))
@@ -86,33 +87,33 @@
                      `(("tex"
                         ,(vector
                           ;; Front
-                          (vector s1 t1)
-                          (vector s2 t1)
-                          (vector s2 t2)
-                          (vector s1 t2)
+                          (vector2 s1 t1)
+                          (vector2 s2 t1)
+                          (vector2 s2 t2)
+                          (vector2 s1 t2)
                           ;; Back
-                          (vector s1 t1)
-                          (vector s2 t1)
-                          (vector s2 t2)
-                          (vector s1 t2)
+                          (vector2 s1 t1)
+                          (vector2 s2 t1)
+                          (vector2 s2 t2)
+                          (vector2 s1 t2)
                           ;; Top
-                          (vector s1 t1)
-                          (vector s2 t1)
-                          (vector s2 t2)
-                          (vector s1 t2)
+                          (vector2 s1 t1)
+                          (vector2 s2 t1)
+                          (vector2 s2 t2)
+                          (vector2 s1 t2)
                           ;; Bottom
-                          (vector s1 t1)
-                          (vector s2 t1)
-                          (vector s2 t2)
-                          (vector s1 t2)
+                          (vector2 s1 t1)
+                          (vector2 s2 t1)
+                          (vector2 s2 t2)
+                          (vector2 s1 t2)
                           ;; Left
-                          (vector s1 t1)
-                          (vector s2 t1)
-                          (vector s2 t2)
-                          (vector s1 t2)
+                          (vector2 s1 t1)
+                          (vector2 s2 t1)
+                          (vector2 s2 t2)
+                          (vector2 s1 t2)
                           ;; Right
-                          (vector s1 t1)
-                          (vector s2 t1)
-                          (vector s2 t2)
-                          (vector 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 e717133..5b4ee81 100644
--- a/sly/sprite.scm
+++ b/sly/sprite.scm
@@ -37,7 +37,7 @@
   #:use-module (sly shader)
   #:use-module (sly signal)
   #:use-module (sly texture)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:export (make-sprite
             load-sprite
             make-animated-sprite))
@@ -67,15 +67,15 @@ custom SHADER can be specified."
      #:texture texture
      #:indices #(0 3 2 0 2 1)
      #:data `(("position" ,(vector
-                            (vector x1 y1 0)
-                            (vector x2 y1 0)
-                            (vector x2 y2 0)
-                            (vector x1 y2 0)))
+                            (vector3 x1 y1 0)
+                            (vector3 x2 y1 0)
+                            (vector3 x2 y2 0)
+                            (vector3 x1 y2 0)))
               ("tex" ,(vector
-                       (vector s1 t1)
-                       (vector s2 t1)
-                       (vector s2 t2)
-                       (vector s1 t2)))))))
+                       (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))
diff --git a/sly/texture.scm b/sly/texture.scm
index 3a74c2c..3d62f1f 100644
--- a/sly/texture.scm
+++ b/sly/texture.scm
@@ -30,7 +30,7 @@
   #:use-module (gl contrib packed-struct)
   #:use-module (sly color)
   #:use-module (sly helpers)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:use-module (sly wrappers gl)
   #:use-module (sly wrappers freeimage)
   #:export (make-texture
@@ -175,23 +175,23 @@ vector to be returned."
   (let ((w (texture-width texture))
         (h (texture-height texture)))
     (match anchor
-      (#(x y)
+      ((? vector2? anchor)
        anchor)
       ('center
-       (vector (/ w 2)
-               (/ h 2)))
+       (vector2 (/ w 2)
+                (/ h 2)))
       ('top-left
-       #(0 0))
+       (vector2 0 0))
       ('top-right
-       (vector w 0))
+       (vector2 w 0))
       ('bottom-left
-       (vector 0 h))
+       (vector2 0 h))
       ('bottom-right
-       (vector w h))
+       (vector2 w h))
       ('top-center
-       (vector (/ w 2) 0))
+       (vector2 (/ w 2) 0))
       ('bottom-center
-       (vector (/ w 2) h))
+       (vector2 (/ w 2) h))
       (_ (error "Invalid anchor type: " anchor)))))
 
 ;;;
diff --git a/sly/transform.scm b/sly/transform.scm
index 905edda..3b82c2e 100644
--- a/sly/transform.scm
+++ b/sly/transform.scm
@@ -27,7 +27,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-42)
   #:use-module (sly math)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:export (make-transform null-transform identity-transform
             transform? transform-matrix
             transpose transform-vector2
@@ -92,12 +92,12 @@ column-major format."
   (let ((m (transform-matrix transform))
         (x (vx v))
         (y (vy v)))
-    (vector (+ (* x (array-ref m 0 0))
-               (* y (array-ref m 0 1))
-               (array-ref m 0 3))
-            (+ (* x (array-ref m 1 0))
-               (* y (array-ref m 1 1))
-               (array-ref m 1 3)))))
+    (vector2 (+ (* x (array-ref m 0 0))
+                (* y (array-ref m 0 1))
+                (array-ref m 0 3))
+             (+ (* x (array-ref m 1 0))
+                (* y (array-ref m 1 1))
+                (array-ref m 1 3)))))
 
 (define (transform+ . transforms)
   "Return the sum of all given transformation matrices.  Return
@@ -130,41 +130,48 @@ identity-transform if called without any arguments."
       (%make-transform m3)))
   (reduce mul identity-transform transforms))
 
-(define (translate v)
-  "Return a new transform that translates by the 2D or 3D vector V."
-  (match v
-    (#(x y)
-     (make-transform 1 0 0 0
-                      0 1 0 0
-                      0 0 1 0
-                      x y 0 1))
-    (#(x y z)
-     (make-transform 1 0 0 0
-                      0 1 0 0
-                      0 0 1 0
-                      x y z 1))
-    (_ (error "Invalid translation vector: " v))))
-
-(define (scale v)
-  "Return a new transform that scales by the 2D vector, 3D vector, or
-scalar V."
-  (match v
+(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)))
+    (v (error "Invalid translation vector: " v))))
+
+(define scale
+  (match-lambda
    ((? number? v)
     (make-transform v 0 0 0
                     0 v 0 0
                     0 0 v 0
                     0 0 0 1))
-   (#(x y)
-    (make-transform x 0 0 0
-                    0 y 0 0
-                    0 0 1 0
-                    0 0 0 1))
-   (#(x y z)
-    (make-transform x 0 0 0
-                    0 y 0 0
-                    0 0 z 0
-                    0 0 0 1))
-   (_ (error "Invalid scaling vector: " v))))
+   ((? 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)))
+   (v (error "Invalid scaling vector: " v))))
 
 (define (rotate-x angle)
   "Return a new transform that rotates the X axis by ANGLE radians."
@@ -210,7 +217,7 @@ depth clipping plane NEAR and FAR."
                     0 0 (/ (+ far near) (- near far)) -1
                     0 0 (/ (* 2 far near) (- near far)) 0)))
 
-(define* (look-at eye center #:optional (up #(0 1 0)))
+(define* (look-at eye center #:optional (up (vector3 0 1 0)))
   (let* ((forward (normalize (v- center eye)))
          (side (normalize (vcross forward up)))
          (up (normalize (vcross side forward))))
diff --git a/sly/transition.scm b/sly/transition.scm
index 68ec18e..c923980 100644
--- a/sly/transition.scm
+++ b/sly/transition.scm
@@ -28,7 +28,7 @@
   #:use-module (sly math)
   #:use-module (sly quaternion)
   #:use-module (sly signal)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:export (ease-linear
             ease-in-sine ease-out-sine ease-in-out-sine
             ease-in-quad ease-out-quad ease-in-out-quad
@@ -122,7 +122,9 @@ range [0, 1]."
 
   (cond ((both? number?)
          number-interpolate)
-        ((both? vector?)
+        ((or (both? vector2?)
+             (both? vector3?)
+             (both? vector4?))
          vector-interpolate)
         ((both? color?)
          color-interpolate)
diff --git a/sly/vector.scm b/sly/vector.scm
deleted file mode 100644
index a41176e..0000000
--- a/sly/vector.scm
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; Sly
-;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
-;;;
-;;; This program is free software: you can redistribute it and/or
-;;; modify it under the terms of the GNU General Public License as
-;;; published by the Free Software Foundation, either version 3 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program.  If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Vector math.
-;;
-;;; Code:
-
-(define-module (sly vector)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-43)
-  #:export (vector2? vector3? vector4?
-                     vector-length= v=
-                     vx vy vz vw
-                     polar-vector
-                     v+ v- v* vdot vcross
-                     magnitude normalize))
-
-(define (vector-dimensionality? v d)
-  (and (vector? v) (= (vector-length v) d)))
-
-(define (vector2? v)
-  "Return #t if V is a 2D vector, #f otherwise."
-  (vector-dimensionality? v 2))
-
-(define (vector3? v)
-  "Return #t if V is a 3D vector, #f otherwise."
-  (vector-dimensionality? v 3))
-
-(define (vector4? v)
-  "Return #t if V is a 4D vector, #f otherwise."
-  (vector-dimensionality? v 4))
-
-(define (vector-length= v1 v2)
-  "Return #t if V1 and V2 are of the same dimensionality, #f
-otherwise."
-  (= (vector-length v1)
-     (vector-length v2)))
-
-(define (v= . vectors)
-  "Return #t if all arguments are equivalent vectors, #f otherwise."
-  (apply vector= = vectors))
-
-(define (vx v)
-  "Return the first component of the vector V."
-  (vector-ref v 0))
-
-(define (vy v)
-  "Return the second component of the vector V."
-  (vector-ref v 1))
-
-(define (vz v)
-  "Return the third component of the vector V."
-  (vector-ref v 2))
-
-(define (vw v)
-  "Return the fourth component of the vector V."
-  (vector-ref v 3))
-
-(define (polar-vector r theta)
-  "Create a 2D cartesian vector from the polar coordinates (R,
-THETA)."
-  (vector (* r (cos theta))
-          (* r (sin theta))))
-
-(define (dimension-error v1 v2)
-  (error "Vector dimensionality mismatch: " v1 v2))
-
-(define* (vreduce op vectors #:optional (reduce reduce))
-  (reduce (lambda args
-            (match args
-              (((? number? k) (? number? l))
-               (op k l))
-              (((? number? k) (? vector? v))
-               (vector-map (lambda (i n) (op k n)) v))
-              (((? vector? v) (? number? k))
-               (vector-map (lambda (i n) (op n k)) v))
-              (((? vector? v1) (? vector? v2))
-               (if (vector-length= v1 v2)
-                   (vector-map (lambda (i a b)
-                                 (op a b))
-                               v1 v2)
-                   (dimension-error v1 v2)))))
-          0 vectors))
-
-(define (v+ . vectors)
-  "Return the sum of all vectors.  All vectors must be of the same
-dimensionality.  Scalar values can be used to add to all components of
-the resulting vector."
-  (vreduce + vectors))
-
-(define v-
-  (case-lambda
-    "Return the difference of all vectors.  All vectors must be of the
-same dimensionality.  Scalar values can be used to subtract from all
-components of the resulting vector."
-    ((v) (v- 0 v))
-    ((v . rest)
-     (vreduce - (cons v rest) reduce-right))))
-
-(define (v* . vectors)
-  "Return the product of all VECTORS.  All vectors must be of the same
-dimensionality.  Scalar values can be used to multiply all components
-of the resulting vector."
-  (vreduce * vectors))
-
-(define (vdot v1 v2)
-  "Return the dot product of the vectors V1 and V2.  V1 and V2 must be
-of the same dimensionality."
-  (if (vector-length= v1 v2)
-      (vector-fold (lambda (i memo a b)
-                     (+ memo (* a b)))
-                   0 v1 v2)
-      (dimension-error v1 v2)))
-
-(define (vcross v1 v2)
-  "Return the cross product of the vectors V1 and V2.  V1 and V2 must
-both be 3D vectors."
-  (match (list v1 v2)
-    ((#(x1 y1 z1) #(x2 y2 z2))
-     (vector (- (* y1 z2) (* z1 y2))
-             (- (* z1 x2) (* x1 z2))
-             (- (* x1 y2) (* y1 x2))))
-    (_ (error "Expected 3D vectors: " v1 v2))))
-
-(define (magnitude v)
-  "Return the magnitude of the vector V."
-  (sqrt
-   (vector-fold (lambda (i memo n)
-                  (+ memo (expt n 2)))
-                0 v)))
-
-(define (normalize v)
-  "Normalize the vector V."
-  (let ((m (magnitude v)))
-    (if (zero? m)
-        v
-        (vector-map (lambda (i n)
-                      (/ n m))
-                    v))))
diff --git a/sly/window.scm b/sly/window.scm
index 0e400f5..10aee4d 100644
--- a/sly/window.scm
+++ b/sly/window.scm
@@ -28,7 +28,7 @@
   #:use-module (sly event)
   #:use-module (sly signal)
   #:use-module (sly transform)
-  #:use-module (sly vector)
+  #:use-module (sly math vector)
   #:export (make-window
             window?
             window-title
@@ -53,7 +53,7 @@
 
 (define* (make-window #:optional #:key
                       (title "Sly Window")
-                      (resolution #(640 480))
+                      (resolution (vector2 640 480))
                       (fullscreen? #f))
   (%make-window title resolution fullscreen?))
 
@@ -70,9 +70,8 @@
 
 (define-signal window-size
   (hook->signal window-resize-hook
-                #(0 0)
-                (lambda (width height)
-                  (vector width height))))
+                (vector2 0 0)
+                vector2))
 (define-signal window-width (signal-map vx window-size))
 (define-signal window-height (signal-map vy window-size))
 
@@ -95,7 +94,7 @@
   (let ((flags (if (window-fullscreen? window) '(opengl fullscreen) 'opengl))
         (width (vx (window-resolution window)))
         (height (vy (window-resolution window))))
-    (signal-set! window-size (vector width height))
+    (signal-set! window-size (vector2 width height))
     ;; Initialize everything
     (SDL:enable-unicode #t)
     (SDL:init 'everything)
diff --git a/tests/math/vector.scm b/tests/math/vector.scm
new file mode 100644
index 0000000..7b5b156
--- /dev/null
+++ b/tests/math/vector.scm
@@ -0,0 +1,128 @@
+;;; Sly
+;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (test-vector)
+  #:use-module (srfi srfi-64)
+  #:use-module (sly math vector))
+
+(test-begin "vector")
+
+(test-group "vx"
+  (test-equal 1 (vx (vector2 1 2)))
+  (test-equal 1 (vx (vector3 1 2 3)))
+  (test-equal 1 (vx (vector4 1 2 3 4))))
+
+(test-group "vy"
+  (test-equal 2 (vy (vector2 1 2)))
+  (test-equal 2 (vy (vector3 1 2 3)))
+  (test-equal 2 (vy (vector4 1 2 3 4))))
+
+(test-group "vz"
+  (test-equal 3 (vz (vector3 1 2 3)))
+  (test-equal 3 (vz (vector4 1 2 3 4))))
+
+(test-group "vw"
+  (test-equal 4 (vw (vector4 1 2 3 4))))
+
+(test-group "v+"
+  (test-equal 0 (v+))
+  (test-equal (vector2 1 1) (v+ (vector2 1 1)))
+  (test-equal (vector2 9 12)
+    (v+ (vector2 1 2) (vector2 3 4) (vector2 5 6)))
+  (test-equal (vector2 8 10)
+    (v+ (vector2 1 2) 3 (vector2 4 5)))
+  (test-equal (vector3 12 15 18)
+    (v+ (vector3 1 2 3) (vector3 4 5 6) (vector3 7 8 9)))
+  (test-equal (vector3 10 12 14)
+    (v+ (vector3 1 2 3) 4 (vector3 5 6 7)))
+  (test-equal (vector4 15 18 21 24)
+    (v+ (vector4 1 2 3 4) (vector4 5 6 7 8) (vector4 9 10 11 12)))
+  (test-equal (vector4 12 14 16 18)
+    (v+ (vector4 1 2 3 4) 5 (vector4 6 7 8 9))))
+
+(test-group "v+"
+  (test-equal 0 (v+))
+  (test-equal (vector2 1 1) (v+ (vector2 1 1)))
+  (test-equal (vector2 9 12)
+    (v+ (vector2 1 2) (vector2 3 4) (vector2 5 6)))
+  (test-equal (vector2 8 10)
+    (v+ (vector2 1 2) 3 (vector2 4 5)))
+  (test-equal (vector3 12 15 18)
+    (v+ (vector3 1 2 3) (vector3 4 5 6) (vector3 7 8 9)))
+  (test-equal (vector3 10 12 14)
+    (v+ (vector3 1 2 3) 4 (vector3 5 6 7)))
+  (test-equal (vector4 15 18 21 24)
+    (v+ (vector4 1 2 3 4) (vector4 5 6 7 8) (vector4 9 10 11 12)))
+  (test-equal (vector4 12 14 16 18)
+    (v+ (vector4 1 2 3 4) 5 (vector4 6 7 8 9))))
+
+(test-group "v-"
+  (test-equal (vector2 -1 -1) (v- (vector2 1 1)))
+  (test-equal (vector2 0 1)
+    (v- (vector2 6 5) (vector2 4 3) (vector2 2 1)))
+  (test-equal (vector2 0 0)
+    (v- (vector2 5 4) 3 (vector2 2 1)))
+  (test-equal (vector3 0 1 2)
+    (v- (vector3 9 8 7) (vector3 6 5 4) (vector3 3 2 1)))
+  (test-equal (vector3 0 0 0)
+    (v- (vector3 7 6 5) 4 (vector3 3 2 1)))
+  (test-equal (vector4 0 1 2 3)
+    (v- (vector4 12 11 10 9) (vector4 8 7 6 5) (vector4 4 3 2 1)))
+  (test-equal (vector4 0 0 0 0)
+    (v- (vector4 9 8 7 6) 5 (vector4 4 3 2 1))))
+
+(test-group "v*"
+  (test-equal 1 (v*))
+  (test-equal (vector2 1 1) (v* (vector2 1 1)))
+  (test-equal (vector2 15 48)
+    (v* (vector2 1 2) (vector2 3 4) (vector2 5 6)))
+  (test-equal (vector2 12 30)
+    (v* (vector2 1 2) 3 (vector2 4 5)))
+  (test-equal (vector3 28 80 162)
+    (v* (vector3 1 2 3) (vector3 4 5 6) (vector3 7 8 9)))
+  (test-equal (vector3 20 48 84)
+    (v* (vector3 1 2 3) 4 (vector3 5 6 7)))
+  (test-equal (vector4 45 120 231 384)
+    (v* (vector4 1 2 3 4) (vector4 5 6 7 8) (vector4 9 10 11 12)))
+  (test-equal (vector4 30 70 120 180)
+    (v* (vector4 1 2 3 4) 5 (vector4 6 7 8 9))))
+
+(test-group "vdot"
+  (test-equal 11 (vdot (vector2 1 2) (vector2 3 4)))
+  (test-equal 32 (vdot (vector3 1 2 3) (vector3 4 5 6)))
+  (test-equal 70 (vdot (vector4 1 2 3 4) (vector4 5 6 7 8))))
+
+(test-group "vcross"
+  (test-equal (vector3 -3 6 -3)
+    (vcross (vector3 2 3 4) (vector3 5 6 7))))
+
+(test-group "magnitude"
+  (test-equal 5 (magnitude (vector2 3 4)))
+  (test-equal 3 (magnitude (vector3 1 2 2)))
+  (test-equal 4 (magnitude (vector4 2 2 2 2))))
+
+(test-group "normalize"
+  (test-equal (vector2 0 0) (normalize (vector2 0 0)))
+  (test-equal (vector3 0 0 0) (normalize (vector3 0 0 0)))
+  (test-equal (vector4 0 0 0 0) (normalize (vector4 0 0 0 0)))
+  (test-equal (vector2 3/5 4/5) (normalize (vector2 3 4)))
+  (test-equal (vector3 1/3 2/3 2/3) (normalize (vector3 1 2 2)))
+  (test-equal (vector4 1/2 1/2 1/2 1/2) (normalize (vector4 2 2 2 2))))
+
+(test-end "vector")
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
-- 
cgit v1.2.3