From e03885548a3062724e35d30317a0bfdbb66d5915 Mon Sep 17 00:00:00 2001 From: Marc Sunet Date: Tue, 28 Aug 2012 17:37:23 +0200 Subject: =?UTF-8?q?=C2=B7=20Moved=20mathematical=20entities=20in=20Collisi?= =?UTF-8?q?on=20to=20Math.=20+=20Added=20Spear.Math.Vector2.=20=C2=B7=20Ma?= =?UTF-8?q?de=20fields=20of=20mathematical=20entities=20strict=20and=20unp?= =?UTF-8?q?acked.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Spear.cabal | 17 ++--- Spear.lkshs | 14 ++-- Spear.lkshw | 4 +- Spear/Collision.hs | 11 +-- Spear/Collision/AABB.hs | 32 --------- Spear/Collision/Collision.hs | 10 ++- Spear/Collision/Collisioner.hs | 10 +-- Spear/Collision/Sphere.hs | 36 ---------- Spear/Collision/Triangle.hs | 40 ----------- Spear/Collision/Types.hs | 4 +- Spear/Math/AABB.hs | 28 ++++++++ Spear/Math/Matrix3.hs | 6 +- Spear/Math/Matrix4.hs | 8 +-- Spear/Math/Octree.hs | 6 +- Spear/Math/Plane.hs | 29 ++++---- Spear/Math/Sphere.hs | 35 ++++++++++ Spear/Math/Triangle.hs | 40 +++++++++++ Spear/Math/Vector2.hs | 155 +++++++++++++++++++++++++++++++++++++++++ Spear/Math/Vector3.hs | 32 ++------- Spear/Math/Vector4.hs | 33 +++------ Spear/Physics.hs | 2 - Spear/Physics/Rigid.hs | 8 +-- Spear/Physics/World.hs | 126 --------------------------------- Spear/Scene/Scene.hs | 8 +-- Spear/Setup.hs | 2 +- 25 files changed, 335 insertions(+), 361 deletions(-) delete mode 100644 Spear/Collision/AABB.hs delete mode 100644 Spear/Collision/Sphere.hs delete mode 100644 Spear/Collision/Triangle.hs create mode 100644 Spear/Math/AABB.hs create mode 100644 Spear/Math/Sphere.hs create mode 100644 Spear/Math/Triangle.hs create mode 100644 Spear/Math/Vector2.hs delete mode 100644 Spear/Physics/World.hs diff --git a/Spear.cabal b/Spear.cabal index 37ab48b..acad880 100644 --- a/Spear.cabal +++ b/Spear.cabal @@ -14,14 +14,13 @@ data-dir: "" library build-depends: GLFW -any, OpenGL -any, OpenGLRaw -any, StateVar -any, base -any, bytestring -any, directory -any, - mtl -any, transformers -any, resource-simple -any, parsec >=3.1.3, + mtl -any, transformers -any, resourcet -any, parsec >=3.1.3, containers -any, vector -any, array -any - exposed-modules: Spear.Math.Triangle - Spear.Physics.Types Spear.Physics.World Spear.App + exposed-modules: Spear.Physics.Types Spear.App Spear.App.Application Spear.App.Input Spear.Assets.Image - Spear.Assets.Model Spear.Collision Spear.Collision.AABB + Spear.Assets.Model Spear.Collision Spear.Math.AABB Spear.Collision.Collision Spear.Collision.Collisioner - Spear.Collision.Sphere Spear.Collision.Triangle + Spear.Math.Sphere Spear.Math.Triangle Spear.Collision.Types Spear.Game Spear.GLSL Spear.GLSL.Buffer Spear.GLSL.Error Spear.GLSL.Management Spear.GLSL.Texture Spear.GLSL.Uniform Spear.GLSL.VAO Spear.Math.Camera @@ -34,8 +33,7 @@ library Spear.Render.StaticModel Spear.Render.Texture Spear.Scene.Graph Spear.Scene.Light Spear.Scene.Loader Spear.Scene.Scene Spear.Scene.SceneResources Spear.Setup Spear.Sys.Timer - Spear.Sys.Store Spear.Sys.Store.ID - Spear.Updatable + Spear.Sys.Store Spear.Sys.Store.ID Spear.Updatable Spear.Math.Vector2 exposed: True buildable: True build-tools: hsc2hs -any @@ -51,12 +49,11 @@ library 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/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/Assets/Image Spear/Assets/Model Spear/Render Spear/Sys hs-source-dirs: . ghc-options: -O2 -rtsopts - \ No newline at end of file + diff --git a/Spear.lkshs b/Spear.lkshs index c4ef8ee..9aa6160 100644 --- a/Spear.lkshs +++ b/Spear.lkshs @@ -1,18 +1,18 @@ Version of session file format: 1 Time of storage: - "Fri Aug 10 23:05:26 CEST 2012" -Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 3, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 244) 202)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 710) 954 -Population: [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c" 433)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h" 1424)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc" 423)),[SplitP LeftP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([[0,2],[0]],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.c" 3824)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.h" 0)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/cvector.c" 575)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/cvector.h" 765)),[SplitP LeftP])] -Window size: (1841,964) + "Tue Aug 28 17:22:50 CEST 2012" +Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 247) 202)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 691) 954 +Population: [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (InfoSt (InfoState (Just (Real (RealDescr {dscName' = "map", dscMbTypeStr' = Just "map ::\n (e -> AABB -> CollisionType) -> (e -> e) -> Octree e -> Octree e", dscMbModu' = Just (PM {pack = PackageIdentifier {pkgName = PackageName "Spear", pkgVersion = Version {versionBranch = [0,1], versionTags = []}}, modu = ModuleName ["Spear","Math","Octree"]}), dscMbLocation' = Just (Location {locationSLine = 185, locationSCol = 1, locationELine = 185, locationECol = 90}), dscMbComment' = Just " Applies the given function to the entities in the octree.\n Entities that break out of their cell are reallocated appropriately.", dscTypeHint' = VariableDescr, dscExported' = False}))))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 328 (PackageScope False,False) (Just (ModuleName ["Spear","Math","Octree"]),Just "map") (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0,4],[0,1],[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP])] +Window size: (1820,939) Completion size: (750,400) Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" -Active pane: Just "OBJ_load.c" +Active pane: Just "Workspace" Toolbar visible: True FindbarState: (False,FindState {entryStr = "asd", entryHist = ["idxs","asd","elemIndexa","elemtIn","splitAt","allocaBytes","copyArray","allocaArray","allocaa","putStrLn","assigned","Triangle"], replaceStr = "objects", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) Recently opened files: - ["/home/jeanne/programming/haskell/Spear/Spear/Scene/Loader.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.h","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.cc","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/MD2/MD2_load.c","/home/jeanne/programming/haskell/Spear/Spear/Assets/Image.hsc","/home/jeanne/programming/haskell/Spear/Spear/Render/Model.hsc","/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Player.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameState.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameMessage.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Factory.hs"] + ["/home/jeanne/programming/haskell/Spear/Spear/Collision/Types.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Triangle.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Sphere.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/Scene.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collisioner.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/AABB.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/Game/GameObject/Factory.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Octree.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision.hs","/home/jeanne/programming/haskell/Spear/Spear/Physics.hs","/home/jeanne/programming/haskell/Spear/Spear/Physics/World.hs"] Recently opened workspaces: - ["/home/jeanne/leksah.lkshw"] \ No newline at end of file + ["/home/jeanne/programming/haskell/hagen/hagen.lkshw","/home/jeanne/programming/haskell/foo/foo.lkshw","/home/jeanne/programming/haskell/Spear/Spear.lkshw","/home/jeanne/programming/haskell/nexus/nexus.lkshw","/home/jeanne/leksah.lkshw"] \ No newline at end of file diff --git a/Spear.lkshw b/Spear.lkshw index 1cbf39e..5345907 100644 --- a/Spear.lkshw +++ b/Spear.lkshw @@ -1,10 +1,10 @@ Version of workspace file format: 1 Time of storage: - "Sat Aug 11 11:39:35 CEST 2012" + "Tue Aug 28 17:23:50 CEST 2012" Name of the workspace: "Spear" File paths of contained packages: - ["demos/simple-scene/simple-scene.cabal","Spear.cabal"] + ["Spear.cabal"] Maybe file path of an active package: Just "Spear.cabal" \ No newline at end of file diff --git a/Spear/Collision.hs b/Spear/Collision.hs index d2de02d..975f3cf 100644 --- a/Spear/Collision.hs +++ b/Spear/Collision.hs @@ -1,19 +1,10 @@ module Spear.Collision ( - module Spear.Collision.AABB -, module Spear.Collision.Collision -, module Spear.Collision.Sphere -, module Spear.Collision.Triangle + module Spear.Collision.Collision , module Spear.Collision.Types ) where -import Spear.Collision.AABB hiding (contains) import Spear.Collision.Collision -import Spear.Collision.Sphere hiding (contains) -import Spear.Collision.Triangle import Spear.Collision.Types - -import qualified Spear.Collision.AABB as AABB (contains) -import qualified Spear.Collision.Sphere as Sphere (contains) diff --git a/Spear/Collision/AABB.hs b/Spear/Collision/AABB.hs deleted file mode 100644 index 2676af0..0000000 --- a/Spear/Collision/AABB.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Spear.Collision.AABB -( - AABB(..) -, aabb -, contains -) -where - - -import Spear.Math.Vector3 as Vector - - --- | An axis-aligned bounding box. -data AABB = AABB - { min :: !Vector3 - , max :: !Vector3 - } - deriving Eq - - --- | Create a 'AABB' from the given points. -aabb :: [Vector3] -> AABB - -aabb [] = error "Attempting to build a BoundingVolume from an empty list!" - -aabb (x:xs) = foldr update (AABB x x) xs - where update p (AABB min max) = AABB (Vector.min p min) (Vector.max p max) - - --- | Return 'True' if the given 'AABB' contains the given point, 'False' otherwise. -contains :: AABB -> Vector3 -> Bool -(AABB min max) `contains` v = v >= min && v <= max diff --git a/Spear/Collision/Collision.hs b/Spear/Collision/Collision.hs index d59cbc2..08f33b5 100644 --- a/Spear/Collision/Collision.hs +++ b/Spear/Collision/Collision.hs @@ -6,9 +6,9 @@ module Spear.Collision.Collision where -import Spear.Collision.AABB as AABB -import Spear.Collision.Sphere as Sphere import Spear.Collision.Types +import Spear.Math.AABB +import Spear.Math.Sphere import Spear.Math.Plane import Spear.Math.Vector3 @@ -22,11 +22,10 @@ class Collisionable a where instance Collisionable AABB where collideBox box1@(AABB min1 max1) box2@(AABB min2 max2) - | box1 == box2 = Equal | min1 > max2 = NoCollision | max1 < min2 = NoCollision - | box1 `AABB.contains` min2 && box1 `AABB.contains` max2 = FullyContains - | box2 `AABB.contains` min1 && box2 `AABB.contains` max1 = FullyContainedBy + | box1 `aabbpt` min2 && box1 `aabbpt` max2 = FullyContains + | box2 `aabbpt` min1 && box2 `aabbpt` max1 = FullyContainedBy | (x max1) < (x min2) = NoCollision | (x min1) > (x max2) = NoCollision | (y max1) < (y min2) = NoCollision @@ -60,7 +59,6 @@ instance Collisionable Sphere where x -> x collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2) - | s1 == s2 = Equal | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy | distance_centers <= sum_radii = Collision | otherwise = NoCollision diff --git a/Spear/Collision/Collisioner.hs b/Spear/Collision/Collisioner.hs index 94a0d63..266244d 100644 --- a/Spear/Collision/Collisioner.hs +++ b/Spear/Collision/Collisioner.hs @@ -9,12 +9,12 @@ module Spear.Collision.Collisioner ) where - -import Spear.Math.Vector3 as Vector -import Spear.Collision.AABB as Box -import Spear.Collision.Sphere as Sphere + import Spear.Collision.Collision as C import Spear.Collision.Types +import Spear.Math.AABB +import Spear.Math.Sphere +import Spear.Math.Vector3 -- | A collisioner component. @@ -41,7 +41,7 @@ buildAABB cols = aabb $ Spear.Collision.Collisioner.generatePoints cols -- | Create the minimal 'AABB' collisioner fully containing the specified 'BSphere'. -boxFromSphere :: Sphere.Sphere -> Collisioner +boxFromSphere :: Sphere -> Collisioner boxFromSphere = AABBCol . aabbFromSphere diff --git a/Spear/Collision/Sphere.hs b/Spear/Collision/Sphere.hs deleted file mode 100644 index de670bc..0000000 --- a/Spear/Collision/Sphere.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Spear.Collision.Sphere -( - Sphere(..) -, sphere -, contains -) -where - - -import Spear.Math.Vector3 as Vector - - --- | A bounding volume. -data Sphere = Sphere - { center :: !Vector3 - , radius :: !Float - } - deriving Eq - - --- | Create a 'Sphere' from the given points. -sphere :: [Vector3] -> Sphere - -sphere [] = error "Attempting to build a BoundingVolume from an empty list!" - -sphere (x:xs) = Sphere c r - where - c = min + (max-min)/2 - r = norm $ max - c - (min,max) = foldr update (x,x) xs - update p (min,max) = (Vector.min p min, Vector.max p max) - - --- | Return 'True' if the given 'Sphere' contains the given point, 'False' otherwise. -contains :: Sphere -> Vector3 -> Bool -(Sphere center radius) `contains` p = radius*radius >= normSq (p - center) diff --git a/Spear/Collision/Triangle.hs b/Spear/Collision/Triangle.hs deleted file mode 100644 index 2391e9f..0000000 --- a/Spear/Collision/Triangle.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Spear.Collision.Triangle -( - Triangle(..) -) -where - - -import Spear.Math.Vector3 - -import Foreign.C.Types -import Foreign.Storable - - -data Triangle = Triangle - { p0 :: Vector3 - , p1 :: Vector3 - , p2 :: Vector3 - } - - -sizeVector3 = 3 * sizeOf (undefined :: CFloat) - - -instance Storable Triangle where - - sizeOf _ = 3 * sizeVector3 - alignment _ = alignment (undefined :: CFloat) - - peek ptr = do - p0 <- peekByteOff ptr 0 - p1 <- peekByteOff ptr $ 1 * sizeVector3 - p2 <- peekByteOff ptr $ 2 * 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 diff --git a/Spear/Collision/Types.hs b/Spear/Collision/Types.hs index efbf7f9..61b224f 100644 --- a/Spear/Collision/Types.hs +++ b/Spear/Collision/Types.hs @@ -2,5 +2,5 @@ module Spear.Collision.Types where -- | Encodes several collision situations. -data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy | Equal - deriving (Eq, Ord, Show) +data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy + deriving (Eq, Show) diff --git a/Spear/Math/AABB.hs b/Spear/Math/AABB.hs new file mode 100644 index 0000000..362ddd6 --- /dev/null +++ b/Spear/Math/AABB.hs @@ -0,0 +1,28 @@ +module Spear.Math.AABB +( + AABB(..) +, aabb +, aabbpt +) +where + + +import Spear.Math.Vector3 as Vector + + +-- | An axis-aligned bounding box. +data AABB = AABB {-# UNPACK #-} !Vector3 {-# UNPACK #-} !Vector3 + + +-- | Create a 'AABB' from the given points. +aabb :: [Vector3] -> AABB + +aabb [] = error "Attempting to build a BoundingVolume from an empty list!" + +aabb (x:xs) = foldr update (AABB x x) xs + where update p (AABB min max) = AABB (Vector.min p min) (Vector.max p max) + + +-- | Return 'True' if the given 'AABB' contains the given point, 'False' otherwise. +aabbpt :: AABB -> Vector3 -> Bool +(AABB min max) `aabbpt` v = v >= min && v <= max diff --git a/Spear/Math/Matrix3.hs b/Spear/Math/Matrix3.hs index bc8f149..1e56ceb 100644 --- a/Spear/Math/Matrix3.hs +++ b/Spear/Math/Matrix3.hs @@ -42,9 +42,9 @@ import Foreign.Storable -- | Represents a 3x3 column major matrix. data Matrix3 = Matrix3 - { m00 :: !Float, m10 :: !Float, m20 :: !Float - , m01 :: !Float, m11 :: !Float, m21 :: !Float - , m02 :: !Float, m12 :: !Float, m22 :: !Float + { m00 :: {-# UNPACK #-} !Float, m10 :: {-# UNPACK #-} !Float, m20 :: {-# UNPACK #-} !Float + , m01 :: {-# UNPACK #-} !Float, m11 :: {-# UNPACK #-} !Float, m21 :: {-# UNPACK #-} !Float + , m02 :: {-# UNPACK #-} !Float, m12 :: {-# UNPACK #-} !Float, m22 :: {-# UNPACK #-} !Float } diff --git a/Spear/Math/Matrix4.hs b/Spear/Math/Matrix4.hs index 2176e99..82dc9d5 100644 --- a/Spear/Math/Matrix4.hs +++ b/Spear/Math/Matrix4.hs @@ -54,10 +54,10 @@ import Foreign.Storable -- | Represents a 4x4 column major matrix. data Matrix4 = Matrix4 - { m00 :: !Float, m10 :: !Float, m20 :: !Float, m30 :: !Float - , m01 :: !Float, m11 :: !Float, m21 :: !Float, m31 :: !Float - , m02 :: !Float, m12 :: !Float, m22 :: !Float, m32 :: !Float - , m03 :: !Float, m13 :: !Float, m23 :: !Float, m33 :: !Float + { m00 :: {-# UNPACK #-} !Float, m10 :: {-# UNPACK #-} !Float, m20 :: {-# UNPACK #-} !Float, m30 :: {-# UNPACK #-} !Float + , m01 :: {-# UNPACK #-} !Float, m11 :: {-# UNPACK #-} !Float, m21 :: {-# UNPACK #-} !Float, m31 :: {-# UNPACK #-} !Float + , m02 :: {-# UNPACK #-} !Float, m12 :: {-# UNPACK #-} !Float, m22 :: {-# UNPACK #-} !Float, m32 :: {-# UNPACK #-} !Float + , m03 :: {-# UNPACK #-} !Float, m13 :: {-# UNPACK #-} !Float, m23 :: {-# UNPACK #-} !Float, m33 :: {-# UNPACK #-} !Float } diff --git a/Spear/Math/Octree.hs b/Spear/Math/Octree.hs index 1e257eb..15f7dde 100644 --- a/Spear/Math/Octree.hs +++ b/Spear/Math/Octree.hs @@ -11,9 +11,9 @@ module Spear.Math.Octree ) where -import Spear.Collision.AABB as AABB import Spear.Collision.Types -import Spear.Math.Vector3 as Vector +import Spear.Math.AABB +import Spear.Math.Vector3 import Control.Applicative ((<*>)) import Data.List @@ -93,7 +93,7 @@ clone (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = Octree root [] c1' c2' c3' c4 keep :: (e -> AABB -> CollisionType) -> AABB -> e -> Bool -keep testAABB aabb e = test == FullyContainedBy || test == Equal +keep testAABB aabb e = test == FullyContainedBy where test = e `testAABB` aabb diff --git a/Spear/Math/Plane.hs b/Spear/Math/Plane.hs index 0f5829b..8772a42 100644 --- a/Spear/Math/Plane.hs +++ b/Spear/Math/Plane.hs @@ -1,8 +1,8 @@ module Spear.Math.Plane ( - Plane -, plane -, classify + Plane +, plane +, classify ) where @@ -13,21 +13,22 @@ import Spear.Math.Vector3 as Vector data PointPlanePos = Front | Back | Contained deriving (Eq, Ord, Show) -data Plane = Plane { - n :: !Vector3, - d :: !Float -} deriving(Eq, Show) +data Plane = Plane + { n :: {-# UNPACK #-} !Vector3, + d :: {-# UNPACK #-} !Float + } + deriving(Eq, Show) -- | Create a plane given a normal vector and a distance from the origin. plane :: Vector3 -> Float -> Plane plane n d = Plane (normalise n) d - - + + -- | Classify the given point's relative position with respect to the given plane. classify :: Plane -> Vector3 -> PointPlanePos -classify (Plane n d) pt = case (n `dot` pt - d) `compare` 0 of - GT -> Front - LT -> Back - EQ -> Contained - \ No newline at end of file +classify (Plane n d) pt = + case (n `dot` pt - d) `compare` 0 of + GT -> Front + LT -> Back + EQ -> Contained diff --git a/Spear/Math/Sphere.hs b/Spear/Math/Sphere.hs new file mode 100644 index 0000000..4a9e3fc --- /dev/null +++ b/Spear/Math/Sphere.hs @@ -0,0 +1,35 @@ +module Spear.Math.Sphere +( + Sphere(..) +, sphere +, spherept +) +where + + +import Spear.Math.Vector3 as Vector + + +-- | A bounding volume. +data Sphere = Sphere + { center :: {-# UNPACK #-} !Vector3 + , radius :: {-# UNPACK #-} !Float + } + + +-- | Create a 'Sphere' from the given points. +sphere :: [Vector3] -> Sphere + +sphere [] = error "Attempting to build a BoundingVolume from an empty list!" + +sphere (x:xs) = Sphere c r + where + c = min + (max-min)/2 + r = norm $ max - c + (min,max) = foldr update (x,x) xs + update p (min,max) = (Vector.min p min, Vector.max p max) + + +-- | Return 'True' if the given 'Sphere' contains the given point, 'False' otherwise. +spherept :: Sphere -> Vector3 -> Bool +(Sphere center radius) `spherept` p = radius*radius >= normSq (p - center) diff --git a/Spear/Math/Triangle.hs b/Spear/Math/Triangle.hs new file mode 100644 index 0000000..3c30ea6 --- /dev/null +++ b/Spear/Math/Triangle.hs @@ -0,0 +1,40 @@ +module Spear.Math.Triangle +( + Triangle(..) +) +where + + +import Spear.Math.Vector3 + +import Foreign.C.Types +import Foreign.Storable + + +data Triangle = Triangle + { p0 :: {-# UNPACK #-} !Vector3 + , p1 :: {-# UNPACK #-} !Vector3 + , p2 :: {-# UNPACK #-} !Vector3 + } + + +sizeVector3 = 3 * sizeOf (undefined :: CFloat) + + +instance Storable Triangle where + + sizeOf _ = 3 * sizeVector3 + alignment _ = alignment (undefined :: CFloat) + + peek ptr = do + p0 <- peekByteOff ptr 0 + p1 <- peekByteOff ptr $ 1 * sizeVector3 + p2 <- peekByteOff ptr $ 2 * 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 diff --git a/Spear/Math/Vector2.hs b/Spear/Math/Vector2.hs new file mode 100644 index 0000000..ace86fe --- /dev/null +++ b/Spear/Math/Vector2.hs @@ -0,0 +1,155 @@ +module Spear.Math.Vector2 +( + Vector2 + -- * Accessors +, x +, y + -- * Construction +, unitx +, unity +, zero +, fromList +, vec2 + -- * Operations +, v2min +, v2max +, dot +, normSq +, norm +, scale +, normalise +, neg +, perp +) +where + +import Foreign.C.Types (CFloat) +import Foreign.Storable + + +-- | Represents a vector in 2D. +data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) + + +instance Num Vector2 where + Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) + Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) + Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) + abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay) + signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay) + fromInteger i = Vector2 i' i' where i' = fromInteger i + + +instance Fractional Vector2 where + Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) + fromRational r = Vector2 r' r' where r' = fromRational r + + +instance Ord Vector2 where + Vector2 ax ay <= Vector2 bx by = (ax <= bx) || (ax == bx && ay <= by) + Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by) + Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by) + Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by) + + +sizeFloat = sizeOf (undefined :: CFloat) + + +instance Storable Vector2 where + sizeOf _ = 2*sizeFloat + alignment _ = alignment (undefined :: CFloat) + + peek ptr = do + ax <- peekByteOff ptr 0 + ay <- peekByteOff ptr $ sizeFloat + return (Vector2 ax ay) + + poke ptr (Vector2 ax ay) = do + pokeByteOff ptr 0 ax + pokeByteOff ptr sizeFloat ay + + +-- | Get the vector's x coordinate. +x (Vector2 ax _) = ax + + +-- | Get the vector's y coordinate. +y (Vector2 _ ay) = ay + + +-- | Unit vector along the X axis. +unitx :: Vector2 +unitx = Vector2 1 0 + + +-- | Unit vector along the Y axis. +unity :: Vector2 +unity = Vector2 0 1 + + +-- | Zero vector. +zero :: Vector2 +zero = Vector2 0 0 + + +-- | Create a vector from the given list. +fromList :: [Float] -> Vector2 +fromList (ax:ay:_) = Vector2 ax ay + + +-- | Create a vector from the given values. +vec2 :: Float -> Float -> Vector2 +vec2 ax ay = Vector2 ax ay + + +-- | Create a vector with components set to the minimum of each of the given vectors'. +v2min :: Vector2 -> Vector2 -> Vector2 +v2min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by) + + +-- | Create a vector with components set to the maximum of each of the given vectors'. +v2max :: Vector2 -> Vector2 -> Vector2 +v2max (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.max ax bx) (Prelude.max ay by) + + +-- | Compute the given vectors' dot product. +dot :: Vector2 -> Vector2 -> Float +Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by + + +-- | Compute the given vector's squared norm. +normSq :: Vector2 -> Float +normSq (Vector2 ax ay) = ax*ax + ay*ay + + +-- | Compute the given vector's norm. +norm :: Vector2 -> Float +norm = sqrt . normSq + + +-- | Multiply the given vector with the given scalar. +scale :: Float -> Vector2 -> Vector2 +scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay) + + +-- | Normalise the given vector. +normalise :: Vector2 -> Vector2 +normalise v = + let n' = norm v + n = if n' == 0 then 1 else n' + in + scale (1.0 / n) v + + +-- | Negate the given vector. +neg :: Vector2 -> Vector2 +neg (Vector2 ax ay) = Vector2 (-ax) (-ay) + + +-- | Compute a vector perpendicular to the given one, satisfying: +-- +-- perp (Vector2 0 1) = Vector2 1 0 +-- +-- perp (Vector2 1 0) = Vector2 0 (-1) +perp :: Vector2 -> Vector2 +perp (Vector2 x y) = Vector2 y (-x) diff --git a/Spear/Math/Vector3.hs b/Spear/Math/Vector3.hs index b10fd16..0d559c3 100644 --- a/Spear/Math/Vector3.hs +++ b/Spear/Math/Vector3.hs @@ -16,8 +16,6 @@ module Spear.Math.Vector3 -- * Operations , Spear.Math.Vector3.min , Spear.Math.Vector3.max -, Spear.Math.Vector3.zipWith -, Spear.Math.Vector3.map , dot , cross , normSq @@ -33,7 +31,11 @@ import Foreign.Storable -- | Represents a vector in 3D. -data Vector3 = Vector3 !Float !Float !Float deriving (Eq, Show) +data Vector3 = Vector3 + {-# UNPACK #-} !Float + {-# UNPACK #-} !Float + {-# UNPACK #-} !Float + deriving (Eq, Show) instance Num Vector3 where @@ -89,8 +91,8 @@ instance Storable Vector3 where pokeByteOff ptr 0 ax pokeByteOff ptr (1*sizeFloat) ay pokeByteOff ptr (2*sizeFloat) az - - + + x (Vector3 ax _ _ ) = ax y (Vector3 _ ay _ ) = ay z (Vector3 _ _ az) = az @@ -157,26 +159,6 @@ max :: Vector3 -> Vector3 -> Vector3 max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) --- | Zip two vectors with the given function. -zipWith :: (Float -> Float -> Float) -> Vector3 -> Vector3 -> Vector3 -zipWith f (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (f ax bx) (f ay by) (f az bz) - - --- | Folds a vector from the left. -{-foldl :: (UV.Unbox b) => (a -> b -> a) -> a -> Vector3 b -> a -foldl f acc (Vector3 v) = UV.foldl f acc v - - --- | Folds a vector from the right. -foldr :: (UV.Unbox b) => (b -> a -> a) -> a -> Vector3 b -> a -foldr f acc (Vector3 v) = UV.foldr f acc v-} - - --- | Map the given function over the given vector. -map :: (Float -> Float) -> Vector3 -> Vector3 -map f (Vector3 ax ay az) = Vector3 (f ax) (f ay) (f az) - - -- | Compute the given vectors' dot product. dot :: Vector3 -> Vector3 -> Float Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz diff --git a/Spear/Math/Vector4.hs b/Spear/Math/Vector4.hs index 2dd852a..9ba35bc 100644 --- a/Spear/Math/Vector4.hs +++ b/Spear/Math/Vector4.hs @@ -15,8 +15,6 @@ module Spear.Math.Vector4 -- * Operations , Spear.Math.Vector4.min , Spear.Math.Vector4.max -, Spear.Math.Vector4.zipWith -, Spear.Math.Vector4.map , dot , normSq , norm @@ -32,7 +30,12 @@ import Foreign.Storable -- | Represents a vector in 3D. -data Vector4 = Vector4 !Float !Float !Float !Float deriving (Eq, Show) +data Vector4 = Vector4 + {-# UNPACK #-} !Float + {-# UNPACK #-} !Float + {-# UNPACK #-} !Float + {-# UNPACK #-} !Float + deriving (Eq, Show) instance Num Vector4 where @@ -94,8 +97,8 @@ instance Storable Vector4 where pokeByteOff ptr (1 * sizeFloat) ay pokeByteOff ptr (2 * sizeFloat) az pokeByteOff ptr (3 * sizeFloat) aw - - + + x (Vector4 ax _ _ _ ) = ax y (Vector4 _ ay _ _ ) = ay z (Vector4 _ _ az _ ) = az @@ -139,26 +142,6 @@ 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) --- | Zip two vectors with the given function. -zipWith :: (Float -> Float -> Float) -> Vector4 -> Vector4 -> Vector4 -zipWith f (Vector4 ax ay az aw) (Vector4 bx by bz bw) = Vector4 (f ax bx) (f ay by) (f az bz) (f aw bw) - - --- | Folds a vector from the left. -{-foldl :: (UV.Unbox b) => (a -> b -> a) -> a -> Vector4 b -> a -foldl f acc (Vector4 v) = UV.foldl f acc v - - --- | Folds a vector from the right. -foldr :: (UV.Unbox b) => (b -> a -> a) -> a -> Vector4 b -> a -foldr f acc (Vector4 v) = UV.foldr f acc v-} - - --- | Map the given function over the given vector. -map :: (Float -> Float) -> Vector4 -> Vector4 -map f (Vector4 ax ay az aw) = Vector4 (f ax) (f ay) (f az) (f aw) - - -- | Compute the given vectors' dot product. dot :: Vector4 -> Vector4 -> Float Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw diff --git a/Spear/Physics.hs b/Spear/Physics.hs index 248d4fe..c143e32 100644 --- a/Spear/Physics.hs +++ b/Spear/Physics.hs @@ -2,11 +2,9 @@ module Spear.Physics ( module Spear.Physics.Rigid , module Spear.Physics.Types -, module Spear.Physics.World ) where import Spear.Physics.Rigid import Spear.Physics.Types -import Spear.Physics.World diff --git a/Spear/Physics/Rigid.hs b/Spear/Physics/Rigid.hs index c3b4cfa..6d3c4d7 100644 --- a/Spear/Physics/Rigid.hs +++ b/Spear/Physics/Rigid.hs @@ -20,10 +20,10 @@ import Control.Monad.State data RigidBody = RigidBody - { mass :: Float - , position :: Vector3 - , velocity :: Vector3 - , acceleration :: Vector3 + { mass :: !Float + , position :: !Vector3 + , velocity :: !Vector3 + , acceleration :: !Vector3 } diff --git a/Spear/Physics/World.hs b/Spear/Physics/World.hs deleted file mode 100644 index b4e6176..0000000 --- a/Spear/Physics/World.hs +++ /dev/null @@ -1,126 +0,0 @@ -module Spear.Physics.World -( - module Spear.Physics.Types - -- * Data types -, World -, ObjectID - -- * Construction -, emptyWorld - -- * World operations -, setGravity -, updateWorld - -- * Object operations -, newObject -, deleteObject -, withBody -, objectTransform -, setForces -) -where - - -import Spear.Collision.AABB -import Spear.Collision.Collisioner as C -import Spear.Collision.Sphere -import Spear.Math.Matrix4 (Matrix4) -import Spear.Math.Spatial -import Spear.Math.Vector3 -import Spear.Physics.Rigid as Rigid -import Spear.Physics.Types -import Spear.Sys.Store - - -import Data.Maybe (fromJust) - - --- | Uniquely identifies an object in a 'World'. -newtype ObjectID = ObjectID Int - - -data Object = Object - { body :: RigidBody - , collisioner :: Collisioner - , forces :: [Vector3] - } - - --- | The world where physical bodies are simulated. -data World = World - { bodies :: Store Object -- ^ Collection of objects. - , gravity :: Vector3 -- ^ World gravity. - } - - --- | Create an empty world. -emptyWorld :: World -emptyWorld = World emptyStore $ vec3 0 (-9.8) 0 - - --- | Create a new object. -newObject :: RigidBody -> Collisioner -> World -> (ObjectID, World) -newObject body collisioner world = - let (index, bodies') = store (Object body collisioner []) $ bodies world - in (ObjectID index, world { bodies = bodies' }) - - --- | Remove the object specified by the given object ID. -deleteObject :: ObjectID -> World -> World -deleteObject (ObjectID i) world = world { bodies = bodies' } - where - bodies' = storeFree i $ bodies world - - --- | Modify the object identified by the given object ID. -withBody :: ObjectID -> World -> (RigidBody -> RigidBody) -> World -withBody (ObjectID index) world f = world { bodies = bodies' } - where - bodies' = withElement index (bodies world) $ \obj -> obj { body = f $ body obj } - - --- | Get the transform of the object identified by the given object ID. -objectTransform :: World -> ObjectID -> Matrix4 -objectTransform world (ObjectID i) = transform . body . fromJust $ (element i $ bodies world) - - --- | Add the given force to the forces acting on the object identified by the given object ID. -setForces :: [Force] -> ObjectID -> World -> World -setForces fs (ObjectID i) world = world { bodies = bodies' } - where - bodies' = withElement i (bodies world) $ \obj -> obj { forces = fs } - - --- | Set the world's gravity. -setGravity :: Vector3 -> World -> World -setGravity g world = world { gravity = g } - - --- | Update the world. -updateWorld :: Dt -> World -> World -updateWorld dt world = world { bodies = fmap updateObject $ bodies world } - where - updateObject (Object body collisioner forces) = Object body' collisioner' forces - where - -- Forces acting on the body. - forces' = scale (mass body) (gravity world) : forces - - -- Updated body. - body' = Rigid.update forces dt body - - -- Center collisioner around the new body's center. - collisioner' = center (Rigid.position body') collisioner - - -- Center the collisioner around the given point. - center c (SphereCol (Sphere _ r)) = sphereCollisioner $ Sphere c r - center c (AABBCol (AABB min max)) = - let v = (max - min) / 2 - min' = c - v - max' = c + v - in - aabbCollisioner $ AABB min' max' - - -{--- | Test for potential collisions. --- --- Returns a new world and a list of colliding pairs of objects. ---testCollisions :: World -> (World, [(ObjectID, ObjectID)])-} - diff --git a/Spear/Scene/Scene.hs b/Spear/Scene/Scene.hs index 94c2f6f..fe0eff8 100644 --- a/Spear/Scene/Scene.hs +++ b/Spear/Scene/Scene.hs @@ -21,9 +21,9 @@ module Spear.Scene.Scene where -import Spear.Collision.AABB import Spear.Collision.Types import Spear.Game (Game) +import Spear.Math.AABB import Spear.Math.Octree as Octree import Control.Applicative ((<*>)) @@ -35,12 +35,12 @@ import qualified Data.List as L (delete, filter, find) data Scene obj = ListScene - { objects :: [obj] + { objects :: ![obj] } | OctreeScene - { collideAABB :: obj -> AABB -> CollisionType - , world :: Octree obj + { collideAABB :: obj -> AABB -> CollisionType + , world :: !(Octree obj) } diff --git a/Spear/Setup.hs b/Spear/Setup.hs index 2f16c54..cfe379c 100644 --- a/Spear/Setup.hs +++ b/Spear/Setup.hs @@ -13,7 +13,7 @@ where import Control.Monad.Error -import qualified Control.Monad.Resource as R +import qualified Control.Monad.Trans.Resource as R import qualified Control.Monad.Trans.Class as MT (lift) -- cgit v1.2.3