Skip to content

Commit

Permalink
move robot dialog rendering to new module
Browse files Browse the repository at this point in the history
  • Loading branch information
kostmo committed Sep 5, 2024
1 parent 8e74d73 commit 4466c12
Show file tree
Hide file tree
Showing 4 changed files with 180 additions and 144 deletions.
168 changes: 168 additions & 0 deletions src/swarm-tui/Swarm/TUI/Model/Dialog/Robot.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,168 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A UI-centric model for Structure presentation.
module Swarm.TUI.Model.Dialog.Robot where

import Brick hiding (Direction, Location)
import Brick.Widgets.Center (hCenter)
import Brick.Widgets.Table qualified as BT
import Control.Lens as Lens hiding (Const, from)
import Data.IntMap qualified as IM
import Data.Map qualified as M
import Data.Maybe (fromMaybe)
import Linear
import Numeric (showFFloat)
import Swarm.Game.CESK (CESK (..))
import Swarm.Game.Entity as E
import Swarm.Game.Location
import Swarm.Game.Robot
import Swarm.Game.Robot.Activity
import Swarm.Game.Robot.Concrete
import Swarm.Game.State
import Swarm.Game.State.Robot
import Swarm.Game.State.Substate
import Swarm.Game.Tick (addTicks)
import Swarm.Game.Universe
import Swarm.Game.World.Coords
import Swarm.TUI.Model
import Swarm.TUI.Model.DebugOption (DebugOption (..))
import Swarm.TUI.Model.Name

Check warning on line 33 in src/swarm-tui/Swarm/TUI/Model/Dialog/Robot.hs

View workflow job for this annotation

GitHub Actions / Haskell-CI - windows-latest - ghc-9.8.2

The import of ‘Swarm.TUI.Model.Name’ is redundant
import Swarm.TUI.Model.UI
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.CellDisplay
import Swarm.TUI.View.Util as VU
import Swarm.Util
import Swarm.Util.UnitInterval
import Swarm.Util.WindowedCounter qualified as WC
import System.Clock (TimeSpec (..))

-- | Render the percentage of ticks that this robot was active.
-- This indicator can take some time to "warm up" and stabilize
-- due to the sliding window.
--
-- == Use of previous tick
-- The 'Swarm.Game.Step.gameTick' function runs all robots, then increments the current tick.
-- So at the time we are rendering a frame, the current tick will always be
-- strictly greater than any ticks stored in the 'WC.WindowedCounter' for any robot;
-- hence 'WC.getOccupancy' will never be @1@ if we use the current tick directly as
-- obtained from the 'ticks' function.
-- So we "rewind" it to the previous tick for the purpose of this display.
renderDutyCycle :: GameState -> Robot -> Widget Name
renderDutyCycle gs robot =
withAttr dutyCycleAttr . str . flip (showFFloat (Just 1)) "%" $ dutyCyclePercentage
where
curTicks = gs ^. temporal . ticks
window = robot ^. activityCounts . activityWindow

-- Rewind to previous tick
latestRobotTick = addTicks (-1) curTicks
dutyCycleRatio = WC.getOccupancy latestRobotTick window

dutyCycleAttr = safeIndex dutyCycleRatio meterAttributeNames

dutyCyclePercentage :: Double
dutyCyclePercentage = 100 * getValue dutyCycleRatio

