made doors player interactable

This commit is contained in:
nek0 2019-02-16 20:38:00 +01:00
parent db4b6a4a34
commit 6c3ac407ed
13 changed files with 196 additions and 34 deletions

Binary file not shown.

Binary file not shown.

Before

Width:  |  Height:  |  Size: 622 B

After

Width:  |  Height:  |  Size: 1.5 KiB

Binary file not shown.

Binary file not shown.

Before

Width:  |  Height:  |  Size: 608 B

After

Width:  |  Height:  |  Size: 1.6 KiB

View file

@ -453,22 +453,40 @@ loadFork ws win glc nvg future progress = do
, AnimationConfig (64, 0) (64, 74) (0, 0) 1 0 APLoop , 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, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Loading Animation \"neDoor0: shut\"" , "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 [ ( 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, _) -> modifyMVar_ progress (return . (\(p, _) ->
( p + increment ( p + increment
, "Loading Animation \"nwDoor0: shut\"" , "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 [ ( 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, _) -> modifyMVar_ progress (return . (\(p, _) ->
@ -499,7 +517,9 @@ loadFork ws win glc nvg future progress = do
toiletFree ++ toiletFree ++
toiletOccupied ++ toiletOccupied ++
neDoor0shut ++ neDoor0shut ++
nwDoor0shut neDoor0open ++
nwDoor0shut ++
nwDoor0open
) )
, loadAssetIcons = M.fromList icons , loadAssetIcons = M.fromList icons
} }

View file

