{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Code for drawing the TUI.
module Swarm.TUI.View (
  drawUI,
  drawTPS,

  -- * Dialog box
  drawDialog,
  chooseCursor,

  -- * Key hint menu
  drawKeyMenu,
  drawModalMenu,
  drawKeyCmd,

  -- * World
  drawWorldPane,

  -- * Robot panel
  drawRobotPanel,
  drawItem,
  drawLabelledEntityName,
  renderDutyCycle,

  -- * Info panel
  drawInfoPanel,
  explainFocusedItem,

  -- * REPL
  drawREPL,
) where

import Brick hiding (Direction, Location)
import Brick.Focus
import Brick.Forms
import Brick.Widgets.Border (
  hBorder,
  hBorderWithLabel,
  joinableBorder,
  vBorder,
 )
import Brick.Widgets.Center (center, centerLayer, hCenter)
import Brick.Widgets.Dialog
import Brick.Widgets.Edit (getEditContents, renderEditor)
import Brick.Widgets.List qualified as BL
import Brick.Widgets.Table qualified as BT
import Control.Lens as Lens hiding (Const, from)
import Control.Monad (guard)
import Data.Array (range)
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.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.List.Split (chunksOf)
import Data.Map qualified as M
import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe, mapMaybe, maybeToList)
import Data.Semigroup (sconcat)
import Data.Sequence qualified as Seq
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 (..), TickNumber (..), addTicks)
import Swarm.Game.Display
import Swarm.Game.Entity as E
import Swarm.Game.Location
import Swarm.Game.Recipe
import Swarm.Game.Robot
import Swarm.Game.Scenario (
  scenarioAuthor,
  scenarioCreative,
  scenarioDescription,
  scenarioKnown,
  scenarioName,
  scenarioObjectives,
  scenarioSeed,
 )
import Swarm.Game.Scenario.Scoring.Best
import Swarm.Game.Scenario.Scoring.CodeSize
import Swarm.Game.Scenario.Scoring.ConcreteMetrics
import Swarm.Game.Scenario.Scoring.GenericMetrics
import Swarm.Game.Scenario.Status
import Swarm.Game.ScenarioInfo (
  ScenarioItem (..),
  scenarioItemName,
 )
import Swarm.Game.State
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.Language.Capability (Capability (..), constCaps)
import Swarm.Language.Pretty (prettyText, prettyTextLine)
import Swarm.Language.Syntax
import Swarm.Language.Typecheck (inferConst)
import Swarm.Log
import Swarm.TUI.Border
import Swarm.TUI.Controller (ticksPerFrameCap)
import Swarm.TUI.Editor.Model
import Swarm.TUI.Editor.View qualified as EV
import Swarm.TUI.Inventory.Sorting (renderSortMethod)
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.View
import Swarm.TUI.Model
import Swarm.TUI.Model.Goal (goalsContent, hasAnythingToShow)
import Swarm.TUI.Model.Repl (getSessionREPLHistoryItems, lastEntry)
import Swarm.TUI.Model.UI
import Swarm.TUI.Panel
import Swarm.TUI.View.Achievement
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.CellDisplay
import Swarm.TUI.View.Objective qualified as GR
import Swarm.TUI.View.Util as VU
import Swarm.Util
import Swarm.Util.UnitInterval
import Swarm.Util.WindowedCounter qualified as WC
import Swarm.Version (NewReleaseFailure (..))
import System.Clock (TimeSpec (..))
import Text.Printf
import Text.Wrap
import Witch (into)

-- | The main entry point for drawing the entire UI.  Figures out
--   which menu screen we should show (if any), or just the game itself.
drawUI :: AppState -> [Widget Name]
drawUI :: AppState -> [Widget Name]
drawUI AppState
s
  | AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiPlaying = AppState -> [Widget Name]
drawGameUI AppState
s
  | Bool
otherwise = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu of
      -- We should never reach the NoMenu case if uiPlaying is false; we would have
      -- quit the app instead.  But just in case, we display the main menu anyway.
      Menu
NoMenu -> [AppState -> List Name MainMenuEntry -> Widget Name
drawMainMenuUI AppState
s (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
NewGame)]
      MainMenu List Name MainMenuEntry
l -> [AppState -> List Name MainMenuEntry -> Widget Name
drawMainMenuUI AppState
s List Name MainMenuEntry
l]
      NewGameMenu NonEmpty (List Name ScenarioItem)
stk -> NonEmpty (List Name ScenarioItem) -> LaunchOptions -> [Widget Name]
drawNewGameMenuUI NonEmpty (List Name ScenarioItem)
stk forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig
      AchievementsMenu List Name CategorizedAchievement
l -> [AppState -> List Name CategorizedAchievement -> Widget Name
drawAchievementsMenuUI AppState
s List Name CategorizedAchievement
l]
      Menu
MessagesMenu -> [AppState -> Widget Name
drawMainMessages AppState
s]
      Menu
AboutMenu -> [Maybe Text -> Widget Name
drawAboutMenuUI (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Map Text Text)
appData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
"about")]

drawMainMessages :: AppState -> Widget Name
drawMainMessages :: AppState -> Widget Name
drawMainMessages AppState
s = forall n a. Ord n => Dialog a n -> Widget n -> Widget n
renderDialog forall {a}. Dialog a Name
dial forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
scrollList forall a b. (a -> b) -> a -> b
$ forall {a}. [LogEntry] -> [Widget a]
drawLogs [LogEntry]
ls
 where
  ls :: [LogEntry]
ls = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Notifications LogEntry)
eventLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent
  dial :: Dialog a Name
dial = forall n a.
Eq n =>
Maybe (Widget n)
-> Maybe (n, [(String, n, a)]) -> Count -> Dialog a n
dialog (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Messages") forall a. Maybe a
Nothing Count
maxModalWindowWidth
  scrollList :: [Widget n] -> Widget n
scrollList = forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox
  drawLogs :: [LogEntry] -> [Widget a]
drawLogs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Bool -> LogEntry -> Widget a
drawLogEntry Bool
True)

drawMainMenuUI :: AppState -> BL.List Name MainMenuEntry -> Widget Name
drawMainMenuUI :: AppState -> List Name MainMenuEntry -> Widget Name
drawMainMenuUI AppState
s List Name MainMenuEntry
l =
  forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
    [ Text -> Widget Name
drawLogo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
logo
    , forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
padTopBottom Count
2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Either NewReleaseFailure String -> Maybe (Widget n)
newVersionWidget Either NewReleaseFailure String
version
    , forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n
centerLayer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
vLimit Count
6 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
hLimit Count
20 forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
BL.renderList (forall a b. a -> b -> a
const (forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> MainMenuEntry -> Widget Name
drawMainMenuEntry AppState
s)) Bool
True List Name MainMenuEntry
l
    ]
 where
  logo :: Maybe Text
logo = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Map Text Text)
appData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
"logo"
  version :: Either NewReleaseFailure String
version = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Either NewReleaseFailure String)
upstreamRelease

newVersionWidget :: Either NewReleaseFailure String -> Maybe (Widget n)
newVersionWidget :: forall n. Either NewReleaseFailure String -> Maybe (Widget n)
newVersionWidget = \case
  Right String
ver -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"New version " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
ver forall a. Semigroup a => a -> a -> a
<> Text
" is available!"
  Left (OnDevelopmentBranch String
_b) -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"Good luck developing!"
  Left (FailedReleaseQuery String
_f) -> forall a. Maybe a
Nothing
  Left (NoMainUpstreamRelease [String]
_fails) -> forall a. Maybe a
Nothing
  Left (OldUpstreamRelease Version
_up Version
_my) -> forall a. Maybe a
Nothing

drawLogo :: Text -> Widget Name
drawLogo :: Text -> Widget Name
drawLogo = forall n. Widget n -> Widget n
centerLayer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall {n}. [Widget n] -> Widget n
hBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (\Char
c [Widget Name]
ws -> Char -> Widget Name
drawThing Char
c forall a. a -> [a] -> [a]
: [Widget Name]
ws) []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
 where
  drawThing :: Char -> Widget Name
  drawThing :: Char -> Widget Name
drawThing Char
c = forall n. AttrName -> Widget n -> Widget n
withAttr (Char -> AttrName
attrFor Char
c) forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str [Char
c]

  attrFor :: Char -> AttrName
  attrFor :: Char -> AttrName
attrFor Char
c
    | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"<>v^" :: String) = AttrName
robotAttr
  attrFor Char
'T' = AttrName
plantAttr
  attrFor Char
'@' = AttrName
rockAttr
  attrFor Char
'~' = AttrName
waterAttr
  attrFor Char
'▒' = AttrName
dirtAttr
  attrFor Char
_ = AttrName
defAttr

-- | When launching a game, a modal prompt may appear on another layer
-- to input seed and/or a script to run.
drawNewGameMenuUI ::
  NonEmpty (BL.List Name ScenarioItem) ->
  LaunchOptions ->
  [Widget Name]
drawNewGameMenuUI :: NonEmpty (List Name ScenarioItem) -> LaunchOptions -> [Widget Name]
drawNewGameMenuUI (List Name ScenarioItem
l :| [List Name ScenarioItem]
ls) LaunchOptions
launchOptions = case Maybe ScenarioInfoPair
displayedFor of
  Maybe ScenarioInfoPair
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget Name
mainWidget
  Just ScenarioInfoPair
_ -> LaunchOptions -> [Widget Name]
drawLaunchConfigPanel LaunchOptions
launchOptions forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget Name
mainWidget
 where
  displayedFor :: Maybe ScenarioInfoPair
displayedFor = LaunchOptions
launchOptions forall s a. s -> Getting a s a -> a
^. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (Maybe ScenarioInfoPair)
isDisplayedFor
  mainWidget :: Widget Name
mainWidget =
    forall {n}. [Widget n] -> Widget n
vBox
      [ forall n. Count -> Widget n -> Widget n
padLeftRight Count
20
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n
centerLayer
          forall a b. (a -> b) -> a -> b
$ forall {n}. [Widget n] -> Widget n
hBox
            [ forall {n}. [Widget n] -> Widget n
vBox
                [ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ [List Name ScenarioItem] -> Text
breadcrumbs [List Name ScenarioItem]
ls
                , forall n. Text -> Widget n
txt Text
" "
                , forall n. Count -> Widget n -> Widget n
vLimit Count
20
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
hLimit Count
35
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
BL.renderList (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. ScenarioItem -> Widget n
drawScenarioItem) Bool
True
                    forall a b. (a -> b) -> a -> b
$ List Name ScenarioItem
l
                ]
            , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
5) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall n. Text -> Widget n
txt Text
"") (ScenarioItem -> Widget Name
drawDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Count, e)
BL.listSelectedElement List Name ScenarioItem
l))
            ]
      , forall {n}. Widget n
launchOptionsMessage
      ]

  launchOptionsMessage :: Widget n
launchOptionsMessage = case (Maybe ScenarioInfoPair
displayedFor, forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Count, e)
BL.listSelectedElement List Name ScenarioItem
l) of
    (Maybe ScenarioInfoPair
Nothing, Just (SISingle ScenarioInfoPair
_)) -> forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Press 'o' for launch options, or 'Enter' to launch with defaults"
    (Maybe ScenarioInfoPair, Maybe ScenarioItem)
_ -> forall n. Text -> Widget n
txt Text
" "

  drawScenarioItem :: ScenarioItem -> Widget n
drawScenarioItem (SISingle (Scenario
s, ScenarioInfo
si)) = forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) (forall {n}. Scenario -> ScenarioInfo -> Widget n
drawStatusInfo Scenario
s ScenarioInfo
si) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario Text
scenarioName)
  drawScenarioItem (SICollection Text
nm ScenarioCollection
_) = forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" > ") forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
nm
  drawStatusInfo :: Scenario -> ScenarioInfo -> Widget n
drawStatusInfo Scenario
s ScenarioInfo
si = case ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioStatus of
    ScenarioStatus
NotStarted -> forall n. Text -> Widget n
txt Text
" ○ "
    Played SerializableLaunchParams
_initialScript (Metric Progress
Attempted ProgressStats
_) BestRecords
_ -> case Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Objective]
scenarioObjectives of
      [] -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ◉ "
      [Objective]
_ -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ◎ "
    Played SerializableLaunchParams
_initialScript (Metric Progress
Completed ProgressStats
_) BestRecords
_ -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ● "

  describeStatus :: ScenarioStatus -> Widget n
  describeStatus :: forall n. ScenarioStatus -> Widget n
describeStatus = \case
    ScenarioStatus
NotStarted -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"not started"
    Played SerializableLaunchParams
_initialScript Metric ProgressStats
pm BestRecords
_best -> forall n. Metric ProgressStats -> Widget n
describeProgress Metric ProgressStats
pm

  breadcrumbs :: [BL.List Name ScenarioItem] -> Text
  breadcrumbs :: [List Name ScenarioItem] -> Text
breadcrumbs =
    Text -> [Text] -> Text
T.intercalate Text
" > "
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Scenarios" forall a. a -> [a] -> [a]
:)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScenarioItem -> Text
scenarioItemName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Count, e)
BL.listSelectedElement)

  drawDescription :: ScenarioItem -> Widget Name
  drawDescription :: ScenarioItem -> Widget Name
