restructuring and adding final rotation after walking

src/Interior.hs

@@ -16,10 +16,7 @@ import System.Random
 import Navigation
 import Util
 
-import Types.Interior
+import Types
-import Types.Map
-import Types.UserData
-import Types.ReachPoint
 
 placeInteriorIO
   :: Matrix TileState
@@ -94,6 +91,7 @@ placeInteriorIO imat imgmat irp graph =
             rp
           reaches = map (+ V2 (pr - 1) (pc - 1))
             (map pointCoord (clusterPoints appl))
+          reachdirs = map pointDir (clusterPoints appl)
           oldreaches = foldl (\acc p ->
               if pointType p /= RoomExit && inBounds (pointCoord p) bnds
               then pointCoord p : acc
@@ -101,7 +99,7 @@ placeInteriorIO imat imgmat irp graph =
               )
             []
             rp
-          newrp = rp ++ map (ReachPoint Table) reaches
+          newrp = rp ++ map (uncurry (ReachPoint Table)) (zip reaches reachdirs)
       in
         if try > 10 || fromIntegral freeRoom < size appl
         then (g2, (mat, rp))

src/NPC.hs

@@ -5,6 +5,8 @@ import Affection as A
 import qualified Data.Matrix as M
 import Data.Map.Strict as Map hiding (filter, null)
 import Data.Ecstasy as E
+import Data.Maybe (fromMaybe)
+import Data.List (find)
 
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Concurrent.MVar
@@ -21,10 +23,7 @@ import NanoVG hiding (V2(..))
 import Navigation
 import Util
 
-import Types.UserData
+import Types
-import Types.Interior
-import Types.Map
-import Types.ReachPoint
 
 -- drawNPCs
 --   :: Map ImgId Image
@@ -122,6 +121,8 @@ updateNPCs imgmat rp dt =
     with npcState
     with vel
     with pos
+    with rot
+    with anim
     npcState' <- query npcState
     case npcState' of
       NPCStanding ttl future -> do
@@ -160,10 +161,21 @@ updateNPCs imgmat rp dt =
         else do
           ttl <- liftIO $ randomRIO (5, 30)
           future <- liftIO $ newEmptyMVar
