From 44a2fc13f57454ed54223d028e287e053609971a Mon Sep 17 00:00:00 2001 From: Jeanne-Kamikaze Date: Thu, 21 Feb 2013 13:15:55 +0100 Subject: Made vector min/max part of Ord instance --- Spear/Math/AABB.hs | 4 +- Spear/Math/Circle.hs | 8 +- Spear/Math/Matrix3.hs | 480 ++++++++++++++--------------- Spear/Math/Matrix4.hs | 838 +++++++++++++++++++++++++------------------------- Spear/Math/Plane.hs | 2 +- Spear/Math/Vector2.hs | 278 ++++++++--------- Spear/Math/Vector3.hs | 40 +-- Spear/Math/Vector4.hs | 349 ++++++++++----------- 8 files changed, 985 insertions(+), 1014 deletions(-) diff --git a/Spear/Math/AABB.hs b/Spear/Math/AABB.hs index 55e3083..cd945a6 100644 --- a/Spear/Math/AABB.hs +++ b/Spear/Math/AABB.hs @@ -20,9 +20,9 @@ aabb :: [Vector2] -> AABB aabb [] = error "Attempting to build a BoundingVolume from an empty list!" aabb (x:xs) = foldr update (AABB x x) xs - where update p (AABB min max) = AABB (v2min p min) (v2max p max) + where update p (AABB pmin pmax) = AABB (min p pmin) (max p pmax) -- | Return 'True' if the given 'AABB' contains the given point, 'False' otherwise. aabbpt :: AABB -> Vector2 -> Bool -aabbpt (AABB min max) v = v >= min && v <= max +aabbpt (AABB pmin pmax) v = v >= pmin && v <= pmax diff --git a/Spear/Math/Circle.hs b/Spear/Math/Circle.hs index a34de0b..daaafc5 100644 --- a/Spear/Math/Circle.hs +++ b/Spear/Math/Circle.hs @@ -22,10 +22,10 @@ circle :: [Vector2] -> Circle circle [] = error "Attempting to build a Circle from an empty list!" circle (x:xs) = Circle c r where - c = min + (max-min)/2 - r = norm $ max - c - (min,max) = foldr update (x,x) xs - update p (min,max) = (v2min p min, v2max p max) + c = pmin + (pmax-pmin)/2 + r = norm $ pmax - c + (pmin,pmax) = foldr update (x,x) xs + update p (pmin,pmax) = (min p pmin, max p pmax) -- | Return 'True' if the given 'Sphere' contains the given point, 'False' otherwise. diff --git a/Spear/Math/Matrix3.hs b/Spear/Math/Matrix3.hs index adc4449..d5e46e9 100644 --- a/Spear/Math/Matrix3.hs +++ b/Spear/Math/Matrix3.hs @@ -1,162 +1,162 @@ -module Spear.Math.Matrix3 -( - Matrix3 - -- * Accessors -, m00, m01, m02 -, m10, m11, m12 -, m20, m21, m22 -, col0, col1, col2 +module Spear.Math.Matrix3 +( + Matrix3 + -- * Accessors +, m00, m01, m02 +, m10, m11, m12 +, m20, m21, m22 +, col0, col1, col2 , row0, row1, row2 -, right, up, forward, position - -- * Construction -, mat3 +, right, up, forward, position + -- * Construction +, mat3 , mat3fromVec , transform , translation -, rotation -, Spear.Math.Matrix3.id +, rotation +, Spear.Math.Matrix3.id -- * Transformations - -- ** Translation -, transl -, translv - -- ** Rotation -, rot - -- ** Scale -, Spear.Math.Matrix3.scale -, scalev - -- ** Reflection -, reflectX -, reflectY -, reflectZ - -- * Operations + -- ** Translation +, transl +, translv + -- ** Rotation +, rot + -- ** Scale +, Spear.Math.Matrix3.scale +, scalev + -- ** Reflection +, reflectX +, reflectY +, reflectZ + -- * Operations , transpose , mulp , muld , mul -, inverseTransform -, Spear.Math.Matrix3.zipWith -, Spear.Math.Matrix3.map -) -where - - -import Spear.Math.Vector2 as V2 -import Spear.Math.Vector3 as V3 - -import Foreign.Storable - - --- | Represents a 3x3 column major matrix. -data Matrix3 = Matrix3 - { m00 :: {-# UNPACK #-} !Float, m10 :: {-# UNPACK #-} !Float, m20 :: {-# UNPACK #-} !Float - , m01 :: {-# UNPACK #-} !Float, m11 :: {-# UNPACK #-} !Float, m21 :: {-# UNPACK #-} !Float - , m02 :: {-# UNPACK #-} !Float, m12 :: {-# UNPACK #-} !Float, m22 :: {-# UNPACK #-} !Float - } - - -instance Show Matrix3 where - - show (Matrix3 m00 m10 m20 m01 m11 m21 m02 m12 m22) = - show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ "\n" ++ - show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ "\n" ++ - show' m02 ++ ", " ++ show' m12 ++ ", " ++ show' m22 ++ "\n" - where - show' f = if abs f < 0.0000001 then "0" else show f - - -instance Num Matrix3 where - (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08) - + (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08) - = Matrix3 (a00 + b00) (a01 + b01) (a02 + b02) - (a03 + b03) (a04 + b04) (a05 + b05) - (a06 + b06) (a07 + b07) (a08 + b08) - - (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08) - - (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08) - = Matrix3 (a00 - b00) (a01 - b01) (a02 - b02) - (a03 - b03) (a04 - b04) (a05 - b05) - (a06 - b06) (a07 - b07) (a08 - b08) - - (Matrix3 a00 a10 a20 a01 a11 a21 a02 a12 a22) - * (Matrix3 b00 b10 b20 b01 b11 b21 b02 b12 b22) - = Matrix3 (a00 * b00 + a10 * b01 + a20 * b02) - (a00 * b10 + a10 * b11 + a20 * b12) - (a00 * b20 + a10 * b21 + a20 * b22) - - (a01 * b00 + a11 * b01 + a21 * b02) - (a01 * b10 + a11 * b11 + a21 * b12) - (a01 * b20 + a11 * b21 + a21 * b22) - - (a02 * b00 + a12 * b01 + a22 * b02) - (a02 * b10 + a12 * b11 + a22 * b12) - (a02 * b20 + a12 * b21 + a22 * b22) - - abs = Spear.Math.Matrix3.map abs - - signum = Spear.Math.Matrix3.map signum - - fromInteger i = mat3 i' i' i' i' i' i' i' i' i' where i' = fromInteger i - - -instance Storable Matrix3 where - sizeOf _ = 36 - alignment _ = 4 - - peek ptr = do - a00 <- peekByteOff ptr 0; a01 <- peekByteOff ptr 4; a02 <- peekByteOff ptr 8; - a10 <- peekByteOff ptr 12; a11 <- peekByteOff ptr 16; a12 <- peekByteOff ptr 20; - a20 <- peekByteOff ptr 24; a21 <- peekByteOff ptr 28; a22 <- peekByteOff ptr 32; - - return $ Matrix3 a00 a10 a20 - a01 a11 a21 - a02 a12 a22 - - poke ptr (Matrix3 a00 a01 a02 - a10 a11 a12 - a20 a21 a22) = do - pokeByteOff ptr 0 a00; pokeByteOff ptr 4 a01; pokeByteOff ptr 8 a02; - pokeByteOff ptr 12 a10; pokeByteOff ptr 16 a11; pokeByteOff ptr 20 a12; - pokeByteOff ptr 24 a20; pokeByteOff ptr 28 a21; pokeByteOff ptr 32 a22; - - -col0 (Matrix3 a00 _ _ a01 _ _ a02 _ _ ) = vec3 a00 a01 a02 -col1 (Matrix3 _ a10 _ _ a11 _ _ a12 _ ) = vec3 a10 a11 a12 -col2 (Matrix3 _ _ a20 _ _ a21 _ _ a22) = vec3 a20 a21 a22 - - -row0 (Matrix3 a00 a10 a20 _ _ _ _ _ _ ) = vec3 a00 a10 a20 -row1 (Matrix3 _ _ _ a01 a11 a21 _ _ _ ) = vec3 a01 a11 a21 +, inverseTransform +, Spear.Math.Matrix3.zipWith +, Spear.Math.Matrix3.map +) +where + + +import Spear.Math.Vector2 as V2 +import Spear.Math.Vector3 as V3 + +import Foreign.Storable + + +-- | Represents a 3x3 column major matrix. +data Matrix3 = Matrix3 + { m00 :: {-# UNPACK #-} !Float, m10 :: {-# UNPACK #-} !Float, m20 :: {-# UNPACK #-} !Float + , m01 :: {-# UNPACK #-} !Float, m11 :: {-# UNPACK #-} !Float, m21 :: {-# UNPACK #-} !Float + , m02 :: {-# UNPACK #-} !Float, m12 :: {-# UNPACK #-} !Float, m22 :: {-# UNPACK #-} !Float + } + + +instance Show Matrix3 where + + show (Matrix3 m00 m10 m20 m01 m11 m21 m02 m12 m22) = + show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ "\n" ++ + show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ "\n" ++ + show' m02 ++ ", " ++ show' m12 ++ ", " ++ show' m22 ++ "\n" + where + show' f = if abs f < 0.0000001 then "0" else show f + + +instance Num Matrix3 where + (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08) + + (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08) + = Matrix3 (a00 + b00) (a01 + b01) (a02 + b02) + (a03 + b03) (a04 + b04) (a05 + b05) + (a06 + b06) (a07 + b07) (a08 + b08) + + (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08) + - (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08) + = Matrix3 (a00 - b00) (a01 - b01) (a02 - b02) + (a03 - b03) (a04 - b04) (a05 - b05) + (a06 - b06) (a07 - b07) (a08 - b08) + + (Matrix3 a00 a10 a20 a01 a11 a21 a02 a12 a22) + * (Matrix3 b00 b10 b20 b01 b11 b21 b02 b12 b22) + = Matrix3 (a00 * b00 + a10 * b01 + a20 * b02) + (a00 * b10 + a10 * b11 + a20 * b12) + (a00 * b20 + a10 * b21 + a20 * b22) + + (a01 * b00 + a11 * b01 + a21 * b02) + (a01 * b10 + a11 * b11 + a21 * b12) + (a01 * b20 + a11 * b21 + a21 * b22) + + (a02 * b00 + a12 * b01 + a22 * b02) + (a02 * b10 + a12 * b11 + a22 * b12) + (a02 * b20 + a12 * b21 + a22 * b22) + + abs = Spear.Math.Matrix3.map abs + + signum = Spear.Math.Matrix3.map signum + + fromInteger i = mat3 i' i' i' i' i' i' i' i' i' where i' = fromInteger i + + +instance Storable Matrix3 where + sizeOf _ = 36 + alignment _ = 4 + + peek ptr = do + a00 <- peekByteOff ptr 0; a01 <- peekByteOff ptr 4; a02 <- peekByteOff ptr 8; + a10 <- peekByteOff ptr 12; a11 <- peekByteOff ptr 16; a12 <- peekByteOff ptr 20; + a20 <- peekByteOff ptr 24; a21 <- peekByteOff ptr 28; a22 <- peekByteOff ptr 32; + + return $ Matrix3 a00 a10 a20 + a01 a11 a21 + a02 a12 a22 + + poke ptr (Matrix3 a00 a01 a02 + a10 a11 a12 + a20 a21 a22) = do + pokeByteOff ptr 0 a00; pokeByteOff ptr 4 a01; pokeByteOff ptr 8 a02; + pokeByteOff ptr 12 a10; pokeByteOff ptr 16 a11; pokeByteOff ptr 20 a12; + pokeByteOff ptr 24 a20; pokeByteOff ptr 28 a21; pokeByteOff ptr 32 a22; + + +col0 (Matrix3 a00 _ _ a01 _ _ a02 _ _ ) = vec3 a00 a01 a02 +col1 (Matrix3 _ a10 _ _ a11 _ _ a12 _ ) = vec3 a10 a11 a12 +col2 (Matrix3 _ _ a20 _ _ a21 _ _ a22) = vec3 a20 a21 a22 + + +row0 (Matrix3 a00 a10 a20 _ _ _ _ _ _ ) = vec3 a00 a10 a20 +row1 (Matrix3 _ _ _ a01 a11 a21 _ _ _ ) = vec3 a01 a11 a21 row2 (Matrix3 _ _ _ _ _ _ a02 a12 a22) = vec3 a02 a12 a22 right (Matrix3 a00 _ _ a01 _ _ _ _ _) = vec2 a00 a01 up (Matrix3 _ a10 _ _ a11 _ _ _ _) = vec2 a10 a11 forward (Matrix3 _ a10 _ _ a11 _ _ _ _) = vec2 a10 a11 -position (Matrix3 _ _ a20 _ _ a21 _ _ _) = vec2 a20 a21 - - --- | Build a matrix from the specified values. -mat3 = Matrix3 - - --- | Build a matrix from three vectors in 3D. -mat3fromVec :: Vector3 -> Vector3 -> Vector3 -> Matrix3 -mat3fromVec v0 v1 v2 = Matrix3 - (V3.x v0) (V3.x v1) (V3.x v2) - (V3.y v0) (V3.y v1) (V3.y v2) - (V3.z v0) (V3.z v1) (V3.z v2) +position (Matrix3 _ _ a20 _ _ a21 _ _ _) = vec2 a20 a21 + + +-- | Build a matrix from the specified values. +mat3 = Matrix3 + + +-- | Build a matrix from three vectors in 3D. +mat3fromVec :: Vector3 -> Vector3 -> Vector3 -> Matrix3 +mat3fromVec v0 v1 v2 = Matrix3 + (V3.x v0) (V3.x v1) (V3.x v2) + (V3.y v0) (V3.y v1) (V3.y v2) + (V3.z v0) (V3.z v1) (V3.z v2) -- | Build a transformation matrix. transform :: Vector2 -- ^ Right vector -> Vector2 -- ^ Forward vector -> Vector2 -- ^ Position - -> Matrix3 -- ^ Transform + -> Matrix3 -- ^ Transform transform r f p = mat3 (V2.x r) (V2.x f) (V2.x p) (V2.y r) (V2.y f) (V2.y p) - 0 0 1 + 0 0 1 -- | Get the translation part of the given transformation matrix. @@ -181,14 +181,14 @@ rotation (Matrix3 a00 a10 0 a01 a11 0 a02 a12 1 - - --- | Return the identity matrix. -id :: Matrix3 -id = mat3 - 1 0 0 - 0 1 0 - 0 0 1 + + +-- | Return the identity matrix. +id :: Matrix3 +id = mat3 + 1 0 0 + 0 1 0 + 0 0 1 -- | Create a translation matrix. @@ -208,71 +208,71 @@ translv v = mat3 1 0 (V2.x v) 0 1 (V2.y v) 0 0 1 - - + + -- | Create a rotation matrix rotating counter-clockwise about the Z axis. --- --- The given angle must be in degrees. -rot :: Float -> Matrix3 -rot angle = mat3 - c (-s) 0 - s c 0 - 0 0 1 - where - s = sin . fromDeg $ angle - c = cos . fromDeg $ angle - - --- | Create a scale matrix. -scale :: Float -> Float -> Float -> Matrix3 -scale sx sy sz = mat3 - sx 0 0 - 0 sy 0 - 0 0 sz - - --- | Create a scale matrix. -scalev :: Vector3 -> Matrix3 -scalev v = mat3 - sx 0 0 - 0 sy 0 - 0 0 sz - where - sx = V3.x v - sy = V3.y v - sz = V3.z v - - --- | Create an X reflection matrix. -reflectX :: Matrix3 -reflectX = mat3 - (-1) 0 0 - 0 1 0 - 0 0 1 - - --- | Create a Y reflection matrix. -reflectY :: Matrix3 -reflectY = mat3 - 1 0 0 - 0 (-1) 0 - 0 0 1 - - --- | Create a Z reflection matrix. -reflectZ :: Matrix3 -reflectZ = mat3 - 1 0 0 - 0 1 0 - 0 0 (-1) - - --- | Transpose the specified matrix. -transpose :: Matrix3 -> Matrix3 -transpose m = mat3 - (m00 m) (m01 m) (m02 m) - (m10 m) (m11 m) (m12 m) - (m20 m) (m21 m) (m22 m) +-- +-- The given angle must be in degrees. +rot :: Float -> Matrix3 +rot angle = mat3 + c (-s) 0 + s c 0 + 0 0 1 + where + s = sin . fromDeg $ angle + c = cos . fromDeg $ angle + + +-- | Create a scale matrix. +scale :: Float -> Float -> Float -> Matrix3 +scale sx sy sz = mat3 + sx 0 0 + 0 sy 0 + 0 0 sz + + +-- | Create a scale matrix. +scalev :: Vector3 -> Matrix3 +scalev v = mat3 + sx 0 0 + 0 sy 0 + 0 0 sz + where + sx = V3.x v + sy = V3.y v + sz = V3.z v + + +-- | Create an X reflection matrix. +reflectX :: Matrix3 +reflectX = mat3 + (-1) 0 0 + 0 1 0 + 0 0 1 + + +-- | Create a Y reflection matrix. +reflectY :: Matrix3 +reflectY = mat3 + 1 0 0 + 0 (-1) 0 + 0 0 1 + + +-- | Create a Z reflection matrix. +reflectZ :: Matrix3 +reflectZ = mat3 + 1 0 0 + 0 1 0 + 0 0 (-1) + + +-- | Transpose the specified matrix. +transpose :: Matrix3 -> Matrix3 +transpose m = mat3 + (m00 m) (m01 m) (m02 m) + (m10 m) (m11 m) (m12 m) + (m20 m) (m21 m) (m22 m) -- | Transform the given point vector in 2D space with the given matrix. @@ -292,36 +292,36 @@ muld m v = vec2 x' y' v' = vec3 (V2.x v) (V2.y v) 0 x' = row0 m `V3.dot` v' y' = row1 m `V3.dot` v' - - --- | Transform the given vector in 3D space with the given matrix. -mul :: Matrix3 -> Vector3 -> Vector3 -mul m v = vec3 x' y' z' - where - v' = vec3 (V3.x v) (V3.y v) (V3.z v) - x' = row0 m `V3.dot` v' - y' = row1 m `V3.dot` v' - z' = row2 m `V3.dot` v' - - --- | Zip two 'Matrix3' together with the specified function. -zipWith :: (Float -> Float -> Float) -> Matrix3 -> Matrix3 -> Matrix3 -zipWith f a b = Matrix3 - (f (m00 a) (m00 b)) (f (m10 a) (m10 b)) (f (m20 a) (m20 b)) - (f (m01 a) (m01 b)) (f (m11 a) (m11 b)) (f (m21 a) (m21 b)) - (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b)) - - --- | Map the specified function to the specified 'Matrix3'. -map :: (Float -> Float) -> Matrix3 -> Matrix3 -map f m = Matrix3 - (f . m00 $ m) (f . m10 $ m) (f . m20 $ m) - (f . m01 $ m) (f . m11 $ m) (f . m21 $ m) + + +-- | Transform the given vector in 3D space with the given matrix. +mul :: Matrix3 -> Vector3 -> Vector3 +mul m v = vec3 x' y' z' + where + v' = vec3 (V3.x v) (V3.y v) (V3.z v) + x' = row0 m `V3.dot` v' + y' = row1 m `V3.dot` v' + z' = row2 m `V3.dot` v' + + +-- | Zip two 'Matrix3' together with the specified function. +zipWith :: (Float -> Float -> Float) -> Matrix3 -> Matrix3 -> Matrix3 +zipWith f a b = Matrix3 + (f (m00 a) (m00 b)) (f (m10 a) (m10 b)) (f (m20 a) (m20 b)) + (f (m01 a) (m01 b)) (f (m11 a) (m11 b)) (f (m21 a) (m21 b)) + (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b)) + + +-- | Map the specified function to the specified 'Matrix3'. +map :: (Float -> Float) -> Matrix3 -> Matrix3 +map f m = Matrix3 + (f . m00 $ m) (f . m10 $ m) (f . m20 $ m) + (f . m01 $ m) (f . m11 $ m) (f . m21 $ m) (f . m02 $ m) (f . m12 $ m) (f . m22 $ m) - - --- | Compute the inverse transform of the given transformation matrix. -inverseTransform :: Matrix3 -> Matrix3 + + +-- | Compute the inverse transform of the given transformation matrix. +inverseTransform :: Matrix3 -> Matrix3 inverseTransform mat = let r = right mat f = forward mat @@ -330,8 +330,8 @@ inverseTransform mat = (V2.x r) (V2.y r) (t `V2.dot` r) (V2.x f) (V2.y f) (t `V2.dot` f) 0 0 1 - - -fromDeg :: (Floating a) => a -> a -fromDeg = (*pi) . (/180) - + + +fromDeg :: (Floating a) => a -> a +fromDeg = (*pi) . (/180) + diff --git a/Spear/Math/Matrix4.hs b/Spear/Math/Matrix4.hs index a4ad651..41bfadd 100644 --- a/Spear/Math/Matrix4.hs +++ b/Spear/Math/Matrix4.hs @@ -1,194 +1,194 @@ -module Spear.Math.Matrix4 -( - Matrix4 - -- * Accessors -, m00, m01, m02, m03 -, m10, m11, m12, m13 -, m20, m21, m22, m23 -, m30, m31, m32, m33 -, col0, col1, col2, col3 -, row0, row1, row2, row3 -, right, up, forward, position - -- * Construction -, mat4 -, mat4fromVec +module Spear.Math.Matrix4 +( + Matrix4 + -- * Accessors +, m00, m01, m02, m03 +, m10, m11, m12, m13 +, m20, m21, m22, m23 +, m30, m31, m32, m33 +, col0, col1, col2, col3 +, row0, row1, row2, row3 +, right, up, forward, position + -- * Construction +, mat4 +, mat4fromVec , transform , translation , rotation -, lookAt -, Spear.Math.Matrix4.id - -- * Transformations - -- ** Translation -, transl -, translv - -- ** Rotation -, rotX -, rotY -, rotZ -, axisAngle - -- ** Scale -, Spear.Math.Matrix4.scale -, scalev - -- ** Reflection -, reflectX -, reflectY -, reflectZ - -- ** Projection -, ortho +, lookAt +, Spear.Math.Matrix4.id + -- * Transformations + -- ** Translation +, transl +, translv + -- ** Rotation +, rotX +, rotY +, rotZ +, axisAngle + -- ** Scale +, Spear.Math.Matrix4.scale +, scalev + -- ** Reflection +, reflectX +, reflectY +, reflectZ + -- ** Projection +, ortho , perspective -, planeProj - -- * Operations -, Spear.Math.Matrix4.zipWith -, Spear.Math.Matrix4.map -, transpose +, planeProj + -- * Operations +, Spear.Math.Matrix4.zipWith +, Spear.Math.Matrix4.map +, transpose , inverseTransform -, inverse -, mul -, mulp +, inverse +, mul +, mulp , muld -, mul' -) -where - - -import Spear.Math.Vector3 as V3 -import Spear.Math.Vector4 as V4 - -import Foreign.Storable - - --- | Represents a 4x4 column major matrix. -data Matrix4 = Matrix4 - { m00 :: {-# UNPACK #-} !Float, m10 :: {-# UNPACK #-} !Float, m20 :: {-# UNPACK #-} !Float, m30 :: {-# UNPACK #-} !Float - , m01 :: {-# UNPACK #-} !Float, m11 :: {-# UNPACK #-} !Float, m21 :: {-# UNPACK #-} !Float, m31 :: {-# UNPACK #-} !Float - , m02 :: {-# UNPACK #-} !Float, m12 :: {-# UNPACK #-} !Float, m22 :: {-# UNPACK #-} !Float, m32 :: {-# UNPACK #-} !Float - , m03 :: {-# UNPACK #-} !Float, m13 :: {-# UNPACK #-} !Float, m23 :: {-# UNPACK #-} !Float, m33 :: {-# UNPACK #-} !Float - } - - -instance Show Matrix4 where - - show (Matrix4 m00 m10 m20 m30 m01 m11 m21 m31 m02 m12 m22 m32 m03 m13 m23 m33) = - show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ ", " ++ show' m30 ++ "\n" ++ - show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ ", " ++ show' m31 ++ "\n" ++ - show' m02 ++ ", " ++ show' m12 ++ ", " ++ show' m22 ++ ", " ++ show' m32 ++ "\n" ++ - show' m03 ++ ", " ++ show' m13 ++ ", " ++ show' m23 ++ ", " ++ show' m33 ++ "\n" - where - show' f = if abs f < 0.0000001 then "0" else show f - - -instance Num Matrix4 where - (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15) - + (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15) - = Matrix4 (a00 + b00) (a01 + b01) (a02 + b02) (a03 + b03) - (a04 + b04) (a05 + b05) (a06 + b06) (a07 + b07) - (a08 + b08) (a09 + b09) (a10 + b10) (a11 + b11) - (a12 + b12) (a13 + b13) (a14 + b14) (a15 + b15) - - (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15) - - (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15) - = Matrix4 (a00 - b00) (a01 - b01) (a02 - b02) (a03 - b03) - (a04 - b04) (a05 - b05) (a06 - b06) (a07 - b07) - (a08 - b08) (a09 - b09) (a10 - b10) (a11 - b11) - (a12 - b12) (a13 - b13) (a14 - b14) (a15 - b15) - - (Matrix4 a00 a10 a20 a30 a01 a11 a21 a31 a02 a12 a22 a32 a03 a13 a23 a33) - * (Matrix4 b00 b10 b20 b30 b01 b11 b21 b31 b02 b12 b22 b32 b03 b13 b23 b33) - = Matrix4 (a00 * b00 + a10 * b01 + a20 * b02 + a30 * b03) - (a00 * b10 + a10 * b11 + a20 * b12 + a30 * b13) - (a00 * b20 + a10 * b21 + a20 * b22 + a30 * b23) - (a00 * b30 + a10 * b31 + a20 * b32 + a30 * b33) - - (a01 * b00 + a11 * b01 + a21 * b02 + a31 * b03) - (a01 * b10 + a11 * b11 + a21 * b12 + a31 * b13) - (a01 * b20 + a11 * b21 + a21 * b22 + a31 * b23) - (a01 * b30 + a11 * b31 + a21 * b32 + a31 * b33) - - (a02 * b00 + a12 * b01 + a22 * b02 + a32 * b03) - (a02 * b10 + a12 * b11 + a22 * b12 + a32 * b13) - (a02 * b20 + a12 * b21 + a22 * b22 + a32 * b23) - (a02 * b30 + a12 * b31 + a22 * b32 + a32 * b33) - - (a03 * b00 + a13 * b01 + a23 * b02 + a33 * b03) - (a03 * b10 + a13 * b11 + a23 * b12 + a33 * b13) - (a03 * b20 + a13 * b21 + a23 * b22 + a33 * b23) - (a03 * b30 + a13 * b31 + a23 * b32 + a33 * b33) - - abs = Spear.Math.Matrix4.map abs - - signum = Spear.Math.Matrix4.map signum - - fromInteger i = mat4 i' i' i' i' i' i' i' i' i' i' i' i' i' i' i' i' where i' = fromInteger i - - -instance Storable Matrix4 where - sizeOf _ = 64 - alignment _ = 4 - - peek ptr = do - a00 <- peekByteOff ptr 0; a01 <- peekByteOff ptr 4; a02 <- peekByteOff ptr 8; a03 <- peekByteOff ptr 12; - a10 <- peekByteOff ptr 16; a11 <- peekByteOff ptr 20; a12 <- peekByteOff ptr 24; a13 <- peekByteOff ptr 28; - a20 <- peekByteOff ptr 32; a21 <- peekByteOff ptr 36; a22 <- peekByteOff ptr 40; a23 <- peekByteOff ptr 44; - a30 <- peekByteOff ptr 48; a31 <- peekByteOff ptr 52; a32 <- peekByteOff ptr 56; a33 <- peekByteOff ptr 60; - - return $ Matrix4 a00 a10 a20 a30 - a01 a11 a21 a31 - a02 a12 a22 a32 - a03 a13 a23 a33 - - poke ptr (Matrix4 a00 a10 a20 a30 - a01 a11 a21 a31 - a02 a12 a22 a32 - a03 a13 a23 a33) = do - pokeByteOff ptr 0 a00; pokeByteOff ptr 4 a01; pokeByteOff ptr 8 a02; pokeByteOff ptr 12 a03; - pokeByteOff ptr 16 a10; pokeByteOff ptr 20 a11; pokeByteOff ptr 24 a12; pokeByteOff ptr 28 a13; - pokeByteOff ptr 32 a20; pokeByteOff ptr 36 a21; pokeByteOff ptr 40 a22; pokeByteOff ptr 44 a23; - pokeByteOff ptr 48 a30; pokeByteOff ptr 52 a31; pokeByteOff ptr 56 a32; pokeByteOff ptr 60 a33; - - -col0 (Matrix4 a00 _ _ _ a01 _ _ _ a02 _ _ _ a03 _ _ _ ) = vec4 a00 a01 a02 a03 -col1 (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ a13 _ _ ) = vec4 a10 a11 a12 a13 -col2 (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ a23 _ ) = vec4 a20 a21 a22 a23 -col3 (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ a33) = vec4 a30 a31 a32 a33 - - -row0 (Matrix4 a00 a01 a02 a03 _ _ _ _ _ _ _ _ _ _ _ _ ) = vec4 a00 a01 a02 a03 -row1 (Matrix4 _ _ _ _ a10 a11 a12 a13 _ _ _ _ _ _ _ _ ) = vec4 a10 a11 a12 a13 -row2 (Matrix4 _ _ _ _ _ _ _ _ a20 a21 a22 a23 _ _ _ _ ) = vec4 a20 a21 a22 a23 -row3 (Matrix4 _ _ _ _ _ _ _ _ _ _ _ _ a30 a31 a32 a33) = vec4 a30 a31 a32 a33 - - -right (Matrix4 a00 _ _ _ a01 _ _ _ a02 _ _ _ _ _ _ _) = vec3 a00 a01 a02 -up (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ _ _ _) = vec3 a10 a11 a12 -forward (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ _ _) = vec3 a20 a21 a22 -position (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ _) = vec3 a30 a31 a32 - - --- | Build a matrix from the specified values. -mat4 = Matrix4 - - --- | Build a matrix from four vectors in 4D. -mat4fromVec :: Vector4 -> Vector4 -> Vector4 -> Vector4 -> Matrix4 -mat4fromVec v0 v1 v2 v3 = Matrix4 - (V4.x v0) (V4.x v1) (V4.x v2) (V4.x v3) - (V4.y v0) (V4.y v1) (V4.y v2) (V4.y v3) - (V4.z v0) (V4.z v1) (V4.z v2) (V4.z v3) - (V4.w v0) (V4.w v1) (V4.w v2) (V4.w v3) - - --- | Build a transformation 'Matrix4' from the given vectors. -transform :: Vector3 -- ^ Right vector. - -> Vector3 -- ^ Up vector. - -> Vector3 -- ^ Forward vector. - -> Vector3 -- ^ Position. - -> Matrix4 - -transform right up fwd pos = mat4 - (V3.x right) (V3.x up) (V3.x fwd) (V3.x pos) - (V3.y right) (V3.y up) (V3.y fwd) (V3.y pos) - (V3.z right) (V3.z up) (V3.z fwd) (V3.z pos) - 0 0 0 1 +, mul' +) +where + + +import Spear.Math.Vector3 as V3 +import Spear.Math.Vector4 as V4 + +import Foreign.Storable + + +-- | Represents a 4x4 column major matrix. +data Matrix4 = Matrix4 + { m00 :: {-# UNPACK #-} !Float, m10 :: {-# UNPACK #-} !Float, m20 :: {-# UNPACK #-} !Float, m30 :: {-# UNPACK #-} !Float + , m01 :: {-# UNPACK #-} !Float, m11 :: {-# UNPACK #-} !Float, m21 :: {-# UNPACK #-} !Float, m31 :: {-# UNPACK #-} !Float + , m02 :: {-# UNPACK #-} !Float, m12 :: {-# UNPACK #-} !Float, m22 :: {-# UNPACK #-} !Float, m32 :: {-# UNPACK #-} !Float + , m03 :: {-# UNPACK #-} !Float, m13 :: {-# UNPACK #-} !Float, m23 :: {-# UNPACK #-} !Float, m33 :: {-# UNPACK #-} !Float + } + + +instance Show Matrix4 where + + show (Matrix4 m00 m10 m20 m30 m01 m11 m21 m31 m02 m12 m22 m32 m03 m13 m23 m33) = + show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ ", " ++ show' m30 ++ "\n" ++ + show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ ", " ++ show' m31 ++ "\n" ++ + show' m02 ++ ", " ++ show' m12 ++ ", " ++ show' m22 ++ ", " ++ show' m32 ++ "\n" ++ + show' m03 ++ ", " ++ show' m13 ++ ", " ++ show' m23 ++ ", " ++ show' m33 ++ "\n" + where + show' f = if abs f < 0.0000001 then "0" else show f + + +instance Num Matrix4 where + (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15) + + (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15) + = Matrix4 (a00 + b00) (a01 + b01) (a02 + b02) (a03 + b03) + (a04 + b04) (a05 + b05) (a06 + b06) (a07 + b07) + (a08 + b08) (a09 + b09) (a10 + b10) (a11 + b11) + (a12 + b12) (a13 + b13) (a14 + b14) (a15 + b15) + + (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15) + - (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15) + = Matrix4 (a00 - b00) (a01 - b01) (a02 - b02) (a03 - b03) + (a04 - b04) (a05 - b05) (a06 - b06) (a07 - b07) + (a08 - b08) (a09 - b09) (a10 - b10) (a11 - b11) + (a12 - b12) (a13 - b13) (a14 - b14) (a15 - b15) + + (Matrix4 a00 a10 a20 a30 a01 a11 a21 a31 a02 a12 a22 a32 a03 a13 a23 a33) + * (Matrix4 b00 b10 b20 b30 b01 b11 b21 b31 b02 b12 b22 b32 b03 b13 b23 b33) + = Matrix4 (a00 * b00 + a10 * b01 + a20 * b02 + a30 * b03) + (a00 * b10 + a10 * b11 + a20 * b12 + a30 * b13) + (a00 * b20 + a10 * b21 + a20 * b22 + a30 * b23) + (a00 * b30 + a10 * b31 + a20 * b32 + a30 * b33) + + (a01 * b00 + a11 * b01 + a21 * b02 + a31 * b03) + (a01 * b10 + a11 * b11 + a21 * b12 + a31 * b13) + (a01 * b20 + a11 * b21 + a21 * b22 + a31 * b23) + (a01 * b30 + a11 * b31 + a21 * b32 + a31 * b33) + + (a02 * b00 + a12 * b01 + a22 * b02 + a32 * b03) + (a02 * b10 + a12 * b11 + a22 * b12 + a32 * b13) + (a02 * b20 + a12 * b21 + a22 * b22 + a32 * b23) + (a02 * b30 + a12 * b31 + a22 * b32 + a32 * b33) + + (a03 * b00 + a13 * b01 + a23 * b02 + a33 * b03) + (a03 * b10 + a13 * b11 + a23 * b12 + a33 * b13) + (a03 * b20 + a13 * b21 + a23 * b22 + a33 * b23) + (a03 * b30 + a13 * b31 + a23 * b32 + a33 * b33) + + abs = Spear.Math.Matrix4.map abs + + signum = Spear.Math.Matrix4.map signum + + fromInteger i = mat4 i' i' i' i' i' i' i' i' i' i' i' i' i' i' i' i' where i' = fromInteger i + + +instance Storable Matrix4 where + sizeOf _ = 64 + alignment _ = 4 + + peek ptr = do + a00 <- peekByteOff ptr 0; a01 <- peekByteOff ptr 4; a02 <- peekByteOff ptr 8; a03 <- peekByteOff ptr 12; + a10 <- peekByteOff ptr 16; a11 <- peekByteOff ptr 20; a12 <- peekByteOff ptr 24; a13 <- peekByteOff ptr 28; + a20 <- peekByteOff ptr 32; a21 <- peekByteOff ptr 36; a22 <- peekByteOff ptr 40; a23 <- peekByteOff ptr 44; + a30 <- peekByteOff ptr 48; a31 <- peekByteOff ptr 52; a32 <- peekByteOff ptr 56; a33 <- peekByteOff ptr 60; + + return $ Matrix4 a00 a10 a20 a30 + a01 a11 a21 a31 + a02 a12 a22 a32 + a03 a13 a23 a33 + + poke ptr (Matrix4 a00 a10 a20 a30 + a01 a11 a21 a31 + a02 a12 a22 a32 + a03 a13 a23 a33) = do + pokeByteOff ptr 0 a00; pokeByteOff ptr 4 a01; pokeByteOff ptr 8 a02; pokeByteOff ptr 12 a03; + pokeByteOff ptr 16 a10; pokeByteOff ptr 20 a11; pokeByteOff ptr 24 a12; pokeByteOff ptr 28 a13; + pokeByteOff ptr 32 a20; pokeByteOff ptr 36 a21; pokeByteOff ptr 40 a22; pokeByteOff ptr 44 a23; + pokeByteOff ptr 48 a30; pokeByteOff ptr 52 a31; pokeByteOff ptr 56 a32; pokeByteOff ptr 60 a33; + + +col0 (Matrix4 a00 _ _ _ a01 _ _ _ a02 _ _ _ a03 _ _ _ ) = vec4 a00 a01 a02 a03 +col1 (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ a13 _ _ ) = vec4 a10 a11 a12 a13 +col2 (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ a23 _ ) = vec4 a20 a21 a22 a23 +col3 (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ a33) = vec4 a30 a31 a32 a33 + + +row0 (Matrix4 a00 a01 a02 a03 _ _ _ _ _ _ _ _ _ _ _ _ ) = vec4 a00 a01 a02 a03 +row1 (Matrix4 _ _ _ _ a10 a11 a12 a13 _ _ _ _ _ _ _ _ ) = vec4 a10 a11 a12 a13 +row2 (Matrix4 _ _ _ _ _ _ _ _ a20 a21 a22 a23 _ _ _ _ ) = vec4 a20 a21 a22 a23 +row3 (Matrix4 _ _ _ _ _ _ _ _ _ _ _ _ a30 a31 a32 a33) = vec4 a30 a31 a32 a33 + + +right (Matrix4 a00 _ _ _ a01 _ _ _ a02 _ _ _ _ _ _ _) = vec3 a00 a01 a02 +up (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ _ _ _) = vec3 a10 a11 a12 +forward (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ _ _) = vec3 a20 a21 a22 +position (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ _) = vec3 a30 a31 a32 + + +-- | Build a matrix from the specified values. +mat4 = Matrix4 + + +-- | Build a matrix from four vectors in 4D. +mat4fromVec :: Vector4 -> Vector4 -> Vector4 -> Vector4 -> Matrix4 +mat4fromVec v0 v1 v2 v3 = Matrix4 + (V4.x v0) (V4.x v1) (V4.x v2) (V4.x v3) + (V4.y v0) (V4.y v1) (V4.y v2) (V4.y v3) + (V4.z v0) (V4.z v1) (V4.z v2) (V4.z v3) + (V4.w v0) (V4.w v1) (V4.w v2) (V4.w v3) + + +-- | Build a transformation 'Matrix4' from the given vectors. +transform :: Vector3 -- ^ Right vector. + -> Vector3 -- ^ Up vector. + -> Vector3 -- ^ Forward vector. + -> Vector3 -- ^ Position. + -> Matrix4 + +transform right up fwd pos = mat4 + (V3.x right) (V3.x up) (V3.x fwd) (V3.x pos) + (V3.y right) (V3.y up) (V3.y fwd) (V3.y pos) + (V3.z right) (V3.z up) (V3.z fwd) (V3.z pos) + 0 0 0 1 -- | Get the translation part of the given transformation matrix. @@ -230,198 +230,198 @@ lookAt pos target = u = r `cross` fwd in transform r u (-fwd) pos - - --- | Zip two matrices together with the specified function. -zipWith :: (Float -> Float -> Float) -> Matrix4 -> Matrix4 -> Matrix4 -zipWith f a b = Matrix4 - (f (m00 a) (m00 b)) (f (m10 a) (m10 b)) (f (m20 a) (m20 b)) (f (m30 a) (m30 b)) - (f (m01 a) (m01 b)) (f (m11 a) (m11 b)) (f (m21 a) (m21 b)) (f (m31 a) (m31 b)) - (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b)) (f (m32 a) (m32 b)) - (f (m03 a) (m03 b)) (f (m13 a) (m13 b)) (f (m23 a) (m23 b)) (f (m33 a) (m33 b)) - - --- | Map the specified function to the specified matrix. -map :: (Float -> Float) -> Matrix4 -> Matrix4 -map f m = Matrix4 - (f . m00 $ m) (f . m10 $ m) (f . m20 $ m) (f . m30 $ m) - (f . m01 $ m) (f . m11 $ m) (f . m21 $ m) (f . m31 $ m) - (f . m02 $ m) (f . m12 $ m) (f . m22 $ m) (f . m32 $ m) - (f . m03 $ m) (f . m13 $ m) (f . m23 $ m) (f . m33 $ m) - - --- | Return the identity matrix. -id :: Matrix4 -id = mat4 - 1 0 0 0 - 0 1 0 0 - 0 0 1 0 - 0 0 0 1 - - --- | Create a translation matrix. -transl :: Float -> Float -> Float -> Matrix4 -transl x y z = mat4 - 1 0 0 x - 0 1 0 y - 0 0 1 z - 0 0 0 1 - - --- | Create a translation matrix. -translv :: Vector3 -> Matrix4 -translv v = mat4 - 1 0 0 (V3.x v) - 0 1 0 (V3.y v) - 0 0 1 (V3.z v) - 0 0 0 1 - - --- | Create a rotation matrix rotating about the X axis. --- The given angle must be in degrees. -rotX :: Float -> Matrix4 -rotX angle = mat4 - 1 0 0 0 - 0 c (-s) 0 - 0 s c 0 - 0 0 0 1 - where - s = sin . toRAD $ angle - c = cos . toRAD $ angle - - --- | Create a rotation matrix rotating about the Y axis. --- The given angle must be in degrees. -rotY :: Float -> Matrix4 -rotY angle = mat4 - c 0 s 0 - 0 1 0 0 - (-s) 0 c 0 - 0 0 0 1 - where - s = sin . toRAD $ angle - c = cos . toRAD $ angle - - --- | Create a rotation matrix rotating about the Z axis. --- The given angle must be in degrees. -rotZ :: Float -> Matrix4 -rotZ angle = mat4 - c (-s) 0 0 - s c 0 0 - 0 0 1 0 - 0 0 0 1 - where - s = sin . toRAD $ angle - c = cos . toRAD $ angle - - --- | Create a rotation matrix rotating about the specified axis. --- The given angle must be in degrees. -axisAngle :: Vector3 -> Float -> Matrix4 -axisAngle v angle = mat4 - (c + omc*x^2) (omc*xy-sz) (omc*xz+sy) 0 - (omc*xy+sz) (c+omc*y^2) (omc*yz-sx) 0 - (omc*xz-sy) (omc*yz+sx) (c+omc*z^2) 0 - 0 0 0 1 - where - x = V3.x v - y = V3.y v - z = V3.z v - s = sin . toRAD $ angle - c = cos . toRAD $ angle - xy = x*y - xz = x*z - yz = y*z - sx = s*x - sy = s*y - sz = s*z - omc = 1 - c - - --- | Create a scale matrix. -scale :: Float -> Float -> Float -> Matrix4 -scale sx sy sz = mat4 - sx 0 0 0 - 0 sy 0 0 - 0 0 sz 0 - 0 0 0 1 - - --- | Create a scale matrix. -scalev :: Vector3 -> Matrix4 -scalev v = mat4 - sx 0 0 0 - 0 sy 0 0 - 0 0 sz 0 - 0 0 0 1 - where - sx = V3.x v - sy = V3.y v - sz = V3.z v - - --- | Create an X reflection matrix. -reflectX :: Matrix4 -reflectX = mat4 - (-1) 0 0 0 - 0 1 0 0 - 0 0 1 0 - 0 0 0 1 - - --- | Create a Y reflection matrix. -reflectY :: Matrix4 -reflectY = mat4 - 1 0 0 0 - 0 (-1) 0 0 - 0 0 1 0 - 0 0 0 1 - - --- | Create a Z reflection matrix. -reflectZ :: Matrix4 -reflectZ = mat4 - 1 0 0 0 - 0 1 0 0 - 0 0 (-1) 0 - 0 0 0 1 - - --- | Create an orthogonal projection matrix. -ortho :: Float -- ^ Left. - -> Float -- ^ Right. - -> Float -- ^ Bottom. - -> Float -- ^ Top. - -> Float -- ^ Near clip. - -> Float -- ^ Far clip. - -> Matrix4 - -ortho l r b t n f = - let tx = (-(r+l)/(r-l)) - ty = (-(t+b)/(t-b)) - tz = (-(f+n)/(f-n)) - in mat4 - (2/(r-l)) 0 0 tx - 0 (2/(t-b)) 0 ty - 0 0 ((-2)/(f-n)) tz - 0 0 0 1 - - --- | Create a perspective projection matrix. -perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees. - -> Float -- ^ Aspect ratio. - -> Float -- ^ Near clip distance. - -> Float -- ^ Far clip distance - -> Matrix4 -perspective fovy r near far = - let f = 1 / tan (toRAD fovy / 2) - a = near - far - in mat4 - (f/r) 0 0 0 - 0 f 0 0 - 0 0 ((near+far)/a) (2*near*far/a) - 0 0 (-1) 0 + + +-- | Zip two matrices together with the specified function. +zipWith :: (Float -> Float -> Float) -> Matrix4 -> Matrix4 -> Matrix4 +zipWith f a b = Matrix4 + (f (m00 a) (m00 b)) (f (m10 a) (m10 b)) (f (m20 a) (m20 b)) (f (m30 a) (m30 b)) + (f (m01 a) (m01 b)) (f (m11 a) (m11 b)) (f (m21 a) (m21 b)) (f (m31 a) (m31 b)) + (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b)) (f (m32 a) (m32 b)) + (f (m03 a) (m03 b)) (f (m13 a) (m13 b)) (f (m23 a) (m23 b)) (f (m33 a) (m33 b)) + + +-- | Map the specified function to the specified matrix. +map :: (Float -> Float) -> Matrix4 -> Matrix4 +map f m = Matrix4 + (f . m00 $ m) (f . m10 $ m) (f . m20 $ m) (f . m30 $ m) + (f . m01 $ m) (f . m11 $ m) (f . m21 $ m) (f . m31 $ m) + (f . m02 $ m) (f . m12 $ m) (f . m22 $ m) (f . m32 $ m) + (f . m03 $ m) (f . m13 $ m) (f . m23 $ m) (f . m33 $ m) + + +-- | Return the identity matrix. +id :: Matrix4 +id = mat4 + 1 0 0 0 + 0 1 0 0 + 0 0 1 0 + 0 0 0 1 + + +-- | Create a translation matrix. +transl :: Float -> Float -> Float -> Matrix4 +transl x y z = mat4 + 1 0 0 x + 0 1 0 y + 0 0 1 z + 0 0 0 1 + + +-- | Create a translation matrix. +translv :: Vector3 -> Matrix4 +translv v = mat4 + 1 0 0 (V3.x v) + 0 1 0 (V3.y v) + 0 0 1 (V3.z v) + 0 0 0 1 + + +-- | Create a rotation matrix rotating about the X axis. +-- The given angle must be in degrees. +rotX :: Float -> Matrix4 +rotX angle = mat4 + 1 0 0 0 + 0 c (-s) 0 + 0 s c 0 + 0 0 0 1 + where + s = sin . toRAD $ angle + c = cos . toRAD $ angle + + +-- | Create a rotation matrix rotating about the Y axis. +-- The given angle must be in degrees. +rotY :: Float -> Matrix4 +rotY angle = mat4 + c 0 s 0 + 0 1 0 0 + (-s) 0 c 0 + 0 0 0 1 + where + s = sin . toRAD $ angle + c = cos . toRAD $ angle + + +-- | Create a rotation matrix rotating about the Z axis. +-- The given angle must be in degrees. +rotZ :: Float -> Matrix4 +rotZ angle = mat4 + c (-s) 0 0 + s c 0 0 + 0 0 1 0 + 0 0 0 1 + where + s = sin . toRAD $ angle + c = cos . toRAD $ angle + + +-- | Create a rotation matrix rotating about the specified axis. +-- The given angle must be in degrees. +axisAngle :: Vector3 -> Float -> Matrix4 +axisAngle v angle = mat4 + (c + omc*x^2) (omc*xy-sz) (omc*xz+sy) 0 + (omc*xy+sz) (c+omc*y^2) (omc*yz-sx) 0 + (omc*xz-sy) (omc*yz+sx) (c+omc*z^2) 0 + 0 0 0 1 + where + x = V3.x v + y = V3.y v + z = V3.z v + s = sin . toRAD $ angle + c = cos . toRAD $ angle + xy = x*y + xz = x*z + yz = y*z + sx = s*x + sy = s*y + sz = s*z + omc = 1 - c + + +-- | Create a scale matrix. +scale :: Float -> Float -> Float -> Matrix4 +scale sx sy sz = mat4 + sx 0 0 0 + 0 sy 0 0 + 0 0 sz 0 + 0 0 0 1 + + +-- | Create a scale matrix. +scalev :: Vector3 -> Matrix4 +scalev v = mat4 + sx 0 0 0 + 0 sy 0 0 + 0 0 sz 0 + 0 0 0 1 + where + sx = V3.x v + sy = V3.y v + sz = V3.z v + + +-- | Create an X reflection matrix. +reflectX :: Matrix4 +reflectX = mat4 + (-1) 0 0 0 + 0 1 0 0 + 0 0 1 0 + 0 0 0 1 + + +-- | Create a Y reflection matrix. +reflectY :: Matrix4 +reflectY = mat4 + 1 0 0 0 + 0 (-1) 0 0 + 0 0 1 0 + 0 0 0 1 + + +-- | Create a Z reflection matrix. +reflectZ :: Matrix4 +reflectZ = mat4 + 1 0 0 0 + 0 1 0 0 + 0 0 (-1) 0 + 0 0 0 1 + + +-- | Create an orthogonal projection matrix. +ortho :: Float -- ^ Left. + -> Float -- ^ Right. + -> Float -- ^ Bottom. + -> Float -- ^ Top. + -> Float -- ^ Near clip. + -> Float -- ^ Far clip. + -> Matrix4 + +ortho l r b t n f = + let tx = (-(r+l)/(r-l)) + ty = (-(t+b)/(t-b)) + tz = (-(f+n)/(f-n)) + in mat4 + (2/(r-l)) 0 0 tx + 0 (2/(t-b)) 0 ty + 0 0 ((-2)/(f-n)) tz + 0 0 0 1 + + +-- | Create a perspective projection matrix. +perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees. + -> Float -- ^ Aspect ratio. + -> Float -- ^ Near clip distance. + -> Float -- ^ Far clip distance + -> Matrix4 +perspective fovy r near far = + let f = 1 / tan (toRAD fovy / 2) + a = near - far + in mat4 + (f/r) 0 0 0 + 0 f 0 0 + 0 0 ((near+far)/a) (2*near*far/a) + 0 0 (-1) 0 -- | Create a plane projection matrix. @@ -442,19 +442,19 @@ planeProj n d l = (-nx*ly) (d + c - ny*ly) (-nz*ly) (-ly*d) (-nx*lz) (-ny*lz) (d + c - nz*lz) (-lz*d) (-nx) (-ny) (-nz) c - - --- | Transpose the specified matrix. -transpose :: Matrix4 -> Matrix4 -transpose m = mat4 - (m00 m) (m01 m) (m02 m) (m03 m) - (m10 m) (m11 m) (m12 m) (m13 m) - (m20 m) (m21 m) (m22 m) (m23 m) - (m30 m) (m31 m) (m32 m) (m33 m) - - --- | Invert the given transformation matrix. -inverseTransform :: Matrix4 -> Matrix4 + + +-- | Transpose the specified matrix. +transpose :: Matrix4 -> Matrix4 +transpose m = mat4 + (m00 m) (m01 m) (m02 m) (m03 m) + (m10 m) (m11 m) (m12 m) (m13 m) + (m20 m) (m21 m) (m22 m) (m23 m) + (m30 m) (m31 m) (m32 m) (m33 m) + + +-- | Invert the given transformation matrix. +inverseTransform :: Matrix4 -> Matrix4 inverseTransform mat = let r = right mat @@ -611,26 +611,26 @@ inverse mat = (m00' * det) (m04' * det) (m08' * det) (m12' * det) (m01' * det) (m05' * det) (m09' * det) (m13' * det) (m02' * det) (m06' * det) (m10' * det) (m14' * det) - (m03' * det) (m07' * det) (m11' * det) (m15' * det) - - --- | Transform the given vector in 3D space with the given matrix. -mul :: Float -> Matrix4 -> Vector3 -> Vector3 -mul w m v = vec3 x' y' z' - where - v' = vec4 (V3.x v) (V3.y v) (V3.z v) w - x' = row0 m `V4.dot` v' - y' = row1 m `V4.dot` v' - z' = row2 m `V4.dot` v' - - --- | Transform the given point vector in 3D space with the given matrix. -mulp :: Matrix4 -> Vector3 -> Vector3 -mulp = mul 1 - - --- | Transform the given directional vector in 3D space with the given matrix. -muld :: Matrix4 -> Vector3 -> Vector3 + (m03' * det) (m07' * det) (m11' * det) (m15' * det) + + +-- | Transform the given vector in 3D space with the given matrix. +mul :: Float -> Matrix4 -> Vector3 -> Vector3 +mul w m v = vec3 x' y' z' + where + v' = vec4 (V3.x v) (V3.y v) (V3.z v) w + x' = row0 m `V4.dot` v' + y' = row1 m `V4.dot` v' + z' = row2 m `V4.dot` v' + + +-- | Transform the given point vector in 3D space with the given matrix. +mulp :: Matrix4 -> Vector3 -> Vector3 +mulp = mul 1 + + +-- | Transform the given directional vector in 3D space with the given matrix. +muld :: Matrix4 -> Vector3 -> Vector3 muld = mul 0 @@ -639,13 +639,13 @@ muld = mul 0 -- The vector is brought from homogeneous space to 3D space by performing a -- perspective divide. mul' :: Float -> Matrix4 -> Vector3 -> Vector3 -mul' w m v = vec3 (x'/w') (y'/w') (z'/w') - where - v' = vec4 (V3.x v) (V3.y v) (V3.z v) w - x' = row0 m `V4.dot` v' - y' = row1 m `V4.dot` v' +mul' w m v = vec3 (x'/w') (y'/w') (z'/w') + where + v' = vec4 (V3.x v) (V3.y v) (V3.z v) w + x' = row0 m `V4.dot` v' + y' = row1 m `V4.dot` v' z' = row2 m `V4.dot` v' - w' = row3 m `V4.dot` v' - - -toRAD = (*pi) . (/180) + w' = row3 m `V4.dot` v' + + +toRAD = (*pi) . (/180) diff --git a/Spear/Math/Plane.hs b/Spear/Math/Plane.hs index 8772a42..6fabbec 100644 --- a/Spear/Math/Plane.hs +++ b/Spear/Math/Plane.hs @@ -7,7 +7,7 @@ module Spear.Math.Plane where -import Spear.Math.Vector3 as Vector +import Spear.Math.Vector3 data PointPlanePos = Front | Back | Contained deriving (Eq, Ord, Show) diff --git a/Spear/Math/Vector2.hs b/Spear/Math/Vector2.hs index ace86fe..581a64f 100644 --- a/Spear/Math/Vector2.hs +++ b/Spear/Math/Vector2.hs @@ -1,155 +1,145 @@ -module Spear.Math.Vector2 -( - Vector2 - -- * Accessors -, x -, y - -- * Construction -, unitx -, unity -, zero -, fromList -, vec2 - -- * Operations -, v2min -, v2max -, dot -, normSq -, norm -, scale -, normalise +module Spear.Math.Vector2 +( + Vector2 + -- * Accessors +, x +, y + -- * Construction +, unitx +, unity +, zero +, fromList +, vec2 + -- * Operations +, perp +, dot +, normSq +, norm +, scale , neg -, perp -) -where - -import Foreign.C.Types (CFloat) -import Foreign.Storable - - --- | Represents a vector in 2D. -data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) - - -instance Num Vector2 where - Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) - Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) - Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) - abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay) - signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay) - fromInteger i = Vector2 i' i' where i' = fromInteger i - - -instance Fractional Vector2 where - Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) - fromRational r = Vector2 r' r' where r' = fromRational r - - -instance Ord Vector2 where - Vector2 ax ay <= Vector2 bx by = (ax <= bx) || (ax == bx && ay <= by) - Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by) - Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by) - Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by) - - -sizeFloat = sizeOf (undefined :: CFloat) - - -instance Storable Vector2 where - sizeOf _ = 2*sizeFloat - alignment _ = alignment (undefined :: CFloat) - - peek ptr = do - ax <- peekByteOff ptr 0 - ay <- peekByteOff ptr $ sizeFloat - return (Vector2 ax ay) - - poke ptr (Vector2 ax ay) = do - pokeByteOff ptr 0 ax - pokeByteOff ptr sizeFloat ay - - --- | Get the vector's x coordinate. +, normalise +) +where + + +import Foreign.C.Types (CFloat) +import Foreign.Storable + + +-- | Represents a vector in 2D. +data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) + + +instance Num Vector2 where + Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) + Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) + Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) + abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay) + signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay) + fromInteger i = Vector2 i' i' where i' = fromInteger i + + +instance Fractional Vector2 where + Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) + fromRational r = Vector2 r' r' where r' = fromRational r + + +instance Ord Vector2 where + Vector2 ax ay <= Vector2 bx by = (ax <= bx) || (ax == bx && ay <= by) + Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by) + Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by) + Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by) + max (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.max ax bx) (Prelude.max ay by) + min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by) + + +sizeFloat = sizeOf (undefined :: CFloat) + + +instance Storable Vector2 where + sizeOf _ = 2*sizeFloat + alignment _ = alignment (undefined :: CFloat) + + peek ptr = do + ax <- peekByteOff ptr 0 + ay <- peekByteOff ptr $ sizeFloat + return (Vector2 ax ay) + + poke ptr (Vector2 ax ay) = do + pokeByteOff ptr 0 ax + pokeByteOff ptr sizeFloat ay + + +-- | Get the vector's x coordinate. x (Vector2 ax _) = ax --- | Get the vector's y coordinate. -y (Vector2 _ ay) = ay - - --- | Unit vector along the X axis. -unitx :: Vector2 -unitx = Vector2 1 0 - - --- | Unit vector along the Y axis. -unity :: Vector2 -unity = Vector2 0 1 - - --- | Zero vector. -zero :: Vector2 -zero = Vector2 0 0 - - --- | Create a vector from the given list. -fromList :: [Float] -> Vector2 -fromList (ax:ay:_) = Vector2 ax ay - - --- | Create a vector from the given values. -vec2 :: Float -> Float -> Vector2 -vec2 ax ay = Vector2 ax ay - - --- | Create a vector with components set to the minimum of each of the given vectors'. -v2min :: Vector2 -> Vector2 -> Vector2 -v2min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by) - - --- | Create a vector with components set to the maximum of each of the given vectors'. -v2max :: Vector2 -> Vector2 -> Vector2 -v2max (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.max ax bx) (Prelude.max ay by) - - --- | Compute the given vectors' dot product. -dot :: Vector2 -> Vector2 -> Float -Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by - - --- | Compute the given vector's squared norm. -normSq :: Vector2 -> Float -normSq (Vector2 ax ay) = ax*ax + ay*ay - - --- | Compute the given vector's norm. -norm :: Vector2 -> Float -norm = sqrt . normSq - - --- | Multiply the given vector with the given scalar. -scale :: Float -> Vector2 -> Vector2 -scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay) - - --- | Normalise the given vector. -normalise :: Vector2 -> Vector2 -normalise v = - let n' = norm v - n = if n' == 0 then 1 else n' - in - scale (1.0 / n) v - - --- | Negate the given vector. -neg :: Vector2 -> Vector2 -neg (Vector2 ax ay) = Vector2 (-ax) (-ay) +-- | Get the vector's y coordinate. +y (Vector2 _ ay) = ay + + +-- | Unit vector along the X axis. +unitx :: Vector2 +unitx = Vector2 1 0 + + +-- | Unit vector along the Y axis. +unity :: Vector2 +unity = Vector2 0 1 + + +-- | Zero vector. +zero :: Vector2 +zero = Vector2 0 0 + + +-- | Create a vector from the given list. +fromList :: [Float] -> Vector2 +fromList (ax:ay:_) = Vector2 ax ay + + +-- | Create a vector from the given values. +vec2 :: Float -> Float -> Vector2 +vec2 ax ay = Vector2 ax ay -- | Compute a vector perpendicular to the given one, satisfying: --- +-- -- perp (Vector2 0 1) = Vector2 1 0 -- -- perp (Vector2 1 0) = Vector2 0 (-1) perp :: Vector2 -> Vector2 -perp (Vector2 x y) = Vector2 y (-x) +perp (Vector2 x y) = Vector2 y (-x) + + +-- | Compute the given vectors' dot product. +dot :: Vector2 -> Vector2 -> Float +Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by + + +-- | Compute the given vector's squared norm. +normSq :: Vector2 -> Float +normSq (Vector2 ax ay) = ax*ax + ay*ay + + +-- | Compute the given vector's norm. +norm :: Vector2 -> Float +norm = sqrt . normSq + + +-- | Multiply the given vector with the given scalar. +scale :: Float -> Vector2 -> Vector2 +scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay) + + +-- | Negate the given vector. +neg :: Vector2 -> Vector2 +neg (Vector2 ax ay) = Vector2 (-ax) (-ay) + + +-- | Normalise the given vector. +normalise :: Vector2 -> Vector2 +normalise v = + let n' = norm v + n = if n' == 0 then 1 else n' + in scale (1.0 / n) v diff --git a/Spear/Math/Vector3.hs b/Spear/Math/Vector3.hs index 7ac0f7a..d280811 100644 --- a/Spear/Math/Vector3.hs +++ b/Spear/Math/Vector3.hs @@ -14,18 +14,17 @@ module Spear.Math.Vector3 , vec3 , orbit -- * Operations -, Spear.Math.Vector3.min -, Spear.Math.Vector3.max , dot , cross , normSq , norm , scale -, normalise , neg +, normalise ) where + import Foreign.C.Types (CFloat) import Foreign.Storable @@ -73,6 +72,10 @@ instance Ord Vector3 where || (ax == bx && ay > by) || (ax == bx && ay == by && az > bz) + max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) + + min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) + sizeFloat = sizeOf (undefined :: CFloat) @@ -149,16 +152,6 @@ orbit center radius anglex angley = vec3 px py pz --- | Create a vector with components set to the minimum of each of the given vectors'. -min :: Vector3 -> Vector3 -> Vector3 -min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) - - --- | Create a vector with components set to the maximum of each of the given vectors'. -max :: Vector3 -> Vector3 -> Vector3 -max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) - - -- | Compute the given vectors' dot product. dot :: Vector3 -> Vector3 -> Float Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz @@ -169,31 +162,26 @@ cross :: Vector3 -> Vector3 -> Vector3 (Vector3 ax ay az) `cross` (Vector3 bx by bz) = Vector3 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx) - + -- | Compute the given vector's squared norm. -normSq :: Vector3 -> Float normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az -- | Compute the given vector's norm. -norm :: Vector3 -> Float norm = sqrt . normSq -- | Multiply the given vector with the given scalar. -scale :: Float -> Vector3 -> Vector3 scale s (Vector3 ax ay az) = Vector3 (s*ax) (s*ay) (s*az) +-- | Negate the given vector. +neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az) + + -- | Normalise the given vector. -normalise :: Vector3 -> Vector3 normalise v = - let n' = norm v - n = if n' == 0 then 1 else n' - in - scale (1.0 / n) v - + let n' = norm v + n = if n' == 0 then 1 else n' + in scale (1.0 / n) v --- | Negate the given vector. -neg :: Vector3 -> Vector3 -neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az) diff --git a/Spear/Math/Vector4.hs b/Spear/Math/Vector4.hs index 9ba35bc..554fb27 100644 --- a/Spear/Math/Vector4.hs +++ b/Spear/Math/Vector4.hs @@ -1,183 +1,176 @@ -module Spear.Math.Vector4 -( - Vector4 - -- * Accessors -, x -, y -, z -, w - -- * Construction -, unitX -, unitY -, unitZ -, fromList -, vec4 - -- * Operations -, Spear.Math.Vector4.min -, Spear.Math.Vector4.max -, dot -, normSq -, norm -, scale -, normalise -, neg -) -where - - -import Foreign.C.Types (CFloat) -import Foreign.Storable - - --- | Represents a vector in 3D. +module Spear.Math.Vector4 +( + Vector4 + -- * Accessors +, x +, y +, z +, w + -- * Construction +, unitX +, unitY +, unitZ +, fromList +, vec4 + -- * Operations +, dot +, normSq +, norm +, scale +, neg +, normalise +) +where + + +import Foreign.C.Types (CFloat) +import Foreign.Storable + + +-- | Represents a vector in 3D. data Vector4 = Vector4 {-# UNPACK #-} !Float {-# UNPACK #-} !Float {-# UNPACK #-} !Float {-# UNPACK #-} !Float - deriving (Eq, Show) - - -instance Num Vector4 where - Vector4 ax ay az aw + Vector4 bx by bz bw = Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw) - Vector4 ax ay az aw - Vector4 bx by bz bw = Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw) - Vector4 ax ay az aw * Vector4 bx by bz bw = Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw) - abs (Vector4 ax ay az aw) = Vector4 (abs ax) (abs ay) (abs az) (abs aw) - signum (Vector4 ax ay az aw) = Vector4 (signum ax) (signum ay) (signum az) (signum aw) - fromInteger i = Vector4 i' i' i' i' where i' = fromInteger i - - -instance Fractional Vector4 where - Vector4 ax ay az aw / Vector4 bx by bz bw = Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw) - fromRational r = Vector4 r' r' r' r' where r' = fromRational r - - -instance Ord Vector4 where - Vector4 ax ay az aw <= Vector4 bx by bz bw - = (ax <= bx) - || (az == bx && ay <= by) - || (ax == bx && ay == by && az <= bz) - || (ax == bx && ay == by && az == bz && aw <= bw) - - Vector4 ax ay az aw >= Vector4 bx by bz bw - = (ax >= bx) - || (ax == bx && ay >= by) - || (ax == bx && ay == by && az >= bz) - || (ax == bx && ay == by && az == bz && aw >= bw) - - Vector4 ax ay az aw < Vector4 bx by bz bw - = (ax < bx) - || (az == bx && ay < by) - || (ax == bx && ay == by && az < bz) - || (ax == bx && ay == by && az == bz && aw < bw) - - Vector4 ax ay az aw > Vector4 bx by bz bw - = (ax > bx) - || (ax == bx && ay > by) - || (ax == bx && ay == by && az > bz) - || (ax == bx && ay == by && az == bz && aw > bw) - - -sizeFloat = sizeOf (undefined :: CFloat) - - -instance Storable Vector4 where - sizeOf _ = 4*sizeFloat - alignment _ = alignment (undefined :: CFloat) - - peek ptr = do - ax <- peekByteOff ptr 0 - ay <- peekByteOff ptr $ 1 * sizeFloat - az <- peekByteOff ptr $ 2 * sizeFloat - aw <- peekByteOff ptr $ 3 * sizeFloat - return (Vector4 ax ay az aw) - - poke ptr (Vector4 ax ay az aw) = do - pokeByteOff ptr 0 ax - pokeByteOff ptr (1 * sizeFloat) ay - pokeByteOff ptr (2 * sizeFloat) az - pokeByteOff ptr (3 * sizeFloat) aw - - -x (Vector4 ax _ _ _ ) = ax -y (Vector4 _ ay _ _ ) = ay -z (Vector4 _ _ az _ ) = az -w (Vector4 _ _ _ aw) = aw - - --- | Unit vector along the X axis. -unitX :: Vector4 -unitX = Vector4 1 0 0 0 - - --- | Unit vector along the Y axis. -unitY :: Vector4 -unitY = Vector4 0 1 0 0 - - --- | Unit vector along the Z axis. -unitZ :: Vector4 -unitZ = Vector4 0 0 1 0 - - --- | Create a vector from the given list. -fromList :: [Float] -> Vector4 -fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw - - --- | Create a 4D vector from the given values. -vec4 :: Float -> Float -> Float -> Float -> Vector4 -vec4 ax ay az aw = Vector4 ax ay az aw - - --- | Create a vector whose components are the minimum of each of the given vectors'. -min :: Vector4 -> Vector4 -> Vector4 -min (Vector4 ax ay az aw) (Vector4 bx by bz bw) = - Vector4 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) (Prelude.min aw bw) - - --- | Create a vector whose components are the maximum of each of the given vectors'. -max :: Vector4 -> Vector4 -> Vector4 -max (Vector4 ax ay az aw) (Vector4 bx by bz bw) = - Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw) - - --- | Compute the given vectors' dot product. -dot :: Vector4 -> Vector4 -> Float -Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw - - --- | Compute the given vectors' cross product. --- The vectors are projected to 3D space. The resulting vector is the cross product of the vectors' projections with w=0. -cross :: Vector4 -> Vector4 -> Vector4 -(Vector4 ax ay az _) `cross` (Vector4 bx by bz _) = - Vector4 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx) 0 - - --- | Compute the given vector's squared norm. -normSq :: Vector4 -> Float -normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw - - --- | Compute the given vector's norm. -norm :: Vector4 -> Float -norm = sqrt . normSq - - --- | Multiply the given vector with the given scalar. -scale :: Float -> Vector4 -> Vector4 -scale s (Vector4 ax ay az aw) = Vector4 (s*ax) (s*ay) (s*az) (s*aw) - - --- | Normalise the given vector. -normalise :: Vector4 -> Vector4 -normalise v = - let n' = norm v - n = if n' == 0 then 1 else n' - in - scale (1.0 / n) v - - --- | Negate the given vector. -neg :: Vector4 -> Vector4 -neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw) + deriving (Eq, Show) + + +instance Num Vector4 where + Vector4 ax ay az aw + Vector4 bx by bz bw = Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw) + Vector4 ax ay az aw - Vector4 bx by bz bw = Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw) + Vector4 ax ay az aw * Vector4 bx by bz bw = Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw) + abs (Vector4 ax ay az aw) = Vector4 (abs ax) (abs ay) (abs az) (abs aw) + signum (Vector4 ax ay az aw) = Vector4 (signum ax) (signum ay) (signum az) (signum aw) + fromInteger i = Vector4 i' i' i' i' where i' = fromInteger i + + +instance Fractional Vector4 where + Vector4 ax ay az aw / Vector4 bx by bz bw = Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw) + fromRational r = Vector4 r' r' r' r' where r' = fromRational r + + +instance Ord Vector4 where + Vector4 ax ay az aw <= Vector4 bx by bz bw + = (ax <= bx) + || (az == bx && ay <= by) + || (ax == bx && ay == by && az <= bz) + || (ax == bx && ay == by && az == bz && aw <= bw) + + Vector4 ax ay az aw >= Vector4 bx by bz bw + = (ax >= bx) + || (ax == bx && ay >= by) + || (ax == bx && ay == by && az >= bz) + || (ax == bx && ay == by && az == bz && aw >= bw) + + Vector4 ax ay az aw < Vector4 bx by bz bw + = (ax < bx) + || (az == bx && ay < by) + || (ax == bx && ay == by && az < bz) + || (ax == bx && ay == by && az == bz && aw < bw) + + Vector4 ax ay az aw > Vector4 bx by bz bw + = (ax > bx) + || (ax == bx && ay > by) + || (ax == bx && ay == by && az > bz) + || (ax == bx && ay == by && az == bz && aw > bw) + + min (Vector4 ax ay az aw) (Vector4 bx by bz bw) = + Vector4 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) (Prelude.min aw bw) + + max (Vector4 ax ay az aw) (Vector4 bx by bz bw) = + Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw) + + +sizeFloat = sizeOf (undefined :: CFloat) + + +instance Storable Vector4 where + sizeOf _ = 4*sizeFloat + alignment _ = alignment (undefined :: CFloat) + + peek ptr = do + ax <- peekByteOff ptr 0 + ay <- peekByteOff ptr $ 1 * sizeFloat + az <- peekByteOff ptr $ 2 * sizeFloat + aw <- peekByteOff ptr $ 3 * sizeFloat + return (Vector4 ax ay az aw) + + poke ptr (Vector4 ax ay az aw) = do + pokeByteOff ptr 0 ax + pokeByteOff ptr (1 * sizeFloat) ay + pokeByteOff ptr (2 * sizeFloat) az + pokeByteOff ptr (3 * sizeFloat) aw + + +x (Vector4 ax _ _ _ ) = ax +y (Vector4 _ ay _ _ ) = ay +z (Vector4 _ _ az _ ) = az +w (Vector4 _ _ _ aw) = aw + + +-- | Unit vector along the X axis. +unitX :: Vector4 +unitX = Vector4 1 0 0 0 + + +-- | Unit vector along the Y axis. +unitY :: Vector4 +unitY = Vector4 0 1 0 0 + + +-- | Unit vector along the Z axis. +unitZ :: Vector4 +unitZ = Vector4 0 0 1 0 + + +-- | Create a vector from the given list. +fromList :: [Float] -> Vector4 +fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw + + +-- | Create a 4D vector from the given values. +vec4 :: Float -> Float -> Float -> Float -> Vector4 +vec4 ax ay az aw = Vector4 ax ay az aw + + +-- | Compute the given vectors' dot product. +dot :: Vector4 -> Vector4 -> Float +Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw + + +-- | Compute the given vectors' cross product. +-- The vectors are projected to 3D space. The resulting vector is the cross product of the vectors' projections with w=0. +cross :: Vector4 -> Vector4 -> Vector4 +(Vector4 ax ay az _) `cross` (Vector4 bx by bz _) = + Vector4 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx) 0 + + +-- | Compute the given vector's squared norm. +normSq :: Vector4 -> Float +normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw + + +-- | Compute the given vector's norm. +norm :: Vector4 -> Float +norm = sqrt . normSq + + +-- | Multiply the given vector with the given scalar. +scale :: Float -> Vector4 -> Vector4 +scale s (Vector4 ax ay az aw) = Vector4 (s*ax) (s*ay) (s*az) (s*aw) + + +-- | Negate the given vector. +neg :: Vector4 -> Vector4 +neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw) + + +-- | Normalise the given vector. +normalise :: Vector4 -> Vector4 +normalise v = + let n' = norm v + n = if n' == 0 then 1 else n' + in + scale (1.0 / n) v + -- cgit v1.2.3