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

I present: copiers

Browse source
This commit is contained in:
nek0 2018-07-21 06:43:26 +02:00
parent 2f8a267b09
commit b70b50e513
11 changed files with 149 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/Interior.hs
View file

@ -38,7 +38,7 @@ placeInteriorIO imat imgmat irp graph =
-> (StdGen, (Matrix (Maybe ImgId), [ReachPoint]))
traverseGraph acc (GHall sub) =
foldl traverseGraph acc sub
traverseGraph putt@(_, _) (GRoom _ bnds) =
traverseGraph putt (GRoom _ bnds) =
let applicable =
(L.sortBy (\b a -> size a `compare` size b) (
L.filter
@ -90,6 +90,7 @@ placeInteriorIO imat imgmat irp graph =
reaches = map (+ V2 (pr - 1) (pc - 1))
(map pointCoord (clusterPoints appl))
reachdirs = map pointDir (clusterPoints appl)
reachtypes = map pointType (clusterPoints appl)
oldreaches = foldl (\acc p ->
if pointType p /= RoomExit && inBounds (pointCoord p) bnds
then pointCoord p : acc
@ -97,7 +98,8 @@ placeInteriorIO imat imgmat irp graph =
)
[]
rp
newrp = rp ++ map (uncurry (ReachPoint Table)) (zip reaches reachdirs)
newrp = rp ++ map (\(a, b, c) -> ReachPoint a b c)
(zip3 reachtypes reaches reachdirs)
in
if try > 10 || fromIntegral freeRoom < size appl
then (g2, (mat, rp))

66
src/Load.hs
View file

@ -59,7 +59,7 @@ loadFork
-> MVar (Float, T.Text)
-> IO ()
loadFork ws win glc nvg future progress = do
let stateSteps = 22
let stateSteps = 24
increment = 1 / stateSteps
SDL.glMakeCurrent win glc
modifyMVar_ progress (return . (\(p, _) ->
@ -162,36 +162,74 @@ loadFork ws win glc nvg future progress = do
exitFailure
-- playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg
-- (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE])
let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs
let imgs = zipWith (\a b -> (a, fromJust b))
[ ImgWallAsc
, ImgWallDesc
, ImgWallCornerN
, ImgWallCornerE
, ImgWallCornerS
, ImgWallCornerW
, ImgWallTNE
, ImgWallTSE
, ImgWallTSW
, ImgWallTNW
, ImgWallCross
, ImgMiscBox1
, ImgMiscTable1
, ImgMiscTable2
, ImgMiscTable3
, ImgMiscTable4
, ImgMiscTableCorner
]
mimgs
directions = [E .. N] ++ [NE]
standIds var = map (AnimId var "standing") directions
walkIds var = map (AnimId var "walking") directions
standConfigs = map
(\i -> AnimationConfig (0, i * 74) (64, 74) 1 0 APLoop)
[0 .. length (standIds 0) - 1]
(\i -> AnimationConfig (0, i * 74) (64, 74) (64, 0) 1 0 APLoop)
[0 .. length (standIds "intruder") - 1]
walkConfigs = map
(\i -> AnimationConfig (64, i * 74) (64, 74) 6 1.5 APLoop)
[0 .. length (walkIds 0) - 1]
(\i -> AnimationConfig (64, i * 74) (64, 74) (64, 0) 6 1.5 APLoop)
[0 .. length (walkIds "intruder") - 1]
playerStanding <- loadAnimationSprites "assets/intruder.png" nvg
(zip (standIds 0) standConfigs)
(zip (standIds "intruder") standConfigs)
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"intruder: walking\""
)))
playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
(zip (walkIds 0) walkConfigs)
(zip (walkIds "intruder") walkConfigs)
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"jdoem: standing\""
)))
jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg
(zip (standIds 1) standConfigs)
(zip (standIds "jdoem") standConfigs)
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"jdoem: walking\""
)))
jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg
(zip (walkIds 1) walkConfigs)
(zip (walkIds "jdoem") walkConfigs)
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"copier: stand\""
)))
copierStand <- loadAnimationSprites "assets/misc/copier.png" nvg $ zip
(map (\name -> AnimId "copier" name N) ["closed", "open"])
(map
(\i -> AnimationConfig (0, i * 74) (64, 74) (0, 0) 1 0 APLoop)
[0, 1]
)
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"copier: copy\""
)))
copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg $
[ ( AnimId "copier" "copy" N
, AnimationConfig (64, 0) (64, 74) (64, 0) 4 0.5 APOnce
)
]
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Handing over"
@ -202,7 +240,13 @@ loadFork ws win glc nvg future progress = do
, LoadData
{ loadAssetImages = M.fromList imgs
, loadAssetAnims = M.fromList
(playerStanding ++ playerWalking ++ jdoemStanding ++ jdoemWalking)
( playerStanding ++
playerWalking ++
jdoemStanding ++
jdoemWalking ++
copierStand ++
copierCopy
)
}
)