+          rot' <- query rot
+          state <- query anim
+          let mdir = 
+                (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
           -- _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat
           _ <- liftIO $ getPath (fmap floor pos') future rp imgmat
           return $ unchanged
             { npcState = Set $ NPCStanding ttl future
+            , vel      = Set $ V2 0 0
+            , rot      = Set $ fromMaybe rot' mdir
+            , anim     = Set state
+              { asId = (asId state)
+                { aiDirection = fromMaybe rot' mdir
+                }
+              }
             }
 
 

src/Navigation.hs

@@ -10,10 +10,7 @@ import Linear
 
 -- internal imports
 
-import Types.Map
+import Types
-import Types.UserData
-import Types.Interior
-import Types.ReachPoint
 import Util
 
 isReachable :: Matrix (Maybe ImgId) -> [V2 Int] -> [ReachPoint] -> Bool

src/Test.hs

@@ -44,7 +44,7 @@ loadMap = do
   let imgmat = convertTileToImg mat
       exits = Prelude.foldl
         (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty
-          then ReachPoint RoomExit (V2 r c) : acc
+          then ReachPoint RoomExit (V2 r c) NE : acc
           else acc
           )
         []

src/Types.hs

@@ -6,3 +6,7 @@ import Types.UserData as T
 import Types.Map as T
 import Types.Interior as T
 import Types.ReachPoint as T
+import Types.ImgId as T
+import Types.Direction as T
+import Types.StateData as T
+import Types.Animation as T

src/Types/Animation.hs

@@ -0,0 +1,37 @@
+module Types.Animation where
+
+import NanoVG (Image)
+
+import Types.Direction
+
+data AnimId = AnimId
+  { aiVariation :: Int
+  , aiName      :: String -- CHANGE ME !!!
+  , aiDirection :: Direction
+  }
+  deriving (Show, Eq, Ord)
+
+data AnimState = AnimState
+  { asId           :: AnimId
+  , asCurrentFrame :: Int
+  , asElapsedTime  :: Double
+  }
+  deriving (Show)
+
+data AnimPlayback
+  = APLoop
+  | APOnce
+
+data Animation = Animation
+  { animDuration :: Double
+  , animSprites  :: [Image]
+  , animPlay     :: AnimPlayback
+  }
+
+data AnimationConfig = AnimationConfig
+  { animConfOffset   :: (Int, Int)
+  , animConfSize     :: (Int, Int)
+  , animConfCount    :: Int
+  , animConfDuration :: Double
+  , animConfPlay     :: AnimPlayback
+  }

src/Types/Direction.hs

@@ -0,0 +1,12 @@
+module Types.Direction where
+
+data Direction
+  = NE
+  | E
+  | SE
+  | S
+  | SW
+  | W
+  | NW
+  | N
+  deriving (Show, Eq, Ord, Enum)

src/Types/ImgId.hs

@@ -0,0 +1,99 @@
+module Types.ImgId where
+
+import Types.Map
+
+data ImgId
+  = ImgEmpty -- TODO: Find better solution thatn empty image.
+  | ImgWallAsc
+  | ImgWallDesc
+  | ImgWallCornerN
+  | ImgWallCornerE
+  | ImgWallCornerS
+  | ImgWallCornerW
+  | ImgWallTNE
+  | ImgWallTSE
+  | ImgWallTSW
+  | ImgWallTNW
+  | ImgWallCross
+  | ImgMiscBox1
+  | ImgMiscTable1
+  | ImgMiscTable2
+  | ImgMiscTable3
+  | ImgMiscTable4
+  | ImgMiscTableCorner
+  -- | ImgIntrNE
+  -- | ImgIntrE
+  -- | ImgIntrSE
+  -- | ImgIntrS
+  -- | ImgIntrSW
+  -- | ImgIntrW
+  -- | ImgIntrNW
+  -- | ImgIntrN
+  deriving (Show, Eq, Ord, Enum)
+
+isWall :: ImgId -> Bool
+isWall ImgMiscBox1 = False
+isWall ImgMiscTable1 = False
+isWall ImgMiscTable2 = False
+isWall ImgMiscTable3 = False
+isWall ImgMiscTable4 = False
+isWall ImgMiscTableCorner = False
+isWall _ = True
+
+imgObstacle :: Maybe ImgId -> [(Boundaries Double)]
+imgObstacle (Just ImgMiscBox1) = [Boundaries (0.2, 0.34) (0.8, 1)]
+imgObstacle (Just ImgWallAsc) = [Boundaries (0.34, 0) (0.66, 1)]
+imgObstacle (Just ImgWallDesc) = [Boundaries (0, 0.34) (1, 0.66)]
+imgObstacle (Just ImgWallCornerN) =
+  [ Boundaries (0, 0.34) (0.66, 0.66)
+  , Boundaries (0.34, 0.34) (0.66, 1)
+  ]
+imgObstacle (Just ImgWallCornerE) =
+  [ Boundaries (0.34, 0.34) (1, 0.66)
+  , Boundaries (0.34, 0.34) (0.66, 1)
+  ]
+imgObstacle (Just ImgWallCornerS) =
+  [ Boundaries (0.34, 0.34) (1, 0.66)
+  , Boundaries (0.34, 0) (0.66, 0.66)
+  ]
+imgObstacle (Just ImgWallCornerW) =
+  [ Boundaries (0, 0.34) (0.66, 0.66)
+  , Boundaries (0.34, 0) (0.66, 0.66)
+  ]
+imgObstacle (Just ImgWallTNE) =
+  [ Boundaries (0, 0.34) (1, 0.66)
+  , Boundaries (0.34, 0.34) (0.66, 1)
+  ]
+imgObstacle (Just ImgWallTSW) =
+  [ Boundaries (0, 0.34) (1, 0.66)
+  , Boundaries (0.34, 0) (0.66, 0.66)
+  ]
+imgObstacle (Just ImgWallTSE) =
+  [ Boundaries (0.34, 0) (0.66, 1)
+  , Boundaries (0.34, 0.34) (1, 0.66)
+  ]
+imgObstacle (Just ImgWallTNW) =
+  [ Boundaries (0.34, 0) (0.66, 1)
+  , Boundaries (0, 0.34) (0.66, 0.66)
+  ]
+imgObstacle (Just ImgWallCross) =
+  [ Boundaries (0.34, 0) (0.66, 1)
+  , Boundaries (0, 0.34) (1, 0.66)
+  ]
+imgObstacle (Just ImgMiscTable1) =
+  [ Boundaries (0, 0.34) (1, 1)
+  ]
+imgObstacle (Just ImgMiscTable2) =
+  [ Boundaries (0, 0) (0.63, 1)
+  ]
+imgObstacle (Just ImgMiscTable3) =
+  [ Boundaries (0, 0) (1, 0.63)
+  ]
+imgObstacle (Just ImgMiscTable4) =
+  [ Boundaries (0.34, 0) (1, 1)
+  ]
+imgObstacle (Just ImgMiscTableCorner) =
+  [ Boundaries (0, 0) (0.63, 1)
+  , Boundaries (0, 0.34) (1, 1)
+  ]
+imgObstacle _ = []

src/Types/Interior.hs

@@ -9,6 +9,8 @@ import Linear.V2
 import Types.Map
 import Types.UserData
 import Types.ReachPoint
+import Types.ImgId
+import Types.Direction
 
 data Cluster
   = ClusterBox1
@@ -79,20 +81,20 @@ clusterRoom ClusterTableGroup = Offi
 clusterPoints :: Cluster -> [ReachPoint]
 clusterPoints ClusterBox1 = []
 clusterPoints ClusterTable1 =
-  [ ReachPoint Table (V2 1 1) ]
+  [ ReachPoint Table (V2 1 1) NE]
 clusterPoints ClusterTable2 =
-  [ ReachPoint Table (V2 2 1) ]
+  [ ReachPoint Table (V2 2 1) NW]
 clusterPoints ClusterTable3 =
-  [ ReachPoint Table (V2 1 2) ]
+  [ ReachPoint Table (V2 1 2) SW]
 clusterPoints ClusterTable4 =
-  [ ReachPoint Table (V2 1 1) ]
+  [ ReachPoint Table (V2 1 1) SE]
 clusterPoints ClusterCornerTable =
-  [ ReachPoint Table (V2 2 1)
+  [ ReachPoint Table (V2 2 1) N
   ]
 clusterPoints ClusterTableGroup =
-  [ ReachPoint Table (V2 2 2)
+  [ ReachPoint Table (V2 2 2) N
-  , ReachPoint Table (V2 2 5)
+  , ReachPoint Table (V2 2 5) N
-  , ReachPoint Table (V2 5 5)
+  , ReachPoint Table (V2 5 5) N
   ]
 
 instance Size Cluster where

src/Types/ReachPoint.hs

@@ -1,10 +1,12 @@
 module Types.ReachPoint where
 
 import Linear (V2(..))
+import Types.Direction
 
 data ReachPoint = ReachPoint
   { pointType  :: PointType
   , pointCoord :: V2 Int
+  , pointDir   :: Direction
   }
   deriving (Show)
 

src/Types/StateData.hs

@@ -0,0 +1,16 @@
+module Types.StateData where
+
+import Data.Matrix
+
+import Types.ReachPoint
+import Types.Map
+import Types.ImgId
+
+data StateData
+  = None                                                                           
+  | MenuData                                                                       
+    { mapMat      :: Matrix TileState                                              
+    , initCoords  :: (Int, Int)                                                    
+    , imgMat      :: Matrix (Maybe ImgId)                                          
+    , reachPoints :: [ReachPoint]                                                  
+    }

src/Types/UserData.hs

@@ -17,7 +17,10 @@ import Data.Ecstasy
 import Control.Concurrent.MVar
 
 import Types.Map
-import Types.ReachPoint
+import Types.StateData
+import Types.ImgId
+import Types.Direction
+import Types.Animation
 
 data UserData = UserData
   { state           :: State
@@ -35,136 +38,10 @@ data State
   = Menu
   | Test
 
-data StateData
-  = None
-  | MenuData
-    { mapMat      :: Matrix TileState
-    , initCoords  :: (Int, Int)
-    , imgMat      :: Matrix (Maybe ImgId)
-    , reachPoints :: [ReachPoint]
-    }
-
-data ImgId
-  = ImgEmpty -- TODO: Find better solution thatn empty image.
-  | ImgWallAsc
-  | ImgWallDesc
-  | ImgWallCornerN
-  | ImgWallCornerE
-  | ImgWallCornerS
-  | ImgWallCornerW
-  | ImgWallTNE
-  | ImgWallTSE
-  | ImgWallTSW
-  | ImgWallTNW
-  | ImgWallCross
-  | ImgMiscBox1
-  | ImgMiscTable1
-  | ImgMiscTable2
-  | ImgMiscTable3
-  | ImgMiscTable4
-  | ImgMiscTableCorner
-  -- | ImgIntrNE
-  -- | ImgIntrE
-  -- | ImgIntrSE
-  -- | ImgIntrS
-  -- | ImgIntrSW
-  -- | ImgIntrW
-  -- | ImgIntrNW
-  -- | ImgIntrN
-  deriving (Show, Eq, Ord, Enum)
-
-isWall :: ImgId -> Bool
-isWall ImgMiscBox1 = False
-isWall ImgMiscTable1 = False
-isWall ImgMiscTable2 = False
-isWall ImgMiscTable3 = False
-isWall ImgMiscTable4 = False
-isWall ImgMiscTableCorner = False
-isWall _ = True
-
-imgObstacle :: Maybe ImgId -> [(Boundaries Double)]
-imgObstacle (Just ImgMiscBox1) = [Boundaries (0.2, 0.34) (0.8, 1)]
-imgObstacle (Just ImgWallAsc) = [Boundaries (0.34, 0) (0.66, 1)]
-imgObstacle (Just ImgWallDesc) = [Boundaries (0, 0.34) (1, 0.66)]
-imgObstacle (Just ImgWallCornerN) =
-  [ Boundaries (0, 0.34) (0.66, 0.66)
-  , Boundaries (0.34, 0.34) (0.66, 1)
-  ]
-imgObstacle (Just ImgWallCornerE) =
-  [ Boundaries (0.34, 0.34) (1, 0.66)
-  , Boundaries (0.34, 0.34) (0.66, 1)
-  ]
-imgObstacle (Just ImgWallCornerS) =
-  [ Boundaries (0.34, 0.34) (1, 0.66)
-  , Boundaries (0.34, 0) (0.66, 0.66)
-  ]
-imgObstacle (Just ImgWallCornerW) =
-  [ Boundaries (0, 0.34) (0.66, 0.66)
-  , Boundaries (0.34, 0) (0.66, 0.66)
-  ]
-imgObstacle (Just ImgWallTNE) =
-  [ Boundaries (0, 0.34) (1, 0.66)
-  , Boundaries (0.34, 0.34) (0.66, 1)
-  ]
-imgObstacle (Just ImgWallTSW) =
-  [ Boundaries (0, 0.34) (1, 0.66)
-  , Boundaries (0.34, 0) (0.66, 0.66)
-  ]
-imgObstacle (Just ImgWallTSE) =
-  [ Boundaries (0.34, 0) (0.66, 1)
-  , Boundaries (0.34, 0.34) (1, 0.66)
-  ]
-imgObstacle (Just ImgWallTNW) =
-  [ Boundaries (0.34, 0) (0.66, 1)
-  , Boundaries (0, 0.34) (0.66, 0.66)
-  ]
-imgObstacle (Just ImgWallCross) =
-  [ Boundaries (0.34, 0) (0.66, 1)
-  , Boundaries (0, 0.34) (1, 0.66)
-  ]
-imgObstacle (Just ImgMiscTable1) =
-  [ Boundaries (0, 0.34) (1, 1)
-  ]
-imgObstacle (Just ImgMiscTable2) =
-  [ Boundaries (0, 0) (0.63, 1)
-  ]
-imgObstacle (Just ImgMiscTable3) =
-  [ Boundaries (0, 0) (1, 0.63)
-  ]
-imgObstacle (Just ImgMiscTable4) =
-  [ Boundaries (0.34, 0) (1, 1)
-  ]
-imgObstacle (Just ImgMiscTableCorner) =
-  [ Boundaries (0, 0) (0.63, 1)
-  , Boundaries (0, 0.34) (1, 1)
-  ]
-imgObstacle _ = []
-
 data FontId
   = FontBedstead
   deriving (Show, Eq, Ord, Enum)
 
-data Direction
-  = NE
-  | E
-  | SE
-  | S
-  | SW
-  | W
-  | NW
-  | N
-  deriving (Show, Eq, Ord, Enum)
-
--- dirToImgId :: Direction -> ImgId
--- dirToImgId E  = ImgIntrE
--- dirToImgId SE = ImgIntrSE
--- dirToImgId S  = ImgIntrS
--- dirToImgId SW = ImgIntrSW
--- dirToImgId W  = ImgIntrW
--- dirToImgId NW = ImgIntrNW
--- dirToImgId N  = ImgIntrN
--- dirToImgId NE = ImgIntrNE
-
 data Entity f = Entity
   { pos           :: Component f 'Field (V2 Double)
   , gridPos       :: Component f 'Field (V2 Int)
@@ -243,37 +120,3 @@ generalUnSubscribe t uu =
   liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
   where
     filterMsg (u, _) p = u /= p
-
--- ANIMATIONS
-
-data AnimId = AnimId
-  { aiVariation :: Int
-  , aiName      :: String -- CHANGE ME !!!
-  , aiDirection :: Direction
-  }
-  deriving (Show, Eq, Ord)
-
-data AnimState = AnimState
-  { asId           :: AnimId
-  , asCurrentFrame :: Int
-  , asElapsedTime  :: Double
-  }
-  deriving (Show)
-
-data AnimPlayback
-  = APLoop
-  | APOnce
-
-data Animation = Animation
-  { animDuration :: Double
-  , animSprites  :: [Image]
-  , animPlay     :: AnimPlayback
-  }
-
-data AnimationConfig = AnimationConfig
-  { animConfOffset   :: (Int, Int)
-  , animConfSize     :: (Int, Int)
-  , animConfCount    :: Int
-  , animConfDuration :: Double
-  , animConfPlay     :: AnimPlayback
-  }

tracer-game.cabal

@@ -22,6 +22,10 @@ executable tracer-game
                      , Types.Map
                      , Types.Interior
                      , Types.ReachPoint
+                     , Types.Direction
+                     , Types.ImgId
+                     , Types.StateData
+                     , Types.Animation
                      , StateMachine
                      , Floorplan
                      , Interior