{-# 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,

  -- * Robot panel
  drawRobotPanel,
  drawItem,

  -- * Info panel
  drawInfoPanel,
  explainFocusedItem,

  -- * REPL
  drawREPL,
) where

import Brick hiding (Direction, Location)
import Brick.Focus
import Brick.Forms
import Brick.Keybindings (KeyConfig)
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.Foldable (toList)
import Data.Foldable qualified as F
import Data.Functor (($>))
import Data.List (intersperse)
import Data.List qualified as L
import Data.List.Extra (enumerate)
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, mapMaybe, maybeToList)
import Data.Semigroup (sconcat)
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (NominalDiffTime, defaultTimeLocale, formatTime)
import Network.Wai.Handler.Warp (Port)
import Swarm.Constant
import Swarm.Game.Device (commandCost, commandsForDeviceCaps, enabledCommands, getCapabilitySet, getMap, ingredients)
import Swarm.Game.Display
import Swarm.Game.Entity as E
import Swarm.Game.Ingredients
import Swarm.Game.Land
import Swarm.Game.Location
import Swarm.Game.Recipe
import Swarm.Game.Robot
import Swarm.Game.Robot.Concrete
import Swarm.Game.Scenario (
  scenarioAuthor,
  scenarioCreative,
  scenarioDescription,
  scenarioKnown,
  scenarioLandscape,
  scenarioMetadata,
  scenarioName,
  scenarioObjectives,
  scenarioOperation,
  scenarioSeed,
  scenarioTerrainAndEntities,
 )
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.Scenario.Topography.Center
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Swarm.Game.ScenarioInfo (
  ScenarioItem (..),
  scenarioItemByPath,
  scenarioItemName,
  _SISingle,
 )
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Game.State.Runtime
import Swarm.Game.State.Substate
import Swarm.Game.Tick (TickNumber (..), formatTicks)
import Swarm.Game.Universe
import Swarm.Game.World.Coords
import Swarm.Game.World.Gen (Seed)
import Swarm.Language.Capability (Capability (..), constCaps)
import Swarm.Language.Syntax
import Swarm.Language.Typecheck (inferConst)
import Swarm.Log
import Swarm.Pretty (prettyText, prettyTextLine, prettyTextWidth)
import Swarm.TUI.Border
import Swarm.TUI.Controller (ticksPerFrameCap)
import Swarm.TUI.Controller.EventHandlers (allEventHandlers, mainEventHandlers, replEventHandlers, robotEventHandlers, worldEventHandlers)
import Swarm.TUI.Controller.Util (hasDebugCapability)
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.DebugOption (DebugOption (..))
import Swarm.TUI.Model.Dialog.Goal (goalsContent, hasAnythingToShow)
import Swarm.TUI.Model.Event qualified as SE
import Swarm.TUI.Model.KeyBindings (handlerNameKeysDescription)
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.UI
import Swarm.TUI.Model.UI.Gameplay
import Swarm.TUI.Panel
import Swarm.TUI.View.Achievement
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.CellDisplay
import Swarm.TUI.View.Logo
import Swarm.TUI.View.Objective qualified as GR
import Swarm.TUI.View.Popup
import Swarm.TUI.View.Robot
import Swarm.TUI.View.Structure qualified as SR
import Swarm.TUI.View.Util as VU
import Swarm.Util
import Text.Printf
import Text.Wrap
import Witch (into)

data KeyCmd
  = SingleButton KeyHighlight Text Text
  | MultiButton KeyHighlight [(Text, Text)] Text

-- | The main entry point for drawing the entire UI.
drawUI :: AppState -> [Widget Name]
drawUI :: AppState -> [Widget Name]
drawUI AppState
s = AppState -> Widget Name
drawPopups AppState
s Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name]
mainLayers
 where
  mainLayers :: [Widget Name]
mainLayers
    | AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Bool UIState) -> AppState -> Const Bool AppState
Lens' AppState UIState
uiState ((UIState -> Const Bool UIState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> UIState -> Const Bool UIState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIState -> Const Bool UIState
Lens' UIState Bool
uiPlaying = AppState -> [Widget Name]
drawGameUI AppState
s
    | Bool
otherwise = AppState -> [Widget Name]
drawMenuUI AppState
s

drawMenuUI :: AppState -> [Widget Name]
drawMenuUI :: AppState -> [Widget Name]
drawMenuUI AppState
s = case AppState
s AppState -> Getting Menu AppState Menu -> Menu
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Menu UIState) -> AppState -> Const Menu AppState
Lens' AppState UIState
uiState ((UIState -> Const Menu UIState)
 -> AppState -> Const Menu AppState)
-> ((Menu -> Const Menu Menu) -> UIState -> Const Menu UIState)
-> Getting Menu AppState Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Const Menu Menu) -> UIState -> Const Menu UIState
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 ScenarioPath))
stk -> AppState
-> NonEmpty (List Name (ScenarioItem ScenarioPath))
-> LaunchOptions
-> [Widget Name]
drawNewGameMenuUI AppState
s NonEmpty (List Name (ScenarioItem ScenarioPath))
stk (LaunchOptions -> [Widget Name]) -> LaunchOptions -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ AppState
s AppState
-> Getting LaunchOptions AppState LaunchOptions -> LaunchOptions
forall s a. s -> Getting a s a -> a
^. (UIState -> Const LaunchOptions UIState)
-> AppState -> Const LaunchOptions AppState
Lens' AppState UIState
uiState ((UIState -> Const LaunchOptions UIState)
 -> AppState -> Const LaunchOptions AppState)
-> ((LaunchOptions -> Const LaunchOptions LaunchOptions)
    -> UIState -> Const LaunchOptions UIState)
-> Getting LaunchOptions AppState LaunchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchOptions -> Const LaunchOptions LaunchOptions)
-> UIState -> Const LaunchOptions UIState
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 AppState
-> Getting (Maybe Text) AppState (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. (RuntimeState -> Const (Maybe Text) RuntimeState)
-> AppState -> Const (Maybe Text) AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Const (Maybe Text) RuntimeState)
 -> AppState -> Const (Maybe Text) AppState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> RuntimeState -> Const (Maybe Text) RuntimeState)
-> Getting (Maybe Text) AppState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text Text -> Const (Maybe Text) (Map Text Text))
-> RuntimeState -> Const (Maybe Text) RuntimeState
Lens' RuntimeState (Map Text Text)
appData ((Map Text Text -> Const (Maybe Text) (Map Text Text))
 -> RuntimeState -> Const (Maybe Text) RuntimeState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> Map Text Text -> Const (Maybe Text) (Map Text Text))
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> RuntimeState
-> Const (Maybe Text) RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Text Text)
-> Lens' (Map Text Text) (Maybe (IxValue (Map Text Text)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text Text)
"about")]

drawMainMessages :: AppState -> Widget Name
drawMainMessages :: AppState -> Widget Name
drawMainMessages AppState
s = Dialog Any Name -> Widget Name -> Widget Name
forall n a. Ord n => Dialog a n -> Widget n -> Widget n
renderDialog Dialog Any Name
forall {a}. Dialog a Name
dial (Widget Name -> Widget Name)
-> ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name)
-> ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
scrollList ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ [LogEntry] -> [Widget Name]
forall {a}. [LogEntry] -> [Widget a]
drawLogs [LogEntry]
ls
 where
  ls :: [LogEntry]
ls = [LogEntry] -> [LogEntry]
forall a. [a] -> [a]
reverse ([LogEntry] -> [LogEntry]) -> [LogEntry] -> [LogEntry]
forall a b. (a -> b) -> a -> b
$ AppState
s AppState -> Getting [LogEntry] AppState [LogEntry] -> [LogEntry]
forall s a. s -> Getting a s a -> a
^. (RuntimeState -> Const [LogEntry] RuntimeState)
-> AppState -> Const [LogEntry] AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Const [LogEntry] RuntimeState)
 -> AppState -> Const [LogEntry] AppState)
-> (([LogEntry] -> Const [LogEntry] [LogEntry])
    -> RuntimeState -> Const [LogEntry] RuntimeState)
-> Getting [LogEntry] AppState [LogEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications LogEntry
 -> Const [LogEntry] (Notifications LogEntry))
-> RuntimeState -> Const [LogEntry] RuntimeState
Lens' RuntimeState (Notifications LogEntry)
eventLog ((Notifications LogEntry
  -> Const [LogEntry] (Notifications LogEntry))
 -> RuntimeState -> Const [LogEntry] RuntimeState)
-> (([LogEntry] -> Const [LogEntry] [LogEntry])
    -> Notifications LogEntry
    -> Const [LogEntry] (Notifications LogEntry))
-> ([LogEntry] -> Const [LogEntry] [LogEntry])
-> RuntimeState
-> Const [LogEntry] RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LogEntry] -> Const [LogEntry] [LogEntry])
-> Notifications LogEntry
-> Const [LogEntry] (Notifications LogEntry)
forall a1 a2 (f :: * -> *).
Functor f =>
([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
notificationsContent
  dial :: Dialog a Name
dial = Maybe (Widget Name)
-> Maybe (Name, [(String, Name, a)]) -> Int -> Dialog a Name
forall n a.
Eq n =>
Maybe (Widget n)
-> Maybe (n, [(String, n, a)]) -> Int -> Dialog a n
dialog (Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
Just (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
forall n. String -> Widget n
str String
"Messages") Maybe (Name, [(String, Name, a)])
forall a. Maybe a
Nothing Int
maxModalWindowWidth
  scrollList :: [Widget n] -> Widget n
scrollList = VScrollBarOrientation -> Widget n -> Widget n
forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight (Widget n -> Widget n)
-> ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox
  drawLogs :: [LogEntry] -> [Widget a]
drawLogs = (LogEntry -> Widget a) -> [LogEntry] -> [Widget a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LogEntry -> Widget a
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 =
  [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> ([Maybe (Widget Name)] -> [Widget Name])
-> [Maybe (Widget Name)]
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Widget Name)] -> [Widget Name]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Widget Name)] -> Widget Name)
-> [Maybe (Widget Name)] -> Widget Name
forall a b. (a -> b) -> a -> b
$
    [ Text -> Widget Name
drawLogo (Text -> Widget Name) -> Maybe Text -> Maybe (Widget Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
logo
    , Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTopBottom Int
2 (Widget Name -> Widget Name)
-> Maybe (Widget Name) -> Maybe (Widget Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (Severity, Text) String -> Maybe (Widget Name)
forall n. Either (Severity, Text) String -> Maybe (Widget n)
newVersionWidget Either (Severity, Text) String
version
    , Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
Just (Widget Name -> Maybe (Widget Name))
-> (Widget Name -> Widget Name)
-> Widget Name
-> Maybe (Widget Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
6 (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
20 (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$
        (Bool -> MainMenuEntry -> Widget Name)
-> Bool -> List Name MainMenuEntry -> Widget Name
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 ((MainMenuEntry -> Widget Name)
-> Bool -> MainMenuEntry -> Widget Name
forall a b. a -> b -> a
const (Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> (MainMenuEntry -> Widget Name) -> MainMenuEntry -> Widget Name
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 AppState
-> Getting (Maybe Text) AppState (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. (RuntimeState -> Const (Maybe Text) RuntimeState)
-> AppState -> Const (Maybe Text) AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Const (Maybe Text) RuntimeState)
 -> AppState -> Const (Maybe Text) AppState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> RuntimeState -> Const (Maybe Text) RuntimeState)
-> Getting (Maybe Text) AppState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text Text -> Const (Maybe Text) (Map Text Text))
-> RuntimeState -> Const (Maybe Text) RuntimeState
Lens' RuntimeState (Map Text Text)
appData ((Map Text Text -> Const (Maybe Text) (Map Text Text))
 -> RuntimeState -> Const (Maybe Text) RuntimeState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> Map Text Text -> Const (Maybe Text) (Map Text Text))
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> RuntimeState
-> Const (Maybe Text) RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Text Text)
-> Lens' (Map Text Text) (Maybe (IxValue (Map Text Text)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text Text)
"logo"
  version :: Either (Severity, Text) String
version = AppState
s AppState
-> Getting
     (Either (Severity, Text) String)
     AppState
     (Either (Severity, Text) String)
-> Either (Severity, Text) String
forall s a. s -> Getting a s a -> a
^. (RuntimeState
 -> Const (Either (Severity, Text) String) RuntimeState)
-> AppState -> Const (Either (Severity, Text) String) AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState
  -> Const (Either (Severity, Text) String) RuntimeState)
 -> AppState -> Const (Either (Severity, Text) String) AppState)
-> ((Either (Severity, Text) String
     -> Const
          (Either (Severity, Text) String) (Either (Severity, Text) String))
    -> RuntimeState
    -> Const (Either (Severity, Text) String) RuntimeState)
-> Getting
     (Either (Severity, Text) String)
     AppState
     (Either (Severity, Text) String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Severity, Text) String
 -> Const
      (Either (Severity, Text) String) (Either (Severity, Text) String))
-> RuntimeState
-> Const (Either (Severity, Text) String) RuntimeState
Lens' RuntimeState (Either (Severity, Text) String)
upstreamRelease

newVersionWidget :: Either (Severity, Text) String -> Maybe (Widget n)
newVersionWidget :: forall n. Either (Severity, Text) String -> Maybe (Widget n)
newVersionWidget = \case
  Right String
ver -> Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n))
-> (Text -> Widget n) -> Text -> Maybe (Widget n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Maybe (Widget n)) -> Text -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ Text
"New version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
ver Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is available!"
  Left (Severity, Text)
_ -> Maybe (Widget n)
forall a. Maybe a
Nothing

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

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

  drawScenarioItem :: ScenarioItem ScenarioPath -> Widget n
drawScenarioItem (SISingle (ScenarioWith Scenario
s (ScenarioPath String
sPath))) = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Scenario -> String -> Widget n
forall {n}. Scenario -> String -> Widget n
drawStatusInfo Scenario
s String
sPath) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt (Scenario
s Scenario -> Getting Text Scenario Text -> Text
forall s a. s -> Getting a s a -> a
^. (ScenarioMetadata -> Const Text ScenarioMetadata)
-> Scenario -> Const Text Scenario
Lens' Scenario ScenarioMetadata
scenarioMetadata ((ScenarioMetadata -> Const Text ScenarioMetadata)
 -> Scenario -> Const Text Scenario)
-> ((Text -> Const Text Text)
    -> ScenarioMetadata -> Const Text ScenarioMetadata)
-> Getting Text Scenario Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> ScenarioMetadata -> Const Text ScenarioMetadata
Lens' ScenarioMetadata Text
scenarioName)
  drawScenarioItem (SICollection Text
nm ScenarioCollection ScenarioPath
_) = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
" > ") Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt Text
nm

  drawStatusInfo :: Scenario -> String -> Widget n
drawStatusInfo Scenario
s String
sPath = case Maybe ScenarioInfo
currentScenarioInfo of
    Maybe ScenarioInfo
Nothing -> Widget n
forall {n}. Widget n
emptyWidget
    Just ScenarioInfo
si -> case ScenarioInfo
si ScenarioInfo
-> Getting ScenarioStatus ScenarioInfo ScenarioStatus
-> ScenarioStatus
forall s a. s -> Getting a s a -> a
^. Getting ScenarioStatus ScenarioInfo ScenarioStatus
Lens' ScenarioInfo ScenarioStatus
scenarioStatus of
      ScenarioStatus
NotStarted -> Text -> Widget n
forall n. Text -> Widget n
txt Text
" ○ "
      Played SerializableLaunchParams
_script ProgressMetric
_latestMetric BestRecords
best | BestRecords -> Bool
isCompleted BestRecords
best -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
" ● "
      Played {} -> case Scenario
s Scenario -> Getting [Objective] Scenario [Objective] -> [Objective]
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const [Objective] ScenarioOperation)
-> Scenario -> Const [Objective] Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const [Objective] ScenarioOperation)
 -> Scenario -> Const [Objective] Scenario)
-> (([Objective] -> Const [Objective] [Objective])
    -> ScenarioOperation -> Const [Objective] ScenarioOperation)
-> Getting [Objective] Scenario [Objective]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Const [Objective] [Objective])
-> ScenarioOperation -> Const [Objective] ScenarioOperation
Lens' ScenarioOperation [Objective]
scenarioObjectives of
        [] -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
" ◉ "
        [Objective]
_ -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
" ◎ "
   where
    currentScenarioInfo :: Maybe ScenarioInfo
currentScenarioInfo = AppState
appState AppState
-> Getting (First ScenarioInfo) AppState ScenarioInfo
-> Maybe ScenarioInfo
forall s a. s -> Getting (First a) s a -> Maybe a
^? (PlayState -> Const (First ScenarioInfo) PlayState)
-> AppState -> Const (First ScenarioInfo) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (First ScenarioInfo) PlayState)
 -> AppState -> Const (First ScenarioInfo) AppState)
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> PlayState -> Const (First ScenarioInfo) PlayState)
-> Getting (First ScenarioInfo) AppState ScenarioInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> Const (First ScenarioInfo) ProgressionState)
-> PlayState -> Const (First ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> Const (First ScenarioInfo) ProgressionState)
 -> PlayState -> Const (First ScenarioInfo) PlayState)
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ProgressionState -> Const (First ScenarioInfo) ProgressionState)
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> PlayState
-> Const (First ScenarioInfo) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
-> ProgressionState -> Const (First ScenarioInfo) ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios ((ScenarioCollection ScenarioInfo
  -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
 -> ProgressionState -> Const (First ScenarioInfo) ProgressionState)
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ScenarioCollection ScenarioInfo
    -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ProgressionState
-> Const (First ScenarioInfo) ProgressionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Traversal'
     (ScenarioCollection ScenarioInfo) (ScenarioItem ScenarioInfo)
forall a.
String -> Traversal' (ScenarioCollection a) (ScenarioItem a)
scenarioItemByPath String
sPath ((ScenarioItem ScenarioInfo
  -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
 -> ScenarioCollection ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ScenarioItem ScenarioInfo
    -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ScenarioCollection ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioWith ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
-> ScenarioItem ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo)
forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ScenarioWith a) (f (ScenarioWith a))
-> p (ScenarioItem a) (f (ScenarioItem a))
_SISingle ((ScenarioWith ScenarioInfo
  -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
 -> ScenarioItem ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ScenarioWith ScenarioInfo
    -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ScenarioItem ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ScenarioWith ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ScenarioWith a1 -> f (ScenarioWith a2)
getScenarioInfo

  isCompleted :: BestRecords -> Bool
  isCompleted :: BestRecords -> Bool
isCompleted BestRecords
best = BestRecords
best BestRecords -> Getting Progress BestRecords Progress -> Progress
forall s a. s -> Getting a s a -> a
^. (ProgressMetric -> Const Progress ProgressMetric)
-> BestRecords -> Const Progress BestRecords
Lens' BestRecords ProgressMetric
scenarioBestByTime ((ProgressMetric -> Const Progress ProgressMetric)
 -> BestRecords -> Const Progress BestRecords)
-> ((Progress -> Const Progress Progress)
    -> ProgressMetric -> Const Progress ProgressMetric)
-> Getting Progress BestRecords Progress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Progress -> Const Progress Progress)
-> ProgressMetric -> Const Progress ProgressMetric
forall a (f :: * -> *).
Functor f =>
(Progress -> f Progress) -> Metric a -> f (Metric a)
metricProgress Progress -> Progress -> Bool
forall a. Eq a => a -> a -> Bool
== Progress
Completed

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

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

  drawDescription :: ScenarioItem ScenarioPath -> Widget Name
  drawDescription :: ScenarioItem ScenarioPath -> Widget Name
drawDescription (SICollection Text
_ ScenarioCollection ScenarioPath
_) = Text -> Widget Name
forall n. Text -> Widget n
txtWrap Text
" "
  drawDescription (SISingle (ScenarioWith Scenario
s (ScenarioPath String
sPath))) =
    [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
      [ Document Syntax -> Widget Name
drawMarkdown (Document Syntax -> Document Syntax
forall {a}. (Eq a, IsString a) => a -> a
nonBlank (Scenario
s Scenario
-> Getting (Document Syntax) Scenario (Document Syntax)
-> Document Syntax
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
-> Scenario -> Const (Document Syntax) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
 -> Scenario -> Const (Document Syntax) Scenario)
-> ((Document Syntax -> Const (Document Syntax) (Document Syntax))
    -> ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
-> Getting (Document Syntax) Scenario (Document Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Document Syntax -> Const (Document Syntax) (Document Syntax))
-> ScenarioOperation -> Const (Document Syntax) ScenarioOperation
Lens' ScenarioOperation (Document Syntax)
scenarioDescription))
      , Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
cached (String -> Name
ScenarioPreview String
sPath) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
          Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
6 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
60 Widget Name
forall {n}. Widget n
worldPeek
      , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) Widget Name
forall {n}. Widget n
table
      ]
   where
    vc :: Cosmic Location
vc = ScenarioLandscape
-> NonEmpty SubworldDescription -> Cosmic Location
determineStaticViewCenter (Scenario
s Scenario
-> Getting ScenarioLandscape Scenario ScenarioLandscape
-> ScenarioLandscape
forall s a. s -> Getting a s a -> a
^. Getting ScenarioLandscape Scenario ScenarioLandscape
Lens' Scenario ScenarioLandscape
scenarioLandscape) NonEmpty SubworldDescription
worldTuples

    currentScenarioInfo :: Maybe ScenarioInfo
currentScenarioInfo = AppState
appState AppState
-> Getting (First ScenarioInfo) AppState ScenarioInfo
-> Maybe ScenarioInfo
forall s a. s -> Getting (First a) s a -> Maybe a
^? (PlayState -> Const (First ScenarioInfo) PlayState)
-> AppState -> Const (First ScenarioInfo) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (First ScenarioInfo) PlayState)
 -> AppState -> Const (First ScenarioInfo) AppState)
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> PlayState -> Const (First ScenarioInfo) PlayState)
-> Getting (First ScenarioInfo) AppState ScenarioInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> Const (First ScenarioInfo) ProgressionState)
-> PlayState -> Const (First ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> Const (First ScenarioInfo) ProgressionState)
 -> PlayState -> Const (First ScenarioInfo) PlayState)
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ProgressionState -> Const (First ScenarioInfo) ProgressionState)
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> PlayState
-> Const (First ScenarioInfo) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
-> ProgressionState -> Const (First ScenarioInfo) ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios ((ScenarioCollection ScenarioInfo
  -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
 -> ProgressionState -> Const (First ScenarioInfo) ProgressionState)
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ScenarioCollection ScenarioInfo
    -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ProgressionState
-> Const (First ScenarioInfo) ProgressionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Traversal'
     (ScenarioCollection ScenarioInfo) (ScenarioItem ScenarioInfo)
forall a.
String -> Traversal' (ScenarioCollection a) (ScenarioItem a)
scenarioItemByPath String
sPath ((ScenarioItem ScenarioInfo
  -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
 -> ScenarioCollection ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ScenarioItem ScenarioInfo
    -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ScenarioCollection ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioWith ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
-> ScenarioItem ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo)
forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ScenarioWith a) (f (ScenarioWith a))
-> p (ScenarioItem a) (f (ScenarioItem a))
_SISingle ((ScenarioWith ScenarioInfo
  -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
 -> ScenarioItem ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ScenarioWith ScenarioInfo
    -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ScenarioItem ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ScenarioWith ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ScenarioWith a1 -> f (ScenarioWith a2)
getScenarioInfo

    worldTuples :: NonEmpty SubworldDescription
worldTuples = ScenarioLandscape -> NonEmpty SubworldDescription
buildWorldTuples (ScenarioLandscape -> NonEmpty SubworldDescription)
-> ScenarioLandscape -> NonEmpty SubworldDescription
forall a b. (a -> b) -> a -> b
$ Scenario
s Scenario
-> Getting ScenarioLandscape Scenario ScenarioLandscape
-> ScenarioLandscape
forall s a. s -> Getting a s a -> a
^. Getting ScenarioLandscape Scenario ScenarioLandscape
Lens' Scenario ScenarioLandscape
scenarioLandscape
    theWorlds :: MultiWorld Int Entity
theWorlds =
      NonEmpty SubworldDescription -> Int -> MultiWorld Int Entity
genMultiWorld NonEmpty SubworldDescription
worldTuples (Int -> MultiWorld Int Entity) -> Int -> MultiWorld Int Entity
forall a b. (a -> b) -> a -> b
$
        Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
          Scenario
s Scenario -> Getting (Maybe Int) Scenario (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (ScenarioLandscape -> Const (Maybe Int) ScenarioLandscape)
-> Scenario -> Const (Maybe Int) Scenario
Lens' Scenario ScenarioLandscape
scenarioLandscape ((ScenarioLandscape -> Const (Maybe Int) ScenarioLandscape)
 -> Scenario -> Const (Maybe Int) Scenario)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ScenarioLandscape -> Const (Maybe Int) ScenarioLandscape)
-> Getting (Maybe Int) Scenario (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ScenarioLandscape -> Const (Maybe Int) ScenarioLandscape
Lens' ScenarioLandscape (Maybe Int)
scenarioSeed

    entIsKnown :: EntityPaint -> Bool
entIsKnown =
      EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown (EntityKnowledgeDependencies -> EntityPaint -> Bool)
-> EntityKnowledgeDependencies -> EntityPaint -> Bool
forall a b. (a -> b) -> a -> b
$
        EntityKnowledgeDependencies
          { isCreativeMode :: Bool
isCreativeMode = Scenario
s Scenario -> Getting Bool Scenario Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const Bool ScenarioOperation)
-> Scenario -> Const Bool Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const Bool ScenarioOperation)
 -> Scenario -> Const Bool Scenario)
-> ((Bool -> Const Bool Bool)
    -> ScenarioOperation -> Const Bool ScenarioOperation)
-> Getting Bool Scenario Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ScenarioOperation -> Const Bool ScenarioOperation
Lens' ScenarioOperation Bool
scenarioCreative
          , globallyKnownEntities :: Set Text
globallyKnownEntities = Scenario
s Scenario -> Getting (Set Text) Scenario (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^. (ScenarioLandscape -> Const (Set Text) ScenarioLandscape)
-> Scenario -> Const (Set Text) Scenario
Lens' Scenario ScenarioLandscape
scenarioLandscape ((ScenarioLandscape -> Const (Set Text) ScenarioLandscape)
 -> Scenario -> Const (Set Text) Scenario)
-> ((Set Text -> Const (Set Text) (Set Text))
    -> ScenarioLandscape -> Const (Set Text) ScenarioLandscape)
-> Getting (Set Text) Scenario (Set Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text -> Const (Set Text) (Set Text))
-> ScenarioLandscape -> Const (Set Text) ScenarioLandscape
Lens' ScenarioLandscape (Set Text)
scenarioKnown
          , theFocusedRobot :: Maybe Robot
theFocusedRobot = Maybe Robot
forall a. Maybe a
Nothing
          }

    tm :: TerrainMap
tm = Scenario
s Scenario -> Getting TerrainMap Scenario TerrainMap -> TerrainMap
forall s a. s -> Getting a s a -> a
^. (ScenarioLandscape -> Const TerrainMap ScenarioLandscape)
-> Scenario -> Const TerrainMap Scenario
Lens' Scenario ScenarioLandscape
scenarioLandscape ((ScenarioLandscape -> Const TerrainMap ScenarioLandscape)
 -> Scenario -> Const TerrainMap Scenario)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> ScenarioLandscape -> Const TerrainMap ScenarioLandscape)
-> Getting TerrainMap Scenario TerrainMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> ScenarioLandscape -> Const TerrainMap ScenarioLandscape
Lens' ScenarioLandscape TerrainEntityMaps
scenarioTerrainAndEntities ((TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
 -> ScenarioLandscape -> Const TerrainMap ScenarioLandscape)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> (TerrainMap -> Const TerrainMap TerrainMap)
-> ScenarioLandscape
-> Const TerrainMap ScenarioLandscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainMap -> Const TerrainMap TerrainMap)
-> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps
Lens' TerrainEntityMaps TerrainMap
terrainMap
    ri :: RenderingInput
ri = MultiWorld Int Entity
-> (EntityPaint -> Bool) -> TerrainMap -> RenderingInput
RenderingInput MultiWorld Int Entity
theWorlds EntityPaint -> Bool
entIsKnown TerrainMap
tm

    renderCoord :: Cosmic Coords -> Widget n
renderCoord = Display -> Widget n
forall n. Display -> Widget n
renderDisplay (Display -> Widget n)
-> (Cosmic Coords -> Display) -> Cosmic Coords -> Widget n
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 Map Coords (TerrainWith EntityFacade)
forall a. Monoid a => a
mempty) RenderingInput
ri []
    worldPeek :: Widget n