robotsListWidget :: AppState -> Widget Name
robotsListWidget s = hCenter table
where
table =
BT.renderTable
. BT.columnBorders False
. BT.setDefaultColAlignment BT.AlignCenter
-- Inventory count is right aligned
. BT.alignRight 4
. BT.table
$ map (padLeftRight 1) <$> (headers : robotsTable)
headings =
[ "Name"
, "Age"
, "Pos"
, "Items"
, "Status"
, "Actns"
, "Cmds"
, "Cycles"
, "Activity"
, "Log"
]
headers = withAttr robotAttr . txt <$> applyWhen debugRID ("ID" :) headings
robotsTable = mkRobotRow <$> robots
mkRobotRow robot =
applyWhen debugRID (idWidget :) cells
where
cells =
[ nameWidget
, str ageStr
, locWidget
, padRight (Pad 1) (str $ show rInvCount)
, statusWidget
, str $ show $ robot ^. activityCounts . tangibleCommandCount
, -- TODO(#1341): May want to expose the details of this histogram in
-- a per-robot pop-up
str . show . sum . M.elems $ robot ^. activityCounts . commandsHistogram
, str $ show $ robot ^. activityCounts . lifetimeStepCount
, renderDutyCycle (s ^. gameState) robot
, txt rLog
]

idWidget = str $ show $ robot ^. robotID
nameWidget =
hBox
[ renderDisplay (robot ^. robotDisplay)
, highlightSystem . txt $ " " <> robot ^. robotName
]

highlightSystem = if robot ^. systemRobot then withAttr highlightAttr else id

ageStr
| age < 60 = show age <> "sec"
| age < 3600 = show (age `div` 60) <> "min"
| age < 3600 * 24 = show (age `div` 3600) <> "hour"
| otherwise = show (age `div` 3600 * 24) <> "day"
where
TimeSpec createdAtSec _ = robot ^. robotCreatedAt
TimeSpec nowSec _ = s ^. uiState . uiGameplay . uiTiming . lastFrameTime
age = nowSec - createdAtSec

rInvCount = sum $ map fst . E.elems $ robot ^. robotEntity . entityInventory
rLog
| robot ^. robotLogUpdated = "x"
| otherwise = " "

locWidget = hBox [worldCell, str $ " " <> locStr]
where
rCoords = fmap locToCoords rLoc
rLoc = robot ^. robotLocation
worldCell =
drawLoc
(s ^. uiState . uiGameplay)
g
rCoords
locStr = renderCoordsString rLoc

statusWidget = case robot ^. machine of
Waiting {} -> txt "waiting"
_
| isActive robot -> withAttr notifAttr $ txt "busy"
| otherwise -> withAttr greenAttr $ txt "idle"

basePos :: Point V2 Double
basePos = realToFrac <$> fromMaybe origin (g ^? baseRobot . robotLocation . planar)
-- Keep the base and non system robot (e.g. no seed)
isRelevant robot = robot ^. robotID == 0 || not (robot ^. systemRobot)
-- Keep the robot that are less than 32 unit away from the base
isNear robot = creative || distance (realToFrac <$> robot ^. robotLocation . planar) basePos < 32
robots :: [Robot]
robots =
filter (\robot -> debugAllRobots || (isRelevant robot && isNear robot))
. IM.elems
$ g ^. robotInfo . robotMap
creative = g ^. creativeMode
debugRID = s ^. uiState . uiDebugOptions . Lens.contains ListRobotIDs
debugAllRobots = s ^. uiState . uiDebugOptions . Lens.contains ListAllRobots
g = s ^. gameState
146 changes: 2 additions & 144 deletions src/swarm-tui/Swarm/TUI/View.hs
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,6 @@ import Data.Bits (shiftL, shiftR, (.&.))
import Data.Foldable (toList)
import Data.Foldable qualified as F
import Data.Functor (($>))
import Data.IntMap qualified as IM
import Data.List (intersperse)
import Data.List qualified as L
import Data.List.Extra (enumerate)
Expand All @@ -69,11 +68,8 @@ import Data.Set qualified as Set (toList)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (NominalDiffTime, defaultTimeLocale, formatTime)
import Linear
import Network.Wai.Handler.Warp (Port)
import Numeric (showFFloat)
import Swarm.Constant
import Swarm.Game.CESK (CESK (..))
import Swarm.Game.Device (commandCost, commandsForDeviceCaps, enabledCommands, getMap, ingredients)
import Swarm.Game.Display
import Swarm.Game.Entity as E
Expand All @@ -82,7 +78,6 @@ import Swarm.Game.Land
import Swarm.Game.Location
import Swarm.Game.Recipe
import Swarm.Game.Robot
import Swarm.Game.Robot.Activity
import Swarm.Game.Robot.Concrete
import Swarm.Game.Scenario (
scenarioAuthor,
Expand Down Expand Up @@ -114,7 +109,7 @@ import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Game.State.Runtime
import Swarm.Game.State.Substate
import Swarm.Game.Tick (TickNumber (..), addTicks)
import Swarm.Game.Tick (TickNumber (..))
import Swarm.Game.Universe
import Swarm.Game.World.Coords
import Swarm.Game.World.Gen (Seed)
Expand All @@ -135,6 +130,7 @@ import Swarm.TUI.Launch.View
import Swarm.TUI.Model
import Swarm.TUI.Model.DebugOption (DebugOption (..))
import Swarm.TUI.Model.Dialog.Goal (goalsContent, hasAnythingToShow)
import Swarm.TUI.Model.Dialog.Robot
import Swarm.TUI.Model.Event qualified as SE
import Swarm.TUI.Model.KeyBindings (handlerNameKeysDescription)
import Swarm.TUI.Model.Repl
Expand All @@ -149,9 +145,6 @@ import Swarm.TUI.View.Popup
import Swarm.TUI.View.Structure qualified as SR
import Swarm.TUI.View.Util as VU
import Swarm.Util
import Swarm.Util.UnitInterval
import Swarm.Util.WindowedCounter qualified as WC
import System.Clock (TimeSpec (..))
import Text.Printf
import Text.Wrap
import Witch (into)
Expand Down Expand Up @@ -507,14 +500,6 @@ drawGameUI s =
)
]

