NPCs now interact with objects!

src/MainGame/WorldMap.hs

@@ -84,8 +84,8 @@ loadMapFork ud ad future progress = do
   let loadSteps = 20
       fc = FloorConfig
         (10, 10)
-        [(5, 5), (5, 45)]
+        [] -- [(5, 5), (5, 20)]
-        (50, 50)
+        (30, 50)
   _ <- liftIO $ swapMVar progress (1 / loadSteps, "Building floor")
   (mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps)
   _ <- liftIO $ swapMVar progress (11 / loadSteps, "Converting to images")
@@ -320,9 +320,10 @@ drawMap = do
           pos' <- query pos
           t <- query objType
           s <- query objState
+          pa <- query objPlayerActivated
           let maxt = actionTime t s
           ttl <- query objStateTime
-          return (pos', realToFrac (1 - ttl / maxt))
+          return (pos', pa, realToFrac (1 - ttl / maxt))
         return (pc, posanims, posActions)
       let V2 pr pc = playerPos
           mat = imgMat (stateData ud)
@@ -377,7 +378,7 @@ drawMap = do
             (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t)
             (reverse $ zip [1..] ls))
           (zip [1..] (toLists mat))
-        mapM_ (\(V2 sr sc, perc) -> do
+        mapM_ (\(V2 sr sc, pa, perc) -> when pa $ do
           let lx = realToFrac $ 640 + ((sc - pc) +
                 (sr - pr)) * (tileWidth / 2) :: CFloat
               ly = realToFrac $ 360 - (tileHeight / 2) + ((sr - pr) -

src/NPC.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 module NPC where
 
 import Affection as A
@@ -21,6 +23,8 @@ import Util
 
 import Types
 
+import Object
+
 placeNPCs
   :: M.Matrix (Maybe ImgId)
   -> M.Matrix TileState
@@ -54,11 +58,10 @@ placeNPCs imgmat tilemat rp count =
         rp
 
 updateNPCs
-  :: MonadIO m
+  :: M.Matrix (Maybe ImgId)
-  => M.Matrix (Maybe ImgId)
   -> [ReachPoint]
   -> Double
-  -> SystemT Entity m ()
+  -> SystemT Entity (AffectionState (AffectionData UserData) IO) ()
 updateNPCs imgmat rp dt = do
   posbounds <- efor allEnts $ do
     with pos
@@ -66,33 +69,42 @@ updateNPCs imgmat rp dt = do
     pos' <- query pos
     bnds <- query obstacle
     return (pos', bnds)
-  emap allEnts $ do
+  npcs <- efor allEnts $ do
     with npcMoveState
     with vel
     with pos
     with rot
     with anim
+    pos' <- query pos
+    rot' <- query rot
+    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 <- eover (anEnt e) $ do
       npcState' <- query npcMoveState
       case npcState' of
         NPCStanding ttl future -> do
           let nttl = ttl - dt
           if nttl > 0
           then
-          return $ unchanged
+            return $ (Nothing, unchanged
               { npcMoveState = Set $ NPCStanding nttl future
               , vel      = Set $ V2 0 0
-            }
+              })
           else do
             mpath <- liftIO $ tryTakeMVar future
             case mpath of
               Just path ->
-              return $ unchanged
+                return $ (Nothing, unchanged
                   { npcMoveState = Set $ NPCWalking path
-                }
+                  })
               Nothing ->
-              return $ unchanged
+                return $ (Nothing, unchanged
                   { npcMoveState = Set $ NPCStanding 1 future
-                }
+                  })
         NPCWalking path -> do
           pos' <- query pos
           if not (null path)
@@ -100,24 +112,37 @@ updateNPCs imgmat rp dt = do
             let itarget = V2 0.5 0.5 + (fromIntegral <$> head path) :: V2 Double
             if distance pos' itarget < 0.1
             then
-            return $ unchanged
+              return $ (Nothing, unchanged
                 { npcMoveState = Set $ NPCWalking (tail path)
-              }
+                })
             else
-            return $ unchanged
+              return $ (Nothing, unchanged
                 { vel = Set $ (* 2) <$> signorm (itarget - pos')
-              }
+                })
           else do
-          ttl <- liftIO $ randomRIO (5, 30)
             future <- liftIO $ newEmptyMVar
-          rot' <- query rot
             stat <- query anim
-          let mdir = 
+            rot' <- query rot
-                (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
+            pos' <- query pos
-          -- _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat
             _ <- liftIO $ forkIO $
               getPath (fmap floor pos') future rp imgmat posbounds
-          return $ unchanged
+            let mdir = 
+                  (pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp)
+            -- ttl <- liftIO $ randomRIO (5, 30)
+            -- 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)
+                return $ (Nothing, unchanged
                   { npcMoveState = Set $ NPCStanding ttl future
                   , vel      = Set $ V2 0 0
                   , rot      = Set $ fromMaybe rot' mdir
@@ -126,8 +151,59 @@ updateNPCs imgmat rp dt = do
                       { aiDirection = fromMaybe rot' mdir
                       }
                     }
+                  })
+              objects -> do
+                liftIO $ logIO Debug ("applicable objects: " ++ show objects)
+                rind <- liftIO $ randomRIO (0, length objects - 1)
+                npcent <- queryEnt
+                let (oent, _, _) = objects !! rind
+                return (Just (oent, npcent), unchanged
+                  { rot      = Set $ fromMaybe rot' mdir
+                  , anim     = Set stat
+                    { asId = (asId stat)
+                      { aiDirection = fromMaybe rot' mdir
                       }
+                    }
+                  })
+    mapM_ (\smoent -> maybe (return()) (\(oent, npcent) -> do
+      [(t, s)] <- efor (anEnt oent) $ do
+        with objType
+        with objState
+        otyp <- query objType
+        ostat <- query objState
+        return (otyp, ostat)
+      setEntity oent =<< objectTransition t s False oent
+      [(nt, ns)] <- efor (anEnt oent) $ do
+        with objType
+        with objState
+        otyp <- query objType
+        ostat <- query objState
+        return (otyp, ostat)
+      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
+          }
+      ) smoent) moent
+    ) npcs
 
+getObjects npos = do
+  candidates <- efor allEnts $ do
+    with pos
+    with objType
+    with objState
+    with objAccess
+    pos' <- query pos
+    oacc <- query objAccess
+    ent <- queryEnt
+    return (ent, pos', oacc)
+  return $ filter (\(_, p, (delta, _)) ->
+    fmap floor p + delta == fmap floor npos
+    ) candidates
 
 getPath
   :: V2 Int

src/Types/ObjClass.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 module Types.ObjClass where
 
 import Affection