worldPeek = (Cosmic Coords -> Widget n) -> Cosmic Location -> Widget n
forall n.
(Cosmic Coords -> Widget n) -> Cosmic Location -> Widget n
worldWidget Cosmic Coords -> Widget n
forall {n}. Cosmic Coords -> Widget n
renderCoord Cosmic Location
vc

    firstRow :: (Widget n, Maybe (Widget n))
firstRow =
      ( AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dimAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Author:"
      , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dimAttr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Maybe Text -> Maybe (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scenario
s Scenario
-> Getting (Maybe Text) Scenario (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. (ScenarioMetadata -> Const (Maybe Text) ScenarioMetadata)
-> Scenario -> Const (Maybe Text) Scenario
Lens' Scenario ScenarioMetadata
scenarioMetadata ((ScenarioMetadata -> Const (Maybe Text) ScenarioMetadata)
 -> Scenario -> Const (Maybe Text) Scenario)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> ScenarioMetadata -> Const (Maybe Text) ScenarioMetadata)
-> Getting (Maybe Text) Scenario (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ScenarioMetadata -> Const (Maybe Text) ScenarioMetadata
Lens' ScenarioMetadata (Maybe Text)
scenarioAuthor
      )
    secondRow :: (Widget n, Maybe (Widget n))
secondRow =
      ( Text -> Widget n
forall n. Text -> Widget n
txt Text
"last:"
      , Maybe (Widget n)
forall {n}. Maybe (Widget n)
stat
      )
     where
      stat :: Maybe (Widget n)
stat = ScenarioStatus -> Widget n
forall n. ScenarioStatus -> Widget n
describeStatus (ScenarioStatus -> Widget n)
-> (ScenarioInfo -> ScenarioStatus) -> ScenarioInfo -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ScenarioStatus ScenarioInfo ScenarioStatus
-> ScenarioInfo -> ScenarioStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ScenarioStatus ScenarioInfo ScenarioStatus
Lens' ScenarioInfo ScenarioStatus
scenarioStatus (ScenarioInfo -> Widget n)
-> Maybe ScenarioInfo -> Maybe (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScenarioInfo
currentScenarioInfo

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

    tableRows :: [[Widget n]]
tableRows =
      ((Widget n, Widget n) -> [Widget n])
-> [(Widget n, Widget n)] -> [[Widget n]]
forall a b. (a -> b) -> [a] -> [b]
map ((Widget n -> Widget n) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Widget n -> Widget n
forall n. Widget n -> Widget n
padTopLeft ([Widget n] -> [Widget n])
-> ((Widget n, Widget n) -> [Widget n])
-> (Widget n, Widget n)
-> [Widget n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Widget n, Widget n) -> [Widget n]
forall a. (a, a) -> [a]
pairToList) ([(Widget n, Widget n)] -> [[Widget n]])
-> [(Widget n, Widget n)] -> [[Widget n]]
forall a b. (a -> b) -> a -> b
$
        ((Widget n, Maybe (Widget n)) -> Maybe (Widget n, Widget n))
-> [(Widget n, Maybe (Widget n))] -> [(Widget n, Widget n)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Widget n, Maybe (Widget n)) -> Maybe (Widget n, Widget n)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
(Widget n, f a) -> f (Widget n, a)
sequenceA ([(Widget n, Maybe (Widget n))] -> [(Widget n, Widget n)])
-> [(Widget n, Maybe (Widget n))] -> [(Widget n, Widget n)]
forall a b. (a -> b) -> a -> b
$
          (Widget n, Maybe (Widget n))
forall {n} {n}. (Widget n, Maybe (Widget n))
firstRow (Widget n, Maybe (Widget n))
-> [(Widget n, Maybe (Widget n))] -> [(Widget n, Maybe (Widget n))]
forall a. a -> [a] -> [a]
: (Widget n, Maybe (Widget n))
forall {n} {n}. (Widget n, Maybe (Widget n))
secondRow (Widget n, Maybe (Widget n))
-> [(Widget n, Maybe (Widget n))] -> [(Widget n, Maybe (Widget n))]
forall a. a -> [a] -> [a]
: [(Widget n, Maybe (Widget n))]
-> (ScenarioInfo -> [(Widget n, Maybe (Widget n))])
-> Maybe ScenarioInfo
-> [(Widget n, Maybe (Widget n))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (ScenarioStatus -> [(Widget n, Maybe (Widget n))]
forall n1 n2. ScenarioStatus -> [(Widget n1, Maybe (Widget n2))]
makeBestScoreRows (ScenarioStatus -> [(Widget n, Maybe (Widget n))])
-> (ScenarioInfo -> ScenarioStatus)
-> ScenarioInfo
-> [(Widget n, Maybe (Widget n))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ScenarioStatus ScenarioInfo ScenarioStatus
-> ScenarioInfo -> ScenarioStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ScenarioStatus ScenarioInfo ScenarioStatus
Lens' ScenarioInfo ScenarioStatus
scenarioStatus) Maybe ScenarioInfo
currentScenarioInfo
    table :: Widget n
table =
      Table n -> Widget n
forall n. Table n -> Widget n
BT.renderTable
        (Table n -> Widget n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
BT.surroundingBorder Bool
False
        (Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
BT.rowBorders Bool
False
        (Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
BT.columnBorders Bool
False
        (Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Table n -> Table n
forall n. Int -> Table n -> Table n
BT.alignRight Int
0
        (Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Table n -> Table n
forall n. Int -> Table n -> Table n
BT.alignLeft Int
1
        (Table n -> Table n)
-> ([[Widget n]] -> Table n) -> [[Widget n]] -> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Widget n]] -> Table n
forall n. [[Widget n]] -> Table n
BT.table
        ([[Widget n]] -> Widget n) -> [[Widget n]] -> Widget n
forall a b. (a -> b) -> a -> b
$ [[Widget n]]
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. ProgressMetric -> Widget n
describeProgress (Metric Progress
p (ProgressStats ZonedTime
_startedAt (AttemptMetrics (DurationMetrics NominalDiffTime
e TickNumber
t) Maybe ScenarioCodeMetrics
maybeCodeMetrics))) = case Progress
p of
  Progress
Attempted ->
    AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr (Widget n -> Widget n)
-> ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
      [ Text -> Widget n
forall n. Text -> Widget n
txt Text
"in progress"
      , Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Text
parens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"played for", NominalDiffTime -> Text
formatTimeDiff NominalDiffTime
e]
      ]
  Progress
Completed ->
    AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr (Widget n -> Widget n)
-> ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
      [ Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"completed in", NominalDiffTime -> Text
formatTimeDiff NominalDiffTime
e]
      , Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> (Text -> Text) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
parens (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> TickNumber -> String
formatTicks Bool
True TickNumber
t, Text
"ticks"]
      ]
        [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> Maybe (Widget n) -> [Widget n]
forall a. Maybe a -> [a]
maybeToList (ScenarioCodeMetrics -> Widget n
forall {n}. ScenarioCodeMetrics -> Widget n
sizeDisplay (ScenarioCodeMetrics -> Widget n)
-> Maybe ScenarioCodeMetrics -> Maybe (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScenarioCodeMetrics
maybeCodeMetrics)
   where
    sizeDisplay :: ScenarioCodeMetrics -> Widget n
sizeDisplay (ScenarioCodeMetrics Int
myCharCount Int
myAstSize) =
      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
        [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
          (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map
            Text -> Widget n
forall n. Text -> Widget n
txt
            [ [Text] -> Text
T.unwords
                [ Text
"Code:"
                , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
myCharCount
                , Text
"chars"
                ]
            , (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                Text -> Text
parens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
                  [Text] -> Text
T.unwords
                    [ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
myAstSize
                    , Text
"AST nodes"
                    ]
            ]
 where
  formatTimeDiff :: NominalDiffTime -> Text
  formatTimeDiff :: NominalDiffTime -> Text
formatTimeDiff = String -> Text
T.pack (String -> Text)
-> (NominalDiffTime -> String) -> NominalDiffTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> NominalDiffTime -> String
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 =
  [(Widget n1, Maybe (Widget n2))]
-> (BestRecords -> [(Widget n1, Maybe (Widget n2))])
-> Maybe BestRecords
-> [(Widget n1, Maybe (Widget n2))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] BestRecords -> [(Widget n1, Maybe (Widget n2))]
forall {n} {n}. BestRecords -> [(Widget n, Maybe (Widget n))]
makeBestRows Maybe BestRecords
getBests
 where
  getBests :: Maybe BestRecords
getBests = case ScenarioStatus
scenarioStat of
    ScenarioStatus
NotStarted -> Maybe BestRecords
forall a. Maybe a
Nothing
    Played SerializableLaunchParams
_initialScript ProgressMetric
_ BestRecords
best -> BestRecords -> Maybe BestRecords
forall a. a -> Maybe a
Just BestRecords
best

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

  makeBestRow :: Bool
-> (ProgressMetric, NonEmpty BestByCriteria)
-> (Widget n, Maybe (Widget n))
makeBestRow Bool
hasDistinctByCriteria (ProgressMetric
b, NonEmpty BestByCriteria
criteria) =
    ( Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (Int
maxLeftColumnWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
        [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
          [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"best:"
          ]
            [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [Widget n]
forall {n}. [Widget n]
elaboratedCriteria
    , Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ ProgressMetric -> Widget n
forall n. ProgressMetric -> Widget n
describeProgress ProgressMetric
b
    )
   where
    maxLeftColumnWidth :: Int
maxLeftColumnWidth = [Int] -> Int
forall a. (Num a, Ord a) => [a] -> a
maximum0 ((BestByCriteria -> Int) -> [BestByCriteria] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int) -> (BestByCriteria -> Text) -> BestByCriteria -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BestByCriteria -> Text
describeCriteria) [BestByCriteria]
forall a. (Enum a, Bounded a) => [a]
enumerate)
    mkCriteriaRow :: (Text, Int) -> Widget n
mkCriteriaRow =
      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dimAttr
        (Widget n -> Widget n)
-> ((Text, Int) -> Widget n) -> (Text, Int) -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max
        (Widget n -> Widget n)
-> ((Text, Int) -> Widget n) -> (Text, Int) -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt
        (Text -> Widget n)
-> ((Text, Int) -> Text) -> (Text, Int) -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        ([Text] -> Text) -> ((Text, Int) -> [Text]) -> (Text, Int) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> [Text]
forall a. (a, a) -> [a]
pairToList
        ((Text, Text) -> [Text])
-> ((Text, Int) -> (Text, Text)) -> (Text, Int) -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text) -> (Text, Int) -> (Text, Text)
forall a b. (a -> b) -> (Text, a) -> (Text, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Char
',' else Char
' ')
    elaboratedCriteria :: [Widget n]
elaboratedCriteria =
      if Bool
hasDistinctByCriteria
        then
          ((Text, Int) -> Widget n) -> [(Text, Int)] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Int) -> Widget n
forall {n}. (Text, Int) -> Widget n
mkCriteriaRow
            ([(Text, Int)] -> [Widget n])
-> (NonEmpty BestByCriteria -> [(Text, Int)])
-> NonEmpty BestByCriteria
-> [Widget n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [Int] -> [(Text, Int)])
-> [Int] -> [Text] -> [(Text, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Text] -> [Int] -> [(Text, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0 :: Int) ..]
            ([Text] -> [(Text, Int)])
-> (NonEmpty BestByCriteria -> [Text])
-> NonEmpty BestByCriteria
-> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList
            (NonEmpty Text -> [Text])
-> (NonEmpty BestByCriteria -> NonEmpty Text)
-> NonEmpty BestByCriteria
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> NonEmpty Text
forall a. NonEmpty a -> NonEmpty a
NE.reverse
            (NonEmpty Text -> NonEmpty Text)
-> (NonEmpty BestByCriteria -> NonEmpty Text)
-> NonEmpty BestByCriteria
-> NonEmpty Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BestByCriteria -> Text)
-> NonEmpty BestByCriteria -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map BestByCriteria -> Text
describeCriteria
            (NonEmpty BestByCriteria -> [Widget n])
-> NonEmpty BestByCriteria -> [Widget n]
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 -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"New game"
  MainMenuEntry
Tutorial -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Tutorial"
  MainMenuEntry
Achievements -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Achievements"
  MainMenuEntry
About -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"About"
  MainMenuEntry
Messages -> Widget Name -> Widget Name
forall n. Widget n -> Widget n
highlightMessages (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Messages"
  MainMenuEntry
Quit -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Quit"
 where
  highlightMessages :: Widget n -> Widget n
highlightMessages =
    Bool -> (Widget n -> Widget n) -> Widget n -> Widget n
forall a. Bool -> (a -> a) -> a -> a
applyWhen (AppState
s AppState -> Getting Int AppState Int -> Int
forall s a. s -> Getting a s a -> a
^. (RuntimeState -> Const Int RuntimeState)
-> AppState -> Const Int AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Const Int RuntimeState)
 -> AppState -> Const Int AppState)
-> ((Int -> Const Int Int)
    -> RuntimeState -> Const Int RuntimeState)
-> Getting Int AppState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications LogEntry -> Const Int (Notifications LogEntry))
-> RuntimeState -> Const Int RuntimeState
Lens' RuntimeState (Notifications LogEntry)
eventLog ((Notifications LogEntry -> Const Int (Notifications LogEntry))
 -> RuntimeState -> Const Int RuntimeState)
-> ((Int -> Const Int Int)
    -> Notifications LogEntry -> Const Int (Notifications LogEntry))
-> (Int -> Const Int Int)
-> RuntimeState
-> Const Int RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> Notifications LogEntry -> Const Int (Notifications LogEntry)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> Notifications a -> f (Notifications a)
notificationsCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ((Widget n -> Widget n) -> Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr

drawAboutMenuUI :: Maybe Text -> Widget Name
drawAboutMenuUI :: Maybe Text -> Widget Name
drawAboutMenuUI Maybe Text
Nothing = Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"About swarm!"
drawAboutMenuUI (Just Text
t) = Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer (Widget Name -> Widget Name)
-> ([Text] -> Widget Name) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> ([Text] -> [Widget Name]) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Widget Name) -> [Text] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map (Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> (Text -> Text) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall {a}. (Eq a, IsString a) => a -> a
nonblank) ([Text] -> Widget Name) -> [Text] -> Widget Name
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 =
  [ Widget Name -> Widget Name
forall n. Widget n -> Widget n
joinBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ ToplevelConfigurationHelp -> Bool -> ScenarioState -> Widget Name
drawDialog ToplevelConfigurationHelp
h Bool
isNoMenu ScenarioState
ps
  , Widget Name -> Widget Name
forall n. Widget n -> Widget n
joinBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
      [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox
        [ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
25 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
              [ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimitPercent Int
50
                  (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ AttrName
-> FocusRing Name
-> Name
-> BorderLabels Name
-> Widget Name
-> Widget Name
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)
                    ( BorderLabels Name
forall n. BorderLabels n
plainBorder
                        BorderLabels Name
-> (BorderLabels Name -> BorderLabels Name) -> BorderLabels Name
forall a b. a -> (a -> b) -> b
& (HBorderLabels Name -> Identity (HBorderLabels Name))
-> BorderLabels Name -> Identity (BorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(HBorderLabels n -> f (HBorderLabels n))
-> BorderLabels n -> f (BorderLabels n)
bottomLabels ((HBorderLabels Name -> Identity (HBorderLabels Name))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
    -> HBorderLabels Name -> Identity (HBorderLabels Name))
-> (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> BorderLabels Name
-> Identity (BorderLabels Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> HBorderLabels Name -> Identity (HBorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(Maybe (Widget n) -> f (Maybe (Widget n)))
-> HBorderLabels n -> f (HBorderLabels n)
centerLabel
                          ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> Maybe (Widget Name) -> BorderLabels Name -> BorderLabels Name
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Text -> Widget Name) -> Maybe Text -> Maybe (Widget Name)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                            (Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> (Text -> Text) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" Search: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "))
                            (UIGameplay
uig UIGameplay
-> Getting (Maybe Text) UIGameplay (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. (UIInventory -> Const (Maybe Text) UIInventory)
-> UIGameplay -> Const (Maybe Text) UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Const (Maybe Text) UIInventory)
 -> UIGameplay -> Const (Maybe Text) UIGameplay)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIInventory -> Const (Maybe Text) UIInventory)
-> Getting (Maybe Text) UIGameplay (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIInventory -> Const (Maybe Text) UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch)
                    )
                  (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ ScenarioState -> Widget Name
drawRobotPanel ScenarioState
ps
              , AttrName
-> FocusRing Name
-> Name
-> BorderLabels Name
-> Widget Name
-> Widget Name
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)
                  BorderLabels Name
forall n. BorderLabels n
plainBorder
                  (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ ScenarioState -> Widget Name
drawInfoPanel ScenarioState
ps
              , Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter
                  (Widget Name -> Widget Name)
-> (UIGameplay -> Widget Name) -> UIGameplay -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
WorldEditorPanel)
                  (Widget Name -> Widget Name)
-> (UIGameplay -> Widget Name) -> UIGameplay -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusRing Name -> UIGameplay -> Widget Name
EV.drawWorldEditor FocusRing Name
fr
                  (UIGameplay -> Widget Name) -> UIGameplay -> Widget Name
forall a b. (a -> b) -> a -> b
$ UIGameplay
uig
              ]
        , [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox [Widget Name]
rightPanel
        ]
  ]
 where
  debugOpts :: Set DebugOption
debugOpts = AppState
s AppState
-> Getting (Set DebugOption) AppState (Set DebugOption)
-> Set DebugOption
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Set DebugOption) UIState)
-> AppState -> Const (Set DebugOption) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Set DebugOption) UIState)
 -> AppState -> Const (Set DebugOption) AppState)
-> ((Set DebugOption -> Const (Set DebugOption) (Set DebugOption))
    -> UIState -> Const (Set DebugOption) UIState)
-> Getting (Set DebugOption) AppState (Set DebugOption)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set DebugOption -> Const (Set DebugOption) (Set DebugOption))
-> UIState -> Const (Set DebugOption) UIState
Lens' UIState (Set DebugOption)
uiDebugOptions
  keyConf :: KeyConfig SwarmEvent
keyConf = AppState
s AppState
-> Getting (KeyConfig SwarmEvent) AppState (KeyConfig SwarmEvent)
-> KeyConfig SwarmEvent
forall s a. s -> Getting a s a -> a
^. (KeyEventHandlingState
 -> Const (KeyConfig SwarmEvent) KeyEventHandlingState)
-> AppState -> Const (KeyConfig SwarmEvent) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const (KeyConfig SwarmEvent) KeyEventHandlingState)
 -> AppState -> Const (KeyConfig SwarmEvent) AppState)
-> ((KeyConfig SwarmEvent
     -> Const (KeyConfig SwarmEvent) (KeyConfig SwarmEvent))
    -> KeyEventHandlingState
    -> Const (KeyConfig SwarmEvent) KeyEventHandlingState)
-> Getting (KeyConfig SwarmEvent) AppState (KeyConfig SwarmEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyConfig SwarmEvent
 -> Const (KeyConfig SwarmEvent) (KeyConfig SwarmEvent))
-> KeyEventHandlingState
-> Const (KeyConfig SwarmEvent) KeyEventHandlingState
Lens' KeyEventHandlingState (KeyConfig SwarmEvent)
keyConfig
  ps :: ScenarioState
ps = AppState
s AppState
-> Getting ScenarioState AppState ScenarioState -> ScenarioState
forall s a. s -> Getting a s a -> a
^. (PlayState -> Const ScenarioState PlayState)
-> AppState -> Const ScenarioState AppState
Lens' AppState PlayState
playState ((PlayState -> Const ScenarioState PlayState)
 -> AppState -> Const ScenarioState AppState)
-> ((ScenarioState -> Const ScenarioState ScenarioState)
    -> PlayState -> Const ScenarioState PlayState)
-> Getting ScenarioState AppState ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const ScenarioState ScenarioState)
-> PlayState -> Const ScenarioState PlayState
Lens' PlayState ScenarioState
scenarioState
  gs :: GameState
gs = ScenarioState
ps ScenarioState
-> Getting GameState ScenarioState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState ScenarioState GameState
Lens' ScenarioState GameState
gameState
  uig :: UIGameplay
uig = ScenarioState
ps ScenarioState
-> Getting UIGameplay ScenarioState UIGameplay -> UIGameplay
forall s a. s -> Getting a s a -> a
^. Getting UIGameplay ScenarioState UIGameplay
Lens' ScenarioState UIGameplay
uiGameplay

  h :: ToplevelConfigurationHelp
h =
    Maybe Int -> KeyConfig SwarmEvent -> ToplevelConfigurationHelp
ToplevelConfigurationHelp
      (AppState
s AppState -> Getting (Maybe Int) AppState (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (RuntimeState -> Const (Maybe Int) RuntimeState)
-> AppState -> Const (Maybe Int) AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Const (Maybe Int) RuntimeState)
 -> AppState -> Const (Maybe Int) AppState)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> RuntimeState -> Const (Maybe Int) RuntimeState)
-> Getting (Maybe Int) AppState (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> RuntimeState -> Const (Maybe Int) RuntimeState
Lens' RuntimeState (Maybe Int)
webPort)
      KeyConfig SwarmEvent
keyConf

  isNoMenu :: Bool
isNoMenu = case AppState
s AppState -> Getting Menu AppState Menu -> Menu
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Menu UIState) -> AppState -> Const Menu AppState
Lens' AppState UIState
uiState ((UIState -> Const Menu UIState)
 -> AppState -> Const Menu AppState)
-> ((Menu -> Const Menu Menu) -> UIState -> Const Menu UIState)
-> Getting Menu AppState Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Const Menu Menu) -> UIState -> Const Menu UIState
Lens' UIState Menu
uiMenu of
    Menu