drawDescription (SICollection Text
_ ScenarioCollection
_) = forall n. Text -> Widget n
txtWrap Text
" "
  drawDescription (SISingle (Scenario
s, ScenarioInfo
si)) =
    forall {n}. [Widget n] -> Widget n
vBox
      [ Document Syntax -> Widget Name
drawMarkdown (forall {a}. (Eq a, IsString a) => a -> a
nonBlank (Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Document Syntax)
scenarioDescription))
      , forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
vLimit Count
6 forall a b. (a -> b) -> a -> b
$ forall n. Count -> Widget n -> Widget n
hLimitPercent Count
60 forall {n}. Widget n
worldPeek
      , forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall {n}. Widget n
table
      ]
   where
    defaultVC :: Cosmic Location
defaultVC = forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
DefaultRootSubworld forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin

    -- The first robot is guaranteed to be the base.
    baseRobotLoc :: Maybe (Cosmic Location)
    baseRobotLoc :: Maybe (Cosmic Location)
baseRobotLoc = do
      TRobot
theBaseRobot <- forall a. [a] -> Maybe a
listToMaybe [TRobot]
theRobots
      forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' TRobot (Maybe (Cosmic Location))
trobotLocation TRobot
theBaseRobot

    vc :: Cosmic Location
vc = forall a. a -> Maybe a -> a
fromMaybe Cosmic Location
defaultVC Maybe (Cosmic Location)
baseRobotLoc

    worldTuples :: NonEmpty SubworldDescription
worldTuples = Scenario -> NonEmpty SubworldDescription
buildWorldTuples Scenario
s
    theWorlds :: MultiWorld Count Entity
theWorlds = NonEmpty SubworldDescription -> Count -> MultiWorld Count Entity
genMultiWorld NonEmpty SubworldDescription
worldTuples forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Count
0 forall a b. (a -> b) -> a -> b
$ Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe Count)
scenarioSeed
    theRobots :: [TRobot]
theRobots = forall a b.
Scenario -> NonEmpty (a, ([(Count, TRobot)], b)) -> [TRobot]
genRobotTemplates Scenario
s NonEmpty SubworldDescription
worldTuples

    ri :: RenderingInput
ri =
      MultiWorld Count Entity -> (EntityPaint -> Bool) -> RenderingInput
RenderingInput MultiWorld Count Entity
theWorlds forall a b. (a -> b) -> a -> b
$
        EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown forall a b. (a -> b) -> a -> b
$
          EntityKnowledgeDependencies
            { isCreativeMode :: Bool
isCreativeMode = Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative
            , globallyKnownEntities :: [Text]
globallyKnownEntities = Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Text]
scenarioKnown
            , theFocusedRobot :: Maybe Robot
theFocusedRobot = forall a. Maybe a
Nothing
            }
    renderCoord :: Cosmic Coords -> Widget n
renderCoord = forall n. Display -> Widget n
renderDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorldOverdraw
-> RenderingInput -> [Display] -> Cosmic Coords -> Display
displayLocRaw (Bool -> Map Coords (TerrainWith EntityFacade) -> WorldOverdraw
WorldOverdraw Bool
False forall a. Monoid a => a
mempty) RenderingInput
ri []
    worldPeek :: Widget n
worldPeek = forall n.
(Cosmic Coords -> Widget n) -> Cosmic Location -> Widget n
worldWidget forall {n}. Cosmic Coords -> Widget n
renderCoord Cosmic Location
vc

    firstRow :: (Widget n, Maybe (Widget n))
firstRow =
      ( forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dimAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Author:"
      , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dimAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe Text)
scenarioAuthor
      )
    secondRow :: (Widget n, Maybe (Widget n))
secondRow =
      ( forall n. Text -> Widget n
txt Text
"last:"
      , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. ScenarioStatus -> Widget n
describeStatus forall a b. (a -> b) -> a -> b
$ ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioStatus
      )

    padTopLeft :: Widget n -> Widget n
padTopLeft = forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
1)

    tableRows :: [[Widget n]]
tableRows =
      forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall n. Widget n -> Widget n
padTopLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a, a) -> [a]
pairToList) forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$
          forall {n} {n}. (Widget n, Maybe (Widget n))
firstRow forall a. a -> [a] -> [a]
: forall {n} {n}. (Widget n, Maybe (Widget n))
secondRow forall a. a -> [a] -> [a]
: forall n1 n2. ScenarioStatus -> [(Widget n1, Maybe (Widget n2))]
makeBestScoreRows (ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioStatus)
    table :: Widget n
table =
      forall n. Table n -> Widget n
BT.renderTable
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.surroundingBorder Bool
False
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.rowBorders Bool
False
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.columnBorders Bool
False
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Table n -> Table n
BT.alignRight Count
0
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Table n -> Table n
BT.alignLeft Count
1
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. [[Widget n]] -> Table n
BT.table
        forall a b. (a -> b) -> a -> b
$ forall {n}. [[Widget n]]
tableRows

  nonBlank :: a -> a
nonBlank a
"" = a
" "
  nonBlank a
t = a
t

pairToList :: (a, a) -> [a]
pairToList :: forall a. (a, a) -> [a]
pairToList (a
x, a
y) = [a
x, a
y]

describeProgress :: ProgressMetric -> Widget n
describeProgress :: forall n. Metric ProgressStats -> Widget n
describeProgress (Metric Progress
p (ProgressStats ZonedTime
_startedAt (AttemptMetrics (DurationMetrics NominalDiffTime
e TickNumber
t) Maybe ScenarioCodeMetrics
maybeCodeMetrics))) = case Progress
p of
  Progress
Attempted ->
    forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
      [ forall n. Text -> Widget n
txt Text
"in progress"
      , forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text -> Text
parens forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"played for", NominalDiffTime -> Text
formatTimeDiff NominalDiffTime
e]
      ]
  Progress
Completed ->
    forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
      [ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"completed in", NominalDiffTime -> Text
formatTimeDiff NominalDiffTime
e]
      , forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
parens forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ TickNumber -> Bool -> String
drawTime TickNumber
t Bool
True, Text
"ticks"]
      ]
        forall a. Semigroup a => a -> a -> a
<> forall a. Maybe a -> [a]
maybeToList (forall {n}. ScenarioCodeMetrics -> Widget n
sizeDisplay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScenarioCodeMetrics
maybeCodeMetrics)
   where
    sizeDisplay :: ScenarioCodeMetrics -> Widget n
sizeDisplay (ScenarioCodeMetrics Count
myCharCount Count
myAstSize) =
      forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr forall a b. (a -> b) -> a -> b
$
        forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map
            forall n. Text -> Widget n
txt
            [ [Text] -> Text
T.unwords
                [ Text
"Code:"
                , String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Count
myCharCount
                , Text
"chars"
                ]
            , (Text
" " forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$
                Text -> Text
parens forall a b. (a -> b) -> a -> b
$
                  [Text] -> Text
T.unwords
                    [ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Count
myAstSize
                    , Text
"AST nodes"
                    ]
            ]
 where
  formatTimeDiff :: NominalDiffTime -> Text
  formatTimeDiff :: NominalDiffTime -> Text
formatTimeDiff = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%hh %Mm %Ss"

-- | If there are multiple different games that each are \"best\"
-- by different criteria, display them all separately, labeled
-- by which criteria they were best in.
--
-- On the other hand, if all of the different \"best\" criteria are for the
-- same game, consolidate them all into one entry and don't bother
-- labelling the criteria.
makeBestScoreRows ::
  ScenarioStatus ->
  [(Widget n1, Maybe (Widget n2))]
makeBestScoreRows :: forall n1 n2. ScenarioStatus -> [(Widget n1, Maybe (Widget n2))]
makeBestScoreRows ScenarioStatus
scenarioStat =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall {n} {n}. BestRecords -> [(Widget n, Maybe (Widget n))]
makeBestRows Maybe BestRecords
getBests
 where
  getBests :: Maybe BestRecords
getBests = case ScenarioStatus
scenarioStat of
    ScenarioStatus
NotStarted -> forall a. Maybe a
Nothing
    Played SerializableLaunchParams
_initialScript Metric ProgressStats
_ BestRecords
best -> forall a. a -> Maybe a
Just BestRecords
best

  makeBestRows :: BestRecords -> [(Widget n, Maybe (Widget n))]
makeBestRows BestRecords
b = forall a b. (a -> b) -> [a] -> [b]
map (forall {n} {n}.
Bool
-> (Metric ProgressStats, NonEmpty BestByCriteria)
-> (Widget n, Maybe (Widget n))
makeBestRow Bool
hasMultiple) [(Metric ProgressStats, NonEmpty BestByCriteria)]
groups
   where
    groups :: [(Metric ProgressStats, NonEmpty BestByCriteria)]
groups = BestRecords -> [(Metric ProgressStats, NonEmpty BestByCriteria)]
getBestGroups BestRecords
b
    hasMultiple :: Bool
hasMultiple = forall (t :: * -> *) a. Foldable t => t a -> Count
length [(Metric ProgressStats, NonEmpty BestByCriteria)]
groups forall a. Ord a => a -> a -> Bool
> Count
1

  makeBestRow :: Bool
-> (Metric ProgressStats, NonEmpty BestByCriteria)
-> (Widget n, Maybe (Widget n))
makeBestRow Bool
hasDistinctByCriteria (Metric ProgressStats
b, NonEmpty BestByCriteria
criteria) =
    ( forall n. Count -> Widget n -> Widget n
hLimit (Count
maxLeftColumnWidth forall a. Num a => a -> a -> a
+ Count
2) forall a b. (a -> b) -> a -> b
$
        forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
          [ forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"best:"
          ]
            forall a. Semigroup a => a -> a -> a
<> forall {n}. [Widget n]
elaboratedCriteria
    , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Metric ProgressStats -> Widget n
describeProgress Metric ProgressStats
b
    )
   where
    maxLeftColumnWidth :: Count
maxLeftColumnWidth = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (Text -> Count
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. BestByCriteria -> Text
describeCriteria) forall e. (Enum e, Bounded e) => [e]
listEnums)
    mkCriteriaRow :: (Text, Count) -> Widget n
mkCriteriaRow =
      forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dimAttr
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a, a) -> [a]
pairToList
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Count
x -> Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ if Count
x forall a. Eq a => a -> a -> Bool
== Count
0 then Char
',' else Char
' ')
    elaboratedCriteria :: [Widget n]
elaboratedCriteria =
      if Bool
hasDistinctByCriteria
        then
          forall a b. (a -> b) -> [a] -> [b]
map forall {n}. (Text, Count) -> Widget n
mkCriteriaRow
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. [a] -> [b] -> [(a, b)]
zip [(Count
0 :: Int) ..]
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> NonEmpty a
NE.reverse
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map BestByCriteria -> Text
describeCriteria
            forall a b. (a -> b) -> a -> b
$ NonEmpty BestByCriteria
criteria
        else []

drawMainMenuEntry :: AppState -> MainMenuEntry -> Widget Name
drawMainMenuEntry :: AppState -> MainMenuEntry -> Widget Name
drawMainMenuEntry AppState
s = \case
  MainMenuEntry
NewGame -> forall n. Text -> Widget n
txt Text
"New game"
  MainMenuEntry
Tutorial -> forall n. Text -> Widget n
txt Text
"Tutorial"
  MainMenuEntry
Achievements -> forall n. Text -> Widget n
txt Text
"Achievements"
  MainMenuEntry
About -> forall n. Text -> Widget n
txt Text
"About"
  MainMenuEntry
Messages -> forall n. Widget n -> Widget n
highlightMessages forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Messages"
  MainMenuEntry
Quit -> forall n. Text -> Widget n
txt Text
"Quit"
 where
  highlightMessages :: Widget n -> Widget n
highlightMessages =
    if AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Notifications LogEntry)
eventLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Count
notificationsCount forall a. Ord a => a -> a -> Bool
> Count
0
      then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr
      else forall a. a -> a
id

drawAboutMenuUI :: Maybe Text -> Widget Name
drawAboutMenuUI :: Maybe Text -> Widget Name
drawAboutMenuUI Maybe Text
Nothing = forall n. Widget n -> Widget n
centerLayer forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"About swarm!"
drawAboutMenuUI (Just Text
t) = forall n. Widget n -> Widget n
centerLayer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Eq a, IsString a) => a -> a
nonblank) forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t
 where
  -- Turn blank lines into a space so they will take up vertical space as widgets
  nonblank :: a -> a
nonblank a
"" = a
" "
  nonblank a
s = a
s

-- | Draw the main game UI.  Generates a list of widgets, where each
--   represents a layer.  Right now we just generate two layers: the
--   main layer and a layer for a floating dialog that can be on top.
drawGameUI :: AppState -> [Widget Name]
drawGameUI :: AppState -> [Widget Name]
drawGameUI AppState
s =
  [ forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
drawDialog AppState
s
  , forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$
      forall {n}. [Widget n] -> Widget n
hBox
        [ forall n. Count -> Widget n -> Widget n
hLimitPercent Count
25 forall a b. (a -> b) -> a -> b
$
            forall {n}. [Widget n] -> Widget n
vBox
              [ forall n. Count -> Widget n -> Widget n
vLimitPercent Count
50
                  forall a b. (a -> b) -> a -> b
$ forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel
                    AttrName
highlightAttr
                    FocusRing Name
fr
                    (FocusablePanel -> Name
FocusablePanel FocusablePanel
RobotPanel)
                    ( forall n. BorderLabels n
plainBorder
                        forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
bottomLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
centerLabel
                          forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                            (forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" Search: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
" "))
                            (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiInventorySearch)
                    )
                  forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
drawRobotPanel AppState
s
              , forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel
                  AttrName
highlightAttr
                  FocusRing Name
fr
                  (FocusablePanel -> Name
FocusablePanel FocusablePanel
InfoPanel)
                  forall n. BorderLabels n
plainBorder
                  forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
drawInfoPanel AppState
s
              , forall n. Widget n -> Widget n
hCenter
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
WorldEditorPanel)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusRing Name -> UIState -> Widget Name
EV.drawWorldEditor FocusRing Name
fr
                  forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState
              ]
        , forall {n}. [Widget n] -> Widget n
