Physics for player move

README.md

@@ -64,21 +64,6 @@ stack test --pedantic --file-watch
 
 ## TODO
 
- - sort out entity typing in world issue
- - physics engine (2d top down). wolfs is simple
-   - general
-         1. Move x and y, if okay then return
-         2. move x only, if okay return
-         3. move y only, if oka return
-         4. return
-   - functional structure
-         - input a bunch of force events (vector2 + character)
-         - normalise to one force event per char
-         - create move to events which result from forces
-             - which apply the force and take in to account any bumping up against
-             - items should be static (cant be moved), dynamic (can be moved), virtual (move right through them)
-         - collision events between 2
-
  - have press m to toggle map for debug
  - move sprites forward a bit. This was fudged in original:
    - https://github.com/id-Software/wolf3d/blob/05167784ef009d0d0daefe8d012b027f39dc8541/WOLFSRC/WL_DRAW.C#L227
@@ -106,9 +91,6 @@ stack test --pedantic --file-watch
  - difference for pistol and uzi - auto vs semi auto
  - Structure cabal project in such a way that modules not exposed to main can still be exposed to test
    - Do general deeper research into cabal project and possibilities - multiple libraries?
- - Split Wolf3D.Sim into separate files, resolving circular dependencies
-   - https://stackoverflow.com/questions/8650297/haskell-recursive-circular-module-definitions
-   - https://downloads.haskell.org/~ghc/7.0.3/docs/html/users_guide/separate-compilation.html#mutual-recursion 
  - Dont render hidden sprites
    - only render within field of view bounds
    - only render in front of walls

src/Wolf3D/Debug/Display.hs

