From 03b84b02dbeea3f40e30e8d2bcd56b3b4cea1476 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@chelnok.de>
Date: Sun, 3 Jun 2018 04:28:39 +0200
Subject: [PATCH] hunting again

---
 src/NPC.hs  |  3 ++-
 src/Test.hs | 43 +++++++++++++++++++++++++++++++++----------
 2 files changed, 35 insertions(+), 11 deletions(-)

diff --git a/src/NPC.hs b/src/NPC.hs
index ea353bb..dce1758 100644
--- a/src/NPC.hs
+++ b/src/NPC.hs
@@ -160,7 +160,8 @@ updateNPCs imgmat rp dt =
         else do
           ttl <- liftIO $ randomRIO (5, 30)
           future <- liftIO $ newEmptyMVar
-          _ <- 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
           return $ unchanged
             { npcState = Set $ NPCStanding ttl future
             }
diff --git a/src/Test.hs b/src/Test.hs
index 66dd6ca..04bbe4f 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -16,7 +16,7 @@ import qualified Data.Text as T
 import Data.Matrix as M
 import Data.Ecstasy as E
 import Data.Maybe
-import Data.List (sortOn)
+import Data.List as L (sortOn, partition)
 
 import System.Random (randomRIO)
 
@@ -131,8 +131,7 @@ drawMap = do
     pc <- fmap head $ efor allEnts $ do
       with player
       with pos
-      pos' <- query pos
-      pure pos'
+      query pos
     posanims <- efor allEnts $ do
       with anim
       with pos
@@ -149,6 +148,30 @@ drawMap = do
       tileHeight = 32 :: Double
       x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2)
       y = realToFrac $ 360 + ((1 - pr) - (1 - pc)) * (tileHeight / 2)
+      partposanims = M.fromList
+        (nrows $ mapMat $ stateData ud)
+        (ncols $ mapMat $ stateData ud)
+        ((reverse . fst) $
+          (Prelude.foldl
+            (\(done, proc) coord ->
+              let (ndone, nproc) = processList proc coord
+              in  (ndone : done, nproc)
+              )
+            ([], posanims)
+            ((,)
+              <$> [1 .. (nrows $ mapMat $ stateData ud)]
+              <*> [1 .. (ncols $ mapMat $ stateData ud)]
+              )
+            )
+          )
+      processList
+        :: [(V2 Double, AnimState)]
+        -> (Int, Int)
+        -> ([(V2 Double, AnimState)], [(V2 Double, AnimState)])
+      processList list coord@(r, c) =
+        let delimiter (V2 nr nc, _) =
+              floor nr == r && floor nc == c
+        in  L.partition delimiter list
   liftIO $ do -- draw floor
     beginPath ctx
     moveTo ctx (x + realToFrac tileWidth / 2) y
@@ -165,7 +188,7 @@ drawMap = do
     fillColor ctx (rgb 255 255 255)
     fill ctx
     mapM_ (\(i, ls) -> mapM_
-        (uncurry (drawTile ud ctx posanims pr pc i))
+        (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t)
         (reverse $ zip [1..] ls))
       (zip [1..] (toLists mat))
     fontSize ctx 20
@@ -189,8 +212,8 @@ drawTile ud ctx posanims pr pc row col img =
     ((realToFrac x :: Double) < 1280 &&
     (realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $
       do
-        let lt = Prelude.filter delimiter sorted
-            ge = Prelude.filter (not . delimiter) sorted
+        let (lt, ge) = L.partition delimiter filtered
+            -- ge = Prelude.filter (not . delimiter) sorted
         save ctx
         mapM_ drawAnim lt
         when (isJust img) drawImage
@@ -198,8 +221,8 @@ drawTile ud ctx posanims pr pc row col img =
         restore ctx
   where
     delimiter (V2 nr nc, _) =
-      (any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs &&
-      any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs)
+      any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs &&
+      any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs
     ai = assetImages ud
     anims = assetAnimations ud
     tileWidth = 64 :: Double
@@ -418,10 +441,10 @@ updateMap dt = do
             (
               concatMap
               (\(dr, dc) ->
-                let bs = fromMaybe [] (imgObstacle <$> (M.safeGet
+                let bs = fromMaybe [] (imgObstacle <$> M.safeGet
                       (fromIntegral $ floor pr + dr)
                       (fromIntegral $ floor pc + dc)
-                      (imgMat (stateData ud))))
+                      (imgMat (stateData ud)))
                 in  Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))->
                       Boundaries
                         (minr + fromIntegral dr, minc + fromIntegral dc)