vBox [Widget Name]
rightPanel
        ]
  ]
 where
  addCursorPos :: BorderLabels Name -> BorderLabels Name
addCursorPos = forall n. Lens' (BorderLabels n) (HBorderLabels n)
bottomLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
leftLabel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 Widget Name
widg
   where
    widg :: Widget Name
widg = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Cosmic Coords))
uiWorldCursor of
      Maybe (Cosmic Coords)
Nothing -> forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ Cosmic Location -> String
renderCoordsString forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState (Cosmic Location)
viewCenter
      Just Cosmic Coords
coord -> forall n. Ord n => n -> Widget n -> Widget n
clickable Name
WorldPositionIndicator forall a b. (a -> b) -> a -> b
$ WorldOverdraw -> GameState -> Cosmic Coords -> Widget Name
drawWorldCursorInfo (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState) Cosmic Coords
coord
  -- Add clock display in top right of the world view if focused robot
  -- has a clock equipped
  addClock :: BorderLabels n -> BorderLabels n
addClock = forall n. Lens' (BorderLabels n) (HBorderLabels n)
topLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
rightLabel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 (forall n. Count -> GameState -> Widget n
drawClockDisplay (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Count
lgTicksPerSecond) forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState)
  fr :: FocusRing Name
fr = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing
  showREPL :: Bool
showREPL = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowREPL
  rightPanel :: [Widget Name]
rightPanel = if Bool
showREPL then [Widget Name]
worldPanel forall a. [a] -> [a] -> [a]
++ [Widget Name]
replPanel else [Widget Name]
worldPanel forall a. [a] -> [a] -> [a]
++ [Widget Name]
minimizedREPL
  minimizedREPL :: [Widget Name]
minimizedREPL = case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fr of
    (Just (FocusablePanel FocusablePanel
REPLPanel)) -> [forall n. Widget n -> Widget n
separateBorders forall a b. (a -> b) -> a -> b
$ forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel) (forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
highlightAttr forall {n}. Widget n
hBorder)]
    Maybe Name
_ -> [forall n. Widget n -> Widget n
separateBorders forall a b. (a -> b) -> a -> b
$ forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel) forall {n}. Widget n
hBorder]
  worldPanel :: [Widget Name]
worldPanel =
    [ forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel
        AttrName
highlightAttr
        FocusRing Name
fr
        (FocusablePanel -> Name
FocusablePanel FocusablePanel
WorldPanel)
        ( forall n. BorderLabels n
plainBorder
            forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
bottomLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
rightLabel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 (AppState -> Widget Name
drawTPS AppState
s)
            forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
topLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
leftLabel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ AppState -> Widget Name
drawModalMenu AppState
s
            forall a b. a -> (a -> b) -> b
& BorderLabels Name -> BorderLabels Name
addCursorPos
            forall a b. a -> (a -> b) -> b
& forall {n}. BorderLabels n -> BorderLabels n
addClock
        )
        (UIState -> GameState -> Widget Name
drawWorldPane (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState))
    , AppState -> Widget Name
drawKeyMenu AppState
s
    ]
  replPanel :: [Widget Name]
replPanel =
    [ forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel) forall a b. (a -> b) -> a -> b
$
        forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel
          AttrName
highlightAttr
          FocusRing Name
fr
          (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel)
          ( forall n. BorderLabels n
plainBorder
              forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
topLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
rightLabel forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Polytype -> Widget Name
drawType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState (Maybe Polytype)
replType))
          )
          ( forall n. Count -> Widget n -> Widget n
vLimit Count
replHeight
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
1)
              forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
drawREPL AppState
s
          )
    ]

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

drawWorldCursorInfo :: WorldOverdraw -> GameState -> Cosmic W.Coords -> Widget Name
drawWorldCursorInfo :: WorldOverdraw -> GameState -> Cosmic Coords -> Widget Name
drawWorldCursorInfo WorldOverdraw
worldEditor GameState
g Cosmic Coords
cCoords =
  case GameState -> Coords -> Maybe Word32
getStatic GameState
g Coords
coords of
    Just Word32
s -> forall n. Display -> Widget n
renderDisplay forall a b. (a -> b) -> a -> b
$ Word32 -> Display
displayStatic Word32
s
    Maybe Word32
Nothing -> forall {n}. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall {n}. [Widget n]
tileMemberWidgets forall a. [a] -> [a] -> [a]
++ [forall {n}. Widget n
coordsWidget]
 where
  Cosmic SubworldName
_ Coords
coords = Cosmic Coords
cCoords
  coordsWidget :: Widget n
coordsWidget = forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ Cosmic Location -> String
renderCoordsString forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coords -> Location
W.coordsToLoc Cosmic Coords
cCoords

  tileMembers :: [Display]
tileMembers = Display
terrain forall a. a -> [a] -> [a]
: forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Display] -> Maybe Display
merge [[Display]
entity, [Display]
robot]
  tileMemberWidgets :: [Widget n]
tileMemberWidgets =
    forall a b. (a -> b) -> [a] -> [b]
map (forall n. Padding -> Widget n -> Widget n
padRight forall a b. (a -> b) -> a -> b
$ Count -> Padding
Pad Count
1)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {n}. Display -> Text -> [Widget n]
f [Display]
tileMembers
      forall a b. (a -> b) -> a -> b
$ [Text
"at", Text
"on", Text
"with"]
   where
    f :: Display -> Text -> [Widget n]
f Display
cell Text
preposition = [forall n. Display -> Widget n
renderDisplay Display
cell, forall n. Text -> Widget n
txt Text
preposition]

  ri :: RenderingInput
ri = MultiWorld Count Entity -> (EntityPaint -> Bool) -> RenderingInput
RenderingInput (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld Count Entity)
multiWorld) (EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown forall a b. (a -> b) -> a -> b
$ GameState -> EntityKnowledgeDependencies
mkEntityKnowledge GameState
g)
  terrain :: Display
terrain = WorldOverdraw -> RenderingInput -> Cosmic Coords -> Display
displayTerrainCell WorldOverdraw
worldEditor RenderingInput
ri Cosmic Coords
cCoords
  entity :: [Display]
entity = WorldOverdraw -> RenderingInput -> Cosmic Coords -> [Display]
displayEntityCell WorldOverdraw
worldEditor RenderingInput
ri Cosmic Coords
cCoords
  robot :: [Display]
robot = GameState -> Cosmic Coords -> [Display]
displayRobotCell GameState
g Cosmic Coords
cCoords

  merge :: [Display] -> Maybe Display
merge = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' Display Bool
invisible))

-- | Format the clock display to be shown in the upper right of the
--   world panel.
drawClockDisplay :: Int -> GameState -> Widget n
drawClockDisplay :: forall n. Count -> GameState -> Widget n
drawClockDisplay Count
lgTPS GameState
gs = forall {n}. [Widget n] -> Widget n
hBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (forall n. Text -> Widget n
txt Text
" ") forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [forall {n}. Maybe (Widget n)
clockWidget, forall {n}. Maybe (Widget n)
pauseWidget]
 where
  clockWidget :: Maybe (Widget n)
clockWidget = forall n. TickNumber -> Bool -> GameState -> Maybe (Widget n)
maybeDrawTime (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks) (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter TemporalState Bool
paused Bool -> Bool -> Bool
|| Count
lgTPS forall a. Ord a => a -> a -> Bool
< Count
3) GameState
gs
  pauseWidget :: Maybe (Widget n)
pauseWidget = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter TemporalState Bool
paused) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall n. Text -> Widget n
txt Text
"(PAUSED)"

-- | Check whether the currently focused robot (if any) has a clock
--   device equipped.
clockEquipped :: GameState -> Bool
clockEquipped :: GameState -> Bool
clockEquipped GameState
gs = case GameState -> Maybe Robot
focusedRobot GameState
gs of
  Maybe Robot
Nothing -> Bool
False
  Just Robot
r
    | Text -> Inventory -> Count
countByName Text
"clock" (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices) forall a. Ord a => a -> a -> Bool
> Count
0 -> Bool
True
    | Bool
otherwise -> Bool
False

-- | Format a ticks count as a hexadecimal clock.
drawTime :: TickNumber -> Bool -> String
drawTime :: TickNumber -> Bool -> String
drawTime (TickNumber Int64
t) Bool
showTicks =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
    forall a. a -> [a] -> [a]
intersperse
      String
":"
      [ forall r. PrintfType r => String -> r
printf String
"%x" (Int64
t forall a. Bits a => a -> Count -> a
`shiftR` Count
20)
      , forall r. PrintfType r => String -> r
printf String
"%02x" ((Int64
t forall a. Bits a => a -> Count -> a
`shiftR` Count
12) forall a. Bits a => a -> a -> a
.&. ((Int64
1 forall a. Bits a => a -> Count -> a
`shiftL` Count
8) forall a. Num a => a -> a -> a
- Int64
1))
      , forall r. PrintfType r => String -> r
printf String
"%02x" ((Int64
t forall a. Bits a => a -> Count -> a
`shiftR` Count
4) forall a. Bits a => a -> a -> a
.&. ((Int64
1 forall a. Bits a => a -> Count -> a
`shiftL` Count
8) forall a. Num a => a -> a -> a
- Int64
1))
      ]
      forall a. [a] -> [a] -> [a]
++ if Bool
showTicks then [String
".", forall r. PrintfType r => String -> r
printf String
"%x" (Int64
t forall a. Bits a => a -> a -> a
.&. ((Int64
1 forall a. Bits a => a -> Count -> a
`shiftL` Count
4) forall a. Num a => a -> a -> a
- Int64
1))] else []

-- | Return a possible time display, if the currently focused robot
--   has a clock device equipped.  The first argument is the number
--   of ticks (e.g. 943 = 0x3af), and the second argument indicates
--   whether the time should be shown down to single-tick resolution
--   (e.g. 0:00:3a.f) or not (e.g. 0:00:3a).
maybeDrawTime :: TickNumber -> Bool -> GameState -> Maybe (Widget n)
maybeDrawTime :: forall n. TickNumber -> Bool -> GameState -> Maybe (Widget n)
maybeDrawTime TickNumber
t Bool
showTicks GameState
gs = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GameState -> Bool
clockEquipped GameState
gs) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall n. String -> Widget n
str (TickNumber -> Bool -> String
drawTime TickNumber
t Bool
showTicks)

-- | Draw info about the current number of ticks per second.
drawTPS :: AppState -> Widget Name
drawTPS :: AppState -> Widget Name
drawTPS AppState
s = forall {n}. [Widget n] -> Widget n
hBox (forall {n}. Widget n
tpsInfo forall a. a -> [a] -> [a]
: forall {n}. [Widget n]
rateInfo)
 where
  tpsInfo :: Widget n
tpsInfo
    | Count
l forall a. Ord a => a -> a -> Bool
>= Count
0 = forall {n}. [Widget n] -> Widget n
hBox [forall n. String -> Widget n
str (forall a. Show a => a -> String
show Count
n), forall n. Text -> Widget n
txt Text
" ", forall n. Text -> Widget n
txt (Count -> Text -> Text
number Count
n Text
"tick"), forall n. Text -> Widget n
txt Text
" / s"]
    | Bool
otherwise = forall {n}. [Widget n] -> Widget n
hBox [forall n. Text -> Widget n
txt Text
"1 tick / ", forall n. String -> Widget n
str (forall a. Show a => a -> String
show Count
n), forall n. Text -> Widget n
txt Text
" s"]

  rateInfo :: [Widget n]
rateInfo
    | AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowFPS =
        [ forall n. Text -> Widget n
txt Text
" ("
        , let tpf :: Double
tpf = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Double
uiTPF
           in (if Double
tpf forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
ticksPerFrameCap then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr else forall a. a -> a
id)
                (forall n. String -> Widget n
str (forall r. PrintfType r => String -> r
printf String
"%0.1f" Double
tpf))
        , forall n. Text -> Widget n
txt Text
" tpf, "
        , forall n. String -> Widget n
str (forall r. PrintfType r => String -> r
printf String
"%0.1f" (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Double
uiFPS))
        , forall n. Text -> Widget n
txt Text
" fps)"
        ]
    | Bool
otherwise = []

  l :: Count
l = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Count
lgTicksPerSecond
  n :: Count
n = Count
2 forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. Num a => a -> a
abs Count
l

-- | The height of the REPL box.  Perhaps in the future this should be
--   configurable.
replHeight :: Int
replHeight :: Count
replHeight = Count
10