NoMenu -> Bool
True
    Menu
_ -> Bool
False

  addCursorPos :: BorderLabels Name -> BorderLabels Name
addCursorPos = (HBorderLabels Name -> Identity (HBorderLabels Name))
-> BorderLabels Name -> Identity (BorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(HBorderLabels n -> f (HBorderLabels n))
-> BorderLabels n -> f (BorderLabels n)
bottomLabels ((HBorderLabels Name -> Identity (HBorderLabels Name))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
    -> HBorderLabels Name -> Identity (HBorderLabels Name))
-> (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> BorderLabels Name
-> Identity (BorderLabels Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> HBorderLabels Name -> Identity (HBorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(Maybe (Widget n) -> f (Maybe (Widget n)))
-> HBorderLabels n -> f (HBorderLabels n)
leftLabel ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> Widget Name -> BorderLabels Name -> BorderLabels Name
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 Widget Name
widg
   where
    widg :: Widget Name
widg = case UIGameplay
uig UIGameplay
-> Getting
     (Maybe (Cosmic Coords)) UIGameplay (Maybe (Cosmic Coords))
-> Maybe (Cosmic Coords)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (Cosmic Coords)) UIGameplay (Maybe (Cosmic Coords))
Lens' UIGameplay (Maybe (Cosmic Coords))
uiWorldCursor of
      Maybe (Cosmic Coords)
Nothing -> String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ Cosmic Location -> String
renderCoordsString (Cosmic Location -> String) -> Cosmic Location -> String
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState
-> Getting (Cosmic Location) GameState (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. (Robots -> Const (Cosmic Location) Robots)
-> GameState -> Const (Cosmic Location) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (Cosmic Location) Robots)
 -> GameState -> Const (Cosmic Location) GameState)
-> ((Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
    -> Robots -> Const (Cosmic Location) Robots)
-> Getting (Cosmic Location) GameState (Cosmic Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
-> Robots -> Const (Cosmic Location) Robots
Getter Robots (Cosmic Location)
viewCenter
      Just Cosmic Coords
coord -> Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable Name
WorldPositionIndicator (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ WorldOverdraw -> GameState -> Cosmic Coords -> Widget Name
drawWorldCursorInfo (UIGameplay
uig UIGameplay
-> Getting WorldOverdraw UIGameplay WorldOverdraw -> WorldOverdraw
forall s a. s -> Getting a s a -> a
^. (WorldEditor Name -> Const WorldOverdraw (WorldEditor Name))
-> UIGameplay -> Const WorldOverdraw UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Const WorldOverdraw (WorldEditor Name))
 -> UIGameplay -> Const WorldOverdraw UIGameplay)
-> ((WorldOverdraw -> Const WorldOverdraw WorldOverdraw)
    -> WorldEditor Name -> Const WorldOverdraw (WorldEditor Name))
-> Getting WorldOverdraw UIGameplay WorldOverdraw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldOverdraw -> Const WorldOverdraw WorldOverdraw)
-> WorldEditor Name -> Const WorldOverdraw (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw) GameState
gs 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 = (HBorderLabels n -> Identity (HBorderLabels n))
-> BorderLabels n -> Identity (BorderLabels n)
forall n (f :: * -> *).
Functor f =>
(HBorderLabels n -> f (HBorderLabels n))
-> BorderLabels n -> f (BorderLabels n)
topLabels ((HBorderLabels n -> Identity (HBorderLabels n))
 -> BorderLabels n -> Identity (BorderLabels n))
-> ((Maybe (Widget n) -> Identity (Maybe (Widget n)))
    -> HBorderLabels n -> Identity (HBorderLabels n))
-> (Maybe (Widget n) -> Identity (Maybe (Widget n)))
-> BorderLabels n
-> Identity (BorderLabels n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Widget n) -> Identity (Maybe (Widget n)))
-> HBorderLabels n -> Identity (HBorderLabels n)
forall n (f :: * -> *).
Functor f =>
(Maybe (Widget n) -> f (Maybe (Widget n)))
-> HBorderLabels n -> f (HBorderLabels n)
rightLabel ((Maybe (Widget n) -> Identity (Maybe (Widget n)))
 -> BorderLabels n -> Identity (BorderLabels n))
-> Widget n -> BorderLabels n -> BorderLabels n
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Int -> GameState -> Widget n
forall n. Int -> GameState -> Widget n
drawClockDisplay (UIGameplay
uig UIGameplay -> Getting Int UIGameplay Int -> Int
forall s a. s -> Getting a s a -> a
^. (UITiming -> Const Int UITiming)
-> UIGameplay -> Const Int UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Const Int UITiming)
 -> UIGameplay -> Const Int UIGameplay)
-> ((Int -> Const Int Int) -> UITiming -> Const Int UITiming)
-> Getting Int UIGameplay Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> UITiming -> Const Int UITiming
Lens' UITiming Int
lgTicksPerSecond) GameState
gs)
  fr :: FocusRing Name
fr = UIGameplay
uig UIGameplay
-> Getting (FocusRing Name) UIGameplay (FocusRing Name)
-> FocusRing Name
forall s a. s -> Getting a s a -> a
^. Getting (FocusRing Name) UIGameplay (FocusRing Name)
Lens' UIGameplay (FocusRing Name)
uiFocusRing
  showREPL :: Bool
showREPL = UIGameplay
uig UIGameplay -> Getting Bool UIGameplay Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UIGameplay Bool
Lens' UIGameplay Bool
uiShowREPL
  rightPanelBottom :: [Widget Name]
rightPanelBottom = if Bool
showREPL then [Widget Name]
replPanel else [Widget Name]
minimizedREPL
  rightPanel :: [Widget Name]
rightPanel = [Widget Name]
worldPanel [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name]
rightPanelBottom
  minimizedREPL :: [Widget Name]
minimizedREPL = case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fr of
    (Just (FocusablePanel FocusablePanel
REPLPanel)) -> [Widget Name -> Widget Name
forall n. Widget n -> Widget n
separateBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel) (AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
highlightAttr Widget Name
forall {n}. Widget n
hBorder)]
    Maybe Name
_ -> [Widget Name -> Widget Name
forall n. Widget n -> Widget n
separateBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel) Widget Name
forall {n}. Widget n
hBorder]
  worldPanel :: [Widget Name]
worldPanel =
    [ AttrName
-> FocusRing Name
-> Name
-> BorderLabels Name
-> Widget Name
-> Widget Name
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)
        ( BorderLabels Name
forall n. BorderLabels n
plainBorder
            BorderLabels Name
-> (BorderLabels Name -> BorderLabels Name) -> BorderLabels Name
forall a b. a -> (a -> b) -> b
& (HBorderLabels Name -> Identity (HBorderLabels Name))
-> BorderLabels Name -> Identity (BorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(HBorderLabels n -> f (HBorderLabels n))
-> BorderLabels n -> f (BorderLabels n)
bottomLabels ((HBorderLabels Name -> Identity (HBorderLabels Name))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
    -> HBorderLabels Name -> Identity (HBorderLabels Name))
-> (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> BorderLabels Name
-> Identity (BorderLabels Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> HBorderLabels Name -> Identity (HBorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(Maybe (Widget n) -> f (Maybe (Widget n)))
-> HBorderLabels n -> f (HBorderLabels n)
rightLabel ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> Widget Name -> BorderLabels Name -> BorderLabels Name
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (UITiming -> Widget Name
drawTPS (UITiming -> Widget Name) -> UITiming -> Widget Name
forall a b. (a -> b) -> a -> b
$ UIGameplay
uig UIGameplay -> Getting UITiming UIGameplay UITiming -> UITiming
forall s a. s -> Getting a s a -> a
^. Getting UITiming UIGameplay UITiming
Lens' UIGameplay UITiming
uiTiming)
            BorderLabels Name
-> (BorderLabels Name -> BorderLabels Name) -> BorderLabels Name
forall a b. a -> (a -> b) -> b
& (HBorderLabels Name -> Identity (HBorderLabels Name))
-> BorderLabels Name -> Identity (BorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(HBorderLabels n -> f (HBorderLabels n))
-> BorderLabels n -> f (BorderLabels n)
topLabels ((HBorderLabels Name -> Identity (HBorderLabels Name))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
    -> HBorderLabels Name -> Identity (HBorderLabels Name))
-> (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> BorderLabels Name
-> Identity (BorderLabels Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> HBorderLabels Name -> Identity (HBorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(Maybe (Widget n) -> f (Maybe (Widget n)))
-> HBorderLabels n -> f (HBorderLabels n)
leftLabel ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> Widget Name -> BorderLabels Name -> BorderLabels Name
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ GameState -> KeyConfig SwarmEvent -> Widget Name
drawModalMenu GameState
gs KeyConfig SwarmEvent
keyConf
            BorderLabels Name
-> (BorderLabels Name -> BorderLabels Name) -> BorderLabels Name
forall a b. a -> (a -> b) -> b
& BorderLabels Name -> BorderLabels Name
addCursorPos
            BorderLabels Name
-> (BorderLabels Name -> BorderLabels Name) -> BorderLabels Name
forall a b. a -> (a -> b) -> b
& BorderLabels Name -> BorderLabels Name
forall {n}. BorderLabels n -> BorderLabels n
addClock
        )
        (UIGameplay -> GameState -> Widget Name
drawWorldPane UIGameplay
uig GameState
gs)
    , ScenarioState
-> KeyConfig SwarmEvent -> Set DebugOption -> Widget Name
drawKeyMenu ScenarioState
ps KeyConfig SwarmEvent
keyConf Set DebugOption
debugOpts
    ]
  replPanel :: [Widget Name]
replPanel =
    [ Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        AttrName
-> FocusRing Name
-> Name
-> BorderLabels Name
-> Widget Name
-> Widget Name
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)
          ( BorderLabels Name
forall n. BorderLabels n
plainBorder
              BorderLabels Name
-> (BorderLabels Name -> BorderLabels Name) -> BorderLabels Name
forall a b. a -> (a -> b) -> b
& (HBorderLabels Name -> Identity (HBorderLabels Name))
-> BorderLabels Name -> Identity (BorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(HBorderLabels n -> f (HBorderLabels n))
-> BorderLabels n -> f (BorderLabels n)
topLabels ((HBorderLabels Name -> Identity (HBorderLabels Name))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
    -> HBorderLabels Name -> Identity (HBorderLabels Name))
-> (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> BorderLabels Name
-> Identity (BorderLabels Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
-> HBorderLabels Name -> Identity (HBorderLabels Name)
forall n (f :: * -> *).
Functor f =>
(Maybe (Widget n) -> f (Maybe (Widget n)))
-> HBorderLabels n -> f (HBorderLabels n)
rightLabel ((Maybe (Widget Name) -> Identity (Maybe (Widget Name)))
 -> BorderLabels Name -> Identity (BorderLabels Name))
-> Maybe (Widget Name) -> BorderLabels Name -> BorderLabels Name
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Polytype -> Widget Name
drawType (Polytype -> Widget Name) -> Maybe Polytype -> Maybe (Widget Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UIGameplay
uig UIGameplay
-> Getting (Maybe Polytype) UIGameplay (Maybe Polytype)
-> Maybe Polytype
forall s a. s -> Getting a s a -> a
^. (REPLState -> Const (Maybe Polytype) REPLState)
-> UIGameplay -> Const (Maybe Polytype) UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const (Maybe Polytype) REPLState)
 -> UIGameplay -> Const (Maybe Polytype) UIGameplay)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> REPLState -> Const (Maybe Polytype) REPLState)
-> Getting (Maybe Polytype) UIGameplay (Maybe Polytype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> REPLState -> Const (Maybe Polytype) REPLState
Lens' REPLState (Maybe Polytype)
replType))
          )
          ( Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
replHeight
              (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max
              (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1)
              (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ ScenarioState -> Widget Name
drawREPL ScenarioState
ps
          )
    ]

drawWorldCursorInfo :: WorldOverdraw -> GameState -> Cosmic 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 -> Display -> Widget Name
forall n. Display -> Widget n
renderDisplay (Display -> Widget Name) -> Display -> Widget Name
forall a b. (a -> b) -> a -> b
$ Word32 -> Display
displayStatic Word32
s
    Maybe Word32
Nothing -> [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name]
forall {n}. [Widget n]
tileMemberWidgets [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name
forall {n}. Widget n
coordsWidget]
 where
  Cosmic SubworldName
_ Coords
coords = Cosmic Coords
cCoords
  coordsWidget :: Widget n
coordsWidget = String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ Cosmic Location -> String
renderCoordsString (Cosmic Location -> String) -> Cosmic Location -> String
forall a b. (a -> b) -> a -> b
$ (Coords -> Location) -> Cosmic Coords -> Cosmic Location
forall a b. (a -> b) -> Cosmic a -> Cosmic b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Coords -> Location
coordsToLoc Cosmic Coords
cCoords

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

  ri :: RenderingInput
ri =
    MultiWorld Int Entity
-> (EntityPaint -> Bool) -> TerrainMap -> RenderingInput
RenderingInput
      (GameState
g GameState
-> Getting
     (MultiWorld Int Entity) GameState (MultiWorld Int Entity)
-> MultiWorld Int Entity
forall s a. s -> Getting a s a -> a
^. (Landscape -> Const (MultiWorld Int Entity) Landscape)
-> GameState -> Const (MultiWorld Int Entity) GameState
Lens' GameState Landscape
landscape ((Landscape -> Const (MultiWorld Int Entity) Landscape)
 -> GameState -> Const (MultiWorld Int Entity) GameState)
-> ((MultiWorld Int Entity
     -> Const (MultiWorld Int Entity) (MultiWorld Int Entity))
    -> Landscape -> Const (MultiWorld Int Entity) Landscape)
-> Getting
     (MultiWorld Int Entity) GameState (MultiWorld Int Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiWorld Int Entity
 -> Const (MultiWorld Int Entity) (MultiWorld Int Entity))
-> Landscape -> Const (MultiWorld Int Entity) Landscape
Lens' Landscape (MultiWorld Int Entity)
multiWorld)
      (EntityKnowledgeDependencies -> EntityPaint -> Bool
getEntityIsKnown (EntityKnowledgeDependencies -> EntityPaint -> Bool)
-> EntityKnowledgeDependencies -> EntityPaint -> Bool
forall a b. (a -> b) -> a -> b
$ GameState -> EntityKnowledgeDependencies
mkEntityKnowledge GameState
g)
      (GameState
g GameState -> Getting TerrainMap GameState TerrainMap -> TerrainMap
forall s a. s -> Getting a s a -> a
^. (Landscape -> Const TerrainMap Landscape)
-> GameState -> Const TerrainMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const TerrainMap Landscape)
 -> GameState -> Const TerrainMap GameState)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> Landscape -> Const TerrainMap Landscape)
-> Getting TerrainMap GameState TerrainMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> Landscape -> Const TerrainMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
 -> Landscape -> Const TerrainMap Landscape)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> (TerrainMap -> Const TerrainMap TerrainMap)
-> Landscape
-> Const TerrainMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainMap -> Const TerrainMap TerrainMap)
-> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps
Lens' TerrainEntityMaps TerrainMap
terrainMap)

  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
  r :: [Display]
r = GameState -> Cosmic Coords -> [Display]
displayRobotCell GameState
g Cosmic Coords
cCoords

  merge :: [Display] -> Maybe Display
merge = (NonEmpty Display -> Display)
-> Maybe (NonEmpty Display) -> Maybe Display
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Display -> Display
forall a. Semigroup a => NonEmpty a -> a
sconcat (Maybe (NonEmpty Display) -> Maybe Display)
-> ([Display] -> Maybe (NonEmpty Display))
-> [Display]
-> Maybe Display
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Display] -> Maybe (NonEmpty Display)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Display] -> Maybe (NonEmpty Display))
-> ([Display] -> [Display])
-> [Display]
-> Maybe (NonEmpty Display)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Display -> Bool) -> [Display] -> [Display]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Display -> Bool) -> Display -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Display -> Getting Bool Display Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Display Bool
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. Int -> GameState -> Widget n
drawClockDisplay Int
lgTPS GameState
gs = [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n)
-> ([Widget n] -> [Widget n]) -> [Widget n] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget n
forall n. Text -> Widget n
txt Text
" ") ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ [Maybe (Widget n)] -> [Widget n]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Widget n)
forall {n}. Maybe (Widget n)
clockWidget, Maybe (Widget n)
forall {n}. Maybe (Widget n)
pauseWidget]
 where
  clockWidget :: Maybe (Widget n)
clockWidget = TickNumber -> Bool -> GameState -> Maybe (Widget n)
forall n. TickNumber -> Bool -> GameState -> Maybe (Widget n)
maybeDrawTime (GameState
gs GameState -> Getting TickNumber GameState TickNumber -> TickNumber
forall s a. s -> Getting a s a -> a
^. (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> Getting TickNumber GameState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks) (GameState
gs GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (TemporalState -> Const Bool TemporalState)
-> GameState -> Const Bool GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const Bool TemporalState)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> TemporalState -> Const Bool TemporalState)
-> Getting Bool GameState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> TemporalState -> Const Bool TemporalState
Getter TemporalState Bool
paused Bool -> Bool -> Bool
|| Int
lgTPS Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3) GameState
gs
  pauseWidget :: Maybe (Widget n)
pauseWidget = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GameState
gs GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (TemporalState -> Const Bool TemporalState)
-> GameState -> Const Bool GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const Bool TemporalState)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> TemporalState -> Const Bool TemporalState)
-> Getting Bool GameState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> TemporalState -> Const Bool TemporalState
Getter TemporalState Bool
paused) Maybe () -> Widget n -> Maybe (Widget n)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text -> Widget n
forall n. Text -> Widget n
txt Text
"(PAUSED)"

