diff options
author | Marc Sunet <jeannekamikaze@gmail.com> | 2012-08-28 17:37:23 +0200 |
---|---|---|
committer | Marc Sunet <jeannekamikaze@gmail.com> | 2012-08-28 17:37:23 +0200 |
commit | e03885548a3062724e35d30317a0bfdbb66d5915 (patch) | |
tree | 303e531ba74ca6f3032acb17195b4e91fccb8b49 | |
parent | de1085d2aa85b8c332b781c2c9386f7f809f5b25 (diff) |
· Moved mathematical entities in Collision to Math.
+ Added Spear.Math.Vector2.
· Made fields of mathematical entities strict and unpacked.
-rw-r--r-- | Spear.cabal | 17 | ||||
-rw-r--r-- | Spear.lkshs | 14 | ||||
-rw-r--r-- | Spear.lkshw | 4 | ||||
-rw-r--r-- | Spear/Collision.hs | 11 | ||||
-rw-r--r-- | Spear/Collision/Collision.hs | 10 | ||||
-rw-r--r-- | Spear/Collision/Collisioner.hs | 10 | ||||
-rw-r--r-- | Spear/Collision/Types.hs | 4 | ||||
-rw-r--r-- | Spear/Math/AABB.hs (renamed from Spear/Collision/AABB.hs) | 14 | ||||
-rw-r--r-- | Spear/Math/Matrix3.hs | 6 | ||||
-rw-r--r-- | Spear/Math/Matrix4.hs | 8 | ||||
-rw-r--r-- | Spear/Math/Octree.hs | 6 | ||||
-rw-r--r-- | Spear/Math/Plane.hs | 29 | ||||
-rw-r--r-- | Spear/Math/Sphere.hs (renamed from Spear/Collision/Sphere.hs) | 13 | ||||
-rw-r--r-- | Spear/Math/Triangle.hs (renamed from Spear/Collision/Triangle.hs) | 8 | ||||
-rw-r--r-- | Spear/Math/Vector2.hs | 155 | ||||
-rw-r--r-- | Spear/Math/Vector3.hs | 32 | ||||
-rw-r--r-- | Spear/Math/Vector4.hs | 33 | ||||
-rw-r--r-- | Spear/Physics.hs | 2 | ||||
-rw-r--r-- | Spear/Physics/Rigid.hs | 8 | ||||
-rw-r--r-- | Spear/Physics/World.hs | 126 | ||||
-rw-r--r-- | Spear/Scene/Scene.hs | 8 | ||||
-rw-r--r-- | Spear/Setup.hs | 2 |
22 files changed, 247 insertions, 273 deletions
diff --git a/Spear.cabal b/Spear.cabal index 37ab48b..acad880 100644 --- a/Spear.cabal +++ b/Spear.cabal | |||
@@ -14,14 +14,13 @@ data-dir: "" | |||
14 | library | 14 | library |
15 | build-depends: GLFW -any, OpenGL -any, OpenGLRaw -any, | 15 | build-depends: GLFW -any, OpenGL -any, OpenGLRaw -any, |
16 | StateVar -any, base -any, bytestring -any, directory -any, | 16 | StateVar -any, base -any, bytestring -any, directory -any, |
17 | mtl -any, transformers -any, resource-simple -any, parsec >=3.1.3, | 17 | mtl -any, transformers -any, resourcet -any, parsec >=3.1.3, |
18 | containers -any, vector -any, array -any | 18 | containers -any, vector -any, array -any |
19 | exposed-modules: Spear.Math.Triangle | 19 | exposed-modules: Spear.Physics.Types Spear.App |
20 | Spear.Physics.Types Spear.Physics.World Spear.App | ||
21 | Spear.App.Application Spear.App.Input Spear.Assets.Image | 20 | Spear.App.Application Spear.App.Input Spear.Assets.Image |
22 | Spear.Assets.Model Spear.Collision Spear.Collision.AABB | 21 | Spear.Assets.Model Spear.Collision Spear.Math.AABB |
23 | Spear.Collision.Collision Spear.Collision.Collisioner | 22 | Spear.Collision.Collision Spear.Collision.Collisioner |
24 | Spear.Collision.Sphere Spear.Collision.Triangle | 23 | Spear.Math.Sphere Spear.Math.Triangle |
25 | Spear.Collision.Types Spear.Game Spear.GLSL Spear.GLSL.Buffer | 24 | Spear.Collision.Types Spear.Game Spear.GLSL Spear.GLSL.Buffer |
26 | Spear.GLSL.Error Spear.GLSL.Management Spear.GLSL.Texture | 25 | Spear.GLSL.Error Spear.GLSL.Management Spear.GLSL.Texture |
27 | Spear.GLSL.Uniform Spear.GLSL.VAO Spear.Math.Camera | 26 | Spear.GLSL.Uniform Spear.GLSL.VAO Spear.Math.Camera |
@@ -34,8 +33,7 @@ library | |||
34 | Spear.Render.StaticModel Spear.Render.Texture Spear.Scene.Graph | 33 | Spear.Render.StaticModel Spear.Render.Texture Spear.Scene.Graph |
35 | Spear.Scene.Light Spear.Scene.Loader Spear.Scene.Scene | 34 | Spear.Scene.Light Spear.Scene.Loader Spear.Scene.Scene |
36 | Spear.Scene.SceneResources Spear.Setup Spear.Sys.Timer | 35 | Spear.Scene.SceneResources Spear.Setup Spear.Sys.Timer |
37 | Spear.Sys.Store Spear.Sys.Store.ID | 36 | Spear.Sys.Store Spear.Sys.Store.ID Spear.Updatable Spear.Math.Vector2 |
38 | Spear.Updatable | ||
39 | exposed: True | 37 | exposed: True |
40 | buildable: True | 38 | buildable: True |
41 | build-tools: hsc2hs -any | 39 | build-tools: hsc2hs -any |
@@ -51,12 +49,11 @@ library | |||
51 | Spear/Assets/Image/Image.h Spear/Assets/Image/Image_error_code.h | 49 | Spear/Assets/Image/Image.h Spear/Assets/Image/Image_error_code.h |
52 | Spear/Assets/Image/sys_types.h Spear/Assets/Model/MD2/MD2_load.h | 50 | Spear/Assets/Image/sys_types.h Spear/Assets/Model/MD2/MD2_load.h |
53 | Spear/Assets/Model/OBJ/OBJ_load.h Spear/Assets/Model/OBJ/cvector.h | 51 | Spear/Assets/Model/OBJ/OBJ_load.h Spear/Assets/Model/OBJ/cvector.h |
54 | Spear/Assets/Model/Model.h | 52 | Spear/Assets/Model/Model.h Spear/Assets/Model/Model_error_code.h |
55 | Spear/Assets/Model/Model_error_code.h | ||
56 | Spear/Assets/Model/sys_types.h Spear/Render/RenderModel.h | 53 | Spear/Assets/Model/sys_types.h Spear/Render/RenderModel.h |
57 | Timer/Timer.h | 54 | Timer/Timer.h |
58 | include-dirs: Spear/Assets/Image Spear/Assets/Model Spear/Render | 55 | include-dirs: Spear/Assets/Image Spear/Assets/Model Spear/Render |
59 | Spear/Sys | 56 | Spear/Sys |
60 | hs-source-dirs: . | 57 | hs-source-dirs: . |
61 | ghc-options: -O2 -rtsopts | 58 | ghc-options: -O2 -rtsopts |
62 | \ No newline at end of file | 59 | |
diff --git a/Spear.lkshs b/Spear.lkshs index c4ef8ee..9aa6160 100644 --- a/Spear.lkshs +++ b/Spear.lkshs | |||
@@ -1,18 +1,18 @@ | |||
1 | Version of session file format: | 1 | Version of session file format: |
2 | 1 | 2 | 1 |
3 | Time of storage: | 3 | Time of storage: |
4 | "Fri Aug 10 23:05:26 CEST 2012" | 4 | "Tue Aug 28 17:22:50 CEST 2012" |
5 | 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 | 5 | 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 |
6 | 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])] | 6 | 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])] |
7 | Window size: (1841,964) | 7 | Window size: (1820,939) |
8 | Completion size: | 8 | Completion size: |
9 | (750,400) | 9 | (750,400) |
10 | Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" | 10 | Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" |
11 | Active pane: Just "OBJ_load.c" | 11 | Active pane: Just "Workspace" |
12 | Toolbar visible: | 12 | Toolbar visible: |
13 | True | 13 | True |
14 | 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}) | 14 | 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}) |
15 | Recently opened files: | 15 | Recently opened files: |
16 | ["/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"] | 16 | ["/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"] |
17 | Recently opened workspaces: | 17 | Recently opened workspaces: |
18 | ["/home/jeanne/leksah.lkshw"] \ No newline at end of file | 18 | ["/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 @@ | |||
1 | Version of workspace file format: | 1 | Version of workspace file format: |
2 | 1 | 2 | 1 |
3 | Time of storage: | 3 | Time of storage: |
4 | "Sat Aug 11 11:39:35 CEST 2012" | 4 | "Tue Aug 28 17:23:50 CEST 2012" |
5 | Name of the workspace: | 5 | Name of the workspace: |
6 | "Spear" | 6 | "Spear" |
7 | File paths of contained packages: | 7 | File paths of contained packages: |
8 | ["demos/simple-scene/simple-scene.cabal","Spear.cabal"] | 8 | ["Spear.cabal"] |
9 | Maybe file path of an active package: | 9 | Maybe file path of an active package: |
10 | Just "Spear.cabal" \ No newline at end of file | 10 | 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 @@ | |||
1 | module Spear.Collision | 1 | module Spear.Collision |
2 | ( | 2 | ( |
3 | module Spear.Collision.AABB | 3 | module Spear.Collision.Collision |
4 | , module Spear.Collision.Collision | ||
5 | , module Spear.Collision.Sphere | ||
6 | , module Spear.Collision.Triangle | ||
7 | , module Spear.Collision.Types | 4 | , module Spear.Collision.Types |
8 | ) | 5 | ) |
9 | where | 6 | where |
10 | 7 | ||
11 | 8 | ||
12 | import Spear.Collision.AABB hiding (contains) | ||
13 | import Spear.Collision.Collision | 9 | import Spear.Collision.Collision |
14 | import Spear.Collision.Sphere hiding (contains) | ||
15 | import Spear.Collision.Triangle | ||
16 | import Spear.Collision.Types | 10 | import Spear.Collision.Types |
17 | |||
18 | import qualified Spear.Collision.AABB as AABB (contains) | ||
19 | import qualified Spear.Collision.Sphere as Sphere (contains) | ||
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 | |||
6 | where | 6 | where |
7 | 7 | ||
8 | 8 | ||
9 | import Spear.Collision.AABB as AABB | ||
10 | import Spear.Collision.Sphere as Sphere | ||
11 | import Spear.Collision.Types | 9 | import Spear.Collision.Types |
10 | import Spear.Math.AABB | ||
11 | import Spear.Math.Sphere | ||
12 | import Spear.Math.Plane | 12 | import Spear.Math.Plane |
13 | import Spear.Math.Vector3 | 13 | import Spear.Math.Vector3 |
14 | 14 | ||
@@ -22,11 +22,10 @@ class Collisionable a where | |||
22 | instance Collisionable AABB where | 22 | instance Collisionable AABB where |
23 | 23 | ||
24 | collideBox box1@(AABB min1 max1) box2@(AABB min2 max2) | 24 | collideBox box1@(AABB min1 max1) box2@(AABB min2 max2) |
25 | | box1 == box2 = Equal | ||
26 | | min1 > max2 = NoCollision | 25 | | min1 > max2 = NoCollision |
27 | | max1 < min2 = NoCollision | 26 | | max1 < min2 = NoCollision |
28 | | box1 `AABB.contains` min2 && box1 `AABB.contains` max2 = FullyContains | 27 | | box1 `aabbpt` min2 && box1 `aabbpt` max2 = FullyContains |
29 | | box2 `AABB.contains` min1 && box2 `AABB.contains` max1 = FullyContainedBy | 28 | | box2 `aabbpt` min1 && box2 `aabbpt` max1 = FullyContainedBy |
30 | | (x max1) < (x min2) = NoCollision | 29 | | (x max1) < (x min2) = NoCollision |
31 | | (x min1) > (x max2) = NoCollision | 30 | | (x min1) > (x max2) = NoCollision |
32 | | (y max1) < (y min2) = NoCollision | 31 | | (y max1) < (y min2) = NoCollision |
@@ -60,7 +59,6 @@ instance Collisionable Sphere where | |||
60 | x -> x | 59 | x -> x |
61 | 60 | ||
62 | collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2) | 61 | collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2) |
63 | | s1 == s2 = Equal | ||
64 | | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy | 62 | | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy |
65 | | distance_centers <= sum_radii = Collision | 63 | | distance_centers <= sum_radii = Collision |
66 | | otherwise = NoCollision | 64 | | 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 | |||
9 | ) | 9 | ) |
10 | where | 10 | where |
11 | 11 | ||
12 | 12 | ||
13 | import Spear.Math.Vector3 as Vector | ||
14 | import Spear.Collision.AABB as Box | ||
15 | import Spear.Collision.Sphere as Sphere | ||
16 | import Spear.Collision.Collision as C | 13 | import Spear.Collision.Collision as C |
17 | import Spear.Collision.Types | 14 | import Spear.Collision.Types |
15 | import Spear.Math.AABB | ||
16 | import Spear.Math.Sphere | ||
17 | import Spear.Math.Vector3 | ||
18 | 18 | ||
19 | 19 | ||
20 | -- | A collisioner component. | 20 | -- | A collisioner component. |
@@ -41,7 +41,7 @@ buildAABB cols = aabb $ Spear.Collision.Collisioner.generatePoints cols | |||
41 | 41 | ||
42 | 42 | ||
43 | -- | Create the minimal 'AABB' collisioner fully containing the specified 'BSphere'. | 43 | -- | Create the minimal 'AABB' collisioner fully containing the specified 'BSphere'. |
44 | boxFromSphere :: Sphere.Sphere -> Collisioner | 44 | boxFromSphere :: Sphere -> Collisioner |
45 | boxFromSphere = AABBCol . aabbFromSphere | 45 | boxFromSphere = AABBCol . aabbFromSphere |
46 | 46 | ||
47 | 47 | ||
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 | |||
2 | where | 2 | where |
3 | 3 | ||
4 | -- | Encodes several collision situations. | 4 | -- | Encodes several collision situations. |
5 | data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy | Equal | 5 | data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy |
6 | deriving (Eq, Ord, Show) | 6 | deriving (Eq, Show) |
diff --git a/Spear/Collision/AABB.hs b/Spear/Math/AABB.hs index 2676af0..362ddd6 100644 --- a/Spear/Collision/AABB.hs +++ b/Spear/Math/AABB.hs | |||
@@ -1,8 +1,8 @@ | |||
1 | module Spear.Collision.AABB | 1 | module Spear.Math.AABB |
2 | ( | 2 | ( |
3 | AABB(..) | 3 | AABB(..) |
4 | , aabb | 4 | , aabb |
5 | , contains | 5 | , aabbpt |
6 | ) | 6 | ) |
7 | where | 7 | where |
8 | 8 | ||
@@ -11,11 +11,7 @@ import Spear.Math.Vector3 as Vector | |||
11 | 11 | ||
12 | 12 | ||
13 | -- | An axis-aligned bounding box. | 13 | -- | An axis-aligned bounding box. |
14 | data AABB = AABB | 14 | data AABB = AABB {-# UNPACK #-} !Vector3 {-# UNPACK #-} !Vector3 |
15 | { min :: !Vector3 | ||
16 | , max :: !Vector3 | ||
17 | } | ||
18 | deriving Eq | ||
19 | 15 | ||
20 | 16 | ||
21 | -- | Create a 'AABB' from the given points. | 17 | -- | Create a 'AABB' from the given points. |
@@ -28,5 +24,5 @@ aabb (x:xs) = foldr update (AABB x x) xs | |||
28 | 24 | ||
29 | 25 | ||
30 | -- | Return 'True' if the given 'AABB' contains the given point, 'False' otherwise. | 26 | -- | Return 'True' if the given 'AABB' contains the given point, 'False' otherwise. |
31 | contains :: AABB -> Vector3 -> Bool | 27 | aabbpt :: AABB -> Vector3 -> Bool |
32 | (AABB min max) `contains` v = v >= min && v <= max | 28 | (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 | |||
42 | 42 | ||
43 | -- | Represents a 3x3 column major matrix. | 43 | -- | Represents a 3x3 column major matrix. |
44 | data Matrix3 = Matrix3 | 44 | data Matrix3 = Matrix3 |
45 | { m00 :: !Float, m10 :: !Float, m20 :: !Float | 45 | { m00 :: {-# UNPACK #-} !Float, m10 :: {-# UNPACK #-} !Float, m20 :: {-# UNPACK #-} !Float |
46 | , m01 :: !Float, m11 :: !Float, m21 :: !Float | 46 | , m01 :: {-# UNPACK #-} !Float, m11 :: {-# UNPACK #-} !Float, m21 :: {-# UNPACK #-} !Float |
47 | , m02 :: !Float, m12 :: !Float, m22 :: !Float | 47 | , m02 :: {-# UNPACK #-} !Float, m12 :: {-# UNPACK #-} !Float, m22 :: {-# UNPACK #-} !Float |
48 | } | 48 | } |
49 | 49 | ||
50 | 50 | ||
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 | |||
54 | 54 | ||
55 | -- | Represents a 4x4 column major matrix. | 55 | -- | Represents a 4x4 column major matrix. |
56 | data Matrix4 = Matrix4 | 56 | data Matrix4 = Matrix4 |
57 | { m00 :: !Float, m10 :: !Float, m20 :: !Float, m30 :: !Float | 57 | { m00 :: {-# UNPACK #-} !Float, m10 :: {-# UNPACK #-} !Float, m20 :: {-# UNPACK #-} !Float, m30 :: {-# UNPACK #-} !Float |
58 | , m01 :: !Float, m11 :: !Float, m21 :: !Float, m31 :: !Float | 58 | , m01 :: {-# UNPACK #-} !Float, m11 :: {-# UNPACK #-} !Float, m21 :: {-# UNPACK #-} !Float, m31 :: {-# UNPACK #-} !Float |
59 | , m02 :: !Float, m12 :: !Float, m22 :: !Float, m32 :: !Float | 59 | , m02 :: {-# UNPACK #-} !Float, m12 :: {-# UNPACK #-} !Float, m22 :: {-# UNPACK #-} !Float, m32 :: {-# UNPACK #-} !Float |
60 | , m03 :: !Float, m13 :: !Float, m23 :: !Float, m33 :: !Float | 60 | , m03 :: {-# UNPACK #-} !Float, m13 :: {-# UNPACK #-} !Float, m23 :: {-# UNPACK #-} !Float, m33 :: {-# UNPACK #-} !Float |
61 | } | 61 | } |
62 | 62 | ||
63 | 63 | ||
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 | |||
11 | ) | 11 | ) |
12 | where | 12 | where |
13 | 13 | ||
14 | import Spear.Collision.AABB as AABB | ||
15 | import Spear.Collision.Types | 14 | import Spear.Collision.Types |
16 | import Spear.Math.Vector3 as Vector | 15 | import Spear.Math.AABB |
16 | import Spear.Math.Vector3 | ||
17 | 17 | ||
18 | import Control.Applicative ((<*>)) | 18 | import Control.Applicative ((<*>)) |
19 | import Data.List | 19 | 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 | |||
93 | 93 | ||
94 | 94 | ||
95 | keep :: (e -> AABB -> CollisionType) -> AABB -> e -> Bool | 95 | keep :: (e -> AABB -> CollisionType) -> AABB -> e -> Bool |
96 | keep testAABB aabb e = test == FullyContainedBy || test == Equal | 96 | keep testAABB aabb e = test == FullyContainedBy |
97 | where test = e `testAABB` aabb | 97 | where test = e `testAABB` aabb |
98 | 98 | ||
99 | 99 | ||
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 @@ | |||
1 | module Spear.Math.Plane | 1 | module Spear.Math.Plane |
2 | ( | 2 | ( |
3 | Plane | 3 | Plane |
4 | , plane | 4 | , plane |
5 | , classify | 5 | , classify |
6 | ) | 6 | ) |
7 | where | 7 | where |
8 | 8 | ||
@@ -13,21 +13,22 @@ import Spear.Math.Vector3 as Vector | |||
13 | data PointPlanePos = Front | Back | Contained deriving (Eq, Ord, Show) | 13 | data PointPlanePos = Front | Back | Contained deriving (Eq, Ord, Show) |
14 | 14 | ||
15 | 15 | ||
16 | data Plane = Plane { | 16 | data Plane = Plane |
17 | n :: !Vector3, | 17 | { n :: {-# UNPACK #-} !Vector3, |
18 | d :: !Float | 18 | d :: {-# UNPACK #-} !Float |
19 | } deriving(Eq, Show) | 19 | } |
20 | deriving(Eq, Show) | ||
20 | 21 | ||
21 | 22 | ||
22 | -- | Create a plane given a normal vector and a distance from the origin. | 23 | -- | Create a plane given a normal vector and a distance from the origin. |
23 | plane :: Vector3 -> Float -> Plane | 24 | plane :: Vector3 -> Float -> Plane |
24 | plane n d = Plane (normalise n) d | 25 | plane n d = Plane (normalise n) d |
25 | 26 | ||
26 | 27 | ||
27 | -- | Classify the given point's relative position with respect to the given plane. | 28 | -- | Classify the given point's relative position with respect to the given plane. |
28 | classify :: Plane -> Vector3 -> PointPlanePos | 29 | classify :: Plane -> Vector3 -> PointPlanePos |
29 | classify (Plane n d) pt = case (n `dot` pt - d) `compare` 0 of | 30 | classify (Plane n d) pt = |
30 | GT -> Front | 31 | case (n `dot` pt - d) `compare` 0 of |
31 | LT -> Back | 32 | GT -> Front |
32 | EQ -> Contained | 33 | LT -> Back |
33 | \ No newline at end of file | 34 | EQ -> Contained |
diff --git a/Spear/Collision/Sphere.hs b/Spear/Math/Sphere.hs index de670bc..4a9e3fc 100644 --- a/Spear/Collision/Sphere.hs +++ b/Spear/Math/Sphere.hs | |||
@@ -1,8 +1,8 @@ | |||
1 | module Spear.Collision.Sphere | 1 | module Spear.Math.Sphere |
2 | ( | 2 | ( |
3 | Sphere(..) | 3 | Sphere(..) |
4 | , sphere | 4 | , sphere |
5 | , contains | 5 | , spherept |
6 | ) | 6 | ) |
7 | where | 7 | where |
8 | 8 | ||
@@ -12,10 +12,9 @@ import Spear.Math.Vector3 as Vector | |||
12 | 12 | ||
13 | -- | A bounding volume. | 13 | -- | A bounding volume. |
14 | data Sphere = Sphere | 14 | data Sphere = Sphere |
15 | { center :: !Vector3 | 15 | { center :: {-# UNPACK #-} !Vector3 |
16 | , radius :: !Float | 16 | , radius :: {-# UNPACK #-} !Float |
17 | } | 17 | } |
18 | deriving Eq | ||
19 | 18 | ||
20 | 19 | ||
21 | -- | Create a 'Sphere' from the given points. | 20 | -- | Create a 'Sphere' from the given points. |
@@ -32,5 +31,5 @@ sphere (x:xs) = Sphere c r | |||
32 | 31 | ||
33 | 32 | ||
34 | -- | Return 'True' if the given 'Sphere' contains the given point, 'False' otherwise. | 33 | -- | Return 'True' if the given 'Sphere' contains the given point, 'False' otherwise. |
35 | contains :: Sphere -> Vector3 -> Bool | 34 | spherept :: Sphere -> Vector3 -> Bool |
36 | (Sphere center radius) `contains` p = radius*radius >= normSq (p - center) | 35 | (Sphere center radius) `spherept` p = radius*radius >= normSq (p - center) |
diff --git a/Spear/Collision/Triangle.hs b/Spear/Math/Triangle.hs index 2391e9f..3c30ea6 100644 --- a/Spear/Collision/Triangle.hs +++ b/Spear/Math/Triangle.hs | |||
@@ -1,4 +1,4 @@ | |||
1 | module Spear.Collision.Triangle | 1 | module Spear.Math.Triangle |
2 | ( | 2 | ( |
3 | Triangle(..) | 3 | Triangle(..) |
4 | ) | 4 | ) |
@@ -12,9 +12,9 @@ import Foreign.Storable | |||
12 | 12 | ||
13 | 13 | ||
14 | data Triangle = Triangle | 14 | data Triangle = Triangle |
15 | { p0 :: Vector3 | 15 | { p0 :: {-# UNPACK #-} !Vector3 |
16 | , p1 :: Vector3 | 16 | , p1 :: {-# UNPACK #-} !Vector3 |
17 | , p2 :: Vector3 | 17 | , p2 :: {-# UNPACK #-} !Vector3 |
18 | } | 18 | } |
19 | 19 | ||
20 | 20 | ||
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 @@ | |||
1 | module Spear.Math.Vector2 | ||
2 | ( | ||
3 | Vector2 | ||
4 | -- * Accessors | ||
5 | , x | ||
6 | , y | ||
7 | -- * Construction | ||
8 | , unitx | ||
9 | , unity | ||
10 | , zero | ||
11 | , fromList | ||
12 | , vec2 | ||
13 | -- * Operations | ||
14 | , v2min | ||
15 | , v2max | ||
16 | , dot | ||
17 | , normSq | ||
18 | , norm | ||
19 | , scale | ||
20 | , normalise | ||
21 | , neg | ||
22 | , perp | ||
23 | ) | ||
24 | where | ||
25 | |||
26 | import Foreign.C.Types (CFloat) | ||
27 | import Foreign.Storable | ||
28 | |||
29 | |||
30 | -- | Represents a vector in 2D. | ||
31 | data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) | ||
32 | |||
33 | |||
34 | instance Num Vector2 where | ||
35 | Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) | ||
36 | Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) | ||
37 | Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) | ||
38 | abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay) | ||
39 | signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay) | ||
40 | fromInteger i = Vector2 i' i' where i' = fromInteger i | ||
41 | |||
42 | |||
43 | instance Fractional Vector2 where | ||
44 | Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) | ||
45 | fromRational r = Vector2 r' r' where r' = fromRational r | ||
46 | |||
47 | |||
48 | instance Ord Vector2 where | ||
49 | Vector2 ax ay <= Vector2 bx by = (ax <= bx) || (ax == bx && ay <= by) | ||
50 | Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by) | ||
51 | Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by) | ||
52 | Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by) | ||
53 | |||
54 | |||
55 | sizeFloat = sizeOf (undefined :: CFloat) | ||
56 | |||
57 | |||
58 | instance Storable Vector2 where | ||
59 | sizeOf _ = 2*sizeFloat | ||
60 | alignment _ = alignment (undefined :: CFloat) | ||
61 | |||
62 | peek ptr = do | ||
63 | ax <- peekByteOff ptr 0 | ||
64 | ay <- peekByteOff ptr $ sizeFloat | ||
65 | return (Vector2 ax ay) | ||
66 | |||
67 | poke ptr (Vector2 ax ay) = do | ||
68 | pokeByteOff ptr 0 ax | ||
69 | pokeByteOff ptr sizeFloat ay | ||
70 | |||
71 | |||
72 | -- | Get the vector's x coordinate. | ||
73 | x (Vector2 ax _) = ax | ||
74 | |||
75 | |||
76 | -- | Get the vector's y coordinate. | ||
77 | y (Vector2 _ ay) = ay | ||
78 | |||
79 | |||
80 | -- | Unit vector along the X axis. | ||
81 | unitx :: Vector2 | ||
82 | unitx = Vector2 1 0 | ||
83 | |||
84 | |||
85 | -- | Unit vector along the Y axis. | ||
86 | unity :: Vector2 | ||
87 | unity = Vector2 0 1 | ||
88 | |||
89 | |||
90 | -- | Zero vector. | ||
91 | zero :: Vector2 | ||
92 | zero = Vector2 0 0 | ||
93 | |||
94 | |||
95 | -- | Create a vector from the given list. | ||
96 | fromList :: [Float] -> Vector2 | ||
97 | fromList (ax:ay:_) = Vector2 ax ay | ||
98 | |||
99 | |||
100 | -- | Create a vector from the given values. | ||
101 | vec2 :: Float -> Float -> Vector2 | ||
102 | vec2 ax ay = Vector2 ax ay | ||
103 | |||
104 | |||
105 | -- | Create a vector with components set to the minimum of each of the given vectors'. | ||
106 | v2min :: Vector2 -> Vector2 -> Vector2 | ||
107 | v2min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by) | ||
108 | |||
109 | |||
110 | -- | Create a vector with components set to the maximum of each of the given vectors'. | ||
111 | v2max :: Vector2 -> Vector2 -> Vector2 | ||
112 | v2max (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.max ax bx) (Prelude.max ay by) | ||
113 | |||
114 | |||
115 | -- | Compute the given vectors' dot product. | ||
116 | dot :: Vector2 -> Vector2 -> Float | ||
117 | Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by | ||
118 | |||
119 | |||
120 | -- | Compute the given vector's squared norm. | ||
121 | normSq :: Vector2 -> Float | ||
122 | normSq (Vector2 ax ay) = ax*ax + ay*ay | ||
123 | |||
124 | |||
125 | -- | Compute the given vector's norm. | ||
126 | norm :: Vector2 -> Float | ||
127 | norm = sqrt . normSq | ||
128 | |||
129 | |||
130 | -- | Multiply the given vector with the given scalar. | ||
131 | scale :: Float -> Vector2 -> Vector2 | ||
132 | scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay) | ||
133 | |||
134 | |||
135 | -- | Normalise the given vector. | ||
136 | normalise :: Vector2 -> Vector2 | ||
137 | normalise v = | ||
138 | let n' = norm v | ||
139 | n = if n' == 0 then 1 else n' | ||
140 | in | ||
141 | scale (1.0 / n) v | ||
142 | |||
143 | |||
144 | -- | Negate the given vector. | ||
145 | neg :: Vector2 -> Vector2 | ||
146 | neg (Vector2 ax ay) = Vector2 (-ax) (-ay) | ||
147 | |||
148 | |||
149 | -- | Compute a vector perpendicular to the given one, satisfying: | ||
150 | -- | ||
151 | -- perp (Vector2 0 1) = Vector2 1 0 | ||
152 | -- | ||
153 | -- perp (Vector2 1 0) = Vector2 0 (-1) | ||
154 | perp :: Vector2 -> Vector2 | ||
155 | 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 | |||
16 | -- * Operations | 16 | -- * Operations |
17 | , Spear.Math.Vector3.min | 17 | , Spear.Math.Vector3.min |
18 | , Spear.Math.Vector3.max | 18 | , Spear.Math.Vector3.max |
19 | , Spear.Math.Vector3.zipWith | ||
20 | , Spear.Math.Vector3.map | ||
21 | , dot | 19 | , dot |
22 | , cross | 20 | , cross |
23 | , normSq | 21 | , normSq |
@@ -33,7 +31,11 @@ import Foreign.Storable | |||
33 | 31 | ||
34 | 32 | ||
35 | -- | Represents a vector in 3D. | 33 | -- | Represents a vector in 3D. |
36 | data Vector3 = Vector3 !Float !Float !Float deriving (Eq, Show) | 34 | data Vector3 = Vector3 |
35 | {-# UNPACK #-} !Float | ||
36 | {-# UNPACK #-} !Float | ||
37 | {-# UNPACK #-} !Float | ||
38 | deriving (Eq, Show) | ||
37 | 39 | ||
38 | 40 | ||
39 | instance Num Vector3 where | 41 | instance Num Vector3 where |
@@ -89,8 +91,8 @@ instance Storable Vector3 where | |||
89 | pokeByteOff ptr 0 ax | 91 | pokeByteOff ptr 0 ax |
90 | pokeByteOff ptr (1*sizeFloat) ay | 92 | pokeByteOff ptr (1*sizeFloat) ay |
91 | pokeByteOff ptr (2*sizeFloat) az | 93 | pokeByteOff ptr (2*sizeFloat) az |
92 | 94 | ||
93 | 95 | ||
94 | x (Vector3 ax _ _ ) = ax | 96 | x (Vector3 ax _ _ ) = ax |
95 | y (Vector3 _ ay _ ) = ay | 97 | y (Vector3 _ ay _ ) = ay |
96 | z (Vector3 _ _ az) = az | 98 | z (Vector3 _ _ az) = az |
@@ -157,26 +159,6 @@ max :: Vector3 -> Vector3 -> Vector3 | |||
157 | max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) | 159 | max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) |
158 | 160 | ||
159 | 161 | ||
160 | -- | Zip two vectors with the given function. | ||
161 | zipWith :: (Float -> Float -> Float) -> Vector3 -> Vector3 -> Vector3 | ||
162 | zipWith f (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (f ax bx) (f ay by) (f az bz) | ||
163 | |||
164 | |||
165 | -- | Folds a vector from the left. | ||
166 | {-foldl :: (UV.Unbox b) => (a -> b -> a) -> a -> Vector3 b -> a | ||
167 | foldl f acc (Vector3 v) = UV.foldl f acc v | ||
168 | |||
169 | |||
170 | -- | Folds a vector from the right. | ||
171 | foldr :: (UV.Unbox b) => (b -> a -> a) -> a -> Vector3 b -> a | ||
172 | foldr f acc (Vector3 v) = UV.foldr f acc v-} | ||
173 | |||
174 | |||
175 | -- | Map the given function over the given vector. | ||
176 | map :: (Float -> Float) -> Vector3 -> Vector3 | ||
177 | map f (Vector3 ax ay az) = Vector3 (f ax) (f ay) (f az) | ||
178 | |||
179 | |||
180 | -- | Compute the given vectors' dot product. | 162 | -- | Compute the given vectors' dot product. |
181 | dot :: Vector3 -> Vector3 -> Float | 163 | dot :: Vector3 -> Vector3 -> Float |
182 | Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz | 164 | 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 | |||
15 | -- * Operations | 15 | -- * Operations |
16 | , Spear.Math.Vector4.min | 16 | , Spear.Math.Vector4.min |
17 | , Spear.Math.Vector4.max | 17 | , Spear.Math.Vector4.max |
18 | , Spear.Math.Vector4.zipWith | ||
19 | , Spear.Math.Vector4.map | ||
20 | , dot | 18 | , dot |
21 | , normSq | 19 | , normSq |
22 | , norm | 20 | , norm |
@@ -32,7 +30,12 @@ import Foreign.Storable | |||
32 | 30 | ||
33 | 31 | ||
34 | -- | Represents a vector in 3D. | 32 | -- | Represents a vector in 3D. |
35 | data Vector4 = Vector4 !Float !Float !Float !Float deriving (Eq, Show) | 33 | data Vector4 = Vector4 |
34 | {-# UNPACK #-} !Float | ||
35 | {-# UNPACK #-} !Float | ||
36 | {-# UNPACK #-} !Float | ||
37 | {-# UNPACK #-} !Float | ||
38 | deriving (Eq, Show) | ||
36 | 39 | ||
37 | 40 | ||
38 | instance Num Vector4 where | 41 | instance Num Vector4 where |
@@ -94,8 +97,8 @@ instance Storable Vector4 where | |||
94 | pokeByteOff ptr (1 * sizeFloat) ay | 97 | pokeByteOff ptr (1 * sizeFloat) ay |
95 | pokeByteOff ptr (2 * sizeFloat) az | 98 | pokeByteOff ptr (2 * sizeFloat) az |
96 | pokeByteOff ptr (3 * sizeFloat) aw | 99 | pokeByteOff ptr (3 * sizeFloat) aw |
97 | 100 | ||
98 | 101 | ||
99 | x (Vector4 ax _ _ _ ) = ax | 102 | x (Vector4 ax _ _ _ ) = ax |
100 | y (Vector4 _ ay _ _ ) = ay | 103 | y (Vector4 _ ay _ _ ) = ay |
101 | z (Vector4 _ _ az _ ) = az | 104 | z (Vector4 _ _ az _ ) = az |
@@ -139,26 +142,6 @@ max (Vector4 ax ay az aw) (Vector4 bx by bz bw) = | |||
139 | Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw) | 142 | Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw) |
140 | 143 | ||
141 | 144 | ||
142 | -- | Zip two vectors with the given function. | ||
143 | zipWith :: (Float -> Float -> Float) -> Vector4 -> Vector4 -> Vector4 | ||
144 | 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) | ||
145 | |||
146 | |||
147 | -- | Folds a vector from the left. | ||
148 | {-foldl :: (UV.Unbox b) => (a -> b -> a) -> a -> Vector4 b -> a | ||
149 | foldl f acc (Vector4 v) = UV.foldl f acc v | ||
150 | |||
151 | |||
152 | -- | Folds a vector from the right. | ||
153 | foldr :: (UV.Unbox b) => (b -> a -> a) -> a -> Vector4 b -> a | ||
154 | foldr f acc (Vector4 v) = UV.foldr f acc v-} | ||
155 | |||
156 | |||
157 | -- | Map the given function over the given vector. | ||
158 | map :: (Float -> Float) -> Vector4 -> Vector4 | ||
159 | map f (Vector4 ax ay az aw) = Vector4 (f ax) (f ay) (f az) (f aw) | ||
160 | |||
161 | |||
162 | -- | Compute the given vectors' dot product. | 145 | -- | Compute the given vectors' dot product. |
163 | dot :: Vector4 -> Vector4 -> Float | 146 | dot :: Vector4 -> Vector4 -> Float |
164 | Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw | 147 | 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 | |||
2 | ( | 2 | ( |
3 | module Spear.Physics.Rigid | 3 | module Spear.Physics.Rigid |
4 | , module Spear.Physics.Types | 4 | , module Spear.Physics.Types |
5 | , module Spear.Physics.World | ||
6 | ) | 5 | ) |
7 | where | 6 | where |
8 | 7 | ||
9 | 8 | ||
10 | import Spear.Physics.Rigid | 9 | import Spear.Physics.Rigid |
11 | import Spear.Physics.Types | 10 | import Spear.Physics.Types |
12 | 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 | |||
20 | 20 | ||
21 | 21 | ||
22 | data RigidBody = RigidBody | 22 | data RigidBody = RigidBody |
23 | { mass :: Float | 23 | { mass :: !Float |
24 | , position :: Vector3 | 24 | , position :: !Vector3 |
25 | , velocity :: Vector3 | 25 | , velocity :: !Vector3 |
26 | , acceleration :: Vector3 | 26 | , acceleration :: !Vector3 |
27 | } | 27 | } |
28 | 28 | ||
29 | 29 | ||
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 @@ | |||
1 | module Spear.Physics.World | ||
2 | ( | ||
3 | module Spear.Physics.Types | ||
4 | -- * Data types | ||
5 | , World | ||
6 | , ObjectID | ||
7 | -- * Construction | ||
8 | , emptyWorld | ||
9 | -- * World operations | ||
10 | , setGravity | ||
11 | , updateWorld | ||
12 | -- * Object operations | ||
13 | , newObject | ||
14 | , deleteObject | ||
15 | , withBody | ||
16 | , objectTransform | ||
17 | , setForces | ||
18 | ) | ||
19 | where | ||
20 | |||
21 | |||
22 | import Spear.Collision.AABB | ||
23 | import Spear.Collision.Collisioner as C | ||
24 | import Spear.Collision.Sphere | ||
25 | import Spear.Math.Matrix4 (Matrix4) | ||
26 | import Spear.Math.Spatial | ||
27 | import Spear.Math.Vector3 | ||
28 | import Spear.Physics.Rigid as Rigid | ||
29 | import Spear.Physics.Types | ||
30 | import Spear.Sys.Store | ||
31 | |||
32 | |||
33 | import Data.Maybe (fromJust) | ||
34 | |||
35 | |||
36 | -- | Uniquely identifies an object in a 'World'. | ||
37 | newtype ObjectID = ObjectID Int | ||
38 | |||
39 | |||
40 | data Object = Object | ||
41 | { body :: RigidBody | ||
42 | , collisioner :: Collisioner | ||
43 | , forces :: [Vector3] | ||
44 | } | ||
45 | |||
46 | |||
47 | -- | The world where physical bodies are simulated. | ||
48 | data World = World | ||
49 | { bodies :: Store Object -- ^ Collection of objects. | ||
50 | , gravity :: Vector3 -- ^ World gravity. | ||
51 | } | ||
52 | |||
53 | |||
54 | -- | Create an empty world. | ||
55 | emptyWorld :: World | ||
56 | emptyWorld = World emptyStore $ vec3 0 (-9.8) 0 | ||
57 | |||
58 | |||
59 | -- | Create a new object. | ||
60 | newObject :: RigidBody -> Collisioner -> World -> (ObjectID, World) | ||
61 | newObject body collisioner world = | ||
62 | let (index, bodies') = store (Object body collisioner []) $ bodies world | ||
63 | in (ObjectID index, world { bodies = bodies' }) | ||
64 | |||
65 | |||
66 | -- | Remove the object specified by the given object ID. | ||
67 | deleteObject :: ObjectID -> World -> World | ||
68 | deleteObject (ObjectID i) world = world { bodies = bodies' } | ||
69 | where | ||
70 | bodies' = storeFree i $ bodies world | ||
71 | |||
72 | |||
73 | -- | Modify the object identified by the given object ID. | ||
74 | withBody :: ObjectID -> World -> (RigidBody -> RigidBody) -> World | ||
75 | withBody (ObjectID index) world f = world { bodies = bodies' } | ||
76 | where | ||
77 | bodies' = withElement index (bodies world) $ \obj -> obj { body = f $ body obj } | ||
78 | |||
79 | |||
80 | -- | Get the transform of the object identified by the given object ID. | ||
81 | objectTransform :: World -> ObjectID -> Matrix4 | ||
82 | objectTransform world (ObjectID i) = transform . body . fromJust $ (element i $ bodies world) | ||
83 | |||
84 | |||
85 | -- | Add the given force to the forces acting on the object identified by the given object ID. | ||
86 | setForces :: [Force] -> ObjectID -> World -> World | ||
87 | setForces fs (ObjectID i) world = world { bodies = bodies' } | ||
88 | where | ||
89 | bodies' = withElement i (bodies world) $ \obj -> obj { forces = fs } | ||
90 | |||
91 | |||
92 | -- | Set the world's gravity. | ||
93 | setGravity :: Vector3 -> World -> World | ||
94 | setGravity g world = world { gravity = g } | ||
95 | |||
96 | |||
97 | -- | Update the world. | ||
98 | updateWorld :: Dt -> World -> World | ||
99 | updateWorld dt world = world { bodies = fmap updateObject $ bodies world } | ||
100 | where | ||
101 | updateObject (Object body collisioner forces) = Object body' collisioner' forces | ||
102 | where | ||
103 | -- Forces acting on the body. | ||
104 | forces' = scale (mass body) (gravity world) : forces | ||
105 | |||
106 | -- Updated body. | ||
107 | body' = Rigid.update forces dt body | ||
108 | |||
109 | -- Center collisioner around the new body's center. | ||
110 | collisioner' = center (Rigid.position body') collisioner | ||
111 | |||
112 | -- Center the collisioner around the given point. | ||
113 | center c (SphereCol (Sphere _ r)) = sphereCollisioner $ Sphere c r | ||
114 | center c (AABBCol (AABB min max)) = | ||
115 | let v = (max - min) / 2 | ||
116 | min' = c - v | ||
117 | max' = c + v | ||
118 | in | ||
119 | aabbCollisioner $ AABB min' max' | ||
120 | |||
121 | |||
122 | {--- | Test for potential collisions. | ||
123 | -- | ||
124 | -- Returns a new world and a list of colliding pairs of objects. | ||
125 | --testCollisions :: World -> (World, [(ObjectID, ObjectID)])-} | ||
126 | |||
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 | |||
21 | where | 21 | where |
22 | 22 | ||
23 | 23 | ||
24 | import Spear.Collision.AABB | ||
25 | import Spear.Collision.Types | 24 | import Spear.Collision.Types |
26 | import Spear.Game (Game) | 25 | import Spear.Game (Game) |
26 | import Spear.Math.AABB | ||
27 | import Spear.Math.Octree as Octree | 27 | import Spear.Math.Octree as Octree |
28 | 28 | ||
29 | import Control.Applicative ((<*>)) | 29 | import Control.Applicative ((<*>)) |
@@ -35,12 +35,12 @@ import qualified Data.List as L (delete, filter, find) | |||
35 | 35 | ||
36 | data Scene obj = | 36 | data Scene obj = |
37 | ListScene | 37 | ListScene |
38 | { objects :: [obj] | 38 | { objects :: ![obj] |
39 | } | 39 | } |
40 | | | 40 | | |
41 | OctreeScene | 41 | OctreeScene |
42 | { collideAABB :: obj -> AABB -> CollisionType | 42 | { collideAABB :: obj -> AABB -> CollisionType |
43 | , world :: Octree obj | 43 | , world :: !(Octree obj) |
44 | } | 44 | } |
45 | 45 | ||
46 | 46 | ||
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 | |||
13 | 13 | ||
14 | 14 | ||
15 | import Control.Monad.Error | 15 | import Control.Monad.Error |
16 | import qualified Control.Monad.Resource as R | 16 | import qualified Control.Monad.Trans.Resource as R |
17 | import qualified Control.Monad.Trans.Class as MT (lift) | 17 | import qualified Control.Monad.Trans.Class as MT (lift) |
18 | 18 | ||
19 | 19 | ||