-- | Hide the cursor when a modal is set
chooseCursor :: AppState -> [CursorLocation n] -> Maybe (CursorLocation n)
chooseCursor :: forall n.
AppState -> [CursorLocation n] -> Maybe (CursorLocation n)
chooseCursor AppState
s [CursorLocation n]
locs = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal of
  Maybe Modal
Nothing -> forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor AppState
s [CursorLocation n]
locs
  Just Modal
_ -> forall a. Maybe a
Nothing

-- | Draw a dialog window, if one should be displayed right now.
drawDialog :: AppState -> Widget Name
drawDialog :: AppState -> Widget Name
drawDialog AppState
s = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal of
  Just (Modal ModalType
mt Dialog ButtonAction Name
d) -> forall n a. Ord n => Dialog a n -> Widget n -> Widget n
renderDialog Dialog ButtonAction Name
d forall a b. (a -> b) -> a -> b
$ case ModalType
mt of
    ModalType
GoalModal -> AppState -> ModalType -> Widget Name
drawModal AppState
s ModalType
mt
    ModalType
_ -> forall n. (Ord n, Show n) => n -> Widget n -> Widget n
maybeScroll Name
ModalViewport forall a b. (a -> b) -> a -> b
$ AppState -> ModalType -> Widget Name
drawModal AppState
s ModalType
mt
  Maybe Modal
Nothing -> forall {n}. Widget n
emptyWidget

-- | Draw one of the various types of modal dialog.
drawModal :: AppState -> ModalType -> Widget Name
drawModal :: AppState -> ModalType -> Widget Name
drawModal AppState
s = \case
  ModalType
HelpModal -> Count -> Maybe Count -> Widget Name
helpWidget (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Count
seed) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Maybe Count)
webPort)
  ModalType
RobotsModal -> AppState -> Widget Name
robotsListWidget AppState
s
  ModalType
RecipesModal -> GameState -> NotificationList -> Widget Name
availableListWidget (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState) NotificationList
RecipeList
  ModalType
CommandsModal -> GameState -> Widget Name
commandsListWidget (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState)
  ModalType
MessagesModal -> GameState -> NotificationList -> Widget Name
availableListWidget (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState) NotificationList
MessageList
  ScenarioEndModal ScenarioOutcome
outcome ->
    forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$
      forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map
          (forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt)
          [Text]
content
   where
    content :: [Text]
content = case ScenarioOutcome
outcome of
      ScenarioOutcome
WinModal -> [Text
"Congratulations!"]
      ScenarioOutcome
LoseModal ->
        [ Text
"Condolences!"
        , Text
"This scenario is no longer winnable."
        ]
  DescriptionModal Entity
e -> AppState -> Entity -> Widget Name
descriptionWidget AppState
s Entity
e
  ModalType
QuitModal -> forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt (Menu -> Text
quitMsg (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu))
  ModalType
GoalModal -> GoalDisplay -> Widget Name
GR.renderGoalsDisplay (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal)
  ModalType
KeepPlayingModal ->
    forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 forall a b. (a -> b) -> a -> b
$
      [Text] -> Widget Name
displayParagraphs forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
          Text
"Have fun!  Hit Ctrl-Q whenever you're ready to proceed to the next challenge or return to the menu."
  ModalType
TerrainPaletteModal -> AppState -> Widget Name
EV.drawTerrainSelector AppState
s
  ModalType
EntityPaletteModal -> AppState -> Widget Name
EV.drawEntityPaintSelector AppState
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 :: GameState -> Robot -> Widget Name
renderDutyCycle GameState
gs Robot
robot =
  forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dutyCycleAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. String -> Widget n
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. RealFloat a => Maybe Count -> a -> ShowS
showFFloat (forall a. a -> Maybe a
Just Count
1)) String
"%" forall a b. (a -> b) -> a -> b
$ Double
dutyCyclePercentage
 where
  curTicks :: TickNumber
curTicks = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
  window :: WindowedCounter TickNumber
window = Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts (WindowedCounter TickNumber)
activityWindow

  -- Rewind to previous tick
  latestRobotTick :: TickNumber
latestRobotTick = Count -> TickNumber -> TickNumber
addTicks (-Count
1) TickNumber
curTicks
  dutyCycleRatio :: UnitInterval Double
dutyCycleRatio = forall a.
(Ord a, Offsettable a) =>
a -> WindowedCounter a -> UnitInterval Double
WC.getOccupancy TickNumber
latestRobotTick WindowedCounter TickNumber
window

  dutyCycleAttr :: AttrName
dutyCycleAttr = forall a b. RealFrac a => UnitInterval a -> NonEmpty b -> b
safeIndex UnitInterval Double
dutyCycleRatio NonEmpty AttrName
meterAttributeNames

  dutyCyclePercentage :: Double
  dutyCyclePercentage :: Double
dutyCyclePercentage = Double
100 forall a. Num a => a -> a -> a
* forall a. UnitInterval a -> a
getValue UnitInterval Double
dutyCycleRatio

robotsListWidget :: AppState -> Widget Name
robotsListWidget :: AppState -> Widget Name
robotsListWidget AppState
s = forall n. Widget n -> Widget n
hCenter Widget Name
table
 where
  table :: Widget Name
table =
    forall n. Table n -> Widget n
BT.renderTable
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.columnBorders Bool
False
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. ColumnAlignment -> Table n -> Table n
BT.setDefaultColAlignment ColumnAlignment
BT.AlignCenter
      -- Inventory count is right aligned
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Table n -> Table n
BT.alignRight Count
4
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. [[Widget n]] -> Table n
BT.table
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. Count -> Widget n -> Widget n
padLeftRight Count
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {n}. [Widget n]
headers forall a. a -> [a] -> [a]
: [[Widget Name]]
robotsTable)
  headings :: [Text]
headings =
    [ Text
"Name"
    , Text
"Age"
    , Text
"Pos"
    , Text
"Items"
    , Text
"Status"
    , Text
"Actns"
    , Text
"Cmds"
    , Text
"Cycles"
    , Text
"Activity"
    , Text
"Log"
    ]
  headers :: [Widget n]
headers = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
robotAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
cheat (Text
"ID" forall a. a -> [a] -> [a]
:) [Text]
headings
  robotsTable :: [[Widget Name]]
robotsTable = Robot -> [Widget Name]
mkRobotRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Robot]
robots
  mkRobotRow :: Robot -> [Widget Name]
mkRobotRow Robot
robot =
    forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
cheat (forall {n}. Widget n
idWidget forall a. a -> [a] -> [a]
:) [Widget Name]
cells
   where
    cells :: [Widget Name]
cells =
      [ forall {n}. Widget n
nameWidget
      , forall n. String -> Widget n
str String
ageStr
      , Widget Name
locWidget
      , forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) (forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Count
rInvCount)
      , forall {n}. Widget n
statusWidget
      , forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts Count
tangibleCommandCount
      , -- TODO(#1341): May want to expose the details of this histogram in
        -- a per-robot pop-up
        forall n. String -> Widget n
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts (Map Const Count)
commandsHistogram
      , forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts Count
lifetimeStepCount
      , GameState -> Robot -> Widget Name
renderDutyCycle (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState) Robot
robot
      , forall n. Text -> Widget n
txt Text
rLog
      ]

    idWidget :: Widget n
idWidget = forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot Count
robotID
    nameWidget :: Widget n
nameWidget =
      forall {n}. [Widget n] -> Widget n
hBox
        [ forall n. Display -> Widget n
renderDisplay (Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot Display
robotDisplay)
        , forall n. Widget n -> Widget n
highlightSystem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
" " forall a. Semigroup a => a -> a -> a
<> Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot Text
robotName
        ]

    highlightSystem :: Widget n -> Widget n
highlightSystem = if Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
systemRobot then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightAttr else forall a. a -> a
id

    ageStr :: String
ageStr
      | Int64
age forall a. Ord a => a -> a -> Bool
< Int64
60 = forall a. Show a => a -> String
show Int64
age forall a. Semigroup a => a -> a -> a
<> String
"sec"
      | Int64
age forall a. Ord a => a -> a -> Bool
< Int64
3600 = forall a. Show a => a -> String
show (Int64
age forall a. Integral a => a -> a -> a
`div` Int64
60) forall a. Semigroup a => a -> a -> a
<> String
"min"
      | Int64
age forall a. Ord a => a -> a -> Bool
< Int64
3600 forall a. Num a => a -> a -> a
* Int64
24 = forall a. Show a => a -> String
show (Int64
age forall a. Integral a => a -> a -> a
`div` Int64
3600) forall a. Semigroup a => a -> a -> a
<> String
"hour"
      | Bool
otherwise = forall a. Show a => a -> String
show (Int64
age forall a. Integral a => a -> a -> a
`div` Int64
3600 forall a. Num a => a -> a -> a
* Int64
24) forall a. Semigroup a => a -> a -> a
<> String
"day"
     where
      TimeSpec Int64
createdAtSec Int64
_ = Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot TimeSpec
robotCreatedAt
      TimeSpec Int64
nowSec Int64
_ = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastFrameTime
      age :: Int64
age = Int64
nowSec forall a. Num a => a -> a -> a
- Int64
createdAtSec

    rInvCount :: Count
rInvCount = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Count, Entity)]
E.elems forall a b. (a -> b) -> a -> b
$ Robot
robot forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Inventory
entityInventory
    rLog :: Text
rLog
      | Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
robotLogUpdated = Text
"x"
      | Bool
otherwise = Text
" "

    locWidget :: Widget Name
locWidget = forall {n}. [Widget n] -> Widget n
hBox [Widget Name
worldCell, forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ String
" " forall a. Semigroup a => a -> a -> a
<> String
locStr]
     where
      rCoords :: Cosmic Coords
rCoords = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Location -> Coords
W.locToCoords Cosmic Location
rLoc
      rLoc :: Cosmic Location
rLoc = Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation
      worldCell :: Widget Name
worldCell =
        UIState -> GameState -> Cosmic Coords -> Widget Name
drawLoc
          (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState)
          GameState
g
          Cosmic Coords
rCoords
      locStr :: String
locStr = Cosmic Location -> String
renderCoordsString Cosmic Location
rLoc

    statusWidget :: Widget n
statusWidget = case Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine of
      Waiting {} -> forall n. Text -> Widget n
txt Text
"waiting"
      CESK
_
        | Robot -> Bool
isActive Robot
robot -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"busy"
        | Bool
otherwise -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"idle"

  basePos :: Point V2 Double
  basePos :: Point V2 Double
basePos = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a -> a
fromMaybe forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (GameState
g forall s a. s -> Getting (First a) s a -> Maybe a
^? Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot (Cosmic Location)
robotLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar)
  -- Keep the base and non system robot (e.g. no seed)
  isRelevant :: Robot -> Bool
isRelevant Robot
robot = Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot Count
robotID forall a. Eq a => a -> a -> Bool
== Count
0 Bool -> Bool -> Bool
|| Bool -> Bool
not (Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
systemRobot)
  -- Keep the robot that are less than 32 unit away from the base
  isNear :: Robot -> Bool
isNear Robot
robot = Bool
creative Bool -> Bool -> Bool
|| forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
distance (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) Point V2 Double
basePos forall a. Ord a => a -> a -> Bool
< Double
32
  robots :: [Robot]
  robots :: [Robot]
robots =
    forall a. (a -> Bool) -> [a] -> [a]
filter (\Robot
robot -> Bool
debugging Bool -> Bool -> Bool
|| (Robot -> Bool
isRelevant Robot
robot Bool -> Bool -> Bool
&& Robot -> Bool
isNear Robot
robot))
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [a]
IM.elems
      forall a b. (a -> b) -> a -> b
$ GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap
  creative :: Bool
creative = GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode
  cheat :: Bool
cheat = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
  debugging :: Bool
debugging = Bool
creative Bool -> Bool -> Bool
&& Bool
cheat
  g :: GameState
g = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState

helpWidget :: Seed -> Maybe Port -> Widget Name
helpWidget :: Count -> Maybe Count -> Widget Name
helpWidget Count
theSeed Maybe Count
mport =
  forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$
    (forall {n}. [Widget n] -> Widget n
hBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall n. Count -> Widget n -> Widget n
padLeftRight Count
2) forall a b. (a -> b) -> a -> b
$ [forall {n}. Widget n
helpKeys, forall {n}. Widget n
info])
      forall n. Widget n -> Widget n -> Widget n
<=> forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) (forall n. Widget n -> Widget n
hCenter forall {n}. Widget n
tips)
 where
  tips :: Widget n
tips =
    forall {n}. [Widget n] -> Widget n
vBox
      [ forall n. Text -> Widget n
txt Text
"Have questions? Want some tips? Check out:"
      , forall n. Text -> Widget n
txt Text
" "
      , forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"  - The Swarm wiki, " forall a. Semigroup a => a -> a -> a
<> Text
wikiUrl
      , forall n. Text -> Widget n
txt Text
"  - The #swarm IRC channel on Libera.Chat"
      ]
  info :: Widget n
info =
    forall {n}. [Widget n] -> Widget n
