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

Add a geometry file to the maths module

Browse source
This commit is contained in:
Renaud Casenave-Péré 2014-01-02 20:51:15 +09:00
parent e47f9c7c05
commit 070f26270e
2 changed files with 55 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
src/maths/geometry.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.geometry
(:nicknames :geometry :geom)
(:use :cl)
(:export :mat-trans :mat-scale :mat-rot))
(in-package :stoe.maths.geometry)
(defun mat-trans (vec)
(declare (type f3:float3 vec))
(let ((mat (f44:mat-ident)))
(m:setcol mat 3 vec)))
(defun mat-scale (dim vec)
(let ((mat (m:mat-ident (array-element-type vec) dim)))
(m:setdiag mat vec)))
(defun mat-rot (angle &optional axis)
(let ((cos (cos angle))
(sin (sin angle)))
(cond
((null axis) (f22:mat cos (- sin) sin cos))
((eq axis :x) (f44:mat 1 0 0 0
0 cos (- sin) 0
0 sin cos 0
0 0 0 1))
((eq axis :y) (f44:mat cos 0 sin 0
0 1 0 0
(- sin) 0 cos 0
0 0 0 1))
((eq axis :z) (f44:mat cos (- sin) 0 0
sin cos 0 0
0 0 1 0
0 0 0 1))
((arrayp axis)
(let ((1-cos (- 1.0 cos))
(axis (v:safe-normalize axis nil))
(mat (f44:mat-ident)))
(unless (null axis)
(v:with-attributes (x y z) axis
(setf (aref mat 0 0) (+ (* x x) (* (- 1 (* x x)) cos)))
(setf (aref mat 0 1) (- (* x y 1-cos) (* z sin)))
(setf (aref mat 0 2) (+ (* x z 1-cos) (* y sin)))
(setf (aref mat 1 0) (+ (* x y 1-cos) (* z sin)))
(setf (aref mat 1 1) (+ (* y y) (* (- 1 (* y y)) cos)))
(setf (aref mat 1 2) (- (* y z 1-cos) (* x sin)))
(setf (aref mat 2 0) (- (* x z 1-cos) (* y sin)))
(setf (aref mat 2 1) (+ (* y z 1-cos) (* x sin)))))
mat)))))

3
stoe.asd
View file

@ -31,7 +31,8 @@
(:file "matrix")
(:file "float22")
(:file "float33")
(:file "float44")))
(:file "float44")
(:file "geometry")))
(:file "utils")
(:file "thread"
:depends-on ("utils"))