floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Rename some maths interfaces

Browse source
This commit is contained in:
Renaud Casenave-Péré 2015-08-26 17:58:40 +02:00
parent 6d3a0e19e7
commit 70c51eb04d
4 changed files with 68 additions and 70 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
engine/import.lisp
View file

@ -33,9 +33,9 @@
(defun import-transform (trans)
(let ((mat (mat-null 4 'single-float)))
(loop for i below (first (dimension mat))
do (loop for j below (second (dimension mat))
do (setf (mref mat i j) (aref trans (+ j (* i (second (dimension mat))))))))
(loop for i below (first (dimensions mat))
do (loop for j below (second (dimensions mat))
do (setf (mref mat i j) (aref trans (+ j (* i (second (dimensions mat))))))))
mat))
(defun import-nodes (node)

48
maths/matrix.lisp
View file

@ -15,14 +15,12 @@
#:m+ #:m- #:m*))
(in-package :stoe/maths/matrix)
(defmethod dimension ((m matrix)) (slot-value m 'dimensions))
(defmethod element-type ((m matrix)) (array-element-type (slot-value m 'array)))
(defun mref (m &rest subscripts)
(let ((len (length subscripts))
(dim-x (first (dimension m)))
(dim-y (second (dimension m))))
(dim-x (first (dimensions m)))
(dim-y (second (dimensions m))))
(assert (< len 3))
(case len
(2 (progn
@ -41,13 +39,13 @@
(assert (< len 4))
(case len
(3 (setf (aref (slot-value m 'array) (+ (* (first subscripts-or-value)
(second (dimension m)))
(second (dimensions m)))
(second subscripts-or-value)))
(third subscripts-or-value)))
(2 (let* ((dim (second (dimension m)))
(2 (let* ((dim (second (dimensions m)))
(offset (* (first subscripts-or-value) dim))
(v (second subscripts-or-value)))
(assert (= dim (dimension v)))
(assert (= dim (dimensions v)))
(loop for i below dim
do (setf (aref (slot-value m 'array) (+ i offset)) (vref v i))
finally (return (second subscripts-or-value))))))))
@ -67,7 +65,7 @@
(let ((dim-x (if (listp dims) (first dims) dims))
(dim-y (if (listp dims) (second dims) dims)))
(make-instance (matrix-type dim-x dim-y type)
:dimensions (list dim-x dim-y)
:dims (list dim-x dim-y)
:array (make-array (* dim-x dim-y) :element-type type))))
(defun mat-id (dim type)
@ -78,8 +76,8 @@
(defun clone-matrix (dims type mat)
(let ((m (mat-null dims type)))
(loop for i below (first (dimension mat))
do (loop for j below (second (dimension mat))
(loop for i below (first (dimensions mat))
do (loop for j below (second (dimensions mat))
do (setf (mref m i j) (mref mat i j))))
m))
@ -94,7 +92,7 @@
(defmacro mat (&rest attribs)
(once-only ((attrib (first attribs)))
(if (= (length attribs) 1)
`(clone-matrix (dimension ,attrib) (element-type ,attrib) ,attrib)
`(clone-matrix (dimensions ,attrib) (element-type ,attrib) ,attrib)
(let ((dim (list '+ 0)) type)
(loop for attr in attribs
do (progn
@ -104,7 +102,7 @@
((integerp attr) 'fixnum))))
(if (numberp attr)
(setf (cadr dim) (1+ (cadr dim)))
(setf dim (append dim (list `(dimension ,attr)))))))
(setf dim (append dim (list `(dimensions ,attr)))))))
`(let* ((len ,dim)
(dim-x (floor (sqrt len)))
(dim-y (if (= (* dim-x dim-x) len) dim-x (/ len dim-x))))
@ -164,8 +162,8 @@
(defgeneric transpose (m))
(defmethod transpose ((m matrix))
(let* ((dim-x (first (dimension m)))
(dim-y (second (dimension m)))
(let* ((dim-x (first (dimensions m)))
(dim-y (second (dimensions m)))
(transposed (mat-null (list dim-y dim-x) (element-type m))))
(loop for i below dim-x
do (loop for j below dim-y
@ -174,9 +172,9 @@
(defgeneric madd (m1 m2))
(defmethod madd ((m1 matrix) (m2 matrix))
(let ((dim (dimension m1))
(let ((dim (dimensions m1))
(type (element-type m1)))
(assert (equal dim (dimension m2)))
(assert (equal dim (dimensions m2)))
(assert (eq type (element-type m2)))
(let ((mat (mat-null dim (element-type m1))))
(loop for i below (apply #'* dim)
@ -190,9 +188,9 @@
(defgeneric msub (m1 m2))
(defmethod msub ((m1 matrix) (m2 matrix))
(let ((dim (dimension m1))
(let ((dim (dimensions m1))
(type (element-type m1)))
(assert (equal dim (dimension m2)))
(assert (equal dim (dimensions m2)))
(assert (eq type (element-type m2)))
(let ((mat (mat-null dim (element-type m1))))
(loop for i below (apply #'* dim)
@ -206,7 +204,7 @@
(defgeneric mmul (m1 m2))
(defmethod mmul ((m1 matrix) (m2 number))
(let* ((dim (dimension m1))
(let* ((dim (dimensions m1))
(mat (mat-null dim (element-type m1))))
(loop for i below (apply #'* dim)
do (setf (aref (slot-value mat 'array) i)
@ -217,8 +215,8 @@
(mmul m2 m1))
(defmethod mmul ((m1 matrix) (m2 matrix))
(let ((dim-1 (dimension m1))
(dim-2 (dimension m2))
(let ((dim-1 (dimensions m1))
(dim-2 (dimensions m2))
(type (element-type m1)))
(assert (= (first dim-1) (second dim-2)))
(assert (eq type (element-type m2)))
@ -232,8 +230,8 @@
mat)))
(defmethod mmul ((m1 matrix) (m2 vect))
(let* ((dim-1 (dimension m1))
(dim-2 (dimension m2))
(let* ((dim-1 (dimensions m1))
(dim-2 (dimensions m2))
(type (element-type m1)))
(assert (= (first dim-1) dim-2))
(assert (eq type (element-type m2)))
@ -245,8 +243,8 @@
vec)))
(defmethod mmul ((m1 vect) (m2 matrix))
(let* ((dim-1 (dimension m1))
(dim-2 (dimension m2))
(let* ((dim-1 (dimensions m1))
(dim-2 (dimensions m2))
(type (element-type m1)))
(assert (= dim-1 (second dim-2)))
(assert (eq type (element-type m2)))

18
maths/types.lisp
View file

@ -9,12 +9,18 @@
#:int2 #:int3 #:int4
#:float2 #:float3 #:float4
#:quaternion
#:matrix #:dimensions
#:matrix #:dims
#:int22 #:int33 #:int44
#:float22 #:float33 #:float44
#:dimension #:element-type))
#:dimensions #:element-type))
(in-package :stoe/maths/types)
(defgeneric dimensions (x))
(defmethod dimensions ((x number)) 1)
(defgeneric element-type (x))
(defmethod element-type ((x float)) 'single-float)
(defmethod element-type ((x integer)) 'fixnum)
(defclass vect ()
((array :type (array * (*))
:initarg :array
@ -43,7 +49,7 @@
())
(defclass matrix ()
((dimensions :initarg :dimensions
((dims :initarg :dims :reader dimensions
:documentation "The dimensions of the matrix")
(array :type (array * (*))
:initarg :array
@ -68,9 +74,3 @@
(defclass float44 (matrix)
((array :type (array single-float (16)))))
(defgeneric dimension (x))
(defmethod dimension ((x number)) 1)
(defgeneric element-type (x))
(defmethod element-type ((x float)) 'single-float)
(defmethod element-type ((x integer)) 'fixnum)

66
maths/vector.lisp
View file

@ -15,13 +15,13 @@
#:normalize #:safe-normalize))
(in-package :stoe/maths/vector)
(defmethod dimension ((v vect)) (array-dimension (slot-value v 'array) 0))
(defmethod dimension ((v int2)) 2)
(defmethod dimension ((v int3)) 3)
(defmethod dimension ((v int4)) 4)
(defmethod dimension ((v float2)) 2)
(defmethod dimension ((v float3)) 3)
(defmethod dimension ((v float4)) 4)
(defmethod dimensions ((v vect)) (array-dimension (slot-value v 'array) 0))
(defmethod dimensions ((v int2)) 2)
(defmethod dimensions ((v int3)) 3)
(defmethod dimensions ((v int4)) 4)
(defmethod dimensions ((v float2)) 2)
(defmethod dimensions ((v float3)) 3)
(defmethod dimensions ((v float4)) 4)
(defmethod element-type ((v vect)) (array-element-type (slot-value v 'array)))
(defmethod element-type ((v int2)) 'fixnum)
@ -43,7 +43,7 @@
(1+ subscript))
(defmethod fill-vector (v (attr vect) subscript)
(loop for i from 0 below (dimension attr)
(loop for i from 0 below (dimensions attr)
for j from subscript
do (setf (vref v j) (vref attr i))
finally (return (1+ j))))
@ -83,7 +83,7 @@
((integerp attr) 'fixnum))))
(if (numberp attr)
(setf (cadr dim) (1+ (cadr dim)))
(setf dim (append dim (list `(dimension ,attr)))))))
(setf dim (append dim (list `(dimensions ,attr)))))))
`(make-vector ,(if (eq (cddr dim) nil) (cadr dim) dim) ',type ,@attribs)))
(defmacro vec2 (&rest attribs)
@ -134,10 +134,10 @@
(defgeneric ,attribs (v))
(defmethod ,attribs ((v vect))
,(if (< len 2)
(ref-vect 'v '(dimension v) (char name 0) '(coerce 0 (element-type v)))
(ref-vect 'v '(dimensions v) (char name 0) '(coerce 0 (element-type v)))
`(make-vector ,len (element-type v)
,@(loop for x across name
collect (ref-vect 'v '(dimension v) x '(coerce 0 (element-type v)))))))
collect (ref-vect 'v '(dimensions v) x '(coerce 0 (element-type v)))))))
,@(loop for cls in '(int2 int3 int4 float2 float3 float4)
for type in '(fixnum fixnum fixnum single-float single-float single-float)
for dim in '(2 3 4 2 3 4)
@ -177,20 +177,20 @@
(defgeneric vadd (v1 v2))
(defmethod vadd ((v vect) (s number))
(let ((vec (make-vector (dimension v) (element-type v))))
(loop for i from 0 below (dimension v)
(let ((vec (make-vector (dimensions v) (element-type v))))
(loop for i from 0 below (dimensions v)
do (setf (vref vec i) (+ (vref v i) s)))
vec))
(defmethod vadd ((s number) (v vect))
(let ((vec (make-vector (dimension v) (element-type v))))
(loop for i from 0 below (dimension v)
(let ((vec (make-vector (dimensions v) (element-type v))))
(loop for i from 0 below (dimensions v)
do (setf (vref vec i) (+ s (vref v i))))
vec))
(defmethod vadd ((v1 vect) (v2 vect))
(let ((vec (make-vector (dimension v1) (element-type v1))))
(loop for i from 0 below (dimension v1)
(let ((vec (make-vector (dimensions v1) (element-type v1))))
(loop for i from 0 below (dimensions v1)
do (setf (vref vec i) (+ (vref v1 i) (vref v2 i))))
vec))
@ -204,20 +204,20 @@
(defgeneric vsub (v1 v2))
(defmethod vsub ((v vect) (s number))
(let ((vec (make-vector (dimension v) (element-type v))))
(loop for i from 0 below (dimension v)
(let ((vec (make-vector (dimensions v) (element-type v))))
(loop for i from 0 below (dimensions v)
do (setf (vref vec i) (- (vref v i) s)))
vec))
(defmethod vsub ((s number) (v vect))
(let ((vec (make-vector (dimension v) (element-type v))))
(loop for i from 0 below (dimension v)
(let ((vec (make-vector (dimensions v) (element-type v))))
(loop for i from 0 below (dimensions v)
do (setf (vref vec i) (- s (vref v i))))
vec))
(defmethod vsub ((v1 vect) (v2 vect))
(let ((vec (make-vector (dimension v1) (element-type v1))))
(loop for i from 0 below (dimension v1)
(let ((vec (make-vector (dimensions v1) (element-type v1))))
(loop for i from 0 below (dimensions v1)
do (setf (vref vec i) (- (vref v1 i) (vref v2 i))))
vec))
@ -228,18 +228,18 @@
(defun v- (&rest v-list)
(let ((v (first v-list)))
(reduce #'vsub v-list :initial-value (vec-null (dimension v) (element-type v)))))
(reduce #'vsub v-list :initial-value (vec-null (dimensions v) (element-type v)))))
(defgeneric vmul (v1 v2))
(defmethod vmul ((v vect) (s number))
(let ((vec (make-vector (dimension v) (element-type v))))
(loop for i from 0 below (dimension v)
(let ((vec (make-vector (dimensions v) (element-type v))))
(loop for i from 0 below (dimensions v)
do (setf (vref vec i) (* (vref v i) s)))
vec))
(defmethod vmul ((s number) (v vect))
(let ((vec (make-vector (dimension v) (element-type v))))
(loop for i from 0 below (dimension v)
(let ((vec (make-vector (dimensions v) (element-type v))))
(loop for i from 0 below (dimensions v)
do (setf (vref vec i) (* s (vref v i))))
vec))
@ -248,14 +248,14 @@
(defgeneric vdiv (v1 v2))
(defmethod vdiv ((v vect) (s number))
(let ((vec (make-vector (dimension v) (element-type v))))
(loop for i from 0 below (dimension v)
(let ((vec (make-vector (dimensions v) (element-type v))))
(loop for i from 0 below (dimensions v)
do (setf (vref vec i) (/ (vref v i) s)))
vec))
(defmethod vdiv ((s number) (v vect))
(let ((vec (make-vector (dimension v) (element-type v))))
(loop for i from 0 below (dimension v)
(let ((vec (make-vector (dimensions v) (element-type v))))
(loop for i from 0 below (dimensions v)
do (setf (vref vec i) (/ s (vref v i))))
vec))
@ -264,7 +264,7 @@
(defgeneric dot (v1 v2))
(defmethod dot ((v1 vect) (v2 vect))
(loop for i below (dimension v1)
(loop for i below (dimensions v1)
sum (* (vref v1 i) (vref v2 i))))
(defgeneric cross (v1 v2))