fix and optimization

src/MainGame/WorldMap.hs

@@ -675,13 +675,6 @@ updateMap dt = do
               }
         -- liftIO $ A.logIO A.Debug ("player position: " ++ show (pos' + colldpos))
         return ent
-      updateNPCs
-        (imgMat $ stateData ud)
-        (Prelude.filter
-          (\p -> pointType p /= RoomExit)
-          (reachPoints $ stateData ud)
-          )
-        dt
       tses <- efor allEnts $ do
           with objType
           with objState
@@ -692,8 +685,16 @@ updateMap dt = do
       mapM_ (\(t, s, e) ->
         objectAction dt t s e
         ) tses
+    (nws2, _) <- yieldSystemT nws $ updateNPCs
+      (imgMat $ stateData ud)
+      (Prelude.filter
+        (\p -> pointType p /= RoomExit)
+        (reachPoints $ stateData ud)
+        )
+      dt
+      nws
     putAffection ud
-      { worldState = nws
+      { worldState = nws2
       }
 
 checkBoundsCollision2

src/NPC.hs

@@ -6,9 +6,10 @@ import Affection as A
 
 import qualified Data.Matrix as M
 import Data.Ecstasy as E
-import Data.Maybe (fromMaybe, fromJust)
+import Data.Maybe
 import Data.List (find)
 
+import Control.Monad.Trans
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Concurrent.MVar
 import Control.Concurrent (forkIO)
@@ -61,18 +62,29 @@ updateNPCs
   :: M.Matrix (Maybe ImgId)
   -> [ReachPoint]
   -> Double
+  -> SystemState Entity (AffectionState (AffectionData UserData) IO)
   -> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
-updateNPCs imgmat rp dt = do
+updateNPCs imgmat rp dt ws = do
   posbounds <- efor allEnts $ do
     with pos
     with obstacle
     pos' <- query pos
     bnds <- query obstacle
     return (pos', bnds)
-  npcs <- efor allEnts $ do
+  npcposs <- efor allEnts $ do
+    with pos
     with npcMoveState
     with vel
+    with rot
+    with anim
+    pos' <- query pos
+    e <- queryEnt
+    return (e, pos')
+  eaccess <- getObjects npcposs
+  moent <- catMaybes <$> (eover allEnts $ do
     with pos
+    with npcMoveState
+    with vel
     with rot
     with anim
     pos' <- query pos
@@ -80,10 +92,6 @@ updateNPCs imgmat rp dt = do
     let mdir =
           (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
     e <- queryEnt
-    return (e, pos', rot', mdir)
-  mapM_ (\(e, pos', rot', mdir) -> do
-    accessibles <- getObjects pos'
-    moent <- runQueryT e $ do
     npcState' <- query npcMoveState
     case npcState' of
       NPCStanding ttl future -> do
@@ -122,23 +130,12 @@ updateNPCs imgmat rp dt = do
         else do
           future <- liftIO $ newEmptyMVar
           stat <- query anim
-            rot' <- query rot
-            pos' <- query pos
           _ <- liftIO $ forkIO $
             getPath (fmap floor pos') future rp imgmat posbounds
+          e <- queryEnt
           let mdir = 
                 (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
-            -- ttl <- liftIO $ randomRIO (5, 30)
+              accessibles = fromMaybe [] $ lookup e eaccess
-            -- return $ (Nothing, unchanged
-            --   { npcMoveState = Set $ NPCStanding ttl future
-            --   , vel      = Set $ V2 0 0
-            --   , rot      = Set $ fromMaybe rot' mdir
-            --   , anim     = Set stat
-            --     { asId = (asId stat)
-            --       { aiDirection = fromMaybe rot' mdir
-            --       }
-            --     }
-            --   })
           case accessibles of
             [] -> do
               ttl <- liftIO $ randomRIO (5, 30)
@@ -157,18 +154,16 @@ updateNPCs imgmat rp dt = do
               rind <- liftIO $ randomRIO (0, length objects - 1)
               npcent <- queryEnt
               let (oent, _, _) = objects !! rind
-                return (Just (oent, npcent), unchanged
+              return (Just (oent, npcent, future), unchanged
                 { rot      = Set $ fromMaybe rot' mdir
                 , anim     = Set stat
                   { asId = (asId stat)
                     { aiDirection = fromMaybe rot' mdir
                     }
                   }
-                  })
+                , vel = Set $ V2 0 0
-    (\(_, ent) ->
+                }))
-      setEntity e ent
+  mapM_ (\(oent, npcent, future) -> do
-      ) (fromJust moent)
-    maybe (return()) (\(oent, npcent) -> do
     Just (t, s) <- runQueryT oent $ do
       with objType
       with objState
@@ -182,20 +177,14 @@ updateNPCs imgmat rp dt = do
       otyp <- query objType
       ostat <- query objState
       return (otyp, ostat)
-      Just npc <- runQueryT npcent $ do
+    emap (anEnt npcent) $ do
       let ttl = actionTime nt ns
-        future <- liftIO $ newEmptyMVar
-        _ <- liftIO $ forkIO $
-          getPath (fmap floor pos') future rp imgmat posbounds
       return unchanged
         { npcMoveState = Set $ NPCStanding ttl future
-          , vel = Set $ V2 0 0
         }
-      setEntity npcent npc
+    ) moent
-      ) (fromJust (fst <$> moent))
-    ) npcs
 
-getObjects npos = do
+getObjects npcposs = do
   candidates <- efor allEnts $ do
     with pos
     with objType
@@ -205,9 +194,14 @@ getObjects npos = do
     oacc <- query objAccess
     ent <- queryEnt
     return (ent, pos', oacc)
-  return $ filter (\(_, p, (delta, _)) ->
+  mapM (\(e, pos) ->
-    fmap floor p + delta == fmap floor npos
+    return
+      ( e
+      , filter (\(_, p, (delta, _)) ->
+        fmap floor p + delta == fmap floor pos
         ) candidates
+      )
+    ) npcposs
 
 getPath
   :: V2 Int