@@ -7,9 +7,9 @@ module Wolf3D.Debug.Display (
 
 import qualified Wolf3D.Display as D
 import qualified Wolf3D.Display.Data as DD
-import Wolf3D.Sim
 import Wolf3D.Runner
 import Wolf3D.SDLUtils
+import Wolf3D.WorldData
 import Wolf3D.Display.MiniMap
 import Wolf3D.Display.Utils
 import qualified SDL

src/Wolf3D/Debug/Dummy.hs

@@ -1,7 +1,7 @@
 module Wolf3D.Debug.Dummy (dummyWorld) where
 
 import Wolf3D.WorldData
-import Wolf3D.Sim
+import Wolf3D.World
 import Wolf3D.Hero
 import Wolf3D.DataHelpers
 

src/Wolf3D/Display.hs

@@ -9,7 +9,7 @@ module Wolf3D.Display (
   actionWidth
 ) where
 
-import Wolf3D.Sim
+import Wolf3D.World
 import Wolf3D.Runner
 import Wolf3D.SDLUtils
 import Wolf3D.Geom
@@ -62,7 +62,7 @@ renderCeilingAndFloor r _ w = do
   SDL.rendererDrawColor r $= floorColor
   SDL.fillRect r (Just (mkSDLRect actionAreaX (actionAreaY + halfActionHeight) actionWidth halfActionHeight))
   where
-    ceilingColor = fromJust (M.lookup (worldCeilingColor w) ceilingColors)
+    ceilingColor = fromJust (M.lookup (worldCeiling w) ceilingColors)
 
 renderWalls :: SDL.Renderer -> RenderData -> World -> IO ()
 renderWalls r d w = forM_ (zip [0..] hits) (renderWallLine r d)

src/Wolf3D/Display/MiniMap.hs

@@ -6,7 +6,7 @@ import Foreign.C.Types (CInt)
 import Data.Vector
 import Wolf3D.Geom
 import Wolf3D.WorldData
-import Wolf3D.Sim
+import Wolf3D.World
 import Wolf3D.SDLUtils
 import Data.Foldable (forM_)
 import Data.StateVar (($=))

src/Wolf3D/Hero.hs

@@ -5,15 +5,19 @@ module Wolf3D.Hero (
   createHeroFromTilePosition,
   modifyHeroActionState,
   updateHeroActionsState,
-
+
+  heroSize,
   createHero,
-  moveHero,
-  rotateHero
+  rotateHero,
+
+  moveHero -- for specs only
 ) where
 
 import Wolf3D.WorldData
 import Wolf3D.Geom
 import Data.Vector
+import Data.Maybe
+import Data.List
 
 
 simUpdateWeapon :: World -> Weapon -> Weapon
@@ -72,7 +76,7 @@ simUpdateHero w h@(Hero {actionsState=has}) = h3
     -- player->tiley = player->y >> TILESHIFT;
     -- offset = farmapylookup[player->tiley]+player->tilex;
     -- player->areanumber = *(mapsegs[0] + offset) -AREATILE;
-    h2 = moveHero h1 velocity
+    h2 = moveHero w h1 velocity
     h3 = updateWeapon w h2
 
 angleScale :: Int
@@ -81,6 +85,9 @@ angleScale = 20
 moveScale :: Int
 moveScale = 150
 
+heroSize :: Int
+heroSize = minDist
+
 backMoveScale :: Int
 backMoveScale = 100
 
@@ -103,16 +110,20 @@ createHero pos = Hero pos 0 0 staticHeroActionsState (Pistol Nothing False)
 createHeroFromTilePosition :: TileCoord -> Hero
 createHeroFromTilePosition p = createHero (tileCoordToCentreGlobalPos p)
 
-moveHero :: Hero -> Int -> Hero
-moveHero h 0 = h
-moveHero h@(Hero {position=p, snappedRotation=sr}) velocity = h {position=newPos}
+moveHero :: World -> Hero -> Int -> Hero
+moveHero _ h 0 = h
+moveHero w h@(Hero {position=p, snappedRotation=sr}) velocity = h {position=fromJust firstOkay}
   where
     speed = abs velocity
     moveAngle = if velocity < 0 then sr else bindAngle (sr + (angles `div` 2))
     boundSpeed = if speed >= minDist * 2 then minDist * 2 - 1 else speed
     rotRad = (fromIntegral moveAngle) * degToRad
     dSpeed = fromIntegral boundSpeed
-    newPos = p + Vector2 (dSpeed * (cos rotRad)) (-(dSpeed * (sin rotRad)))
+    xOffset = dSpeed * (cos rotRad)
+    yOffset = -(dSpeed * (sin rotRad))
+    potentialOffsets = [Vector2 xOffset yOffset, Vector2 xOffset 0, Vector2 0 yOffset, Vector2 0 0]
+    potentialPositions = map (p +) potentialOffsets
+    firstOkay = find (\pos -> not (isHittingWall w pos heroSize)) potentialPositions
 
 updateHeroActionsState :: HeroActionsState -> Hero -> Hero
 updateHeroActionsState a (Hero p sr rr _ w) = Hero p sr rr a w

src/Wolf3D/Runner.hs

@@ -14,7 +14,7 @@ import Data.Time.Clock
 import Data.Maybe
 import Wolf3D.Utils
 import Wolf3D.Input
-import Wolf3D.Sim
+import Wolf3D.World
 import Wolf3D.WorldData
 import Data.Foldable
 

src/Wolf3D/Sim.hs → src/Wolf3D/World.hs

@@ -1,10 +1,7 @@
-module Wolf3D.Sim (
+module Wolf3D.World (
   createWorld,
   incWorldTicks,
   emptyWallMap,
-  worldTicks,
-  worldCeilingColor,
-  worldWallMap,
   tickWorld,
   tickWorldNTimes,
 
@@ -46,9 +43,6 @@ tickWorldNTimes w n
 incWorldTicks :: World -> World
 incWorldTicks (World c wm h is ticks) = World c wm h is (ticks + 1)
 
-{-----------------------------------------------------------------------------------------------------------------------
- General
------------------------------------------------------------------------------------------------------------------------}
 updateWorldHeroActionsState :: World -> HeroActionsState -> World
 updateWorldHeroActionsState w a = updateWorldHero w (updateHeroActionsState a)
 
@@ -61,9 +55,6 @@ worldEnvItemsTouching r w = filter (itemIsTouching r) (worldEnvItems w)
 itemIsTouching :: Rectangle -> EnvItem -> Bool
 itemIsTouching r i = rectangleOverlapsRectangle r (itemRectangle i)
 
-{-----------------------------------------------------------------------------------------------------------------------
- Environment
------------------------------------------------------------------------------------------------------------------------}
 itemRectangle :: EnvItem -> Rectangle
 itemRectangle i@(EnvItem _ o) = Rectangle (o - halfItemSize i) (itemSize i)
   where

src/Wolf3D/WorldData.hs

@@ -7,29 +7,25 @@ module Wolf3D.WorldData (
   Ceiling (..),
   EnvItemType (..),
   EnvItem (..),
-  
+
   HeroActionsState (..),
   Hero (..),
   SnappedRotation,
   HeroAction (..),
   Weapon (..),
 
-  worldWallMap,
-  worldCeilingColor,
-  worldTicks,
-  worldHero,
-  worldHeroWeapon,
-  worldEnvItems,
-
+  isHittingWall,
+
   Angle,
   FineAngle,
+  worldHeroWeapon,
   minDist,
   angles,
   fineAngles,
-  bindAngle,  
+  bindAngle,
   fineToNormalAngle,
   normalToFineAngle,
-  
+
   tileGlobalSize,
   tileToGlobalShift,
   tileCoordToGlobalPos,
@@ -40,6 +36,8 @@ module Wolf3D.WorldData (
 import Data.Vector
 import Data.Array
 import Data.Bits
+import Data.Maybe
+
 
 type UsingWeapon = Bool
 data Weapon = Pistol (Maybe WorldTicks) UsingWeapon
@@ -86,25 +84,26 @@ data Ceiling = GreyCeiling | PurpleCeiling | GreenCeiling | YellowCeiling
 type WorldTicks = Int
 type WallMap = Array (Int, Int) (Maybe Wall)
 -- Tried record syntax for this and failed
-data World = World Ceiling WallMap Hero [EnvItem] WorldTicks
-
-worldWallMap :: World -> WallMap
-worldWallMap (World _ wm _ _ _) = wm
-
-worldCeilingColor :: World -> Ceiling
-worldCeilingColor (World c _ _ _ _) = c
-
-worldTicks :: World -> Int
-worldTicks (World _ _ _ _ t) = t
-
-worldHero :: World -> Hero
-worldHero (World _ _ h _ _) = h
+data World = World {worldCeiling :: Ceiling
+                    , worldWallMap :: WallMap
+                    , worldHero :: Hero
+                    , worldEnvItems :: [EnvItem]
+                    , worldTicks :: WorldTicks}
 
 worldHeroWeapon :: World -> Weapon
-worldHeroWeapon = weapon . worldHero
+worldHeroWeapon w = weapon (worldHero w)
+
+-- Would be better in world, but results in cyclic dependency
+type ActorSize = Int
 
-worldEnvItems :: World -> [EnvItem]
-worldEnvItems (World _ _ _ is _) = is
+isHittingWall :: World -> Vector2 -> ActorSize -> Bool
+isHittingWall (World {worldWallMap=wm}) (Vector2 x y) s = any isJust (map (wm!) tiles)
+  where
+    xTileLow = ((round x) - s) `shiftR` tileToGlobalShift
+    yTileLow = ((round y) - s) `shiftR` tileToGlobalShift
+    xTileHigh = ((round x) + s) `shiftR` tileToGlobalShift
+    yTileHigh = ((round y) + s) `shiftR` tileToGlobalShift
+    tiles = [(xTileLow, yTileLow), (xTileLow, yTileHigh), (xTileHigh, yTileLow), (xTileHigh, yTileHigh)]
 
 tileGlobalSize :: Int
 tileGlobalSize = 1 `shiftL` 16

test/Spec.hs

@@ -1,5 +1,6 @@
 import Test.Hspec
 import Wolf3D.HeroSpec
+import Wolf3D.WorldSpec
 import Wolf3D.RunnerSpec
 import Wolf3D.GeomSpec
 import Wolf3D.Display.RaySpec
@@ -10,3 +11,4 @@ main = hspec $ do
   runnerSpec
   geomSpec
   raySpec
+  worldSpec

test/Wolf3D/HeroSpec.hs

@@ -3,58 +3,73 @@ module Wolf3D.HeroSpec (heroSpec) where
 import Test.Hspec
 import Data.Vector
 import Wolf3D.WorldData
+import Wolf3D.World
 import Wolf3D.Hero
 import Wolf3D.SpecHelp
 
 
+dTileSize :: Double
+dTileSize = fromIntegral tileGlobalSize
+
+heroPosUnit :: Vector2
+heroPosUnit = Vector2 dTileSize dTileSize
+
 heroSpec :: SpecWith ()
 heroSpec =
   describe "Wolf3D.Hero" $ do
     describe "moveHero" $ do
       it "should move forward correctly if facing north" $
         let
-          hero = rotateHero (createHero (Vector2 0 0)) (90 * 20) -- angleScale
+          hero = rotateHero (createHero heroPosUnit) (90 * 20) -- angleScale
+          world = createWorld GreyCeiling (emptyWallMap 2 2) hero []
         in
-          position (moveHero hero 1) `shouldSatisfy` veryCloseToVector2 (Vector2 0 (-1))
+          position (moveHero world hero 1) `shouldSatisfy` veryCloseToVector2 (Vector2 dTileSize (dTileSize - 1))
 
       it "should move forward correctly if facing south" $
         let
-          hero = rotateHero (createHero (Vector2 0 0)) (270 * 20) -- angleScale
+          hero = rotateHero (createHero heroPosUnit) (270 * 20) -- angleScale
+          world = createWorld GreyCeiling (emptyWallMap 2 2) hero []
         in
-          position (moveHero hero 1) `shouldSatisfy` veryCloseToVector2 (Vector2 0 1)
+          position (moveHero world hero 1) `shouldSatisfy` veryCloseToVector2 (Vector2 dTileSize (dTileSize + 1))
 
       it "should move backward correctly if facing north" $
         let
-          hero = rotateHero (createHero (Vector2 0 0)) (90 * 20) -- angleScale
+          hero = rotateHero (createHero heroPosUnit) (90 * 20) -- angleScale
+          world = createWorld GreyCeiling (emptyWallMap 2 2) hero []
         in
-          position (moveHero hero (-1)) `shouldSatisfy` veryCloseToVector2 (Vector2 0 1)
+          position (moveHero world hero (-1)) `shouldSatisfy` veryCloseToVector2 (Vector2 dTileSize (dTileSize + 1))
 
       it "should move backward correctly if facing south" $
         let
-          hero = rotateHero (createHero (Vector2 0 0)) (270 * 20) -- angleScale
+          hero = rotateHero (createHero heroPosUnit) (270 * 20) -- angleScale
+          world = createWorld GreyCeiling (emptyWallMap 2 2) hero []
         in
-          position (moveHero hero (-1)) `shouldSatisfy` veryCloseToVector2 (Vector2 0 (-1))
+          position (moveHero world hero (-1)) `shouldSatisfy` veryCloseToVector2 (Vector2 dTileSize (dTileSize - 1))
 
       it "should move forward correctly if facing east" $
         let
-          hero = rotateHero (createHero (Vector2 0 0)) (0 * 20) -- angleScale
+          hero = rotateHero (createHero heroPosUnit) (0 * 20) -- angleScale
+          world = createWorld GreyCeiling (emptyWallMap 2 2) hero []
         in
-          position (moveHero hero (-1)) `shouldSatisfy` veryCloseToVector2 (Vector2 1 0)
+          position (moveHero world hero (-1)) `shouldSatisfy` veryCloseToVector2 (Vector2 (dTileSize + 1) dTileSize)
 
       it "should move backward correctly if facing east" $
         let
-          hero = rotateHero (createHero (Vector2 0 0)) (0 * 20) -- angleScale
+          hero = rotateHero (createHero heroPosUnit) (0 * 20) -- angleScale
+          world = createWorld GreyCeiling (emptyWallMap 2 2) hero []
         in
-          position (moveHero hero 1) `shouldSatisfy` veryCloseToVector2 (Vector2 (-1) 0)
+          position (moveHero world hero 1) `shouldSatisfy` veryCloseToVector2 (Vector2 (dTileSize - 1) dTileSize)
 
       it "should move forward correctly if facing west" $
         let
-          hero = rotateHero (createHero (Vector2 0 0)) (180 * 20) -- angleScale
+          hero = rotateHero (createHero heroPosUnit) (180 * 20) -- angleScale
+          world = createWorld GreyCeiling (emptyWallMap 2 2) hero []
         in
-          position (moveHero hero (-1)) `shouldSatisfy` veryCloseToVector2 (Vector2 (-1) 0)
+          position (moveHero world hero (-1)) `shouldSatisfy` veryCloseToVector2 (Vector2 (dTileSize - 1) dTileSize)
 
       it "should move backward correctly if facing west" $
         let
-          hero = rotateHero (createHero (Vector2 0 0)) (180 * 20) -- angleScale
+          hero = rotateHero (createHero heroPosUnit) (180 * 20) -- angleScale
+          world = createWorld GreyCeiling (emptyWallMap 2 2) hero []
         in
-          position (moveHero hero 1) `shouldSatisfy` veryCloseToVector2 (Vector2 1 0)
+          position (moveHero world hero 1) `shouldSatisfy` veryCloseToVector2 (Vector2 (dTileSize + 1) dTileSize)