nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

restructuring and adding final rotation after walking

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/Interior.hs
View file

@ -16,10 +16,7 @@ import System.Random
import Navigation
import Util
import Types.Interior
import Types.Map
import Types.UserData
import Types.ReachPoint
import Types
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))

20
src/NPC.hs
View file

@ -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.Interior
import Types.Map
import Types.ReachPoint
import Types
-- 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
}
}
}

5
src/Navigation.hs
View file

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

2
src/Test.hs
View file

@ -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
)
[]

4
src/Types.hs
View file

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

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

18
src/Types/Interior.hs
View file

@ -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 5)
, ReachPoint Table (V2 5 5)
[ ReachPoint Table (V2 2 2) N
, ReachPoint Table (V2 2 5) N
, ReachPoint Table (V2 5 5) N
]
instance Size Cluster where

2
src/Types/ReachPoint.hs
View file

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

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

165
src/Types/UserData.hs
View file

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

4
tracer-game.cabal
View file

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