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 | ||