-- | Check whether the currently focused robot (if any) has some kind
-- of 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 -> Const -> Capability
CExecute Const
Time Capability -> Set Capability -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Capabilities (NonEmpty (DeviceUseCost Entity Text))
-> Set Capability
forall e. Capabilities e -> Set Capability
getCapabilitySet (Robot
r Robot
-> Getting
     (Capabilities (NonEmpty (DeviceUseCost Entity Text)))
     Robot
     (Capabilities (NonEmpty (DeviceUseCost Entity Text)))
-> Capabilities (NonEmpty (DeviceUseCost Entity Text))
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (NonEmpty (DeviceUseCost Entity Text)))
  Robot
  (Capabilities (NonEmpty (DeviceUseCost Entity Text)))
Getter Robot (Capabilities (NonEmpty (DeviceUseCost Entity Text)))
robotCapabilities)

-- | 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 = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GameState -> Bool
clockEquipped GameState
gs) Maybe () -> Widget n -> Maybe (Widget n)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String -> Widget n
forall n. String -> Widget n
str (Bool -> TickNumber -> String
formatTicks Bool
showTicks TickNumber
t)

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

  rateInfo :: [Widget n]
rateInfo
    | UITiming
timing UITiming -> Getting Bool UITiming Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UITiming Bool
Lens' UITiming Bool
uiShowFPS =
        [ Text -> Widget n
forall n. Text -> Widget n
txt Text
" ("
        , let tpf :: Double
tpf = UITiming
timing UITiming -> Getting Double UITiming Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double UITiming Double
Lens' UITiming Double
uiTPF
           in Bool -> (Widget n -> Widget n) -> Widget n -> Widget n
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Double
tpf Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ticksPerFrameCap) (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                String -> Widget n
forall n. String -> Widget n
str (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%0.1f" Double
tpf)
        , Text -> Widget n
forall n. Text -> Widget n
txt Text
" tpf, "
        , String -> Widget n
forall n. String -> Widget n
str (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%0.1f" (UITiming
timing UITiming -> Getting Double UITiming Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double UITiming Double
Lens' UITiming Double
uiFPS))
        , Text -> Widget n
forall n. Text -> Widget n
txt Text
" fps)"
        ]
    | Bool
otherwise = []

  l :: Int
l = UITiming
timing UITiming
-> ((Int -> Const Int Int) -> UITiming -> Const Int UITiming)
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int) -> UITiming -> Const Int UITiming
Lens' UITiming Int
lgTicksPerSecond
  n :: Int
n = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Int
forall a. Num a => a -> a
abs Int
l

-- | The height of the REPL box.  Perhaps in the future this should be
--   configurable.
replHeight :: Int
replHeight :: Int
replHeight = Int
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 = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Maybe Modal -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe Modal
m
  AppState -> [CursorLocation n] -> Maybe (CursorLocation n)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor AppState
s [CursorLocation n]
locs
 where
  m :: Maybe Modal
m = AppState
s AppState
-> Getting (Maybe Modal) AppState (Maybe Modal) -> Maybe Modal
forall s a. s -> Getting a s a -> a
^. (PlayState -> Const (Maybe Modal) PlayState)
-> AppState -> Const (Maybe Modal) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (Maybe Modal) PlayState)
 -> AppState -> Const (Maybe Modal) AppState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> PlayState -> Const (Maybe Modal) PlayState)
-> Getting (Maybe Modal) AppState (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const (Maybe Modal) ScenarioState)
-> PlayState -> Const (Maybe Modal) PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const (Maybe Modal) ScenarioState)
 -> PlayState -> Const (Maybe Modal) PlayState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> PlayState
-> Const (Maybe Modal) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ScenarioState -> Const (Maybe Modal) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> ScenarioState
-> Const (Maybe Modal) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (Maybe Modal) UIDialogs)
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (Maybe Modal) UIDialogs)
 -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIDialogs -> Const (Maybe Modal) UIDialogs)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay
-> Const (Maybe Modal) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIDialogs -> Const (Maybe Modal) UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal

-- | Draw a dialog window, if one should be displayed right now.
drawDialog ::
  ToplevelConfigurationHelp ->
  Bool ->
  ScenarioState ->
  Widget Name
drawDialog :: ToplevelConfigurationHelp -> Bool -> ScenarioState -> Widget Name
drawDialog ToplevelConfigurationHelp
h Bool
isNoMenu ScenarioState
ps =
  Widget Name -> (Modal -> Widget Name) -> Maybe Modal -> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall {n}. Widget n
emptyWidget Modal -> Widget Name
go Maybe Modal
m
 where
  m :: Maybe Modal
m = ScenarioState
ps ScenarioState
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> Maybe Modal
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ScenarioState -> Const (Maybe Modal) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> ScenarioState
-> Const (Maybe Modal) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (Maybe Modal) UIDialogs)
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (Maybe Modal) UIDialogs)
 -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIDialogs -> Const (Maybe Modal) UIDialogs)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay
-> Const (Maybe Modal) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIDialogs -> Const (Maybe Modal) UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal
  go :: Modal -> Widget Name
go (Modal ModalType
mt Dialog ButtonAction Name
d) = Dialog ButtonAction Name -> Widget Name -> Widget Name
forall n a. Ord n => Dialog a n -> Widget n -> Widget n
renderDialog Dialog ButtonAction Name
d (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ case ModalType
mt of
    MidScenarioModal MidScenarioModalType
GoalModal -> Widget Name
draw
    MidScenarioModal MidScenarioModalType
RobotsModal -> Widget Name
draw
    ModalType
_ -> Name -> Widget Name -> Widget Name
forall n. (Ord n, Show n) => n -> Widget n -> Widget n
maybeScroll Name
ModalViewport Widget Name
draw
   where
    draw :: Widget Name
draw = ToplevelConfigurationHelp
-> ScenarioState -> Bool -> ModalType -> Widget Name
drawModal ToplevelConfigurationHelp
h ScenarioState
ps Bool
isNoMenu ModalType
mt

-- | Draw one of the various types of modal dialog.
drawModal ::
  ToplevelConfigurationHelp ->
  ScenarioState ->
  Bool ->
  ModalType ->
  Widget Name
drawModal :: ToplevelConfigurationHelp
-> ScenarioState -> Bool -> ModalType -> Widget Name
drawModal ToplevelConfigurationHelp
h ScenarioState
ps Bool
isNoMenu = \case
  MidScenarioModal MidScenarioModalType
x -> case MidScenarioModalType
x of
    MidScenarioModalType
HelpModal -> ToplevelConfigurationHelp -> Int -> Widget Name
helpWidget ToplevelConfigurationHelp
h (Int -> Widget Name) -> Int -> Widget Name
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState -> Getting Int GameState Int -> Int
forall s a. s -> Getting a s a -> a
^. (Randomness -> Const Int Randomness)
-> GameState -> Const Int GameState
Lens' GameState Randomness
randomness ((Randomness -> Const Int Randomness)
 -> GameState -> Const Int GameState)
-> ((Int -> Const Int Int) -> Randomness -> Const Int Randomness)
-> Getting Int GameState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Randomness -> Const Int Randomness
Lens' Randomness Int
seed
    MidScenarioModalType
RobotsModal -> UIGameplay -> GameState -> RobotDisplay -> Widget Name
drawRobotsDisplayModal UIGameplay
uig GameState
gs (RobotDisplay -> Widget Name) -> RobotDisplay -> Widget Name
forall a b. (a -> b) -> a -> b
$ UIGameplay
uig UIGameplay
-> Getting RobotDisplay UIGameplay RobotDisplay -> RobotDisplay
forall s a. s -> Getting a s a -> a
^. (UIDialogs -> Const RobotDisplay UIDialogs)
-> UIGameplay -> Const RobotDisplay UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const RobotDisplay UIDialogs)
 -> UIGameplay -> Const RobotDisplay UIGameplay)
-> ((RobotDisplay -> Const RobotDisplay RobotDisplay)
    -> UIDialogs -> Const RobotDisplay UIDialogs)
-> Getting RobotDisplay UIGameplay RobotDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RobotDisplay -> Const RobotDisplay RobotDisplay)
-> UIDialogs -> Const RobotDisplay UIDialogs
Lens' UIDialogs RobotDisplay
uiRobot
    MidScenarioModalType
RecipesModal -> GameState -> NotificationList -> Widget Name
availableListWidget GameState
gs NotificationList
RecipeList
    MidScenarioModalType
CommandsModal -> GameState -> Widget Name
commandsListWidget GameState
gs
    MidScenarioModalType
MessagesModal -> GameState -> NotificationList -> Widget Name
availableListWidget GameState
gs NotificationList
MessageList
    MidScenarioModalType
StructuresModal -> GameState -> StructureDisplay -> Widget Name
SR.renderStructuresDisplay GameState
gs (StructureDisplay -> Widget Name)
-> StructureDisplay -> Widget Name
forall a b. (a -> b) -> a -> b
$ UIGameplay
uig UIGameplay
-> Getting StructureDisplay UIGameplay StructureDisplay
-> StructureDisplay
forall s a. s -> Getting a s a -> a
^. (UIDialogs -> Const StructureDisplay UIDialogs)
-> UIGameplay -> Const StructureDisplay UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const StructureDisplay UIDialogs)
 -> UIGameplay -> Const StructureDisplay UIGameplay)
-> ((StructureDisplay -> Const StructureDisplay StructureDisplay)
    -> UIDialogs -> Const StructureDisplay UIDialogs)
-> Getting StructureDisplay UIGameplay StructureDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay -> Const StructureDisplay StructureDisplay)
-> UIDialogs -> Const StructureDisplay UIDialogs
Lens' UIDialogs StructureDisplay
uiStructure
    DescriptionModal Entity
e -> ScenarioState -> Entity -> Widget Name
descriptionWidget ScenarioState
ps Entity
e
    MidScenarioModalType
GoalModal ->
      GoalDisplay -> Maybe (Document Syntax) -> Widget Name
GR.renderGoalsDisplay (UIGameplay
uig UIGameplay
-> Getting GoalDisplay UIGameplay GoalDisplay -> GoalDisplay
forall s a. s -> Getting a s a -> a
^. (UIDialogs -> Const GoalDisplay UIDialogs)
-> UIGameplay -> Const GoalDisplay UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const GoalDisplay UIDialogs)
 -> UIGameplay -> Const GoalDisplay UIGameplay)
-> ((GoalDisplay -> Const GoalDisplay GoalDisplay)
    -> UIDialogs -> Const GoalDisplay UIDialogs)
-> Getting GoalDisplay UIGameplay GoalDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const GoalDisplay GoalDisplay)
-> UIDialogs -> Const GoalDisplay UIDialogs
Lens' UIDialogs GoalDisplay
uiGoal) (Maybe (Document Syntax) -> Widget Name)
-> Maybe (Document Syntax) -> Widget Name
forall a b. (a -> b) -> a -> b
$
        Getting
  (Document Syntax) (ScenarioWith ScenarioPath) (Document Syntax)
-> ScenarioWith ScenarioPath -> Document Syntax
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Scenario -> Const (Document Syntax) Scenario)
-> ScenarioWith ScenarioPath
-> Const (Document Syntax) (ScenarioWith ScenarioPath)
forall a (f :: * -> *).
Functor f =>
(Scenario -> f Scenario) -> ScenarioWith a -> f (ScenarioWith a)
getScenario ((Scenario -> Const (Document Syntax) Scenario)
 -> ScenarioWith ScenarioPath
 -> Const (Document Syntax) (ScenarioWith ScenarioPath))
-> Getting (Document Syntax) Scenario (Document Syntax)
-> Getting
     (Document Syntax) (ScenarioWith ScenarioPath) (Document Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
-> Scenario -> Const (Document Syntax) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
 -> Scenario -> Const (Document Syntax) Scenario)
-> ((Document Syntax -> Const (Document Syntax) (Document Syntax))
    -> ScenarioOperation -> Const (Document Syntax) ScenarioOperation)
-> Getting (Document Syntax) Scenario (Document Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Document Syntax -> Const (Document Syntax) (Document Syntax))
-> ScenarioOperation -> Const (Document Syntax) ScenarioOperation
Lens' ScenarioOperation (Document Syntax)
scenarioDescription) (ScenarioWith ScenarioPath -> Document Syntax)
-> Maybe (ScenarioWith ScenarioPath) -> Maybe (Document Syntax)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIGameplay
uig UIGameplay
-> Getting
     (Maybe (ScenarioWith ScenarioPath))
     UIGameplay
     (Maybe (ScenarioWith ScenarioPath))
-> Maybe (ScenarioWith ScenarioPath)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ScenarioWith ScenarioPath))
  UIGameplay
  (Maybe (ScenarioWith ScenarioPath))
Lens' UIGameplay (Maybe (ScenarioWith ScenarioPath))
scenarioRef
    MidScenarioModalType
TerrainPaletteModal -> UIGameplay -> Widget Name
EV.drawTerrainSelector UIGameplay
uig
    MidScenarioModalType
EntityPaletteModal -> UIGameplay -> Widget Name
EV.drawEntityPaintSelector UIGameplay
uig
  EndScenarioModal EndScenarioModalType
x -> case EndScenarioModalType
x of
    ScenarioFinishModal ScenarioOutcome
outcome ->
      Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$
          (Text -> Widget Name) -> [Text] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map
            (Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget Name
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."
          ]
    EndScenarioModalType
QuitModal -> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt (Bool -> Text
quitMsg Bool
isNoMenu)
    EndScenarioModalType
KeepPlayingModal ->
      Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        [Text] -> Widget Name
displayParagraphs ([Text] -> Widget Name) -> [Text] -> Widget Name
forall a b. (a -> b) -> a -> b
$
          Text -> [Text]
forall a. a -> [a]
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."
 where
  gs :: GameState
gs = ScenarioState
ps ScenarioState
-> Getting GameState ScenarioState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState ScenarioState GameState
Lens' ScenarioState GameState
gameState
  uig :: UIGameplay
uig = ScenarioState
ps ScenarioState
-> Getting UIGameplay ScenarioState UIGameplay -> UIGameplay
forall s a. s -> Getting a s a -> a
^. Getting UIGameplay ScenarioState UIGameplay
Lens' ScenarioState UIGameplay
uiGameplay

data ToplevelConfigurationHelp = ToplevelConfigurationHelp
  { ToplevelConfigurationHelp -> Maybe Int
_helpPort :: Maybe Port
  , ToplevelConfigurationHelp -> KeyConfig SwarmEvent
_helpKeyConf :: KeyConfig SE.SwarmEvent
  }

helpWidget :: ToplevelConfigurationHelp -> Seed -> Widget Name
helpWidget :: ToplevelConfigurationHelp -> Int -> Widget Name
helpWidget (ToplevelConfigurationHelp Maybe Int
mport KeyConfig SwarmEvent
keyConf) Int
theSeed =
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
2 (Widget Name -> Widget Name)
-> ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1)
      (Widget Name -> Widget Name) -> [Widget Name] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Widget Name
forall {n}. Widget n
info
          , Widget Name
colorizationLegend
          , Widget Name
forall {n}. Widget n
helpKeys
          , Widget Name
forall {n}. Widget n
tips
          ]
 where
  tips :: Widget n
tips =
    [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox
      [ AttrName -> Text -> Widget n
forall {n}. AttrName -> Text -> Widget n
heading AttrName
boldAttr Text
"Have questions? Want some tips? Check out:"
      , Text -> Widget n
forall n. Text -> Widget n
txt Text
"  - The Swarm wiki, " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n -> Widget n
forall n. Text -> Widget n -> Widget n
hyperlink Text
wikiUrl (Text -> Widget n
forall n. Text -> Widget n
txt Text
wikiUrl)
      , Text -> Widget n
forall n. Text -> Widget n
txt Text
"  - The Swarm Discord server at " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n -> Widget n
forall n. Text -> Widget n -> Widget n
hyperlink Text
swarmDiscord (Text -> Widget n
forall n. Text -> Widget n
txt Text
swarmDiscord)
      ]
  info :: Widget n
info =
    [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox
      [ AttrName -> Text -> Widget n
forall {n}. AttrName -> Text -> Widget n
heading AttrName
boldAttr Text
"Configuration"
      , Text -> Widget n
forall n. Text -> Widget n
txt (Text
"Seed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text (Int -> String
forall a. Show a => a -> String
show Int
theSeed))
      , Text -> Widget n
forall n. Text -> Widget n
txt (Text
"Web server port: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"none" (forall target source. From source target => source -> target
into @Text (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Maybe Int
mport)
      ]
  colorizationLegend :: Widget Name
colorizationLegend =
    [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
      [ AttrName -> Text -> Widget Name
forall {n}. AttrName -> Text -> Widget n
heading AttrName
boldAttr Text
"Colorization legend"
      , Document Syntax -> Widget Name
drawMarkdown
          Document Syntax
"In text, snippets of code like `3 + 4` or `scan down` will be colorized. Types like `Cmd Text`{=type} have a dedicated color. The names of an `entity`{=entity}, a `structure`{=structure}, and a `tag`{=tag} also each have their own color."
      ]
  helpKeys :: Widget n
helpKeys =
    [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox
      [ AttrName -> Text -> Widget n
forall {n}. AttrName -> Text -> Widget n
heading AttrName
boldAttr Text
"Keybindings"
      , Text
-> [KeyEventHandler SwarmEvent (EventM Name AppState)] -> Widget n
forall {m :: * -> *} {n}.
Text -> [KeyEventHandler SwarmEvent m] -> Widget n
keySection Text
"Main (always active)" [KeyEventHandler SwarmEvent (EventM Name AppState)]
mainEventHandlers
      , Text
-> [KeyEventHandler SwarmEvent (EventM Name AppState)] -> Widget n
forall {m :: * -> *} {n}.
Text -> [KeyEventHandler SwarmEvent m] -> Widget n
keySection Text
"REPL panel" [KeyEventHandler SwarmEvent (EventM Name AppState)]
replEventHandlers
      , Text
-> [KeyEventHandler SwarmEvent (EventM Name AppState)] -> Widget n
forall {m :: * -> *} {n}.
Text -> [KeyEventHandler SwarmEvent m] -> Widget n
keySection Text
"World view panel" [KeyEventHandler SwarmEvent (EventM Name AppState)]
worldEventHandlers
      , Text
-> [KeyEventHandler SwarmEvent (EventM Name AppState)] -> Widget n
forall {m :: * -> *} {n}.
Text -> [KeyEventHandler SwarmEvent m] -> Widget n
keySection Text
"Robot inventory panel" [KeyEventHandler SwarmEvent (EventM Name AppState)]
robotEventHandlers
      ]
  keySection :: Text -> [KeyEventHandler SwarmEvent m] -> Widget n
keySection Text
name [KeyEventHandler SwarmEvent m]
handlers =
    Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
      [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox
        [ AttrName -> Text -> Widget n
forall {n}. AttrName -> Text -> Widget n
heading AttrName
italicAttr Text
name
        , [KeyEventHandler SwarmEvent m] -> Widget n
forall {m :: * -> *} {n}.
[KeyEventHandler SwarmEvent m] -> Widget n
mkKeyTable [KeyEventHandler SwarmEvent m]
handlers
        ]
  mkKeyTable :: [KeyEventHandler SwarmEvent m] -> Widget n
mkKeyTable =
    Table n -> Widget n
forall n. Table n -> Widget n
BT.renderTable
      (Table n -> Widget n)
-> ([KeyEventHandler SwarmEvent m] -> Table n)
-> [KeyEventHandler SwarmEvent m]
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
BT.surroundingBorder Bool
False
      (Table n -> Table n)
-> ([KeyEventHandler SwarmEvent m] -> Table n)
-> [KeyEventHandler SwarmEvent m]
-> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Table n -> Table n
forall n. Bool -> Table n -> Table n
BT.rowBorders Bool
False
      (Table n -> Table n)
-> ([KeyEventHandler SwarmEvent m] -> Table n)
-> [KeyEventHandler SwarmEvent m]
-> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Widget n]] -> Table n
forall n. [[Widget n]] -> Table n
BT.table
      ([[Widget n]] -> Table n)
-> ([KeyEventHandler SwarmEvent m] -> [[Widget n]])
-> [KeyEventHandler SwarmEvent m]
-> Table n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyEventHandler SwarmEvent m -> [Widget n])
-> [KeyEventHandler SwarmEvent m] -> [[Widget n]]
forall a b. (a -> b) -> [a] -> [b]
map ((Text, Text, Text) -> [Widget n]
forall {n}. (Text, Text, Text) -> [Widget n]
toRow ((Text, Text, Text) -> [Widget n])
-> (KeyEventHandler SwarmEvent m -> (Text, Text, Text))
-> KeyEventHandler SwarmEvent m
-> [Widget n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyEventHandler SwarmEvent m -> (Text, Text, Text)
forall {m :: * -> *}.
KeyEventHandler SwarmEvent m -> (Text, Text, Text)
keyHandlerToText)
  heading :: AttrName -> Text -> Widget n
heading AttrName
attr = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
attr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt
  toRow :: (Text, Text, Text) -> [Widget n]
toRow (Text
n, Text
k, Text
d) =
    [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Widget n
forall {n}. Int -> Text -> Widget n
txtFilled Int
maxN Text
n
    , Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Widget n
forall {n}. Int -> Text -> Widget n
txtFilled Int
maxK Text
k
    , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Widget n
forall {n}. Int -> Text -> Widget n
txtFilled Int
maxD Text
d
    ]
  keyHandlerToText :: KeyEventHandler SwarmEvent m -> (Text, Text, Text)
keyHandlerToText = KeyConfig SwarmEvent
-> KeyEventHandler SwarmEvent m -> (Text, Text, Text)
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> KeyEventHandler k m -> (Text, Text, Text)
handlerNameKeysDescription KeyConfig SwarmEvent
keyConf
  -- Get maximum width of the table columns so it all neatly aligns
  txtFilled :: Int -> Text -> Widget n
txtFilled Int
n Text
t = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad (Int -> Padding) -> Int -> Padding
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
forall a. TextWidth a => a -> Int
textWidth Text
t)) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
t
  (Int
maxN, Int
maxK, Int
maxD) = ([Text] -> Int) -> ([Text], [Text], [Text]) -> (Int, Int, Int)
forall {t} {c}. (t -> c) -> (t, t, t) -> (c, c, c)
map3 ([Int] -> Int
forall a. (Num a, Ord a) => [a] -> a
maximum0 ([Int] -> Int) -> ([Text] -> [Int]) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
forall a. TextWidth a => a -> Int
textWidth) (([Text], [Text], [Text]) -> (Int, Int, Int))
-> ([(Text, Text, Text)] -> ([Text], [Text], [Text]))
-> [(Text, Text, Text)]
-> (Int, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text, Text)] -> ([Text], [Text], [Text])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Text, Text, Text)] -> (Int, Int, Int))
-> [(Text, Text, Text)] -> (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ KeyEventHandler SwarmEvent (EventM Name AppState)
-> (Text, Text, Text)
forall {m :: * -> *}.
KeyEventHandler SwarmEvent m -> (Text, Text, Text)
keyHandlerToText (KeyEventHandler SwarmEvent (EventM Name AppState)
 -> (Text, Text, Text))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
-> [(Text, Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyEventHandler SwarmEvent (EventM Name AppState)]
allEventHandlers
  map3 :: (t -> c) -> (t, t, t) -> (c, c, c)
map3 t -> c
f (t
n, t
k, t
d) = (t -> c
f t
n, t -> c
f t
k, t -> c
f t
d)

data NotificationList = RecipeList | MessageList

availableListWidget :: GameState -> NotificationList -> Widget Name
availableListWidget :: GameState -> NotificationList -> Widget Name
availableListWidget GameState
gs NotificationList
nl = Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox [Widget Name]
widgetList
 where
  widgetList :: [Widget Name]
widgetList = case NotificationList
nl of
    NotificationList
RecipeList -> GameState
-> Lens' GameState (Notifications (Recipe Entity))
-> (Recipe Entity -> Widget Name)
-> [Widget Name]
forall a.
GameState
-> Lens' GameState (Notifications a)
-> (a -> Widget Name)
-> [Widget Name]
mkAvailableList GameState
gs ((Discovery -> f Discovery) -> GameState -> f GameState
Lens' GameState Discovery
discovery ((Discovery -> f Discovery) -> GameState -> f GameState)
-> ((Notifications (Recipe Entity)
     -> f (Notifications (Recipe Entity)))
    -> Discovery -> f Discovery)
-> (Notifications (Recipe Entity)
    -> f (Notifications (Recipe Entity)))
-> GameState
-> f GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications (Recipe Entity)
 -> f (Notifications (Recipe Entity)))
-> Discovery -> f Discovery
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 = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
18 (Widget Name -> Widget Name)
-> (Recipe Entity -> Widget Name) -> Recipe Entity -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Entity -> Inventory -> Recipe Entity -> Widget Name
drawRecipe Maybe Entity
forall a. Maybe a
Nothing (Inventory -> Maybe Inventory -> Inventory
forall a. a -> Maybe a -> a
fromMaybe Inventory
E.empty Maybe Inventory
inv)
  inv :: Maybe Inventory
inv = GameState
gs GameState
-> Getting (First Inventory) GameState Inventory -> Maybe Inventory
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Maybe Robot)
-> (Maybe Robot -> Const (First Inventory) (Maybe Robot))
-> GameState
-> Const (First Inventory) GameState
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot ((Maybe Robot -> Const (First Inventory) (Maybe Robot))
 -> GameState -> Const (First Inventory) GameState)
-> ((Inventory -> Const (First Inventory) Inventory)
    -> Maybe Robot -> Const (First Inventory) (Maybe Robot))
-> Getting (First Inventory) GameState Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Const (First Inventory) Robot)
-> Maybe Robot -> Const (First Inventory) (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Const (First Inventory) Robot)
 -> Maybe Robot -> Const (First Inventory) (Maybe Robot))
