# HG changeset patch # User Steve Losh # Date 1471558506 0 # Node ID ae02fff6fa6552dd40e1a2bf9ae1b3bf1f315e1f # Parent 8119f8eccbeddf226f12bc5b57b3b47084bdcb83 Add in-place vector mutators diff -r 8119f8eccbed -r ae02fff6fa65 package.lisp --- a/package.lisp Tue Aug 16 18:25:48 2016 +0000 +++ b/package.lisp Thu Aug 18 22:15:06 2016 +0000 @@ -82,58 +82,84 @@ (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-magdir - vec2f-magdir - vec2d-magdir - vec2i-magdir - 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 + #: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-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-magdir + #:vec2f-magdir + #:vec2d-magdir + #:vec2i-magdir + + #: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 ) ) diff -r 8119f8eccbed -r ae02fff6fa65 src/vectors.lisp --- 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!