From 755350ba9fb8f728243303df1e2134db357378d0 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@chelnok.de>
Date: Thu, 26 Apr 2018 15:25:38 +0200
Subject: [PATCH] don't draw NPCs outside of visible area

---
 src/NPC.hs  | 23 +++++++++++++++++++++--
 src/Test.hs |  2 +-
 src/Util.hs | 11 ++++++-----
 3 files changed, 28 insertions(+), 8 deletions(-)

diff --git a/src/NPC.hs b/src/NPC.hs
index 06f2ee2..1eedec4 100644
--- a/src/NPC.hs
+++ b/src/NPC.hs
@@ -30,11 +30,22 @@ drawNPCs
   -> Double
   -> Int
   -> Int
+  -> Maybe ImgId
   -> Affection UserData ()
-drawNPCs ctx npcposs prow pcol row col = do
+drawNPCs ctx npcposs prow pcol row col img = do
   ud <- getAffection
   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
   liftIO $ mapM_
     (\(V2 nr nc) -> do
@@ -47,6 +58,14 @@ drawNPCs ctx npcposs prow pcol row col = do
       fill ctx
       )
     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
   :: M.Matrix (Maybe ImgId)
diff --git a/src/Test.hs b/src/Test.hs
index 82154aa..b60a9f1 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -161,7 +161,7 @@ drawMap = do
     (\(j, t) -> do
       liftIO $ drawTile
         (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))
     (zip [1..] (toLists mat))
diff --git a/src/Util.hs b/src/Util.hs
index 6d39bd2..e1e833a 100644
--- a/src/Util.hs
+++ b/src/Util.hs
@@ -133,7 +133,7 @@ astarAppl imgmat target start = aStar
 
 naviGraph :: Matrix (Maybe ImgId) -> V2 Int -> HS.HashSet (V2 Int)
 naviGraph imgmat (V2 r c) =
-  let list =
+  let list1 =
         foldl
           (\acc (or, 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)]
-        ++
+      list2 =
         foldl
           (\acc (or, oc) ->
-            if all null
+            if null (imgObstacle $ imgmat M.! (r + or, c + oc))
+              && any null
               (map
               (\(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
             else acc
             )
           []
           [(-1, -1), (-1, 1), (1, -1), (1, 1)]
-  in  HS.fromList list
+  in  HS.fromList (list1 ++ list2)