make doors open automagically

src/Load.hs

@@ -459,7 +459,7 @@ loadFork ws win glc nvg future progress = do
     )))
   neDoor0open <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg
     [ ( AnimId AnimDoor0 "open" NE
-      , AnimationConfig (0, 0) (64, 74) (0, 74) 5 1 APOnce
+      , AnimationConfig (0, 0) (64, 74) (0, 74) 5 0.25 APOnce
       )
     ]
   modifyMVar_ progress (return . (\(p, _) ->
@@ -468,7 +468,7 @@ loadFork ws win glc nvg future progress = do
     )))
   neDoor0shut <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg
     [ ( AnimId AnimDoor0 "shut" NE
-      , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 1 APOnce
+      , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 0.25 APOnce
       )
     ]
   modifyMVar_ progress (return . (\(p, _) ->
@@ -477,7 +477,7 @@ loadFork ws win glc nvg future progress = do
     )))
   nwDoor0open <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg
     [ ( AnimId AnimDoor0 "open" NW
-      , AnimationConfig (0, 0) (64, 74) (0, 74) 5 1 APOnce
+      , AnimationConfig (0, 0) (64, 74) (0, 74) 5 0.25 APOnce
       )
     ]
   modifyMVar_ progress (return . (\(p, _) ->
@@ -486,7 +486,7 @@ loadFork ws win glc nvg future progress = do
     )))
   nwDoor0shut <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg
     [ ( AnimId AnimDoor0 "shut" NW
-      , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 1 APOnce
+      , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 0.25 APOnce
       )
     ]
   modifyMVar_ progress (return . (\(p, _) ->

src/MainGame/WorldMap.hs

@@ -1001,15 +1001,25 @@ updateMap dt = do
               }
         -- liftIO $ A.logIO A.Debug ("player position: " ++ show (pos' + colldpos))
         return ent
+      allRelEnts <- efor allEnts $ do
+        with pos
+        with rot
+        with clearanceLvl
+        without objType
+        pos' <- query pos
+        rot' <- query rot
+        clvl <- query clearanceLvl
+        entn <- queryEnt
+        return (entn, pos', rot', clvl)
       tses <- efor allEnts $ do
-          with objType
-          with objState
-          t <- query objType
-          s <- query objState
-          e <- queryEnt
-          return (t, s, e)
+        with objType
+        with objState
+        t <- query objType
+        s <- query objState
+        e <- queryEnt
+        return (t, s, e)
       mapM_ (\(t, s, e) ->
-        objectAction dt t s e
+        objectAction allRelEnts dt t s e
         ) tses
     (nws2, _) <- yieldSystemT nws $ updateNPCs
       (imgMat $ stateData ud)

src/Object.hs

@@ -21,13 +21,13 @@ import Object.Copier
 import Object.Door
 
 instance ObjectAction ObjType ObjState where
-  objectAction dt t@ObjCopier s ent = copierObjectAction dt t s ent
+  objectAction relEnts dt t@ObjCopier s ent = copierObjectAction relEnts dt t s ent
 
-  objectAction dt t@ObjComputer s ent = computerObjectAction dt t s ent
+  objectAction relEnts dt t@ObjComputer s ent = computerObjectAction relEnts dt t s ent
 
-  objectAction dt t@ObjDoor s ent = doorObjectAction dt t s ent
+  objectAction relEnts dt t@ObjDoor s ent = doorObjectAction relEnts dt t s ent
 
-  objectAction _ _ _ _ = return ()
+  objectAction _ _ _ _ _ = return ()
 
   objectTransition t@ObjCopier s pa ent aent =
     copierObjectTransition t s pa ent aent

src/Object/Computer.hs

@@ -22,12 +22,13 @@ import Object.ActionTime
 
 computerObjectAction
   :: (Monad m, MonadIO m)
-  => Double
+  => [(Ent, V2 Double, Direction, Word)]
+  -> Double
   -> ObjType
   -> ObjState
   -> Ent
   -> SystemT Entity m ()
-computerObjectAction dt t@ObjComputer s@"on" ent = do
+computerObjectAction _ dt t@ObjComputer s@"on" ent = do
   pent <- efor (anEnt ent) $ do
     with objUsedBy
     query objUsedBy
@@ -65,7 +66,7 @@ computerObjectAction dt t@ObjComputer s@"on" ent = do
     (\tpa -> setEntity ent =<< computerObjectTransition t s tpa ent Nothing)
     (head trans)
 
-computerObjectAction dt t@ObjComputer s@"hack" ent = do
+computerObjectAction _ dt t@ObjComputer s@"hack" ent = do
   aent <- efor (anEnt ent) $ do
     with objUsedBy
     query objUsedBy
@@ -100,7 +101,7 @@ computerObjectAction dt t@ObjComputer s@"hack" ent = do
     (\tpa -> setEntity ent =<< computerObjectTransition t s tpa ent Nothing)
     (head trans)
 
-computerObjectAction _ _ _ _ = return ()
+computerObjectAction _ _ _ _ _ = return ()
 
 computerObjectTransition
   :: (Monad m, MonadIO m)

src/Object/Copier.hs

@@ -15,7 +15,7 @@ import Linear
 
 import Types
 
-copierObjectAction dt t@ObjCopier s@"copying" ent = do
+copierObjectAction _ dt t@ObjCopier s@"copying" ent = do
   emap (anEnt ent) $ do
     mtime <- queryMaybe objStateTime
     case mtime of
@@ -36,7 +36,7 @@ copierObjectAction dt t@ObjCopier s@"copying" ent = do
       Just ttl -> return (ttl < 0)
   when (head trans) (setEntity ent =<< copierObjectTransition t s False ent Nothing)
 
-copierObjectAction _ _ _ _ = return ()
+copierObjectAction _ _ _ _ _ = return ()
 
 copierObjectTransition ObjCopier "idle" playerActivated ent (Just aent) = do
   e <- efor (anEnt ent) $ do

src/Object/Door.hs

@@ -19,7 +19,7 @@ import Types
 
 import Object.ActionTime
 
-doorObjectAction dt t@ObjDoor s@"open" ent = do
+doorObjectAction _ dt t@ObjDoor s@"open" ent = do
   emap (anEnt ent) $ do
     mtime <- queryMaybe objStateTime
     case mtime of
@@ -36,17 +36,49 @@ doorObjectAction dt t@ObjDoor s@"open" ent = do
       Just ttl -> return (ttl < 0)
   when (head trans) (setEntity ent =<< doorObjectTransition t s False ent Nothing)
 
-doorObjectAction _ _ _ _ = return ()
+doorObjectAction allRelEnts dt t@ObjDoor s@"shut" ent = do
+  permEnts <- efor (anEnt ent) $ do
+    pos' <- query pos
+    rot' <- query rot
+    clvl <- query clearanceLvl
+    let posEnts = filter
+          (\(_, b, _, _) ->
+            (fmap floor b `elem` deltaCoords || fmap floor b == floorPos) &&
+            distance b pos' < 0.75)
+          allRelEnts
+        floorPos = fmap floor pos'
+        deltas = case rot' of
+          NW ->
+            [ V2 (-1) 0
+            , V2 1    0
+            ]
+          NE ->
+            [ V2 0 (-1)
+            , V2 0    1
+            ]
+        acceptedRots = case rot' of
+          NW -> [NW, SE]
+          NE -> [NE, SW]
+        deltaCoords = map (floorPos +) deltas
+        predicate (_, _, c, d) = c `elem` acceptedRots && d >= clvl
+        ret = filter predicate posEnts
+    return ret
+  mapM_
+    (\(e, _, _, _) -> setEntity ent =<< doorObjectTransition t s False ent (Just e))
+    (head permEnts)
+
+doorObjectAction _ _ _ _ _ = return ()
 
 doorObjectTransition t@ObjDoor s@"shut" _ ent (Just aent) = do
   [clearance] <- efor (anEnt aent) (query clearanceLvl)
   e <- efor (anEnt ent) $ do
       dir <- query rot
       oclear <- query clearanceLvl
-      liftIO $ A.logIO A.Debug (show aent ++ " is attempting to open door " ++ show ent)
-      liftIO $ A.logIO A.Debug ("door clearance: " ++ show oclear ++ ", entity clearance: " ++ show clearance)
-      if clearance == oclear
+      liftIO $ A.logIO A.Verbose (show aent ++ " is attempting to open door " ++ show ent)
+      liftIO $ A.logIO A.Verbose ("door clearance: " ++ show oclear ++ ", entity clearance: " ++ show clearance)
+      if clearance >= oclear
       then do
+        liftIO $ A.logIO A.Verbose ("door " ++ show oclear ++ " opens")
         let nstat = AnimState
               (AnimId AnimDoor0 "open" dir)
               0

src/Types/ObjClass.hs

@@ -9,10 +9,12 @@ import Data.Ecstasy
 
 import Types.Entity
 import Types.UserData
+import Types.Direction
 
 class ObjectAction otype ostate where
   objectAction
-    :: Double
+    :: [(Ent, V2 Double, Direction, Word)]
+    -> Double
     -> otype
     -> ostate
     -> Ent