# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1470232399 0
# Node ID 8a0c2154cda574eae4eee08038ce10c5c1e079ea
# Parent  6b92f156e83bc91d4ad763d091fc0082b9f643c8
Start writing up Yet Another Vector Library

diff -r 6b92f156e83b -r 8a0c2154cda5 package.lisp
--- a/package.lisp	Sun Jul 24 12:34:26 2016 +0000
+++ b/package.lisp	Wed Aug 03 13:53:19 2016 +0000
@@ -88,6 +88,60 @@
     #:update-tweens!
     ))
 
+(defpackage #:coding-math.vectors
+  (:use #:cl)
+  (:export
+    vec2
+    vec2f
+    vec2d
+    vec2i
+    vec2-add
+    vec2f-add
+    vec2d-add
+    vec2i-add
+    vec2-sub
+    vec2f-sub
+    vec2d-sub
+    vec2i-sub
+    vec2-mul
+    vec2f-mul
+    vec2d-mul
+    vec2i-mul
+    vec2-div
+    vec2f-div
+    vec2d-div
+    vec2i-div
+    vec2-eql
+    vec2f-eql
+    vec2d-eql
+    vec2i-eql
+    vec2-magnitude
+    vec2f-magnitude
+    vec2d-magnitude
+    vec2i-magnitude
+    vec2-length
+    vec2f-length
+    vec2d-length
+    vec2i-length
+    vec2-angle
+    vec2f-angle
+    vec2d-angle
+    vec2i-angle
+    vec2-direction
+    vec2f-direction
+    vec2d-direction
+    vec2i-direction
+    vec2-x
+    vec2f-x
+    vec2d-x
+    vec2i-x
+    vec2-y
+    vec2f-y
+    vec2d-y
+    vec2i-y
+    )
+  )
+
 
 ;;;; 2D stuff
 (defpackage #:coding-math.2d.vectors
diff -r 6b92f156e83b -r 8a0c2154cda5 src/math.lisp
--- a/src/math.lisp	Sun Jul 24 12:34:26 2016 +0000
+++ b/src/math.lisp	Wed Aug 03 13:53:19 2016 +0000
@@ -9,9 +9,6 @@
 
 
 ;; Basics
-(defun square (x)
-  (* x x))
-
 (defun dividesp (n divisor)
   "Return whether `n` is evenly divisible by `divisor`."
   (zerop (mod n divisor)))
diff -r 6b92f156e83b -r 8a0c2154cda5 src/vectors.lisp
--- /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