--- /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