diff --git a/assets/doors/door_asc_0.kra b/assets/doors/door_asc_0.kra index 2fc8f05..0dc75e4 100644 Binary files a/assets/doors/door_asc_0.kra and b/assets/doors/door_asc_0.kra differ diff --git a/assets/doors/door_asc_0.png b/assets/doors/door_asc_0.png index 9e56a78..cd4cf2e 100644 Binary files a/assets/doors/door_asc_0.png and b/assets/doors/door_asc_0.png differ diff --git a/assets/doors/door_desc_0.kra b/assets/doors/door_desc_0.kra index c42870c..a597aa2 100644 Binary files a/assets/doors/door_desc_0.kra and b/assets/doors/door_desc_0.kra differ diff --git a/assets/doors/door_desc_0.png b/assets/doors/door_desc_0.png index 6ec04a2..8d31d3b 100644 Binary files a/assets/doors/door_desc_0.png and b/assets/doors/door_desc_0.png differ diff --git a/src/Load.hs b/src/Load.hs index 5ac585c..0ee170a 100644 --- a/src/Load.hs +++ b/src/Load.hs @@ -453,22 +453,40 @@ loadFork ws win glc nvg future progress = do , AnimationConfig (64, 0) (64, 74) (0, 0) 1 0 APLoop ) ] + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading Animation \"neDoor0: open\"" + ))) + neDoor0open <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg + [ ( AnimId AnimDoor0 "open" NE + , AnimationConfig (0, 0) (64, 74) (0, 74) 5 1 APOnce + ) + ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"neDoor0: shut\"" ))) - neDoor0shut <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg + neDoor0shut <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg [ ( AnimId AnimDoor0 "shut" NE - , AnimationConfig (0, 0) (64, 74) (0, 0) 1 0 APLoop + , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 1 APOnce + ) + ] + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading Animation \"nwDoor0: open\"" + ))) + nwDoor0open <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg + [ ( AnimId AnimDoor0 "open" NW + , AnimationConfig (0, 0) (64, 74) (0, 74) 5 1 APOnce ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"nwDoor0: shut\"" ))) - nwDoor0shut <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg + nwDoor0shut <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg [ ( AnimId AnimDoor0 "shut" NW - , AnimationConfig (0, 0) (64, 74) (0, 0) 1 0 APLoop + , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 1 APOnce ) ] modifyMVar_ progress (return . (\(p, _) -> @@ -499,7 +517,9 @@ loadFork ws win glc nvg future progress = do toiletFree ++ toiletOccupied ++ neDoor0shut ++ - nwDoor0shut + neDoor0open ++ + nwDoor0shut ++ + nwDoor0open ) , loadAssetIcons = M.fromList icons } diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index a08cf10..ebac05f 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -147,7 +147,7 @@ loadMapFork ud ad future progress = do { pos = Just $ reachCoord - V2 1 0 , obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36) , anim = Just $ AnimState (AnimId AnimCopier "open" N) 0 0 - , objAccess = Just (V2 1 0, NW) + , objAccess = Just [(V2 1 0, NW)] , objType = Just ObjCopier , objState = Just "idle" } @@ -167,7 +167,8 @@ loadMapFork ud ad future progress = do void $ createEntity $ newEntity { pos = Just $ reachCoord - fmap fromIntegral access , anim = Just $ AnimState (AnimId AnimComputer "off" dir) 0 0 - , objAccess = Just (access, dir) + , rot = Just dir + , objAccess = Just [(access, dir)] , objType = Just ObjComputer , objState = Just "off" } @@ -183,7 +184,7 @@ loadMapFork ud ad future progress = do { pos = Just $ reachCoord - V2 0 (-1) , obstacle = Just $ Boundaries (0, 0) (1, 1) , anim = Just $ AnimState (AnimId AnimToilet "free" N) 0 0 - , objAccess = Just (V2 0 (-1), dir) + , objAccess = Just [(V2 0 (-1), dir)] , objType = Just ObjToilet } ) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets) @@ -218,6 +219,7 @@ loadMapFork ud ad future progress = do , mmvel = Just (V2 0 0) , player = Just () , rot = Just SE + , clearanceLvl = Just 0 , anim = Just $ AnimState (AnimId AnimIntruder "standing" SE) 0 0 } liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length computers) @@ -288,18 +290,31 @@ loadMapFork ud ad future progress = do fromMaybe False (isWall <$> imgmat M.! (r, c))) deltas orientation - | head wall == V2 0 1 || head wall == V2 0 (-1) = NE - | head wall == V2 1 0 || head wall == V2 (-1) 0 = NW + | head wall == V2 0 1 || head wall == V2 0 (-1) = NW + | head wall == V2 1 0 || head wall == V2 (-1) 0 = NE | otherwise = error ("strange wall: " ++ show wall) void $ createEntity $ newEntity { pos = Just (fmap ((+ 0.5) . fromIntegral) coord) , clearanceLvl = Just (maximum $ 0 : Prelude.map clearance (Prelude.map snd rooms)) - , anim = Just $ AnimState (AnimId AnimDoor0 "shut" orientation) 0 0 + , anim = Just $ AnimState (AnimId AnimDoor0 "shut" orientation) 0 1 , obstacle = Just $ case orientation of - NE -> Boundaries (4/9, 0) (5/9, 1) - NW -> Boundaries (0, 4/9) (1, 5/9) + NW -> Boundaries (4/9, 0) (5/9, 1) + NE -> Boundaries (0, 4/9) (1, 5/9) _ -> error "strange orientation for door" , ignoreObstacle = Just () + , rot = Just orientation + , objAccess = Just $ case orientation of + NW -> + [ ((V2 (-1) 0), SE) + , ((V2 1 0), NW) + ] + NE -> + [ ((V2 0 1), SW) + , ((V2 0 (-1)), NE) + ] + _ -> error "strange orientation for door" + , objType = Just ObjDoor + , objState = Just "shut" } ) doors liftIO $ modifyMVar_ progress (return . (\(p, _) -> @@ -467,15 +482,15 @@ playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do with objAccess with objType with objState - (rel, dir) <- query objAccess + reldirs <- query objAccess pos' <- query pos otype <- query objType ostate <- query objState ent <- queryEnt - if ((fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) || + if any (\(rel, dir) -> ((fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) || (fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) + rel) && (fmap floor (ppos + V2 dr dc) :: V2 Int) == (fmap floor pos' ::V2 Int) && - pdir == dir + pdir == dir) reldirs then return $ Just (otype, ostate, ent) else return Nothing let relEnts = catMaybes mrelEnts @@ -507,14 +522,14 @@ playerInteract2 (ActionMessage ActActivate _) = do with objAccess with objType with objState - (rel, dir) <- query objAccess + reldirs <- query objAccess pos' <- query pos otype <- query objType ostate <- query objState ent <- queryEnt - if ((fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) || + if any (\(rel, dir) -> ((fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) || (fmap floor ppos :: V2 Int) == (fmap floor pos' :: V2 Int) + rel) && - pdir == dir + pdir == dir) reldirs then return $ Just (otype, ostate, ent) else return Nothing let relEnts = catMaybes mrelEnts diff --git a/src/NPC.hs b/src/NPC.hs index 318625a..5c7173c 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -252,7 +252,7 @@ updateStats dt = getObject :: (MonadIO m, RealFrac a1) => V2 a1 - -> SystemT Entity m [(Ent, V2 Double, (V2 Int, Direction))] + -> SystemT Entity m [(Ent, V2 Double, [(V2 Int, Direction)])] getObject npos = do candidates <- efor allEnts $ do with pos @@ -265,8 +265,8 @@ getObject npos = do return (ent, pos', oacc) liftIO $ logIO A.Verbose ("candidates: " ++ show candidates) return $ - filter (\(_, p, (delta, _)) -> - fmap floor p + delta == fmap floor npos + filter (\(_, p, deltaors) -> + any (\(delta, _) -> fmap floor p + delta == fmap floor npos) deltaors ) candidates getPath diff --git a/src/Object.hs b/src/Object.hs index cb440c8..98d7633 100644 --- a/src/Object.hs +++ b/src/Object.hs @@ -18,12 +18,15 @@ import Types import Object.Computer import Object.Copier +import Object.Door instance ObjectAction ObjType ObjState where objectAction dt t@ObjCopier s ent = copierObjectAction dt t s ent objectAction dt t@ObjComputer s ent = computerObjectAction dt t s ent + objectAction dt t@ObjDoor s ent = doorObjectAction dt t s ent + objectAction _ _ _ _ = return () objectTransition t@ObjCopier s pa ent aent = @@ -32,12 +35,7 @@ instance ObjectAction ObjType ObjState where objectTransition t@ObjComputer s pa ent aent = computerObjectTransition t s pa ent aent + objectTransition t@ObjDoor s pa ent aent = + doorObjectTransition t s pa ent aent + objectTransition _ _ _ _ _ = return unchanged - -instance ActionTime ObjType ObjState where - actionTime ObjCopier "copying" = 5 - actionTime ObjComputer "off" = 0 - actionTime ObjComputer "on" = 20 - actionTime ObjComputer "hack" = 20 - - actionTime o s = A.log Error (show o ++ ": " ++ s ++ ": has not a time") 0 diff --git a/src/Object/ActionTime.hs b/src/Object/ActionTime.hs new file mode 100644 index 0000000..815e438 --- /dev/null +++ b/src/Object/ActionTime.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Object.ActionTime where + +import Affection as A + +-- internal imports + +import Types + +instance ActionTime ObjType ObjState where + actionTime ObjCopier "copying" = 5 + actionTime ObjComputer "off" = 0 + actionTime ObjComputer "on" = 20 + actionTime ObjComputer "hack" = 20 + actionTime ObjComputer "hack" = 20 + actionTime ObjDoor "open" = 2 + + actionTime o s = A.log Error (show o ++ ": " ++ s ++ ": has not a time") 0 diff --git a/src/Object/Computer.hs b/src/Object/Computer.hs index 6fe764a..0557bdf 100644 --- a/src/Object/Computer.hs +++ b/src/Object/Computer.hs @@ -7,15 +7,26 @@ module Object.Computer where import Affection as A import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO(..)) import Data.Ecstasy import Data.Maybe import Linear +-- internal imports + import Types +import Object.ActionTime +computerObjectAction + :: (Monad m, MonadIO m) + => Double + -> ObjType + -> ObjState + -> Ent + -> SystemT Entity m () computerObjectAction dt t@ObjComputer s@"on" ent = do pent <- efor (anEnt ent) $ do with objUsedBy @@ -91,10 +102,18 @@ computerObjectAction dt t@ObjComputer s@"hack" ent = do computerObjectAction _ _ _ _ = return () +computerObjectTransition + :: (Monad m, MonadIO m) + => ObjType + -> ObjState + -> Bool + -> Ent + -> Maybe Ent + -> SystemT Entity m (Entity 'SetterOf) computerObjectTransition ObjComputer "off" pa ent (Just aent) = do + [dir] <- efor (anEnt aent) (query rot) e <- efor (anEnt ent) $ do solved <- queryMaybe objSolved - (_, dir) <- query objAccess if pa then if not (fromMaybe False solved) then do @@ -134,7 +153,7 @@ computerObjectTransition ObjComputer "off" pa ent (Just aent) = do computerObjectTransition ObjComputer "on" _ ent _ = do e <- efor (anEnt ent) $ do - (_, dir) <- query objAccess + dir <- query rot let nstat = AnimState (AnimId AnimComputer "off" dir) 0 @@ -152,7 +171,7 @@ computerObjectTransition ObjComputer "hack" pa ent _ = if pa then do e <- efor (anEnt ent) $ do - (_, dir) <- query objAccess + dir <- query rot let nstat = AnimState (AnimId AnimComputer "off" dir) 0 diff --git a/src/Object/Door.hs b/src/Object/Door.hs new file mode 100644 index 0000000..850976f --- /dev/null +++ b/src/Object/Door.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +module Object.Door where + +import Affection as A + +import Control.Monad (when) + +import Data.Ecstasy +import Data.Maybe + +import Linear + +-- internal imports + +import Types + +import Object.ActionTime + +doorObjectAction dt t@ObjDoor s@"open" ent = do + emap (anEnt ent) $ do + mtime <- queryMaybe objStateTime + case mtime of + Nothing -> do + return unchanged + Just ttl -> + return unchanged + { objStateTime = Set (ttl - dt) + } + trans <- efor (anEnt ent) $ do + mttl <- queryMaybe objStateTime + case mttl of + Nothing -> return False + Just ttl -> return (ttl < 0) + when (head trans) (setEntity ent =<< doorObjectTransition t s False ent Nothing) + +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 + then do + let nstat = AnimState + (AnimId AnimDoor0 "open" dir) + 0 + 0 + return unchanged + { objState = Set "open" + , objStateTime = Set (actionTime t ("open" :: String)) + , objUsedBy = Set aent + , anim = Set nstat + , obstacle = Unset + } + else + return unchanged + return (head e) + +doorObjectTransition ObjDoor "open" _ ent Nothing = do + e <- efor (anEnt ent) $ do + ttl <- query objStateTime + orientation <- query rot + if ttl < 0 + then do + let nstat = AnimState + (AnimId AnimDoor0 "shut" orientation) + 0 + 0 + return unchanged + { anim = Set nstat + , objState = Set "shut" + , objStateTime = Unset + , objUsedBy = Unset + , obstacle = Set $ case orientation of + NW -> Boundaries (4/9, 0) (5/9, 1) + NE -> Boundaries (0, 4/9) (1, 5/9) + _ -> error "strange orientation for door" + } + else return unchanged + return (head e) + +doorObjectTransition _ _ _ _ _ = return unchanged diff --git a/src/Types/Entity.hs b/src/Types/Entity.hs index a58a961..fe03fe7 100644 --- a/src/Types/Entity.hs +++ b/src/Types/Entity.hs @@ -29,7 +29,7 @@ data Entity f = Entity , npcStats :: Component f 'Field NPCStats , clearanceLvl :: Component f 'Field Word , anim :: Component f 'Field AnimState - , objAccess :: Component f 'Field ((V2 Int), Direction) + , objAccess :: Component f 'Field [((V2 Int), Direction)] , objType :: Component f 'Field ObjType , objState :: Component f 'Field ObjState , objStateTime :: Component f 'Field Double diff --git a/tracer-game.cabal b/tracer-game.cabal index 86e28c7..66e2634 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -49,8 +49,10 @@ executable tracer-game , MindMap , NPC , Object + , Object.ActionTime , Object.Computer , Object.Copier + , Object.Door , Util default-extensions: OverloadedStrings , DeriveGeneric