add dining tables and clean tables

This commit is contained in:
nek0 2019-03-09 20:37:20 +01:00
parent 77b9a0a46e
commit 0fcd4a10b2
2 changed files with 12 additions and 69 deletions

View file

@ -423,57 +423,6 @@ movePlayer2 (ActionMessage mov _) = do
}
movePlayer2 _ = return ()
playerInteract :: MouseMessage -> Affection UserData ()
playerInteract (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonRight _ m) = do
ud <- getAffection
(V2 rx ry) <- liftIO $ (* V2 640 360) <$> relativizeMouseCoords m
let dr = ((ry / 32) / sin (atan 0.5) / 2) + (rx / 64)
dc = (rx / 64) - ((ry / 32) / sin (atan 0.5) / 2)
(nws, _) <- yieldSystemT (worldState ud) $ do
emap allEnts $ do
with player
with rot
rot' <- query rot
let ndir = direction (V2 dr dc)
return $ unchanged
{ rot = Set $ fromMaybe rot' ndir
}
pdata <- efor allEnts $ do
with player
with pos
with rot
pos' <- query pos
rot' <- query rot
ent <- queryEnt
return (pos', rot', ent)
let (ppos, pdir, pent) = head pdata
mrelEnts <- efor allEnts $ do
with pos
with objAccess
with objType
with objState
reldirs <- query objAccess
pos' <- query pos
otype <- query objType
ostate <- query objState
ent <- queryEnt
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) reldirs
then return $ Just (otype, ostate, ent)
else return Nothing
let relEnts = catMaybes mrelEnts
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 True e (Just pent)
) relEnts
putAffection ud
{ worldState = nws
}
playerInteract _ = return ()
playerInteract2 :: ActionMessage -> Affection UserData ()
playerInteract2 (ActionMessage ActActivate _) = do
ud <- getAffection

View file

@ -34,6 +34,7 @@ data Cluster
| ClusterWatercooler
| ClusterVending
| ClusterCabinets
| ClusterBreakroomTable
deriving (Enum, Bounded, Show)
-- row -> NS; col -> WE
@ -72,18 +73,6 @@ clusterMatWithRPs ClusterTableSE dim@(_, mw) g =
]
, ps
)
-- clusterMatWithRPs ClusterTableNE dim@(h, _) _ =
-- ( M.fromLists $ replicate h
-- [Just ImgTableNE, Just ImgEmpty]
-- , clusterPoints ClusterTableNE dim
-- )
-- clusterMatWithRPs ClusterTableNW dim@(_, w) _ =
-- ( M.fromLists $
-- [ replicate w (Just ImgEmpty)
-- , replicate w (Just ImgTableNW)
-- ]
-- , clusterPoints ClusterTableNW dim
-- )
clusterMatWithRPs ClusterCornerTable dim _ =
( M.fromLists
[ [Just ImgTableSE, Just ImgTableCorner]
@ -232,12 +221,14 @@ clusterMatWithRPs ClusterCabinets (h, w) g =
M.fromLists (map (\a -> [a]) sws)
)
in (outmat, (seps ++ swps))
clusterMatWithRPs ClusterBreakroomTable dim g =
( fst (clusterMatWithRPs ClusterConferenceTable (4, 4) g)
, clusterPoints ClusterBreakroomTable dim
)
clusterRoom :: Cluster -> [TileState]
clusterRoom ClusterBox1 = [Offi]
clusterRoom ClusterTableSW = [Offi]
-- clusterRoom ClusterTableNW = [Offi]
-- clusterRoom ClusterTableNE = [Offi]
clusterRoom ClusterTableSE = [Offi]
clusterRoom ClusterCornerTable = [Offi]
clusterRoom ClusterTableGroup = [Offi]
@ -250,13 +241,10 @@ clusterRoom ClusterToilets = [Toil]
clusterRoom ClusterWatercooler = [Kitc, Offi]
clusterRoom ClusterVending = [Kitc]
clusterRoom ClusterCabinets = [Kitc]
clusterRoom ClusterBreakroomTable = [Kitc]
clusterPoints :: Cluster -> (Int, Int) -> [ReachPoint]
clusterPoints ClusterBox1 _ = []
-- clusterPoints ClusterTableNE (h, _) =
-- [ ReachPoint Table (V2 r 2) SW 0 | r <- [1..h] ]
-- clusterPoints ClusterTableNW (_, w) =
-- [ ReachPoint Table (V2 1 c) SE 0 | c <- [1..w] ]
clusterPoints ClusterCornerTable _ =
[ ReachPoint Computer (V2 2 1) N 0
]
@ -292,6 +280,12 @@ clusterPoints ClusterWatercooler _ =
clusterPoints ClusterVending _ =
[ ReachPoint Eat (V2 2 1) NW 0
]
clusterPoints ClusterBreakroomTable _ =
map
(\p -> p
{ pointType = Eat }
)
(clusterPoints ClusterConferenceTable (4, 4))
clusterPoints _ _ = []
instance Size (Cluster, (Int, Int), StdGen) where