diff --git a/maths/matrix.lisp b/maths/matrix.lisp index 742a9b6..e8f9eb2 100644 --- a/maths/matrix.lisp +++ b/maths/matrix.lisp @@ -113,7 +113,7 @@ ,(if type `',type `(element-type ,attrib)) - ,@attribs)))))) + ,attrib ,@(rest attribs))))))) (defmacro mat2 (&rest attribs) (once-only ((attrib (first attribs))) @@ -129,7 +129,7 @@ ,(if type `',type `(element-type ,attrib)) - ,@attribs))))) + ,attrib ,@(rest attribs)))))) (defmacro mat3 (&rest attribs) (once-only ((attrib (first attribs))) @@ -145,7 +145,7 @@ ,(if type `',type `(element-type ,attrib)) - ,@attribs))))) + ,attrib ,@(rest attribs)))))) (defmacro mat4 (&rest attribs) (once-only ((attrib (first attribs))) @@ -161,7 +161,7 @@ ,(if type `',type `(element-type ,attrib)) - ,@attribs))))) + ,attrib ,@(rest attribs)))))) (defgeneric transpose (m)) (defmethod transpose ((m matrix)) diff --git a/maths/types.lisp b/maths/types.lisp index b41c4bd..a80f315 100644 --- a/maths/types.lisp +++ b/maths/types.lisp @@ -62,6 +62,11 @@ :reader raw-data :documentation "The internal representation of the matrix"))) +(defmethod print-object ((m matrix) stream) + (with-slots (dims array) m + (print-unreadable-object (m stream :type t) + (format stream "~a ~a" dims array)))) + (defclass int22 (matrix) ((array :type (array fixnum (4))))) diff --git a/maths/vector.lisp b/maths/vector.lisp index f7ee0bc..0a2d6d0 100644 --- a/maths/vector.lisp +++ b/maths/vector.lisp @@ -89,7 +89,7 @@ ,(if type `',type `(element-type ,attrib)) - ,@attribs)))) + ,attrib ,@(rest attribs))))) (defmacro vec2 (&rest attribs) (once-only ((attrib (first attribs))) @@ -182,6 +182,8 @@ (defswizzle xzw) (defswizzle yzw) (defswizzle xyzw) +(defswizzle xyxy) +(defswizzle wzyx) (defmacro with-swizzle (attr-list v &body body) "Binds a list of variables with x y z w or some swizzled vector for use in BODY" @@ -244,8 +246,11 @@ (- (y v1) (y v2)))) (defun v- (&rest v-list) - (let ((v (first v-list))) - (reduce #'vsub v-list :initial-value (vec-null (dimensions v) (element-type v))))) + (let ((v (first v-list)) + (r (rest v-list))) + (if (null r) + (vsub (vec-null (dimensions v) (element-type v)) v) + (reduce #'vsub v-list)))) (defgeneric vmul (v1 v2)) (defmethod vmul ((v vect) (s number)) diff --git a/test/all.lisp b/test/all.lisp index 0b501c0..3d4ffec 100644 --- a/test/all.lisp +++ b/test/all.lisp @@ -6,6 +6,7 @@ (uiop:define-package :stoe/test/all (:nicknames :test) (:use-reexport + :stoe/test/maths :stoe/test/jobs :stoe/test/resources :stoe/test/entity)) diff --git a/test/maths.lisp b/test/maths.lisp index b0fd473..0af6672 100644 --- a/test/maths.lisp +++ b/test/maths.lisp @@ -1,68 +1,64 @@ #| This file is a part of stoe project. - Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr) + Copyright (c) 2017 Renaud Casenave-Péré (renaud@casenave-pere.fr) |# -(in-package :cl-user) -(defpackage stoe-test.maths - (:use :cl - :stoe - :prove)) -(in-package :stoe-test.maths) +(uiop:define-package :stoe/test/maths + (:use :cl :prove :maths)) +(in-package :stoe/test/maths) -(plan 23) +(plan 20) (diag "Vector Constructor Tests") -(is (v:vec 1 2 3) #(1.0 2.0 3.0) "Float Vector Constructor" :test #'equalp) -(is (v:vec-int 1 2 3) #(1 2 3) "Integer Vector Constructor" :test #'equalp) -(is (f2:vec 2 3) (v:vec 2 3) "Float2 Constructor" :test #'equalp) -(is (f3:vec 2 3 4) (v:vec 2 3 4) "Float3 Constructor" :test #'equalp) -(is (f4:vec 2 3 4 5) (v:vec 2 3 4 5) "Float4 Constructor" :test #'equalp) +(is (raw-data (vec 1 2 3)) #(1 2 3) "Integer Vector Constructor" :test #'equalp) +(is (raw-data (vec 1.0 2.0 3.0)) #(1.0 2.0 3.0) "Float Vector Constructor" :test #'equalp) +(is (raw-data (vec 2.0 3.0)) #(2.0 3.0) "Float2 Constructor" :test #'equalp) +(is (raw-data (vec 2.0 3.0 4.0)) #(2.0 3.0 4.0) "Float3 Constructor" :test #'equalp) +(is (raw-data (vec 2.0 3.0 4.0 5.0)) #(2.0 3.0 4.0 5.0) "Float4 Constructor" :test #'equalp) -(defvar *vector2* (f2:vec 2 3)) -(defvar *vector3* (f3:vec 4 5 6)) -(defvar *vector4* (f4:vec 7 8 9 10)) +(defvar *vector2* (vec 2 3)) +(defvar *vector3* (vec 4 5 6)) +(defvar *vector4* (vec 7 8 9 10)) +(defvar *vector2f* (vec 2.0 3.0)) (diag "Swizzle Tests") -(is (v:swizzle *vector4* xy) (f2:vec 7 8) "Swizzle f4:xy" :test #'equalp) -(is (v:swizzle *vector2* xyz) (f3:vec 2 3 0) "Swizzle f2:xyz" :test #'equalp) -(is (v:swizzle *vector3* xyz) *vector3* "Swizzle f3:xyz (identity)" :test #'equalp) -(is (v:swizzle *vector4* wzyx) (f4:vec 10 9 8 7) "Swizzle f4:wzyx (reverse)" :test #'equalp) -(is (v:swizzle *vector2* xyxy) (f4:vec 2 3 2 3) - "Swizzle f2:xyxy (multiple attributes)" :test #'equalp) +(is (raw-data (xy *vector4*)) (raw-data (vec 7 8)) "Swizzle int4:xy" :test #'equalp) +(is (raw-data (xyz *vector2*)) (raw-data (vec 2 3 0)) "Swizzle int2:xyz" :test #'equalp) +(is (raw-data (xyz *vector3*)) (raw-data *vector3*) "Swizzle int3:xyz (identity)" :test #'equalp) +(is (raw-data (wzyx *vector4*)) (raw-data (vec 10 9 8 7)) "Swizzle int4:wzyx (reverse)" :test #'equalp) (diag "Simple vector operations") -(is (v:+ *vector2* (v:swizzle *vector4* xy)) #(9.0 11.0) "Add f2" :test #'equalp) -(is (v:- *vector3* *vector3*) #(0.0 0.0 0.0) "Substract f3 to itself" :test #'equalp) -(is (v:* *vector4* (v:swizzle *vector2* xyxy)) #(14.0 24.0 18.0 30.0) "Multiply f4" :test #'equalp) -(is (v:/ *vector2* (v:swizzle *vector3* xz)) #(0.5 0.5) "Divide f2" :test #'equalp) +(is (raw-data (v+ *vector2* (xy *vector4*))) #(9 11) "Add f2" :test #'equalp) +(is (raw-data (v- *vector3* *vector3*)) #(0 0 0) "Substract f3 to itself" :test #'equalp) (diag "Simple vector / scalar operations") -(is (v:+ *vector2* 3) #(5.0 6.0) "Add f2" :test #'equalp) -(is (v:- *vector3* 1) #(3.0 4.0 5.0) "Substract f3" :test #'equalp) -(is (v:* *vector4* 2) #(14.0 16.0 18.0 20.0) "Multiply f4" :test #'equalp) -(is (v:/ *vector2* 5) #(0.4 0.6) "Divide f2" :test #'equalp) +(is (raw-data (v+ *vector2* 3)) #(5 6) "Add f2" :test #'equalp) +(is (raw-data (v- *vector3* 1)) #(3 4 5) "Substract f3" :test #'equalp) +(is (raw-data (v* *vector4* 2)) #(14 16 18 20) "Multiply f4" :test #'equalp) +(is (raw-data (v/ *vector2f* 5)) #(0.4 0.6) "Divide f2" :test #'equalp) (diag "Matrix Constructor Tests") -(is (m:mat 1 2 3 4 5 6 7 8 9 10 11 12) #2A((1.0 2.0 3.0 4.0) (5.0 6.0 7.0 8.0) (9.0 10.0 11.0 12.0)) +(is (raw-data (mat 1 2 3 4 5 6 7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12) "Matrix Constructor" :test #'equalp) -(defvar *matrix22* (f22:mat 1 2 - 3 4)) -(defvar *matrix33* (f33:mat 1 2 3 - 4 5 6 - 7 8 9)) -(defvar *matrix44* (f44:mat 1 2 3 4 - 5 6 7 8 - 9 10 11 12 - 13 14 15 16)) +(defvar *matrix22* (mat 1 2 + 3 4)) +(defvar *matrix33* (mat 1 2 3 + 4 5 6 + 7 8 9)) +(defvar *matrix44* (mat 1 2 3 4 + 5 6 7 8 + 9 10 11 12 + 13 14 15 16)) +(defvar *matrix22f* (mat 1.0 2.0 + 3.0 4.0)) -(is *matrix22* #2a((1.0 2.0) (3.0 4.0)) "Matrix22 Constructor" :test #'equalp) -(is *matrix33* #2a((1.0 2.0 3.0) (4.0 5.0 6.0) (7.0 8.0 9.0)) "Matrix33 Constructor" :test #'equalp) -(is *matrix44* #2a((1.0 2.0 3.0 4.0) (5.0 6.0 7.0 8.0) (9.0 10.0 11.0 12.0) (13.0 14.0 15.0 16.0)) +(is (raw-data *matrix22*) #(1 2 3 4) "Matrix22 Constructor" :test #'equalp) +(is (raw-data *matrix33*) #(1 2 3 4 5 6 7 8 9) "Matrix33 Constructor" :test #'equalp) +(is (raw-data *matrix44*) #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) "Matrix44 Constructor" :test #'equalp) (diag "Simple Matrix Operations") -(is (m:+ *matrix22* (f22:mat-ident)) #2a((2.0 2.0) (3.0 5.0)) "Add f22" :test #'equalp) +(is (raw-data (m+ *matrix22* (mat-id 2 'fixnum))) #(2 2 3 5) "Add f22" :test #'equalp) (finalize)