renderCoordsString :: Cosmic Location -> String
renderCoordsString (Cosmic sw coords) =
unwords $ VU.locationToString coords : suffix
where
suffix = case sw of
DefaultRootSubworld -> []
SubworldName swName -> ["in", T.unpack swName]

drawWorldCursorInfo :: WorldOverdraw -> GameState -> Cosmic Coords -> Widget Name
drawWorldCursorInfo worldEditor g cCoords =
case getStatic g coords of
Expand Down Expand Up @@ -660,133 +645,6 @@ drawModal s = \case
TerrainPaletteModal -> EV.drawTerrainSelector s
EntityPaletteModal -> EV.drawEntityPaintSelector s

-- | Render the percentage of ticks that this robot was active.
-- This indicator can take some time to "warm up" and stabilize
-- due to the sliding window.
--
-- == Use of previous tick
-- The 'Swarm.Game.Step.gameTick' function runs all robots, then increments the current tick.
-- So at the time we are rendering a frame, the current tick will always be
-- strictly greater than any ticks stored in the 'WC.WindowedCounter' for any robot;
-- hence 'WC.getOccupancy' will never be @1@ if we use the current tick directly as
-- obtained from the 'ticks' function.
-- So we "rewind" it to the previous tick for the purpose of this display.
renderDutyCycle :: GameState -> Robot -> Widget Name
renderDutyCycle gs robot =
withAttr dutyCycleAttr . str . flip (showFFloat (Just 1)) "%" $ dutyCyclePercentage
where
curTicks = gs ^. temporal . ticks
window = robot ^. activityCounts . activityWindow

-- Rewind to previous tick
latestRobotTick = addTicks (-1) curTicks
dutyCycleRatio = WC.getOccupancy latestRobotTick window

dutyCycleAttr = safeIndex dutyCycleRatio meterAttributeNames

dutyCyclePercentage :: Double
dutyCyclePercentage = 100 * getValue dutyCycleRatio