vBox
      [ forall n. Text -> Widget n
txt Text
"Configuration"
      , forall n. Text -> Widget n
txt Text
" "
      , forall n. Text -> Widget n
txt (Text
"Seed: " forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text (forall a. Show a => a -> String
show Count
theSeed))
      , forall n. Text -> Widget n
txt (Text
"Web server port: " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"none" (forall target source. From source target => source -> target
into @Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Count
mport)
      ]
  helpKeys :: Widget n
helpKeys =
    forall {n}. [Widget n] -> Widget n
vBox
      [ forall n. Text -> Widget n
txt Text
"Keybindings"
      , forall n. Text -> Widget n
txt Text
" "
      , forall {n}. [(Text, Text)] -> Widget n
mkTable [(Text, Text)]
glKeyBindings
      ]
  mkTable :: [(Text, Text)] -> Widget n
mkTable =
    forall n. Table n -> Widget n
BT.renderTable
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.surroundingBorder Bool
False
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.rowBorders Bool
False
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. [[Widget n]] -> Table n
BT.table
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {n}. (Text, Text) -> [Widget n]
toRow
  toRow :: (Text, Text) -> [Widget n]
toRow (Text
k, Text
v) = [forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
k, forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
v]
  glKeyBindings :: [(Text, Text)]
glKeyBindings =
    [ (Text
"F1", Text
"Help")
    , (Text
"F2", Text
"Robots list")
    , (Text
"F3", Text
"Available recipes")
    , (Text
"F4", Text
"Available commands")
    , (Text
"F5", Text
"Messages")
    , (Text
"Ctrl-g", Text
"show goal")
    , (Text
"Ctrl-p", Text
"pause")
    , (Text
"Ctrl-o", Text
"single step")
    , (Text
"Ctrl-z", Text
"decrease speed")
    , (Text
"Ctrl-w", Text
"increase speed")
    , (Text
"Ctrl-q", Text
"quit the current scenario")
    , (Text
"Ctrl-s", Text
"collapse/expand REPL")
    , (Text
"Meta-h", Text
"hide robots for 2s")
    , (Text
"Meta-w", Text
"focus on the world map")
    , (Text
"Meta-e", Text
"focus on the robot inventory")
    , (Text
"Meta-r", Text
"focus on the REPL")
    , (Text
"Meta-t", Text
"focus on the info panel")
    ]

data NotificationList = RecipeList | MessageList

availableListWidget :: GameState -> NotificationList -> Widget Name
availableListWidget :: GameState -> NotificationList -> Widget Name
availableListWidget GameState
gs NotificationList
nl = forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall {n}. [Widget n] -> Widget n
vBox [Widget Name]
widgetList
 where
  widgetList :: [Widget Name]
widgetList = case NotificationList
nl of
    NotificationList
RecipeList -> forall a.
GameState
-> Lens' GameState (Notifications a)
-> (a -> Widget Name)
-> [Widget Name]
mkAvailableList GameState
gs (Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications (Recipe Entity))
availableRecipes) Recipe Entity -> Widget Name
renderRecipe
    NotificationList
MessageList -> GameState -> [Widget Name]
messagesWidget GameState
gs
  renderRecipe :: Recipe Entity -> Widget Name
renderRecipe = forall n. Count -> Widget n -> Widget n
padLeftRight Count
18 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Entity -> Inventory -> Recipe Entity -> Widget Name
drawRecipe forall a. Maybe a
Nothing (forall a. a -> Maybe a -> a
fromMaybe Inventory
E.empty Maybe Inventory
inv)
  inv :: Maybe Inventory
inv = GameState
gs forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory

mkAvailableList :: GameState -> Lens' GameState (Notifications a) -> (a -> Widget Name) -> [Widget Name]
mkAvailableList :: forall a.
GameState
-> Lens' GameState (Notifications a)
-> (a -> Widget Name)
-> [Widget Name]
mkAvailableList GameState
gs Lens' GameState (Notifications a)
notifLens a -> Widget Name
notifRender = forall a b. (a -> b) -> [a] -> [b]
map a -> Widget Name
padRender [a]
news forall a. Semigroup a => a -> a -> a
<> forall {n}. [Widget n]
notifSep forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map a -> Widget Name
padRender [a]
knowns
 where
  padRender :: a -> Widget Name
padRender = forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Widget Name
notifRender
  count :: Count
count = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (Notifications a)
notifLens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Count
notificationsCount
  ([a]
news, [a]
knowns) = forall a. Count -> [a] -> ([a], [a])
splitAt Count
count (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (Notifications a)
notifLens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent)
  notifSep :: [Widget n]
notifSep
    | Count
count forall a. Ord a => a -> a -> Bool
> Count
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
knowns) =
        [ forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 (forall n. Text -> Widget n
txt Text
"new↑")))
        ]
    | Bool
otherwise = []

commandsListWidget :: GameState -> Widget Name
commandsListWidget :: GameState -> Widget Name
commandsListWidget GameState
gs =
  forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$
    forall {n}. [Widget n] -> Widget n
vBox
      [ Widget Name
table
      , forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"For the full list of available commands see the Wiki at:"
      , forall n. Text -> Widget n
txt Text
wikiCheatSheet
      ]
 where
  commands :: [Const]
commands = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications Const)
availableCommands forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent
  table :: Widget Name
table =
    forall n. Table n -> Widget n
BT.renderTable
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.surroundingBorder Bool
False
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.columnBorders Bool
False
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.rowBorders Bool
False
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. ColumnAlignment -> Table n -> Table n
BT.setDefaultColAlignment ColumnAlignment
BT.AlignLeft
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Table n -> Table n
BT.alignRight Count
0
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. [[Widget n]] -> Table n
BT.table
      forall a b. (a -> b) -> a -> b
$ forall {n}. [Widget n]
headers forall a. a -> [a] -> [a]
: [[Widget Name]]
commandsTable
  headers :: [Widget n]
headers =
    forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
robotAttr
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ forall n. Text -> Widget n
txt Text
"command name"
          , forall n. Text -> Widget n
txt Text
" : type"
          , forall n. Text -> Widget n
txt Text
"Enabled by"
          ]

  commandsTable :: [[Widget Name]]
commandsTable = Const -> [Widget Name]
mkCmdRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Const]
commands
  mkCmdRow :: Const -> [Widget Name]
mkCmdRow Const
cmd =
    forall a b. (a -> b) -> [a] -> [b]
map
      (forall n. Padding -> Widget n -> Widget n
padTop forall a b. (a -> b) -> a -> b
$ Count -> Padding
Pad Count
1)
      [ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ ConstInfo -> Text
syntax forall a b. (a -> b) -> a -> b
$ Const -> ConstInfo
constInfo Const
cmd
      , forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
magentaAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
" : " forall a. Semigroup a => a -> a -> a
<> forall a. PrettyPrec a => a -> Text
prettyTextLine (Const -> Polytype
inferConst Const
cmd)
      , Const -> Widget Name
listDevices Const
cmd
      ]

  base :: Maybe Robot
base = GameState
gs forall s a. s -> Getting (First a) s a -> Maybe a
^? Traversal' GameState Robot
baseRobot
  entsByCap :: Map Capability [Entity]
entsByCap = case Maybe Robot
base of
    Just Robot
r ->
      forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$
        Inventory -> Map Capability (NonEmpty Entity)
entitiesByCapability forall a b. (a -> b) -> a -> b
$
          (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices) Inventory -> Inventory -> Inventory
`union` (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory)
    Maybe Robot
Nothing -> forall a. Monoid a => a
mempty

  listDevices :: Const -> Widget Name
listDevices Const
cmd = forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Entity -> Widget Name
drawLabelledEntityName [Entity]
providerDevices
   where
    providerDevices :: [Entity]
providerDevices =
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault []) Map Capability [Entity]
entsByCap) forall a b. (a -> b) -> a -> b
$
        forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$
          Const -> Maybe Capability
constCaps Const
cmd

-- | Generate a pop-up widget to display the description of an entity.
descriptionWidget :: AppState -> Entity -> Widget Name
descriptionWidget :: AppState -> Entity -> Widget Name
descriptionWidget AppState
s Entity
e = forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 (AppState -> Entity -> Widget Name
explainEntry AppState
s Entity
e)

-- | Draw a widget with messages to the current robot.
messagesWidget :: GameState -> [Widget Name]
messagesWidget :: GameState -> [Widget Name]
messagesWidget GameState
gs = [Widget Name]
widgetList
 where
  widgetList :: [Widget Name]
widgetList = [Widget Name] -> [Widget Name]
focusNewest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {n}. LogEntry -> Widget n
drawLogEntry' forall a b. (a -> b) -> a -> b
$ GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState (Notifications LogEntry)
messageNotifications forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent
  focusNewest :: [Widget Name] -> [Widget Name]
focusNewest = if GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter TemporalState Bool
paused then forall a. a -> a
id else forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s a. Snoc s s a a => Traversal' s a
_last forall n. Widget n -> Widget n
visible
  drawLogEntry' :: LogEntry -> Widget n
drawLogEntry' LogEntry
e =
    forall n. AttrName -> Widget n -> Widget n
withAttr (LogEntry -> AttrName
colorLogs LogEntry
e) forall a b. (a -> b) -> a -> b
$
      forall {n}. [Widget n] -> Widget n
hBox
        [ forall a. a -> Maybe a -> a
fromMaybe (forall n. Text -> Widget n
txt Text
"") forall a b. (a -> b) -> a -> b
$ forall n. TickNumber -> Bool -> GameState -> Maybe (Widget n)
maybeDrawTime (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry TickNumber
leTime) Bool
True GameState
gs
        , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text -> Text
brackets forall a b. (a -> b) -> a -> b
$ LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Text
leName
        , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt2 forall a b. (a -> b) -> a -> b
$ LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Text
leText
        ]
  txt2 :: Text -> Widget n
txt2 = forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
indent2

colorLogs :: LogEntry -> AttrName
colorLogs :: LogEntry -> AttrName
colorLogs LogEntry
e = case LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSource of
  LogSource
SystemLog -> Severity -> AttrName
colorSeverity (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Severity
leSeverity)
  RobotLog RobotLogSource
rls Count
rid Cosmic Location
_loc -> case RobotLogSource
rls of
    RobotLogSource
Said -> Count -> AttrName
robotColor Count
rid
    RobotLogSource
Logged -> AttrName
notifAttr
    RobotLogSource
RobotError -> Severity -> AttrName
colorSeverity (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Severity
leSeverity)
 where
  -- color each robot message with different color of the world
  robotColor :: Count -> AttrName
robotColor = forall b a. Integral b => NonEmpty a -> b -> a
indexWrapNonEmpty NonEmpty AttrName
worldAttributeNames

colorSeverity :: Severity -> AttrName
colorSeverity :: Severity -> AttrName
colorSeverity = \case
  Severity
Info -> AttrName
infoAttr
  Severity
Debug -> AttrName
dimAttr
  Severity
Warning -> AttrName
yellowAttr
  Severity
Error -> AttrName
redAttr
  Severity
Critical -> AttrName
redAttr

-- | Draw the F-key modal menu. This is displayed in the top left world corner.
drawModalMenu :: AppState -> Widget Name
drawModalMenu :: AppState -> Widget Name
drawModalMenu AppState
s = forall n. Count -> Widget n -> Widget n
vLimit Count
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd) [(KeyHighlight, Text, Text)]
globalKeyCmds
 where
  notificationKey :: Getter GameState (Notifications a) -> Text -> Text -> Maybe (KeyHighlight, Text, Text)
  notificationKey :: forall a.
Getter GameState (Notifications a)
-> Text -> Text -> Maybe (KeyHighlight, Text, Text)
notificationKey Getter GameState (Notifications a)
notifLens Text
key Text
name
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState (Notifications a)
notifLens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent) = forall a. Maybe a
Nothing
    | Bool
otherwise =
        let highlight :: KeyHighlight
highlight
              | AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState (Notifications a)
notifLens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Count
notificationsCount forall a. Ord a => a -> a -> Bool
> Count
0 = KeyHighlight
Alert
              | Bool
otherwise = KeyHighlight
NoHighlight
         in forall a. a -> Maybe a
Just (KeyHighlight
highlight, Text
key, Text
name)

  globalKeyCmds :: [(KeyHighlight, Text, Text)]
globalKeyCmds =
    forall a. [Maybe a] -> [a]
catMaybes
      [ forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, Text
"F1", Text
"Help")
      , forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, Text
"F2", Text
"Robots")
      , forall a.
Getter GameState (Notifications a)
-> Text -> Text -> Maybe (KeyHighlight, Text, Text)
notificationKey (Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications (Recipe Entity))
availableRecipes) Text
"F3" Text
"Recipes"
      , forall a.
Getter GameState (Notifications a)
-> Text -> Text -> Maybe (KeyHighlight, Text, Text)
notificationKey (Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications Const)
availableCommands) Text
"F4" Text
"Commands"
      , forall a.
Getter GameState (Notifications a)
-> Text -> Text -> Maybe (KeyHighlight, Text, Text)
notificationKey Getter GameState (Notifications LogEntry)
messageNotifications Text
"F5" Text
"Messages"
      ]

-- | Draw a menu explaining what key commands are available for the
--   current panel.  This menu is displayed as one or two lines in
--   between the world panel and the REPL.
--
-- This excludes the F-key modals that are shown elsewhere.
drawKeyMenu :: AppState -> Widget Name
drawKeyMenu :: AppState -> Widget Name
drawKeyMenu AppState
s =
  forall n. Count -> Widget n -> Widget n
vLimit Count
2 forall a b. (a -> b) -> a -> b
$
    forall {n}. [Widget n] -> Widget n
