diff --git a/src/maths/float22.lisp b/src/maths/float22.lisp index ff8cc60..feb8801 100644 --- a/src/maths/float22.lisp +++ b/src/maths/float22.lisp @@ -7,7 +7,7 @@ (defpackage stoe.maths.float22 (:nicknames :float22 :f22) (:use :cl) - (:export :mat :mat-null :mat-ident)) + (:export :float22 :mat :mat-null :mat-ident)) (in-package :stoe.maths.float22) (deftype float22 () '(simple-array single-float (2 2))) diff --git a/src/maths/float33.lisp b/src/maths/float33.lisp index 98b902e..83c550b 100644 --- a/src/maths/float33.lisp +++ b/src/maths/float33.lisp @@ -7,7 +7,7 @@ (defpackage stoe.maths.float33 (:nicknames :float33 :f33) (:use :cl) - (:export :mat :mat-null :mat-ident)) + (:export :float33 :mat :mat-null :mat-ident)) (in-package :stoe.maths.float33) (deftype float33 () '(simple-array single-float (3 3))) diff --git a/src/maths/float44.lisp b/src/maths/float44.lisp index 1a0265b..475296b 100644 --- a/src/maths/float44.lisp +++ b/src/maths/float44.lisp @@ -7,7 +7,7 @@ (defpackage stoe.maths.float44 (:nicknames :float44 :f44) (:use :cl) - (:export :mat :mat-null :mat-ident)) + (:export :float44 :mat :mat-null :mat-ident)) (in-package :stoe.maths.float44) (deftype float44 () '(simple-array single-float (4 4))) diff --git a/src/maths/geometry.lisp b/src/maths/geometry.lisp index f59beaf..4681940 100644 --- a/src/maths/geometry.lisp +++ b/src/maths/geometry.lisp @@ -7,7 +7,8 @@ (defpackage stoe.maths.geometry (:nicknames :geometry :geom) (:use :cl) - (:export :mat-trans :mat-scale :mat-rot)) + (:export :mat-trans :mat-scale :mat-rot + :make-persp-matrix :make-ortho-matrix)) (in-package :stoe.maths.geometry) (defun mat-trans (vec) @@ -51,3 +52,19 @@ (setf (aref mat 2 0) (- (* x z 1-cos) (* y sin))) (setf (aref mat 2 1) (+ (* y z 1-cos) (* x sin))))) mat))))) + +(defun calc-frustum-scale (fovy) + (/ 1.0 (tan (/ (maths:deg-to-rad fovy) 2.0)))) + +(defun make-persp-matrix (fovy aspect near far) + (let ((frustum-scale (calc-frustum-scale fovy))) + (f44:mat frustum-scale 0.0 0.0 0.0 + 0.0 (/ frustum-scale aspect) 0.0 0.0 + 0.0 0.0 (/ (+ far near) (- near far)) -1.0 + 0.0 0.0 (/ (* 2.0 far near) (- near far)) 0.0))) + +(defun make-ortho-matrix (width height) + (f44:mat (/ 2.0 width) 0.0 0.0 -1.0 + 0.0 (/ -2.0 height) 0.0 1.0 + 0.0 0.0 1.0 0.0 + 0.0 0.0 0.0 1.0)) diff --git a/src/maths/maths.lisp b/src/maths/maths.lisp index 75d93eb..6be5983 100644 --- a/src/maths/maths.lisp +++ b/src/maths/maths.lisp @@ -21,7 +21,7 @@ (defun rad-to-deg (rad) "Convert an angle from radian to degree." - (/ deg (/ (* (coerce pi 'single-float) 2.0) 360.0))) + (/ rad (/ (* (coerce pi 'single-float) 2.0) 360.0))) (defun clamp (number min max) "Clamp a `number' between `min' and `max'." diff --git a/src/maths/matrix.lisp b/src/maths/matrix.lisp index 165fc5c..453efb9 100644 --- a/src/maths/matrix.lisp +++ b/src/maths/matrix.lisp @@ -35,7 +35,7 @@ (let* ((ident-elt (coerce 1 type)) (mat (mat-null type dim dim))) (loop for i below dim - do (setf (aref mat i i) identity-elt)) + do (setf (aref mat i i) ident-elt)) mat)) (defun setrow (mat subscript vec) @@ -50,7 +50,7 @@ (defun setdiag (mat vec) (loop for i below (array-dimension vec 0) - do (sef (aref mat i i) (aref vec i))) + do (setf (aref mat i i) (aref vec i))) mat) (defun add-mat (mat-a mat-b) diff --git a/src/maths/quaternion.lisp b/src/maths/quaternion.lisp new file mode 100644 index 0000000..bc3b0a8 --- /dev/null +++ b/src/maths/quaternion.lisp @@ -0,0 +1,53 @@ +#| + This file is a part of stoe project. + Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr) +|# + +(in-package :cl-user) +(defpackage stoe.maths.quaternion + (:nicknames :quaternion :q) + (:use :cl) + (:shadow :* :conjugate) + (:export :quaternion :quat + :from-axis-and-angle + :to-float33 :to-float44 + :* :conjugate)) +(in-package :stoe.maths.quaternion) + +(deftype quaternion () '(simple-array single-float (4))) + +(defun quat (x y z w) + (v:normalize (v:vec x y z w))) + +(defun from-axis-and-angle (vec angle) + "Create a quaternion from an axis and an angle." + (let ((vec (v:normalize vec)) + (sin (coerce (sin (/ angle 2)) 'single-float)) + (cos (coerce (cos (/ angle 2)) 'single-float))) + (v:normalize (v:vec (v:* vec sin) cos)))) + +(defun conjugate (quat) + (quat (v:- (v:x quat)) (v:- (v:y quat)) (v:- (v:z quat)) (v:w quat))) + +(defun * (&rest quat-list) + (v:normalize (reduce (lambda (q1 q2) + (v:with-attributes ((ax x) (ay y) (az z) (aw w)) q1 + (v:with-attributes ((bx x) (by y) (bz z) (bw w)) q2 + (quat (cl:- (cl:+ (cl:* aw bx) (cl:* ax bw) (cl:* ay bz)) (cl:* az by)) + (cl:- (cl:+ (cl:* aw by) (cl:* ay bw) (cl:* az bx)) (cl:* ax bz)) + (cl:- (cl:+ (cl:* aw bz) (cl:* az bw) (cl:* ax by)) (cl:* ay bx)) + (cl:- (cl:* aw bw) (cl:* ax bx) (cl:* ay by) (cl:* az bz)))))) + quat-list))) + +(defun to-float33 (quat) + (v:with-attributes (x y z w) quat + (f33:mat (cl:- 1 (cl:* 2 y y) (cl:* 2 z z)) (cl:- (cl:* 2 x y) (cl:* 2 w z)) (cl:+ (cl:* 2 x z) (cl:* 2 w y)) + (cl:+ (cl:* 2 x y) (cl:* 2 w z)) (cl:- 1 (cl:* 2 x x) (cl:* 2 z z)) (cl:- (cl:* 2 y z) (cl:* 2 w x)) + (cl:- (cl:* 2 x z) (cl:* 2 w y)) (cl:+ (cl:* 2 y z) (cl:* 2 w x)) (cl:- 1 (cl:* 2 x x) (cl:* 2 y y))))) + +(defun to-float44 (quat) + (v:with-attributes (x y z w) quat + (f44:mat (cl:- 1 (cl:* 2 y y) (cl:* 2 z z)) (cl:- (cl:* 2 x y) (cl:* 2 w z)) (cl:+ (cl:* 2 x z) (cl:* 2 w y)) 0.0 + (cl:+ (cl:* 2 x y) (cl:* 2 w z)) (cl:- 1 (cl:* 2 x x) (cl:* 2 z z)) (cl:- (cl:* 2 y z) (cl:* 2 w x)) 0.0 + (cl:- (cl:* 2 x z) (cl:* 2 w y)) (cl:+ (cl:* 2 y z) (cl:* 2 w x)) (cl:- 1 (cl:* 2 x x) (cl:* 2 y y)) 0.0 + 0.0 0.0 0.0 1.0))) diff --git a/src/maths/vector.lisp b/src/maths/vector.lisp index 29f66cc..e07aa90 100644 --- a/src/maths/vector.lisp +++ b/src/maths/vector.lisp @@ -17,16 +17,22 @@ (defun make-vector (type components) (let ((dim (cl:length components))) - `(make-array ,dim :element-type ',type :initial-contents (list ,@(loop for i in components - collect (if (numberp i) - (coerce i type) - `(coerce ,i ',type))))))) + (make-array dim :element-type type :initial-contents (loop for i in components + collect (coerce i type))))) + +(defun decompose (&rest components) + "Decompose a list of potential vectors into a single list." + (reduce #'append (mapcar (lambda (attr) + (if (typep attr 'sequence) + (coerce attr 'list) + (list attr))) + components))) (defmacro vec (&rest components) - (make-vector 'single-float components)) + `(make-vector 'single-float (decompose ,@components))) (defmacro vec-int (&rest components) - (make-vector 'fixnum components)) + `(make-vector 'fixnum (decompose ,@components))) (defun x (vec) (if (> (array-dimension vec 0) 0) (aref vec 0) (coerce 0 (array-element-type vec)))) (defun y (vec) (if (> (array-dimension vec 0) 1) (aref vec 1) (coerce 0 (array-element-type vec)))) @@ -68,12 +74,15 @@ vec-list)) (defun - (&rest vec-list) - (reduce #'(lambda (a b) - (cond - ((not (typep a 'simple-array)) (op-scalar #'cl:- b a)) - ((not (typep b 'simple-array)) (op-scalar #'cl:- a b)) - (t (op-vec #'cl:- a b)))) - vec-list)) + (if (= (cl:length vec-list) 1) + (let ((vec (car vec-list))) + (map (type-of vec) #'cl:- vec)) + (reduce #'(lambda (a b) + (cond + ((not (typep a 'simple-array)) (op-scalar #'cl:- b a)) + ((not (typep b 'simple-array)) (op-scalar #'cl:- a b)) + (t (op-vec #'cl:- a b)))) + vec-list))) (defun * (&rest vec-list) (reduce #'(lambda (a b) diff --git a/stoe.asd b/stoe.asd index 49db159..9f4d81d 100644 --- a/stoe.asd +++ b/stoe.asd @@ -35,6 +35,7 @@ (:file "float22") (:file "float33") (:file "float44") + (:file "quaternion") (:file "geometry"))) (:file "thread" :depends-on ("utils"))