-> ((Inventory -> Const (First Inventory) Inventory)
    -> Robot -> Const (First Inventory) Robot)
-> (Inventory -> Const (First Inventory) Inventory)
-> Maybe Robot
-> Const (First Inventory) (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Const (First Inventory) Inventory)
-> Robot -> Const (First Inventory) Robot
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 = (a -> Widget Name) -> [a] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map a -> Widget Name
padRender [a]
news [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. Semigroup a => a -> a -> a
<> [Widget Name]
forall {n}. [Widget n]
notifSep [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. Semigroup a => a -> a -> a
<> (a -> Widget Name) -> [a] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map a -> Widget Name
padRender [a]
knowns
 where
  padRender :: a -> Widget Name
padRender = Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name)
-> (a -> Widget Name) -> a -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Widget Name
notifRender
  count :: Int
count = GameState
gs GameState -> Getting Int GameState Int -> Int
forall s a. s -> Getting a s a -> a
^. (Notifications a -> Const Int (Notifications a))
-> GameState -> Const Int GameState
Lens' GameState (Notifications a)
notifLens ((Notifications a -> Const Int (Notifications a))
 -> GameState -> Const Int GameState)
-> ((Int -> Const Int Int)
    -> Notifications a -> Const Int (Notifications a))
-> Getting Int GameState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> Notifications a -> Const Int (Notifications a)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> Notifications a -> f (Notifications a)
notificationsCount
  ([a]
news, [a]
knowns) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
count (GameState
gs GameState -> Getting [a] GameState [a] -> [a]
forall s a. s -> Getting a s a -> a
^. (Notifications a -> Const [a] (Notifications a))
-> GameState -> Const [a] GameState
Lens' GameState (Notifications a)
notifLens ((Notifications a -> Const [a] (Notifications a))
 -> GameState -> Const [a] GameState)
-> (([a] -> Const [a] [a])
    -> Notifications a -> Const [a] (Notifications a))
-> Getting [a] GameState [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Const [a] [a])
-> Notifications a -> Const [a] (Notifications a)
forall a1 a2 (f :: * -> *).
Functor f =>
([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
notificationsContent)
  notifSep :: [Widget n]
notifSep
    | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
knowns) =
        [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Text -> Widget n
forall n. Text -> Widget n
txt Text
"new↑")))
        ]
    | Bool
otherwise = []

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

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

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

  listDevices :: Const -> Widget n
listDevices Const
cmd = [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Entity -> Widget n) -> [Entity] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Entity -> Widget n
forall n. Entity -> Widget n
drawLabelledEntityName [Entity]
providerDevices
   where
    providerDevices :: [Entity]
providerDevices =
      (Capability -> [Entity]) -> [Capability] -> [Entity]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Capability -> Map Capability [Entity] -> [Entity])
-> Map Capability [Entity] -> Capability -> [Entity]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Entity] -> Capability -> Map Capability [Entity] -> [Entity]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault []) Map Capability [Entity]
entsByCap) ([Capability] -> [Entity]) -> [Capability] -> [Entity]
forall a b. (a -> b) -> a -> b
$
        Maybe Capability -> [Capability]
forall a. Maybe a -> [a]
maybeToList (Maybe Capability -> [Capability])
-> Maybe Capability -> [Capability]
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 :: ScenarioState -> Entity -> Widget Name
descriptionWidget :: ScenarioState -> Entity -> Widget Name
descriptionWidget ScenarioState
s Entity
e = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (UIGameplay -> GameState -> Entity -> Widget Name
explainEntry UIGameplay
uig GameState
gs Entity
e)
 where
  gs :: GameState
gs = ScenarioState
s ScenarioState
-> Getting GameState ScenarioState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState ScenarioState GameState
Lens' ScenarioState GameState
gameState
  uig :: UIGameplay
uig = ScenarioState
s ScenarioState
-> Getting UIGameplay ScenarioState UIGameplay -> UIGameplay
forall s a. s -> Getting a s a -> a
^. Getting UIGameplay ScenarioState UIGameplay
Lens' ScenarioState UIGameplay
uiGameplay

-- | 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 ([Widget Name] -> [Widget Name])
-> ([LogEntry] -> [Widget Name]) -> [LogEntry] -> [Widget Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogEntry -> Widget Name) -> [LogEntry] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map LogEntry -> Widget Name
forall {n}. LogEntry -> Widget n
drawLogEntry' ([LogEntry] -> [Widget Name]) -> [LogEntry] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState -> Getting [LogEntry] GameState [LogEntry] -> [LogEntry]
forall s a. s -> Getting a s a -> a
^. (Notifications LogEntry
 -> Const [LogEntry] (Notifications LogEntry))
-> GameState -> Const [LogEntry] GameState
Getter GameState (Notifications LogEntry)
messageNotifications ((Notifications LogEntry
  -> Const [LogEntry] (Notifications LogEntry))
 -> GameState -> Const [LogEntry] GameState)
-> (([LogEntry] -> Const [LogEntry] [LogEntry])
    -> Notifications LogEntry
    -> Const [LogEntry] (Notifications LogEntry))
-> Getting [LogEntry] GameState [LogEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LogEntry] -> Const [LogEntry] [LogEntry])
-> Notifications LogEntry
-> Const [LogEntry] (Notifications LogEntry)
forall a1 a2 (f :: * -> *).
Functor f =>
([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
notificationsContent
  focusNewest :: [Widget Name] -> [Widget Name]
focusNewest = Bool
-> ([Widget Name] -> [Widget Name])
-> [Widget Name]
-> [Widget Name]
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (TemporalState -> Const Bool TemporalState)
-> GameState -> Const Bool GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const Bool TemporalState)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> TemporalState -> Const Bool TemporalState)
-> Getting Bool GameState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> TemporalState -> Const Bool TemporalState
Getter TemporalState Bool
paused) (([Widget Name] -> [Widget Name])
 -> [Widget Name] -> [Widget Name])
-> ([Widget Name] -> [Widget Name])
-> [Widget Name]
-> [Widget Name]
forall a b. (a -> b) -> a -> b
$ ASetter [Widget Name] [Widget Name] (Widget Name) (Widget Name)
-> (Widget Name -> Widget Name) -> [Widget Name] -> [Widget Name]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter [Widget Name] [Widget Name] (Widget Name) (Widget Name)
forall s a. Snoc s s a a => Traversal' s a
Traversal' [Widget Name] (Widget Name)
_last Widget Name -> Widget Name
forall n. Widget n -> Widget n
visible
  drawLogEntry' :: LogEntry -> Widget n
drawLogEntry' LogEntry
e =
    AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (LogEntry -> AttrName
colorLogs LogEntry
e) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
      [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
hBox
        [ Widget n -> Maybe (Widget n) -> Widget n
forall a. a -> Maybe a -> a
fromMaybe (Text -> Widget n
forall n. Text -> Widget n
txt Text
"") (Maybe (Widget n) -> Widget n) -> Maybe (Widget n) -> Widget n
forall a b. (a -> b) -> a -> b
$ TickNumber -> Bool -> GameState -> Maybe (Widget n)
forall n. TickNumber -> Bool -> GameState -> Maybe (Widget n)
maybeDrawTime (LogEntry
e LogEntry -> Getting TickNumber LogEntry TickNumber -> TickNumber
forall s a. s -> Getting a s a -> a
^. Getting TickNumber LogEntry TickNumber
Lens' LogEntry TickNumber
leTime) Bool
True GameState
gs
        , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Text
brackets (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ LogEntry
e LogEntry -> Getting Text LogEntry Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text LogEntry Text
Lens' LogEntry Text
leName
        , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt2 (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ LogEntry
e LogEntry -> Getting Text LogEntry Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text LogEntry Text
Lens' LogEntry Text
leText
        ]
  txt2 :: Text -> Widget n
txt2 = WrapSettings -> Text -> Widget n
forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
indent2

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

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 :: GameState -> KeyConfig SE.SwarmEvent -> Widget Name
drawModalMenu :: GameState -> KeyConfig SwarmEvent -> Widget Name
drawModalMenu GameState
gs KeyConfig SwarmEvent
keyConf = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget Name -> Widget Name)
-> ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ (KeyCmd -> Widget Name) -> [KeyCmd] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Name -> Widget Name)
-> (KeyCmd -> Widget Name) -> KeyCmd -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyCmd -> Widget Name
drawKeyCmd) [KeyCmd]
globalKeyCmds
 where
  notificationKey :: Getter GameState (Notifications a) -> SE.MainEvent -> Text -> Maybe KeyCmd
  notificationKey :: forall a.
Getter GameState (Notifications a)
-> MainEvent -> Text -> Maybe KeyCmd
notificationKey Getter GameState (Notifications a)
notifLens MainEvent
key Text
name
    | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GameState
gs GameState -> Getting [a] GameState [a] -> [a]
forall s a. s -> Getting a s a -> a
^. (Notifications a -> Const [a] (Notifications a))
-> GameState -> Const [a] GameState
Getter GameState (Notifications a)
notifLens ((Notifications a -> Const [a] (Notifications a))
 -> GameState -> Const [a] GameState)
-> (([a] -> Const [a] [a])
    -> Notifications a -> Const [a] (Notifications a))
-> Getting [a] GameState [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Const [a] [a])
-> Notifications a -> Const [a] (Notifications a)
forall a1 a2 (f :: * -> *).
Functor f =>
([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
notificationsContent) = Maybe KeyCmd
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let highlight :: KeyHighlight
highlight
              | GameState
gs GameState -> Getting Int GameState Int -> Int
forall s a. s -> Getting a s a -> a
^. (Notifications a -> Const Int (Notifications a))
-> GameState -> Const Int GameState
Getter GameState (Notifications a)
notifLens ((Notifications a -> Const Int (Notifications a))
 -> GameState -> Const Int GameState)
-> ((Int -> Const Int Int)
    -> Notifications a -> Const Int (Notifications a))
-> Getting Int GameState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> Notifications a -> Const Int (Notifications a)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> Notifications a -> f (Notifications a)
notificationsCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = KeyHighlight
Alert
              | Bool
otherwise = KeyHighlight
NoHighlight
         in KeyCmd -> Maybe KeyCmd
forall a. a -> Maybe a
Just (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
highlight (MainEvent -> Text
keyM MainEvent
key) Text
name)

  -- Hides this key if the recognizable structure list is empty
  structuresKey :: Maybe KeyCmd
structuresKey =
    if Map
  StructureName (StructureInfo RecognizableStructureContent Entity)
-> Bool
forall a. Map StructureName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map
   StructureName (StructureInfo RecognizableStructureContent Entity)
 -> Bool)
-> Map
     StructureName (StructureInfo RecognizableStructureContent Entity)
-> Bool
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState
-> Getting
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
-> Map
     StructureName (StructureInfo RecognizableStructureContent Entity)
forall s a. s -> Getting a s a -> a
^. (Landscape
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      Landscape)
-> GameState
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
Lens' GameState Landscape
landscape ((Landscape
  -> Const
       (Map
          StructureName (StructureInfo RecognizableStructureContent Entity))
       Landscape)
 -> GameState
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      GameState)
-> ((Map
       StructureName (StructureInfo RecognizableStructureContent Entity)
     -> Const
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity))
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity)))
    -> Landscape
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         Landscape)
-> Getting
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognizerAutomatons RecognizableStructureContent Entity
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      (RecognizerAutomatons RecognizableStructureContent Entity))
-> Landscape
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     Landscape
Lens'
  Landscape
  (RecognizerAutomatons RecognizableStructureContent Entity)
recognizerAutomatons ((RecognizerAutomatons RecognizableStructureContent Entity
  -> Const
       (Map
          StructureName (StructureInfo RecognizableStructureContent Entity))
       (RecognizerAutomatons RecognizableStructureContent Entity))
 -> Landscape
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      Landscape)
-> ((Map
       StructureName (StructureInfo RecognizableStructureContent Entity)
     -> Const
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity))
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity)))
    -> RecognizerAutomatons RecognizableStructureContent Entity
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         (RecognizerAutomatons RecognizableStructureContent Entity))
-> (Map
      StructureName (StructureInfo RecognizableStructureContent Entity)
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity)))
-> Landscape
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   StructureName (StructureInfo RecognizableStructureContent Entity)
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity)))
-> RecognizerAutomatons RecognizableStructureContent Entity
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     (RecognizerAutomatons RecognizableStructureContent Entity)
forall b a (f :: * -> *).
Functor f =>
(Map StructureName (StructureInfo b a)
 -> f (Map StructureName (StructureInfo b a)))
-> RecognizerAutomatons b a -> f (RecognizerAutomatons b a)
originalStructureDefinitions
      then Maybe KeyCmd
forall a. Maybe a
Nothing
      else KeyCmd -> Maybe KeyCmd
forall a. a -> Maybe a
Just (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
NoHighlight (MainEvent -> Text
keyM MainEvent
SE.ViewStructuresEvent) Text
"Structures")

  globalKeyCmds :: [KeyCmd]
globalKeyCmds =
    [Maybe KeyCmd] -> [KeyCmd]
forall a. [Maybe a] -> [a]
catMaybes
      [ KeyCmd -> Maybe KeyCmd
forall a. a -> Maybe a
Just (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
NoHighlight (MainEvent -> Text
keyM MainEvent
SE.ViewHelpEvent) Text
"Help")
      , KeyCmd -> Maybe KeyCmd
forall a. a -> Maybe a
Just (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
NoHighlight (MainEvent -> Text
keyM MainEvent
SE.ViewRobotsEvent) Text
"Robots")
      , Getter GameState (Notifications (Recipe Entity))
-> MainEvent -> Text -> Maybe KeyCmd
forall a.
Getter GameState (Notifications a)
-> MainEvent -> Text -> Maybe KeyCmd
notificationKey ((Discovery -> f Discovery) -> GameState -> f GameState
Lens' GameState Discovery
discovery ((Discovery -> f Discovery) -> GameState -> f GameState)
-> ((Notifications (Recipe Entity)
     -> f (Notifications (Recipe Entity)))
    -> Discovery -> f Discovery)
-> (Notifications (Recipe Entity)
    -> f (Notifications (Recipe Entity)))
-> GameState
-> f GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications (Recipe Entity)
 -> f (Notifications (Recipe Entity)))
-> Discovery -> f Discovery
Lens' Discovery (Notifications (Recipe Entity))
availableRecipes) MainEvent
SE.ViewRecipesEvent Text
"Recipes"
      , Getter GameState (Notifications Const)
-> MainEvent -> Text -> Maybe KeyCmd
forall a.
Getter GameState (Notifications a)
-> MainEvent -> Text -> Maybe KeyCmd
notificationKey ((Discovery -> f Discovery) -> GameState -> f GameState
Lens' GameState Discovery
discovery ((Discovery -> f Discovery) -> GameState -> f GameState)
-> ((Notifications Const -> f (Notifications Const))
    -> Discovery -> f Discovery)
-> (Notifications Const -> f (Notifications Const))
-> GameState
-> f GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications Const -> f (Notifications Const))
-> Discovery -> f Discovery
Lens' Discovery (Notifications Const)
availableCommands) MainEvent
SE.ViewCommandsEvent Text
"Commands"
      , Getter GameState (Notifications LogEntry)
-> MainEvent -> Text -> Maybe KeyCmd
forall a.
Getter GameState (Notifications a)
-> MainEvent -> Text -> Maybe KeyCmd
notificationKey (Notifications LogEntry -> f (Notifications LogEntry))
-> GameState -> f GameState
Getter GameState (Notifications LogEntry)
messageNotifications MainEvent
SE.ViewMessagesEvent Text
"Messages"
      , Maybe KeyCmd
structuresKey
      ]
  keyM :: MainEvent -> Text
keyM = KeyConfig SwarmEvent -> SwarmEvent -> Text
VU.bindingText KeyConfig SwarmEvent
keyConf (SwarmEvent -> Text)
-> (MainEvent -> SwarmEvent) -> MainEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MainEvent -> SwarmEvent
SE.Main

-- | 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 ::
  ScenarioState ->
  KeyConfig SE.SwarmEvent ->
  Set DebugOption ->
  Widget Name
drawKeyMenu :: ScenarioState
-> KeyConfig SwarmEvent -> Set DebugOption -> Widget Name
drawKeyMenu ScenarioState
ps KeyConfig SwarmEvent
keyConf Set DebugOption
debugOpts =
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
2 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox
      [ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
          [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
            [ [KeyCmd] -> Widget Name
mkCmdRow [KeyCmd]
globalKeyCmds
            , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) Widget Name
contextCmds
            ]
      , Widget Name
forall {n}. Widget n
gameModeWidget
      ]
 where
  mkCmdRow :: [KeyCmd] -> Widget Name
mkCmdRow = [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name)
-> ([KeyCmd] -> [Widget Name]) -> [KeyCmd] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyCmd -> Widget Name) -> [KeyCmd] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map KeyCmd -> Widget Name
drawPaddedCmd
  drawPaddedCmd :: KeyCmd -> Widget Name
drawPaddedCmd = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Name -> Widget Name)
-> (KeyCmd -> Widget Name) -> KeyCmd -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyCmd -> Widget Name
drawKeyCmd
  contextCmds :: Widget Name
contextCmds
    | ReplControlMode
ctrlMode ReplControlMode -> ReplControlMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReplControlMode
Handling = Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (GameState
gs GameState -> Getting (First Text) GameState Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameControls -> Const (First Text) GameControls)
-> GameState -> Const (First Text) GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const (First Text) GameControls)
 -> GameState -> Const (First Text) GameState)
-> ((Text -> Const (First Text) Text)
    -> GameControls -> Const (First Text) GameControls)
-> Getting (First Text) GameState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Text, Value) -> Const (First Text) (Maybe (Text, Value)))
-> GameControls -> Const (First Text) GameControls
Lens' GameControls (Maybe (Text, Value))
inputHandler ((Maybe (Text, Value) -> Const (First Text) (Maybe (Text, Value)))
 -> GameControls -> Const (First Text) GameControls)
-> ((Text -> Const (First Text) Text)
    -> Maybe (Text, Value) -> Const (First Text) (Maybe (Text, Value)))
-> (Text -> Const (First Text) Text)
-> GameControls
-> Const (First Text) GameControls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> Const (First Text) (Text, Value))
-> Maybe (Text, Value) -> Const (First Text) (Maybe (Text, Value))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Text, Value) -> Const (First Text) (Text, Value))
 -> Maybe (Text, Value) -> Const (First Text) (Maybe (Text, Value)))
-> ((Text -> Const (First Text) Text)
    -> (Text, Value) -> Const (First Text) (Text, Value))
-> (Text -> Const (First Text) Text)
-> Maybe (Text, Value)
-> Const (First Text) (Maybe (Text, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> (Text, Value) -> Const (First Text) (Text, Value)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Text, Value) (Text, Value) Text Text
_1)
    | Bool
otherwise = [KeyCmd] -> Widget Name
mkCmdRow [KeyCmd]
focusedPanelCmds
  focusedPanelCmds :: [KeyCmd]
focusedPanelCmds =
    ((Text, Text) -> KeyCmd) -> [(Text, Text)] -> [KeyCmd]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> KeyCmd
highlightKeyCmds
      ([(Text, Text)] -> [KeyCmd])
-> (UIGameplay -> [(Text, Text)]) -> UIGameplay -> [KeyCmd]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Name -> [(Text, Text)]
keyCmdsFor
      (Maybe Name -> [(Text, Text)])
-> (UIGameplay -> Maybe Name) -> UIGameplay -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent
      (FocusRing Name -> Maybe Name)
