From f10147a471427b6556ecad6f5e0a68dead188f25 Mon Sep 17 00:00:00 2001 From: 3gg <3gg@shellblade.net> Date: Thu, 31 Aug 2023 19:12:47 -0700 Subject: New Algebra module and Spatial abstraction. --- Demos/Pong/Main.hs | 22 +-- Demos/Pong/Pong.hs | 109 +++++++++------ Spear.cabal | 159 +++++++++++---------- Spear/GL.hs | 79 ++++++----- Spear/Game.hs | 8 +- Spear/Math/AABB.hs | 34 +++-- Spear/Math/Algebra.hs | 102 ++++++++++++++ Spear/Math/Camera.hs | 60 +++++--- Spear/Math/Circle.hs | 22 ++- Spear/Math/Collision.hs | 69 +++++---- Spear/Math/Matrix3.hs | 103 ++++++-------- Spear/Math/Matrix4.hs | 93 +++++------- Spear/Math/MatrixUtils.hs | 31 ++-- Spear/Math/Plane.hs | 5 +- Spear/Math/Quaternion.hs | 13 +- Spear/Math/Ray.hs | 35 ++++- Spear/Math/Spatial.hs | 111 +++++++++++++++ Spear/Math/Spatial2.hs | 253 ++++++++++++++------------------- Spear/Math/Spatial3.hs | 318 +++++++++++++++++++----------------------- Spear/Math/Sphere.hs | 21 ++- Spear/Math/Triangle.hs | 29 ++-- Spear/Math/Utils.hs | 11 +- Spear/Math/Vector/Vector.hs | 93 ++++++------ Spear/Math/Vector/Vector2.hs | 113 ++++++++++----- Spear/Math/Vector/Vector3.hs | 150 ++++++++++++-------- Spear/Math/Vector/Vector4.hs | 142 ++++++++++++------- Spear/Prelude.hs | 10 ++ Spear/Render/AnimatedModel.hs | 77 +++++----- Spear/Render/StaticModel.hs | 41 +++--- Spear/Scene/Loader.hs | 66 ++++----- Spear/Step.hs | 2 +- 31 files changed, 1391 insertions(+), 990 deletions(-) create mode 100644 Spear/Math/Algebra.hs create mode 100644 Spear/Math/Spatial.hs create mode 100644 Spear/Prelude.hs diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs index 0644f9d..a49efec 100644 --- a/Demos/Pong/Main.hs +++ b/Demos/Pong/Main.hs @@ -8,6 +8,7 @@ import Pong import Spear.App import Spear.Game import Spear.Math.AABB +import Spear.Math.Spatial import Spear.Math.Spatial2 import Spear.Math.Vector import Spear.Window @@ -28,10 +29,10 @@ step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool step elapsed dt inputEvents = do gs <- getGameState gameIO . process $ inputEvents - let events = translate inputEvents + let events = translateEvents inputEvents modifyGameState $ \gs -> gs - { world = stepWorld elapsed dt events (world gs) + { world = stepWorld (realToFrac elapsed) dt events (world gs) } getGameState >>= \gs -> gameIO . render $ world gs return (not $ exitRequested inputEvents) @@ -63,7 +64,7 @@ renderBackground = renderGO :: GameObject -> IO () renderGO go = do let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go - (Vector2 xcenter ycenter) = pos go + (Vector2 xcenter ycenter) = position go (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax') GL.preservingMatrix $ do GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0) @@ -76,7 +77,7 @@ renderGO go = do process = mapM_ procEvent procEvent (Resize w h) = - let r = (fromIntegral w) / (fromIntegral h) + let r = fromIntegral w / fromIntegral h pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 left = if r > 1 then -pad else 0 right = if r > 1 then 1 + pad else 1 @@ -90,13 +91,12 @@ procEvent (Resize w h) = GL.matrixMode $= GL.Modelview 0 procEvent _ = return () -translate = mapMaybe translate' - -translate' (KeyDown KEY_LEFT) = Just MoveLeft -translate' (KeyDown KEY_RIGHT) = Just MoveRight -translate' (KeyUp KEY_LEFT) = Just StopLeft -translate' (KeyUp KEY_RIGHT) = Just StopRight -translate' _ = Nothing +translateEvents = mapMaybe translateEvents' + where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft + translateEvents' (KeyDown KEY_RIGHT) = Just MoveRight + translateEvents' (KeyUp KEY_LEFT) = Just StopLeft + translateEvents' (KeyUp KEY_RIGHT) = Just StopRight + translateEvents' _ = Nothing exitRequested = elem (KeyDown KEY_ESC) diff --git a/Demos/Pong/Pong.hs b/Demos/Pong/Pong.hs index 0e24a42..104a92e 100644 --- a/Demos/Pong/Pong.hs +++ b/Demos/Pong/Pong.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeSynonymInstances #-} + module Pong ( GameEvent (..), GameObject, @@ -7,25 +11,29 @@ module Pong ) where -import Data.Monoid (mconcat) -import GHC.Float (double2Float) import Spear.Math.AABB +import Spear.Math.Algebra +import Spear.Math.Spatial import Spear.Math.Spatial2 import Spear.Math.Vector +import Spear.Prelude import Spear.Step +import Data.Monoid (mconcat) + + -- Configuration -padSize = vec2 0.07 0.02 -ballSize = 0.012 -ballSpeed = 0.6 +padSize = vec2 0.07 0.02 +ballSize = 0.012 :: Float +ballSpeed = 0.6 :: Float initialBallVelocity = vec2 1 1 -maxBounceAngle = 65 * pi/180 -playerSpeed = 1.0 -enemySpeed = 1.5 -initialEnemyPos = vec2 0.5 0.9 -initialPlayerPos = vec2 0.5 0.1 -initialBallPos = vec2 0.5 0.5 +maxBounceAngle = (65::Float) * (pi::Float)/(180::Float) +playerSpeed = 1.0 :: Float +enemySpeed = 3.0 :: Float +initialEnemyPos = vec2 0.5 0.9 +initialPlayerPos = vec2 0.5 0.1 +initialBallPos = vec2 0.5 0.5 -- Game events @@ -40,13 +48,36 @@ data GameEvent data GameObject = GameObject { aabb :: AABB2, - obj :: Obj2, + basis :: Transform2, gostep :: Step [GameObject] [GameEvent] GameObject GameObject } -instance Spatial2 GameObject where - getObj2 = obj - setObj2 s o = s {obj = o} + +instance Has2dTransform GameObject where + set2dTransform transform object = object { basis = transform } + transform2 = basis + + +instance Positional GameObject Vector2 where + setPosition p = with2dTransform (setPosition p) + position = position . basis + translate v = with2dTransform (translate v) + + +instance Rotational GameObject Vector2 Angle where + setRotation r = with2dTransform (setRotation r) + rotation = rotation . basis + rotate angle = with2dTransform (rotate angle) + right = right . basis + up = up . basis + forward = forward . basis + setForward v = with2dTransform (setForward v) + + +instance Spatial GameObject Vector2 Angle Transform2 where + setTransform t obj = obj { basis = t } + transform = basis + stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject] stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos @@ -60,13 +91,12 @@ ballBox, padBox :: AABB2 ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize padBox = AABB2 (-padSize) padSize -obj2 = obj2FromVectors unitx2 unity2 - newWorld = - [ GameObject ballBox (obj2 initialBallPos) $ stepBall initialBallVelocity, - GameObject padBox (obj2 initialEnemyPos) stepEnemy, - GameObject padBox (obj2 initialPlayerPos) stepPlayer + [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity, + GameObject padBox (makeAt initialEnemyPos) stepEnemy, + GameObject padBox (makeAt initialPlayerPos) stepPlayer ] + where makeAt = newTransform2 unitx2 unity2 -- Ball steppers @@ -76,7 +106,7 @@ stepBall vel = collideBall vel .> moveBall -- ball when collision is detected. collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) collideBall vel = step $ \_ dt gos _ ball -> - let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball + let (AABB2 pmin pmax) = translate (position ball) (aabb ball) collideSide = x pmin < 0 || x pmax > 1 collideBack = y pmin < 0 || y pmax > 1 collidePaddle = any (collide ball) (tail gos) @@ -84,18 +114,18 @@ collideBall vel = step $ \_ dt gos _ ball -> flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel -- A small delta to apply when collision occurs. - delta = 1 + if collideSide || collideBack || collidePaddle then 2*dt else 0 - in ((scale ballSpeed (scale delta vel'), ball), collideBall vel') + delta = (1::Float) + if collideSide || collideBack || collidePaddle then (2::Float)*dt else (0::Float) + in ((ballSpeed * delta * vel', ball), collideBall vel') paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 paddleBounce ball v paddle = if collide ball paddle then - let (AABB2 pmin pmax) = aabb paddle `aabbAdd` pos paddle - center = (x pmin + x pmax) / 2 + let (AABB2 pmin pmax) = translate (position paddle) (aabb paddle) + center = (x pmin + x pmax) / (2::Float) -- Normalized offset of the ball from the paddle's center, [-1, +1]. -- It's outside the [-1, +1] range if there is no collision. - offset = (x (pos ball) - center) / ((x pmax - x pmin) / 2) + offset = (x (position ball) - center) / ((x pmax - x pmin) / (2::Float)) angle = offset * maxBounceAngle -- When it bounces off of a paddle, y vel is flipped. ysign = -(signum (y v)) @@ -105,19 +135,17 @@ paddleBounce ball v paddle = collide :: GameObject -> GameObject -> Bool collide go1 go2 = let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) = - aabb go1 `aabbAdd` pos go1 + translate (position go1) (aabb go1) (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = - aabb go2 `aabbAdd` pos go2 + translate (position go2) (aabb go2) in not $ xmax1 < xmin2 || xmin1 > xmax2 || ymax1 < ymin2 || ymin1 > ymax2 -aabbAdd (AABB2 pmin pmax) p = AABB2 (p + pmin) (p + pmax) - moveBall :: Step s e (Vector2, GameObject) GameObject -moveBall = step $ \_ dt _ _ (vel, ball) -> (move (scale dt vel) ball, moveBall) +moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall) -- Enemy stepper @@ -125,12 +153,13 @@ stepEnemy = movePad movePad :: Step s e GameObject GameObject movePad = step $ \elapsed _ _ _ pad -> - let p = vec2 px 0.9 + let enemyY = 0.9 + p = vec2 px enemyY px = - double2Float (sin (elapsed * enemySpeed) * 0.5 + 0.5) - * (1 - 2 * x padSize) + (sin (enemySpeed * elapsed) * (0.5::Float) + (0.5::Float)) + * ((1::Float) - (2::Float) * x padSize) + x padSize - in (setPos p pad, movePad) + in (setPosition p pad, movePad) -- Player stepper @@ -138,20 +167,20 @@ stepPlayer = sfold moveGO .> clamp moveGO = mconcat - [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0), - switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) + [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0), + switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) ] moveGO' :: Vector2 -> Step s e GameObject GameObject -moveGO' dir = step $ \_ dt _ _ go -> (move (scale dt dir) go, moveGO' dir) +moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir) clamp :: Step s e GameObject GameObject clamp = spure $ \go -> let p' = vec2 (clamp' x s (1 - s)) y - (Vector2 x y) = pos go + (Vector2 x y) = position go clamp' x a b | x < a = a | x > b = b | otherwise = x (Vector2 s _) = padSize - in setPos p' go + in setPosition p' go diff --git a/Spear.cabal b/Spear.cabal index 7025fcd..448f7f4 100644 --- a/Spear.cabal +++ b/Spear.cabal @@ -12,63 +12,68 @@ author: Marc Sunet data-dir: "" library - build-depends: GLFW-b -any, - OpenGL >= 3, - OpenGLRaw -any, - StateVar -any, - base -any, - bytestring -any, - directory -any, - exceptions -any, - mtl -any, - transformers -any, - resourcet -any, - parsec >= 3, - containers -any, - vector -any, - array -any + build-depends: + GLFW-b -any, + OpenGL >= 3, + OpenGLRaw -any, + StateVar -any, + base -any, + bytestring -any, + directory -any, + exceptions -any, + mtl -any, + transformers -any, + resourcet -any, + parsec >= 3, + containers -any, + vector -any, + array -any - exposed-modules: Spear.App - Spear.Assets.Image - Spear.Assets.Model - Spear.Game - Spear.GL - Spear.Math.AABB - Spear.Math.Camera - Spear.Math.Circle - Spear.Math.Collision - Spear.Math.Frustum - Spear.Math.Matrix3 - Spear.Math.Matrix4 - Spear.Math.MatrixUtils - Spear.Math.Octree - Spear.Math.Plane - Spear.Math.Quaternion - Spear.Math.Ray - Spear.Math.Segment - Spear.Math.Spatial2 - Spear.Math.Spatial3 - Spear.Math.Sphere - Spear.Math.Triangle - Spear.Math.Utils - Spear.Math.Vector - Spear.Math.Vector.Vector - Spear.Math.Vector.Vector2 - Spear.Math.Vector.Vector3 - Spear.Math.Vector.Vector4 - Spear.Render.AnimatedModel - Spear.Render.Material - Spear.Render.Model - Spear.Render.Program - Spear.Render.StaticModel - Spear.Scene.Graph - Spear.Scene.Loader - Spear.Scene.SceneResources - Spear.Step - Spear.Sys.Store - Spear.Sys.Store.ID - Spear.Sys.Timer - Spear.Window + exposed-modules: + Spear.App + Spear.Assets.Image + Spear.Assets.Model + Spear.Game + Spear.GL + Spear.Math.AABB + Spear.Math.Algebra + Spear.Math.Camera + Spear.Math.Circle + Spear.Math.Collision + Spear.Math.Frustum + Spear.Math.Matrix3 + Spear.Math.Matrix4 + Spear.Math.MatrixUtils + Spear.Math.Octree + Spear.Math.Plane + Spear.Math.Quaternion + Spear.Math.Ray + Spear.Math.Segment + Spear.Math.Spatial + Spear.Math.Spatial2 + Spear.Math.Spatial3 + Spear.Math.Sphere + Spear.Math.Triangle + Spear.Math.Utils + Spear.Math.Vector + Spear.Math.Vector.Vector + Spear.Math.Vector.Vector2 + Spear.Math.Vector.Vector3 + Spear.Math.Vector.Vector4 + Spear.Prelude + Spear.Render.AnimatedModel + Spear.Render.Material + Spear.Render.Model + Spear.Render.Program + Spear.Render.StaticModel + Spear.Scene.Graph + Spear.Scene.Loader + Spear.Scene.SceneResources + Spear.Step + Spear.Sys.Store + Spear.Sys.Store.ID + Spear.Sys.Timer + Spear.Window exposed: True @@ -87,28 +92,28 @@ library Spear/Render/RenderModel.c Spear/Sys/Timer/ctimer.c - extensions: TypeFamilies + includes: + Spear/Assets/Image/BMP/BMP_load.h + Spear/Assets/Image/Image.h + Spear/Assets/Image/Image_error_code.h + Spear/Assets/Image/sys_types.h + Spear/Assets/Model/MD2/MD2_load.h + Spear/Assets/Model/OBJ/OBJ_load.h + Spear/Assets/Model/OBJ/cvector.h + Spear/Assets/Model/Model.h + Spear/Assets/Model/Model_error_code.h + Spear/Assets/Model/sys_types.h + Spear/Render/RenderModel.h + Timer/Timer.h - includes: Spear/Assets/Image/BMP/BMP_load.h - Spear/Assets/Image/Image.h - Spear/Assets/Image/Image_error_code.h - Spear/Assets/Image/sys_types.h - Spear/Assets/Model/MD2/MD2_load.h - Spear/Assets/Model/OBJ/OBJ_load.h - Spear/Assets/Model/OBJ/cvector.h - Spear/Assets/Model/Model.h - Spear/Assets/Model/Model_error_code.h - Spear/Assets/Model/sys_types.h - Spear/Render/RenderModel.h - Timer/Timer.h - - include-dirs: . - Spear - Spear/Assets/Image - Spear/Assets/Image/BMP - Spear/Assets/Model - Spear/Render - Spear/Sys + include-dirs: + . + Spear + Spear/Assets/Image + Spear/Assets/Image/BMP + Spear/Assets/Model + Spear/Render + Spear/Sys hs-source-dirs: . diff --git a/Spear/GL.hs b/Spear/GL.hs index 21ed9ec..81a433e 100644 --- a/Spear/GL.hs +++ b/Spear/GL.hs @@ -87,29 +87,32 @@ module Spear.GL ) where -import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.State as State -import qualified Data.ByteString.Char8 as B -import Data.StateVar -import Data.Word -import Foreign.C.String -import Foreign.C.Types -import Foreign.Marshal.Alloc (alloca) -import Foreign.Marshal.Array (withArray) -import Foreign.Marshal.Utils as Foreign (with) -import Foreign.Ptr -import Foreign.Storable -import Foreign.Storable (peek) -import Graphics.GL.Core46 -import Spear.Assets.Image -import Spear.Game -import Spear.Math.Matrix3 (Matrix3) -import Spear.Math.Matrix4 (Matrix4) -import Spear.Math.Vector -import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory) -import System.IO (hPutStrLn, stderr) -import Unsafe.Coerce +import Control.Monad +import Control.Monad.Trans.Class +import Control.Monad.Trans.State as State +import qualified Data.ByteString.Char8 as B +import Data.StateVar +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Array (withArray) +import Foreign.Marshal.Utils as Foreign (with) +import Foreign.Ptr +import Foreign.Storable +import Foreign.Storable (peek) +import Graphics.GL.Core46 +import Prelude hiding ((*)) +import Spear.Assets.Image +import Spear.Game +import Spear.Math.Algebra +import Spear.Math.Matrix3 (Matrix3) +import Spear.Math.Matrix4 (Matrix4) +import Spear.Math.Vector +import System.Directory (doesFileExist, getCurrentDirectory, + setCurrentDirectory) +import System.IO (hPutStrLn, stderr) +import Unsafe.Coerce -- -- MANAGEMENT @@ -117,7 +120,7 @@ import Unsafe.Coerce -- | A GLSL shader handle. data GLSLShader = GLSLShader - { getShader :: GLuint, + { getShader :: GLuint, getShaderKey :: Resource } @@ -126,7 +129,7 @@ instance ResourceClass GLSLShader where -- | A GLSL program handle. data GLSLProgram = GLSLProgram - { getProgram :: GLuint, + { getProgram :: GLuint, getProgramKey :: Resource } @@ -137,7 +140,7 @@ instance ResourceClass GLSLProgram where data ShaderType = VertexShader | FragmentShader | GeometryShader deriving (Eq, Show) toGLShader :: ShaderType -> GLenum -toGLShader VertexShader = GL_VERTEX_SHADER +toGLShader VertexShader = GL_VERTEX_SHADER toGLShader FragmentShader = GL_FRAGMENT_SHADER toGLShader GeometryShader = GL_GEOMETRY_SHADER @@ -529,7 +532,7 @@ drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs -- | An OpenGL buffer. data GLBuffer = GLBuffer { getBuffer :: GLuint, - rkey :: Resource + rkey :: Resource } instance ResourceClass GLBuffer where @@ -544,10 +547,10 @@ data TargetBuffer deriving (Eq, Show) fromTarget :: TargetBuffer -> GLenum -fromTarget ArrayBuffer = GL_ARRAY_BUFFER +fromTarget ArrayBuffer = GL_ARRAY_BUFFER fromTarget ElementArrayBuffer = GL_ELEMENT_ARRAY_BUFFER -fromTarget PixelPackBuffer = GL_PIXEL_PACK_BUFFER -fromTarget PixelUnpackBuffer = GL_PIXEL_UNPACK_BUFFER +fromTarget PixelPackBuffer = GL_PIXEL_PACK_BUFFER +fromTarget PixelUnpackBuffer = GL_PIXEL_UNPACK_BUFFER -- | A buffer usage. data BufferUsage @@ -563,12 +566,12 @@ data BufferUsage deriving (Eq, Show) fromUsage :: BufferUsage -> GLenum -fromUsage StreamDraw = GL_STREAM_DRAW -fromUsage StreamRead = GL_STREAM_READ -fromUsage StreamCopy = GL_STREAM_COPY -fromUsage StaticDraw = GL_STATIC_DRAW -fromUsage StaticRead = GL_STATIC_READ -fromUsage StaticCopy = GL_STATIC_COPY +fromUsage StreamDraw = GL_STREAM_DRAW +fromUsage StreamRead = GL_STREAM_READ +fromUsage StreamCopy = GL_STREAM_COPY +fromUsage StaticDraw = GL_STATIC_DRAW +fromUsage StaticRead = GL_STATIC_READ +fromUsage StaticCopy = GL_STATIC_COPY fromUsage DynamicDraw = GL_DYNAMIC_DRAW fromUsage DynamicRead = GL_DYNAMIC_READ fromUsage DynamicCopy = GL_DYNAMIC_COPY @@ -780,7 +783,7 @@ getGLError = fmap translate glGetError printGLError :: IO () printGLError = getGLError >>= \err -> case err of - Nothing -> return () + Nothing -> return () Just str -> hPutStrLn stderr str -- | Run the given setup action and check for OpenGL errors. @@ -793,4 +796,4 @@ assertGL action err = do status <- gameIO getGLError case status of Just str -> gameError $ "OpenGL error raised: " ++ err ++ "; " ++ str - Nothing -> return result + Nothing -> return result diff --git a/Spear/Game.hs b/Spear/Game.hs index c5b043b..e43974f 100644 --- a/Spear/Game.hs +++ b/Spear/Game.hs @@ -30,9 +30,9 @@ module Spear.Game ) where -import Control.Monad.Catch -import Control.Monad.State.Strict -import Control.Monad.Trans.Class (lift) +import Control.Monad.Catch +import Control.Monad.State.Strict +import Control.Monad.Trans.Class (lift) import qualified Control.Monad.Trans.Resource as R type Resource = R.ReleaseKey @@ -83,7 +83,7 @@ gameError' = lift . lift . throwM -- | Throw the given error if given 'Nothing'. assertMaybe :: Maybe a -> GameException -> Game s a assertMaybe Nothing err = gameError' err -assertMaybe (Just x) _ = return x +assertMaybe (Just x) _ = return x -- | Run the given game with the given error handler. catchGameError :: Game s a -> (GameException -> Game s a) -> Game s a diff --git a/Spear/Math/AABB.hs b/Spear/Math/AABB.hs index de3b1a4..ab51ec9 100644 --- a/Spear/Math/AABB.hs +++ b/Spear/Math/AABB.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + module Spear.Math.AABB ( AABB2(..) @@ -9,9 +13,12 @@ module Spear.Math.AABB ) where -import Spear.Math.Vector +import Spear.Math.Spatial +import Spear.Math.Vector +import Spear.Prelude + +import Data.List (foldl') -import Data.List (foldl') -- | An axis-aligned bounding box in 2D space. data AABB2 = AABB2 {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2 deriving Show @@ -19,17 +26,28 @@ data AABB2 = AABB2 {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2 deriving Show -- | An axis-aligned bounding box in 3D space. data AABB3 = AABB3 {-# UNPACK #-} !Vector3 {-# UNPACK #-} !Vector3 deriving Show + +instance Positional AABB2 Vector2 where + setPosition p (AABB2 pmin pmax) = AABB2 p (p + (pmax - pmin)) + position (AABB2 pmin pmax) = pmin + translate p (AABB2 pmin pmax) = AABB2 (p + pmin) (p + pmax) + + +instance Positional AABB3 Vector3 where + setPosition p (AABB3 pmin pmax) = AABB3 p (p + (pmax - pmin)) + position (AABB3 pmin pmax) = pmin + translate p (AABB3 pmin pmax) = AABB3 (p + pmin) (p + pmax) + + -- | Create a AABB from the given points. aabb2 :: [Vector2] -> AABB2 -aabb2 [] = AABB2 zero2 zero2 -aabb2 (x:xs) = foldl' update (AABB2 x x) xs - where update (AABB2 pmin pmax) p = AABB2 (min p pmin) (max p pmax) +aabb2 = foldl' union (AABB2 zero2 zero2) + where union (AABB2 pmin pmax) p = AABB2 (min p pmin) (max p pmax) -- | Create an AABB from the given points. aabb3 :: [Vector3] -> AABB3 -aabb3 [] = AABB3 zero3 zero3 -aabb3 (x:xs) = foldl' update (AABB3 x x) xs - where update (AABB3 pmin pmax) p = AABB3 (min p pmin) (max p pmax) +aabb3 = foldl' union (AABB3 zero3 zero3) + where union (AABB3 pmin pmax) p = AABB3 (min p pmin) (max p pmax) -- | Return 'True' if the given AABB contains the given point, 'False' otherwise. aabb2pt :: AABB2 -> Vector2 -> Bool diff --git a/Spear/Math/Algebra.hs b/Spear/Math/Algebra.hs new file mode 100644 index 0000000..f6f8938 --- /dev/null +++ b/Spear/Math/Algebra.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeFamilies #-} + +module Spear.Math.Algebra +where + +import Foreign.C.Types +import Prelude hiding ((*), (+), (-), (/)) +import qualified Prelude as P + + +-- | General addition. +class Addition a b where + infixl 6 + + (+) :: a -> b -> a + +-- | General subtraction. +class Subtraction a b where + infixl 6 - + (-) :: a -> b -> a + +-- | General multiplication. +class Product a b c | a b -> c where + infixl 7 * + (*) :: a -> b -> c + +-- | General division. +class Quotient a b where + infixl 7 / + (/) :: a -> b -> a + +-- -- Commutative addition. +-- class CommutativeAddition a b + +-- -- Commutative product. +-- class CommutativeProduct a b + + +-- Convenient definitions so that we can again use operators on scalars simply. +instance Addition Int Int where (+) = (P.+) +instance Addition Float Float where (+) = (P.+) +instance Addition Double Double where (+) = (P.+) +instance Addition CUInt CUInt where (+) = (P.+) + +instance Subtraction Int Int where (-) = (P.-) +instance Subtraction Float Float where (-) = (P.-) +instance Subtraction Double Double where (-) = (P.-) + +instance Product Int Int Int where (*) = (P.*) +instance Product Float Float Float where (*) = (P.*) +instance Product Double Double Double where (*) = (P.*) +instance Product CUInt CUInt CUInt where (*) = (P.*) + +instance Quotient Int Int where (/) = P.div +instance Quotient Float Float where (/) = (P./) +instance Quotient Double Double where (/) = (P./) + + +-- These definitions help in the implementations of Num. Num is needed if we +-- want syntactic negation for a type. +add :: Addition a a => a -> a -> a +add a b = a + b + +sub :: Subtraction a a => a -> a -> a +sub a b = a - b + +mul :: Product a a a => a -> a -> a +mul a b = a * b + +div :: Quotient a a => a -> a -> a +div a b = a / b + + +{- instance Num a => Addition a a where + (+) = (P.+) + +instance Num a => Subtraction a a where + (-) = (P.+) + +instance Num a => Product a a where + type Prod a a = a + + (*) = (P.*) + +instance Fractional a => Quotient a a where + (/) = (P./) -} + + +-- instance Quotient Int Int where (/) = div + +-- instance (Addition a b c, CommutativeAddition a b) => Addition b a c where +-- b + a = a + b + +-- instance (Product a b c, CommutativeProduct a b) => Product b a c where +-- b * a = a * b + +-- instance Num a => CommutativeAddition a a +-- instance Num a => CommutativeProduct a a + + +lerp a b t = a + t * (b - a) diff --git a/Spear/Math/Camera.hs b/Spear/Math/Camera.hs index 220c435..030846a 100644 --- a/Spear/Math/Camera.hs +++ b/Spear/Math/Camera.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + module Spear.Math.Camera ( Camera @@ -15,27 +17,52 @@ module Spear.Math.Camera ) where -import qualified Spear.Math.Matrix4 as M -import Spear.Math.Spatial3 -import Spear.Math.Vector +import qualified Spear.Math.Matrix4 as M +import Spear.Math.Spatial +import Spear.Math.Spatial3 +import Spear.Math.Vector + data Camera = Camera { projection :: M.Matrix4 -- ^ Get the camera's projection. - , spatial :: Obj3 + , basis :: Transform3 } -instance Spatial3 Camera where - getObj3 = spatial - setObj3 cam o = cam { spatial = o } -type Fovy = Float +instance Has3dTransform Camera where + set3dTransform transform camera = camera { basis = transform } + transform3 = basis + + +instance Positional Camera Vector3 where + setPosition p = with3dTransform (setPosition p) + position = position . basis + translate v = with3dTransform (translate v) + + +instance Rotational Camera Vector3 Rotation3 where + setRotation rotation = with3dTransform (setRotation rotation) + rotation = rotation . basis + rotate rot = with3dTransform (rotate rot) + right = right . basis + up = up . basis + forward = forward . basis + setForward forward = with3dTransform (setForward forward) + + +instance Spatial Camera Vector3 Rotation3 Transform3 where + setTransform transform camera = camera { basis = transform } + transform = basis + + +type Fovy = Float type Aspect = Float -type Near = Float -type Far = Float -type Left = Float -type Right = Float +type Near = Float +type Far = Float +type Left = Float +type Right = Float type Bottom = Float -type Top = Float +type Top = Float -- | Build a perspective camera. perspective :: Fovy -- ^ Fovy - Vertical field of view angle in degrees. @@ -47,14 +74,12 @@ perspective :: Fovy -- ^ Fovy - Vertical field of view angle in degrees. -> Forward3 -- ^ Forward vector. -> Position3 -- ^ Position vector. -> Camera - perspective fovy r n f right up fwd pos = Camera { projection = M.perspective fovy r n f - , spatial = fromVectors right up fwd pos + , basis = newTransform3 right up fwd pos } - -- | Build an orthogonal camera. ortho :: Left -- ^ Left. -> Right -- ^ Right. @@ -67,9 +92,8 @@ ortho :: Left -- ^ Left. -> Forward3 -- ^ Forward vector. -> Position3 -- ^ Position vector. -> Camera - ortho l r b t n f right up fwd pos = Camera { projection = M.ortho l r b t n f - , spatial = fromVectors right up fwd pos + , basis = newTransform3 right up fwd pos } diff --git a/Spear/Math/Circle.hs b/Spear/Math/Circle.hs index e4a9bb6..be17666 100644 --- a/Spear/Math/Circle.hs +++ b/Spear/Math/Circle.hs @@ -1,9 +1,18 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + module Spear.Math.Circle where -import Spear.Math.Vector +import Spear.Math.Algebra +import Spear.Math.Vector +import Spear.Prelude + +import Data.List (foldl') +import Spear.Math.Spatial +import Spear.Math.Spatial2 -import Data.List (foldl') -- | A circle in 2D space. data Circle = Circle @@ -11,12 +20,19 @@ data Circle = Circle , radius :: {-# UNPACK #-} !Float } + +instance Positional Circle Vector2 where + setPosition p circle = circle { center = p } + position = center + translate v circle = circle { center = center circle + v} + + -- | Create a circle from the given points. circle :: [Vector2] -> Circle circle [] = Circle zero2 0 circle (x:xs) = Circle c r where - c = pmin + (pmax-pmin)/2 + c = pmin + (pmax-pmin) / (2::Float) r = norm $ pmax - c (pmin,pmax) = foldl' update (x,x) xs update (pmin,pmax) p = (min p pmin, max p pmax) diff --git a/Spear/Math/Collision.hs b/Spear/Math/Collision.hs index a69ea7a..4412b10 100644 --- a/Spear/Math/Collision.hs +++ b/Spear/Math/Collision.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + module Spear.Math.Collision ( CollisionType(..) @@ -23,15 +25,17 @@ module Spear.Math.Collision ) where -import Spear.Assets.Model -import Spear.Math.AABB -import Spear.Math.Circle +import Spear.Assets.Model +import Spear.Math.AABB +import Spear.Math.Algebra +import Spear.Math.Circle import qualified Spear.Math.Matrix4 as M4 -import Spear.Math.Plane -import Spear.Math.Sphere -import Spear.Math.Vector +import Spear.Math.Plane +import Spear.Math.Sphere +import Spear.Math.Vector +import Spear.Prelude -import Data.List (foldl') +import Data.List (foldl') data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy deriving (Eq, Show) @@ -39,7 +43,6 @@ data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy -- 2D collision class Collisionable2 a where - -- | Collide the object with an AABB. collideAABB2 :: AABB2 -> a -> CollisionType @@ -47,7 +50,6 @@ class Collisionable2 a where collideCircle :: Circle -> a -> CollisionType instance Collisionable2 AABB2 where - collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2) | (x max1) < (x min2) = NoCollision | (x min1) > (x max2) = NoCollision @@ -63,15 +65,14 @@ instance Collisionable2 AABB2 where | otherwise = Collision where test = collideAABB2 aabb $ aabb2FromCircle circle - boxC = min + (max-min)/2 + boxC = min + (max-min) / (2::Float) l = norm $ min + (vec2 (x boxC) (y min)) - min instance Collisionable2 Circle where - collideAABB2 box circle = case collideCircle circle box of FullyContains -> FullyContainedBy FullyContainedBy -> FullyContains - x -> x + x -> x collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2) | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy @@ -83,13 +84,13 @@ instance Collisionable2 Circle where sub_radii = (r1 - r2)^2 instance Collisionable2 Collisioner2 where - collideAABB2 box (AABB2Col self) = collideAABB2 box self collideAABB2 box (CircleCol self) = collideAABB2 box self collideCircle circle (AABB2Col self) = collideCircle circle self collideCircle circle (CircleCol self) = collideCircle circle self + aabbPoints :: AABB2 -> [Vector2] aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8] where @@ -142,15 +143,15 @@ buildAABB2 cols = aabb2 $ generatePoints cols aabb2FromCircle :: Circle -> AABB2 aabb2FromCircle (Circle c r) = AABB2 bot top where - bot = c - (vec2 r r) - top = c + (vec2 r r) + bot = c - vec2 r r + top = c + vec2 r r -- | Create the minimal circle fully containing the specified box. circleFromAABB2 :: AABB2 -> Circle circleFromAABB2 (AABB2 min max) = Circle c r where - c = scale 0.5 (min + max) - r = norm . scale 0.5 $ max - min + c = (0.5::Float) * (min + max) + r = norm . (*(0.5::Float)) $ max - min generatePoints :: [Collisioner2] -> [Vector2] generatePoints = foldl' generate [] @@ -168,10 +169,10 @@ generatePoints = foldl' generate [] generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc where - p1 = c + unitx2 * (vec2 r r) - p2 = c - unitx2 * (vec2 r r) - p3 = c + unity2 * (vec2 r r) - p4 = c - unity2 * (vec2 r r) + p1 = c + unitx2 * vec2 r r + p2 = c - unitx2 * vec2 r r + p3 = c + unity2 * vec2 r r + p4 = c - unity2 * vec2 r r -- | Collide the given collisioners. collide :: Collisioner2 -> Collisioner2 -> CollisionType @@ -183,13 +184,11 @@ collide (CircleCol circle) (AABB2Col box) = collideCircle circle box -- | Move the collisioner. move :: Vector2 -> Collisioner2 -> Collisioner2 move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v)) -move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) - +move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) --- 3D collision +-- | 3D collision class Collisionable3 a where - -- | Collide the object with an AABB. collideAABB3 :: AABB3 -> a -> CollisionType @@ -197,12 +196,11 @@ class Collisionable3 a where collideSphere :: Sphere -> a -> CollisionType instance Collisionable3 AABB3 where - collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2) - | (x max1) < (x min2) = NoCollision - | (x min1) > (x max2) = NoCollision - | (y max1) < (y min2) = NoCollision - | (y min1) > (y max2) = NoCollision + | x max1 < x min2 = NoCollision + | x min1 > x max2 = NoCollision + | y max1 < y min2 = NoCollision + | y min1 > y max2 = NoCollision | box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains | box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy | otherwise = Collision @@ -215,18 +213,17 @@ instance Collisionable3 AABB3 where test = collideAABB3 aabb $ aabb3FromSphere sphere boxC = min + v l = norm v - v = (max-min)/2 + v = (max-min) / (2::Float) instance Collisionable3 Sphere where - collideAABB3 box sphere = case collideSphere sphere box of FullyContains -> FullyContainedBy FullyContainedBy -> FullyContains - x -> x + x -> x collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2) | distance_centers <= sub_radii = - if (r1 > r2) then FullyContains else FullyContainedBy + if r1 > r2 then FullyContains else FullyContainedBy | distance_centers <= sum_radii = Collision | otherwise = NoCollision where @@ -238,5 +235,5 @@ instance Collisionable3 Sphere where aabb3FromSphere :: Sphere -> AABB3 aabb3FromSphere (Sphere c r) = AABB3 bot top where - bot = c - (vec3 r r r) - top = c + (vec3 r r r) \ No newline at end of file + bot = c - vec3 r r r + top = c + vec3 r r r diff --git a/Spear/Math/Matrix3.hs b/Spear/Math/Matrix3.hs index 7526827..c8ed6d2 100644 --- a/Spear/Math/Matrix3.hs +++ b/Spear/Math/Matrix3.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + module Spear.Math.Matrix3 ( Matrix3 @@ -8,6 +12,7 @@ module Spear.Math.Matrix3 , col0, col1, col2 , row0, row1, row2 , right, up, forward, position +, setRight, setUp, setForward, setPosition -- * Construction , mat3 , mat3fromVec @@ -17,8 +22,8 @@ module Spear.Math.Matrix3 , Spear.Math.Matrix3.id -- * Transformations -- ** Translation -, transl -, translv +, translate +, translatev -- ** Rotation , rot -- ** Scale @@ -39,10 +44,11 @@ module Spear.Math.Matrix3 ) where +import Spear.Math.Algebra hiding (mul) +import Spear.Math.Vector +import Spear.Prelude hiding (mul) -import Spear.Math.Vector - -import Foreign.Storable +import Foreign.Storable -- | Represents a 3x3 column major matrix. @@ -54,7 +60,6 @@ data Matrix3 = Matrix3 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" ++ @@ -63,53 +68,51 @@ instance Show Matrix3 where show' f = if abs f < 0.0000001 then "0" else show f -instance Num Matrix3 where +instance Addition Matrix3 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) - + + +instance Subtraction Matrix3 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) - + + +instance Product Matrix3 Matrix3 Matrix3 where (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 @@ -122,22 +125,24 @@ 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 +position (Matrix3 _ _ a20 _ _ a21 _ _ _) = vec2 a20 a21 +forward = up + +setRight (Vector2 x y) matrix = matrix { m00 = x, m01 = y } +setUp (Vector2 x y) matrix = matrix { m10 = x, m11 = y } +setPosition (Vector2 x y) matrix = matrix { m20 = x, m21 = y} +setForward = setUp -- | 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 @@ -145,19 +150,16 @@ mat3fromVec v0 v1 v2 = Matrix3 (y v0) (y v1) (y v2) (z v0) (z v1) (z v2) - -- | Build a transformation matrix. transform :: Vector2 -- ^ Right vector -> Vector2 -- ^ Forward vector -> Vector2 -- ^ Position -> Matrix3 -- ^ Transform - transform r f p = mat3 (x r) (x f) (x p) (y r) (y f) (y p) 0 0 1 - -- | Get the translation part of the given transformation matrix. translation :: Matrix3 -> Matrix3 translation (Matrix3 @@ -169,7 +171,6 @@ translation (Matrix3 0 1 a21 0 0 a22 - -- | Get the rotation part of the given transformationmatrix. rotation :: Matrix3 -> Matrix3 rotation (Matrix3 @@ -181,7 +182,6 @@ rotation (Matrix3 a01 a11 0 a02 a12 1 - -- | Return the identity matrix. id :: Matrix3 id = mat3 @@ -189,26 +189,23 @@ id = mat3 0 1 0 0 0 1 - -- | Create a translation matrix. -transl :: Float -- ^ Translation on the x axis - -> Float -- ^ Translation on the y axis - -> Matrix3 - -transl tx ty = mat3 +translate + :: Float -- ^ Translation on the x axis + -> Float -- ^ Translation on the y axis + -> Matrix3 +translate tx ty = mat3 1 0 tx 0 1 ty 0 0 1 - -- | Create a translation matrix. -translv :: Vector2 -> Matrix3 -translv v = mat3 +translatev :: Vector2 -> Matrix3 +translatev v = mat3 1 0 (x v) 0 1 (y v) 0 0 1 - -- | Create a rotation matrix rotating counter-clockwise about the Z axis. -- -- The given angle must be in degrees. @@ -218,9 +215,8 @@ rot angle = mat3 s c 0 0 0 1 where - s = sin . fromDeg $ angle - c = cos . fromDeg $ angle - + s = sin angle + c = cos angle -- | Create a scale matrix. scale :: Float -> Float -> Float -> Matrix3 @@ -228,8 +224,7 @@ scale sx sy sz = mat3 sx 0 0 0 sy 0 0 0 sz - - + -- | Create a scale matrix. scalev :: Vector3 -> Matrix3 scalev v = mat3 @@ -241,7 +236,6 @@ scalev v = mat3 sy = y v sz = z v - -- | Create an X reflection matrix. reflectX :: Matrix3 reflectX = mat3 @@ -249,7 +243,6 @@ reflectX = mat3 0 1 0 0 0 1 - -- | Create a Y reflection matrix. reflectY :: Matrix3 reflectY = mat3 @@ -257,7 +250,6 @@ reflectY = mat3 0 (-1) 0 0 0 1 - -- | Create a Z reflection matrix. reflectZ :: Matrix3 reflectZ = mat3 @@ -265,7 +257,6 @@ reflectZ = mat3 0 1 0 0 0 (-1) - -- | Transpose the specified matrix. transpose :: Matrix3 -> Matrix3 transpose m = mat3 @@ -273,7 +264,6 @@ transpose m = mat3 (m10 m) (m11 m) (m12 m) (m20 m) (m21 m) (m22 m) - -- | Transform the given point vector in 2D space with the given matrix. mulp :: Matrix3 -> Vector2 -> Vector2 mulp m v = vec2 x' y' @@ -283,7 +273,6 @@ mulp m v = vec2 x' y' y' = row1 m `dot` v' - -- | Transform the given directional vector in 2D space with the given matrix. muld :: Matrix3 -> Vector2 -> Vector2 muld m v = vec2 x' y' @@ -292,7 +281,6 @@ muld m v = vec2 x' y' x' = row0 m `dot` v' y' = row1 m `dot` v' - -- | Transform the given vector in 3D space with the given matrix. mul :: Matrix3 -> Vector3 -> Vector3 mul m v = vec3 x' y' z' @@ -302,7 +290,6 @@ mul m v = vec3 x' y' z' y' = row1 m `dot` v' z' = row2 m `dot` v' - -- | Zip two 'Matrix3' together with the specified function. zipWith :: (Float -> Float -> Float) -> Matrix3 -> Matrix3 -> Matrix3 zipWith f a b = Matrix3 @@ -310,7 +297,6 @@ zipWith f a b = Matrix3 (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 @@ -318,7 +304,6 @@ map f m = Matrix3 (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 inverseTransform mat = @@ -329,7 +314,3 @@ inverseTransform mat = (x r) (y r) (t `dot` r) (x f) (y f) (t `dot` f) 0 0 1 - - -fromDeg :: (Floating a) => a -> a -fromDeg = (*pi) . (/180) diff --git a/Spear/Math/Matrix4.hs b/Spear/Math/Matrix4.hs index 16f7c93..bc74a27 100644 --- a/Spear/Math/Matrix4.hs +++ b/Spear/Math/Matrix4.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + module Spear.Math.Matrix4 ( Matrix4 @@ -9,6 +13,7 @@ module Spear.Math.Matrix4 , col0, col1, col2, col3 , row0, row1, row2, row3 , right, up, forward, position +, setRight, setUp, setForward, setPosition -- * Construction , mat4 , mat4fromVec @@ -50,10 +55,11 @@ module Spear.Math.Matrix4 ) where +import Spear.Math.Algebra hiding (mul) +import Spear.Math.Vector +import Spear.Prelude hiding (mul) -import Spear.Math.Vector - -import Foreign.Storable +import Foreign.Storable -- | Represents a 4x4 column major matrix. @@ -66,7 +72,6 @@ data Matrix4 = Matrix4 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" ++ @@ -76,7 +81,7 @@ instance Show Matrix4 where show' f = if abs f < 0.0000001 then "0" else show f -instance Num Matrix4 where +instance Addition Matrix4 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) @@ -84,6 +89,8 @@ instance Num Matrix4 where (a08 + b08) (a09 + b09) (a10 + b10) (a11 + b11) (a12 + b12) (a13 + b13) (a14 + b14) (a15 + b15) + +instance Subtraction Matrix4 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) @@ -91,6 +98,8 @@ instance Num Matrix4 where (a08 - b08) (a09 - b09) (a10 - b10) (a11 - b11) (a12 - b12) (a13 - b13) (a14 - b14) (a15 - b15) + +instance Product Matrix4 Matrix4 Matrix4 where (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) @@ -113,11 +122,13 @@ instance Num Matrix4 where (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 Product Matrix4 Float Matrix4 where + (Matrix4 a00 a10 a20 a30 a01 a11 a21 a31 a02 a12 a22 a32 a03 a13 a23 a33) * s = + Matrix4 (a00 * s) (a10 * s) (a20 * s) (a30 * s) + (a01 * s) (a11 * s) (a21 * s) (a31 * s) + (a02 * s) (a12 * s) (a22 * s) (a32 * s) + (a03 * s) (a13 * s) (a23 * s) (a33 * s) instance Storable Matrix4 where @@ -150,23 +161,24 @@ col1 (Matrix4 _ 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 +setRight (Vector3 x y z) matrix = matrix { m00 = x, m01 = y, m02 = z } +setUp (Vector3 x y z) matrix = matrix { m10 = x, m11 = y, m12 = z } +setForward (Vector3 x y z) matrix = matrix { m20 = x, m21 = y, m22 = z } +setPosition (Vector3 x y z) matrix = matrix { m30 = x, m31 = y, m32 = z } -- | 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 @@ -175,21 +187,18 @@ mat4fromVec v0 v1 v2 v3 = Matrix4 (z v0) (z v1) (z v2) (z v3) (w v0) (w v1) (w v2) (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 (x right) (x up) (x fwd) (x pos) (y right) (y up) (y fwd) (y pos) (z right) (z up) (z fwd) (z pos) 0 0 0 1 - -- | Get the translation part of the given transformation matrix. translation :: Matrix4 -> Matrix4 translation (Matrix4 @@ -203,7 +212,6 @@ translation (Matrix4 0 0 1 a32 0 0 0 a33 - -- | Get the rotation part of the given transformation matrix. rotation :: Matrix4 -> Matrix4 rotation (Matrix4 @@ -217,12 +225,10 @@ rotation (Matrix4 a02 a12 a22 0 a03 a13 a23 1 - -- | Build a transformation 'Matrix4' defined by the given position and target. lookAt :: Vector3 -- ^ Eye position. -> Vector3 -- ^ Target point. -> Matrix4 - lookAt pos target = let fwd = normalise $ target - pos r = fwd `cross` unity3 @@ -230,7 +236,6 @@ lookAt pos target = 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 @@ -239,7 +244,6 @@ zipWith f a b = Matrix4 (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 @@ -248,7 +252,6 @@ map f m = Matrix4 (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 @@ -257,7 +260,6 @@ id = mat4 0 0 1 0 0 0 0 1 - -- | Create a translation matrix. transl :: Float -> Float -> Float -> Matrix4 transl x y z = mat4 @@ -266,7 +268,6 @@ transl x y z = mat4 0 0 1 z 0 0 0 1 - -- | Create a translation matrix. translv :: Vector3 -> Matrix4 translv v = mat4 @@ -275,7 +276,6 @@ translv v = mat4 0 0 1 (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 @@ -285,9 +285,8 @@ rotX angle = mat4 0 s c 0 0 0 0 1 where - s = sin . toRAD $ angle - c = cos . toRAD $ angle - + s = sin angle + c = cos angle -- | Create a rotation matrix rotating about the Y axis. -- The given angle must be in degrees. @@ -298,9 +297,8 @@ rotY angle = mat4 (-s) 0 c 0 0 0 0 1 where - s = sin . toRAD $ angle - c = cos . toRAD $ angle - + s = sin angle + c = cos angle -- | Create a rotation matrix rotating about the Z axis. -- The given angle must be in degrees. @@ -311,9 +309,8 @@ rotZ angle = mat4 0 0 1 0 0 0 0 1 where - s = sin . toRAD $ angle - c = cos . toRAD $ angle - + s = sin angle + c = cos angle -- | Create a rotation matrix rotating about the specified axis. -- The given angle must be in degrees. @@ -327,16 +324,15 @@ axisAngle v angle = mat4 ax = x v ay = y v az = z v - s = sin . toRAD $ angle - c = cos . toRAD $ angle + s = sin angle + c = cos angle xy = ax*ay xz = ax*az yz = ay*az sx = s*ax sy = s*ay sz = s*az - omc = 1 - c - + omc = (1::Float) - c -- | Create a scale matrix. scale :: Float -> Float -> Float -> Matrix4 @@ -346,7 +342,6 @@ scale sx sy sz = mat4 0 0 sz 0 0 0 0 1 - -- | Create a scale matrix. scalev :: Vector3 -> Matrix4 scalev v = mat4 @@ -359,7 +354,6 @@ scalev v = mat4 sy = y v sz = z v - -- | Create an X reflection matrix. reflectX :: Matrix4 reflectX = mat4 @@ -368,7 +362,6 @@ reflectX = mat4 0 0 1 0 0 0 0 1 - -- | Create a Y reflection matrix. reflectY :: Matrix4 reflectY = mat4 @@ -377,7 +370,6 @@ reflectY = mat4 0 0 1 0 0 0 0 1 - -- | Create a Z reflection matrix. reflectZ :: Matrix4 reflectZ = mat4 @@ -386,7 +378,6 @@ reflectZ = mat4 0 0 (-1) 0 0 0 0 1 - -- | Create an orthogonal projection matrix. ortho :: Float -- ^ Left. -> Float -- ^ Right. @@ -395,7 +386,6 @@ ortho :: Float -- ^ Left. -> 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)) @@ -406,7 +396,6 @@ ortho l r b t n f = 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. @@ -414,15 +403,14 @@ perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees. -> Float -- ^ Far clip distance -> Matrix4 perspective fovy r near far = - let f = 1 / tan (toRAD fovy / 2) + let f = 1 / tan (fovy / (2::Float)) a = near - far in mat4 (f/r) 0 0 0 0 f 0 0 - 0 0 ((far+near)/a) (2*far*near/a) + 0 0 ((far+near)/a) ((2::Float)*far*near/a) 0 0 (-1) 0 - -- | Create a plane projection matrix. planeProj :: Vector3 -- ^ Plane normal -> Float -- ^ Plane distance from the origin @@ -442,7 +430,6 @@ planeProj n d l = (-nx*lz) (-ny*lz) (d + c - nz*lz) (-lz*d) (-nx) (-ny) (-nz) c - -- | Transpose the specified matrix. transpose :: Matrix4 -> Matrix4 transpose m = mat4 @@ -451,7 +438,6 @@ transpose m = mat4 (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 = @@ -467,7 +453,6 @@ inverseTransform mat = (x f) (y f) (z f) (-t `dot` f) 0 0 0 1 - -- | Invert the given matrix. inverse :: Matrix4 -> Matrix4 inverse mat = @@ -605,7 +590,7 @@ inverse mat = in if det' == 0 then Spear.Math.Matrix4.id else - let det = 1 / det' + let det = (1::Float) / det' in mat4 (m00' * det) (m04' * det) (m08' * det) (m12' * det) (m01' * det) (m05' * det) (m09' * det) (m13' * det) @@ -622,17 +607,14 @@ mul w m v = vec3 x' y' z' y' = row1 m `dot` v' z' = row2 m `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 - -- | Transform the given vector with the given matrix. -- -- The vector is brought from homogeneous space to 3D space by performing a @@ -645,6 +627,3 @@ mul' w m v = vec3 (x'/w') (y'/w') (z'/w') y' = row1 m `dot` v' z' = row2 m `dot` v' w' = row3 m `dot` v' - - -toRAD = (*pi) . (/180) diff --git a/Spear/Math/MatrixUtils.hs b/Spear/Math/MatrixUtils.hs index 567bee1..cca5c48 100644 --- a/Spear/Math/MatrixUtils.hs +++ b/Spear/Math/MatrixUtils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + module Spear.Math.MatrixUtils ( fastNormalMatrix @@ -11,11 +13,12 @@ module Spear.Math.MatrixUtils ) where -import Spear.Math.Camera as Cam -import Spear.Math.Matrix3 as M3 -import Spear.Math.Matrix4 as M4 -import Spear.Math.Spatial3 as S -import Spear.Math.Vector as V +import Spear.Math.Camera as Cam +import Spear.Math.Matrix3 as M3 +import Spear.Math.Matrix4 as M4 +import Spear.Math.Spatial3 as S +import Spear.Math.Vector as V +import Spear.Prelude -- | Compute the normal matrix of the given matrix. fastNormalMatrix :: Matrix4 -> Matrix3 @@ -39,9 +42,9 @@ unproject :: Matrix4 -- ^ Inverse projection matrix -> Vector3 unproject projI modelviewI vpx vpy w h x y z = let - xmouse = 2*(x-vpx)/w - 1 - ymouse = 2*(y-vpy)/h - 1 - zmouse = 2*z - 1 + xmouse = (2::Float) * (x-vpx)/w - (1::Float) + ymouse = (2::Float) * (y-vpy)/h - (1::Float) + zmouse = (2::Float) * z - (1::Float) in (modelviewI * projI) `M4.mulp` vec3 xmouse ymouse zmouse @@ -64,7 +67,7 @@ rpgUnproject projI viewI vpx vpy w h wx wy = p1 = unproject projI viewI vpx vpy w h wx wy 0 p2 = unproject projI viewI vpx vpy w h wx wy (-1) lambda = (y p1 / (y p1 - y p2)) - p' = p1 + V.scale lambda (p2 - p1) + p' = p1 + lambda * (p2 - p1) in vec2 (x p') (-(z p')) @@ -77,10 +80,10 @@ rpgTransform -> Matrix4 -- ^ Inverse view matrix -> Matrix4 rpgTransform h a axis pos viewI = - let p1 = viewI `M4.mulp` (vec3 (x pos) (y pos) 0) - p2 = viewI `M4.mulp` (vec3 (x pos) (y pos) (-1)) + let p1 = viewI `M4.mulp` vec3 (x pos) (y pos) 0 + p2 = viewI `M4.mulp` vec3 (x pos) (y pos) (-1) lambda = (y p1 / (y p1 - y p2)) - p = p1 + V.scale lambda (p2 - p1) + p = p1 + lambda * (p2 - p1) mat' = axisAngle axis a r = M4.right mat' u = M4.up mat' @@ -134,8 +137,8 @@ pltInverse = M4.inverseTransform . pltTransform objToClip :: Camera -> Matrix4 -> Vector3 -> Vector2 objToClip cam model p = let - view = M4.inverseTransform $ S.transform cam - proj = Cam.projection cam + view = M4.inverseTransform . transform3Matrix . transform3 $ cam + proj = projection cam p' = (proj * view * model) `M4.mulp` p in vec2 (x p') (y p') diff --git a/Spear/Math/Plane.hs b/Spear/Math/Plane.hs index ee788b5..5440a43 100644 --- a/Spear/Math/Plane.hs +++ b/Spear/Math/Plane.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + module Spear.Math.Plane ( Plane @@ -6,7 +8,8 @@ module Spear.Math.Plane ) where -import Spear.Math.Vector +import Spear.Math.Vector +import Spear.Prelude data PointPlanePos = Front | Back | Contained deriving (Eq, Show) diff --git a/Spear/Math/Quaternion.hs b/Spear/Math/Quaternion.hs index 78aca9c..c4d96d5 100644 --- a/Spear/Math/Quaternion.hs +++ b/Spear/Math/Quaternion.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + module Spear.Math.Quaternion ( Quaternion @@ -16,8 +18,9 @@ module Spear.Math.Quaternion ) where - -import Spear.Math.Vector +import Spear.Math.Algebra +import Spear.Math.Vector +import Spear.Prelude newtype Quaternion = Quaternion { getVec :: Vector4 } @@ -47,7 +50,7 @@ qAxisAngle :: Vector3 -> Float -> Quaternion qAxisAngle axis angle = let s' = norm axis s = if s' == 0 then 1 else s' - a = angle * toRAD * 0.5 + a = angle * (0.5::Float) sa = sin a qw = cos a qx = x axis * sa * s @@ -102,7 +105,3 @@ qnorm = norm . getVec qrot :: Quaternion -> Vector3 -> Vector3 qrot q v = toVec3 $ q `qmul` qvec3 v 0 `qmul` qconj q where toVec3 (Quaternion q) = vec3 (x q) (y q) (z q) - - -toRAD = pi / 180 - diff --git a/Spear/Math/Ray.hs b/Spear/Math/Ray.hs index 009455d..5bd4d7c 100644 --- a/Spear/Math/Ray.hs +++ b/Spear/Math/Ray.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeSynonymInstances #-} + module Spear.Math.Ray ( Ray(..) @@ -7,8 +11,12 @@ module Spear.Math.Ray where -import Spear.Math.Utils -import Spear.Math.Vector +import qualified Spear.Math.Matrix3 as Matrix3 +import Spear.Math.Spatial +import Spear.Math.Spatial2 +import Spear.Math.Utils +import Spear.Math.Vector +import Spear.Prelude data Ray = Ray @@ -17,6 +25,29 @@ data Ray = Ray } +instance Positional Ray Vector2 where + setPosition p ray = ray { origin = p } + position = origin + translate v ray = ray { origin = origin ray + v } + + +instance Rotational Ray Vector2 Angle where + setRotation angle ray = ray { dir = setRotation angle (dir ray) } + rotation = rotation . dir + rotate angle ray = ray { dir = rotate angle (dir ray) } + right = right . dir + up = up . dir + forward = forward . dir + setForward forward ray = ray { dir = forward } + + +instance Spatial Ray Vector2 Angle Transform2 where + setTransform (Transform2 matrix) ray = + ray { origin = Matrix3.position matrix, dir = Matrix3.up matrix } + transform ray = + Transform2 $ Matrix3.transform (perp $ dir ray) (dir ray) (origin ray) + + -- | Classify the given point's position with respect to the given ray. Left/Right test. raylr :: Ray -> Vector2 -> Side raylr (Ray o d) p diff --git a/Spear/Math/Spatial.hs b/Spear/Math/Spatial.hs new file mode 100644 index 0000000..bfab6c2 --- /dev/null +++ b/Spear/Math/Spatial.hs @@ -0,0 +1,111 @@ +{- This module categorizes objects in space. We identify three types of objects: + +- Objects that only move (Positional). +- Objects that only rotate (Rotational). +- Objects that both move and rotate (Spatial). + +Objects that only move are basically the rotationally-invariant ones: AABB, +circle, sphere, point light, omnidirectional sound source, etc. + +Conversely for objects that only rotate, which are position-invariant: +directional light sources, for example, or a single vector. + +Objects that both move and rotate are called "spatials". These are the +first-class citizens of space. + +The lack of ad-hoc overloading in Haskell also makes function names a bit +annoying, so all the type classes here are general over 2d/3d space so that +we can use the same names for everything (e.g., "translate" to move an object, +regardless of whether it is a 2D or 3D object). +-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Spear.Math.Spatial where + +import Spear.Math.Algebra +import Spear.Math.Vector +import Spear.Prelude + + +type Angle = Float -- TODO: consider newtype for Angle and Radius. +type Radius = Float -- TODO: Move somewhere more appropriate. + +-- TODO: consider a general concept of Rotation (Angle and Quaternion) that +-- then conditions Rotational like Vector conditions Positional. That would +-- allow us to get a basis out of a Rotational much like we can do now with +-- Positional (because we know it operates on Vectors). + + +class Vector v => Positional a v | a -> v where + -- | Set the object's position. + setPosition :: v -> a -> a + + -- | Get the object's position. + position :: a -> v + + -- | Translate the object. + translate :: v -> a -> a + + +class Rotational a v r | a -> v, a -> r where + -- | Set the object's rotation. + setRotation :: r -> a -> a + + -- | Get the object's rotation. + rotation :: a -> r + + -- | Rotate the object. + rotate :: r -> a -> a + + -- | Get the object's right vector. + right :: a -> v + + -- | Get the object's up vector. + up :: a -> v + + -- | Get the object's forward vector. + forward :: a -> v + + -- | Set the object's forward vector. + setForward :: v -> a -> a + + +class (Positional a v, Rotational a v r) => Spatial a v r t | a -> t where + -- | Set the spatial's transform. + setTransform :: t -> a -> a + + -- | Get the spatial's transform. + transform :: a -> t + + +-------------------------------------------------------------------------------- +-- Spatial. + +-- | Move the spatial along the given axis scaled by the given delta. +move :: Positional a v => Float -> (a -> v) -> a -> a +move delta axis a = translate (axis a * delta) a + +-- | Move the spatial upwards. +moveRight delta = move delta right + +-- | Move the spatial downwards. +moveLeft delta = moveRight (-delta) + +-- | Move the spatial upwards. +moveUp delta = move delta up + +-- | Move the spatial downwards. +moveDown delta = moveUp (-delta) + +-- | Move the spatial forwards. +moveFwd delta = move delta forward + +-- | Move the spatial backwards. +moveBack delta = moveFwd (-delta) + +-- | Make the spatial look at the given point. +lookAt :: Vector v => Spatial a v r t => v -> a -> a +lookAt p a = setForward (normalise $ p - position a) a diff --git a/Spear/Math/Spatial2.hs b/Spear/Math/Spatial2.hs index b2399f8..1cc2b65 100644 --- a/Spear/Math/Spatial2.hs +++ b/Spear/Math/Spatial2.hs @@ -1,151 +1,110 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeSynonymInstances #-} + module Spear.Math.Spatial2 -( - Spatial2(..) -, Obj2 -, Angle -, Radius -, move -, moveFwd -, moveBack -, moveUp -, moveDown -, moveLeft -, moveRight -, rotate -, setRotation -, pos -, fwd -, up -, right -, transform -, setTransform -, setPos -, lookAt -, Spear.Math.Spatial2.orbit -, obj2FromVectors -, obj2FromTransform -) where -import Spear.Math.Vector -import qualified Spear.Math.Matrix3 as M - -type Angle = Float -type Radius = Float - --- | An entity that can be moved around in 2D space. -class Spatial2 s where - - -- | Gets the spatial's Obj2. - getObj2 :: s -> Obj2 - - -- | Set the spatial's Obj2. - setObj2 :: s -> Obj2 -> s - --- | Move the spatial. -move :: Spatial2 s => Vector2 -> s -> s -move v s = let o = getObj2 s in setObj2 s $ o { p = p o + v } - --- | Move the spatial forwards. -moveFwd :: Spatial2 s => Float -> s -> s -moveFwd a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale a (fwd o) } - --- | Move the spatial backwards. -moveBack :: Spatial2 s => Float -> s -> s -moveBack a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale (-a) (fwd o) } - --- | Move the spatial up. -moveUp :: Spatial2 s => Float -> s -> s -moveUp a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale a (fwd o) } - --- | Move the spatial down. -moveDown :: Spatial2 s => Float -> s -> s -moveDown a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale (-a) (fwd o) } - --- | Make the spatial strafe left. -moveLeft :: Spatial2 s => Float -> s -> s -moveLeft a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale (-a) (right o) } - --- | Make the spatial Strafe right. -moveRight :: Spatial2 s => Float -> s -> s -moveRight a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale a (right o) } - --- | Rotate the spatial. -rotate :: Spatial2 s => Float -> s -> s -rotate angle s = let o = getObj2 s in setObj2 s $ o - { r = rotate' angle (r o) - , u = rotate' angle (u o) - } - --- | Set the spatial's rotation. -setRotation :: Spatial2 s => Float -> s -> s -setRotation angle s = let o = getObj2 s in setObj2 s $ o - { r = rotate' angle unitx2 - , u = rotate' angle unity2 - } - -rotate' :: Float -> Vector2 -> Vector2 -rotate' a' (Vector2 x y) = vec2 (x * cos a) (y * sin a) where a = a'*pi/180 - --- | Get the spatial's position. -pos :: Spatial2 s => s -> Vector2 -pos = p . getObj2 - --- | Get the spatial's forward vector. -fwd :: Spatial2 s => s -> Vector2 -fwd = u . getObj2 - --- | Get the spatial's up vector. -up :: Spatial2 s => s -> Vector2 -up = u . getObj2 - --- | Get the spatial's right vector. -right :: Spatial2 s => s -> Vector2 -right = r . getObj2 - --- | Get the spatial's transform. -transform :: Spatial2 s => s -> M.Matrix3 -transform s = let o = getObj2 s in M.transform (r o) (u o) (p o) - --- | Set the spatial's transform. -setTransform :: Spatial2 s => M.Matrix3 -> s -> s -setTransform t s = - let o = Obj2 (M.right t) (M.up t) (M.position t) - in setObj2 s o - --- | Set the spatial's position. -setPos :: Spatial2 s => Vector2 -> s -> s -setPos pos s = setObj2 s $ (getObj2 s) { p = pos } - --- | Make the spatial look at the given point. -lookAt :: Spatial2 s => Vector2 -> s -> s -lookAt pt s = - let position = pos s - fwd = normalise $ pt - position - r = perp fwd - in setTransform (M.transform r fwd position) s - --- | Make the 'Spatial' orbit around the given point -orbit :: Spatial2 s => Vector2 -> Angle -> Radius -> s -> s +import qualified Spear.Math.Matrix3 as Matrix3 +import Spear.Math.Matrix3 (Matrix3) +import Spear.Math.Spatial as Spatial +import Spear.Math.Vector +import Spear.Prelude + + +type Positional2 a = Positional a Vector2 +type Rotational2 a = Rotational a Angle +type Spatial2 s = Spatial s Vector2 Angle Transform2 + + +-- | A 2D transform. +newtype Transform2 = Transform2 { transform2Matrix :: Matrix3 } deriving Show + + +instance Rotational Vector2 Vector2 Angle where + setRotation angle v = norm v * Vector2 (cos angle) (sin angle) + + rotation v@(Vector2 x _) = acos (x / norm v) + + rotate angle v = Vector2 (x v * cos angle) (y v * sin angle) + + right = perp + + up = id + + forward = id + + setForward newForward _ = newForward + + +instance Positional Transform2 Vector2 where + setPosition p (Transform2 matrix) = + Transform2 . Matrix3.setPosition p $ matrix + + position = Matrix3.position . transform2Matrix + + translate v t@(Transform2 matrix) = setPosition (Matrix3.position matrix + v) t + + +instance Rotational Transform2 Vector2 Angle where + setRotation angle = + Transform2 . Matrix3.setRight r' . Matrix3.setUp u' . transform2Matrix + where r' = Spatial.rotate angle unitx2 + u' = Spatial.rotate angle unity2 + + rotation = rotation . Matrix3.right . transform2Matrix + + rotate angle (Transform2 matrix) = + Transform2 . Matrix3.setRight r' . Matrix3.setUp u' $ matrix + where r' = Spatial.rotate angle (Matrix3.right matrix) + u' = Spatial.rotate angle (Matrix3.up matrix) + + right = Matrix3.right . transform2Matrix + + up = Matrix3.up . transform2Matrix + + forward = up + + setForward forward (Transform2 matrix) = + Transform2 $ Matrix3.transform (perp forward) forward (Matrix3.position matrix) + + +instance Spatial Transform2 Vector2 Angle Matrix3 where + setTransform matrix _ = Transform2 matrix + + transform (Transform2 matrix) = matrix + + +class Has2dTransform a where + -- | Set the object's 2d transform. + set2dTransform :: Transform2 -> a -> a + + -- | Get the object's 2d transform. + transform2 :: a -> Transform2 + + +with2dTransform :: Has2dTransform a => (Transform2 -> Transform2) -> a -> a +with2dTransform f obj = set2dTransform (f $ transform2 obj) obj + +-- | Build a 2d transform from right, up, and position vectors. +newTransform2 :: Vector2 -> Vector2 -> Vector2 -> Transform2 +newTransform2 right up position = + Transform2 $ Matrix3.transform right up position + +-- | Get a transform matrix from a 2d positional. +posTransform2 :: Positional a Vector2 => a -> Matrix3 +posTransform2 = Matrix3.translatev . position + +-- TODO: Get a transform matrix from a 2d rotational. + +-- | Make the object orbit around the given point +-- +-- This only changes the object's position and not its direction. Use 'lookAt' +-- to aim the object. +orbit :: Positional a Vector2 => Vector2 -> Angle -> Radius -> a -> a orbit pt angle radius s = - let a = angle * pi / 180 - px = (x pt) + radius * sin a - py = (y pt) + radius * cos a - in setPos (vec2 px py) s - --- | An object in 2D space. -data Obj2 = Obj2 - { r :: Vector2 - , u :: Vector2 - , p :: Vector2 - } deriving Show - -instance Spatial2 Obj2 where - getObj2 = id - setObj2 _ o' = o' - -obj2FromVectors :: Right2 -> Up2 -> Position2 -> Obj2 -obj2FromVectors = Obj2 - -obj2FromTransform :: M.Matrix3 -> Obj2 -obj2FromTransform m = Obj2 (M.right m) (M.up m) (M.position m) \ No newline at end of file + let px = x pt + radius * sin angle + py = y pt + radius * cos angle + in setPosition (vec2 px py) s diff --git a/Spear/Math/Spatial3.hs b/Spear/Math/Spatial3.hs index 896d5ae..0f804cc 100644 --- a/Spear/Math/Spatial3.hs +++ b/Spear/Math/Spatial3.hs @@ -1,179 +1,153 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeSynonymInstances #-} + module Spear.Math.Spatial3 -( - Spatial3(..) -, Obj3 -, move -, moveFwd -, moveBack -, moveLeft -, moveRight -, rotate -, pitch -, yaw -, roll -, pos -, fwd -, up -, right -, transform -, setTransform -, setPos -, lookAt -, Spear.Math.Spatial3.orbit -, fromVectors -, fromTransform -) where -import Spear.Math.Vector -import qualified Spear.Math.Matrix4 as M - -type Matrix4 = M.Matrix4 - -class Spatial3 s where - - -- | Gets the spatial's Obj3. - getObj3 :: s -> Obj3 - - -- | Set the spatial's Obj3. - setObj3 :: s -> Obj3 -> s - --- | Move the spatial. -move :: Spatial3 s => Vector3 -> s -> s -move d s = let o = getObj3 s in setObj3 s $ o { p = p o + d } - --- | Move the spatial forwards. -moveFwd :: Spatial3 s => Float -> s -> s -moveFwd a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (f o) } - --- | Move the spatial backwards. -moveBack :: Spatial3 s => Float -> s -> s -moveBack a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale (-a) (f o) } - --- | Make the spatial strafe left. -moveLeft :: Spatial3 s => Float -> s -> s -moveLeft a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale (-a) (r o) } - --- | Make the spatial Strafe right. -moveRight :: Spatial3 s => Float -> s -> s -moveRight a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (r o) } - --- | Rotate the spatial about the given axis. -rotate :: Spatial3 s => Vector3 -> Float -> s -> s -rotate axis a s = - let t = transform s - axis' = M.inverseTransform t `M.muld` axis - in setTransform (t * M.axisAngle axis' a) s - --- | Rotate the spatial about its local X axis. -pitch :: Spatial3 s => Float -> s -> s -pitch a s = - let o = getObj3 s - a' = toRAD a - sa = sin a' - ca = cos a' - f' = normalise $ scale ca (f o) + scale sa (u o) - u' = normalise $ r o `cross` f' - in setObj3 s $ o { u = u', f = f' } - --- | Rotate the spatial about its local Y axis. -yaw :: Spatial3 s => Float -> s -> s -yaw a s = - let o = getObj3 s - a' = toRAD a - sa = sin a' - ca = cos a' - r' = normalise $ scale ca (r o) + scale sa (f o) - f' = normalise $ u o `cross` r' - in setObj3 s $ o { r = r', f = f' } - --- | Rotate the spatial about its local Z axis. -roll :: Spatial3 s => Float -> s -> s -roll a s = - let o = getObj3 s - a' = toRAD a - sa = sin a' - ca = cos a' - u' = normalise $ scale ca (u o) - scale sa (r o) - r' = normalise $ f o `cross` u' - in setObj3 s $ o { r = r', u = u' } - --- | Get the spatial's position. -pos :: Spatial3 s => s -> Vector3 -pos = p . getObj3 - --- | Get the spatial's forward vector. -fwd :: Spatial3 s => s -> Vector3 -fwd = f . getObj3 - --- | Get the spatial's up vector. -up :: Spatial3 s => s -> Vector3 -up = u . getObj3 - --- | Get the spatial's right vector. -right :: Spatial3 s => s -> Vector3 -right = r . getObj3 - --- | Get the spatial's transform. -transform :: Spatial3 s => s -> Matrix4 -transform s = let o = getObj3 s in M.transform (r o) (u o) (scale (-1) $ f o) (p o) - --- | Set the spatial's transform. -setTransform :: Spatial3 s => Matrix4 -> s -> s -setTransform t s = - let o = Obj3 (M.right t) (M.up t) (scale (-1) $ M.forward t) (M.position t) - in setObj3 s o - --- | Set the spatial's position. -setPos :: Spatial3 s => Vector3 -> s -> s -setPos pos s = setObj3 s $ (getObj3 s) { p = pos } - --- | Make the spatial look at the given point. -lookAt :: Spatial3 s => Vector3 -> s -> s -lookAt pt s = - let position = pos s - fwd = normalise $ pt - position - r = fwd `cross` unity3 - u = r `cross` fwd - in setTransform (M.transform r u (-fwd) position) s - --- | Make the spatial orbit around the given point -orbit :: Spatial3 s +import Spear.Math.Algebra +import qualified Spear.Math.Matrix4 as Matrix4 +import Spear.Math.Matrix4 (Matrix4) +import Spear.Math.Spatial +import Spear.Math.Vector +import Spear.Prelude + + +data Rotation3 + = Pitch Angle + | Yaw Angle + | Roll Angle + | AxisAngle Vector3 Angle + | RotationMatrix Matrix4 + + +-- | A 3D transform. +newtype Transform3 = Transform3 { transform3Matrix :: Matrix4 } deriving Show + + +type Positional3 a = Positional a Vector3 +type Rotational3 a = Rotational a Angle +type Spatial3 s = Spatial s Vector3 Rotation3 Transform3 + + +instance Positional Transform3 Vector3 where + setPosition p (Transform3 matrix) = + Transform3 . Matrix4.setPosition p $ matrix + + position = Matrix4.position . transform3Matrix + + translate v t@(Transform3 matrix) = setPosition (Matrix4.position matrix + v) t + + +instance Rotational Transform3 Vector3 Rotation3 where + setRotation rotation _ = Transform3 $ case rotation of + Pitch angle -> Matrix4.rotX angle + Yaw angle -> Matrix4.rotY angle + Roll angle -> Matrix4.rotZ angle + AxisAngle axis angle -> Matrix4.axisAngle axis angle + RotationMatrix matrix -> matrix + + rotation (Transform3 matrix) = RotationMatrix $ Matrix4.rotation matrix + + rotate rotation t@(Transform3 matrix) = case rotation of + Pitch angle -> pitch angle t + Yaw angle -> yaw angle t + Roll angle -> roll angle t + AxisAngle axis angle -> Transform3 $ Matrix4.axisAngle axis angle * matrix + RotationMatrix rot -> Transform3 $ rot * matrix + + right (Transform3 matrix) = Matrix4.right matrix + + up (Transform3 matrix) = Matrix4.up matrix + + forward (Transform3 matrix )= Matrix4.forward matrix + + setForward forward (Transform3 matrix) = + let right = forward `cross` unity3 + up = right `cross` forward + in Transform3 $ Matrix4.transform right up (neg forward) (Matrix4.position matrix) + + +instance Spatial Transform3 Vector3 Rotation3 Matrix4 where + setTransform matrix _ = Transform3 $ Matrix4.transform + (Matrix4.right matrix) + (Matrix4.up matrix) + (neg $ Matrix4.forward matrix) + (Matrix4.position matrix) + + transform (Transform3 matrix) = Matrix4.transform + (Matrix4.right matrix) + (Matrix4.up matrix) + (neg $ Matrix4.forward matrix) + (Matrix4.position matrix) + + +class Has3dTransform a where + -- | Set the object's 3d transform. + set3dTransform :: Transform3 -> a -> a + + -- | Get the object's 3d transform. + transform3 :: a -> Transform3 + + +with3dTransform :: Has3dTransform a => (Transform3 -> Transform3) -> a -> a +with3dTransform f obj = set3dTransform (f $ transform3 obj) obj + +-- | Build a 3d transform from right, up, forward and position vectors. +newTransform3 :: Vector3 -> Vector3 -> Vector3 -> Vector3 -> Transform3 +newTransform3 right up forward pos = Transform3 $ + Matrix4.transform right up (neg forward) pos + +-- | Rotate the object about the given axis. +rotate3 :: Vector3 -> Float -> Transform3 -> Transform3 +rotate3 axis angle (Transform3 matrix) = + let axis' = Matrix4.inverseTransform matrix `Matrix4.muld` axis + in Transform3 $ matrix * Matrix4.axisAngle axis' angle + +-- | Rotate the object about its local X axis. +pitch :: Float -> Transform3 -> Transform3 +pitch angle (Transform3 matrix) = + let sa = sin angle + ca = cos angle + f' = normalise $ (ca * Matrix4.forward matrix) + (sa * Matrix4.up matrix) + u' = normalise $ Matrix4.right matrix `cross` f' + in Transform3 . Matrix4.setUp u' . Matrix4.setForward f' $ matrix + +-- | Rotate the object about its local Y axis. +yaw :: Float -> Transform3 -> Transform3 +yaw angle (Transform3 matrix) = + let sa = sin angle + ca = cos angle + r' = normalise $ (ca * Matrix4.right matrix) + (sa * Matrix4.forward matrix) + f' = normalise $ Matrix4.up matrix `cross` r' + in Transform3 . Matrix4.setRight r' . Matrix4.setForward f' $ matrix + +-- | Rotate the object about its local Z axis. +roll :: Float -> Transform3 -> Transform3 +roll angle (Transform3 matrix) = + let sa = sin angle + ca = cos angle + u' = normalise $ (ca * Matrix4.up matrix) - (sa * Matrix4.right matrix) + r' = normalise $ Matrix4.forward matrix `cross` u' + in Transform3 . Matrix4.setRight r' . Matrix4.setUp u' $ matrix + + +-- | Make the object orbit around the given point +orbit :: Positional a Vector3 => Vector3 -- ^ Target point -> Float -- ^ Horizontal angle -> Float -- ^ Vertical angle -> Float -- ^ Orbit radius. - -> s - -> s - -orbit pt anglex angley radius s = - let ax = anglex * pi / 180 - ay = angley * pi / 180 - sx = sin ax - sy = sin ay - cx = cos ax - cy = cos ay - px = (x pt) + radius*cy*sx - py = (y pt) + radius*sy - pz = (z pt) + radius*cx*cy - in setPos (vec3 px py pz) s - --- | An object in 3D space. -data Obj3 = Obj3 - { r :: Vector3 - , u :: Vector3 - , f :: Vector3 - , p :: Vector3 - } deriving Show - -instance Spatial3 Obj3 where - getObj3 = id - setObj3 _ o' = o' - -fromVectors :: Right3 -> Up3 -> Forward3 -> Position3 -> Obj3 -fromVectors = Obj3 - -fromTransform :: Matrix4 -> Obj3 -fromTransform m = Obj3 (M.right m) (M.up m) (M.forward m) (M.position m) - -toRAD = (*pi) . (/180) + -> a + -> a +orbit pt anglex angley radius = + let sx = sin anglex + sy = sin angley + cx = cos anglex + cy = cos angley + px = x pt + radius*cy*sx + py = y pt + radius*sy + pz = z pt + radius*cx*cy + in setPosition (vec3 px py pz) diff --git a/Spear/Math/Sphere.hs b/Spear/Math/Sphere.hs index 197a9b2..1d20275 100644 --- a/Spear/Math/Sphere.hs +++ b/Spear/Math/Sphere.hs @@ -1,9 +1,17 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} + module Spear.Math.Sphere where -import Spear.Math.Vector +import Spear.Math.Algebra +import Spear.Math.Spatial +import Spear.Math.Spatial3 +import Spear.Math.Vector +import Spear.Prelude + +import Data.List (foldl') -import Data.List (foldl') -- | A sphere in 3D space. data Sphere = Sphere @@ -11,12 +19,19 @@ data Sphere = Sphere , radius :: {-# UNPACK #-} !Float } + +instance Positional Sphere Vector3 where + setPosition p sphere = sphere { center = p } + position = center + translate v sphere = sphere { center = center sphere + v } + + -- | Create a sphere from the given points. sphere :: [Vector3] -> Sphere sphere [] = Sphere zero3 0 sphere (x:xs) = Sphere c r where - c = pmin + (pmax-pmin)/2 + c = pmin + (pmax-pmin) / (2::Float) r = norm $ pmax - c (pmin,pmax) = foldl' update (x,x) xs update (pmin,pmax) p = (min p pmin, max p pmax) diff --git a/Spear/Math/Triangle.hs b/Spear/Math/Triangle.hs index 04c2639..c47879b 100644 --- a/Spear/Math/Triangle.hs +++ b/Spear/Math/Triangle.hs @@ -4,11 +4,12 @@ module Spear.Math.Triangle ) where +import Spear.Math.Algebra +import Spear.Math.Vector -import Spear.Math.Vector - -import Foreign.C.Types -import Foreign.Storable +import Foreign.C.Types +import Foreign.Storable +import Prelude hiding ((*)) data Triangle = Triangle @@ -18,23 +19,17 @@ data Triangle = Triangle } -sizeVector3 = 3 * sizeOf (undefined :: CFloat) - - instance Storable Triangle where - - sizeOf _ = 3 * sizeVector3 + sizeOf _ = (3::Int) * sizeVector3 alignment _ = alignment (undefined :: CFloat) - + peek ptr = do p0 <- peekByteOff ptr 0 - p1 <- peekByteOff ptr $ 1 * sizeVector3 - p2 <- peekByteOff ptr $ 2 * sizeVector3 - + p1 <- peekByteOff ptr $ (1::Int) * sizeVector3 + p2 <- peekByteOff ptr $ (2::Int) * sizeVector3 return $ Triangle p0 p1 p2 - - + poke ptr (Triangle p0 p1 p2) = do pokeByteOff ptr 0 p0 - pokeByteOff ptr (1*sizeVector3) p1 - pokeByteOff ptr (2*sizeVector3) p2 + pokeByteOff ptr ((1::Int) * sizeVector3) p1 + pokeByteOff ptr ((2::Int) * sizeVector3) p2 diff --git a/Spear/Math/Utils.hs b/Spear/Math/Utils.hs index 04c97bc..cd68cdc 100644 --- a/Spear/Math/Utils.hs +++ b/Spear/Math/Utils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + module Spear.Math.Utils ( Side(..) @@ -7,9 +9,10 @@ module Spear.Math.Utils ) where - -import Spear.Math.Matrix4 as M4 -import Spear.Math.Vector as V +import Spear.Math.Algebra +import Spear.Math.Matrix4 as M4 +import Spear.Math.Vector as V +import Spear.Prelude data Side = L | R deriving (Eq, Show) @@ -33,6 +36,6 @@ viewToWorld2d p viewI = p1 = viewI `mulp` p1' p2 = p1 - M4.forward viewI lambda = (y p1 / (y p1 - y p2)) - p' = p1 + V.scale lambda (p2 - p1) + p' = p1 + lambda * (p2 - p1) in vec2 (x p') (-z p') diff --git a/Spear/Math/Vector/Vector.hs b/Spear/Math/Vector/Vector.hs index 35b04e2..e7f6d53 100644 --- a/Spear/Math/Vector/Vector.hs +++ b/Spear/Math/Vector/Vector.hs @@ -1,43 +1,50 @@ -module Spear.Math.Vector.Vector -where - -class (Fractional a, Ord a) => Vector a where - -- | Create a vector from the given list. - fromList :: [Float] -> a - - -- | Return the vector's x coordinate. - x :: a -> Float - x _ = 0 - - -- | Return the vector's y coordinate. - y :: a -> Float - y _ = 0 - - -- | Return the vector's z coordinate. - z :: a -> Float - z _ = 0 - - -- | Return the vector's w coordinate. - w :: a -> Float - w _ = 0 - - -- | Return the vector's ith coordinate. - (!) :: a -> Int -> Float - - -- | Compute the given vectors' dot product. - dot :: a -> a -> Float - - -- | Compute the given vector's squared norm. - normSq :: a -> Float - - -- | Compute the given vector's norm. - norm :: a -> Float - - -- | Multiply the given vector with the given scalar. - scale :: Float -> a -> a - - -- | Negate the given vector. - neg :: a -> a - - -- | Normalise the given vector. - normalise :: a -> a +{-# LANGUAGE FlexibleContexts #-} + +module Spear.Math.Vector.Vector where + +import Spear.Math.Algebra + + +class + ( Addition v v + , Subtraction v v + , Product v v v + , Product v Float v -- Scalar product. + , Product Float v v) -- Scalar product. + => Vector v where + -- | Create a vector from the given list. + fromList :: [Float] -> v + + -- | Get the vector's x coordinate. + x :: v -> Float + x _ = 0 + + -- | Get the vector's y coordinate. + y :: v -> Float + y _ = 0 + + -- | Get the vector's z coordinate. + z :: v -> Float + z _ = 0 + + -- | Get the vector's w coordinate. + w :: v -> Float + w _ = 0 + + -- | Get the vector's ith coordinate. + (!) :: v -> Int -> Float + + -- | Compute the given vectors' dot product. + dot :: v -> v -> Float + + -- | Compute the given vector's squared norm. + normSq :: v -> Float + + -- | Compute the given vector's norm. + norm :: v -> Float + + -- | Negate the given vector. + neg :: v -> v + + -- | Normalise the given vector. + normalise :: v -> v diff --git a/Spear/Math/Vector/Vector2.hs b/Spear/Math/Vector/Vector2.hs index 5bbb632..1ede3a9 100644 --- a/Spear/Math/Vector/Vector2.hs +++ b/Spear/Math/Vector/Vector2.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + module Spear.Math.Vector.Vector2 ( Vector2(..) @@ -14,30 +18,72 @@ module Spear.Math.Vector.Vector2 ) where +import Spear.Math.Algebra import Spear.Math.Vector.Vector +import Spear.Prelude import Foreign.C.Types (CFloat) import Foreign.Storable +import qualified Prelude as P + -type Right2 = Vector2 -type Up2 = Vector2 +type Right2 = Vector2 +type Up2 = Vector2 type Position2 = Vector2 + -- | Represents a vector in 2D. data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) -instance Num Vector2 where +instance Addition Vector2 Vector2 where + {-# INLINABLE (+) #-} Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) + + +instance Subtraction Vector2 Vector2 where + {-# INLINABLE (-) #-} Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) + + +instance Product Vector2 Vector2 Vector2 where + {-# INLINABLE (*) #-} Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) + + +instance Quotient Vector2 Vector2 where + {-# INLINABLE (/) #-} + Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) + + +-- Scalar product. +instance Product Vector2 Float Vector2 where + {-# INLINABLE (*) #-} + (Vector2 x y) * s = Vector2 (s * x) (s * y) + + +instance Product Float Vector2 Vector2 where + {-# INLINABLE (*) #-} + s * (Vector2 x y) = Vector2 (s * x) (s * y) + + +-- Scalar division. +instance Quotient Vector2 Float where + {-# INLINABLE (/) #-} + (Vector2 x y) / s = Vector2 (x / s) (y / s) + + +instance Num Vector2 where + (+) = add + (-) = sub + (*) = mul 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) + (/) = Spear.Math.Algebra.div fromRational r = Vector2 r' r' where r' = fromRational r @@ -46,52 +92,49 @@ 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) - 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) + max (Vector2 ax ay) (Vector2 bx by) = Vector2 (max ax bx) (max ay by) + min (Vector2 ax ay) (Vector2 bx by) = Vector2 (min ax bx) (min ay by) instance Vector Vector2 where - {-# INLINABLE fromList #-} - fromList (ax:ay:_) = Vector2 ax ay - - {-# INLINABLE x #-} - x (Vector2 ax _) = ax + {-# INLINABLE fromList #-} + fromList (ax:ay:_) = Vector2 ax ay - {-# INLINABLE y #-} - y (Vector2 _ ay) = ay + {-# INLINABLE x #-} + x (Vector2 ax _) = ax - {-# INLINABLE (!) #-} - (Vector2 ax _) ! 0 = ax - (Vector2 _ ay) ! 1 = ay - _ ! _ = 0 + {-# INLINABLE y #-} + y (Vector2 _ ay) = ay - {-# INLINABLE dot #-} - Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by + {-# INLINABLE (!) #-} + (Vector2 ax _) ! 0 = ax + (Vector2 _ ay) ! 1 = ay + _ ! _ = 0 - {-# INLINABLE normSq #-} - normSq (Vector2 ax ay) = ax*ax + ay*ay + {-# INLINABLE dot #-} + Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by - {-# INLINABLE norm #-} - norm = sqrt . normSq + {-# INLINABLE normSq #-} + normSq (Vector2 ax ay) = ax*ax + ay*ay - {-# INLINABLE scale #-} - scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay) + {-# INLINABLE norm #-} + norm = sqrt . normSq - {-# INLINABLE neg #-} - neg (Vector2 ax ay) = Vector2 (-ax) (-ay) + {-# INLINABLE neg #-} + neg (Vector2 ax ay) = Vector2 (-ax) (-ay) - {-# INLINABLE normalise #-} - normalise v = - let n' = norm v - n = if n' == 0 then 1 else n' - in scale (1.0 / n) v + {-# INLINABLE normalise #-} + normalise v = + let n' = norm v + n = if n' == 0 then 1 else n' + in ((1.0::Float) / n) * v sizeFloat = sizeOf (undefined :: CFloat) instance Storable Vector2 where - sizeOf _ = 2*sizeFloat + sizeOf _ = (2::Int) * sizeFloat alignment _ = alignment (undefined :: CFloat) peek ptr = do @@ -115,9 +158,9 @@ zero2 = Vector2 0 0 -- | Create a vector from the given values. vec2 :: Float -> Float -> Vector2 -vec2 ax ay = Vector2 ax ay +vec2 = Vector2 --- | Compute a vector perpendicular to the given one, satisfying: +-- | Compute a perpendicular vector satisfying: -- -- perp (Vector2 0 1) = Vector2 1 0 -- diff --git a/Spear/Math/Vector/Vector3.hs b/Spear/Math/Vector/Vector3.hs index 82deba2..9d44c8b 100644 --- a/Spear/Math/Vector/Vector3.hs +++ b/Spear/Math/Vector/Vector3.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + module Spear.Math.Vector.Vector3 ( Vector3(..) @@ -5,6 +9,7 @@ module Spear.Math.Vector.Vector3 , Up3 , Forward3 , Position3 +, sizeVector3 -- * Construction , unitx3 , unity3 @@ -17,15 +22,17 @@ module Spear.Math.Vector.Vector3 ) where - +import Spear.Math.Algebra import Spear.Math.Vector.Vector +import Spear.Prelude import Foreign.C.Types (CFloat) import Foreign.Storable +import qualified Prelude as P -type Right3 = Vector3 -type Up3 = Vector3 -type Forward3 = Vector3 +type Right3 = Vector3 +type Up3 = Vector3 +type Forward3 = Vector3 type Position3 = Vector3 @@ -36,17 +43,58 @@ data Vector3 = Vector3 {-# UNPACK #-} !Float deriving (Eq, Show) -instance Num Vector3 where + +sizeVector3 = (3::Int) * sizeOf (undefined :: CFloat) + + +instance Addition Vector3 Vector3 where + {-# INLINABLE (+) #-} Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz) + + +instance Subtraction Vector3 Vector3 where + {-# INLINABLE (-) #-} Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz) + + +instance Product Vector3 Vector3 Vector3 where + {-# INLINABLE (*) #-} Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz) + + +instance Quotient Vector3 Vector3 where + {-# INLINABLE (/) #-} + Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz) + + +-- Scalar product. +instance Product Vector3 Float Vector3 where + {-# INLINABLE (*) #-} + (Vector3 x y z) * s = Vector3 (s * x) (s * y) (s * z) + + +instance Product Float Vector3 Vector3 where + {-# INLINABLE (*) #-} + s * (Vector3 x y z) = Vector3 (s * x) (s * y) (s * z) + + +-- Scalar division. +instance Quotient Vector3 Float where + {-# INLINABLE (/) #-} + (Vector3 x y z) / s = Vector3 (x / s) (y / s) (y / s) + + +instance Num Vector3 where + (+) = add + (-) = sub + (*) = mul abs (Vector3 ax ay az) = Vector3 (abs ax) (abs ay) (abs az) signum (Vector3 ax ay az) = Vector3 (signum ax) (signum ay) (signum az) fromInteger i = Vector3 i' i' i' where i' = fromInteger i instance Fractional Vector3 where - Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz) + (/) = Spear.Math.Algebra.div fromRational r = Vector3 r' r' r' where r' = fromRational r @@ -71,91 +119,85 @@ 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) + max (Vector3 ax ay az) (Vector3 bx by bz) = + Vector3 (max ax bx) (max ay by) (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) + min (Vector3 ax ay az) (Vector3 bx by bz) = + Vector3 (min ax bx) (min ay by) (min az bz) instance Vector Vector3 where - {-# INLINABLE fromList #-} - fromList (ax:ay:az:_) = Vector3 ax ay az - - {-# INLINABLE x #-} - x (Vector3 ax _ _ ) = ax + {-# INLINABLE fromList #-} + fromList (ax:ay:az:_) = Vector3 ax ay az - {-# INLINABLE y #-} - y (Vector3 _ ay _ ) = ay + {-# INLINABLE x #-} + x (Vector3 ax _ _ ) = ax - {-# INLINABLE z #-} - z (Vector3 _ _ az) = az + {-# INLINABLE y #-} + y (Vector3 _ ay _ ) = ay - {-# INLINABLE (!) #-} - (Vector3 ax _ _) ! 0 = ax - (Vector3 _ ay _) ! 1 = ay - (Vector3 _ _ az) ! 2 = az - _ ! _ = 0 + {-# INLINABLE z #-} + z (Vector3 _ _ az) = az - {-# INLINABLE dot #-} - Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz + {-# INLINABLE (!) #-} + (Vector3 ax _ _) ! 0 = ax + (Vector3 _ ay _) ! 1 = ay + (Vector3 _ _ az) ! 2 = az + _ ! _ = 0 - {-# INLINABLE normSq #-} - normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az + {-# INLINABLE dot #-} + Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz - {-# INLINABLE norm #-} - norm = sqrt . normSq + {-# INLINABLE normSq #-} + normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az - {-# INLINABLE scale #-} - scale s (Vector3 ax ay az) = Vector3 (s*ax) (s*ay) (s*az) + {-# INLINABLE norm #-} + norm = sqrt . normSq - {-# INLINABLE neg #-} - neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az) + {-# INLINABLE neg #-} + neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az) - {-# INLINABLE normalise #-} - normalise v = - let n' = norm v - n = if n' == 0 then 1 else n' - in scale (1.0 / n) v + {-# INLINABLE normalise #-} + normalise v = + let n' = norm v + n = if n' == 0 then 1 else n' + in ((1.0::Float) / n) * v sizeFloat = sizeOf (undefined :: CFloat) instance Storable Vector3 where - sizeOf _ = 3*sizeFloat + sizeOf _ = (3::Int) * sizeFloat alignment _ = alignment (undefined :: CFloat) peek ptr = do ax <- peekByteOff ptr 0 - ay <- peekByteOff ptr $ 1*sizeFloat - az <- peekByteOff ptr $ 2*sizeFloat + ay <- peekByteOff ptr $ (1::Int) * sizeFloat + az <- peekByteOff ptr $ (2::Int) * sizeFloat return (Vector3 ax ay az) poke ptr (Vector3 ax ay az) = do pokeByteOff ptr 0 ax - pokeByteOff ptr (1*sizeFloat) ay - pokeByteOff ptr (2*sizeFloat) az + pokeByteOff ptr ((1::Int) * sizeFloat) ay + pokeByteOff ptr ((2::Int) * sizeFloat) az -- | Unit vector along the X axis. unitx3 = Vector3 1 0 0 - -- | Unit vector along the Y axis. unity3 = Vector3 0 1 0 - -- | Unit vector along the Z axis. unitz3 = Vector3 0 0 1 - -- | Zero vector. zero3 = Vector3 0 0 0 - -- | Create a 3D vector from the given values. vec3 :: Float -> Float -> Float -> Vector3 -vec3 ax ay az = Vector3 ax ay az - +vec3 = Vector3 -- | Create a 3D vector as a point on a sphere. orbit :: Vector3 -- ^ Sphere center. @@ -163,21 +205,17 @@ orbit :: Vector3 -- ^ Sphere center. -> Float -- ^ Azimuth angle. -> Float -- ^ Zenith angle. -> Vector3 - orbit center radius anglex angley = - let ax = anglex * pi / 180 - ay = angley * pi / 180 - sx = sin ax - sy = sin ay - cx = cos ax - cy = cos ay + let sx = sin anglex + sy = sin angley + cx = cos anglex + cy = cos angley px = x center + radius*cy*sx py = y center + radius*sy pz = z center + radius*cx*cy in vec3 px py pz - -- | Compute the given vectors' cross product. cross :: Vector3 -> Vector3 -> Vector3 (Vector3 ax ay az) `cross` (Vector3 bx by bz) = diff --git a/Spear/Math/Vector/Vector4.hs b/Spear/Math/Vector/Vector4.hs index 325eefc..907295e 100644 --- a/Spear/Math/Vector/Vector4.hs +++ b/Spear/Math/Vector/Vector4.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeFamilies #-} + module Spear.Math.Vector.Vector4 ( Vector4(..) @@ -11,11 +15,13 @@ module Spear.Math.Vector.Vector4 ) where - +import Spear.Math.Algebra import Spear.Math.Vector.Vector +import Spear.Prelude import Foreign.C.Types (CFloat) import Foreign.Storable +import qualified Prelude as P -- | Represents a vector in 3D. @@ -27,17 +33,58 @@ data Vector4 = Vector4 deriving (Eq, Show) +instance Addition Vector4 Vector4 where + {-# INLINABLE (+) #-} + Vector4 ax ay az aw + Vector4 bx by bz bw = + Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw) + + +instance Subtraction Vector4 Vector4 where + {-# INLINABLE (-) #-} + Vector4 ax ay az aw - Vector4 bx by bz bw = + Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw) + + +instance Product Vector4 Vector4 Vector4 where + {-# INLINABLE (*) #-} + Vector4 ax ay az aw * Vector4 bx by bz bw = + Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw) + + +instance Quotient Vector4 Vector4 where + {-# INLINABLE (/) #-} + Vector4 ax ay az aw / Vector4 bx by bz bw = + Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw) + + +-- Scalar product. +instance Product Vector4 Float Vector4 where + {-# INLINABLE (*) #-} + (Vector4 x y z w) * s = Vector4 (s * x) (s * y) (s * z) (s * w) + + +instance Product Float Vector4 Vector4 where + {-# INLINABLE (*) #-} + s * (Vector4 x y z w) = Vector4 (s * x) (s * y) (s * z) (s * w) + + +-- Scalar division. +instance Quotient Vector4 Float where + {-# INLINABLE (/) #-} + (Vector4 x y z w) / s = Vector4 (x / s) (y / s) (y / s) (w / s) + + 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) + (+) = add + (-) = sub + (*) = mul 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) + (/) = Spear.Math.Algebra.div fromRational r = Vector4 r' r' r' r' where r' = fromRational r @@ -67,97 +114,90 @@ instance Ord Vector4 where || (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) + Vector4 (min ax bx) (min ay by) (min az bz) (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) + Vector4 (max ax bx) (max ay by) (max az bz) (min aw bw) instance Vector Vector4 where - {-# INLINABLE fromList #-} - fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw + {-# INLINABLE fromList #-} + fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw - {-# INLINABLE x #-} - x (Vector4 ax _ _ _ ) = ax + {-# INLINABLE x #-} + x (Vector4 ax _ _ _ ) = ax - {-# INLINABLE y #-} - y (Vector4 _ ay _ _ ) = ay + {-# INLINABLE y #-} + y (Vector4 _ ay _ _ ) = ay - {-# INLINABLE z #-} - z (Vector4 _ _ az _ ) = az + {-# INLINABLE z #-} + z (Vector4 _ _ az _ ) = az - {-# INLINABLE w #-} - w (Vector4 _ _ _ aw) = aw + {-# INLINABLE w #-} + w (Vector4 _ _ _ aw) = aw - {-# INLINABLE (!) #-} - (Vector4 ax _ _ _) ! 0 = ax - (Vector4 _ ay _ _) ! 1 = ay - (Vector4 _ _ az _) ! 2 = az - (Vector4 _ _ _ aw) ! 3 = aw - _ ! _ = 0 + {-# INLINABLE (!) #-} + (Vector4 ax _ _ _) ! 0 = ax + (Vector4 _ ay _ _) ! 1 = ay + (Vector4 _ _ az _) ! 2 = az + (Vector4 _ _ _ aw) ! 3 = aw + _ ! _ = 0 - {-# INLINABLE dot #-} - Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw + {-# INLINABLE dot #-} + Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw - {-# INLINABLE normSq #-} - normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw + {-# INLINABLE normSq #-} + normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw - {-# INLINABLE norm #-} - norm = sqrt . normSq + {-# INLINABLE norm #-} + norm = sqrt . normSq - {-# INLINABLE scale #-} - scale s (Vector4 ax ay az aw) = Vector4 (s*ax) (s*ay) (s*az) (s*aw) + {-# INLINABLE neg #-} + neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw) - {-# INLINABLE neg #-} - neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw) - - {-# INLINABLE normalise #-} - normalise v = - let n' = norm v - n = if n' == 0 then 1 else n' - in scale (1.0 / n) v + {-# INLINABLE normalise #-} + normalise v = + let n' = norm v + n = if n' == 0 then 1 else n' + in ((1.0::Float) / n) * v sizeFloat = sizeOf (undefined :: CFloat) instance Storable Vector4 where - sizeOf _ = 4*sizeFloat + sizeOf _ = (4::Int) * 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 + ay <- peekByteOff ptr $ (1::Int) * sizeFloat + az <- peekByteOff ptr $ (2::Int) * sizeFloat + aw <- peekByteOff ptr $ (3::Int) * 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 + pokeByteOff ptr ((1::Int) * sizeFloat) ay + pokeByteOff ptr ((2::Int) * sizeFloat) az + pokeByteOff ptr ((3::Int) * sizeFloat) aw -- | Unit vector along the X axis. unitx4 = Vector4 1 0 0 0 - -- | Unit vector along the Y axis. unity4 = Vector4 0 1 0 0 - -- | Unit vector along the Z axis. unitz4 = Vector4 0 0 1 0 -- | Unit vector along the W axis. unitw4 = Vector4 0 0 0 1 - -- | Create a 4D vector from the given values. vec4 :: Float -> Float -> Float -> Float -> Vector4 -vec4 ax ay az aw = Vector4 ax ay az aw - +vec4 = Vector4 -- | 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. diff --git a/Spear/Prelude.hs b/Spear/Prelude.hs new file mode 100644 index 0000000..3c5fcac --- /dev/null +++ b/Spear/Prelude.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Spear.Prelude +( module BasePrelude +, module Spear.Math.Algebra +) where + +import Prelude as BasePrelude hiding (div, (*), (+), (-), + (/)) +import Spear.Math.Algebra diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs index e69ce75..966fcc2 100644 --- a/Spear/Render/AnimatedModel.hs +++ b/Spear/Render/AnimatedModel.hs @@ -1,3 +1,6 @@ + +{-# LANGUAGE NoImplicitPrelude #-} + module Spear.Render.AnimatedModel ( -- * Data types AnimatedModelResource, @@ -31,19 +34,24 @@ module Spear.Render.AnimatedModel ) where -import Control.Applicative ((<$>), (<*>)) -import qualified Data.Vector as V -import Spear.Assets.Model -import Spear.GL -import Spear.Game -import Spear.Math.AABB -import Spear.Math.Collision -import Spear.Math.Matrix4 (Matrix4) -import Spear.Math.Vector -import Spear.Render.Material -import Spear.Render.Model -import Spear.Render.Program -import Unsafe.Coerce (unsafeCoerce) +import Spear.Assets.Model +import Spear.Game +import Spear.GL +import Spear.Math.AABB +import Spear.Math.Algebra +import Spear.Math.Collision +import Spear.Math.Matrix4 (Matrix4) +import Spear.Math.Vector +import Spear.Prelude +import Spear.Render.Material +import Spear.Render.Model +import Spear.Render.Program + +import Control.Applicative ((<$>), (<*>)) +import qualified Data.Vector as V +import Foreign.C.Types +import Unsafe.Coerce (unsafeCoerce) + type AnimationSpeed = Float @@ -51,14 +59,14 @@ type AnimationSpeed = Float -- -- Contains model data necessary to render an animated model. data AnimatedModelResource = AnimatedModelResource - { model :: Model, - vao :: VAO, - nFrames :: Int, + { model :: Model, + vao :: VAO, + nFrames :: Int, nVertices :: Int, - material :: Material, - texture :: Texture, - boxes :: V.Vector Box, - rkey :: Resource + material :: Material, + texture :: Texture, + boxes :: V.Vector Box, + rkey :: Resource } instance Eq AnimatedModelResource where @@ -82,14 +90,14 @@ instance ResourceClass AnimatedModelResource where -- state changes by sorting 'AnimatedModelRenderer's by their underlying -- 'AnimatedModelResource' when rendering the scene. data AnimatedModelRenderer = AnimatedModelRenderer - { modelResource :: AnimatedModelResource, - currentAnim :: Int, - frameStart :: Int, - frameEnd :: Int, + { modelResource :: AnimatedModelResource, + currentAnim :: Int, + frameStart :: Int, + frameEnd :: Int, -- | Get the renderer's current frame. - currentFrame :: Int, + currentFrame :: Int, -- | Get the renderer's frame progress. - frameProgress :: Float, + frameProgress :: Float, -- | Get the renderer's animation speed. animationSpeed :: Float } @@ -119,7 +127,7 @@ animatedModelResource boxes <- gameIO $ modelBoxes model gameIO $ do - let elemSize = 56 + let elemSize = 56::CUInt elemSize' = fromIntegral elemSize n = numVertices * numFrames @@ -132,7 +140,7 @@ animatedModelResource attribVAOPointer vertChan2 3 GL_FLOAT False elemSize' 12 attribVAOPointer normChan1 3 GL_FLOAT False elemSize' 24 attribVAOPointer normChan2 3 GL_FLOAT False elemSize' 36 - attribVAOPointer texChan 2 GL_FLOAT False elemSize' 48 + attribVAOPointer texChan 2 GL_FLOAT False elemSize' 48 enableVAOAttrib vertChan1 enableVAOAttrib vertChan2 @@ -162,17 +170,18 @@ animatedModelRenderer animSpeed modelResource = AnimatedModelRenderer modelResource 0 0 0 0 0 animSpeed -- | Update the renderer. +update :: Float -> AnimatedModelRenderer -> AnimatedModelRenderer update dt (AnimatedModelRenderer model curAnim startFrame endFrame curFrame fp s) = AnimatedModelRenderer model curAnim startFrame endFrame curFrame' fp' s where f = fp + dt * s nextFrame = f >= 1.0 - fp' = if nextFrame then f - 1.0 else f + fp' = if nextFrame then f - (1::Float) else f curFrame' = if nextFrame then - let x = curFrame + 1 - in if x > endFrame then startFrame else x + let x = curFrame + (1::Int) + in if x > endFrame then startFrame else x else curFrame -- | Get the model's ith bounding box. @@ -193,7 +202,7 @@ nextFrame rend = let curFrame = currentFrame rend in if curFrame == frameEnd rend then frameStart rend - else curFrame + 1 + else curFrame + (1::Int) -- | Set the active animation to the given one. setAnimation :: Enum a => a -> AnimatedModelRenderer -> AnimatedModelRenderer @@ -248,7 +257,7 @@ mkColsFromAnimated f1 f2 fp modelview modelRes = max1 = vec3 xmax1 ymax1 zmax1 min2 = vec3 xmin2 ymin2 zmin2 max2 = vec3 xmax2 ymax2 zmax2 - min = min1 + scale fp (min2 - min1) - max = max1 + scale fp (max2 - max1) + min = min1 + fp * (min2 - min1) + max = max1 + fp * (max2 - max1) in mkCols modelview $ Box (Vec3 (x min) (y min) (z min)) (Vec3 (x max) (y max) (z max)) diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs index f0b141e..327e8b0 100644 --- a/Spear/Render/StaticModel.hs +++ b/Spear/Render/StaticModel.hs @@ -20,26 +20,31 @@ module Spear.Render.StaticModel ) where -import qualified Data.Vector as V -import Spear.Assets.Model -import Spear.GL -import Spear.Game -import Spear.Math.AABB -import Spear.Math.Collision -import Spear.Math.Matrix4 (Matrix4) -import Spear.Math.Vector -import Spear.Render.Material -import Spear.Render.Model -import Spear.Render.Program -import Unsafe.Coerce (unsafeCoerce) +import Spear.Assets.Model +import Spear.Game +import Spear.GL +import Spear.Math.AABB +import Spear.Math.Algebra +import Spear.Math.Collision +import Spear.Math.Matrix4 (Matrix4) +import Spear.Math.Vector +import Spear.Render.Material +import Spear.Render.Model +import Spear.Render.Program + +import qualified Data.Vector as V +import Foreign.C.Types +import Prelude hiding ((*)) +import Unsafe.Coerce (unsafeCoerce) + data StaticModelResource = StaticModelResource - { vao :: VAO, + { vao :: VAO, nVertices :: Int, - material :: Material, - texture :: Texture, - boxes :: V.Vector Box, - rkey :: Resource + material :: Material, + texture :: Texture, + boxes :: V.Vector Box, + rkey :: Resource } instance Eq StaticModelResource where @@ -75,7 +80,7 @@ staticModelResource (StaticProgramChannels vertChan normChan texChan) material t boxes <- gameIO $ modelBoxes model gameIO $ do - let elemSize = 32 + let elemSize = 32::CUInt elemSize' = fromIntegral elemSize n = numVertices diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs index a4a7ea2..668a495 100644 --- a/Spear/Scene/Loader.hs +++ b/Spear/Scene/Loader.hs @@ -15,26 +15,28 @@ module Spear.Scene.Loader ) where -import Control.Monad.State.Strict -import Control.Monad.Trans (lift) -import Data.List as L (find) -import Data.Map as M -import qualified Data.StateVar as SV (get) -import Spear.Assets.Model as Model -import qualified Spear.GL as GL -import Spear.Game -import Spear.Math.Collision -import Spear.Math.Matrix3 as M3 -import Spear.Math.Matrix4 as M4 -import Spear.Math.MatrixUtils (fastNormalMatrix) -import Spear.Math.Vector -import Spear.Render.AnimatedModel as AM -import Spear.Render.Material -import Spear.Render.Program -import Spear.Render.StaticModel as SM -import Spear.Scene.Graph -import Spear.Scene.SceneResources -import Text.Printf (printf) +import Control.Monad.State.Strict +import Control.Monad.Trans (lift) +import Data.List as L (find) +import Data.Map as M +import qualified Data.StateVar as SV (get) +import Prelude hiding ((*)) +import Spear.Assets.Model as Model +import Spear.Game +import qualified Spear.GL as GL +import Spear.Math.Algebra +import Spear.Math.Collision +import Spear.Math.Matrix3 as M3 +import Spear.Math.Matrix4 as M4 +import Spear.Math.MatrixUtils (fastNormalMatrix) +import Spear.Math.Vector +import Spear.Render.AnimatedModel as AM +import Spear.Render.Material +import Spear.Render.Program +import Spear.Render.StaticModel as SM +import Spear.Scene.Graph +import Spear.Scene.SceneResources +import Text.Printf (printf) type Loader = Game SceneResources @@ -62,8 +64,8 @@ resourceMap' :: SceneGraph -> Loader () resourceMap' node@(SceneLeaf nid props) = do case nid of "shader-program" -> newShaderProgram node - "model" -> newModel node - x -> return () + "model" -> newModel node + x -> return () resourceMap' node@(SceneNode nid props children) = do mapM_ resourceMap' children @@ -169,7 +171,7 @@ loadModel' :: FilePath -> Maybe Rotation -> Maybe Vector3 -> Game s Model loadModel' file rotation scale = do let transform = ( case rotation of - Nothing -> Prelude.id + Nothing -> Prelude.id Just rot -> rotateModel rot ) . ( case scale of @@ -300,17 +302,17 @@ loadShader' file shaderType = loadResource file shaders addShader $ GL.loadShade -- Get the value of the given key. value :: String -> [Property] -> Maybe [String] value name props = case L.find ((==) name . fst) props of - Nothing -> Nothing + Nothing -> Nothing Just prop -> Just . snd $ prop unspecified :: Maybe a -> a -> a unspecified (Just x) _ = x -unspecified Nothing x = x +unspecified Nothing x = x mandatory :: String -> [Property] -> Game s [String] mandatory name props = case value name props of Nothing -> gameError $ "Loader::mandatory: key not found: " ++ name - Just x -> return x + Just x -> return x mandatory' :: String -> [Property] -> Loader [String] mandatory' name props = mandatory name props @@ -325,19 +327,19 @@ asVec2 :: Functor f => f [String] -> f Vector2 asVec2 val = fmap toVec2 val where toVec2 (x : y : _) = vec2 (read x) (read y) - toVec2 (x : []) = let x' = read x in vec2 x' x' + toVec2 (x : []) = let x' = read x in vec2 x' x' asVec3 :: Functor f => f [String] -> f Vector3 asVec3 val = fmap toVec3 val where toVec3 (x : y : z : _) = vec3 (read x) (read y) (read z) - toVec3 (x : []) = let x' = read x in vec3 x' x' x' + toVec3 (x : []) = let x' = read x in vec3 x' x' x' asVec4 :: Functor f => f [String] -> f Vector4 asVec4 val = fmap toVec4 val where toVec4 (x : y : z : w : _) = vec4 (read x) (read y) (read z) (read w) - toVec4 (x : []) = let x' = read x in vec4 x' x' x' x' + toVec4 (x : []) = let x' = read x in vec4 x' x' x' x' asRotation :: Functor f => f [String] -> f Rotation asRotation val = fmap parseRotation val @@ -345,9 +347,9 @@ asRotation val = fmap parseRotation val parseRotation (ax : ay : az : order : _) = Rotation (read ax) (read ay) (read az) (readOrder order) data Rotation = Rotation - { ax :: Float, - ay :: Float, - az :: Float, + { ax :: Float, + ay :: Float, + az :: Float, order :: RotationOrder } diff --git a/Spear/Step.hs b/Spear/Step.hs index 609f387..cb4f71c 100644 --- a/Spear/Step.hs +++ b/Spear/Step.hs @@ -31,7 +31,7 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid -type Elapsed = Double +type Elapsed = Float type Dt = Float -- cgit v1.2.3