--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/vectors.lisp	Wed Aug 03 13:53:19 2016 +0000
@@ -0,0 +1,136 @@
+(in-package #:coding-math.vectors)
+
+
+;;;; Utils
+(declaim (inline square))
+
+
+(defun symbolize (&rest args)
+  (intern (format nil "~{~A~}" args)))
+
+(defun square (x)
+  (* x x))
+
+(defmacro defuns (names &rest rest)
+  `(progn
+     ,@(loop :for name :in names :collect `(defun ,name ,@rest))))
+
+
+;;;; Structs
+(defmacro defvec (name slots arglist type default)
+  `(defstruct (,name (:constructor ,name ,arglist))
+     ,@(loop :for slot :in slots :collect `(,slot ,default :type ,type))))
+
+(defmacro defvec2 (name type default)
+  `(defvec ,name (x y) (&optional (x ,default) (y x)) ,type ,default))
+
+(defmacro defvec3 (name type default)
+  `(defvec ,name (x y z) (&optional (x ,default) (y x) (z y)) ,type ,default))
+
+(defmacro defvec4 (name type default)
+  `(defvec ,name (x y z w) (&optional (x ,default) (y x) (z y) (w z)) ,type ,default))
+
+
+(defvec2 vec2 real 0)
+(defvec2 vec2f single-float 0f0)
+(defvec2 vec2d double-float 0d0)
+(defvec2 vec2i fixnum 0)
+
+(defvec3 vec3 real 0)
+(defvec3 vec3f single-float 0f0)
+(defvec3 vec3d double-float 0d0)
+(defvec3 vec3i fixnum 0)
+
+(defvec4 vec4 real 0)
+(defvec4 vec4f single-float 0f0)
+(defvec4 vec4d double-float 0d0)
+(defvec4 vec4i fixnum 0)
+
+
+;;;; Operations
+(defmacro with-fns (vec-type element-type &body body)
+  `(macrolet
+    ((vec (&rest args) `(,',vec-type ,@args))
+     (vec-x (v) `(,(symbolize ',vec-type '-x) ,v))
+     (vec-y (v) `(,(symbolize ',vec-type '-y) ,v))
+     (vec-z (v) `(,(symbolize ',vec-type '-z) ,v))
+     (vec-w (v) `(,(symbolize ',vec-type '-w) ,v))
+     ,(if (eq element-type 'fixnum)
+        `(wrap (x) `(logand most-positive-fixnum ,x))
+        `(wrap (x) x))
+     ,(if (eq element-type 'fixnum)
+       `(// (x y) `(floor ,x ,y))
+       `(// (x y) `(/ ,x ,y))))
+    ,@body))
+
+(defmacro defvec2ops (vec-type element-type)
+  (let ((add (symbolize vec-type '-add))
+        (sub (symbolize vec-type '-sub))
+        (mul (symbolize vec-type '-mul))
+        (div (symbolize vec-type '-div))
+        (eql (symbolize vec-type '-eql))
+        (magnitude (symbolize vec-type '-magnitude))
+        (length (symbolize vec-type '-length))
+        (angle (symbolize vec-type '-angle))
+        (direction (symbolize vec-type '-direction)))
+    `(progn
+      (declaim (ftype (function (,vec-type ,vec-type)
+                                (values boolean &optional))
+                      ,eql))
+
+      (declaim (ftype (function (,vec-type ,vec-type)
+                                (values ,vec-type &optional))
+                      ,add ,sub))
+
+      (declaim (ftype (function (,vec-type ,element-type)
+                                (values ,vec-type &optional))
+                      ,mul ,div))
+
+      (declaim (ftype (function (,vec-type)
+                                ,(if (eq 'fixnum element-type)
+                                   `(values real &optional)
+                                   `(values ,element-type &optional)))
+                      ,magnitude ,length ,angle ,direction))
+
+      (with-fns
+        ,vec-type ,element-type
+
+        (defun ,eql (v1 v2)
+          (and (= (vec-x v1) (vec-x v2))
+               (= (vec-y v1) (vec-y v2))))
+
+        (defun ,add (v1 v2)
+          (vec
+            (wrap (+ (vec-x v1) (vec-x v2)))
+            (wrap (+ (vec-y v1) (vec-y v2)))))
+
+        (defun ,sub (v1 v2)
+          (vec
+            (wrap (- (vec-x v1) (vec-x v2)))
+            (wrap (- (vec-y v1) (vec-y v2)))))
+
+        (defun ,mul (v scalar)
+          (vec
+            (wrap (* (vec-x v) scalar))
+            (wrap (* (vec-y v) scalar))))
+
+        (defun ,div (v scalar)
+          (vec
+            (wrap (// (vec-x v) scalar))
+            (wrap (// (vec-y v) scalar))))
+
+        (defuns (,magnitude ,length) (v)
+          (sqrt (+ (square (vec-x v))
+                   (square (vec-y v)))))
+
+        (defuns (,angle ,direction) (v)
+          (atan (vec-y v) (vec-x v)))))))
+
+
+(defvec2ops vec2 real)
+(defvec2ops vec2f single-float)
+(defvec2ops vec2d double-float)
+(defvec2ops vec2i fixnum)
+
+(declaim (optimize (speed 3)))
+; vec2i-add