81 lines
2.8 KiB
Common Lisp
81 lines
2.8 KiB
Common Lisp
#|
|
|
This file is a part of stoe project.
|
|
Copyright (c) 2015 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|
|
|#
|
|
|
|
(uiop:define-package :stoe/maths/geometry
|
|
(:use :cl
|
|
:stoe/maths/utils
|
|
:stoe/maths/types
|
|
:stoe/maths/vector
|
|
:stoe/maths/matrix
|
|
:stoe/maths/quaternion)
|
|
(:export #:mtranslate #:mscale #:mrotate
|
|
#:mperspective #:morthogonal))
|
|
(in-package :stoe/maths/geometry)
|
|
|
|
(defun mtranslate (vec)
|
|
(let ((mat (mat-id 4 'single-float)))
|
|
(setf (mref mat 3 0) (vref vec 0))
|
|
(setf (mref mat 3 1) (vref vec 1))
|
|
(setf (mref mat 3 2) (vref vec 2))
|
|
mat))
|
|
|
|
(defun mscale (vec)
|
|
(let ((mat (mat-id 4 'single-float)))
|
|
(setf (mref mat 0 0) (vref vec 0))
|
|
(setf (mref mat 1 1) (vref vec 1))
|
|
(setf (mref mat 2 2) (vref vec 2))
|
|
mat))
|
|
|
|
(defun mrotate (angle &optional axis)
|
|
(let ((cos (cos angle))
|
|
(sin (sin angle)))
|
|
(cond
|
|
((null axis) (mat cos sin
|
|
(- sin) cos))
|
|
((eq axis :x) (mat 1.0 0.0 0.0 0.0
|
|
0.0 cos sin 0.0
|
|
0.0 (- sin) cos 0.0
|
|
0.0 0.0 0.0 1.0))
|
|
((eq axis :y) (mat cos 0.0 (- sin) 0.0
|
|
0.0 1.0 0.0 0.0
|
|
sin 0.0 cos 0.0
|
|
0.0 0.0 0.0 1.0))
|
|
((eq axis :z) (mat cos sin 0.0 0.0
|
|
(- sin) cos 0.0 0.0
|
|
0.0 0.0 1.0 0.0
|
|
0.0 0.0 0.0 1.0))
|
|
((subtypep (type-of axis) 'vect)
|
|
(let ((1-cos (- 1.0 cos))
|
|
(axis (safe-normalize axis nil))
|
|
(mat (mat-id 4 'single-float)))
|
|
(unless (null axis)
|
|
(with-swizzle (x y z) axis
|
|
(setf (mref mat 0 0) (+ (* 1-cos x x) cos))
|
|
(setf (mref mat 0 1) (+ (* 1-cos x y) (* sin z)))
|
|
(setf (mref mat 0 2) (- (* 1-cos x z) (* sin y)))
|
|
(setf (mref mat 1 0) (- (* 1-cos x y) (* sin z)))
|
|
(setf (mref mat 1 1) (+ (* 1-cos y y) cos))
|
|
(setf (mref mat 1 2) (+ (* 1-cos y z) (* sin x)))
|
|
(setf (mref mat 2 0) (+ (* 1-cos x z) (* sin y)))
|
|
(setf (mref mat 2 1) (- (* 1-cos y z) (* sin x)))
|
|
(setf (mref mat 2 2) (+ (* 1-cos z z) cos))))
|
|
mat)))))
|
|
|
|
(defun mperspective (fovy aspect near far)
|
|
(let ((range (tan (/ (deg-to-rad fovy) 2.0))))
|
|
(let ((left (* (- range) aspect))
|
|
(right (* range aspect))
|
|
(bottom (- range))
|
|
(top range))
|
|
(mat (/ (* near 2) (- right left)) 0.0 0.0 0.0
|
|
0.0 (/ (* near 2) (- top bottom)) 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 morthogonal (width height)
|
|
(mat (/ 2.0 width) 0.0 0.0 0.0
|
|
0.0 (/ -2.0 height) 0.0 0.0
|
|
0.0 0.0 1.0 0.0
|
|
-1.0 1.0 0.0 1.0))
|