hBox
      [ forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall a b. (a -> b) -> a -> b
$
          forall {n}. [Widget n] -> Widget n
vBox
            [ [(KeyHighlight, Text, Text)] -> Widget Name
mkCmdRow [(KeyHighlight, Text, Text)]
globalKeyCmds
            , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
2) Widget Name
contextCmds
            ]
      , forall {n}. Widget n
gameModeWidget
      ]
 where
  mkCmdRow :: [(KeyHighlight, Text, Text)] -> Widget Name
mkCmdRow = forall {n}. [Widget n] -> Widget n
hBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (KeyHighlight, Text, Text) -> Widget Name
drawPaddedCmd
  drawPaddedCmd :: (KeyHighlight, Text, Text) -> Widget Name
drawPaddedCmd = forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd
  contextCmds :: Widget Name
contextCmds
    | ReplControlMode
ctrlMode forall a. Eq a => a -> a -> Bool
== ReplControlMode
Handling = forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" (AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe (Text, Value))
inputHandler forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1)
    | Bool
otherwise = [(KeyHighlight, Text, Text)] -> Widget Name
mkCmdRow [(KeyHighlight, Text, Text)]
focusedPanelCmds
  focusedPanelCmds :: [(KeyHighlight, Text, Text)]
focusedPanelCmds =
    forall a b. (a -> b) -> [a] -> [b]
map forall {b} {c}. (b, c) -> (KeyHighlight, b, c)
highlightKeyCmds
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. IsString a => Maybe Name -> [(a, Text)]
keyCmdsFor
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. FocusRing n -> Maybe n
focusGetCurrent
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing)
      forall a b. (a -> b) -> a -> b
$ AppState
s

  isReplWorking :: Bool
isReplWorking = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameControls Bool
replWorking
  isPaused :: Bool
isPaused = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter TemporalState Bool
paused
  hasDebug :: Bool
hasDebug = forall a. a -> Maybe a -> a
fromMaybe Bool
creative forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot (Set Capability)
robotCapabilities forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
Lens.contains Capability
CDebug
  viewingBase :: Bool
viewingBase = (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ViewCenterRule
viewCenterRule) forall a. Eq a => a -> a -> Bool
== Count -> ViewCenterRule
VCRobot Count
0
  creative :: Bool
creative = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode
  cheat :: Bool
cheat = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
  goal :: Bool
goal = GoalTracking -> Bool
hasAnythingToShow forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay GoalTracking
goalsContent
  showZero :: Bool
showZero = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowZero
  inventorySort :: InventorySortOptions
inventorySort = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState InventorySortOptions
uiInventorySort
  inventorySearch :: Maybe Text
inventorySearch = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiInventorySearch
  ctrlMode :: ReplControlMode
ctrlMode = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState ReplControlMode
replControlMode
  canScroll :: Bool
canScroll = Bool
creative Bool -> Bool -> Bool
|| (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable)
  handlerInstalled :: Bool
handlerInstalled = forall a. Maybe a -> Bool
isJust (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe (Text, Value))
inputHandler)

  renderPilotModeSwitch :: ReplControlMode -> T.Text
  renderPilotModeSwitch :: ReplControlMode -> Text
renderPilotModeSwitch = \case
    ReplControlMode
Piloting -> Text
"REPL"
    ReplControlMode
_ -> Text
"pilot"

  renderHandlerModeSwitch :: ReplControlMode -> T.Text
  renderHandlerModeSwitch :: ReplControlMode -> Text
renderHandlerModeSwitch = \case
    ReplControlMode
Handling -> Text
"REPL"
    ReplControlMode
_ -> Text
"key handler"

  gameModeWidget :: Widget n
gameModeWidget =
    forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
padLeftRight Count
1
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
" mode")
      forall a b. (a -> b) -> a -> b
$ case Bool
creative of
        Bool
False -> Text
"Classic"
        Bool
True -> Text
"Creative"
  globalKeyCmds :: [(KeyHighlight, Text, Text)]
globalKeyCmds =
    forall a. [Maybe a] -> [a]
catMaybes
      [ forall {a}. Bool -> a -> Maybe a
may Bool
goal (KeyHighlight
NoHighlight, Text
"^g", Text
"goal")
      , forall {a}. Bool -> a -> Maybe a
may Bool
cheat (KeyHighlight
NoHighlight, Text
"^v", Text
"creative")
      , forall {a}. Bool -> a -> Maybe a
may Bool
cheat (KeyHighlight
NoHighlight, Text
"^e", Text
"editor")
      , forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, Text
"^p", if Bool
isPaused then Text
"unpause" else Text
"pause")
      , forall {a}. Bool -> a -> Maybe a
may Bool
isPaused (KeyHighlight
NoHighlight, Text
"^o", Text
"step")
      , forall {a}. Bool -> a -> Maybe a
may (Bool
isPaused Bool -> Bool -> Bool
&& Bool
hasDebug) (if AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowDebug then KeyHighlight
Alert else KeyHighlight
NoHighlight, Text
"M-d", Text
"debug")
      , forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, Text
"^zx", Text
"speed")
      , forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, Text
"M-,", if AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowREPL then Text
"hide REPL" else Text
"show REPL")
      , forall a. a -> Maybe a
Just (if AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter UIState Bool
uiShowRobots then KeyHighlight
NoHighlight else KeyHighlight
Alert, Text
"M-h", Text
"hide robots")
      ]
  may :: Bool -> a -> Maybe a
may Bool
b = if Bool
b then forall a. a -> Maybe a
Just else forall a b. a -> b -> a
const forall a. Maybe a
Nothing

  highlightKeyCmds :: (b, c) -> (KeyHighlight, b, c)
highlightKeyCmds (b
k, c
n) = (KeyHighlight
PanelSpecific, b
k, c
n)

  keyCmdsFor :: Maybe Name -> [(a, Text)]
keyCmdsFor (Just (FocusablePanel FocusablePanel
WorldEditorPanel)) =
    [(a
"^s", Text
"save map")]
  keyCmdsFor (Just (FocusablePanel FocusablePanel
REPLPanel)) =
    [ (a
"↓↑", Text
"history")
    ]
      forall a. [a] -> [a] -> [a]
++ [(a
"Enter", Text
"execute") | Bool -> Bool
not Bool
isReplWorking]
      forall a. [a] -> [a] -> [a]
++ [(a
"^c", Text
"cancel") | Bool
isReplWorking]
      forall a. [a] -> [a] -> [a]
++ [(a
"M-p", ReplControlMode -> Text
renderPilotModeSwitch ReplControlMode
ctrlMode) | Bool
creative]
      forall a. [a] -> [a] -> [a]
++ [(a
"M-k", ReplControlMode -> Text
renderHandlerModeSwitch ReplControlMode
ctrlMode) | Bool
handlerInstalled]
      forall a. [a] -> [a] -> [a]
++ [(a
"PgUp/Dn", Text
"scroll")]
  keyCmdsFor (Just (FocusablePanel FocusablePanel
WorldPanel)) =
    [ (a
"←↓↑→ / hjkl", Text
"scroll") | Bool
canScroll
    ]
      forall a. [a] -> [a] -> [a]
++ [(a
"c", Text
"recenter") | Bool -> Bool
not Bool
viewingBase]
      forall a. [a] -> [a] -> [a]
++ [(a
"f", Text
"FPS")]
  keyCmdsFor (Just (FocusablePanel FocusablePanel
RobotPanel)) =
    (a
"Enter", Text
"pop out")
      forall a. a -> [a] -> [a]
: if forall a. Maybe a -> Bool
isJust Maybe Text
inventorySearch
        then [(a
"Esc", Text
"exit search")]
        else
          [ (a
"m", Text
"make")
          , (a
"0", (if Bool
showZero then Text
"hide" else Text
"show") forall a. Semigroup a => a -> a -> a
<> Text
" 0")
          , (a
":/;", [Text] -> Text
T.unwords [Text
"Sort:", InventorySortOptions -> Text
renderSortMethod InventorySortOptions
inventorySort])
          , (a
"/", Text
"search")
          ]
  keyCmdsFor (Just (FocusablePanel FocusablePanel
InfoPanel)) = []
  keyCmdsFor Maybe Name
_ = []

data KeyHighlight = NoHighlight | Alert | PanelSpecific

-- | Draw a single key command in the menu.
drawKeyCmd :: (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd :: (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd (KeyHighlight
h, Text
key, Text
cmd) =
  forall {n}. [Widget n] -> Widget n
hBox
    [ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
attr (forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text -> Text
brackets Text
key)
    , forall n. Text -> Widget n
txt Text
cmd
    ]
 where
  attr :: AttrName
attr = case KeyHighlight
h of
    KeyHighlight
NoHighlight -> AttrName
defAttr
    KeyHighlight
Alert -> AttrName
notifAttr
    KeyHighlight
PanelSpecific -> AttrName
highlightAttr

------------------------------------------------------------
-- World panel
------------------------------------------------------------

worldWidget ::
  (Cosmic W.Coords -> Widget n) ->
  -- | view center
  Cosmic Location ->
  Widget n
worldWidget :: forall n.
(Cosmic Coords -> Widget n) -> Cosmic Location -> Widget n
worldWidget Cosmic Coords -> Widget n
renderCoord Cosmic Location
gameViewCenter = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$
  do
    Context n
ctx <- forall n. RenderM n (Context n)
getContext
    let w :: Count
w = Context n
ctx forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Context n) Count
availWidthL
        h :: Count
h = Context n
ctx forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Context n) Count
availHeightL
        vr :: Cosmic BoundsRectangle
vr = Cosmic Location -> (Int32, Int32) -> Cosmic BoundsRectangle
viewingRegion Cosmic Location
gameViewCenter (forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
w, forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
h)
        ixs :: [Coords]
ixs = forall a. Ix a => (a, a) -> [a]
range forall a b. (a -> b) -> a -> b
$ Cosmic BoundsRectangle
vr forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar
    forall n. Widget n -> RenderM n (Result n)
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {n}. [Widget n] -> Widget n
hBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Count -> [e] -> [[e]]
chunksOf Count
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Cosmic Coords -> Widget n
renderCoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SubworldName -> a -> Cosmic a
Cosmic (Cosmic BoundsRectangle
vr forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Cosmic a) SubworldName
subworld)) forall a b. (a -> b) -> a -> b
$ [Coords]
ixs

-- | Draw the current world view.
drawWorldPane :: UIState -> GameState -> Widget Name
drawWorldPane :: UIState -> GameState -> Widget Name
drawWorldPane UIState
ui GameState
g =
  forall n. Widget n -> Widget n
center
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> Widget n -> Widget n
cached Name
WorldCache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> Widget n -> Widget n
reportExtent Name
WorldExtent
    -- Set the clickable request after the extent to play nice with the cache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
WorldPanel)
    forall a b. (a -> b) -> a -> b
$ forall n.
(Cosmic Coords -> Widget n) -> Cosmic Location -> Widget n
worldWidget Cosmic Coords -> Widget Name
renderCoord (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter)
 where
  renderCoord :: Cosmic Coords -> Widget Name
renderCoord = UIState -> GameState -> Cosmic Coords -> Widget Name
drawLoc UIState
ui GameState
g

------------------------------------------------------------
-- Robot inventory panel
------------------------------------------------------------

-- | Draw info about the currently focused robot, such as its name,
--   position, orientation, and inventory, as long as it is not too
--   far away.
drawRobotPanel :: AppState -> Widget Name
drawRobotPanel :: AppState -> Widget Name
drawRobotPanel AppState
s
  -- If the focused robot is too far away to communicate, just leave the panel blank.
  -- There should be no way to tell the difference between a robot that is too far
  -- away and a robot that does not exist.
  | Just Robot
r <- AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot
  , Just (Count
_, List Name InventoryListEntry
lst) <- AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Count, List Name InventoryListEntry))
uiInventory =
      let drawClickableItem :: Count -> Bool -> InventoryListEntry -> Widget Name
drawClickableItem Count
pos Bool
selb = forall n. Ord n => n -> Widget n -> Widget n
clickable (Count -> Name
InventoryListItem Count
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Count -> Count -> Bool -> InventoryListEntry -> Widget Name
drawItem (List Name InventoryListEntry
lst forall s a. s -> Getting a s a -> a
^. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Count)
BL.listSelectedL) Count
pos Bool
selb
          row :: [Widget n]
row =
            [ forall n. Text -> Widget n
txt (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Text
robotName)
            , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. String -> Widget n
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> String
renderCoordsString forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation
            , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
2) forall a b. (a -> b) -> a -> b
$ forall n. Display -> Widget n
renderDisplay (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Display
robotDisplay)
            ]
       in forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall a b. (a -> b) -> a -> b
$
            forall {n}. [Widget n] -> Widget n
vBox
              [ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall {n}. [Widget n] -> Widget n
hBox forall {n}. [Widget n]
row
              , forall n. Widget n -> Widget n
withLeftPaddedVScrollBars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$
                  forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Count -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
BL.renderListWithIndex Count -> Bool -> InventoryListEntry -> Widget Name
drawClickableItem Bool
True List Name InventoryListEntry
lst
              ]
  | Bool
otherwise = Widget Name
blank

blank :: Widget Name
blank :: Widget Name
blank = forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
" "