@ -147,7 +147,7 @@ loadMapFork ud ad future progress = do
{ pos = Just $ reachCoord - V2 1 0 { pos = Just $ reachCoord - V2 1 0
, obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36) , obstacle = Just $ Boundaries (10/36, 8/36) (28/36, 30/36)
, anim = Just $ AnimState (AnimId AnimCopier "open" N) 0 0 , anim = Just $ AnimState (AnimId AnimCopier "open" N) 0 0
, objAccess = Just (V2 1 0, NW) , objAccess = Just [(V2 1 0, NW)]
, objType = Just ObjCopier , objType = Just ObjCopier
, objState = Just "idle" , objState = Just "idle"
} }
@ -167,7 +167,8 @@ loadMapFork ud ad future progress = do
void $ createEntity $ newEntity void $ createEntity $ newEntity
{ pos = Just $ reachCoord - fmap fromIntegral access { pos = Just $ reachCoord - fmap fromIntegral access
, anim = Just $ AnimState (AnimId AnimComputer "off" dir) 0 0 , anim = Just $ AnimState (AnimId AnimComputer "off" dir) 0 0
, objAccess = Just (access, dir) , rot = Just dir
, objAccess = Just [(access, dir)]
, objType = Just ObjComputer , objType = Just ObjComputer
, objState = Just "off" , objState = Just "off"
} }
@ -183,7 +184,7 @@ loadMapFork ud ad future progress = do
{ pos = Just $ reachCoord - V2 0 (-1) { pos = Just $ reachCoord - V2 0 (-1)
, obstacle = Just $ Boundaries (0, 0) (1, 1) , obstacle = Just $ Boundaries (0, 0) (1, 1)
, anim = Just $ AnimState (AnimId AnimToilet "free" N) 0 0 , anim = Just $ AnimState (AnimId AnimToilet "free" N) 0 0
, objAccess = Just (V2 0 (-1), dir) , objAccess = Just [(V2 0 (-1), dir)]
, objType = Just ObjToilet , objType = Just ObjToilet
} }
) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets) ) (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) , mmvel = Just (V2 0 0)
, player = Just () , player = Just ()
, rot = Just SE , rot = Just SE
, clearanceLvl = Just 0
, anim = Just $ AnimState (AnimId AnimIntruder "standing" SE) 0 0 , anim = Just $ AnimState (AnimId AnimIntruder "standing" SE) 0 0
} }
liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length computers) 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))) fromMaybe False (isWall <$> imgmat M.! (r, c)))
deltas deltas
orientation orientation
| head wall == V2 0 1 || head wall == V2 0 (-1) = NE | head wall == V2 0 1 || head wall == V2 0 (-1) = NW
| head wall == V2 1 0 || head wall == V2 (-1) 0 = NW | head wall == V2 1 0 || head wall == V2 (-1) 0 = NE
| otherwise = error ("strange wall: " ++ show wall) | otherwise = error ("strange wall: " ++ show wall)
void $ createEntity $ newEntity void $ createEntity $ newEntity
{ pos = Just (fmap ((+ 0.5) . fromIntegral) coord) { pos = Just (fmap ((+ 0.5) . fromIntegral) coord)
, clearanceLvl = Just (maximum $ 0 : Prelude.map clearance (Prelude.map snd rooms)) , 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 , obstacle = Just $ case orientation of
NE -> Boundaries (4/9, 0) (5/9, 1) NW -> Boundaries (4/9, 0) (5/9, 1)
NW -> Boundaries (0, 4/9) (1, 5/9) NE -> Boundaries (0, 4/9) (1, 5/9)
_ -> error "strange orientation for door" _ -> error "strange orientation for door"
, ignoreObstacle = Just () , 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 ) doors
liftIO $ modifyMVar_ progress (return . (\(p, _) -> liftIO $ modifyMVar_ progress (return . (\(p, _) ->
@ -467,15 +482,15 @@ playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do
with objAccess with objAccess
with objType with objType
with objState with objState
(rel, dir) <- query objAccess reldirs <- query objAccess
pos' <- query pos pos' <- query pos
otype <- query objType otype <- query objType
ostate <- query objState ostate <- query objState
ent <- queryEnt 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 Int) == (fmap floor pos' :: V2 Int) + rel) &&
(fmap floor (ppos + V2 dr dc) :: V2 Int) == (fmap floor pos' ::V2 Int) && (fmap floor (ppos + V2 dr dc) :: V2 Int) == (fmap floor pos' ::V2 Int) &&
pdir == dir pdir == dir) reldirs
then return $ Just (otype, ostate, ent) then return $ Just (otype, ostate, ent)
else return Nothing else return Nothing
let relEnts = catMaybes mrelEnts let relEnts = catMaybes mrelEnts
@ -507,14 +522,14 @@ playerInteract2 (ActionMessage ActActivate _) = do
with objAccess with objAccess
with objType with objType
with objState with objState
(rel, dir) <- query objAccess reldirs <- query objAccess
pos' <- query pos pos' <- query pos
otype <- query objType otype <- query objType
ostate <- query objState ostate <- query objState
ent <- queryEnt 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 Int) == (fmap floor pos' :: V2 Int) + rel) &&
pdir == dir pdir == dir) reldirs
then return $ Just (otype, ostate, ent) then return $ Just (otype, ostate, ent)
else return Nothing else return Nothing
let relEnts = catMaybes mrelEnts let relEnts = catMaybes mrelEnts

View file

@ -252,7 +252,7 @@ updateStats dt =
getObject getObject
:: (MonadIO m, RealFrac a1) :: (MonadIO m, RealFrac a1)
=> V2 a1 => V2 a1
-> SystemT Entity m [(Ent, V2 Double, (V2 Int, Direction))] -> SystemT Entity m [(Ent, V2 Double, [(V2 Int, Direction)])]
getObject npos = do getObject npos = do
candidates <- efor allEnts $ do candidates <- efor allEnts $ do
with pos with pos
@ -265,8 +265,8 @@ getObject npos = do
return (ent, pos', oacc) return (ent, pos', oacc)
liftIO $ logIO A.Verbose ("candidates: " ++ show candidates) liftIO $ logIO A.Verbose ("candidates: " ++ show candidates)
return $ return $
filter (\(_, p, (delta, _)) -> filter (\(_, p, deltaors) ->
fmap floor p + delta == fmap floor npos any (\(delta, _) -> fmap floor p + delta == fmap floor npos) deltaors
) candidates ) candidates
getPath getPath

View file

@ -18,12 +18,15 @@ import Types
import Object.Computer import Object.Computer
import Object.Copier import Object.Copier
import Object.Door
instance ObjectAction ObjType ObjState where instance ObjectAction ObjType ObjState where
objectAction dt t@ObjCopier s ent = copierObjectAction dt t s ent 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@ObjComputer s ent = computerObjectAction dt t s ent
objectAction dt t@ObjDoor s ent = doorObjectAction dt t s ent
objectAction _ _ _ _ = return () objectAction _ _ _ _ = return ()
objectTransition t@ObjCopier s pa ent aent = objectTransition t@ObjCopier s pa ent aent =
@ -32,12 +35,7 @@ instance ObjectAction ObjType ObjState where
objectTransition t@ObjComputer s pa ent aent = objectTransition t@ObjComputer s pa ent aent =
computerObjectTransition t 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 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

20
src/Object/ActionTime.hs Normal file
View file

@ -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

View file

@ -7,15 +7,26 @@ module Object.Computer where
import Affection as A import Affection as A
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Ecstasy import Data.Ecstasy
import Data.Maybe import Data.Maybe
import Linear import Linear
-- internal imports
import Types 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 computerObjectAction dt t@ObjComputer s@"on" ent = do
pent <- efor (anEnt ent) $ do pent <- efor (anEnt ent) $ do
with objUsedBy with objUsedBy
@ -91,10 +102,18 @@ computerObjectAction dt t@ObjComputer s@"hack" ent = do
computerObjectAction _ _ _ _ = return () 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 computerObjectTransition ObjComputer "off" pa ent (Just aent) = do
[dir] <- efor (anEnt aent) (query rot)
e <- efor (anEnt ent) $ do e <- efor (anEnt ent) $ do
solved <- queryMaybe objSolved solved <- queryMaybe objSolved
(_, dir) <- query objAccess
if pa if pa
then if not (fromMaybe False solved) then if not (fromMaybe False solved)
then do then do
@ -134,7 +153,7 @@ computerObjectTransition ObjComputer "off" pa ent (Just aent) = do
computerObjectTransition ObjComputer "on" _ ent _ = do computerObjectTransition ObjComputer "on" _ ent _ = do
e <- efor (anEnt ent) $ do e <- efor (anEnt ent) $ do
(_, dir) <- query objAccess dir <- query rot
let nstat = AnimState let nstat = AnimState
(AnimId AnimComputer "off" dir) (AnimId AnimComputer "off" dir)
0 0
@ -152,7 +171,7 @@ computerObjectTransition ObjComputer "hack" pa ent _ =
if pa if pa
then do then do
e <- efor (anEnt ent) $ do e <- efor (anEnt ent) $ do
(_, dir) <- query objAccess dir <- query rot
let nstat = AnimState let nstat = AnimState
(AnimId AnimComputer "off" dir) (AnimId AnimComputer "off" dir)
0 0

88
src/Object/Door.hs Normal file
View file

@ -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

View file

@ -29,7 +29,7 @@ data Entity f = Entity
, npcStats :: Component f 'Field NPCStats , npcStats :: Component f 'Field NPCStats
, clearanceLvl :: Component f 'Field Word , clearanceLvl :: Component f 'Field Word
, anim :: Component f 'Field AnimState , anim :: Component f 'Field AnimState
, objAccess :: Component f 'Field ((V2 Int), Direction) , objAccess :: Component f 'Field [((V2 Int), Direction)]
, objType :: Component f 'Field ObjType , objType :: Component f 'Field ObjType
, objState :: Component f 'Field ObjState , objState :: Component f 'Field ObjState
, objStateTime :: Component f 'Field Double , objStateTime :: Component f 'Field Double

View file

@ -49,8 +49,10 @@ executable tracer-game
, MindMap , MindMap
, NPC , NPC
, Object , Object
, Object.ActionTime
, Object.Computer , Object.Computer
, Object.Copier , Object.Copier
, Object.Door
, Util , Util
default-extensions: OverloadedStrings default-extensions: OverloadedStrings
, DeriveGeneric , DeriveGeneric