From b6ee26f2a1a10a427744b7a6ba3a6dc8a64ae306 Mon Sep 17 00:00:00 2001 From: Marc Sunet Date: Thu, 9 Aug 2012 13:32:49 +0200 Subject: World now uses Spear.Store --- Spear.lkshs | 8 ++-- Spear/Physics/World.hs | 99 ++++++++++++-------------------------------------- 2 files changed, 28 insertions(+), 79 deletions(-) diff --git a/Spear.lkshs b/Spear.lkshs index 3f28583..afbce39 100644 --- a/Spear.lkshs +++ b/Spear.lkshs @@ -1,14 +1,14 @@ Version of session file format: 1 Time of storage: - "Thu Aug 9 11:37:44 CEST 2012" -Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 5, 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}) 279) 208)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 732) 954 -Population: [(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" 259)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 670)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Sys/Store/ID.hs" 96)),[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 328 (PackageScope False,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([[5]],[]), 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" 207)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/Rigid.hs" 2175)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Sys/Store.hs" 2183)),[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" 1269)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 204)),[SplitP LeftP])] + "Thu Aug 9 13:31:29 CEST 2012" +Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 6, 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}) 266) 197)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 702) 954 +Population: [(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" 259)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 670)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Sys/Store/ID.hs" 96)),[SplitP LeftP]),(Just (InfoSt (InfoState (Just (Real (RealDescr {dscName' = "storeFree", dscMbTypeStr' = Just "storeFree :: Index -> Store a -> Store a", dscMbModu' = Just (PM {pack = PackageIdentifier {pkgName = PackageName "Spear", pkgVersion = Version {versionBranch = [0,1], versionTags = []}}, modu = ModuleName ["Spear","Sys","Store"]}), dscMbLocation' = Just (Location {locationSLine = 101, locationSCol = 1, locationELine = 108, locationECol = 32}), dscMbComment' = Just " Free the given slot.", dscTypeHint' = VariableDescr, dscExported' = True}))))),[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","Sys","Store"]),Just "storeFree") (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0,9],[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([[5]],[]), 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" 207)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Physics/Rigid.hs" 2175)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Sys/Store.hs" 4136)),[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" 287)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 204)),[SplitP LeftP])] Window size: (1841,964) Completion size: (750,400) Workspace: Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw" -Active pane: Just "Store.hs" +Active pane: Just "World.hs" Toolbar visible: True FindbarState: (False,FindState {entryStr = "asda", entryHist = ["assigned","Triangle","transforma","gravity","asdad","rotSpeed","azimuth","mandatory","mandao","col","forward","MouseButton"], replaceStr = "objects", replaceHist = [], caseSensitive = True, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) diff --git a/Spear/Physics/World.hs b/Spear/Physics/World.hs index e0996e6..b4e6176 100644 --- a/Spear/Physics/World.hs +++ b/Spear/Physics/World.hs @@ -12,9 +12,8 @@ module Spear.Physics.World -- * Object operations , newObject , deleteObject -, modifyObject +, withBody , objectTransform -, objectForces , setForces ) where @@ -28,10 +27,9 @@ import Spear.Math.Spatial import Spear.Math.Vector3 import Spear.Physics.Rigid as Rigid import Spear.Physics.Types +import Spear.Sys.Store + -import Control.Monad.ST -import Data.Array as A -import Data.Array.ST import Data.Maybe (fromJust) @@ -48,90 +46,47 @@ data Object = Object -- | The world where physical bodies are simulated. data World = World - { bodies :: Array Int (Maybe Object) -- ^ Collection of objects. + { bodies :: Store Object -- ^ Collection of objects. , gravity :: Vector3 -- ^ World gravity. } --- | Create an empty 'World'. +-- | Create an empty world. emptyWorld :: World -emptyWorld = World emptyArray defaultGravity - where - defaultGravity = vec3 0 (-9.8) 0 - emptyArray = listArray (0,0) [] +emptyWorld = World emptyStore $ vec3 0 (-9.8) 0 -- | Create a new object. -newObject :: RigidBody -> Collisioner -> World -> (World, ObjectID) +newObject :: RigidBody -> Collisioner -> World -> (ObjectID, World) newObject body collisioner world = - let obj = (Object body collisioner []) - in case emptySlot world of - Just i -> (insert i obj world, ObjectID i) - Nothing -> append obj world - - --- | Search for an empty slot in the given 'World'. -emptySlot :: World -> Maybe Int -emptySlot world = Nothing - - --- | Insert the given 'Object' in the given 'World' at the given position. -insert :: Int -> Object -> World -> World -insert i obj world = world { bodies = bodies' } - where - bodies' = runSTArray $ do - bs <- thaw $ bodies world - writeArray bs i $ Just obj - return bs + let (index, bodies') = store (Object body collisioner []) $ bodies world + in (ObjectID index, world { bodies = bodies' }) --- | Append the given object to the given 'World'. --- --- The world's vectors are doubled in size to make future insertions faster. -append :: Object -> World -> (World, ObjectID) -append obj world = (world, ObjectID 0) - - --- | Remove the object specified by the given 'ObjectID' from the given 'World'. +-- | Remove the object specified by the given object ID. deleteObject :: ObjectID -> World -> World deleteObject (ObjectID i) world = world { bodies = bodies' } where - bodies' = runSTArray $ do - bs <- thaw $ bodies world - writeArray bs i Nothing - return bs + bodies' = storeFree i $ bodies world --- | Modify the object identified by the given 'ObjectID' in the given 'World'. -modifyObject :: (RigidBody -> RigidBody) -> ObjectID -> World -> World -modifyObject f (ObjectID i) world = world { bodies = bodies' } +-- | Modify the object identified by the given object ID. +withBody :: ObjectID -> World -> (RigidBody -> RigidBody) -> World +withBody (ObjectID index) world f = world { bodies = bodies' } where - bodies' = runSTArray $ do - bs <- thaw $ bodies world - obj <- readArray bs i - writeArray bs i $ fmap (\obj -> obj { body = f $ body obj }) obj - return bs + bodies' = withElement index (bodies world) $ \obj -> obj { body = f $ body obj } --- | Get the transform of the object identified by the given 'ObjectID'. +-- | Get the transform of the object identified by the given object ID. objectTransform :: World -> ObjectID -> Matrix4 -objectTransform world (ObjectID i) = transform . body . fromJust $ bodies world ! i +objectTransform world (ObjectID i) = transform . body . fromJust $ (element i $ bodies world) --- | Get the forces acting on the object identified by the given 'ObjectID'. -objectForces :: World -> ObjectID -> [Force] -objectForces world (ObjectID i) = forces . fromJust $ bodies world ! i - - --- | Add the given force to the forces acting on the object identified by the given 'ObjectID'. +-- | Add the given force to the forces acting on the object identified by the given object ID. setForces :: [Force] -> ObjectID -> World -> World setForces fs (ObjectID i) world = world { bodies = bodies' } where - bodies' = runSTArray $ do - bs <- thaw $ bodies world - obj <- readArray bs i - writeArray bs i $ fmap (\obj -> obj { forces = fs }) obj - return bs + bodies' = withElement i (bodies world) $ \obj -> obj { forces = fs } -- | Set the world's gravity. @@ -139,17 +94,11 @@ setGravity :: Vector3 -> World -> World setGravity g world = world { gravity = g } --- | Update the 'World'. +-- | Update the world. updateWorld :: Dt -> World -> World -updateWorld dt world = world { bodies = bodies' } - where - bodies' = runSTArray $ do - bs <- thaw $ bodies world - mapArray updateObject bs - return bs - - updateObject = fmap updateObject' - updateObject' (Object body collisioner forces) = Object body' collisioner' forces +updateWorld dt world = world { bodies = fmap updateObject $ bodies world } + where + updateObject (Object body collisioner forces) = Object body' collisioner' forces where -- Forces acting on the body. forces' = scale (mass body) (gravity world) : forces @@ -170,7 +119,7 @@ updateWorld dt world = world { bodies = bodies' } aabbCollisioner $ AABB min' max' -{--- | Test for potential collisions in the given 'World'. +{--- | Test for potential collisions. -- -- Returns a new world and a list of colliding pairs of objects. --testCollisions :: World -> (World, [(ObjectID, ObjectID)])-} -- cgit v1.2.3