new plants and now: toilets

This commit is contained in:
nek0 2018-07-31 22:59:25 +02:00
parent 8a474f6edd
commit 9d4205a939
11 changed files with 65 additions and 8 deletions

BIN
assets/misc/plant2.kra Normal file

Binary file not shown.

BIN
assets/misc/plant2.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 762 B

BIN
assets/misc/toilet.kra Normal file

Binary file not shown.

BIN
assets/misc/toilet.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 655 B

View file

@ -59,7 +59,7 @@ loadFork
-> MVar (Float, T.Text)
-> IO ()
loadFork ws win glc nvg future progress = do
let stateSteps = 31
let stateSteps = 34
increment = 1 / stateSteps
SDL.glMakeCurrent win glc
modifyMVar_ progress (return . (\(p, _) ->
@ -177,6 +177,11 @@ loadFork ws win glc nvg future progress = do
, "Loading asset \"plant1\""
)))
mmiscPlant1 <- createImage nvg (FileName "assets/misc/plant1.png") 0
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"plant2\""
)))
mmiscPlant2 <- createImage nvg (FileName "assets/misc/plant2.png") 0
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"intruder: standing\""
@ -188,7 +193,7 @@ loadFork ws win glc nvg future progress = do
mtable1, mtable2, mtable3, mtable4, mtableC,
mtablec1, mtablec2, mtablec3, mtablec4,
mmiscFlipchart,
mmiscPlant1
mmiscPlant1, mmiscPlant2
]
when (any isNothing mimgs) $ do
liftIO $logIO Error "Failed to load image assets"
@ -197,7 +202,7 @@ loadFork ws win glc nvg future progress = do
-- (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE])
let imgs = zipWith (\a b -> (a, fromJust b))
[ ImgWallAsc
.. ImgMiscPlant1
.. ImgMiscPlant2
]
mimgs
directions = [E .. N] ++ [NE]
@ -257,6 +262,24 @@ loadFork ws win glc nvg future progress = do
, AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
)
]
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"toilet: free\""
)))
toiletFree <- loadAnimationSprites "assets/misc/toilet.png" nvg
[ ( AnimId "toilet" "free" N
, AnimationConfig (0, 0) (64, 74) (0, 0) 1 0 APLoop
)
]
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"toilet: occupied\""
)))
toiletOccupied <- loadAnimationSprites "assets/misc/toilet.png" nvg
[ ( AnimId "toilet" "occupied" N
, AnimationConfig (64, 0) (64, 74) (0, 0) 1 0 APLoop
)
]
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Handing over"
@ -273,7 +296,9 @@ loadFork ws win glc nvg future progress = do
jdoemWalking ++
copierStand ++
copierCopy ++
computerOff
computerOff ++
toiletFree ++
toiletOccupied
)
}
)

View file