robotsListWidget :: AppState -> Widget Name
robotsListWidget s = hCenter table
where
table =
BT.renderTable
. BT.columnBorders False
. BT.setDefaultColAlignment BT.AlignCenter
-- Inventory count is right aligned
. BT.alignRight 4
. BT.table
$ map (padLeftRight 1) <$> (headers : robotsTable)
headings =
[ "Name"
, "Age"
, "Pos"
, "Items"
, "Status"
, "Actns"
, "Cmds"
, "Cycles"
, "Activity"
, "Log"
]
headers = withAttr robotAttr . txt <$> applyWhen debugRID ("ID" :) headings
robotsTable = mkRobotRow <$> robots
mkRobotRow robot =
applyWhen debugRID (idWidget :) cells
where
cells =
[ nameWidget
, str ageStr
, locWidget
, padRight (Pad 1) (str $ show rInvCount)
, statusWidget
, str $ show $ robot ^. activityCounts . tangibleCommandCount
, -- TODO(#1341): May want to expose the details of this histogram in
-- a per-robot pop-up
str . show . sum . M.elems $ robot ^. activityCounts . commandsHistogram
, str $ show $ robot ^. activityCounts . lifetimeStepCount
, renderDutyCycle (s ^. gameState) robot
, txt rLog
]

idWidget = str $ show $ robot ^. robotID
nameWidget =
hBox
[ renderDisplay (robot ^. robotDisplay)
, highlightSystem . txt $ " " <> robot ^. robotName
]

highlightSystem = if robot ^. systemRobot then withAttr highlightAttr else id

ageStr
| age < 60 = show age <> "sec"
| age < 3600 = show (age `div` 60) <> "min"
| age < 3600 * 24 = show (age `div` 3600) <> "hour"
| otherwise = show (age `div` 3600 * 24) <> "day"
where
TimeSpec createdAtSec _ = robot ^. robotCreatedAt
TimeSpec nowSec _ = s ^. uiState . uiGameplay . uiTiming . lastFrameTime
age = nowSec - createdAtSec

rInvCount = sum $ map fst . E.elems $ robot ^. robotEntity . entityInventory
rLog
| robot ^. robotLogUpdated = "x"
| otherwise = " "

locWidget = hBox [worldCell, str $ " " <> locStr]
where
rCoords = fmap locToCoords rLoc
rLoc = robot ^. robotLocation
worldCell =
drawLoc
(s ^. uiState . uiGameplay)
g
rCoords
locStr = renderCoordsString rLoc

statusWidget = case robot ^. machine of
Waiting {} -> txt "waiting"
_
| isActive robot -> withAttr notifAttr $ txt "busy"
| otherwise -> withAttr greenAttr $ txt "idle"

basePos :: Point V2 Double
basePos = realToFrac <$> fromMaybe origin (g ^? baseRobot . robotLocation . planar)
-- Keep the base and non system robot (e.g. no seed)
isRelevant robot = robot ^. robotID == 0 || not (robot ^. systemRobot)
-- Keep the robot that are less than 32 unit away from the base
isNear robot = creative || distance (realToFrac <$> robot ^. robotLocation . planar) basePos < 32
robots :: [Robot]
robots =
filter (\robot -> debugAllRobots || (isRelevant robot && isNear robot))
. IM.elems
$ g ^. robotInfo . robotMap
creative = g ^. creativeMode
debugRID = s ^. uiState . uiDebugOptions . Lens.contains ListRobotIDs
debugAllRobots = s ^. uiState . uiDebugOptions . Lens.contains ListAllRobots
g = s ^. gameState

helpWidget :: Seed -> Maybe Port -> KeyEventHandlingState -> Widget Name
helpWidget theSeed mport keyState =
padLeftRight 2 . vBox $ padTop (Pad 1) <$> [info, helpKeys, tips]
Expand Down
9 changes: 9 additions & 0 deletions src/swarm-tui/Swarm/TUI/View/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Substate
import Swarm.Game.Terrain
import Swarm.Game.Universe
import Swarm.Language.Pretty (prettyTextLine)
import Swarm.Language.Syntax (Syntax)
import Swarm.Language.Text.Markdown qualified as Markdown
Expand Down Expand Up @@ -255,3 +256,11 @@ bindingText s e = maybe "" ppBindingShort b
Binding V.KLeft m | null m -> ""
Binding V.KRight m | null m -> ""
bi -> ppBinding bi

renderCoordsString :: Cosmic Location -> String
renderCoordsString (Cosmic sw coords) =
unwords $ locationToString coords : suffix
where
suffix = case sw of
DefaultRootSubworld -> []
SubworldName swName -> ["in", T.unpack swName]
Loading

0 comments on commit 4466c12

Please sign in to comment.