module RSAGL.Math.Affine
(AffineTransformable(..),
scale',
inverseTransform,
withTransformation,
transformAbout,
translateToFrom,
rotateToFrom,
scaleAlong)
where
import Graphics.Rendering.OpenGL.GL as GL hiding (R)
import RSAGL.Math.Vector
import RSAGL.Math.Matrix
import RSAGL.Math.Angle
import RSAGL.Types
import Data.Maybe
class AffineTransformable a where
transform :: RSAGL.Math.Matrix.Matrix -> a -> a
scale :: Vector3D -> a -> a
scale vector = transform $ scaleMatrix vector
translate :: Vector3D -> a -> a
translate vector = transform $ translationMatrix vector
rotate :: Vector3D -> Angle -> a -> a
rotate vector angle = transform $ rotationMatrix vector angle
rotateX :: Angle -> a -> a
rotateX = RSAGL.Math.Affine.rotate (Vector3D 1 0 0)
rotateY :: Angle -> a -> a
rotateY = RSAGL.Math.Affine.rotate (Vector3D 0 1 0)
rotateZ :: Angle -> a -> a
rotateZ = RSAGL.Math.Affine.rotate (Vector3D 0 0 1)
inverseTransform :: (AffineTransformable a) => RSAGL.Math.Matrix.Matrix -> a -> a
inverseTransform m = transform (matrixInverse m)
scale' :: (AffineTransformable a) => RSdouble -> a -> a
scale' x = RSAGL.Math.Affine.scale (Vector3D x x x)
withTransformation :: (AffineTransformable a) => RSAGL.Math.Matrix.Matrix -> (a -> a) -> a -> a
withTransformation m f = inverseTransform m . f . transform m
transformAbout :: (AffineTransformable a) => Point3D -> (a -> a) -> a -> a
transformAbout center f = withTransformation (translateToFrom origin_point_3d center identity_matrix) f
translateToFrom :: (AffineTransformable a) => Point3D -> Point3D -> a -> a
translateToFrom a b = RSAGL.Math.Affine.translate (vectorToFrom a b)
rotateToFrom :: (AffineTransformable a) => Vector3D -> Vector3D -> a -> a
rotateToFrom u v = RSAGL.Math.Affine.rotate c a
where c = vectorNormalize $ vectorScale (1) $ fromMaybe (fst $ orthos u) $ aNonZeroVector $ crossProduct u v
a = angleBetween u v
scaleAlong :: (AffineTransformable a) => Vector3D -> RSdouble -> a -> a
scaleAlong v u = withTransformation (rotateToFrom (Vector3D 0 1 0) v identity_matrix) (RSAGL.Math.Affine.scale (Vector3D 1 u 1))
instance AffineTransformable a => AffineTransformable (Maybe a) where
transform m = fmap (transform m)
instance AffineTransformable a => AffineTransformable [a] where
transform m = map (transform m)
instance (AffineTransformable a,AffineTransformable b) => AffineTransformable (a,b) where
transform m (a,b) = (transform m a,transform m b)
instance (AffineTransformable a,AffineTransformable b,AffineTransformable c) => AffineTransformable (a,b,c) where
transform m (a,b,c) = (transform m a,transform m b,transform m c)
instance AffineTransformable RSAGL.Math.Matrix.Matrix where
transform mat = matrixMultiply mat
instance AffineTransformable Vector3D where
transform m (Vector3D x y z) = transformHomogenous x y z 0 Vector3D m
scale (Vector3D x1 y1 z1) (Vector3D x2 y2 z2) = Vector3D (x1*x2) (y1*y2) (z1*z2)
translate _ = id
rotateX a (Vector3D x y z) = Vector3D x (c*ys*z) (c*z+s*y)
where s = sine a
c = cosine a
rotateY a (Vector3D x y z) = Vector3D (c*x+s*z) y (c*zs*x)
where s = sine a
c = cosine a
rotateZ a (Vector3D x y z) = Vector3D (c*xs*y) (c*y+s*x) z
where s = sine a
c = cosine a
instance AffineTransformable Point3D where
transform m (Point3D x y z) = transformHomogenous x y z 1 Point3D m
scale (Vector3D x1 y1 z1) (Point3D x2 y2 z2) = Point3D (x1*x2) (y1*y2) (z1*z2)
translate (Vector3D x1 y1 z1) (Point3D x2 y2 z2) = Point3D (x1+x2) (y1+y2) (z1+z2)
rotateX a (Point3D x y z) = Point3D x (c*ys*z) (c*z+s*y)
where s = sine a
c = cosine a
rotateY a (Point3D x y z) = Point3D (c*x+s*z) y (c*zs*x)
where s = sine a
c = cosine a
rotateZ a (Point3D x y z) = Point3D (c*xs*y) (c*y+s*x) z
where s = sine a
c = cosine a
instance AffineTransformable SurfaceVertex3D where
transform m (SurfaceVertex3D p v) = SurfaceVertex3D (RSAGL.Math.Affine.transform m p) (RSAGL.Math.Affine.transform (matrixTranspose $ matrixInverse m) v)
translate vector (SurfaceVertex3D p v) = SurfaceVertex3D (RSAGL.Math.Affine.translate vector p) v
instance AffineTransformable (IO a) where
transform mat iofn = preservingMatrix $ do mat' <- newMatrix RowMajor $ map f2f $ concat $ rowMajorForm mat
multMatrix (mat' :: GLmatrix GLdouble)
iofn
translate (Vector3D x y z) iofn = preservingMatrix $
do GL.translate $ Vector3 (f2f x) (f2f y) (f2f z :: GLdouble)
iofn
scale (Vector3D x y z) iofn = preservingMatrix $
do GL.scale (f2f x) (f2f y) (f2f z :: GLdouble)
iofn
rotate (Vector3D x y z) angle iofn = preservingMatrix $
do GL.rotate (f2f $ toDegrees_ angle) (Vector3 (f2f x) (f2f y) (f2f z :: GLdouble))
iofn