diff --git a/src/Swarm/Game/Log.hs b/src/Swarm/Game/Log.hs index fb80189f7c..9de5f563c4 100644 --- a/src/Swarm/Game/Log.hs +++ b/src/Swarm/Game/Log.hs @@ -20,6 +20,7 @@ module Swarm.Game.Log ( -- * Robot log entries LogEntry (..), + LogLocation (..), leText, leSource, leRobotName, @@ -51,6 +52,9 @@ data LogSource ErrorTrace ErrorLevel deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON) +data LogLocation a = Omnipresent | Located a + deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON) + -- | An entry in a robot's log. data LogEntry = LogEntry { _leTime :: TickNumber @@ -62,7 +66,7 @@ data LogEntry = LogEntry -- ^ The name of the robot that generated the entry. , _leRobotID :: Int -- ^ The ID of the robot that generated the entry. - , _leLocation :: Maybe (Cosmo Location) + , _leLocation :: LogLocation (Cosmo Location) -- ^ Location of the robot at log entry creation. -- "Nothing" represents omnipresence for the purpose of proximity. -- TODO: Define a type isomorphic to Maybe that makes this explict. diff --git a/src/Swarm/Game/State.hs b/src/Swarm/Game/State.hs index 0af21f4d0d..8cf49c64f6 100644 --- a/src/Swarm/Game/State.hs +++ b/src/Swarm/Game/State.hs @@ -693,11 +693,16 @@ messageNotifications = to getNotif messageIsRecent :: GameState -> LogEntry -> Bool messageIsRecent gs e = addTicks 1 (e ^. leTime) >= gs ^. ticks --- | If the log location is 'Nothing', consider it omnipresent. +-- | Reconciles the possibilities of log messages being +-- omnipresent and robots being in different worlds messageIsFromNearby :: Cosmo Location -> LogEntry -> Bool -messageIsFromNearby l e = maybe True f (e ^. leLocation) +messageIsFromNearby l e = case e ^. leLocation of + Omnipresent -> True + Located x -> f x where - f logLoc = maybe False (<= hearingDistance) $ cosmoMeasure manhattan l logLoc + f logLoc = case cosmoMeasure manhattan l logLoc of + InfinitelyFar -> False + Measurable x -> x <= hearingDistance -- | Given a current mapping from robot names to robots, apply a -- 'ViewCenterRule' to derive the location it refers to. The result @@ -787,18 +792,22 @@ data RobotRange -- both radii. -- * If the base has an @antenna@ installed, it also doubles both radii. focusedRange :: GameState -> Maybe RobotRange -focusedRange g = computedRange <$ focusedRobot g +focusedRange g = checkRange <$ focusedRobot g where - computedRange - | g ^. creativeMode || g ^. worldScrollable || r <= minRadius = Close - | r > maxRadius = Far - | otherwise = MidRange $ (r - minRadius) / (maxRadius - minRadius) + checkRange = case r of + InfinitelyFar -> Far + Measurable r' -> computedRange r' + + computedRange r' + | g ^. creativeMode || g ^. worldScrollable || r' <= minRadius = Close + | r' > maxRadius = Far + | otherwise = MidRange $ (r' - minRadius) / (maxRadius - minRadius) -- Euclidean distance from the base to the view center. - r = fromMaybe 1000000000 $ do + r = case g ^. robotMap . at 0 of -- if the base doesn't exist, we have bigger problems - br <- g ^. robotMap . at 0 - cosmoMeasure euclidean (g ^. viewCenter) (br ^. robotLocation) + Nothing -> InfinitelyFar + Just br -> cosmoMeasure euclidean (g ^. viewCenter) (br ^. robotLocation) -- See whether the base or focused robot have antennas installed. baseInv, focInv :: Maybe Inventory @@ -1102,8 +1111,8 @@ scenarioToGameState scenario (LaunchParams (Identity userSeed) (Identity toRun)) & knownEntities .~ scenario ^. scenarioKnown & worldNavigation .~ scenario ^. scenarioNavigation & multiWorld .~ allSubworldsMap theSeed - -- TODO: Should we allow subworlds to have their own scrollability? - -- Leaning toward yes, but for now just adopt the root world scrollability + -- TODO (#1370): Should we allow subworlds to have their own scrollability? + -- Leaning toward no , but for now just adopt the root world scrollability -- as being universal. & worldScrollable .~ NE.head (scenario ^. scenarioWorlds) ^. to scrollable & viewCenterRule .~ VCRobot baseID diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index dd9e0034ed..e65628fbc0 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -519,7 +519,7 @@ createLogEntry source msg = do rn <- use robotName time <- use ticks loc <- use robotLocation - pure $ LogEntry time source rn rid (Just loc) msg + pure $ LogEntry time source rn rid (Located loc) msg -- | Print some text via the robot's log. traceLog :: (Has (State GameState) sig m, Has (State Robot) sig m) => LogSource -> Text -> m LogEntry @@ -1617,17 +1617,14 @@ execConst c vs s k = do loc <- use robotLocation m <- traceLog Said msg -- current robot will inserted to robot set, so it needs the log emitMessage m - let manhattanToLog :: Cosmo Location -> Maybe (Cosmo Location) -> Maybe Int32 - -- Measures the Manhattan distance between a robot and a (Maybe) log location. - -- If log location is Nothing, it is \"omnipresent\" and therefore distance is zero. - manhattanToLog robLoc maybeLogLoc = case maybeLogLoc of - Just logLoc -> cosmoMeasure manhattan robLoc logLoc - Nothing -> Just 0 + let measureToLog robLoc rawLogLoc = case rawLogLoc of + Located logLoc -> cosmoMeasure manhattan robLoc logLoc + Omnipresent -> Measurable 0 addLatestClosest rl = \case Seq.Empty -> Seq.singleton m es Seq.:|> e - | e ^. leTime < m ^. leTime -> es |> e |> m - | (cmpManhattan `on` (manhattanToLog rl . view leLocation)) e m -> es |> m + | e `isEarlierThan` m -> es |> e |> m + | e `isFartherThan` m -> es |> m | otherwise -> es |> e where isEarlierThan = (<) `on` (^. leTime) @@ -2654,7 +2651,9 @@ isPrivilegedBot = (||) <$> use systemRobot <*> use creativeMode -- Requirement is waived if the bot is privileged. isNearbyOrExempt :: Bool -> Cosmo Location -> Cosmo Location -> Bool isNearbyOrExempt privileged myLoc otherLoc = - privileged || maybe False (<= 1) (cosmoMeasure manhattan myLoc otherLoc) + privileged || case cosmoMeasure manhattan myLoc otherLoc of + InfinitelyFar -> False + Measurable x -> x <= 1 grantAchievement :: (Has (State GameState) sig m, Has (Lift IO) sig m) => diff --git a/src/Swarm/Game/Universe.hs b/src/Swarm/Game/Universe.hs index 40e91d1fa8..71b2b4b265 100644 --- a/src/Swarm/Game/Universe.hs +++ b/src/Swarm/Game/Universe.hs @@ -6,7 +6,6 @@ module Swarm.Game.Universe where import Control.Lens (makeLenses, view) -import Control.Monad (guard) import Data.Function (on) import Data.Int (Int32) import Data.Text (Text) @@ -58,12 +57,14 @@ instance (FromJSON a) => FromJSON (Cosmo a) where defaultCosmoLocation :: Cosmo Location defaultCosmoLocation = Cosmo defaultRootSubworldName origin --- | Returns 'Nothing' if not within the same subworld. --- TODO: Define a new datatype isomorphic to Maybe for this. -cosmoMeasure :: (a -> a -> b) -> Cosmo a -> Cosmo a -> Maybe b -cosmoMeasure f a b = do - guard $ ((==) `on` view subworld) a b - pure $ (f `on` view planar) a b +data DistanceMeasure b = Measurable b | InfinitelyFar + deriving (Eq, Ord) + +-- | Returns 'InfinitelyFar' if not within the same subworld. +cosmoMeasure :: (a -> a -> b) -> Cosmo a -> Cosmo a -> DistanceMeasure b +cosmoMeasure f a b + | ((/=) `on` view subworld) a b = InfinitelyFar + | otherwise = Measurable $ (f `on` view planar) a b offsetBy :: Cosmo Location -> V2 Int32 -> Cosmo Location offsetBy loc v = fmap (.+^ v) loc diff --git a/src/Swarm/TUI/Model.hs b/src/Swarm/TUI/Model.hs index 20ffcf050e..7b8eff7f82 100644 --- a/src/Swarm/TUI/Model.hs +++ b/src/Swarm/TUI/Model.hs @@ -272,7 +272,7 @@ logEvent src (who, rid) msg el = & notificationsCount %~ succ & notificationsContent %~ (l :) where - l = LogEntry (TickNumber 0) src who rid Nothing msg + l = LogEntry (TickNumber 0) src who rid Omnipresent msg -- | Create a 'GameStateConfig' record from the 'RuntimeState'. mkGameStateConfig :: RuntimeState -> GameStateConfig