add dining tables and clean tables
This commit is contained in:
parent
77b9a0a46e
commit
0fcd4a10b2
2 changed files with 12 additions and 69 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue