draw only progress for player activated actions

src/MainGame/WorldMap.hs

@@ -282,7 +282,7 @@ playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do
     liftIO $ A.logIO A.Debug ("relEnts: " ++ show relEnts)
     -- liftIO $ A.logIO A.Debug ("dV2: " ++ show (V2 dr dc))
     mapM_ (\(t, s, e) ->
-      setEntity e =<< objectTransition t s e
+      setEntity e =<< objectTransition t s True e
       ) relEnts
   putAffection ud
     { worldState = nws
@@ -315,6 +315,7 @@ drawMap = do
           with objType
           with objState
           with objStateTime
+          with objPlayerActivated
           with pos
           pos' <- query pos
           t <- query objType

src/Object.hs

@@ -31,36 +31,38 @@ instance ObjectAction ObjType ObjState where
       case mttl of
         Nothing -> return False
         Just ttl -> return (ttl < 0)
-    when trans (setEntity ent =<< objectTransition t s ent)
+    when trans (setEntity ent =<< objectTransition t s False ent)
 
   objectAction _ _ _ _ = return ()
 
-  objectTransition ObjCopier "idle" ent = do
+  objectTransition ObjCopier "idle" playerActivated ent = do
     [e] <- efor (anEnt ent) $ do
         let nstat = AnimState
               (AnimId "copier" "copy" N)
               0
               0
         return unchanged
-          { objState = Set "copying"
-          , anim     = Set nstat
+          { objState           = Set "copying"
+          , objPlayerActivated = Set playerActivated
+          , anim               = Set nstat
           }
     return e
 
-  objectTransition ObjCopier "copying" ent = do
+  objectTransition ObjCopier "copying" _ ent = do
     [e] <- efor (anEnt ent) $ do
         let nstat = AnimState
               (AnimId "copier" "open" N)
               0
               0
         return unchanged
-          { anim         = Set nstat
-          , objState     = Set "idle"
-          , objStateTime = Unset
+          { anim               = Set nstat
+          , objState           = Set "idle"
+          , objStateTime       = Unset
+          , objPlayerActivated = Unset
           }
     return e
 
-  objectTransition _ _ _ = return unchanged
+  objectTransition _ _ _ _ = return unchanged
 
 instance ActionTime ObjType ObjState where
   actionTime ObjCopier "copying" = 5

src/Types/Entity.hs

@@ -11,20 +11,21 @@ import Types.Animation
 import Types.ObjType
 
 data Entity f = Entity
-  { pos           :: Component f 'Field (V2 Double)
-  , mmpos         :: Component f 'Field (V2 Double)
-  , gridPos       :: Component f 'Field (V2 Int)
-  , vel           :: Component f 'Field (V2 Double)
-  , mmvel         :: Component f 'Field (V2 Double)
-  , velFact       :: Component f 'Field Double
-  , rot           :: Component f 'Field Direction
-  , obstacle      :: Component f 'Field (Boundaries Double)
-  , player        :: Component f 'Unique ()
-  , npcMoveState  :: Component f 'Field NPCMoveState
-  , anim          :: Component f 'Field AnimState
-  , objAccess     :: Component f 'Field ((V2 Int), Direction)
-  , objType       :: Component f 'Field ObjType
-  , objState      :: Component f 'Field ObjState
-  , objStateTime  :: Component f 'Field Double
+  { pos                :: Component f 'Field (V2 Double)
+  , mmpos              :: Component f 'Field (V2 Double)
+  , gridPos            :: Component f 'Field (V2 Int)
+  , vel                :: Component f 'Field (V2 Double)
+  , mmvel              :: Component f 'Field (V2 Double)
+  , velFact            :: Component f 'Field Double
+  , rot                :: Component f 'Field Direction
+  , obstacle           :: Component f 'Field (Boundaries Double)
+  , player             :: Component f 'Unique ()
+  , npcMoveState       :: Component f 'Field NPCMoveState
+  , anim               :: Component f 'Field AnimState
+  , objAccess          :: Component f 'Field ((V2 Int), Direction)
+  , objType            :: Component f 'Field ObjType
+  , objState           :: Component f 'Field ObjState
+  , objStateTime       :: Component f 'Field Double
+  , objPlayerActivated :: Component f 'Field Bool
   }
   deriving (Generic)

src/Types/ObjClass.hs

@@ -19,6 +19,7 @@ class ObjectAction otype ostate where
   objectTransition
     :: otype
     -> ostate
+    -> Bool
     -> Ent
     -> SystemT Entity (AffectionState (AffectionData UserData) IO) (Entity 'SetterOf)