-- | Draw an inventory entry.
drawItem ::
  -- | The index of the currently selected inventory entry
  Maybe Int ->
  -- | The index of the entry we are drawing
  Int ->
  -- | Whether this entry is selected; we can ignore this
  --   because it will automatically have a special attribute
  --   applied to it.
  Bool ->
  -- | The entry to draw.
  InventoryListEntry ->
  Widget Name
drawItem :: Maybe Count -> Count -> Bool -> InventoryListEntry -> Widget Name
drawItem Maybe Count
sel Count
i Bool
_ (Separator Text
l) =
  -- Make sure a separator right before the focused element is
  -- visible. Otherwise, when a separator occurs as the very first
  -- element of the list, once it scrolls off the top of the viewport
  -- it will never become visible again.
  -- See https://github.com/jtdaugherty/brick/issues/336#issuecomment-921220025
  (if Maybe Count
sel forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (Count
i forall a. Num a => a -> a -> a
+ Count
1) then forall n. Widget n -> Widget n
visible else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
l)
drawItem Maybe Count
_ Count
_ Bool
_ (InventoryEntry Count
n Entity
e) = Entity -> Widget Name
drawLabelledEntityName Entity
e forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Count -> Widget n
showCount Count
n
 where
  showCount :: Count -> Widget n
showCount = forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. String -> Widget n
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
drawItem Maybe Count
_ Count
_ Bool
_ (EquippedEntry Entity
e) = Entity -> Widget Name
drawLabelledEntityName Entity
e forall n. Widget n -> Widget n -> Widget n
<+> forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (forall n. String -> Widget n
str String
" ")

-- | Draw the name of an entity, labelled with its visual
--   representation as a cell in the world.
drawLabelledEntityName :: Entity -> Widget Name
drawLabelledEntityName :: Entity -> Widget Name
drawLabelledEntityName Entity
e =
  forall {n}. [Widget n] -> Widget n
hBox
    [ forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
2) (forall n. Display -> Widget n
renderDisplay (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Display
entityDisplay))
    , forall n. Text -> Widget n
txt (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)
    ]

------------------------------------------------------------
-- Info panel
------------------------------------------------------------

-- | Draw the info panel in the bottom-left corner, which shows info
--   about the currently focused inventory item.
drawInfoPanel :: AppState -> Widget Name
drawInfoPanel :: AppState -> Widget Name
drawInfoPanel AppState
s
  | Just RobotRange
Far <- AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe RobotRange
focusedRange = Widget Name
blank
  | Bool
otherwise =
      forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
InfoViewport ViewportType
Vertical
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
padLeftRight Count
1
        forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
explainFocusedItem AppState
s

-- | Display info about the currently focused inventory entity,
--   such as its description and relevant recipes.
explainFocusedItem :: AppState -> Widget Name
explainFocusedItem :: AppState -> Widget Name
explainFocusedItem AppState
s = case AppState -> Maybe InventoryListEntry
focusedItem AppState
s of
  Just (InventoryEntry Count
_ Entity
e) -> AppState -> Entity -> Widget Name
explainEntry AppState
s Entity
e
  Just (EquippedEntry Entity
e) -> AppState -> Entity -> Widget Name
explainEntry AppState
s Entity
e
  Maybe InventoryListEntry
_ -> forall n. Text -> Widget n
txt Text
" "

explainEntry :: AppState -> Entity -> Widget Name
explainEntry :: AppState -> Entity -> Widget Name
explainEntry AppState
s Entity
e =
  forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
    [ [EntityProperty] -> Widget Name
displayProperties forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set EntityProperty)
entityProperties)
    , Document Syntax -> Widget Name
drawMarkdown (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Document Syntax)
entityDescription)
    , AppState -> Entity -> Widget Name
explainRecipes AppState
s Entity
e
    ]
      forall a. Semigroup a => a -> a -> a
<> [AppState -> Bool -> Widget Name
drawRobotMachine AppState
s Bool
False | Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
entityCapabilities forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
Lens.contains Capability
CDebug]
      forall a. Semigroup a => a -> a -> a
<> [AppState -> Widget Name
drawRobotLog AppState
s | Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
entityCapabilities forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
Lens.contains Capability
CLog]

displayProperties :: [EntityProperty] -> Widget Name
displayProperties :: [EntityProperty] -> Widget Name
displayProperties = forall {n}. [Text] -> Widget n
displayList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. IsString a => EntityProperty -> Maybe a
showProperty
 where
  showProperty :: EntityProperty -> Maybe a
showProperty EntityProperty
Growable = forall a. a -> Maybe a
Just a
"growing"
  showProperty EntityProperty
Combustible = forall a. a -> Maybe a
Just a
"combustible"
  showProperty EntityProperty
Infinite = forall a. a -> Maybe a
Just a
"infinite"
  showProperty EntityProperty
Liquid = forall a. a -> Maybe a
Just a
"liquid"
  showProperty EntityProperty
Unwalkable = forall a. a -> Maybe a
Just a
"blocking"
  showProperty EntityProperty
Opaque = forall a. a -> Maybe a
Just a
"opaque"
  -- Most things are portable so we don't show that.
  showProperty EntityProperty
Portable = forall a. Maybe a
Nothing
  -- 'Known' is just a technical detail of how we handle some entities
  -- in challenge scenarios and not really something the player needs
  -- to know.
  showProperty EntityProperty
Known = forall a. Maybe a
Nothing

  displayList :: [Text] -> Widget n
displayList [] = forall {n}. Widget n
emptyWidget
  displayList [Text]
ps =
    forall {n}. [Widget n] -> Widget n
vBox
      [ forall {n}. [Widget n] -> Widget n
hBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
L.intersperse (forall n. Text -> Widget n
txt Text
", ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
robotAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt) forall a b. (a -> b) -> a -> b
$ [Text]
ps
      , forall n. Text -> Widget n
txt Text
" "
      ]

explainRecipes :: AppState -> Entity -> Widget Name
explainRecipes :: AppState -> Entity -> Widget Name
explainRecipes AppState
s Entity
e
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Recipe Entity]
recipes = forall {n}. Widget n
emptyWidget
  | Bool
otherwise =
      forall {n}. [Widget n] -> Widget n
vBox
        [ forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) (forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Recipes"))
        , forall n. Count -> Widget n -> Widget n
padLeftRight Count
2
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n
hCenter
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. Count -> Widget n -> Widget n
hLimit Count
widthLimit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Entity -> Inventory -> Recipe Entity -> Widget Name
drawRecipe (forall a. a -> Maybe a
Just Entity
e) Inventory
inv) [Recipe Entity]
recipes
        ]
 where
  recipes :: [Recipe Entity]
recipes = AppState -> Entity -> [Recipe Entity]
recipesWith AppState
s Entity
e

  inv :: Inventory
inv = forall a. a -> Maybe a -> a
fromMaybe Inventory
E.empty forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory

  width :: (a, Entity) -> Count
width (a
n, Entity
ingr) =
    forall (t :: * -> *) a. Foldable t => t a -> Count
length (forall a. Show a => a -> String
show a
n) forall a. Num a => a -> a -> a
+ Count
1 forall a. Num a => a -> a -> a
+ forall a. (Num a, Ord a) => [a] -> a
maximum0 (forall a b. (a -> b) -> [a] -> [b]
map Text -> Count
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ Entity
ingr forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)

  maxInputWidth :: Count
maxInputWidth =
    forall a. a -> Maybe a -> a
fromMaybe Count
0 forall a b. (a -> b) -> a -> b
$
      forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
maximumOf (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Lens' (Recipe e) (IngredientList e)
recipeInputs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall {a}. Show a => (a, Entity) -> Count
width) [Recipe Entity]
recipes
  maxOutputWidth :: Count
maxOutputWidth =
    forall a. a -> Maybe a -> a
fromMaybe Count
0 forall a b. (a -> b) -> a -> b
$
      forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
maximumOf (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Lens' (Recipe e) (IngredientList e)
recipeOutputs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall {a}. Show a => (a, Entity) -> Count
width) [Recipe Entity]
recipes
  widthLimit :: Count
widthLimit = Count
2 forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
max Count
maxInputWidth Count
maxOutputWidth forall a. Num a => a -> a -> a
+ Count
11

