--- a/src/vectors.lisp Tue Aug 16 18:25:48 2016 +0000
+++ b/src/vectors.lisp Thu Aug 18 22:15:06 2016 +0000
@@ -20,8 +20,11 @@
;;;; Structs
(defmacro defvec (name slots arglist type default)
- `(defstruct (,name (:constructor ,name ,arglist))
- ,@(loop :for slot :in slots :collect `(,slot ,default :type ,type))))
+ `(progn
+ (declaim (inline ,name))
+ (defstruct (,name (:constructor ,name ,arglist))
+ ,@(loop :for slot :in slots :collect `(,slot ,default :type ,type)))
+ (declaim (notinline ,name))))
(defmacro defvec2 (name type default)
`(defvec ,name (x y) (&optional (x ,default) (y x)) ,type ,default))
@@ -51,25 +54,32 @@
;;;; 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))
+ `(progn
+ (declaim (inline ,vec-type))
+ (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)
+ (declaim (notinline ,vec-type))))
(defmacro defvec2ops (vec-type element-type)
(let ((add (symbolize vec-type '-add))
+ (add! (symbolize vec-type '-add!))
(sub (symbolize vec-type '-sub))
+ (sub! (symbolize vec-type '-sub!))
(mul (symbolize vec-type '-mul))
+ (mul! (symbolize vec-type '-mul!))
(div (symbolize vec-type '-div))
+ (div! (symbolize vec-type '-div!))
(eql (symbolize vec-type '-eql))
(magdir (symbolize vec-type '-magdir))
(magnitude (symbolize vec-type '-magnitude))
@@ -77,27 +87,28 @@
(angle (symbolize vec-type '-angle))
(direction (symbolize vec-type '-direction)))
`(progn
- (declaim (ftype (function (,element-type ,element-type)
- (values ,vec-type &optional))
- ,magdir))
+ (declaim
+ (ftype (function (,element-type ,element-type)
+ (values ,vec-type &optional))
+ ,magdir)
- (declaim (ftype (function (,vec-type ,vec-type)
- (values boolean &optional))
- ,eql))
+ (ftype (function (,vec-type ,vec-type &optional (or null ,element-type))
+ (values boolean &optional))
+ ,eql)
- (declaim (ftype (function (,vec-type ,vec-type)
- (values ,vec-type &optional))
- ,add ,sub))
+ (ftype (function (,vec-type ,vec-type)
+ (values ,vec-type &optional))
+ ,add ,sub ,add! ,sub!)
- (declaim (ftype (function (,vec-type ,element-type)
- (values ,vec-type &optional))
- ,mul ,div))
+ (ftype (function (,vec-type ,element-type)
+ (values ,vec-type &optional))
+ ,mul ,div ,mul! ,div!)
- (declaim (ftype (function (,vec-type)
- ,(if (eq 'fixnum element-type)
- `(values real &optional)
- `(values ,element-type &optional)))
- ,magnitude ,length ,angle ,direction))
+ (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
@@ -108,30 +119,53 @@
(* magnitude (cos direction))
(* magnitude (sin direction))))
- (defun ,eql (v1 v2)
- (and (= (vec-x v1) (vec-x v2))
- (= (vec-y v1) (vec-y v2))))
+ (defun ,eql (v1 v2 &optional epsilon)
+ (if epsilon
+ (and (<= (abs (- (vec-x v1) (vec-x v2))) epsilon)
+ (<= (abs (- (vec-y v1) (vec-y v2))) epsilon))
+ (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 ,add! (v1 v2)
+ (setf (vec-x v1) (wrap (+ (vec-x v1) (vec-x v2)))
+ (vec-y v1) (wrap (+ (vec-y v1) (vec-y v2))))
+ v1)
+
(defun ,sub (v1 v2)
(vec
(wrap (- (vec-x v1) (vec-x v2)))
(wrap (- (vec-y v1) (vec-y v2)))))
+ (defun ,sub! (v1 v2)
+ (setf (vec-x v1) (wrap (- (vec-x v1) (vec-x v2)))
+ (vec-y v1) (wrap (- (vec-y v1) (vec-y v2))))
+ v1)
+
(defun ,mul (v scalar)
(vec
(wrap (* (vec-x v) scalar))
(wrap (* (vec-y v) scalar))))
+ (defun ,mul! (v scalar)
+ (setf (vec-x v) (wrap (* (vec-x v) scalar))
+ (vec-y v) (wrap (* (vec-y v) scalar)))
+ v)
+
(defun ,div (v scalar)
(vec
(wrap (// (vec-x v) scalar))
(wrap (// (vec-y v) scalar))))
+ (defun ,div! (v scalar)
+ (setf (vec-x v) (wrap (// (vec-x v) scalar))
+ (vec-y v) (wrap (// (vec-y v) scalar)))
+ v)
+
(defuns (,magnitude ,length) (v)
(sqrt (+ (square (vec-x v))
(square (vec-y v)))))
@@ -145,5 +179,13 @@
(defvec2ops vec2d double-float)
(defvec2ops vec2i fixnum)
-(declaim (optimize (speed 3)))
-; vec2i-add
+; (declaim (optimize (speed 3) (safety 1) (debug 0)))
+; vec2i-eql
+; vec2f-add
+; vec2f-add!
+; vec2f-sub!
+; vec2f-mul!
+; vec2f-div
+; vec2f-mul
+; vec2f
+; vec2f-div!