11
src/MainGame/MindMap.hs
View file

@ -159,7 +159,8 @@ drawMind = do
with mmpos
stat <- query anim
pos' <- query mmpos
return (pos', stat)
mbnds <- queryMaybe obstacle
return (pos', stat, mbnds)
return (pc, posanims)
let V2 pr pc = playerPos
mat = mmImgMat (stateData ud)
@ -186,11 +187,13 @@ drawMind = do
)
)
processList
:: [(V2 Double, AnimState)]
:: [(V2 Double, AnimState, Maybe (Boundaries Double))]
-> (Int, Int)
-> ([(V2 Double, AnimState)], [(V2 Double, AnimState)])
-> ( [(V2 Double, AnimState, Maybe (Boundaries Double))]
, [(V2 Double, AnimState, Maybe (Boundaries Double))]
)
processList list (r, c) =
let delimiter (V2 nr nc, _) =
let delimiter (V2 nr nc, _, _) =
floor nr == r && floor nc == c
in L.partition delimiter list
liftIO $ do -- draw floor

69
src/MainGame/WorldMap.hs
View file

@ -75,7 +75,7 @@ loadMapFork
-> MVar (Float, T.Text)
-> IO ()
loadMapFork ud future progress = do
let loadSteps = 18
let loadSteps = 19
fc = FloorConfig
(10, 10)
[(5, 5), (5, 45)]
@ -85,7 +85,7 @@ loadMapFork ud future progress = do
_ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images")
let imgmat = convertTileToImg mat
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) NE : acc
else acc
)
@ -96,7 +96,7 @@ loadMapFork ud future progress = do
_ <- liftIO $ swapMVar progress (13 / loadSteps, "Placing NPCs")
logIO A.Debug ("number of reachpoints: " ++ show (length rps))
let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps
npcposs <- placeNPCs inter mat rps 100 -- (length nnex)
npcposs <- placeNPCs inter mat rps 10 -- (length $ filter (\a -> pointType a == Table) nnex)
_ <- liftIO $ swapMVar progress (14 / loadSteps, "Preparing MindMap graph")
A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs)
!(mmintmat, mmgraph) <- buildFloorMap . springField <$>
@ -124,9 +124,20 @@ loadMapFork ud future progress = do
, mmvel = Just (V2 0 0)
, player = Just ()
, rot = Just SE
, anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0
, anim = Just $ AnimState (AnimId "intruder" "standing" SE) 0 0
}
void $ liftIO $ swapMVar progress (17 / loadSteps, "Registering NPCs into WorldState")
void $ liftIO $ swapMVar progress (17 / loadSteps, "Registering copiers into WorldState")
let copiers = Prelude.filter (\a -> pointType a == Copier) rps
mapM_ (\(ReachPoint _ icoord _) -> do
let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
void $ createEntity $ newEntity
{ pos = Just $ reachCoord - V2 1 0
, obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36)
, anim = Just $ AnimState (AnimId "copier" "closed" N) 0 0
, objAccess = Just $ V2 1 0
}
) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers)
void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering NPCs into WorldState")
mapM_ (\npcpos@(V2 nr nc) -> do
fact <- liftIO $ randomRIO (0.5, 1.5)
fut <- liftIO newEmptyMVar
@ -137,15 +148,15 @@ loadMapFork ud future progress = do
, velFact = Just fact
, rot = Just SE
, npcMoveState = Just (NPCStanding 0 fut)
, anim = Just $ AnimState (AnimId 1 "standing" SE) 0 0
, anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
}
) npcposs
void $ liftIO $ swapMVar progress (18 / loadSteps, "Handing over")
void $ liftIO $ swapMVar progress (19 / loadSteps, "Handing over")
putMVar future (nws, MainData
{ mapMat = mat
, imgMat = M.fromList (nrows inter) (ncols inter) $
Prelude.map
(\a -> if a == Just ImgEmpty then Nothing else a)
(\a -> if a == Just (ImgEmpty []) then Nothing else a)
(M.toList inter)
, reachPoints = rps
, mmImgMat = mmimgmat
@ -204,7 +215,8 @@ drawMap = do
with pos
stat <- query anim
pos' <- query pos
return (pos', stat)
mbnds <- queryMaybe obstacle
return (pos', stat, mbnds)
return (pc, posanims)
let V2 pr pc = playerPos
mat = imgMat (stateData ud)
@ -231,11 +243,13 @@ drawMap = do
)
)
processList
:: [(V2 Double, AnimState)]
:: [(V2 Double, AnimState, Maybe (Boundaries Double))]
-> (Int, Int)
-> ([(V2 Double, AnimState)], [(V2 Double, AnimState)])
-> ( [(V2 Double, AnimState, Maybe (Boundaries Double))]
, [(V2 Double, AnimState, Maybe (Boundaries Double))]
)
processList list (r, c) =
let delimiter (V2 nr nc, _) =
let delimiter (V2 nr nc, _, _) =
floor nr == r && floor nc == c
in L.partition delimiter list
liftIO $ do -- draw floor
@ -266,7 +280,7 @@ drawMap = do
drawTile
:: UserData
-> Context
-> [(V2 Double, AnimState)]
-> [(V2 Double, AnimState, Maybe (Boundaries Double))]
-> Double
-> Double
-> Int
@ -282,11 +296,18 @@ drawTile ud ctx posanims pr pc row col img =
save ctx
mapM_ drawAnim beh
maybe (return ()) (draw ud x (y - 42) 64 74 fact)
((assetImages ud Map.!) <$> img)
((assetImages ud Map.!) <$> case img of
Just (ImgEmpty _) -> Nothing
_ -> img
)
mapM_ drawAnim bef
restore ctx
when (floor pr == row && floor pc == col) $ do
A.logIO A.Debug ("sorted: " ++ show sorted)
A.logIO A.Debug ("beh: " ++ show beh)
A.logIO A.Debug ("bef: " ++ show bef)
where
delimiter (V2 nr nc, _) =
delimiter (V2 nr nc, _, mbnds) =
all delimit mb
where
delimit b
@ -296,13 +317,22 @@ drawTile ud ctx posanims pr pc row col img =
nnr > fst (matmax b)
| otherwise =
True
nnr = nr - fromIntegral ((floor nr) :: Int) :: Double
nnc = nc - fromIntegral ((floor nc) :: Int) :: Double
nnr = case mbnds of
Just (Boundaries (minr, minc) (maxr, maxc)) -> maxr
Nothing -> nr - fromIntegral ((floor nr) :: Int) :: Double
nnc = case mbnds of
Just (Boundaries (minr, minc) (maxr, maxc)) -> minc
Nothing -> nc - fromIntegral ((floor nc) :: Int) :: Double
-- any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs &&
-- any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs
tileWidth = 64 :: Double
tileHeight = 32 :: Double
sorted = sortOn (\(V2 sr sc, _) -> sc + sr * fromIntegral col) posanims
sorted = sortOn (\(V2 sr sc, _, mbnds) -> case mbnds of
Just (Boundaries (minr, minc) (maxr, maxc)) -> minr * 10 + (1 - minc)
_ -> (sr - (fromIntegral ((floor sr) :: Int))) * 10 +
(1 - (sc - (fromIntegral ((floor sc) :: Int))))
) posanims
-- sorted = posanims
minrs = Prelude.map (fst . matmin) mb
maxrs = Prelude.map (fst . matmax) mb
mincs = Prelude.map (snd . matmin) mb
@ -320,7 +350,7 @@ drawTile ud ctx posanims pr pc row col img =
then min 1 dist
else 1
mb = maybe [] collisionObstacle img
drawAnim (V2 nr nc, as) = do
drawAnim (V2 nr nc, as, _) = do
let ax = realToFrac $ 640 + ((nc - pc) + (nr - pr)) * 32 - 32
ay = realToFrac $ 360 + ((nr - pr) - (nc - pc)) * 16 - 58
draw ud ax ay 64 74 1 as
@ -504,6 +534,7 @@ updateMap dt = do
, rot = Set (fromMaybe rot' $ direction vel')
, anim = Set nstat
}
-- liftIO $ A.logIO A.Debug ("player position: " ++ show (pos' + colldpos))
return ent
updateNPCs
(imgMat $ stateData ud)

3
src/Types/Animation.hs
View file

@ -5,7 +5,7 @@ import NanoVG (Image)
import Types.Direction
data AnimId = AnimId
{ aiVariation :: Int
{ aiVariation :: String
, aiName :: String -- CHANGE ME !!!
, aiDirection :: Direction
}
@ -33,6 +33,7 @@ data Animation = Animation
data AnimationConfig = AnimationConfig
{ animConfOffset :: (Int, Int)
, animConfSize :: (Int, Int)
, animConfStep :: (Int, Int)
, animConfCount :: Int
, animConfDuration :: Double
, animConfPlay :: AnimPlayback

1
src/Types/Collidible.hs
View file

@ -76,4 +76,5 @@ instance Collidible ImgId where
[ Boundaries (0, 0) (0.63, 1)
, Boundaries (0, 0.34) (1, 1)
]
collisionObstacle (ImgEmpty b) = b
collisionObstacle _ = []

4
src/Types/ImgId.hs
View file

@ -3,7 +3,7 @@ module Types.ImgId where
import Types.Map
data ImgId
= ImgEmpty -- TODO: Find better solution thatn empty image.
= ImgEmpty [Boundaries Double] -- TODO: Find better solution than empty image.
| ImgWallAsc
| ImgWallDesc
| ImgWallCornerN
@ -29,7 +29,7 @@ data ImgId
-- | ImgIntrW
-- | ImgIntrNW
-- | ImgIntrN
deriving (Show, Eq, Ord, Enum)
deriving (Show, Eq, Ord)
isWall :: ImgId -> Bool
isWall ImgMiscBox1 = False

36
src/Types/Interior.hs
View file

@ -19,6 +19,7 @@ data Cluster
| ClusterTable4
| ClusterCornerTable
| ClusterTableGroup
| ClusterCopier
deriving (Enum, Bounded)
clusterMat :: Cluster -> Matrix (Maybe ImgId)
@ -30,43 +31,48 @@ clusterMat ClusterBox1 =
]
clusterMat ClusterTable1 =
M.fromLists
[[Just ImgEmpty, Just ImgMiscTable1]]
[[Just (ImgEmpty []), Just ImgMiscTable1]]
clusterMat ClusterTable2 =
M.fromLists
[ [Just ImgMiscTable2]
, [Just ImgEmpty]
, [Just (ImgEmpty [])]
]
clusterMat ClusterTable3 =
M.fromLists
[[Just ImgMiscTable3, Just ImgEmpty]]
[[Just ImgMiscTable3, Just (ImgEmpty [])]]
clusterMat ClusterTable4 =
M.fromLists
[ [Just ImgEmpty]
[ [Just (ImgEmpty [])]
, [Just ImgMiscTable4]
]
clusterMat ClusterCornerTable =
M.fromLists
[ [Just ImgMiscTable2, Just ImgMiscTableCorner]
, [Just ImgEmpty , Just ImgMiscTable1]
, [Just (ImgEmpty []), Just ImgMiscTable1]
]
clusterMat ClusterTableGroup =
M.fromLists
[ [ Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
, Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
[ [ Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
, Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
]
, [ Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1
, Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1
, [ Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
, Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
]
, [ Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
, Just ImgEmpty, Just ImgEmpty, Just ImgEmpty
, [ Just (ImgEmpty []), Just (ImgEmpty []), Just (ImgEmpty [])
, Just (ImgEmpty []), Just (ImgEmpty []), Just (ImgEmpty [])
]
, [ Nothing, Nothing, Nothing
, Just ImgEmpty, Just ImgMiscTable2, Just ImgMiscTableCorner
, Just (ImgEmpty []), Just ImgMiscTable2, Just ImgMiscTableCorner
]
, [ Nothing, Nothing, Nothing
, Just ImgEmpty, Just ImgEmpty, Just ImgMiscTable1
, Just (ImgEmpty []), Just (ImgEmpty []), Just ImgMiscTable1
]
]
clusterMat ClusterCopier =
M.fromLists
[ [ Just (ImgEmpty [Boundaries (10/36, 8/36) (28/36, 30/36)])]
, [ Just (ImgEmpty [])]
]
clusterRoom :: Cluster -> TileState
clusterRoom ClusterBox1 = Offi
@ -76,6 +82,7 @@ clusterRoom ClusterTable3 = Offi
clusterRoom ClusterTable4 = Offi
clusterRoom ClusterCornerTable = Offi
clusterRoom ClusterTableGroup = Offi
clusterRoom ClusterCopier = Offi
clusterPoints :: Cluster -> [ReachPoint]
clusterPoints ClusterBox1 = []
@ -95,6 +102,9 @@ clusterPoints ClusterTableGroup =
, ReachPoint Table (V2 2 5) N
, ReachPoint Table (V2 5 5) N
]
clusterPoints ClusterCopier =
[ ReachPoint Copier (V2 2 1) NW
]
instance Size Cluster where
size c =

2
src/Types/Map.hs
View file

@ -33,7 +33,7 @@ data FloorConfig = FloorConfig
data Boundaries a = Boundaries
{ matmin :: (a, a)
, matmax :: (a, a)
} deriving (Show, Eq)
} deriving (Show, Eq, Ord)
instance Size (Boundaries Int) where
size (Boundaries (minr, minc) (maxr, maxc)) =

1
src/Types/ReachPoint.hs
View file

@ -13,4 +13,5 @@ data ReachPoint = ReachPoint
data PointType
= RoomExit
| Table
| Copier
deriving (Eq, Show)

6
src/Util.hs
View file

@ -100,7 +100,7 @@ convertTileToImg mat = fromLists conversion
| any
(\(rr, cc) -> M.safeGet (irow + rr) (icol + cc) mat == Just Door)
[(1, 0), (-1, 0), (0, 1), (0, -1)] ->
Just ImgEmpty
Just (ImgEmpty [])
| otherwise ->
Nothing
_ ->
@ -208,9 +208,9 @@ loadAnimationSprites fp nvg idconfs = do
Right dimg -> do
let img = convertRGBA8 dimg
mapM
(\(i, (AnimationConfig (xoffs, yoffs) (w, h) count dur pb)) -> do
(\(i, (AnimationConfig (xoffs, yoffs) (w, h) (sx, sy) count dur pb)) -> do
let crs = map
(\iid -> crop (xoffs + (iid * w)) yoffs w h img)
(\iid -> crop (xoffs + (iid * sx)) (yoffs + (iid * sy)) w h img)
[0 .. (count - 1)]
mresimgs <- mapM
(\cr ->