-- | Return all recipes that involve a given entity.
recipesWith :: AppState -> Entity -> [Recipe Entity]
recipesWith :: AppState -> Entity -> [Recipe Entity]
recipesWith AppState
s Entity
e =
  let getRecipes :: ((IntMap [Recipe Entity]
  -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
 -> Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> [Recipe Entity]
getRecipes (IntMap [Recipe Entity]
 -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> Recipes -> Const (IntMap [Recipe Entity]) Recipes
select = IntMap [Recipe Entity] -> Entity -> [Recipe Entity]
recipesFor (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Recipes
recipesInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [Recipe Entity]
 -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> Recipes -> Const (IntMap [Recipe Entity]) Recipes
select) Entity
e
   in -- The order here is chosen intentionally.  See https://github.com/swarm-game/swarm/issues/418.
      --
      --   1. Recipes where the entity is an input --- these should go
      --     first since the first thing you will want to know when you
      --     obtain a new entity is what you can do with it.
      --
      --   2. Recipes where it serves as a catalyst --- for the same reason.
      --
      --   3. Recipes where it is an output --- these should go last,
      --      since if you have it, you probably already figured out how
      --      to make it.
      forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ ((IntMap [Recipe Entity]
  -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
 -> Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> [Recipe Entity]
getRecipes Lens' Recipes (IntMap [Recipe Entity])
recipesIn
          , ((IntMap [Recipe Entity]
  -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
 -> Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> [Recipe Entity]
getRecipes Lens' Recipes (IntMap [Recipe Entity])
recipesCat
          , ((IntMap [Recipe Entity]
  -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
 -> Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> [Recipe Entity]
getRecipes Lens' Recipes (IntMap [Recipe Entity])
recipesOut
          ]

-- | Draw an ASCII art representation of a recipe.  For now, the
--   weight is not shown.
drawRecipe :: Maybe Entity -> Inventory -> Recipe Entity -> Widget Name
drawRecipe :: Maybe Entity -> Inventory -> Recipe Entity -> Widget Name
drawRecipe Maybe Entity
me Inventory
inv (Recipe [(Count, Entity)]
ins [(Count, Entity)]
outs [(Count, Entity)]
reqs Integer
time Integer
_weight) =
  forall {n}. [Widget n] -> Widget n
vBox
    -- any requirements (e.g. furnace) go on top.
    [ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ [(Count, Entity)] -> Widget Name
drawReqs [(Count, Entity)]
reqs
    , -- then we draw inputs, a connector, and outputs.
      forall {n}. [Widget n] -> Widget n
hBox
        [ forall {n}. [Widget n] -> Widget n
vBox (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Count -> (Count, Entity) -> Widget Name
drawIn [Count
0 ..] ([(Count, Entity)]
ins forall a. Semigroup a => a -> a -> a
<> [(Count, Entity)]
times))
        , forall {n}. Widget n
connector
        , forall {n}. [Widget n] -> Widget n
vBox (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Count -> (Count, Entity) -> Widget Name
drawOut [Count
0 ..] [(Count, Entity)]
outs)
        ]
    ]
 where
  -- The connector is either just a horizontal line ─────
  -- or, if there are requirements, a horizontal line with
  -- a vertical piece coming out of the center, ──┴── .
  connector :: Widget n
connector
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Count, Entity)]
reqs = forall n. Count -> Widget n -> Widget n
hLimit Count
5 forall {n}. Widget n
hBorder
    | Bool
otherwise =
        forall {n}. [Widget n] -> Widget n
hBox
          [ forall n. Count -> Widget n -> Widget n
hLimit Count
2 forall {n}. Widget n
hBorder
          , forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
True)
          , forall n. Count -> Widget n -> Widget n
hLimit Count
2 forall {n}. Widget n
hBorder
          ]
  inLen :: Count
inLen = forall (t :: * -> *) a. Foldable t => t a -> Count
length [(Count, Entity)]
ins forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Count
length [(Count, Entity)]
times
  outLen :: Count
outLen = forall (t :: * -> *) a. Foldable t => t a -> Count
length [(Count, Entity)]
outs
  times :: [(Count, Entity)]
times = [(forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
time, Entity
timeE) | Integer
time forall a. Eq a => a -> a -> Bool
/= Integer
1]

  -- Draw inputs and outputs.
  drawIn, drawOut :: Int -> (Count, Entity) -> Widget Name
  drawIn :: Count -> (Count, Entity) -> Widget Name
drawIn Count
i (Count
n, Entity
ingr) =
    forall {n}. [Widget n] -> Widget n
hBox
      [ forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (forall a. Show a => a -> String
show Count
n) -- how many?
      , forall {n}. Bool -> Entity -> Widget n
fmtEntityName Bool
missing Entity
ingr -- name of the input
      , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ -- a connecting line:   ─────┬
          forall {n}. Widget n
hBorder
            forall n. Widget n -> Widget n -> Widget n
<+> ( forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges (Count
i forall a. Eq a => a -> a -> Bool
/= Count
0) (Count
i forall a. Eq a => a -> a -> Bool
/= Count
inLen forall a. Num a => a -> a -> a
- Count
1) Bool
True Bool
False) -- ...maybe plus vert ext:   │
                    forall n. Widget n -> Widget n -> Widget n
<=> if Count
i forall a. Eq a => a -> a -> Bool
/= Count
inLen forall a. Num a => a -> a -> a
- Count
1
                      then forall n. Count -> Widget n -> Widget n
vLimit (forall a. Num a => a -> a -> a
subtract Count
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Count
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ Entity
ingr forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall {n}. Widget n
vBorder
                      else forall {n}. Widget n
emptyWidget
                )
      ]
   where
    missing :: Bool
missing = Entity -> Inventory -> Count
E.lookup Entity
ingr Inventory
inv forall a. Ord a => a -> a -> Bool
< Count
n

  drawOut :: Count -> (Count, Entity) -> Widget Name
drawOut Count
i (Count
n, Entity
ingr) =
    forall {n}. [Widget n] -> Widget n
hBox
      [ forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$
          ( forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges (Count
i forall a. Eq a => a -> a -> Bool
/= Count
0) (Count
i forall a. Eq a => a -> a -> Bool
/= Count
outLen forall a. Num a => a -> a -> a
- Count
1) Bool
False Bool
True)
              forall n. Widget n -> Widget n -> Widget n
<=> if Count
i forall a. Eq a => a -> a -> Bool
/= Count
outLen forall a. Num a => a -> a -> a
- Count
1
                then forall n. Count -> Widget n -> Widget n
vLimit (forall a. Num a => a -> a -> a
subtract Count
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Count
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ Entity
ingr forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall {n}. Widget n
vBorder
                else forall {n}. Widget n
emptyWidget
          )
            forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. Widget n
hBorder
      , forall {n}. Bool -> Entity -> Widget n
fmtEntityName Bool
False Entity
ingr
      , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (forall a. Show a => a -> String
show Count
n)
      ]

  -- If it's the focused entity, draw it highlighted.
  -- If the robot doesn't have any, draw it in red.
  fmtEntityName :: Bool -> Entity -> Widget n
fmtEntityName Bool
missing Entity
ingr
    | forall a. a -> Maybe a
Just Entity
ingr forall a. Eq a => a -> a -> Bool
== Maybe Entity
me = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txtLines Text
nm
    | Entity
ingr forall a. Eq a => a -> a -> Bool
== Entity
timeE = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txtLines Text
nm
    | Bool
missing = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
invalidFormInputAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txtLines Text
nm
    | Bool
otherwise = forall n. Text -> Widget n
txtLines Text
nm
   where
    -- Split up multi-word names, one line per word
    nm :: Text
nm = Entity
ingr forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName
    txtLines :: Text -> Widget n
txtLines = forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words

-- | Ad-hoc entity to represent time - only used in recipe drawing
timeE :: Entity
timeE :: Entity
timeE = Display
-> Text
-> Document Syntax
-> [EntityProperty]
-> [Capability]
-> Entity
mkEntity (Char -> Display
defaultEntityDisplay Char
'.') Text
"ticks" forall a. Monoid a => a
mempty [] []

drawReqs :: IngredientList Entity -> Widget Name
drawReqs :: [(Count, Entity)] -> Widget Name
drawReqs = forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {n}. (Eq a, Num a, Show a) => (a, Entity) -> Widget n
drawReq)
 where
  drawReq :: (a, Entity) -> Widget n
drawReq (a
1, Entity
e) = forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName
  drawReq (a
n, Entity
e) = forall n. String -> Widget n
str (forall a. Show a => a -> String
show a
n) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
" " forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)

indent2 :: WrapSettings
indent2 :: WrapSettings
indent2 = WrapSettings
defaultWrapSettings {fillStrategy :: FillStrategy
fillStrategy = Count -> FillStrategy
FillIndent Count
2}

drawRobotLog :: AppState -> Widget Name
drawRobotLog :: AppState -> Widget Name
drawRobotLog AppState
s =
  forall {n}. [Widget n] -> Widget n
vBox
    [ forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) (forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
"Log"))
    , forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap forall {n}. Count -> LogEntry -> Widget n
drawEntry forall a b. (a -> b) -> a -> b
$ Seq LogEntry
logEntries
    ]
 where
  logEntries :: Seq LogEntry
logEntries = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot (Seq LogEntry)
robotLog

  rid :: Maybe Count
rid = AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot Count
robotID
  n :: Count
n = forall a. Seq a -> Count
Seq.length Seq LogEntry
logEntries

  allMe :: Bool
allMe = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LogEntry -> Bool
me Seq LogEntry
logEntries
  me :: LogEntry -> Bool
me LogEntry
le = case LogEntry
le forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSource of
    RobotLog RobotLogSource
_ Count
i Cosmic Location
_ -> forall a. a -> Maybe a
Just Count
i forall a. Eq a => a -> a -> Bool
== Maybe Count
rid
    LogSource
_ -> Bool
False

  drawEntry :: Count -> LogEntry -> Widget n
drawEntry Count
i LogEntry
e =
    (if Count
i forall a. Eq a => a -> a -> Bool
== Count
n forall a. Num a => a -> a -> a
- Count
1 Bool -> Bool -> Bool
&& AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiScrollToEnd then forall n. Widget n -> Widget n
visible else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
      forall a. Bool -> LogEntry -> Widget a
drawLogEntry (Bool -> Bool
not Bool
allMe) LogEntry
e

-- | Show the 'CESK' machine of focused robot. Puts a separator above.
drawRobotMachine :: AppState -> Bool -> Widget Name
drawRobotMachine :: AppState -> Bool -> Widget Name
drawRobotMachine AppState
s Bool
showName = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot of
  Maybe Robot
Nothing -> forall n. Text -> Widget n
machineLine Text
"no selected robot"
  Just Robot
r ->
    forall {n}. [Widget n] -> Widget n
vBox
      [ forall n. Text -> Widget n
machineLine forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Text
robotName forall a. Semigroup a => a -> a -> a
<> Text
"#" forall a. Semigroup a => a -> a -> a
<> Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot Count
robotID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Count -> Text
tshow
      , forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. PrettyPrec a => a -> Text
prettyText
      ]
 where
  tshow :: Count -> Text
tshow = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
  hLine :: Text -> Widget n
hLine Text
t = forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) (forall n. Widget n -> Widget n
hBorderWithLabel (forall n. Text -> Widget n
txt Text
t))
  machineLine :: Text -> Widget n
machineLine Text
r = forall n. Text -> Widget n
hLine forall a b. (a -> b) -> a -> b
$ if Bool
showName then Text
"Machine [" forall a. Semigroup a => a -> a -> a
<> Text
r forall a. Semigroup a => a -> a -> a
<> Text
"]" else Text
"Machine"

-- | Draw one log entry with an optional robot name first.
drawLogEntry :: Bool -> LogEntry -> Widget a
drawLogEntry :: forall a. Bool -> LogEntry -> Widget a
drawLogEntry Bool
addName LogEntry
e =
  forall n. AttrName -> Widget n -> Widget n
withAttr (LogEntry -> AttrName
colorLogs LogEntry
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
indent2 forall a b. (a -> b) -> a -> b
$
    if Bool
addName then Text
name else Text
t
 where
  t :: Text
t = LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Text
leText
  name :: Text
name =
    Text
"["
      forall a. Semigroup a => a -> a -> a
<> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' LogEntry Text
leName LogEntry
e
      forall a. Semigroup a => a -> a -> a
<> Text
"] "
      forall a. Semigroup a => a -> a -> a
<> case LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSource of
        RobotLog RobotLogSource
Said Count
_ Cosmic Location
_ -> Text
"said " forall a. Semigroup a => a -> a -> a
<> Text -> Text
quote Text
t
        LogSource
_ -> Text
t

------------------------------------------------------------
-- REPL panel
------------------------------------------------------------

-- | Turn the repl prompt into a decorator for the form
replPromptAsWidget :: Text -> REPLPrompt -> Widget Name
replPromptAsWidget :: Text -> REPLPrompt -> Widget Name
replPromptAsWidget Text
_ (CmdPrompt [Text]
_) = forall n. Text -> Widget n
txt Text
"> "
replPromptAsWidget Text
t (SearchPrompt REPLHistory
rh) =
  case Text -> REPLHistory -> Maybe Text
lastEntry Text
t REPLHistory
rh of
    Maybe Text
Nothing -> forall n. Text -> Widget n
txt Text
"[nothing found] "
    Just Text
lastentry
      | Text -> Bool
T.null Text
t -> forall n. Text -> Widget n
txt Text
"[find] "
      | Bool
otherwise -> forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"[found: \"" forall a. Semigroup a => a -> a -> a
<> Text
lastentry forall a. Semigroup a => a -> a -> a
<> Text
"\"] "

renderREPLPrompt :: FocusRing Name -> REPLState -> Widget Name
renderREPLPrompt :: FocusRing Name -> REPLState -> Widget Name
renderREPLPrompt FocusRing Name
focus REPLState
theRepl = Widget Name
ps1 forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
replE
 where
  prompt :: REPLPrompt
prompt = REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLPrompt
replPromptType
  replEditor :: Editor Text Name
replEditor = REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState (Editor Text Name)
replPromptEditor
  color :: Widget n -> Widget n
color = if REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Bool
replValid then forall a. a -> a
id else forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr
  ps1 :: Widget Name
ps1 = Text -> REPLPrompt -> Widget Name
replPromptAsWidget ([Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
replEditor) REPLPrompt
prompt
  replE :: Widget Name
replE =
    forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor
      (forall n. Widget n -> Widget n
color forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. Text -> Widget n
txt)
      (forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focus forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel), forall a. a -> Maybe a
Just Name
REPLInput])
      Editor Text Name
replEditor

-- | Draw the REPL.
drawREPL :: AppState -> Widget Name
drawREPL :: AppState -> Widget Name
drawREPL AppState
s =
  forall {n}. [Widget n] -> Widget n
vBox
    [ forall n. Widget n -> Widget n
withLeftPaddedVScrollBars
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
REPLViewport ViewportType
Vertical
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox
        forall a b. (a -> b) -> a -> b
$ [forall n. Ord n => n -> Widget n -> Widget n
cached Name
REPLHistoryCache (forall {n}. [Widget n] -> Widget n
vBox forall {n}. [Widget n]
history), Widget Name
currentPrompt]
    , forall {n}. [Widget n] -> Widget n
vBox [Widget Name]
mayDebug
    ]
 where
  -- rendered history lines fitting above REPL prompt
  history :: [Widget n]
  history :: forall {n}. [Widget n]
history = forall a b. (a -> b) -> [a] -> [b]
map forall {n}. REPLHistItem -> Widget n
fmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistory -> Seq REPLHistItem
getSessionREPLHistoryItems forall a b. (a -> b) -> a -> b
$ REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLHistory
replHistory
  currentPrompt :: Widget Name
  currentPrompt :: Widget Name
currentPrompt = case (Robot -> Bool
isActive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
base, REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState ReplControlMode
replControlMode) of
    (Maybe Bool
_, ReplControlMode
Handling) -> forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"[key handler running, M-k to toggle]"
    (Just Bool
False, ReplControlMode
_) -> FocusRing Name -> REPLState -> Widget Name
renderREPLPrompt (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing) REPLState
theRepl
    (Maybe Bool, ReplControlMode)
_running -> forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"..."
  theRepl :: REPLState
theRepl = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL
  base :: Maybe Robot
base = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Count
0
  fmt :: REPLHistItem -> Widget n
fmt (REPLEntry Text
e) = forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"> " forall a. Semigroup a => a -> a -> a
<> Text
e
  fmt (REPLOutput Text
t) = forall n. Text -> Widget n
txt Text
t
  fmt (REPLError Text
t) = forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
indent2 {preserveIndentation :: Bool
preserveIndentation = Bool
True} Text
t
  mayDebug :: [Widget Name]
mayDebug = [AppState -> Bool -> Widget Name
drawRobotMachine AppState
s Bool
True | AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowDebug]

------------------------------------------------------------
-- Utility
------------------------------------------------------------

-- See https://github.com/jtdaugherty/brick/discussions/484
withLeftPaddedVScrollBars :: Widget n -> Widget n
withLeftPaddedVScrollBars :: forall n. Widget n -> Widget n
withLeftPaddedVScrollBars =
  forall n. VScrollbarRenderer n -> Widget n -> Widget n
withVScrollBarRenderer (forall n. VScrollbarRenderer n -> VScrollbarRenderer n
addLeftSpacing forall n. VScrollbarRenderer n
verticalScrollbarRenderer)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight
 where
  addLeftSpacing :: VScrollbarRenderer n -> VScrollbarRenderer n
  addLeftSpacing :: forall n. VScrollbarRenderer n -> VScrollbarRenderer n
addLeftSpacing VScrollbarRenderer n
r =
    VScrollbarRenderer n
r
      { scrollbarWidthAllocation :: Count
scrollbarWidthAllocation = Count
2
      , renderVScrollbar :: Widget n
renderVScrollbar = forall n. Count -> Widget n -> Widget n
hLimit Count
1 forall a b. (a -> b) -> a -> b
$ forall n. VScrollbarRenderer n -> Widget n
renderVScrollbar VScrollbarRenderer n
r
      , renderVScrollbarTrough :: Widget n
renderVScrollbarTrough = forall n. Count -> Widget n -> Widget n
hLimit Count
1 forall a b. (a -> b) -> a -> b
$ forall n. VScrollbarRenderer n -> Widget n
renderVScrollbarTrough VScrollbarRenderer n
r
      }