-> (UIGameplay -> FocusRing Name) -> UIGameplay -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (FocusRing Name) UIGameplay (FocusRing Name)
-> UIGameplay -> FocusRing Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (FocusRing Name) UIGameplay (FocusRing Name)
Lens' UIGameplay (FocusRing Name)
uiFocusRing
      (UIGameplay -> [KeyCmd]) -> UIGameplay -> [KeyCmd]
forall a b. (a -> b) -> a -> b
$ UIGameplay
uig

  uig :: UIGameplay
uig = ScenarioState
ps ScenarioState
-> Getting UIGameplay ScenarioState UIGameplay -> UIGameplay
forall s a. s -> Getting a s a -> a
^. Getting UIGameplay ScenarioState UIGameplay
Lens' ScenarioState UIGameplay
uiGameplay
  gs :: GameState
gs = ScenarioState
ps ScenarioState
-> Getting GameState ScenarioState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState ScenarioState GameState
Lens' ScenarioState GameState
gameState

  isReplWorking :: Bool
isReplWorking = GameState
gs GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameControls -> Const Bool GameControls)
-> GameState -> Const Bool GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const Bool GameControls)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> GameControls -> Const Bool GameControls)
-> Getting Bool GameState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> GameControls -> Const Bool GameControls
Getter GameControls Bool
replWorking
  isPaused :: Bool
isPaused = GameState
gs GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (TemporalState -> Const Bool TemporalState)
-> GameState -> Const Bool GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const Bool TemporalState)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> TemporalState -> Const Bool TemporalState)
-> Getting Bool GameState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> TemporalState -> Const Bool TemporalState
Getter TemporalState Bool
paused
  hasDebug :: Bool
hasDebug = Bool -> GameState -> Bool
hasDebugCapability Bool
creative GameState
gs
  creative :: Bool
creative = GameState
gs GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool GameState Bool
Lens' GameState Bool
creativeMode
  showCreative :: Bool
showCreative = Set DebugOption
debugOpts Set DebugOption -> Getting Bool (Set DebugOption) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Index (Set DebugOption) -> Lens' (Set DebugOption) Bool
forall m. Contains m => Index m -> Lens' m Bool
Lens.contains Index (Set DebugOption)
DebugOption
ToggleCreative
  showEditor :: Bool
showEditor = Set DebugOption
debugOpts Set DebugOption -> Getting Bool (Set DebugOption) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Index (Set DebugOption) -> Lens' (Set DebugOption) Bool
forall m. Contains m => Index m -> Lens' m Bool
Lens.contains Index (Set DebugOption)
DebugOption
ToggleWorldEditor
  goal :: Bool
goal = GoalTracking -> Bool
hasAnythingToShow (GoalTracking -> Bool) -> GoalTracking -> Bool
forall a b. (a -> b) -> a -> b
$ UIGameplay
uig UIGameplay
-> Getting GoalTracking UIGameplay GoalTracking -> GoalTracking
forall s a. s -> Getting a s a -> a
^. (UIDialogs -> Const GoalTracking UIDialogs)
-> UIGameplay -> Const GoalTracking UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const GoalTracking UIDialogs)
 -> UIGameplay -> Const GoalTracking UIGameplay)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
    -> UIDialogs -> Const GoalTracking UIDialogs)
-> Getting GoalTracking UIGameplay GoalTracking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const GoalTracking GoalDisplay)
-> UIDialogs -> Const GoalTracking UIDialogs
Lens' UIDialogs GoalDisplay
uiGoal ((GoalDisplay -> Const GoalTracking GoalDisplay)
 -> UIDialogs -> Const GoalTracking UIDialogs)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
    -> GoalDisplay -> Const GoalTracking GoalDisplay)
-> (GoalTracking -> Const GoalTracking GoalTracking)
-> UIDialogs
-> Const GoalTracking UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalTracking -> Const GoalTracking GoalTracking)
-> GoalDisplay -> Const GoalTracking GoalDisplay
Lens' GoalDisplay GoalTracking
goalsContent
  showZero :: Bool
showZero = UIGameplay
uig UIGameplay -> Getting Bool UIGameplay Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (UIInventory -> Const Bool UIInventory)
-> UIGameplay -> Const Bool UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Const Bool UIInventory)
 -> UIGameplay -> Const Bool UIGameplay)
-> ((Bool -> Const Bool Bool)
    -> UIInventory -> Const Bool UIInventory)
-> Getting Bool UIGameplay Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIInventory -> Const Bool UIInventory
Lens' UIInventory Bool
uiShowZero
  inventorySort :: InventorySortOptions
inventorySort = UIGameplay
uig UIGameplay
-> Getting InventorySortOptions UIGameplay InventorySortOptions
-> InventorySortOptions
forall s a. s -> Getting a s a -> a
^. (UIInventory -> Const InventorySortOptions UIInventory)
-> UIGameplay -> Const InventorySortOptions UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Const InventorySortOptions UIInventory)
 -> UIGameplay -> Const InventorySortOptions UIGameplay)
-> ((InventorySortOptions
     -> Const InventorySortOptions InventorySortOptions)
    -> UIInventory -> Const InventorySortOptions UIInventory)
-> Getting InventorySortOptions UIGameplay InventorySortOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InventorySortOptions
 -> Const InventorySortOptions InventorySortOptions)
-> UIInventory -> Const InventorySortOptions UIInventory
Lens' UIInventory InventorySortOptions
uiInventorySort
  inventorySearch :: Maybe Text
inventorySearch = UIGameplay
uig UIGameplay
-> Getting (Maybe Text) UIGameplay (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. (UIInventory -> Const (Maybe Text) UIInventory)
-> UIGameplay -> Const (Maybe Text) UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Const (Maybe Text) UIInventory)
 -> UIGameplay -> Const (Maybe Text) UIGameplay)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIInventory -> Const (Maybe Text) UIInventory)
-> Getting (Maybe Text) UIGameplay (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIInventory -> Const (Maybe Text) UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch
  ctrlMode :: ReplControlMode
ctrlMode = UIGameplay
uig UIGameplay
-> Getting ReplControlMode UIGameplay ReplControlMode
-> ReplControlMode
forall s a. s -> Getting a s a -> a
^. (REPLState -> Const ReplControlMode REPLState)
-> UIGameplay -> Const ReplControlMode UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const ReplControlMode REPLState)
 -> UIGameplay -> Const ReplControlMode UIGameplay)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> REPLState -> Const ReplControlMode REPLState)
-> Getting ReplControlMode UIGameplay ReplControlMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> REPLState -> Const ReplControlMode REPLState
Lens' REPLState ReplControlMode
replControlMode
  canScroll :: Bool
canScroll = Bool
creative Bool -> Bool -> Bool
|| (GameState
gs GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (Landscape -> Const Bool Landscape)
-> GameState -> Const Bool GameState
Lens' GameState Landscape
landscape ((Landscape -> Const Bool Landscape)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool) -> Landscape -> Const Bool Landscape)
-> Getting Bool GameState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Landscape -> Const Bool Landscape
Lens' Landscape Bool
worldScrollable)
  handlerInstalled :: Bool
handlerInstalled = Maybe (Text, Value) -> Bool
forall a. Maybe a -> Bool
isJust (GameState
gs GameState
-> Getting (Maybe (Text, Value)) GameState (Maybe (Text, Value))
-> Maybe (Text, Value)
forall s a. s -> Getting a s a -> a
^. (GameControls -> Const (Maybe (Text, Value)) GameControls)
-> GameState -> Const (Maybe (Text, Value)) GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const (Maybe (Text, Value)) GameControls)
 -> GameState -> Const (Maybe (Text, Value)) GameState)
-> ((Maybe (Text, Value)
     -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
    -> GameControls -> Const (Maybe (Text, Value)) GameControls)
-> Getting (Maybe (Text, Value)) GameState (Maybe (Text, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Text, Value)
 -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
-> GameControls -> Const (Maybe (Text, Value)) GameControls
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 =
    Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max
      (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1
      (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt
      (Text -> Widget n) -> (Text -> Text) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" mode")
      (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ case Bool
creative of
        Bool
False -> Text
"Classic"
        Bool
True -> Text
"Creative"

  globalKeyCmds :: [KeyCmd]
  globalKeyCmds :: [KeyCmd]
globalKeyCmds =
    [Maybe KeyCmd] -> [KeyCmd]
forall a. [Maybe a] -> [a]
catMaybes
      [ Bool -> KeyCmd -> Maybe KeyCmd
forall {a}. Bool -> a -> Maybe a
may Bool
goal (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
NoHighlight (MainEvent -> Text
keyM MainEvent
SE.ViewGoalEvent) Text
"goal")
      , Bool -> KeyCmd -> Maybe KeyCmd
forall {a}. Bool -> a -> Maybe a
may Bool
showCreative (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
NoHighlight (MainEvent -> Text
keyM MainEvent
SE.ToggleCreativeModeEvent) Text
"creative")
      , Bool -> KeyCmd -> Maybe KeyCmd
forall {a}. Bool -> a -> Maybe a
may Bool
showEditor (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
NoHighlight (MainEvent -> Text
keyM MainEvent
SE.ToggleWorldEditorEvent) Text
"editor")
      , KeyCmd -> Maybe KeyCmd
forall a. a -> Maybe a
Just (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
NoHighlight (MainEvent -> Text
keyM MainEvent
SE.PauseEvent) (if Bool
isPaused then Text
"unpause" else Text
"pause"))
      , Bool -> KeyCmd -> Maybe KeyCmd
forall {a}. Bool -> a -> Maybe a
may Bool
isPaused (KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
NoHighlight (MainEvent -> Text
keyM MainEvent
SE.RunSingleTickEvent) Text
"step")
      , Bool -> KeyCmd -> Maybe KeyCmd
forall {a}. Bool -> a -> Maybe a
may
          (Bool
isPaused Bool -> Bool -> Bool
&& Bool
hasDebug)
          ( KeyHighlight -> Text -> Text -> KeyCmd
SingleButton
              (if UIGameplay
uig UIGameplay -> Getting Bool UIGameplay Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UIGameplay Bool
Lens' UIGameplay Bool
uiShowDebug then KeyHighlight
Alert else KeyHighlight
NoHighlight)
              (MainEvent -> Text
keyM MainEvent
SE.ShowCESKDebugEvent)
              Text
"debug"
          )
      , KeyCmd -> Maybe KeyCmd
forall a. a -> Maybe a
Just (KeyHighlight -> [(Text, Text)] -> Text -> KeyCmd
MultiButton KeyHighlight
NoHighlight [(MainEvent -> Text
keyM MainEvent
SE.IncreaseTpsEvent, Text
"speed-up"), (MainEvent -> Text
keyM MainEvent
SE.DecreaseTpsEvent, Text
"speed-down")] Text
"speed")
      , KeyCmd -> Maybe KeyCmd
forall a. a -> Maybe a
Just
          ( KeyHighlight -> Text -> Text -> KeyCmd
SingleButton
              KeyHighlight
NoHighlight
              (MainEvent -> Text
keyM MainEvent
SE.ToggleREPLVisibilityEvent)
              (if UIGameplay
uig UIGameplay -> Getting Bool UIGameplay Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UIGameplay Bool
Lens' UIGameplay Bool
uiShowREPL then Text
"hide REPL" else Text
"show REPL")
          )
      , KeyCmd -> Maybe KeyCmd
forall a. a -> Maybe a
Just
          ( KeyHighlight -> Text -> Text -> KeyCmd
SingleButton
              (if UIGameplay
uig UIGameplay -> Getting Bool UIGameplay Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UIGameplay Bool
Getter UIGameplay Bool
uiShowRobots then KeyHighlight
NoHighlight else KeyHighlight
Alert)
              (MainEvent -> Text
keyM MainEvent
SE.HideRobotsEvent)
              Text
"hide robots"
          )
      ]
  may :: Bool -> a -> Maybe a
may Bool
b = if Bool
b then a -> Maybe a
forall a. a -> Maybe a
Just else Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing

  highlightKeyCmds :: (Text, Text) -> KeyCmd
highlightKeyCmds (Text
k, Text
n) = KeyHighlight -> Text -> Text -> KeyCmd
SingleButton KeyHighlight
PanelSpecific Text
k Text
n

  keyCmdsFor :: Maybe Name -> [(Text, Text)]
keyCmdsFor (Just (FocusablePanel FocusablePanel
WorldEditorPanel)) =
    [(Text
"^s", Text
"save map")]
  keyCmdsFor (Just (FocusablePanel FocusablePanel
REPLPanel)) =
    [ (Text
"↓↑", Text
"history")
    ]
      [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
"Enter", Text
"execute") | Bool -> Bool
not Bool
isReplWorking]
      [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(REPLEvent -> Text
keyR REPLEvent
SE.CancelRunningProgramEvent, Text
"cancel") | Bool
isReplWorking]
      [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(REPLEvent -> Text
keyR REPLEvent
SE.TogglePilotingModeEvent, ReplControlMode -> Text
renderPilotModeSwitch ReplControlMode
ctrlMode) | Bool
creative]
      [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(REPLEvent -> Text
keyR REPLEvent
SE.ToggleCustomKeyHandlingEvent, ReplControlMode -> Text
renderHandlerModeSwitch ReplControlMode
ctrlMode) | Bool
handlerInstalled]
      [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
"PgUp/Dn", Text
"scroll")]
  keyCmdsFor (Just (FocusablePanel FocusablePanel
WorldPanel)) =
    [(Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (WorldEvent -> Text) -> [WorldEvent] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map WorldEvent -> Text
keyW [WorldEvent]
forall a. (Enum a, Bounded a) => [a]
enumerate, Text
"scroll") | Bool
canScroll]
  keyCmdsFor (Just (FocusablePanel FocusablePanel
RobotPanel)) =
    (Text
"Enter", Text
"pop out")
      (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
inventorySearch
        then [(Text
"Esc", Text
"exit search")]
        else
          [ (RobotEvent -> Text
keyE RobotEvent
SE.MakeEntityEvent, Text
"make")
          , (RobotEvent -> Text
keyE RobotEvent
SE.ShowZeroInventoryEntitiesEvent, (if Bool
showZero then Text
"hide" else Text
"show") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 0")
          ,
            ( RobotEvent -> Text
keyE RobotEvent
SE.SwitchInventorySortDirection Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RobotEvent -> Text
keyE RobotEvent
SE.CycleInventorySortEvent
            , [Text] -> Text
T.unwords [Text
"Sort:", InventorySortOptions -> Text
renderSortMethod InventorySortOptions
inventorySort]
            )
          , (RobotEvent -> Text
keyE RobotEvent
SE.SearchInventoryEvent, Text
"search")
          ]
  keyCmdsFor (Just (FocusablePanel FocusablePanel
InfoPanel)) = []
  keyCmdsFor Maybe Name
_ = []
  keyM :: MainEvent -> Text
keyM = KeyConfig SwarmEvent -> SwarmEvent -> Text
VU.bindingText KeyConfig SwarmEvent
keyConf (SwarmEvent -> Text)
-> (MainEvent -> SwarmEvent) -> MainEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MainEvent -> SwarmEvent
SE.Main
  keyR :: REPLEvent -> Text
keyR = KeyConfig SwarmEvent -> SwarmEvent -> Text
VU.bindingText KeyConfig SwarmEvent
keyConf (SwarmEvent -> Text)
-> (REPLEvent -> SwarmEvent) -> REPLEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLEvent -> SwarmEvent
SE.REPL
  keyE :: RobotEvent -> Text
keyE = KeyConfig SwarmEvent -> SwarmEvent -> Text
VU.bindingText KeyConfig SwarmEvent
keyConf (SwarmEvent -> Text)
-> (RobotEvent -> SwarmEvent) -> RobotEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RobotEvent -> SwarmEvent
SE.Robot
  keyW :: WorldEvent -> Text
keyW = KeyConfig SwarmEvent -> SwarmEvent -> Text
VU.bindingText KeyConfig SwarmEvent
keyConf (SwarmEvent -> Text)
-> (WorldEvent -> SwarmEvent) -> WorldEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorldEvent -> SwarmEvent
SE.World

data KeyHighlight = NoHighlight | Alert | PanelSpecific

-- | Draw a single key command in the menu.
drawKeyCmd :: KeyCmd -> Widget Name
drawKeyCmd :: KeyCmd -> Widget Name
drawKeyCmd KeyCmd
keycmd =
  case KeyCmd
keycmd of
    (SingleButton KeyHighlight
h Text
key Text
cmd) ->
      Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (Text -> Name
UIShortcut Text
cmd) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox
          [ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr (KeyHighlight -> AttrName
attr KeyHighlight
h) (Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Text
brackets Text
key)
          , Text -> Widget Name
forall n. Text -> Widget n
txt Text
cmd
          ]
    (MultiButton KeyHighlight
h [(Text, Text)]
keyArr Text
cmd) ->
      [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"/") (((Text, Text) -> Widget Name) -> [(Text, Text)] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map (KeyHighlight -> (Text, Text) -> Widget Name
createCmd KeyHighlight
h) [(Text, Text)]
keyArr) [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Text -> Widget Name
forall n. Text -> Widget n
txt Text
cmd]
 where
  createCmd :: KeyHighlight -> (Text, Text) -> Widget Name
createCmd KeyHighlight
h (Text
key, Text
cmd) = Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (Text -> Name
UIShortcut Text
cmd) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr (KeyHighlight -> AttrName
attr KeyHighlight
h) (Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Text
brackets Text
key)
  attr :: KeyHighlight -> AttrName
attr KeyHighlight
h = case KeyHighlight
h of
    KeyHighlight
NoHighlight -> AttrName
defAttr
    KeyHighlight
Alert -> AttrName
notifAttr
    KeyHighlight
PanelSpecific -> AttrName
highlightAttr

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

-- | Compare to: 'Swarm.Util.Content.getMapRectangle'
worldWidget ::
  (Cosmic 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 = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$
  do
    Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
    let w :: Int
w = Context n
ctx Context n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
        h :: Int
h = Context n
ctx Context n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL
        vr :: Cosmic BoundsRectangle
vr = Cosmic Location -> (Int32, Int32) -> Cosmic BoundsRectangle
viewingRegion Cosmic Location
gameViewCenter (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w, Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
        ixs :: [Coords]
ixs = BoundsRectangle -> [Coords]
forall a. Ix a => (a, a) -> [a]
range (BoundsRectangle -> [Coords]) -> BoundsRectangle -> [Coords]
forall a b. (a -> b) -> a -> b
$ Cosmic BoundsRectangle
vr Cosmic BoundsRectangle
-> Getting BoundsRectangle (Cosmic BoundsRectangle) BoundsRectangle
-> BoundsRectangle
forall s a. s -> Getting a s a -> a
^. Getting BoundsRectangle (Cosmic BoundsRectangle) BoundsRectangle
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar
    Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> ([Coords] -> Widget n) -> [Coords] -> RenderM n (Result n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> ([Coords] -> [Widget n]) -> [Coords] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Widget n] -> Widget n) -> [[Widget n]] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
hBox ([[Widget n]] -> [Widget n])
-> ([Coords] -> [[Widget n]]) -> [Coords] -> [Widget n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Widget n] -> [[Widget n]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
w ([Widget n] -> [[Widget n]])
-> ([Coords] -> [Widget n]) -> [Coords] -> [[Widget n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coords -> Widget n) -> [Coords] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Cosmic Coords -> Widget n
renderCoord (Cosmic Coords -> Widget n)
-> (Coords -> Cosmic Coords) -> Coords -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubworldName -> Coords -> Cosmic Coords
forall a. SubworldName -> a -> Cosmic a
Cosmic (Cosmic BoundsRectangle
vr Cosmic BoundsRectangle
-> Getting SubworldName (Cosmic BoundsRectangle) SubworldName
-> SubworldName
forall s a. s -> Getting a s a -> a
^. Getting SubworldName (Cosmic BoundsRectangle) SubworldName
forall a (f :: * -> *).
Functor f =>
(SubworldName -> f SubworldName) -> Cosmic a -> f (Cosmic a)
subworld)) ([Coords] -> RenderM n (Result n))
-> [Coords] -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Coords]
ixs

-- | Draw the current world view.
drawWorldPane :: UIGameplay -> GameState -> Widget Name
drawWorldPane :: UIGameplay -> GameState -> Widget Name
drawWorldPane UIGameplay
ui GameState
g =
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
center
    (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
cached Name
WorldCache
    (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Widget Name -> Widget Name
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
    (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (FocusablePanel -> Name
FocusablePanel FocusablePanel
WorldPanel)
    (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Cosmic Coords -> Widget Name) -> Cosmic Location -> Widget Name
forall n.
(Cosmic Coords -> Widget n) -> Cosmic Location -> Widget n
worldWidget Cosmic Coords -> Widget Name
renderCoord (GameState
g GameState
-> Getting (Cosmic Location) GameState (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. (Robots -> Const (Cosmic Location) Robots)
-> GameState -> Const (Cosmic Location) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (Cosmic Location) Robots)
 -> GameState -> Const (Cosmic Location) GameState)
-> ((Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
    -> Robots -> Const (Cosmic Location) Robots)
-> Getting (Cosmic Location) GameState (Cosmic Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
-> Robots -> Const (Cosmic Location) Robots
Getter Robots (Cosmic Location)
viewCenter)
 where
  renderCoord :: Cosmic Coords -> Widget Name
renderCoord = UIGameplay -> GameState -> Cosmic Coords -> Widget Name
drawLoc UIGameplay
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 :: ScenarioState -> Widget Name
drawRobotPanel :: ScenarioState -> Widget Name
drawRobotPanel ScenarioState
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 <- ScenarioState
s ScenarioState
-> Getting (Maybe Robot) ScenarioState (Maybe Robot) -> Maybe Robot
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe Robot) GameState)
-> ScenarioState -> Const (Maybe Robot) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (Maybe Robot) GameState)
 -> ScenarioState -> Const (Maybe Robot) ScenarioState)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> GameState -> Const (Maybe Robot) GameState)
-> Getting (Maybe Robot) ScenarioState (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Maybe Robot)
-> (Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
-> GameState
-> Const (Maybe Robot) GameState
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot
  , Just (Int
_, List Name InventoryListEntry
lst) <- ScenarioState
s ScenarioState
-> Getting
     (Maybe (Int, List Name InventoryListEntry))
     ScenarioState
     (Maybe (Int, List Name InventoryListEntry))
-> Maybe (Int, List Name InventoryListEntry)
forall s a. s -> Getting a s a -> a
^. (UIGameplay
 -> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay)
-> ScenarioState
-> Const (Maybe (Int, List Name InventoryListEntry)) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay)
 -> ScenarioState
 -> Const (Maybe (Int, List Name InventoryListEntry)) ScenarioState)
-> ((Maybe (Int, List Name InventoryListEntry)
     -> Const
          (Maybe (Int, List Name InventoryListEntry))
          (Maybe (Int, List Name InventoryListEntry)))
    -> UIGameplay
    -> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay)
-> Getting
     (Maybe (Int, List Name InventoryListEntry))
     ScenarioState
     (Maybe (Int, List Name InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory
 -> Const (Maybe (Int, List Name InventoryListEntry)) UIInventory)
-> UIGameplay
-> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory
  -> Const (Maybe (Int, List Name InventoryListEntry)) UIInventory)
 -> UIGameplay
 -> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay)
-> ((Maybe (Int, List Name InventoryListEntry)
     -> Const
          (Maybe (Int, List Name InventoryListEntry))
          (Maybe (Int, List Name InventoryListEntry)))
    -> UIInventory
    -> Const (Maybe (Int, List Name InventoryListEntry)) UIInventory)
-> (Maybe (Int, List Name InventoryListEntry)
    -> Const
         (Maybe (Int, List Name InventoryListEntry))
         (Maybe (Int, List Name InventoryListEntry)))
-> UIGameplay
-> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Int, List Name InventoryListEntry)
 -> Const
      (Maybe (Int, List Name InventoryListEntry))
      (Maybe (Int, List Name InventoryListEntry)))
