restructuring and adding final rotation after walking

This commit is contained in:
nek0 2018-06-04 05:29:20 +02:00
parent 88c988ddbf
commit 0a740334c5
13 changed files with 209 additions and 183 deletions

View file

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

View file

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

View file

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

View file

@ -44,7 +44,7 @@ loadMap = do
let imgmat = convertTileToImg mat let imgmat = convertTileToImg mat
exits = Prelude.foldl exits = Prelude.foldl
(\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty (\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 else acc
) )
[] []

View file

@ -6,3 +6,7 @@ import Types.UserData as T
import Types.Map as T import Types.Map as T
import Types.Interior as T import Types.Interior as T
import Types.ReachPoint 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

37
src/Types/Animation.hs Normal file
View file

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

12
src/Types/Direction.hs Normal file
View file

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

99
src/Types/ImgId.hs Normal file
View file

@ -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 _ = []

View file

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

View file

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

16
src/Types/StateData.hs Normal file
View file

@ -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]
}

View file

@ -17,7 +17,10 @@ import Data.Ecstasy
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Types.Map import Types.Map
import Types.ReachPoint import Types.StateData
import Types.ImgId
import Types.Direction
import Types.Animation
data UserData = UserData data UserData = UserData
{ state :: State { state :: State
@ -35,136 +38,10 @@ data State
= Menu = Menu
| Test | 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 data FontId
= FontBedstead = FontBedstead
deriving (Show, Eq, Ord, Enum) 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 data Entity f = Entity
{ pos :: Component f 'Field (V2 Double) { pos :: Component f 'Field (V2 Double)
, gridPos :: Component f 'Field (V2 Int) , gridPos :: Component f 'Field (V2 Int)
@ -243,37 +120,3 @@ generalUnSubscribe t uu =
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu)) liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uu))
where where
filterMsg (u, _) p = u /= p 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
}

View file

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