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

Add support for quaternions in maths module and fix various compiling problems

Browse source
This commit is contained in:
Renaud Casenave-Péré 2014-10-11 17:16:41 +09:00
parent 61f963cb3d
commit c9b3877f64
9 changed files with 99 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/maths/float22.lisp
View file

@ -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)))

2
src/maths/float33.lisp
View file

@ -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)))

2
src/maths/float44.lisp
View file

@ -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)))

19
src/maths/geometry.lisp
View file

@ -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))

2
src/maths/maths.lisp
View file

@ -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'."

4
src/maths/matrix.lisp
View file

@ -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)

53
src/maths/quaternion.lisp Normal file
View file

@ -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)))

33
src/maths/vector.lisp
View file

@ -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)

1
stoe.asd
View file

@ -35,6 +35,7 @@
(:file "float22")
(:file "float33")
(:file "float44")
(:file "quaternion")
(:file "geometry")))
(:file "thread"
:depends-on ("utils"))