@ -78,7 +78,7 @@ loadMapFork
-> MVar (Float, T.Text)
-> IO ()
loadMapFork ud future progress = do
let loadSteps = 19
let loadSteps = 20
fc = FloorConfig
(10, 10)
[(5, 5), (5, 45)]
@ -141,6 +141,7 @@ loadMapFork ud future progress = do
, objType = Just ObjCopier
}
) (A.log A.Debug ("number of copiers: " ++ show (length copiers)) copiers)
void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering computers into WorldState")
let computers = Prelude.filter (\a -> pointType a == Computer) rps
mapM_ (\(ReachPoint _ icoord dir) -> do
let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
@ -154,7 +155,19 @@ loadMapFork ud future progress = do
, objType = Just ObjComputer
}
) (A.log A.Debug ("number of computers: " ++ show (length computers)) computers)
void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering NPCs into WorldState")
void $ liftIO $ swapMVar progress (18 / loadSteps, "Registering toilets into WorldState")
let toilets = Prelude.filter (\a -> pointType a == Toilet) rps
mapM_ (\(ReachPoint _ icoord dir) -> do
let reachCoord = fmap ((+ 0.5) . fromIntegral) icoord
void $ createEntity $ newEntity
{ pos = Just $ reachCoord - V2 0 (-1)
, obstacle = Just $ Boundaries (0, 0) (1, 1)
, anim = Just $ AnimState (AnimId "toilet" "free" N) 0 0
, objAccess = Just $ (V2 0 (-1), dir)
, objType = Just ObjToilet
}
) (A.log A.Debug ("number of toilets: " ++ show (length toilets)) toilets)
void $ liftIO $ swapMVar progress (19 / loadSteps, "Registering NPCs into WorldState")
posbounds <- efor allEnts $ do
with pos
with obstacle
@ -175,7 +188,7 @@ loadMapFork ud future progress = do
, anim = Just $ AnimState (AnimId "jdoem" "standing" SE) 0 0
}
) npcposs
void $ liftIO $ swapMVar progress (19 / loadSteps, "Handing over")
void $ liftIO $ swapMVar progress (20 / loadSteps, "Handing over")
putMVar future (nws, MainData
{ mapMat = mat
, imgMat = M.fromList (nrows inter) (ncols inter) $

View file

@ -82,6 +82,9 @@ instance Collidible ImgId where
collisionObstacle ImgMiscPlant1 =
[ Boundaries (9/36, 9/36) (27/36, 27/26)
]
collisionObstacle ImgMiscPlant2 =
[ Boundaries (9/36, 9/36) (27/36, 27/26)
]
collisionObstacle ImgEmptyNoWalk =
[ Boundaries (0, 0) (1, 1) ]
collisionObstacle _ = []

View file

@ -28,6 +28,7 @@ data ImgId
| ImgTableC4
| ImgMiscFlipchart
| ImgMiscPlant1
| ImgMiscPlant2
-- | ImgIntrNE
-- | ImgIntrE
-- | ImgIntrSE

View file

@ -24,6 +24,8 @@ data Cluster
| ClusterConferenceTable1
| ClusterConferenceTable2
| ClusterPlant1
| ClusterPlant2
| ClusterToilet
deriving (Enum, Bounded)
clusterMat :: Cluster -> Matrix (Maybe ImgId)
@ -124,6 +126,12 @@ clusterMat ClusterConferenceTable2 =
clusterMat ClusterPlant1 =
M.fromLists
[ [ Just ImgMiscPlant1 ] ]
clusterMat ClusterPlant2 =
M.fromLists
[ [ Just ImgMiscPlant2 ] ]
clusterMat ClusterToilet =
M.fromLists
[ [ Just ImgEmpty, Just ImgEmptyNoWalk] ]
clusterRoom :: Cluster -> [TileState]
clusterRoom ClusterBox1 = [Offi]
@ -138,6 +146,8 @@ clusterRoom ClusterFlipchart = [Offi]
clusterRoom ClusterConferenceTable1 = [Offi]
clusterRoom ClusterConferenceTable2 = [Offi]
clusterRoom ClusterPlant1 = [Offi, Hall]
clusterRoom ClusterPlant2 = [Offi, Hall]
clusterRoom ClusterToilet = [Toil]
clusterPoints :: Cluster -> [ReachPoint]
clusterPoints ClusterBox1 = []
@ -185,6 +195,9 @@ clusterPoints ClusterConferenceTable2 =
, ReachPoint Table (V2 5 3) NW
, ReachPoint Table (V2 5 4) NW
]
clusterPoints ClusterToilet =
[ ReachPoint Toilet (V2 1 1) NE
]
clusterPoints _ = []
instance Size Cluster where

View file

@ -8,9 +8,10 @@ import Data.Ecstasy (Ent)
data ObjType
= ObjCopier
| ObjComputer
| ObjToilet
deriving (Show, Eq, Ord, Enum)
class ObjectAction us t where
objectAction :: t -> Ent -> Affection us ()
ubjectUpdate :: t -> Ent -> Affection us ()
objectUpdate :: t -> Ent -> Affection us ()

View file

@ -15,4 +15,5 @@ data PointType
| Table
| Copier
| Computer
| Toilet
deriving (Eq, Show)