don't draw NPCs outside of visible area

This commit is contained in:
nek0 2018-04-26 15:25:38 +02:00
parent b6deacbf14
commit 755350ba9f
3 changed files with 28 additions and 8 deletions

View file

@ -30,11 +30,22 @@ drawNPCs
-> Double -> Double
-> Int -> Int
-> Int -> Int
-> Maybe ImgId
-> Affection UserData () -> Affection UserData ()
drawNPCs ctx npcposs prow pcol row col = do drawNPCs ctx npcposs prow pcol row col img = do
ud <- getAffection ud <- getAffection
let fnpcposs = filter let fnpcposs = filter
(\(V2 nr nc) -> floor nr == row && floor nc == col) (\(V2 nr nc) ->
let x = realToFrac $ 640 + ((nc - pcol) + (nr - prow)) * 32
y = realToFrac $ 360 + ((nr - prow) - (nc - pcol)) * 16
in ((realToFrac x > -tileWidth && realToFrac y > -tileHeight) &&
(realToFrac x < 1280 && realToFrac (y - (74 - realToFrac tileHeight)) < 720)) &&
((all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs &&
all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) mincs) ||
(all (\m -> prow > (fromIntegral (floor prow :: Int)) + m) minrs &&
all (\m -> pcol < (fromIntegral (floor pcol :: Int)) + m) maxcs)) &&
(floor nr == row && floor nc == col)
)
npcposs npcposs
liftIO $ mapM_ liftIO $ mapM_
(\(V2 nr nc) -> do (\(V2 nr nc) -> do
@ -47,6 +58,14 @@ drawNPCs ctx npcposs prow pcol row col = do
fill ctx fill ctx
) )
fnpcposs fnpcposs
where
tileWidth = 64 :: Double
tileHeight = 32 :: Double
mb = imgObstacle img
minrs = Prelude.map (fst . matmin) mb
maxrs = Prelude.map (fst . matmax) mb
mincs = Prelude.map (snd . matmin) mb
maxcs = Prelude.map (snd . matmax) mb
placeNPCs placeNPCs
:: M.Matrix (Maybe ImgId) :: M.Matrix (Maybe ImgId)

View file

@ -161,7 +161,7 @@ drawMap = do
(\(j, t) -> do (\(j, t) -> do
liftIO $ drawTile liftIO $ drawTile
(assetImages ud) ctx pr pc i j t (assetImages ud) ctx pr pc i j t
drawNPCs ctx npcposs pr pc i j drawNPCs ctx npcposs pr pc i j t
) )
(reverse $ zip [1..] ls)) (reverse $ zip [1..] ls))
(zip [1..] (toLists mat)) (zip [1..] (toLists mat))

View file

@ -133,7 +133,7 @@ astarAppl imgmat target start = aStar
naviGraph :: Matrix (Maybe ImgId) -> V2 Int -> HS.HashSet (V2 Int) naviGraph :: Matrix (Maybe ImgId) -> V2 Int -> HS.HashSet (V2 Int)
naviGraph imgmat (V2 r c) = naviGraph imgmat (V2 r c) =
let list = let list1 =
foldl foldl
(\acc (or, oc) -> (\acc (or, oc) ->
if null (imgObstacle $ imgmat M.! (r + or, c + oc)) if null (imgObstacle $ imgmat M.! (r + or, c + oc))
@ -142,16 +142,17 @@ naviGraph imgmat (V2 r c) =
) )
[] []
[(0, 1), (0, -1), (1, 0), (-1, 0)] [(0, 1), (0, -1), (1, 0), (-1, 0)]
++ list2 =
foldl foldl
(\acc (or, oc) -> (\acc (or, oc) ->
if all null if null (imgObstacle $ imgmat M.! (r + or, c + oc))
&& any null
(map (map
(\(oor, ooc) -> imgObstacle $ imgmat M.! (r + oor, c + ooc)) (\(oor, ooc) -> imgObstacle $ imgmat M.! (r + oor, c + ooc))
[(0, oc), (or, 0), (or, oc)]) [(0, oc), (or, 0)])
then V2 (r + or) (c + oc): acc then V2 (r + or) (c + oc): acc
else acc else acc
) )
[] []
[(-1, -1), (-1, 1), (1, -1), (1, 1)] [(-1, -1), (-1, 1), (1, -1), (1, 1)]
in HS.fromList list in HS.fromList (list1 ++ list2)