-> UIInventory
-> Const (Maybe (Int, List Name InventoryListEntry)) UIInventory
Lens' UIInventory (Maybe (Int, List Name InventoryListEntry))
uiInventoryList =
      let drawClickableItem :: Int -> Bool -> InventoryListEntry -> Widget Name
drawClickableItem Int
pos Bool
selb = Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (Int -> Name
InventoryListItem Int
pos) (Widget Name -> Widget Name)
-> (InventoryListEntry -> Widget Name)
-> InventoryListEntry
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Int -> Bool -> InventoryListEntry -> Widget Name
drawItem (List Name InventoryListEntry
lst List Name InventoryListEntry
-> Getting (Maybe Int) (List Name InventoryListEntry) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) (List Name InventoryListEntry) (Maybe Int)
forall n (t :: * -> *) e (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> GenericList n t e -> f (GenericList n t e)
BL.listSelectedL) Int
pos Bool
selb
          details :: [Widget n]
details =
            [ Text -> Widget n
forall n. Text -> Widget n
txt (Robot
r Robot -> Getting Text Robot Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Robot Text
Lens' Robot Text
robotName)
            , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) (Widget n -> Widget n)
-> (Cosmic Location -> Widget n) -> Cosmic Location -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget n
forall n. String -> Widget n
str (String -> Widget n)
-> (Cosmic Location -> String) -> Cosmic Location -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> String
renderCoordsString (Cosmic Location -> Widget n) -> Cosmic Location -> Widget n
forall a b. (a -> b) -> a -> b
$ Robot
r Robot
-> Getting (Cosmic Location) Robot (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
            , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Display -> Widget n
forall n. Display -> Widget n
renderDisplay (Robot
r Robot -> Getting Display Robot Display -> Display
forall s a. s -> Getting a s a -> a
^. Getting Display Robot Display
Lens' Robot Display
robotDisplay)
            ]
       in Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
              [ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox [Widget Name]
forall {n}. [Widget n]
details
              , Widget Name -> Widget Name
forall n. Widget n -> Widget n
withLeftPaddedVScrollBars (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                  (Int -> Bool -> InventoryListEntry -> Widget Name)
-> Bool -> List Name InventoryListEntry -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
BL.renderListWithIndex Int -> Bool -> InventoryListEntry -> Widget Name
drawClickableItem Bool
True List Name InventoryListEntry
lst
              ]
  | Bool
otherwise = Widget Name
blank

blank :: Widget Name
blank :: Widget Name
blank = Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
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 Int -> Int -> Bool -> InventoryListEntry -> Widget Name
drawItem Maybe Int
sel Int
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
  Bool -> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Maybe Int
sel Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Widget Name -> Widget Name
forall n. Widget n -> Widget n
visible (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
l)
drawItem Maybe Int
_ Int
_ Bool
_ (InventoryEntry Int
n Entity
e) = Entity -> Widget Name
forall n. Entity -> Widget n
drawLabelledEntityName Entity
e Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Int -> Widget Name
forall {n}. Int -> Widget n
showCount Int
n
 where
  showCount :: Int -> Widget n
showCount = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (Widget n -> Widget n) -> (Int -> Widget n) -> Int -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> (Int -> String) -> Int -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
drawItem Maybe Int
_ Int
_ Bool
_ (EquippedEntry Entity
e) = Entity -> Widget Name
forall n. Entity -> Widget n
drawLabelledEntityName Entity
e Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (String -> Widget Name
forall n. String -> Widget n
str String
" ")

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

-- | Draw the info panel in the bottom-left corner, which shows info
--   about the currently focused inventory item.
drawInfoPanel :: ScenarioState -> Widget Name
drawInfoPanel :: ScenarioState -> Widget Name
drawInfoPanel ScenarioState
s
  | Just RobotRange
Far <- ScenarioState
s ScenarioState
-> Getting (Maybe RobotRange) ScenarioState (Maybe RobotRange)
-> Maybe RobotRange
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe RobotRange) GameState)
-> ScenarioState -> Const (Maybe RobotRange) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (Maybe RobotRange) GameState)
 -> ScenarioState -> Const (Maybe RobotRange) ScenarioState)
-> ((Maybe RobotRange
     -> Const (Maybe RobotRange) (Maybe RobotRange))
    -> GameState -> Const (Maybe RobotRange) GameState)
-> Getting (Maybe RobotRange) ScenarioState (Maybe RobotRange)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Maybe RobotRange)
-> (Maybe RobotRange
    -> Const (Maybe RobotRange) (Maybe RobotRange))
-> GameState
-> Const (Maybe RobotRange) GameState
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 =
      VScrollBarOrientation -> Widget Name -> Widget Name
forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight
        (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
InfoViewport ViewportType
Vertical
        (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1
        (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ ScenarioState -> Widget Name
explainFocusedItem ScenarioState
s

-- | Display info about the currently focused inventory entity,
--   such as its description and relevant recipes.
explainFocusedItem :: ScenarioState -> Widget Name
explainFocusedItem :: ScenarioState -> Widget Name
explainFocusedItem ScenarioState
s = case ScenarioState -> Maybe InventoryListEntry
focusedItem ScenarioState
s of
  Just (InventoryEntry Int
_ Entity
e) -> UIGameplay -> GameState -> Entity -> Widget Name
explainEntry UIGameplay
uig GameState
gs Entity
e
  Just (EquippedEntry Entity
e) -> UIGameplay -> GameState -> Entity -> Widget Name
explainEntry UIGameplay
uig GameState
gs Entity
e
  Maybe InventoryListEntry
_ -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
" "
 where
  gs :: GameState
gs = ScenarioState
s ScenarioState
-> Getting GameState ScenarioState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState ScenarioState GameState
Lens' ScenarioState GameState
gameState
  uig :: UIGameplay
uig = ScenarioState
s ScenarioState
-> Getting UIGameplay ScenarioState UIGameplay -> UIGameplay
forall s a. s -> Getting a s a -> a
^. Getting UIGameplay ScenarioState UIGameplay
Lens' ScenarioState UIGameplay
uiGameplay

explainEntry :: UIGameplay -> GameState -> Entity -> Widget Name
explainEntry :: UIGameplay -> GameState -> Entity -> Widget Name
explainEntry UIGameplay
uig GameState
gs Entity
e =
  [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$
    [ [EntityProperty] -> Widget Name
displayProperties ([EntityProperty] -> Widget Name)
-> [EntityProperty] -> Widget Name
forall a b. (a -> b) -> a -> b
$ Set EntityProperty -> [EntityProperty]
forall a. Set a -> [a]
Set.toList (Entity
e Entity
-> Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Set EntityProperty
forall s a. s -> Getting a s a -> a
^. Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties)
    , Document Syntax -> Widget Name
drawMarkdown (Entity
e Entity
-> Getting (Document Syntax) Entity (Document Syntax)
-> Document Syntax
forall s a. s -> Getting a s a -> a
^. Getting (Document Syntax) Entity (Document Syntax)
Lens' Entity (Document Syntax)
entityDescription)
    , GameState -> Entity -> Widget Name
explainCapabilities GameState
gs Entity
e
    , GameState -> Entity -> Widget Name
explainRecipes GameState
gs Entity
e
    ]
      [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. Semigroup a => a -> a -> a
<> [GameState -> Bool -> Widget Name
drawRobotMachine GameState
gs Bool
False | Capability
CDebug Capability -> Map Capability (ExerciseCost Text) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (Entity
e Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities)]
      [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. Semigroup a => a -> a -> a
<> [UIGameplay -> GameState -> Widget Name
drawRobotLog UIGameplay
uig GameState
gs | Const -> Capability
CExecute Const
Log Capability -> Map Capability (ExerciseCost Text) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Capabilities (ExerciseCost Text)
-> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (Entity
e Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities)]

displayProperties :: [EntityProperty] -> Widget Name
displayProperties :: [EntityProperty] -> Widget Name
displayProperties = [Text] -> Widget Name
forall {n}. [Text] -> Widget n
displayList ([Text] -> Widget Name)
-> ([EntityProperty] -> [Text]) -> [EntityProperty] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityProperty -> Maybe Text) -> [EntityProperty] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe EntityProperty -> Maybe Text
forall {a}. IsString a => EntityProperty -> Maybe a
showProperty
 where
  showProperty :: EntityProperty -> Maybe a
showProperty EntityProperty
Growable = a -> Maybe a
forall a. a -> Maybe a
Just a
"growing"
  showProperty EntityProperty
Pushable = a -> Maybe a
forall a. a -> Maybe a
Just a
"pushable"
  showProperty EntityProperty
Combustible = a -> Maybe a
forall a. a -> Maybe a
Just a
"combustible"
  showProperty EntityProperty
Infinite = a -> Maybe a
forall a. a -> Maybe a
Just a
"infinite"
  showProperty EntityProperty
Liquid = a -> Maybe a
forall a. a -> Maybe a
Just a
"liquid"
  showProperty EntityProperty
Unwalkable = a -> Maybe a
forall a. a -> Maybe a
Just a
"blocking"
  showProperty EntityProperty
Opaque = a -> Maybe a
forall a. a -> Maybe a
Just a
"opaque"
  showProperty EntityProperty
Boundary = a -> Maybe a
forall a. a -> Maybe a
Just a
"boundary"
  showProperty EntityProperty
Evanescent = a -> Maybe a
forall a. a -> Maybe a
Just a
"evanescent"
  -- Most things are pickable so we don't show that.
  showProperty EntityProperty
Pickable = Maybe a
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 = Maybe a
forall a. Maybe a
Nothing
  showProperty EntityProperty
Printable = a -> Maybe a
forall a. a -> Maybe a
Just a
"printable"

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

-- | This widget can have potentially multiple "headings"
-- (one per capability), each with multiple commands underneath.
-- Directly below each heading there will be a "exercise cost"
-- description, unless the capability is free-to-exercise.
explainCapabilities :: GameState -> Entity -> Widget Name
explainCapabilities :: GameState -> Entity -> Widget Name
explainCapabilities GameState
gs Entity
e
  | [CommandsAndCost Entity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CommandsAndCost Entity]
capabilitiesAndCommands = Widget Name
forall {n}. Widget n
emptyWidget
  | Bool
otherwise =
      Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
          [ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Enabled commands")
          , Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter
              (Widget Name -> Widget Name)
-> ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
              ([Widget Name] -> Widget Name)
-> ([Widget Name] -> [Widget Name]) -> [Widget Name] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
L.intersperse (Text -> Widget Name
forall n. Text -> Widget n
txt Text
" ") -- Inserts an extra blank line between major "Cost" sections
              ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ (CommandsAndCost Entity -> Widget Name)
-> [CommandsAndCost Entity] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map CommandsAndCost Entity -> Widget Name
forall {n}. CommandsAndCost Entity -> Widget n
drawSingleCapabilityWidget [CommandsAndCost Entity]
capabilitiesAndCommands
          ]
 where
  eLookup :: Text -> Either Text Entity
eLookup = Map Text Entity -> Text -> Either Text Entity
forall b. Map Text b -> Text -> Either Text b
lookupEntityE (Map Text Entity -> Text -> Either Text Entity)
-> Map Text Entity -> Text -> Either Text Entity
forall a b. (a -> b) -> a -> b
$ EntityMap -> Map Text Entity
entitiesByName (EntityMap -> Map Text Entity) -> EntityMap -> Map Text Entity
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState -> Getting EntityMap GameState EntityMap -> EntityMap
forall s a. s -> Getting a s a -> a
^. (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap
  eitherCosts :: Either Text (Capabilities (ExerciseCost Entity))
eitherCosts = ((ExerciseCost Text -> Either Text (ExerciseCost Entity))
-> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Capabilities a -> f (Capabilities b)
traverse ((ExerciseCost Text -> Either Text (ExerciseCost Entity))
 -> Capabilities (ExerciseCost Text)
 -> Either Text (Capabilities (ExerciseCost Entity)))
-> ((Text -> Either Text Entity)
    -> ExerciseCost Text -> Either Text (ExerciseCost Entity))
-> (Text -> Either Text Entity)
-> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text Entity)
-> ExerciseCost Text -> Either Text (ExerciseCost Entity)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExerciseCost a -> f (ExerciseCost b)
traverse) Text -> Either Text Entity
eLookup (Capabilities (ExerciseCost Text)
 -> Either Text (Capabilities (ExerciseCost Entity)))
-> Capabilities (ExerciseCost Text)
-> Either Text (Capabilities (ExerciseCost Entity))
forall a b. (a -> b) -> a -> b
$ Entity
e Entity
-> Getting
     (Capabilities (ExerciseCost Text))
     Entity
     (Capabilities (ExerciseCost Text))
-> Capabilities (ExerciseCost Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Capabilities (ExerciseCost Text))
  Entity
  (Capabilities (ExerciseCost Text))
Lens' Entity (Capabilities (ExerciseCost Text))
entityCapabilities
  capabilitiesAndCommands :: [CommandsAndCost Entity]
capabilitiesAndCommands = case Either Text (Capabilities (ExerciseCost Entity))
eitherCosts of
    Right Capabilities (ExerciseCost Entity)
eCaps -> Map Capability (CommandsAndCost Entity) -> [CommandsAndCost Entity]
forall k a. Map k a -> [a]
M.elems (Map Capability (CommandsAndCost Entity)
 -> [CommandsAndCost Entity])
-> (Capabilities (ExerciseCost Entity)
    -> Map Capability (CommandsAndCost Entity))
-> Capabilities (ExerciseCost Entity)
-> [CommandsAndCost Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (CommandsAndCost Entity)
-> Map Capability (CommandsAndCost Entity)
forall e. Capabilities e -> Map Capability e
getMap (Capabilities (CommandsAndCost Entity)
 -> Map Capability (CommandsAndCost Entity))
-> (Capabilities (ExerciseCost Entity)
    -> Capabilities (CommandsAndCost Entity))
-> Capabilities (ExerciseCost Entity)
-> Map Capability (CommandsAndCost Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capabilities (ExerciseCost Entity)
-> Capabilities (CommandsAndCost Entity)
forall e.
SingleEntityCapabilities e -> Capabilities (CommandsAndCost e)
commandsForDeviceCaps (Capabilities (ExerciseCost Entity) -> [CommandsAndCost Entity])
-> Capabilities (ExerciseCost Entity) -> [CommandsAndCost Entity]
forall a b. (a -> b) -> a -> b
$ Capabilities (ExerciseCost Entity)
eCaps
    -- The Left case should never happen - we check when parsing a
    -- scenario that all entity references are defined.  However, if
    -- it does happen, there's no sense crashing the game; just
    -- return an empty list of capabilities + commands.
    Left Text
_ -> []

  drawSingleCapabilityWidget :: CommandsAndCost Entity -> Widget n
drawSingleCapabilityWidget CommandsAndCost Entity
cmdsAndCost =
    [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox
      [ CommandsAndCost Entity -> Widget n
forall {n}. CommandsAndCost Entity -> Widget n
costWidget CommandsAndCost Entity
cmdsAndCost
      , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget n -> Widget n)
-> (NonEmpty Const -> Widget n) -> NonEmpty Const -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> (NonEmpty Const -> [Widget n]) -> NonEmpty Const -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Widget n) -> [Const] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Const -> Widget n
forall {n}. Const -> Widget n
renderCmdInfo ([Const] -> [Widget n])
-> (NonEmpty Const -> [Const]) -> NonEmpty Const -> [Widget n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Const -> [Const]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Const -> Widget n) -> NonEmpty Const -> Widget n
forall a b. (a -> b) -> a -> b
$ CommandsAndCost Entity -> NonEmpty Const
forall e. CommandsAndCost e -> NonEmpty Const
enabledCommands CommandsAndCost Entity
cmdsAndCost
      ]

  renderCmdInfo :: Const -> Widget n
renderCmdInfo Const
c =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
      Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
      let w :: Int
w = Context n
ctx Context n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
          constType :: Polytype
constType = Const -> Polytype
inferConst Const
c
          info :: ConstInfo
info = Const -> ConstInfo
constInfo Const
c
          requiredWidthForTypes :: Int
requiredWidthForTypes = Text -> Int
forall a. TextWidth a => a -> Int
textWidth (ConstInfo -> Text
syntax ConstInfo
info Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Polytype -> Text
forall a. PrettyPrec a => a -> Text
prettyTextLine Polytype
constType)
      Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render
        (Widget n -> RenderM n (Result n))
-> (Widget n -> Widget n) -> Widget n -> RenderM n (Result n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1)
        (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox
          [ [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
hBox
              [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ ConstInfo -> Text
syntax ConstInfo
info)
              , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Text -> Widget n
forall n. Text -> Widget n
txt Text
":")
              , if Int
requiredWidthForTypes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w
                  then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
magentaAttr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Polytype -> Text
forall a. PrettyPrec a => a -> Text
prettyTextLine Polytype
constType
                  else Widget n
forall {n}. Widget n
emptyWidget
              ]
          , [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
              if Int
requiredWidthForTypes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w
                then
                  [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Text -> Widget n
forall n. Text -> Widget n
txt Text
" ")
                  , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
magentaAttr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Polytype -> Int -> Text
forall a. PrettyPrec a => a -> Int -> Text
prettyTextWidth Polytype
constType (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
                  ]
                else [Widget n
forall {n}. Widget n
emptyWidget]
          , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n)
-> (ConstDoc -> Widget n) -> ConstDoc -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget n -> Widget n)
-> (ConstDoc -> Widget n) -> ConstDoc -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txtWrap (Text -> Widget n) -> (ConstDoc -> Text) -> ConstDoc -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstDoc -> Text
briefDoc (ConstDoc -> Widget n) -> ConstDoc -> Widget n
forall a b. (a -> b) -> a -> b
$ ConstInfo -> ConstDoc
constDoc ConstInfo
info
          ]

  costWidget :: CommandsAndCost Entity -> Widget n
costWidget CommandsAndCost Entity
cmdsAndCost =
    if [(Int, Entity)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Entity)]
ings
      then Widget n
forall {n}. Widget n
emptyWidget
      else Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Text -> Widget n
forall n. Text -> Widget n
txt Text
"Cost:") Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: ((Int, Entity) -> Widget n) -> [(Int, Entity)] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> Widget n
forall {n}. (Int, Entity) -> Widget n
drawCost [(Int, Entity)]
ings
   where
    ings :: [(Int, Entity)]
ings = ExerciseCost Entity -> [(Int, Entity)]
forall e. ExerciseCost e -> IngredientList e
ingredients (ExerciseCost Entity -> [(Int, Entity)])
-> ExerciseCost Entity -> [(Int, Entity)]
forall a b. (a -> b) -> a -> b
$ CommandsAndCost Entity -> ExerciseCost Entity
forall e. CommandsAndCost e -> ExerciseCost e
commandCost CommandsAndCost Entity
cmdsAndCost

  drawCost :: (Int, Entity) -> Widget n
drawCost (Int
n, Entity
ingr) =
    Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (String -> Widget n
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show Int
n)) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall {n}. Widget n
eName
   where
    eName :: Widget n
eName = Maybe Entity -> Bool -> Entity -> Widget n -> Widget n
forall n. Maybe Entity -> Bool -> Entity -> Widget n -> Widget n
applyEntityNameAttr Maybe Entity
forall a. Maybe a
Nothing Bool
missing Entity
ingr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Entity
ingr Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName
    missing :: Bool
missing = Entity -> Inventory -> Int
E.lookup Entity
ingr Inventory
robotInv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n

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

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

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

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

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

-- | Return all recipes that involve a given entity.
recipesWith :: GameState -> Entity -> [Recipe Entity]
recipesWith :: GameState -> Entity -> [Recipe Entity]
recipesWith GameState
gs 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 (GameState
gs GameState
-> Getting
     (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
-> IntMap [Recipe Entity]
forall s a. s -> Getting a s a -> a
^. (Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> GameState -> Const (IntMap [Recipe Entity]) GameState
Lens' GameState Recipes
recipesInfo ((Recipes -> Const (IntMap [Recipe Entity]) Recipes)
 -> GameState -> Const (IntMap [Recipe Entity]) GameState)
-> ((IntMap [Recipe Entity]
     -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
    -> Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> Getting
     (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
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.
      [Recipe Entity] -> [Recipe Entity]
forall a. Eq a => [a] -> [a]
L.nub ([Recipe Entity] -> [Recipe Entity])
-> [Recipe Entity] -> [Recipe Entity]
forall a b. (a -> b) -> a -> b
$
        [[Recipe Entity]] -> [Recipe Entity]
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 (IntMap [Recipe Entity]
 -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> Recipes -> Const (IntMap [Recipe Entity]) Recipes
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 (IntMap [Recipe Entity]
 -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> Recipes -> Const (IntMap [Recipe Entity]) Recipes
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 (IntMap [Recipe Entity]
 -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> Recipes -> Const (IntMap [Recipe Entity]) Recipes
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 [(Int, Entity)]
ins [(Int, Entity)]
outs [(Int, Entity)]
reqs Integer
time Integer
_weight) =
  [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
    -- any requirements (e.g. furnace) go on top.
    [ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [(Int, Entity)] -> Widget Name
drawReqs [(Int, Entity)]
reqs
    , -- then we draw inputs, a connector, and outputs.
      [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox
        [ [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ((Int -> (Int, Entity) -> Widget Name)
-> [Int] -> [(Int, Entity)] -> [Widget Name]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Int, Entity) -> Widget Name
drawIn [Int
0 ..] ([(Int, Entity)]
ins [(Int, Entity)] -> [(Int, Entity)] -> [(Int, Entity)]
forall a. Semigroup a => a -> a -> a
<> [(Int, Entity)]
times))
        , Widget Name
forall {n}. Widget n
connector
        , [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ((Int -> (Int, Entity) -> Widget Name)
-> [Int] -> [(Int, Entity)] -> [Widget Name]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Int, Entity) -> Widget Name
drawOut [Int
0 ..] [(Int, 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
    | [(Int, Entity)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Entity)]
reqs = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
5 Widget n
forall {n}. Widget n
hBorder
    | Bool
otherwise =
        [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
hBox
          [ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
2 Widget n
forall {n}. Widget n
hBorder
          , Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
True)
          , Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
2 Widget n
forall {n}. Widget n
hBorder
          ]
  inLen :: Int
inLen = [(Int, Entity)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Entity)]
ins Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(Int, Entity)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Entity)]
times
  outLen :: Int
outLen = [(Int, Entity)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Entity)]
outs
  times :: [(Int, Entity)]
times = [(Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
time, Entity
timeE) | Integer
time Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1]

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

  drawOut :: Int -> (Int, Entity) -> Widget Name
drawOut Int
i (Int
n, Entity
ingr) =
    [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox
      [ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
          ( Edges Bool -> Widget Name
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
outLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool
False Bool
True)
              Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
outLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                then Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> (Text -> [Text]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Entity
ingr Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName) Widget Name
forall {n}. Widget n
vBorder
                else Widget Name
forall {n}. Widget n
emptyWidget
          )
            Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall {n}. Widget n
hBorder
      , Bool -> Entity -> Widget Name
forall n. Bool -> Entity -> Widget n
fmtEntityName Bool
False Entity
ingr
      , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show Int
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 :: forall n. Bool -> Entity -> Widget n
fmtEntityName Bool
missing Entity
ingr =
    Maybe Entity -> Bool -> Entity -> Widget n -> Widget n
forall n. Maybe Entity -> Bool -> Entity -> Widget n -> Widget n
applyEntityNameAttr Maybe Entity
me Bool
missing Entity
ingr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txtLines Text
nm
   where
    -- Split up multi-word names, one line per word
    nm :: Text
nm = Entity
ingr Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName
    txtLines :: Text -> Widget n
txtLines = [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> (Text -> [Widget n]) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget n
forall n. Text -> Widget n
txt ([Text] -> [Widget n]) -> (Text -> [Text]) -> Text -> [Widget n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words

applyEntityNameAttr :: Maybe Entity -> Bool -> Entity -> (Widget n -> Widget n)
applyEntityNameAttr :: forall n. Maybe Entity -> Bool -> Entity -> Widget n -> Widget n
applyEntityNameAttr Maybe Entity
me Bool
missing Entity
ingr
  | Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
ingr Maybe Entity -> Maybe Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Entity
me = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightAttr
  | Entity
ingr Entity -> Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity
timeE = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr
  | Bool
missing = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
invalidFormInputAttr
  | Bool
otherwise = Widget n -> Widget n
forall a. a -> a
id

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

drawReqs :: IngredientList Entity -> Widget Name
drawReqs :: [(Int, Entity)] -> Widget Name
drawReqs = [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> ([(Int, Entity)] -> [Widget Name])
-> [(Int, Entity)]
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> Widget Name) -> [(Int, Entity)] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map (Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> ((Int, Entity) -> Widget Name) -> (Int, Entity) -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Widget Name
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) = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName
  drawReq (a
n, Entity
e) = String -> Widget n
forall n. String -> Widget n
str (a -> String
forall a. Show a => a -> String
show a
n) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt Text
" " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt (Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName)

indent2 :: WrapSettings
indent2 :: WrapSettings
indent2 = WrapSettings
defaultWrapSettings {fillStrategy = FillIndent 2}

-- | Only show the most recent entry, and any entries which were
--   produced by "say" or "log" commands.  Other entries (i.e. errors
--   or command status reports) are thus ephemeral, i.e. they are only
--   shown when they are the most recent log entry, but hidden once
--   something else is logged.
getLogEntriesToShow :: GameState -> [LogEntry]
getLogEntriesToShow :: GameState -> [LogEntry]
getLogEntriesToShow GameState
gs = Seq LogEntry
logEntries Seq LogEntry
-> Getting (Endo [LogEntry]) (Seq LogEntry) LogEntry -> [LogEntry]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Indexed Int LogEntry (Const (Endo [LogEntry]) LogEntry)
-> Seq LogEntry -> Const (Endo [LogEntry]) (Seq LogEntry)
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int (Seq LogEntry) (Seq LogEntry) LogEntry LogEntry
traversed (Indexed Int LogEntry (Const (Endo [LogEntry]) LogEntry)
 -> Seq LogEntry -> Const (Endo [LogEntry]) (Seq LogEntry))
-> ((LogEntry -> Const (Endo [LogEntry]) LogEntry)
    -> Indexed Int LogEntry (Const (Endo [LogEntry]) LogEntry))
-> Getting (Endo [LogEntry]) (Seq LogEntry) LogEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> LogEntry -> Bool)
-> (LogEntry -> Const (Endo [LogEntry]) LogEntry)
-> Indexed Int LogEntry (Const (Endo [LogEntry]) LogEntry)
forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Applicative f) =>
(i -> a -> Bool) -> Optical' p (Indexed i) f a a
ifiltered Int -> LogEntry -> Bool
shouldShow
 where
  logEntries :: Seq LogEntry
logEntries = GameState
gs GameState
-> Getting (Seq LogEntry) GameState (Seq LogEntry) -> Seq LogEntry
forall s a. s -> Getting a s a -> a
^. (GameState -> Maybe Robot)
-> (Maybe Robot -> Const (Seq LogEntry) (Maybe Robot))
-> GameState
-> Const (Seq LogEntry) GameState
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot ((Maybe Robot -> Const (Seq LogEntry) (Maybe Robot))
 -> GameState -> Const (Seq LogEntry) GameState)
-> ((Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
    -> Maybe Robot -> Const (Seq LogEntry) (Maybe Robot))
-> Getting (Seq LogEntry) GameState (Seq LogEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Const (Seq LogEntry) Robot)
-> Maybe Robot -> Const (Seq LogEntry) (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Const (Seq LogEntry) Robot)
 -> Maybe Robot -> Const (Seq LogEntry) (Maybe Robot))
-> ((Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
    -> Robot -> Const (Seq LogEntry) Robot)
-> (Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
-> Maybe Robot
-> Const (Seq LogEntry) (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
-> Robot -> Const (Seq LogEntry) Robot
Lens' Robot (Seq LogEntry)
robotLog
  n :: Int
n = Seq LogEntry -> Int
forall a. Seq a -> Int
Seq.length Seq LogEntry
logEntries

  shouldShow :: Int -> LogEntry -> Bool
shouldShow Int
i LogEntry
le =
    (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool -> Bool -> Bool
|| case LogEntry
le LogEntry -> Getting LogSource LogEntry LogSource -> LogSource
forall s a. s -> Getting a s a -> a
^. Getting LogSource LogEntry LogSource
Lens' LogEntry LogSource
leSource of
      RobotLog RobotLogSource
src Int
_ Cosmic Location
_ -> RobotLogSource
src RobotLogSource -> [RobotLogSource] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RobotLogSource
Said, RobotLogSource
Logged]
      LogSource
SystemLog -> Bool
False

drawRobotLog :: UIGameplay -> GameState -> Widget Name
drawRobotLog :: UIGameplay -> GameState -> Widget Name
drawRobotLog UIGameplay
uig GameState
gs =
  [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
    [ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Log"))
    , [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> ([LogEntry] -> [Widget Name]) -> [LogEntry] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget Name] -> [Widget Name]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList ([Widget Name] -> [Widget Name])
-> ([LogEntry] -> [Widget Name]) -> [LogEntry] -> [Widget Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> LogEntry -> Widget Name) -> [LogEntry] -> [Widget Name]
forall a b. (Int -> a -> b) -> [a] -> [b]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap Int -> LogEntry -> Widget Name
forall {n}. Int -> LogEntry -> Widget n
drawEntry ([LogEntry] -> Widget Name) -> [LogEntry] -> Widget Name
forall a b. (a -> b) -> a -> b
$ [LogEntry]
logEntriesToShow
    ]
 where
  logEntriesToShow :: [LogEntry]
logEntriesToShow = GameState -> [LogEntry]
getLogEntriesToShow GameState
gs
  n :: Int
n = [LogEntry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LogEntry]
logEntriesToShow
  drawEntry :: Int -> LogEntry -> Widget n
drawEntry Int
i LogEntry
e =
    Bool -> (Widget n -> Widget n) -> Widget n -> Widget n
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& UIGameplay
uig UIGameplay -> Getting Bool UIGameplay Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UIGameplay Bool
Lens' UIGameplay Bool
uiScrollToEnd) Widget n -> Widget n
forall n. Widget n -> Widget n
visible (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
      Bool -> LogEntry -> Widget n
forall a. Bool -> LogEntry -> Widget a
drawLogEntry (Bool -> Bool
not Bool
allMe) LogEntry
e

  rid :: Maybe Int
rid = GameState
gs GameState -> Getting (First Int) GameState Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Maybe Robot)
-> (Maybe Robot -> Const (First Int) (Maybe Robot))
-> GameState
-> Const (First Int) GameState
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot ((Maybe Robot -> Const (First Int) (Maybe Robot))
 -> GameState -> Const (First Int) GameState)
-> ((Int -> Const (First Int) Int)
    -> Maybe Robot -> Const (First Int) (Maybe Robot))
-> Getting (First Int) GameState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Const (First Int) Robot)
-> Maybe Robot -> Const (First Int) (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Const (First Int) Robot)
 -> Maybe Robot -> Const (First Int) (Maybe Robot))
-> ((Int -> Const (First Int) Int)
    -> Robot -> Const (First Int) Robot)
-> (Int -> Const (First Int) Int)
-> Maybe Robot
-> Const (First Int) (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (First Int) Int) -> Robot -> Const (First Int) Robot
Getter Robot Int
robotID

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

-- | Show the 'CESK' machine of focused robot. Puts a separator above.
drawRobotMachine :: GameState -> Bool -> Widget Name
drawRobotMachine :: GameState -> Bool -> Widget Name
drawRobotMachine GameState
gs Bool
showName = case GameState
gs GameState
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> GameState -> Const (Maybe Robot) GameState)
-> Maybe Robot
forall s a. s -> Getting a s a -> a
^. (GameState -> Maybe Robot)
-> (Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
-> GameState
-> Const (Maybe Robot) GameState
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 -> Text -> Widget Name
forall n. Text -> Widget n
machineLine Text
"no selected robot"
  Just Robot
r ->
    [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
      [ Text -> Widget Name
forall n. Text -> Widget n
machineLine (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Robot
r Robot -> Getting Text Robot Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Robot Text
Lens' Robot Text
robotName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Robot
r Robot -> Getting Text Robot Text -> Text
forall s a. s -> Getting a s a -> a
^. (Int -> Const Text Int) -> Robot -> Const Text Robot
Getter Robot Int
robotID ((Int -> Const Text Int) -> Robot -> Const Text Robot)
-> ((Text -> Const Text Text) -> Int -> Const Text Int)
-> Getting Text Robot Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text) -> (Text -> Const Text Text) -> Int -> Const Text Int
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Int -> Text
tshow
      , Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Robot
r Robot -> Getting Text Robot Text -> Text
forall s a. s -> Getting a s a -> a
^. (CESK -> Const Text CESK) -> Robot -> Const Text Robot
Lens' Robot CESK
machine ((CESK -> Const Text CESK) -> Robot -> Const Text Robot)
-> ((Text -> Const Text Text) -> CESK -> Const Text CESK)
-> Getting Text Robot Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Text)
-> (Text -> Const Text Text) -> CESK -> Const Text CESK
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to CESK -> Text
forall a. PrettyPrec a => a -> Text
prettyText
      ]
 where
  tshow :: Int -> Text
tshow = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
  hLine :: Text -> Widget n
hLine Text
t = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget n -> Widget n
forall n. Widget n -> Widget n
hBorderWithLabel (Text -> Widget n
forall n. Text -> Widget n
txt Text
t))
  machineLine :: Text -> Widget n
machineLine Text
r = Text -> Widget n
forall n. Text -> Widget n
hLine (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ if Bool
showName then Text
"Machine [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r Text -> Text -> Text
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 =
  AttrName -> Widget a -> Widget a
forall n. AttrName -> Widget n -> Widget n
withAttr (LogEntry -> AttrName
colorLogs LogEntry
e) (Widget a -> Widget a) -> (Text -> Widget a) -> Text -> Widget a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapSettings -> Text -> Widget a
forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
indent2 (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$
    if Bool
addName then Text
name else Text
t
 where
  t :: Text
t = LogEntry
e LogEntry -> Getting Text LogEntry Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text LogEntry Text
Lens' LogEntry Text
leText
  name :: Text
name =
    Text
"["
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Getting Text LogEntry Text -> LogEntry -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text LogEntry Text
Lens' LogEntry Text
leName LogEntry
e
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case LogEntry
e LogEntry -> Getting LogSource LogEntry LogSource -> LogSource
forall s a. s -> Getting a s a -> a
^. Getting LogSource LogEntry LogSource
Lens' LogEntry LogSource
leSource of
        RobotLog RobotLogSource
Said Int
_ Cosmic Location
_ -> Text
"said " Text -> Text -> Text
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]
_) = Text -> Widget Name
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 -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"[nothing found] "
    Just Text
lastentry
      | Text -> Bool
T.null Text
t -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
"[find] "
      | Bool
otherwise -> Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"[found: \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lastentry Text -> Text -> Text
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 Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
replE
 where
  prompt :: REPLPrompt
prompt = REPLState
theRepl REPLState -> Getting REPLPrompt REPLState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType
  replEditor :: Editor Text Name
replEditor = REPLState
theRepl REPLState
-> Getting (Editor Text Name) REPLState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^. Getting (Editor Text Name) REPLState (Editor Text Name)
Lens' REPLState (Editor Text Name)
replPromptEditor
  color :: Text -> Widget n
color Text
t =
    case REPLState
theRepl REPLState
-> Getting (Either SrcLoc ()) REPLState (Either SrcLoc ())
-> Either SrcLoc ()
forall s a. s -> Getting a s a -> a
^. Getting (Either SrcLoc ()) REPLState (Either SrcLoc ())
Lens' REPLState (Either SrcLoc ())
replValid of
      Right () -> Text -> Widget n
forall n. Text -> Widget n
txt Text
t
      Left SrcLoc
NoLoc -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr (Text -> Widget n
forall n. Text -> Widget n
txt Text
t)
      Left (SrcLoc Int
s Int
e) | Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
e Bool -> Bool -> Bool
|| Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
t -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr (Text -> Widget n
forall n. Text -> Widget n
txt Text
t)
      Left (SrcLoc Int
s Int
e) ->
        let (Text
validL, (Text
invalid, Text
validR)) = Int -> Text -> (Text, Text)
T.splitAt (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Text -> (Text, Text)) -> (Text, Text) -> (Text, (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Text -> (Text, Text)
T.splitAt Int
s Text
t
         in [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
hBox [Text -> Widget n
forall n. Text -> Widget n
txt Text
validL, AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr (Text -> Widget n
forall n. Text -> Widget n
txt Text
invalid), Text -> Widget n
forall n. Text -> Widget n
txt Text
validR]
  ps1 :: Widget Name
ps1 = Text -> REPLPrompt -> Widget Name
replPromptAsWidget ([Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
replEditor) REPLPrompt
prompt
  replE :: Widget Name
replE =
    ([Text] -> Widget Name) -> Bool -> Editor Text Name -> Widget Name
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor
      ([Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox ([Widget Name] -> Widget Name)
-> ([Text] -> [Widget Name]) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Widget Name) -> [Text] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Widget Name
forall n. Text -> Widget n
color)
      (FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focus Maybe Name -> [Maybe Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Name
forall a. Maybe a
Nothing, Name -> Maybe Name
forall a. a -> Maybe a
Just (FocusablePanel -> Name
FocusablePanel FocusablePanel
REPLPanel), Name -> Maybe Name
forall a. a -> Maybe a
Just Name
REPLInput])
      Editor Text Name
replEditor

-- | Draw the REPL.
drawREPL :: ScenarioState -> Widget Name
drawREPL :: ScenarioState -> Widget Name
drawREPL ScenarioState
ps =
  [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
    [ Widget Name -> Widget Name
forall n. Widget n -> Widget n
withLeftPaddedVScrollBars
        (Widget Name -> Widget Name)
-> ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
REPLViewport ViewportType
Vertical
        (Widget Name -> Widget Name)
-> ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox
        ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
cached Name
REPLHistoryCache ([Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox [Widget Name]
forall {n}. [Widget n]
history), Widget Name
currentPrompt]
    , [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox [Widget Name]
mayDebug
    ]
 where
  uig :: UIGameplay
uig = ScenarioState
ps ScenarioState
-> Getting UIGameplay ScenarioState UIGameplay -> UIGameplay
forall s a. s -> Getting a s a -> a
^. Getting UIGameplay ScenarioState UIGameplay
Lens' ScenarioState UIGameplay
uiGameplay
  gs :: GameState
gs = ScenarioState
ps ScenarioState
-> Getting GameState ScenarioState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState ScenarioState GameState
Lens' ScenarioState GameState
gameState

  -- rendered history lines fitting above REPL prompt
  history :: [Widget n]
  history :: forall {n}. [Widget n]
history = (REPLHistItem -> Widget n) -> [REPLHistItem] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map REPLHistItem -> Widget n
forall {n}. REPLHistItem -> Widget n
fmt ([REPLHistItem] -> [Widget n])
-> (REPLHistory -> [REPLHistItem]) -> REPLHistory -> [Widget n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistItem -> Bool) -> [REPLHistItem] -> [REPLHistItem]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (REPLHistItem -> Bool) -> REPLHistItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistItem -> Bool
isREPLSaved) ([REPLHistItem] -> [REPLHistItem])
-> (REPLHistory -> [REPLHistItem]) -> REPLHistory -> [REPLHistItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq REPLHistItem -> [REPLHistItem]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq REPLHistItem -> [REPLHistItem])
-> (REPLHistory -> Seq REPLHistItem)
-> REPLHistory
-> [REPLHistItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistory -> Seq REPLHistItem
getSessionREPLHistoryItems (REPLHistory -> [Widget n]) -> REPLHistory -> [Widget n]
forall a b. (a -> b) -> a -> b
$ REPLState
theRepl REPLState
-> Getting REPLHistory REPLState REPLHistory -> REPLHistory
forall s a. s -> Getting a s a -> a
^. Getting REPLHistory REPLState REPLHistory
Lens' REPLState REPLHistory
replHistory
  currentPrompt :: Widget Name
  currentPrompt :: Widget Name
currentPrompt = case (Robot -> Bool
isActive (Robot -> Bool) -> Maybe Robot -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
base, REPLState
theRepl REPLState
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> REPLState -> Const ReplControlMode REPLState)
-> ReplControlMode
forall s a. s -> Getting a s a -> a
^. (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> REPLState -> Const ReplControlMode REPLState
Lens' REPLState ReplControlMode
replControlMode) of
    (Maybe Bool
_, ReplControlMode
Handling) -> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"[key handler running, M-k to toggle]"
    (Just Bool
False, ReplControlMode
_) -> FocusRing Name -> REPLState -> Widget Name
renderREPLPrompt (UIGameplay
uig UIGameplay
-> Getting (FocusRing Name) UIGameplay (FocusRing Name)
-> FocusRing Name
forall s a. s -> Getting a s a -> a
^. Getting (FocusRing Name) UIGameplay (FocusRing Name)
Lens' UIGameplay (FocusRing Name)
uiFocusRing) REPLState
theRepl
    (Maybe Bool, ReplControlMode)
_running -> Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"..."
  theRepl :: REPLState
theRepl = UIGameplay
uig UIGameplay -> Getting REPLState UIGameplay REPLState -> REPLState
forall s a. s -> Getting a s a -> a
^. Getting REPLState UIGameplay REPLState
Lens' UIGameplay REPLState
uiREPL

  -- NOTE: there exists a lens named 'baseRobot' that uses "unsafe"
  -- indexing that may be an alternative to this:
  base :: Maybe Robot
base = GameState
gs GameState
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> GameState -> Const (Maybe Robot) GameState)
-> Maybe Robot
forall s a. s -> Getting a s a -> a
^. (Robots -> Const (Maybe Robot) Robots)
-> GameState -> Const (Maybe Robot) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (Maybe Robot) Robots)
 -> GameState -> Const (Maybe Robot) GameState)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> Robots -> Const (Maybe Robot) Robots)
-> (Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
-> GameState
-> Const (Maybe Robot) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Const (Maybe Robot) (IntMap Robot))
-> Robots -> Const (Maybe Robot) Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Const (Maybe Robot) (IntMap Robot))
 -> Robots -> Const (Maybe Robot) Robots)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> IntMap Robot -> Const (Maybe Robot) (IntMap Robot))
-> (Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
-> Robots
-> Const (Maybe Robot) Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index (IntMap Robot)
0

  fmt :: REPLHistItem -> Widget n
fmt (REPLHistItem REPLHistItemType
itemType TickNumber
_tick Text
t) = case REPLHistItemType
itemType of
    REPLEntry {} -> Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    REPLHistItemType
REPLOutput -> Text -> Widget n
forall n. Text -> Widget n
txt Text
t
    REPLHistItemType
REPLError -> WrapSettings -> Text -> Widget n
forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
indent2 {preserveIndentation = True} Text
t
  mayDebug :: [Widget Name]
mayDebug = [GameState -> Bool -> Widget Name
drawRobotMachine GameState
gs Bool
True | UIGameplay
uig UIGameplay -> Getting Bool UIGameplay Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UIGameplay Bool
Lens' UIGameplay Bool
uiShowDebug]

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

-- See https://github.com/jtdaugherty/brick/discussions/484
withLeftPaddedVScrollBars :: Widget n -> Widget n
withLeftPaddedVScrollBars :: forall n. Widget n -> Widget n
withLeftPaddedVScrollBars =
  VScrollbarRenderer n -> Widget n -> Widget n
forall n. VScrollbarRenderer n -> Widget n -> Widget n
withVScrollBarRenderer (VScrollbarRenderer n -> VScrollbarRenderer n
forall n. VScrollbarRenderer n -> VScrollbarRenderer n
addLeftSpacing VScrollbarRenderer n
forall n. VScrollbarRenderer n
verticalScrollbarRenderer)
    (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VScrollBarOrientation -> Widget n -> Widget n
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 = 2
      , renderVScrollbar = hLimit 1 $ renderVScrollbar r
      , renderVScrollbarTrough = hLimit 1 $ renderVScrollbarTrough r
      }