Permalink
Browse files

Fixed static bodies

  • Loading branch information...
1 parent 1116239 commit 8362f11b1fc3a1c71f7cd6d4765a85e3d3d63b38 @adinapoli committed Feb 9, 2014
Showing with 20 additions and 16 deletions.
  1. +1 −1 src/Components.hs
  2. +9 −8 src/Physics.hs
  3. +1 −0 src/Seagull.hs
  4. +9 −7 src/Systems.hs
View
@@ -146,7 +146,7 @@ spawnProjectile = GameCallback $ \e ->
(SMap.fromList
[ (Renderable, animation "resources/anims/projectile.json" 500)
, (Position, position (x + 10) (y + 10))
- , (LinearForce, linearForce $ V2 0 1)
+ , (DynamicBody, dynamicObj (H.Circle 16))
, (Disposable, noop)
]
))
View
@@ -4,6 +4,7 @@ import Physics.Hipmunk
import Control.Concurrent.STM
import Types
import Control.Monad.SFML
+import Control.Monad
import Control.Monad.Trans.State
import Control.Lens
import Data.Default
@@ -29,9 +30,8 @@ defaultCollisionHandler collPool = Handler Nothing Nothing (Just postSolveHldr)
postSolveHldr = do
shapesInvolved <- shapes
liftIO $ modifyIORef collPool (shapesInvolved :)
- lenP <- fmap length (liftIO $ readIORef collPool)
- liftIO $ print (show lenP)
-
+ fmap length (liftIO $ readIORef collPool)
+ return ()
--------------------------------------------------------------------------------
createPhysicsManager :: IO PhysicsManager
@@ -43,7 +43,7 @@ createPhysicsManager = do
let cfg = def
gravity newWorld $= toHipmunkVector (cfg ^. defGravity)
- setDefaultCollisionHandler newWorld (defaultCollisionHandler collPool)
+ --setDefaultCollisionHandler newWorld (defaultCollisionHandler collPool)
return PhysicsManager {
_world = newWorld
, _bodies = 0
@@ -65,6 +65,9 @@ destroyPhysicManager = do
toHipmunkVector :: V2 Double -> Vector
toHipmunkVector (V2 x y) = Vector x y
+--------------------------------------------------------------------------------
+toHipmunkVectorI :: V2 Int -> Vector
+toHipmunkVectorI (V2 x y) = Vector (fromIntegral x) (fromIntegral y)
--------------------------------------------------------------------------------
fromHipmunkVector :: Vector -> V2 Double
@@ -126,8 +129,6 @@ addShape' mss momt isStatic shpTyp pos = do
liftIO $ do
friction sh $= defaultFriction
elasticity sh $= defaultElasticity
- liftIO $ spaceAdd wrld bd
- liftIO $ if isStatic
- then spaceAdd wrld (Static sh)
- else spaceAdd wrld sh
+ unless isStatic $ liftIO $ spaceAdd wrld bd
+ liftIO $ spaceAdd wrld sh
return sh
View
@@ -181,6 +181,7 @@ buildEntities = do
"resources/anims/player.json"
300
)
+ , (StaticBody, staticObj (H.Circle 30))
, (Position, position 330 380)
, (Keyboard, keyboard (seagullPlayerKeyboard 5))
]
View
@@ -99,22 +99,25 @@ hipmunkSystem = System $ do
updateStaticBody e
updateDynamicBody e
where
+
+ ----------------------------------------------------------------------------
updateStaticBody e =
case comp e ^. at StaticBody of
Just (Component _ (CollisionShape (HipmunkUninitializedShape clbk))) -> do
- --when (e ^. alias == Special) $ liftIO $ print "init shp"
newShp <- clbk e
e #.= Component StaticBody
(CollisionShape (HipmunkInitializedShape newShp))
- --Just (Component _ (CollisionShape (HipmunkInitializedShape sh))) -> do
- -- newPos <- liftIO $ SV.get . H.position $ H.body sh
-
- --when (e ^. alias == Special) (liftIO $ print $ "S->" ++ show newPos)
+ Just (Component _ (CollisionShape (HipmunkInitializedShape sh))) -> do
+ case comp e ^. at Position of
+ Just (Component _ (PosInt pos)) -> do
+ liftIO $ H.position (H.body sh) SV.$= toHipmunkVectorI pos
+ Nothing -> return ()
_ -> return ()
+ ----------------------------------------------------------------------------
updateDynamicBody e =
case liftM2 (,)
(comp e ^. at DynamicBody)
@@ -127,8 +130,7 @@ hipmunkSystem = System $ do
(CollisionShape (HipmunkInitializedShape newShp))
Just (Component DynamicBody (CollisionShape (HipmunkInitializedShape sh)),
- Component _ (PosInt pos)) -> do
- --when (e ^. alias == Special) (liftIO $ print $ "-->" ++ show pos)
+ Component _ (PosInt _)) -> do
newPos <- liftIO $ SV.get . H.position $ H.body sh
e #.= Component Position
(PosInt (fmap truncate (fromHipmunkVector newPos)))

0 comments on commit 8362f11

Please sign in to comment.