diff options
author | Marc Sunet <jeannekamikaze@gmail.com> | 2012-08-06 13:25:57 +0200 |
---|---|---|
committer | Marc Sunet <jeannekamikaze@gmail.com> | 2012-08-06 13:25:57 +0200 |
commit | 134f9d6cf39cf3e7d3d405fd268a85b55442cc3b (patch) | |
tree | 7dcd00e77d98a4e29639bfb0a9a46d24430fda68 | |
parent | 4d622a038f7a4e34a3252843aacfa70fd072f502 (diff) |
Added physics module
-rw-r--r-- | Spear.cabal | 131 | ||||
-rw-r--r-- | Spear.lkshs | 12 | ||||
-rw-r--r-- | Spear.lkshw | 2 | ||||
-rw-r--r-- | Spear/Physics.hs | 12 | ||||
-rw-r--r-- | Spear/Physics/Rigid.hs | 122 | ||||
-rw-r--r-- | Spear/Physics/Types.hs | 11 | ||||
-rw-r--r-- | Spear/Physics/World.hs | 177 |
7 files changed, 364 insertions, 103 deletions
diff --git a/Spear.cabal b/Spear.cabal index ab8f6b9..dc462ae 100644 --- a/Spear.cabal +++ b/Spear.cabal | |||
@@ -7,7 +7,6 @@ license-file: LICENSE | |||
7 | maintainer: jeannekamikaze@gmail.com | 7 | maintainer: jeannekamikaze@gmail.com |
8 | homepage: http://spear.shellblade.net | 8 | homepage: http://spear.shellblade.net |
9 | synopsis: A 3D game framework. | 9 | synopsis: A 3D game framework. |
10 | description: | ||
11 | category: Game | 10 | category: Game |
12 | author: Marc Sunet | 11 | author: Marc Sunet |
13 | data-dir: "" | 12 | data-dir: "" |
@@ -15,106 +14,46 @@ data-dir: "" | |||
15 | library | 14 | library |
16 | build-depends: GLFW -any, OpenGL -any, OpenGLRaw -any, | 15 | build-depends: GLFW -any, OpenGL -any, OpenGLRaw -any, |
17 | StateVar -any, base -any, bytestring -any, directory -any, | 16 | StateVar -any, base -any, bytestring -any, directory -any, |
18 | mtl -any, transformers -any, resource-simple -any, parsec >= 3.1.3, containers, | 17 | mtl -any, transformers -any, resource-simple -any, parsec >=3.1.3, |
19 | ansi-terminal, vector | 18 | containers -any, ansi-terminal -any, vector -any, array -any |
20 | 19 | exposed-modules: Spear.Physics.Types Spear.Physics.World Spear.App | |
21 | exposed-modules: | 20 | Spear.App.Application Spear.App.Input Spear.Assets.Image |
22 | Spear.App | 21 | Spear.Assets.Model Spear.Collision Spear.Collision.AABB |
23 | Spear.App.Application | 22 | Spear.Collision.Collision Spear.Collision.Collisioner |
24 | Spear.App.Input | 23 | Spear.Collision.Sphere Spear.Collision.Triangle |
25 | 24 | Spear.Collision.Types Spear.Game Spear.GLSL Spear.GLSL.Buffer | |
26 | Spear.Assets.Image | 25 | Spear.GLSL.Error Spear.GLSL.Management Spear.GLSL.Texture |
27 | Spear.Assets.Model | 26 | Spear.GLSL.Uniform Spear.GLSL.VAO Spear.Math.Camera |
28 | 27 | Spear.Math.Entity Spear.Math.Matrix3 Spear.Math.Matrix4 | |
29 | Spear.Collision | 28 | Spear.Math.MatrixUtils Spear.Math.Octree Spear.Math.Plane |
30 | Spear.Collision.AABB | 29 | Spear.Math.Quaternion Spear.Math.Spatial Spear.Math.Vector3 |
31 | Spear.Collision.Collision | 30 | Spear.Math.Vector4 Spear.Physics Spear.Physics.Rigid |
32 | Spear.Collision.Collisioner | ||
33 | Spear.Collision.Sphere | ||
34 | Spear.Collision.Triangle | ||
35 | Spear.Collision.Types | ||
36 | |||
37 | Spear.Game | ||
38 | |||
39 | Spear.GLSL | ||
40 | Spear.GLSL.Buffer | ||
41 | Spear.GLSL.Error | ||
42 | Spear.GLSL.Management | ||
43 | Spear.GLSL.Texture | ||
44 | Spear.GLSL.Uniform | ||
45 | Spear.GLSL.VAO | ||
46 | |||
47 | Spear.Math.Camera | ||
48 | Spear.Math.Entity | ||
49 | Spear.Math.Matrix3 | ||
50 | Spear.Math.Matrix4 | ||
51 | Spear.Math.MatrixUtils | ||
52 | Spear.Math.Octree | ||
53 | Spear.Math.Plane | ||
54 | Spear.Math.Spatial | ||
55 | Spear.Math.Vector3 | ||
56 | Spear.Math.Vector4 | ||
57 | |||
58 | Spear.Render.AnimatedModel | 31 | Spear.Render.AnimatedModel |
59 | Spear.Render.Material | 32 | Spear.Render.Material Spear.Render.Model Spear.Render.Program |
60 | Spear.Render.Model | 33 | Spear.Render.Renderable Spear.Render.StaticModel |
61 | Spear.Render.Program | 34 | Spear.Render.Texture Spear.Scene.Graph Spear.Scene.Light |
62 | Spear.Render.Renderable | 35 | Spear.Scene.Loader Spear.Scene.Scene Spear.Scene.SceneResources |
63 | Spear.Render.StaticModel | 36 | Spear.Setup Spear.Sys.Timer Spear.Updatable |
64 | Spear.Render.Texture | ||
65 | |||
66 | Spear.Scene.Graph | ||
67 | Spear.Scene.Light | ||
68 | Spear.Scene.Loader | ||
69 | Spear.Scene.Scene | ||
70 | Spear.Scene.SceneResources | ||
71 | |||
72 | Spear.Setup | ||
73 | |||
74 | Spear.Sys.Timer | ||
75 | |||
76 | Spear.Updatable | ||
77 | exposed: True | 37 | exposed: True |
78 | |||
79 | buildable: True | 38 | buildable: True |
80 | |||
81 | build-tools: hsc2hs -any | 39 | build-tools: hsc2hs -any |
82 | 40 | cc-options: -O2 -g -Wno-unused-result | |
83 | c-sources: | 41 | c-sources: Spear/Assets/Image/Image.c |
84 | Spear/Assets/Image/Image.c | 42 | Spear/Assets/Image/BMP/BMP_load.c Spear/Assets/Model/Model.c |
85 | Spear/Assets/Image/BMP/BMP_load.c | 43 | Spear/Assets/Model/MD2/MD2_load.c |
86 | Spear/Assets/Model/Model.c | 44 | Spear/Assets/Model/OBJ/OBJ_load.cc Spear/Render/RenderModel.c |
87 | Spear/Assets/Model/MD2/MD2_load.c | 45 | Spear/Sys/Timer/ctimer.c |
88 | Spear/Assets/Model/OBJ/OBJ_load.cc | ||
89 | Spear/Render/RenderModel.c | ||
90 | Spear/Sys/Timer/ctimer.c | ||
91 | |||
92 | extensions: TypeFamilies | 46 | extensions: TypeFamilies |
93 | 47 | extra-libraries: stdc++ | |
94 | includes: | 48 | includes: Spear/Assets/Image/BMP/BMP_load.h |
95 | Spear/Assets/Image/BMP/BMP_load.h | 49 | Spear/Assets/Image/Image.h Spear/Assets/Image/Image_error_code.h |
96 | Spear/Assets/Image/Image.h | 50 | Spear/Assets/Image/sys_types.h Spear/Assets/Model/MD2/MD2_load.h |
97 | Spear/Assets/Image/Image_error_code.h | 51 | Spear/Assets/Model/OBJ/OBJ_load.h Spear/Assets/Model/Model.h |
98 | Spear/Assets/Image/sys_types.h | 52 | Spear/Assets/Model/Model_error_code.h |
99 | Spear/Assets/Model/MD2/MD2_load.h | 53 | Spear/Assets/Model/sys_types.h Spear/Render/RenderModel.h |
100 | Spear/Assets/Model/OBJ/OBJ_load.h | 54 | Timer/Timer.h |
101 | Spear/Assets/Model/Model.h | 55 | include-dirs: Spear/Assets/Image Spear/Assets/Model Spear/Render |
102 | Spear/Assets/Model/Model_error_code.h | 56 | Spear/Sys |
103 | Spear/Assets/Model/sys_types.h | ||
104 | Spear/Render/RenderModel.h | ||
105 | Timer/Timer.h | ||
106 | |||
107 | include-dirs: | ||
108 | Spear/Assets/Image | ||
109 | Spear/Assets/Model | ||
110 | Spear/Render | ||
111 | Spear/Sys | ||
112 | |||
113 | hs-source-dirs: . | 57 | hs-source-dirs: . |
114 | |||
115 | ghc-options: -O2 -rtsopts | 58 | ghc-options: -O2 -rtsopts |
116 | |||
117 | cc-options: -O2 -g -Wno-unused-result | ||
118 | |||
119 | extra-libraries: stdc++ | ||
120 | 59 | ||
diff --git a/Spear.lkshs b/Spear.lkshs index 1427d7f..9fbb082 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 | "Thu Aug 2 15:35:02 CEST 2012" | 4 | "Mon Aug 6 13:19:58 CEST 2012" |
5 | Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 4, 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}) 308) 219)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 756) 953 | 5 | Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 7, 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}) 289) 214)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 738) 954 |
6 | Population: [(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs" 61)),[SplitP LeftP]),(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameObject.hs" 2483)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 893)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Scene/Loader.hs" 10609)),[SplitP LeftP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c" 1772)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h" 0)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc" 10563)),[SplitP LeftP]),(Just (ModulesSt (ModulesState 286 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), 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]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 1249)),[SplitP LeftP])] | 6 | Population: [(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs" 75)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Collision/Collisioner.hs" 551)),[SplitP LeftP]),(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameObject.hs" 1411)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 286 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics.hs" 133)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/Rigid.hs" 447)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Math/Spatial.hs" 0)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/Types.hs" 142)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/World.hs" 196)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 1603)),[SplitP LeftP])] |
7 | Window size: (1796,979) | 7 | Window size: (1796,979) |
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 "Model.c" | 11 | Active pane: Just "World.hs" |
12 | Toolbar visible: | 12 | Toolbar visible: |
13 | True | 13 | True |
14 | FindbarState: (False,FindState {entryStr = "asd", entryHist = ["mandatory","mandao","col","forward","asd","MouseButton"], replaceStr = "mandatory'", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) | 14 | FindbarState: (False,FindState {entryStr = "asd", entryHist = ["gravity","asdad","rotSpeed","azimuth","mandatory","mandao","col","forward","MouseButton"], replaceStr = "mandatory'", replaceHist = [], caseSensitive = False, 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.hsc","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h","/home/jeanne/programming/haskell/Spear/Spear/Scene/Graph.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/SceneResources.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Matrix4.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Vector3.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/simple.scene","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.c","/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameMessage.hs","/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs","/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs"] | 16 | ["/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs","/home/jeanne/programming/haskell/Spear/Spear/App/Input.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Spatial.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Quaternion.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/AnimatedModel.hs","/home/jeanne/programming/haskell/Spear/Spear/Render/StaticModel.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/Loader.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h","/home/jeanne/programming/haskell/Spear/Spear/Scene/Graph.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/SceneResources.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Matrix4.hs"] |
17 | Recently opened workspaces: | 17 | Recently opened workspaces: |
18 | ["/home/jeanne/programming/haskell/Spear/Spear.lkshw","/home/jeanne/leksah.lkshw"] \ No newline at end of file | 18 | ["/home/jeanne/programming/haskell/Spear/Spear.lkshw","/home/jeanne/leksah.lkshw"] \ No newline at end of file |
diff --git a/Spear.lkshw b/Spear.lkshw index 865bceb..fdfc941 100644 --- a/Spear.lkshw +++ b/Spear.lkshw | |||
@@ -1,7 +1,7 @@ | |||
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 | "Wed Aug 1 18:11:40 CEST 2012" | 4 | "Mon Aug 6 13:19:41 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: |
diff --git a/Spear/Physics.hs b/Spear/Physics.hs new file mode 100644 index 0000000..248d4fe --- /dev/null +++ b/Spear/Physics.hs | |||
@@ -0,0 +1,12 @@ | |||
1 | module Spear.Physics | ||
2 | ( | ||
3 | module Spear.Physics.Rigid | ||
4 | , module Spear.Physics.Types | ||
5 | , module Spear.Physics.World | ||
6 | ) | ||
7 | where | ||
8 | |||
9 | |||
10 | import Spear.Physics.Rigid | ||
11 | import Spear.Physics.Types | ||
12 | import Spear.Physics.World | ||
diff --git a/Spear/Physics/Rigid.hs b/Spear/Physics/Rigid.hs new file mode 100644 index 0000000..b9c84d2 --- /dev/null +++ b/Spear/Physics/Rigid.hs | |||
@@ -0,0 +1,122 @@ | |||
1 | module Spear.Physics.Rigid | ||
2 | ( | ||
3 | module Spear.Physics.Types | ||
4 | , RigidBody(..) | ||
5 | , rigidBody | ||
6 | , update | ||
7 | ) | ||
8 | where | ||
9 | |||
10 | |||
11 | import qualified Spear.Math.Matrix4 as M4 | ||
12 | import Spear.Math.Spatial | ||
13 | import Spear.Math.Vector3 as V3 | ||
14 | import Spear.Physics.Types | ||
15 | |||
16 | import Data.List (foldl') | ||
17 | import Control.Monad.State | ||
18 | |||
19 | |||
20 | data RigidBody = RigidBody | ||
21 | { mass :: Float | ||
22 | , position :: Vector3 | ||
23 | , velocity :: Vector3 | ||
24 | , acceleration :: Vector3 | ||
25 | } | ||
26 | |||
27 | |||
28 | instance Spatial RigidBody where | ||
29 | |||
30 | move v body = body { position = v + position body } | ||
31 | |||
32 | moveFwd speed body = body { position = position body + scale (-speed) unitZ } | ||
33 | |||
34 | moveBack speed body = body { position = position body + scale speed unitZ } | ||
35 | |||
36 | strafeLeft speed body = body { position = position body + scale (-speed) unitX } | ||
37 | |||
38 | strafeRight speed body = body { position = position body + scale speed unitX } | ||
39 | |||
40 | pitch angle = id | ||
41 | |||
42 | yaw angle = id | ||
43 | |||
44 | roll angle = id | ||
45 | |||
46 | pos = position | ||
47 | |||
48 | fwd _ = unitZ | ||
49 | |||
50 | up _ = unitY | ||
51 | |||
52 | right _ = unitX | ||
53 | |||
54 | transform body = M4.transform unitX unitY unitZ $ position body | ||
55 | |||
56 | setTransform transf body = body { position = M4.position transf } | ||
57 | |||
58 | setPos p body = body { position = p } | ||
59 | |||
60 | |||
61 | -- | Build a 'RigidBody'. | ||
62 | rigidBody :: Mass -> Position -> RigidBody | ||
63 | rigidBody m x = RigidBody m x V3.zero V3.zero | ||
64 | |||
65 | |||
66 | -- | Update the given 'RigidBody'. | ||
67 | update :: [Force] -> Dt -> RigidBody -> RigidBody | ||
68 | update forces dt body = | ||
69 | let netforce = foldl' (+) V3.zero forces | ||
70 | m = mass body | ||
71 | r1 = position body | ||
72 | v1 = velocity body | ||
73 | a1 = acceleration body | ||
74 | r2 = r1 + scale dt v1 + scale (0.5*dt*dt) a1 | ||
75 | v' = v1 + scale (0.5*dt) a1 | ||
76 | a2 = a1 + scale (1/m) netforce | ||
77 | v2 = v1 + scale (dt/2) (a2+a1) + scale (0.5*dt) a2 | ||
78 | in | ||
79 | RigidBody m r2 v2 a2 | ||
80 | |||
81 | |||
82 | -- test | ||
83 | gravity = vec3 0 (-10) 0 | ||
84 | b0 = rigidBody 50 $ vec3 0 1000 0 | ||
85 | |||
86 | |||
87 | debug :: IO () | ||
88 | debug = evalStateT debug' b0 | ||
89 | |||
90 | |||
91 | |||
92 | debug' :: StateT RigidBody IO () | ||
93 | debug' = do | ||
94 | lift . putStrLn $ "Initial body:" | ||
95 | lift . putStrLn . show' $ b0 | ||
96 | lift . putStrLn $ "Falling..." | ||
97 | step $ update [gravity*50] 1 | ||
98 | step $ update [gravity*50] 1 | ||
99 | step $ update [gravity*50] 1 | ||
100 | lift . putStrLn $ "Jumping" | ||
101 | step $ update [gravity*50, vec3 0 9000 0] 1 | ||
102 | lift . putStrLn $ "Falling..." | ||
103 | step $ update [gravity*50] 1 | ||
104 | step $ update [gravity*50] 1 | ||
105 | step $ update [gravity*50] 1 | ||
106 | |||
107 | |||
108 | step :: (RigidBody -> RigidBody) -> StateT RigidBody IO () | ||
109 | step update = do | ||
110 | modify update | ||
111 | body <- get | ||
112 | lift . putStrLn . show' $ body | ||
113 | |||
114 | |||
115 | show' body = | ||
116 | "mass " ++ (show $ mass body) ++ | ||
117 | ", position " ++ (showVec $ position body) ++ | ||
118 | ", velocity " ++ (showVec $ velocity body) ++ | ||
119 | ", acceleration " ++ (showVec $ acceleration body) | ||
120 | |||
121 | |||
122 | showVec v = (show $ x v) ++ ", " ++ (show $ y v) ++ ", " ++ (show $ z v) | ||
diff --git a/Spear/Physics/Types.hs b/Spear/Physics/Types.hs new file mode 100644 index 0000000..5d87c47 --- /dev/null +++ b/Spear/Physics/Types.hs | |||
@@ -0,0 +1,11 @@ | |||
1 | module Spear.Physics.Types | ||
2 | where | ||
3 | |||
4 | |||
5 | import Spear.Math.Vector3 | ||
6 | |||
7 | |||
8 | type Dt = Float | ||
9 | type Force = Vector3 | ||
10 | type Mass = Float | ||
11 | type Position = Vector3 | ||
diff --git a/Spear/Physics/World.hs b/Spear/Physics/World.hs new file mode 100644 index 0000000..4ad0191 --- /dev/null +++ b/Spear/Physics/World.hs | |||
@@ -0,0 +1,177 @@ | |||
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 | , modifyObject | ||
16 | , objectTransform | ||
17 | , objectForces | ||
18 | , setForces | ||
19 | ) | ||
20 | where | ||
21 | |||
22 | |||
23 | import Spear.Collision.AABB | ||
24 | import Spear.Collision.Collisioner as C | ||
25 | import Spear.Collision.Sphere | ||
26 | import Spear.Math.Matrix4 (Matrix4) | ||
27 | import Spear.Math.Spatial | ||
28 | import Spear.Math.Vector3 | ||
29 | import Spear.Physics.Rigid as Rigid | ||
30 | import Spear.Physics.Types | ||
31 | |||
32 | import Control.Monad.ST | ||
33 | import Data.Array as A | ||
34 | import Data.Array.ST | ||
35 | import Data.Maybe (fromJust) | ||
36 | |||
37 | |||
38 | -- | Uniquely identifies an object in a 'World'. | ||
39 | newtype ObjectID = ObjectID Int | ||
40 | |||
41 | |||
42 | data Object = Object | ||
43 | { body :: RigidBody | ||
44 | , collisioner :: Collisioner | ||
45 | , forces :: [Vector3] | ||
46 | } | ||
47 | |||
48 | |||
49 | -- | The world where physical bodies are simulated. | ||
50 | data World = World | ||
51 | { bodies :: Array Int (Maybe Object) -- ^ Collection of objects. | ||
52 | , gravity :: Vector3 -- ^ World gravity. | ||
53 | } | ||
54 | |||
55 | |||
56 | -- | Create an empty 'World'. | ||
57 | emptyWorld :: World | ||
58 | emptyWorld = World emptyArray defaultGravity | ||
59 | where | ||
60 | defaultGravity = vec3 0 (-9.8) 0 | ||
61 | emptyArray = listArray (0,0) [] | ||
62 | |||
63 | |||
64 | -- | Create a new object. | ||
65 | newObject :: RigidBody -> Collisioner -> World -> (World, ObjectID) | ||
66 | newObject body collisioner world = | ||
67 | let obj = (Object body collisioner []) | ||
68 | in case emptySlot world of | ||
69 | Just i -> (insert i obj world, ObjectID i) | ||
70 | Nothing -> append obj world | ||
71 | |||
72 | |||
73 | -- | Search for an empty slot in the given 'World'. | ||
74 | emptySlot :: World -> Maybe Int | ||
75 | emptySlot world = Nothing | ||
76 | |||
77 | |||
78 | -- | Insert the given 'Object' in the given 'World' at the given position. | ||
79 | insert :: Int -> Object -> World -> World | ||
80 | insert i obj world = world { bodies = bodies' } | ||
81 | where | ||
82 | bodies' = runSTArray $ do | ||
83 | bs <- thaw $ bodies world | ||
84 | writeArray bs i $ Just obj | ||
85 | return bs | ||
86 | |||
87 | |||
88 | -- | Append the given object to the given 'World'. | ||
89 | -- | ||
90 | -- The world's vectors are doubled in size to make future insertions faster. | ||
91 | append :: Object -> World -> (World, ObjectID) | ||
92 | append obj world = (world, ObjectID 0) | ||
93 | |||
94 | |||
95 | -- | Remove the object specified by the given 'ObjectID' from the given 'World'. | ||
96 | deleteObject :: ObjectID -> World -> World | ||
97 | deleteObject (ObjectID i) world = world { bodies = bodies' } | ||
98 | where | ||
99 | bodies' = runSTArray $ do | ||
100 | bs <- thaw $ bodies world | ||
101 | writeArray bs i Nothing | ||
102 | return bs | ||
103 | |||
104 | |||
105 | -- | Modify the object identified by the given 'ObjectID' in the given 'World'. | ||
106 | modifyObject :: (RigidBody -> RigidBody) -> ObjectID -> World -> World | ||
107 | modifyObject f (ObjectID i) world = world { bodies = bodies' } | ||
108 | where | ||
109 | bodies' = runSTArray $ do | ||
110 | bs <- thaw $ bodies world | ||
111 | obj <- readArray bs i | ||
112 | writeArray bs i $ fmap (\obj -> obj { body = f $ body obj }) obj | ||
113 | return bs | ||
114 | |||
115 | |||
116 | -- | Get the transform of the object identified by the given 'ObjectID'. | ||
117 | objectTransform :: World -> ObjectID -> Matrix4 | ||
118 | objectTransform world (ObjectID i) = transform . body . fromJust $ bodies world ! i | ||
119 | |||
120 | |||
121 | -- | Get the forces acting on the object identified by the given 'ObjectID'. | ||
122 | objectForces :: World -> ObjectID -> [Force] | ||
123 | objectForces world (ObjectID i) = forces . fromJust $ bodies world ! i | ||
124 | |||
125 | |||
126 | -- | Add the given force to the forces acting on the object identified by the given 'ObjectID'. | ||
127 | setForces :: [Force] -> ObjectID -> World -> World | ||
128 | setForces fs (ObjectID i) world = world { bodies = bodies' } | ||
129 | where | ||
130 | bodies' = runSTArray $ do | ||
131 | bs <- thaw $ bodies world | ||
132 | obj <- readArray bs i | ||
133 | writeArray bs i $ fmap (\obj -> obj { forces = fs }) obj | ||
134 | return bs | ||
135 | |||
136 | |||
137 | -- | Set the world's gravity. | ||
138 | setGravity :: Vector3 -> World -> World | ||
139 | setGravity g world = world { gravity = g } | ||
140 | |||
141 | |||
142 | -- | Update the 'World'. | ||
143 | updateWorld :: Dt -> World -> World | ||
144 | updateWorld dt world = world { bodies = bodies' } | ||
145 | where | ||
146 | bodies' = runSTArray $ do | ||
147 | bs <- thaw $ bodies world | ||
148 | mapArray updateObject bs | ||
149 | return bs | ||
150 | |||
151 | updateObject = fmap updateObject' | ||
152 | updateObject' (Object body collisioner forces) = Object body' collisioner' forces | ||
153 | where | ||
154 | -- Forces acting on the body. | ||
155 | forces' = scale (mass body) (gravity world) : forces | ||
156 | |||
157 | -- Updated body. | ||
158 | body' = Rigid.update forces dt body | ||
159 | |||
160 | -- Center collisioner around the new body's center. | ||
161 | collisioner' = center (Rigid.position body') collisioner | ||
162 | |||
163 | -- Center the collisioner around the given point. | ||
164 | center c (SphereCol (Sphere _ r)) = sphereCollisioner $ Sphere c r | ||
165 | center c (AABBCol (AABB min max)) = | ||
166 | let v = (max - min) / 2 | ||
167 | min' = c - v | ||
168 | max' = c + v | ||
169 | in | ||
170 | aabbCollisioner $ AABB min' max' | ||
171 | |||
172 | |||
173 | {--- | Test for potential collisions in the given 'World'. | ||
174 | -- | ||
175 | -- Returns a new world and a list of colliding pairs of objects. | ||
176 | --testCollisions :: World -> (World, [(ObjectID, ObjectID)])-} | ||
177 | |||