diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index 04fbbf4..36b6f55 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -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 diff --git a/src/Types/Interior.hs b/src/Types/Interior.hs index d5dfb32..143ac33 100644 --- a/src/Types/Interior.hs +++ b/src/Types/Interior.hs @@ -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