{-# LANGUAGE OverloadedStrings #-}

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

  -- * Dialog box
  drawDialog,
  chooseCursor,

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

  -- * World
  drawWorldPane,

  -- * Robot panel
  drawRobotPanel,
  drawItem,
  renderDutyCycle,

  -- * Info panel
  drawInfoPanel,
  explainFocusedItem,

  -- * REPL
  drawREPL,
) where

import Brick hiding (Direction, Location)
import Brick.Focus
import Brick.Forms
import Brick.Widgets.Border (
  hBorder,
  hBorderWithLabel,
  joinableBorder,
  vBorder,
 )
import Brick.Widgets.Center (center, centerLayer, hCenter)
import Brick.Widgets.Dialog
import Brick.Widgets.Edit (getEditContents, renderEditor)
import Brick.Widgets.List qualified as BL
import Brick.Widgets.Table qualified as BT
import Control.Lens as Lens hiding (Const, from)
import Control.Monad (guard)
import Data.Array (range)
import Data.Bits (shiftL, shiftR, (.&.))
import Data.Foldable (toList)
import Data.Foldable qualified as F
import Data.Functor (($>))
import Data.IntMap qualified as IM
import Data.List (intersperse)
import Data.List qualified as L
import Data.List.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 qualified as Set (toList)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (NominalDiffTime, defaultTimeLocale, formatTime)
import Linear
import Network.Wai.Handler.Warp (Port)
import Numeric (showFFloat)
import Swarm.Constant
import Swarm.Game.CESK (CESK (..))
import Swarm.Game.Device (commandCost, commandsForDeviceCaps, enabledCommands, getMap, ingredients)
import Swarm.Game.Display
import Swarm.Game.Entity as E
import Swarm.Game.Ingredients
import Swarm.Game.Land
import Swarm.Game.Location
import Swarm.Game.Recipe
import Swarm.Game.Robot
import Swarm.Game.Robot.Activity
import Swarm.Game.Robot.Concrete
import Swarm.Game.Scenario (
  scenarioAuthor,
  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 (automatons)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Swarm.Game.ScenarioInfo (
  ScenarioItem (..),
  scenarioItemName,
 )
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 (..), addTicks)
import Swarm.Game.Universe
import Swarm.Game.World.Coords
import Swarm.Game.World.Gen (Seed)
import Swarm.Language.Capability (Capability (..), constCaps)
import Swarm.Language.Pretty (prettyText, prettyTextLine, prettyTextWidth)
import Swarm.Language.Syntax
import Swarm.Language.Typecheck (inferConst)
import Swarm.Log
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.Event qualified as SE
import Swarm.TUI.Model.Goal (goalsContent, hasAnythingToShow)
import Swarm.TUI.Model.KeyBindings (handlerNameKeysDescription)
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.UI
import Swarm.TUI.Panel
import Swarm.TUI.View.Achievement
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.CellDisplay
import Swarm.TUI.View.Logo
import Swarm.TUI.View.Objective qualified as GR
import Swarm.TUI.View.Popup
import Swarm.TUI.View.Structure qualified as SR
import Swarm.TUI.View.Util as VU
import Swarm.Util
import Swarm.Util.UnitInterval
import Swarm.Util.WindowedCounter qualified as WC
import Swarm.Version (NewReleaseFailure (..))
import System.Clock (TimeSpec (..))
import Text.Printf
import Text.Wrap
import Witch (into)

-- | The main entry point for drawing the entire UI.
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)
stk -> NonEmpty (List Name ScenarioItem) -> LaunchOptions -> [Widget Name]
drawNewGameMenuUI NonEmpty (List Name ScenarioItem)
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 NewReleaseFailure String -> Maybe (Widget Name)
forall n. Either NewReleaseFailure String -> Maybe (Widget n)
newVersionWidget Either NewReleaseFailure 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 NewReleaseFailure String
version = AppState
s AppState
-> Getting
     (Either NewReleaseFailure String)
     AppState
     (Either NewReleaseFailure String)
-> Either NewReleaseFailure String
forall s a. s -> Getting a s a -> a
^. (RuntimeState
 -> Const (Either NewReleaseFailure String) RuntimeState)
-> AppState -> Const (Either NewReleaseFailure String) AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState
  -> Const (Either NewReleaseFailure String) RuntimeState)
 -> AppState -> Const (Either NewReleaseFailure String) AppState)
-> ((Either NewReleaseFailure String
     -> Const
          (Either NewReleaseFailure String)
          (Either NewReleaseFailure String))
    -> RuntimeState
    -> Const (Either NewReleaseFailure String) RuntimeState)
-> Getting
     (Either NewReleaseFailure String)
     AppState
     (Either NewReleaseFailure String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either NewReleaseFailure String
 -> Const
      (Either NewReleaseFailure String)
      (Either NewReleaseFailure String))
-> RuntimeState
-> Const (Either NewReleaseFailure String) RuntimeState
Lens' RuntimeState (Either NewReleaseFailure String)
upstreamRelease

newVersionWidget :: Either NewReleaseFailure String -> Maybe (Widget n)
newVersionWidget :: forall n. Either NewReleaseFailure String -> Maybe (Widget n)
newVersionWidget = \case
  Right String
ver -> 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 (OnDevelopmentBranch String
_b) -> 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
"Good luck developing!"
  Left (FailedReleaseQuery String
_f) -> Maybe (Widget n)
forall a. Maybe a
Nothing
  Left (NoMainUpstreamRelease [String]
_fails) -> Maybe (Widget n)
forall a. Maybe a
Nothing
  Left (OldUpstreamRelease Version
_up Version
_my) -> 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 ::
  NonEmpty (BL.List Name ScenarioItem) ->
  LaunchOptions ->
  [Widget Name]
drawNewGameMenuUI :: NonEmpty (List Name ScenarioItem) -> LaunchOptions -> [Widget Name]
drawNewGameMenuUI (List Name ScenarioItem
l :| [List Name ScenarioItem]
ls) LaunchOptions
launchOptions = case Maybe (Scenario, ScenarioInfo)
displayedFor of
  Maybe (Scenario, ScenarioInfo)
Nothing -> Widget Name -> [Widget Name]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Widget Name
mainWidget
  Just (Scenario, 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 (Scenario, ScenarioInfo)
displayedFor = LaunchOptions
launchOptions LaunchOptions
-> Getting
     (Maybe (Scenario, ScenarioInfo))
     LaunchOptions
     (Maybe (Scenario, ScenarioInfo))
-> Maybe (Scenario, ScenarioInfo)
forall s a. s -> Getting a s a -> a
^. (LaunchControls
 -> Const (Maybe (Scenario, ScenarioInfo)) LaunchControls)
-> LaunchOptions
-> Const (Maybe (Scenario, ScenarioInfo)) LaunchOptions
Lens' LaunchOptions LaunchControls
controls ((LaunchControls
  -> Const (Maybe (Scenario, ScenarioInfo)) LaunchControls)
 -> LaunchOptions
 -> Const (Maybe (Scenario, ScenarioInfo)) LaunchOptions)
-> ((Maybe (Scenario, ScenarioInfo)
     -> Const
          (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
    -> LaunchControls
    -> Const (Maybe (Scenario, ScenarioInfo)) LaunchControls)
-> Getting
     (Maybe (Scenario, ScenarioInfo))
     LaunchOptions
     (Maybe (Scenario, ScenarioInfo))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Scenario, ScenarioInfo)
 -> Const
      (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
-> LaunchControls
-> Const (Maybe (Scenario, ScenarioInfo)) LaunchControls
Lens' LaunchControls (Maybe (Scenario, 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] -> Text
breadcrumbs [List Name ScenarioItem]
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 -> Widget Name)
-> List Name ScenarioItem
-> 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 -> Widget Name)
-> List Name ScenarioItem
-> 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 -> Widget Name)
-> List Name ScenarioItem
-> 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 -> Widget Name)
-> List Name ScenarioItem
-> 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 -> Widget Name)
-> List Name ScenarioItem
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> ScenarioItem -> Widget Name)
-> Bool -> List Name ScenarioItem -> 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 -> Widget Name)
-> Bool -> ScenarioItem -> Widget Name
forall a b. a -> b -> a
const ((ScenarioItem -> Widget Name)
 -> Bool -> ScenarioItem -> Widget Name)
-> (ScenarioItem -> Widget Name)
-> Bool
-> ScenarioItem
-> 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 -> Widget Name) -> ScenarioItem -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioItem -> Widget Name
forall {n}. ScenarioItem -> Widget n
drawScenarioItem) Bool
True
                    (List Name ScenarioItem -> Widget Name)
-> List Name ScenarioItem -> Widget Name
forall a b. (a -> b) -> a -> b
$ List Name ScenarioItem
l
                ]
            , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
5) (Widget Name
-> ((Int, ScenarioItem) -> Widget Name)
-> Maybe (Int, ScenarioItem)
-> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"") (ScenarioItem -> Widget Name
drawDescription (ScenarioItem -> Widget Name)
-> ((Int, ScenarioItem) -> ScenarioItem)
-> (Int, ScenarioItem)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ScenarioItem) -> ScenarioItem
forall a b. (a, b) -> b
snd) (List Name ScenarioItem -> Maybe (Int, ScenarioItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name ScenarioItem
l))
            ]
      , Widget Name
forall {n}. Widget n
launchOptionsMessage
      ]

  launchOptionsMessage :: Widget n
launchOptionsMessage = case (Maybe (Scenario, ScenarioInfo)
displayedFor, (Int, ScenarioItem) -> ScenarioItem
forall a b. (a, b) -> b
snd ((Int, ScenarioItem) -> ScenarioItem)
-> Maybe (Int, ScenarioItem) -> Maybe ScenarioItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List Name ScenarioItem -> Maybe (Int, ScenarioItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name ScenarioItem
l) of
    (Maybe (Scenario, ScenarioInfo)
Nothing, Just (SISingle (Scenario, ScenarioInfo)
_)) -> 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 (Scenario, ScenarioInfo), Maybe ScenarioItem)
_ -> Text -> Widget n
forall n. Text -> Widget n
txt Text
" "

  drawScenarioItem :: ScenarioItem -> Widget n
drawScenarioItem (SISingle (Scenario
s, ScenarioInfo
si)) = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Scenario -> ScenarioInfo -> Widget n
forall {n}. Scenario -> ScenarioInfo -> Widget n
drawStatusInfo Scenario
s ScenarioInfo
si) 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
_) = 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 -> ScenarioInfo -> Widget n
drawStatusInfo Scenario
s 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
_initialScript (Metric Progress
Attempted ProgressStats
_) BestRecords
_ -> 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
" ◎ "
    Played SerializableLaunchParams
_initialScript (Metric Progress
Completed ProgressStats
_) BestRecords
_ -> 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
" ● "

  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 Metric ProgressStats
pm BestRecords
_best -> Metric ProgressStats -> Widget n
forall n. Metric ProgressStats -> Widget n
describeProgress Metric ProgressStats
pm

  breadcrumbs :: [BL.List Name ScenarioItem] -> Text
  breadcrumbs :: [List Name ScenarioItem] -> Text
breadcrumbs =
    Text -> [Text] -> Text
T.intercalate Text
" > "
      ([Text] -> Text)
-> ([List Name ScenarioItem] -> [Text])
-> [List Name ScenarioItem]
-> 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] -> [Text])
-> [List Name ScenarioItem]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse
      ([Text] -> [Text])
-> ([List Name ScenarioItem] -> [Text])
-> [List Name ScenarioItem]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name ScenarioItem -> Maybe Text)
-> [List Name ScenarioItem] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (((Int, ScenarioItem) -> Text)
-> Maybe (Int, ScenarioItem) -> 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 -> Text
scenarioItemName (ScenarioItem -> Text)
-> ((Int, ScenarioItem) -> ScenarioItem)
-> (Int, ScenarioItem)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ScenarioItem) -> ScenarioItem
forall a b. (a, b) -> b
snd) (Maybe (Int, ScenarioItem) -> Maybe Text)
-> (List Name ScenarioItem -> Maybe (Int, ScenarioItem))
-> List Name ScenarioItem
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List Name ScenarioItem -> Maybe (Int, ScenarioItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement)

  drawDescription :: ScenarioItem -> Widget Name
  drawDescription :: ScenarioItem -> Widget Name
drawDescription (SICollection Text
_ ScenarioCollection
_) = Text -> Widget Name
forall n. Text -> Widget n
txtWrap Text
" "
  drawDescription (SISingle (Scenario
s, ScenarioInfo
si)) =
    [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))
      , 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

    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:"
      , 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
$ ScenarioStatus -> Widget n
forall n. ScenarioStatus -> Widget n
describeStatus (ScenarioStatus -> Widget n) -> ScenarioStatus -> Widget n
forall a b. (a -> b) -> a -> b
$ 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
      )

    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]
: ScenarioStatus -> [(Widget n, Maybe (Widget n))]
forall n1 n2. ScenarioStatus -> [(Widget n1, Maybe (Widget n2))]
makeBestScoreRows (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)
    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. Metric ProgressStats -> Widget n
describeProgress (Metric Progress
p (ProgressStats ZonedTime
_startedAt (AttemptMetrics (DurationMetrics NominalDiffTime
e TickNumber
t) Maybe ScenarioCodeMetrics
maybeCodeMetrics))) = case Progress
p of
  Progress
Attempted ->
    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
$ TickNumber -> Bool -> String
drawTime TickNumber
t Bool
True, 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 Metric ProgressStats
_ BestRecords
best -> BestRecords -> Maybe BestRecords
forall a. a -> Maybe a
Just BestRecords
best

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

  makeBestRow :: Bool
-> (Metric ProgressStats, NonEmpty BestByCriteria)
-> (Widget n, Maybe (Widget n))
makeBestRow Bool
hasDistinctByCriteria (Metric ProgressStats
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
$ Metric ProgressStats -> Widget n
forall n. Metric ProgressStats -> Widget n
describeProgress Metric ProgressStats
b
    )
   where
    maxLeftColumnWidth :: Int
maxLeftColumnWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((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 =
    if 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
      then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr
      else Widget n -> Widget n
forall a. a -> a
id

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
$ AppState -> Widget Name
drawDialog 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
$
      [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
" "))
                            (AppState
s AppState
-> Getting (Maybe Text) AppState (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe Text) UIState)
-> AppState -> Const (Maybe Text) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe Text) UIState)
 -> AppState -> Const (Maybe Text) AppState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIState -> Const (Maybe Text) UIState)
-> Getting (Maybe Text) AppState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Text) UIGameplay)
-> UIState -> Const (Maybe Text) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Text) UIGameplay)
 -> UIState -> Const (Maybe Text) UIState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIGameplay -> Const (Maybe Text) UIGameplay)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIState
-> Const (Maybe Text) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIGameplay
-> Const (Maybe Text) UIGameplay
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
$ AppState -> Widget Name
drawRobotPanel AppState
s
              , 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
$ AppState -> Widget Name
drawInfoPanel AppState
s
              , Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter
                  (Widget Name -> Widget Name)
-> (UIState -> Widget Name) -> UIState -> 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)
-> (UIState -> Widget Name) -> UIState -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusRing Name -> UIState -> Widget Name
EV.drawWorldEditor FocusRing Name
fr
                  (UIState -> Widget Name) -> UIState -> Widget Name
forall a b. (a -> b) -> a -> b
$ AppState
s AppState -> Getting UIState AppState UIState -> UIState
forall s a. s -> Getting a s a -> a
^. Getting UIState AppState UIState
Lens' AppState UIState
uiState
              ]
        , [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
vBox [Widget Name]
rightPanel
        ]
  ]
 where
  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 AppState
s AppState
-> Getting (Maybe (Cosmic Coords)) AppState (Maybe (Cosmic Coords))
-> Maybe (Cosmic Coords)
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe (Cosmic Coords)) UIState)
-> AppState -> Const (Maybe (Cosmic Coords)) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe (Cosmic Coords)) UIState)
 -> AppState -> Const (Maybe (Cosmic Coords)) AppState)
-> ((Maybe (Cosmic Coords)
     -> Const (Maybe (Cosmic Coords)) (Maybe (Cosmic Coords)))
    -> UIState -> Const (Maybe (Cosmic Coords)) UIState)
-> Getting (Maybe (Cosmic Coords)) AppState (Maybe (Cosmic Coords))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe (Cosmic Coords)) UIGameplay)
-> UIState -> Const (Maybe (Cosmic Coords)) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe (Cosmic Coords)) UIGameplay)
 -> UIState -> Const (Maybe (Cosmic Coords)) UIState)
-> ((Maybe (Cosmic Coords)
     -> Const (Maybe (Cosmic Coords)) (Maybe (Cosmic Coords)))
    -> UIGameplay -> Const (Maybe (Cosmic Coords)) UIGameplay)
-> (Maybe (Cosmic Coords)
    -> Const (Maybe (Cosmic Coords)) (Maybe (Cosmic Coords)))
-> UIState
-> Const (Maybe (Cosmic Coords)) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cosmic Coords)
 -> Const (Maybe (Cosmic Coords)) (Maybe (Cosmic Coords)))
-> UIGameplay -> Const (Maybe (Cosmic Coords)) UIGameplay
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
$ AppState
s AppState
-> Getting (Cosmic Location) AppState (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Cosmic Location) GameState)
-> AppState -> Const (Cosmic Location) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Cosmic Location) GameState)
 -> AppState -> Const (Cosmic Location) AppState)
-> ((Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
    -> GameState -> Const (Cosmic Location) GameState)
-> Getting (Cosmic Location) AppState (Cosmic Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
-> GameState
-> Const (Cosmic Location) GameState
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 (AppState
s AppState
-> Getting WorldOverdraw AppState WorldOverdraw -> WorldOverdraw
forall s a. s -> Getting a s a -> a
^. (UIState -> Const WorldOverdraw UIState)
-> AppState -> Const WorldOverdraw AppState
Lens' AppState UIState
uiState ((UIState -> Const WorldOverdraw UIState)
 -> AppState -> Const WorldOverdraw AppState)
-> ((WorldOverdraw -> Const WorldOverdraw WorldOverdraw)
    -> UIState -> Const WorldOverdraw UIState)
-> Getting WorldOverdraw AppState WorldOverdraw
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const WorldOverdraw UIGameplay)
-> UIState -> Const WorldOverdraw UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const WorldOverdraw UIGameplay)
 -> UIState -> Const WorldOverdraw UIState)
-> ((WorldOverdraw -> Const WorldOverdraw WorldOverdraw)
    -> UIGameplay -> Const WorldOverdraw UIGameplay)
-> (WorldOverdraw -> Const WorldOverdraw WorldOverdraw)
-> UIState
-> Const WorldOverdraw UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
-> (WorldOverdraw -> Const WorldOverdraw WorldOverdraw)
-> UIGameplay
-> Const WorldOverdraw UIGameplay
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) (AppState
s AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState) Cosmic Coords
coord
  -- Add clock display in top right of the world view if focused robot
  -- has a clock equipped
  addClock :: BorderLabels n -> BorderLabels n
addClock = (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 (AppState
s AppState -> Getting Int AppState Int -> Int
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Int UIState) -> AppState -> Const Int AppState
Lens' AppState UIState
uiState ((UIState -> Const Int UIState) -> AppState -> Const Int AppState)
-> ((Int -> Const Int Int) -> UIState -> Const Int UIState)
-> Getting Int AppState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Int UIGameplay)
-> UIState -> Const Int UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Int UIGameplay)
 -> UIState -> Const Int UIState)
-> ((Int -> Const Int Int) -> UIGameplay -> Const Int UIGameplay)
-> (Int -> Const Int Int)
-> UIState
-> Const Int UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Int -> Const Int Int)
-> UIGameplay
-> Const Int UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> UITiming -> Const Int UITiming
Lens' UITiming Int
lgTicksPerSecond) (GameState -> Widget n) -> GameState -> Widget n
forall a b. (a -> b) -> a -> b
$ AppState
s AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState)
  fr :: FocusRing Name
fr = AppState
s AppState
-> Getting (FocusRing Name) AppState (FocusRing Name)
-> FocusRing Name
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (FocusRing Name) UIState)
-> AppState -> Const (FocusRing Name) AppState
Lens' AppState UIState
uiState ((UIState -> Const (FocusRing Name) UIState)
 -> AppState -> Const (FocusRing Name) AppState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIState -> Const (FocusRing Name) UIState)
-> Getting (FocusRing Name) AppState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> UIState -> Const (FocusRing Name) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> UIState -> Const (FocusRing Name) UIState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIState
-> Const (FocusRing Name) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay (FocusRing Name)
uiFocusRing
  showREPL :: Bool
showREPL = 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
. (UIGameplay -> Const Bool UIGameplay)
-> UIState -> Const Bool UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIGameplay -> Const Bool UIGameplay
Lens' UIGameplay Bool
uiShowREPL
  rightPanel :: [Widget Name]
rightPanel = if Bool
showREPL then [Widget Name]
worldPanel [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name]
replPanel else [Widget Name]
worldPanel [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. [a] -> [a] -> [a]
++ [Widget Name]
minimizedREPL
  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 (AppState -> Widget Name
drawTPS AppState
s)
            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
?~ AppState -> Widget Name
drawModalMenu AppState
s
            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 (AppState
s AppState -> Getting UIGameplay AppState UIGameplay -> UIGameplay
forall s a. s -> Getting a s a -> a
^. (UIState -> Const UIGameplay UIState)
-> AppState -> Const UIGameplay AppState
Lens' AppState UIState
uiState ((UIState -> Const UIGameplay UIState)
 -> AppState -> Const UIGameplay AppState)
-> ((UIGameplay -> Const UIGameplay UIGameplay)
    -> UIState -> Const UIGameplay UIState)
-> Getting UIGameplay AppState UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const UIGameplay UIGameplay)
-> UIState -> Const UIGameplay UIState
Lens' UIState UIGameplay
uiGameplay) (AppState
s AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState))
    , AppState -> Widget Name
drawKeyMenu AppState
s
    ]
  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
<$> (AppState
s AppState
-> Getting (Maybe Polytype) AppState (Maybe Polytype)
-> Maybe Polytype
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe Polytype) UIState)
-> AppState -> Const (Maybe Polytype) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe Polytype) UIState)
 -> AppState -> Const (Maybe Polytype) AppState)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> UIState -> Const (Maybe Polytype) UIState)
-> Getting (Maybe Polytype) AppState (Maybe Polytype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Polytype) UIGameplay)
-> UIState -> Const (Maybe Polytype) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Polytype) UIGameplay)
 -> UIState -> Const (Maybe Polytype) UIState)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> UIGameplay -> Const (Maybe Polytype) UIGameplay)
-> (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> UIState
-> Const (Maybe Polytype) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> UIGameplay
-> Const (Maybe Polytype) UIGameplay
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
$ AppState -> Widget Name
drawREPL AppState
s
          )
    ]

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

drawWorldCursorInfo :: WorldOverdraw -> GameState -> Cosmic 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]
robot]
  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
  robot :: [Display]
robot = 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 a clock
--   device equipped.
clockEquipped :: GameState -> Bool
clockEquipped :: GameState -> Bool
clockEquipped GameState
gs = case GameState -> Maybe Robot
focusedRobot GameState
gs of
  Maybe Robot
Nothing -> Bool
False
  Just Robot
r
    | Text -> Inventory -> Int
countByName Text
"clock" (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) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Bool
True
    | Bool
otherwise -> Bool
False

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

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

-- | Draw info about the current number of ticks per second.
drawTPS :: AppState -> Widget Name
drawTPS :: AppState -> Widget Name
drawTPS AppState
s = [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
    | 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
. (UIGameplay -> Const Bool UIGameplay)
-> UIState -> Const Bool UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Const Bool UITiming)
-> UIGameplay -> Const Bool UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Const Bool UITiming)
 -> UIGameplay -> Const Bool UIGameplay)
-> ((Bool -> Const Bool Bool) -> UITiming -> Const Bool UITiming)
-> (Bool -> Const Bool Bool)
-> UIGameplay
-> Const Bool UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UITiming -> Const Bool UITiming
Lens' UITiming Bool
uiShowFPS =
        [ Text -> Widget n
forall n. Text -> Widget n
txt Text
" ("
        , let tpf :: Double
tpf = AppState
s AppState -> Getting Double AppState Double -> Double
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Double UIState)
-> AppState -> Const Double AppState
Lens' AppState UIState
uiState ((UIState -> Const Double UIState)
 -> AppState -> Const Double AppState)
-> ((Double -> Const Double Double)
    -> UIState -> Const Double UIState)
-> Getting Double AppState Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Double UIGameplay)
-> UIState -> Const Double UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Double UIGameplay)
 -> UIState -> Const Double UIState)
-> ((Double -> Const Double Double)
    -> UIGameplay -> Const Double UIGameplay)
-> (Double -> Const Double Double)
-> UIState
-> Const Double UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Const Double UITiming)
-> UIGameplay -> Const Double UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Const Double UITiming)
 -> UIGameplay -> Const Double UIGameplay)
-> ((Double -> Const Double Double)
    -> UITiming -> Const Double UITiming)
-> (Double -> Const Double Double)
-> UIGameplay
-> Const Double UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const Double Double)
-> UITiming -> Const Double UITiming
Lens' UITiming Double
uiTPF
           in (if 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 then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr else Widget n -> Widget n
forall a. a -> a
id)
                (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" (AppState
s AppState -> Getting Double AppState Double -> Double
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Double UIState)
-> AppState -> Const Double AppState
Lens' AppState UIState
uiState ((UIState -> Const Double UIState)
 -> AppState -> Const Double AppState)
-> ((Double -> Const Double Double)
    -> UIState -> Const Double UIState)
-> Getting Double AppState Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Double UIGameplay)
-> UIState -> Const Double UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Double UIGameplay)
 -> UIState -> Const Double UIState)
-> ((Double -> Const Double Double)
    -> UIGameplay -> Const Double UIGameplay)
-> (Double -> Const Double Double)
-> UIState
-> Const Double UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Const Double UITiming)
-> UIGameplay -> Const Double UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Const Double UITiming)
 -> UIGameplay -> Const Double UIGameplay)
-> ((Double -> Const Double Double)
    -> UITiming -> Const Double UITiming)
-> (Double -> Const Double Double)
-> UIGameplay
-> Const Double UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Const Double Double)
-> UITiming -> Const Double UITiming
Lens' UITiming Double
uiFPS))
        , Text -> Widget n
forall n. Text -> Widget n
txt Text
" fps)"
        ]
    | Bool
otherwise = []

  l :: Int
l = AppState
s AppState -> Getting Int AppState Int -> Int
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Int UIState) -> AppState -> Const Int AppState
Lens' AppState UIState
uiState ((UIState -> Const Int UIState) -> AppState -> Const Int AppState)
-> ((Int -> Const Int Int) -> UIState -> Const Int UIState)
-> Getting Int AppState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Int UIGameplay)
-> UIState -> Const Int UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Int UIGameplay)
 -> UIState -> Const Int UIState)
-> ((Int -> Const Int Int) -> UIGameplay -> Const Int UIGameplay)
-> (Int -> Const Int Int)
-> UIState
-> Const Int UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Int -> Const Int Int)
-> UIGameplay
-> Const Int UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 = case AppState
s AppState
-> Getting (Maybe Modal) AppState (Maybe Modal) -> Maybe Modal
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe Modal) UIState)
-> AppState -> Const (Maybe Modal) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe Modal) UIState)
 -> AppState -> Const (Maybe Modal) AppState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIState -> Const (Maybe Modal) UIState)
-> Getting (Maybe Modal) AppState (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> UIState -> Const (Maybe Modal) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> UIState -> Const (Maybe Modal) UIState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIState
-> Const (Maybe Modal) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal of
  Maybe Modal
Nothing -> AppState -> [CursorLocation n] -> Maybe (CursorLocation n)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor AppState
s [CursorLocation n]
locs
  Just Modal
_ -> Maybe (CursorLocation n)
forall a. Maybe a
Nothing

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

-- | Draw one of the various types of modal dialog.
drawModal :: AppState -> ModalType -> Widget Name
drawModal :: AppState -> ModalType -> Widget Name
drawModal AppState
s = \case
  ModalType
HelpModal -> Int -> Maybe Int -> KeyEventHandlingState -> Widget Name
helpWidget (AppState
s AppState -> Getting Int AppState Int -> Int
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Int GameState)
-> AppState -> Const Int AppState
Lens' AppState GameState
gameState ((GameState -> Const Int GameState)
 -> AppState -> Const Int AppState)
-> ((Int -> Const Int Int) -> GameState -> Const Int GameState)
-> Getting Int AppState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Int -> Const Int Int)
-> GameState
-> Const Int GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Randomness -> Const Int Randomness
Lens' Randomness Int
seed) (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) (AppState
s AppState
-> Getting KeyEventHandlingState AppState KeyEventHandlingState
-> KeyEventHandlingState
forall s a. s -> Getting a s a -> a
^. Getting KeyEventHandlingState AppState KeyEventHandlingState
Lens' AppState KeyEventHandlingState
keyEventHandling)
  ModalType
RobotsModal -> AppState -> Widget Name
robotsListWidget AppState
s
  ModalType
RecipesModal -> GameState -> NotificationList -> Widget Name
availableListWidget (AppState
s AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState) NotificationList
RecipeList
  ModalType
CommandsModal -> GameState -> Widget Name
commandsListWidget (AppState
s AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState)
  ModalType
MessagesModal -> GameState -> NotificationList -> Widget Name
availableListWidget (AppState
s AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState) NotificationList
MessageList
  ModalType
StructuresModal -> GameState -> StructureDisplay -> Widget Name
SR.renderStructuresDisplay (AppState
s AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState) (AppState
s AppState
-> Getting StructureDisplay AppState StructureDisplay
-> StructureDisplay
forall s a. s -> Getting a s a -> a
^. (UIState -> Const StructureDisplay UIState)
-> AppState -> Const StructureDisplay AppState
Lens' AppState UIState
uiState ((UIState -> Const StructureDisplay UIState)
 -> AppState -> Const StructureDisplay AppState)
-> ((StructureDisplay -> Const StructureDisplay StructureDisplay)
    -> UIState -> Const StructureDisplay UIState)
-> Getting StructureDisplay AppState StructureDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const StructureDisplay UIGameplay)
-> UIState -> Const StructureDisplay UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const StructureDisplay UIGameplay)
 -> UIState -> Const StructureDisplay UIState)
-> ((StructureDisplay -> Const StructureDisplay StructureDisplay)
    -> UIGameplay -> Const StructureDisplay UIGameplay)
-> (StructureDisplay -> Const StructureDisplay StructureDisplay)
-> UIState
-> Const StructureDisplay UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay -> Const StructureDisplay StructureDisplay)
-> UIGameplay -> Const StructureDisplay UIGameplay
Lens' UIGameplay StructureDisplay
uiStructure)
  ScenarioEndModal 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."
        ]
  DescriptionModal Entity
e -> AppState -> Entity -> Widget Name
descriptionWidget AppState
s Entity
e
  ModalType
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 (Menu -> Text
quitMsg (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))
  ModalType
GoalModal ->
    GoalDisplay -> Maybe (Document Syntax) -> Widget Name
GR.renderGoalsDisplay (AppState
s AppState -> Getting GoalDisplay AppState GoalDisplay -> GoalDisplay
forall s a. s -> Getting a s a -> a
^. (UIState -> Const GoalDisplay UIState)
-> AppState -> Const GoalDisplay AppState
Lens' AppState UIState
uiState ((UIState -> Const GoalDisplay UIState)
 -> AppState -> Const GoalDisplay AppState)
-> ((GoalDisplay -> Const GoalDisplay GoalDisplay)
    -> UIState -> Const GoalDisplay UIState)
-> Getting GoalDisplay AppState GoalDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const GoalDisplay UIGameplay)
-> UIState -> Const GoalDisplay UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const GoalDisplay UIGameplay)
 -> UIState -> Const GoalDisplay UIState)
-> ((GoalDisplay -> Const GoalDisplay GoalDisplay)
    -> UIGameplay -> Const GoalDisplay UIGameplay)
-> (GoalDisplay -> Const GoalDisplay GoalDisplay)
-> UIState
-> Const GoalDisplay UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const GoalDisplay GoalDisplay)
-> UIGameplay -> Const GoalDisplay UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal) (Maybe (Document Syntax) -> Widget Name)
-> Maybe (Document Syntax) -> Widget Name
forall a b. (a -> b) -> a -> b
$
      Getting (Document Syntax) Scenario (Document Syntax)
-> Scenario -> Document Syntax
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((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) (Scenario -> Document Syntax)
-> ((Scenario, ScenarioInfo) -> Scenario)
-> (Scenario, ScenarioInfo)
-> Document Syntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scenario, ScenarioInfo) -> Scenario
forall a b. (a, b) -> a
fst ((Scenario, ScenarioInfo) -> Document Syntax)
-> Maybe (Scenario, ScenarioInfo) -> Maybe (Document Syntax)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AppState
s AppState
-> Getting
     (Maybe (Scenario, ScenarioInfo))
     AppState
     (Maybe (Scenario, ScenarioInfo))
-> Maybe (Scenario, ScenarioInfo)
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
-> AppState -> Const (Maybe (Scenario, ScenarioInfo)) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
 -> AppState -> Const (Maybe (Scenario, ScenarioInfo)) AppState)
-> ((Maybe (Scenario, ScenarioInfo)
     -> Const
          (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
    -> UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
-> Getting
     (Maybe (Scenario, ScenarioInfo))
     AppState
     (Maybe (Scenario, ScenarioInfo))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
-> UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
 -> UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
-> ((Maybe (Scenario, ScenarioInfo)
     -> Const
          (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
    -> UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
-> (Maybe (Scenario, ScenarioInfo)
    -> Const
         (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
-> UIState
-> Const (Maybe (Scenario, ScenarioInfo)) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Scenario, ScenarioInfo)
 -> Const
      (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
-> UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay
Lens' UIGameplay (Maybe (Scenario, ScenarioInfo))
scenarioRef
  ModalType
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."
  ModalType
TerrainPaletteModal -> AppState -> Widget Name
EV.drawTerrainSelector AppState
s
  ModalType
EntityPaletteModal -> AppState -> Widget Name
EV.drawEntityPaintSelector AppState
s

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

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

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

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

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

    idWidget :: Widget n
idWidget = String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Robot
robot Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID
    nameWidget :: Widget n
nameWidget =
      [Widget n] -> Widget n
forall {n}. [Widget n] -> Widget n
hBox
        [ Display -> Widget n
forall n. Display -> Widget n
renderDisplay (Robot
robot Robot -> Getting Display Robot Display -> Display
forall s a. s -> Getting a s a -> a
^. Getting Display Robot Display
Lens' Robot Display
robotDisplay)
        , Widget n -> Widget n
forall n. Widget n -> Widget n
highlightSystem (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
<> Robot
robot Robot -> Getting Text Robot Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Robot Text
Lens' Robot Text
robotName
        ]

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

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

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

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

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

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

helpWidget :: Seed -> Maybe Port -> KeyEventHandlingState -> Widget Name
helpWidget :: Int -> Maybe Int -> KeyEventHandlingState -> Widget Name
helpWidget Int
theSeed Maybe Int
mport KeyEventHandlingState
keyState =
  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
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)
      ]
  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 (KeyEventHandlingState
keyState KeyEventHandlingState
-> Getting
     (KeyConfig SwarmEvent) KeyEventHandlingState (KeyConfig SwarmEvent)
-> KeyConfig SwarmEvent
forall s a. s -> Getting a s a -> a
^. Getting
  (KeyConfig SwarmEvent) KeyEventHandlingState (KeyConfig SwarmEvent)
Lens' KeyEventHandlingState (KeyConfig SwarmEvent)
keyConfig)
  -- 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. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([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
-> ((Int -> Const Int Int) -> GameState -> Const Int GameState)
-> 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))
-> (Int -> Const Int Int)
-> GameState
-> Const Int GameState
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 :: AppState -> Entity -> Widget Name
descriptionWidget :: AppState -> Entity -> Widget Name
descriptionWidget AppState
s Entity
e = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (AppState -> Entity -> Widget Name
explainEntry AppState
s Entity
e)

-- | Draw a widget with messages to the current robot.
messagesWidget :: GameState -> [Widget Name]
messagesWidget :: GameState -> [Widget Name]
messagesWidget GameState
gs = [Widget Name]
widgetList
 where
  widgetList :: [Widget Name]
widgetList = [Widget Name] -> [Widget Name]
focusNewest ([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 = if 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 then [Widget Name] -> [Widget Name]
forall a. a -> a
id else 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 :: AppState -> Widget Name
drawModalMenu :: AppState -> Widget Name
drawModalMenu AppState
s = 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
$ ((KeyHighlight, Text, Text) -> Widget Name)
-> [(KeyHighlight, Text, Text)] -> [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)
-> ((KeyHighlight, Text, Text) -> Widget Name)
-> (KeyHighlight, Text, Text)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd) [(KeyHighlight, Text, Text)]
globalKeyCmds
 where
  notificationKey :: Getter GameState (Notifications a) -> SE.MainEvent -> Text -> Maybe (KeyHighlight, Text, Text)
  notificationKey :: forall a.
Getter GameState (Notifications a)
-> MainEvent -> Text -> Maybe (KeyHighlight, Text, Text)
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 (AppState
s AppState -> Getting [a] AppState [a] -> [a]
forall s a. s -> Getting a s a -> a
^. (GameState -> Const [a] GameState)
-> AppState -> Const [a] AppState
Lens' AppState GameState
gameState ((GameState -> Const [a] GameState)
 -> AppState -> Const [a] AppState)
-> (([a] -> Const [a] [a]) -> GameState -> Const [a] GameState)
-> Getting [a] AppState [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
-> ([a] -> Const [a] [a])
-> GameState
-> Const [a] GameState
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 (KeyHighlight, Text, Text)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let highlight :: KeyHighlight
highlight
              | AppState
s AppState -> Getting Int AppState Int -> Int
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Int GameState)
-> AppState -> Const Int AppState
Lens' AppState GameState
gameState ((GameState -> Const Int GameState)
 -> AppState -> Const Int AppState)
-> ((Int -> Const Int Int) -> GameState -> Const Int GameState)
-> Getting Int AppState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
-> (Int -> Const Int Int)
-> GameState
-> Const Int GameState
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 (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall a. a -> Maybe a
Just (KeyHighlight
highlight, MainEvent -> Text
keyM MainEvent
key, Text
name)

  -- Hides this key if the recognizable structure list is empty
  structuresKey :: Maybe (KeyHighlight, Text, Text)
structuresKey =
    if Map Text (StructureInfo StructureCells Entity) -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map Text (StructureInfo StructureCells Entity) -> Bool)
-> Map Text (StructureInfo StructureCells Entity) -> Bool
forall a b. (a -> b) -> a -> b
$ AppState
s AppState
-> Getting
     (Map Text (StructureInfo StructureCells Entity))
     AppState
     (Map Text (StructureInfo StructureCells Entity))
-> Map Text (StructureInfo StructureCells Entity)
forall s a. s -> Getting a s a -> a
^. (GameState
 -> Const
      (Map Text (StructureInfo StructureCells Entity)) GameState)
-> AppState
-> Const (Map Text (StructureInfo StructureCells Entity)) AppState
Lens' AppState GameState
gameState ((GameState
  -> Const
       (Map Text (StructureInfo StructureCells Entity)) GameState)
 -> AppState
 -> Const (Map Text (StructureInfo StructureCells Entity)) AppState)
-> ((Map Text (StructureInfo StructureCells Entity)
     -> Const
          (Map Text (StructureInfo StructureCells Entity))
          (Map Text (StructureInfo StructureCells Entity)))
    -> GameState
    -> Const
         (Map Text (StructureInfo StructureCells Entity)) GameState)
-> Getting
     (Map Text (StructureInfo StructureCells Entity))
     AppState
     (Map Text (StructureInfo StructureCells Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Discovery
 -> Const
      (Map Text (StructureInfo StructureCells Entity)) Discovery)
-> GameState
-> Const (Map Text (StructureInfo StructureCells Entity)) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const
       (Map Text (StructureInfo StructureCells Entity)) Discovery)
 -> GameState
 -> Const
      (Map Text (StructureInfo StructureCells Entity)) GameState)
-> ((Map Text (StructureInfo StructureCells Entity)
     -> Const
          (Map Text (StructureInfo StructureCells Entity))
          (Map Text (StructureInfo StructureCells Entity)))
    -> Discovery
    -> Const
         (Map Text (StructureInfo StructureCells Entity)) Discovery)
-> (Map Text (StructureInfo StructureCells Entity)
    -> Const
         (Map Text (StructureInfo StructureCells Entity))
         (Map Text (StructureInfo StructureCells Entity)))
-> GameState
-> Const (Map Text (StructureInfo StructureCells Entity)) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      (Map Text (StructureInfo StructureCells Entity))
      (StructureRecognizer StructureCells Entity))
-> Discovery
-> Const (Map Text (StructureInfo StructureCells Entity)) Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       (Map Text (StructureInfo StructureCells Entity))
       (StructureRecognizer StructureCells Entity))
 -> Discovery
 -> Const
      (Map Text (StructureInfo StructureCells Entity)) Discovery)
-> ((Map Text (StructureInfo StructureCells Entity)
     -> Const
          (Map Text (StructureInfo StructureCells Entity))
          (Map Text (StructureInfo StructureCells Entity)))
    -> StructureRecognizer StructureCells Entity
    -> Const
         (Map Text (StructureInfo StructureCells Entity))
         (StructureRecognizer StructureCells Entity))
-> (Map Text (StructureInfo StructureCells Entity)
    -> Const
         (Map Text (StructureInfo StructureCells Entity))
         (Map Text (StructureInfo StructureCells Entity)))
-> Discovery
-> Const (Map Text (StructureInfo StructureCells Entity)) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognizerAutomatons StructureCells Entity
 -> Const
      (Map Text (StructureInfo StructureCells Entity))
      (RecognizerAutomatons StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Const
     (Map Text (StructureInfo StructureCells Entity))
     (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(RecognizerAutomatons b a -> f (RecognizerAutomatons b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
automatons ((RecognizerAutomatons StructureCells Entity
  -> Const
       (Map Text (StructureInfo StructureCells Entity))
       (RecognizerAutomatons StructureCells Entity))
 -> StructureRecognizer StructureCells Entity
 -> Const
      (Map Text (StructureInfo StructureCells Entity))
      (StructureRecognizer StructureCells Entity))
-> ((Map Text (StructureInfo StructureCells Entity)
     -> Const
          (Map Text (StructureInfo StructureCells Entity))
          (Map Text (StructureInfo StructureCells Entity)))
    -> RecognizerAutomatons StructureCells Entity
    -> Const
         (Map Text (StructureInfo StructureCells Entity))
         (RecognizerAutomatons StructureCells Entity))
-> (Map Text (StructureInfo StructureCells Entity)
    -> Const
         (Map Text (StructureInfo StructureCells Entity))
         (Map Text (StructureInfo StructureCells Entity)))
-> StructureRecognizer StructureCells Entity
-> Const
     (Map Text (StructureInfo StructureCells Entity))
     (StructureRecognizer StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text (StructureInfo StructureCells Entity)
 -> Const
      (Map Text (StructureInfo StructureCells Entity))
      (Map Text (StructureInfo StructureCells Entity)))
-> RecognizerAutomatons StructureCells Entity
-> Const
     (Map Text (StructureInfo StructureCells Entity))
     (RecognizerAutomatons StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(Map Text (StructureInfo b a) -> f (Map Text (StructureInfo b a)))
-> RecognizerAutomatons b a -> f (RecognizerAutomatons b a)
originalStructureDefinitions
      then Maybe (KeyHighlight, Text, Text)
forall a. Maybe a
Nothing
      else (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.ViewStructuresEvent, Text
"Structures")

  globalKeyCmds :: [(KeyHighlight, Text, Text)]
globalKeyCmds =
    [Maybe (KeyHighlight, Text, Text)] -> [(KeyHighlight, Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes
      [ (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.ViewHelpEvent, Text
"Help")
      , (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.ViewRobotsEvent, Text
"Robots")
      , Getter GameState (Notifications (Recipe Entity))
-> MainEvent -> Text -> Maybe (KeyHighlight, Text, Text)
forall a.
Getter GameState (Notifications a)
-> MainEvent -> Text -> Maybe (KeyHighlight, Text, Text)
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 (KeyHighlight, Text, Text)
forall a.
Getter GameState (Notifications a)
-> MainEvent -> Text -> Maybe (KeyHighlight, Text, Text)
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 (KeyHighlight, Text, Text)
forall a.
Getter GameState (Notifications a)
-> MainEvent -> Text -> Maybe (KeyHighlight, Text, Text)
notificationKey (Notifications LogEntry -> f (Notifications LogEntry))
-> GameState -> f GameState
Getter GameState (Notifications LogEntry)
messageNotifications MainEvent
SE.ViewMessagesEvent Text
"Messages"
      , Maybe (KeyHighlight, Text, Text)
structuresKey
      ]
  keyM :: MainEvent -> Text
keyM = AppState -> SwarmEvent -> Text
VU.bindingText AppState
s (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 :: AppState -> Widget Name
drawKeyMenu :: AppState -> Widget Name
drawKeyMenu AppState
s =
  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
            [ [(KeyHighlight, Text, Text)] -> Widget Name
mkCmdRow [(KeyHighlight, Text, Text)]
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 :: [(KeyHighlight, Text, Text)] -> Widget Name
mkCmdRow = [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name)
-> ([(KeyHighlight, Text, Text)] -> [Widget Name])
-> [(KeyHighlight, Text, Text)]
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((KeyHighlight, Text, Text) -> Widget Name)
-> [(KeyHighlight, Text, Text)] -> [Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map (KeyHighlight, Text, Text) -> Widget Name
drawPaddedCmd
  drawPaddedCmd :: (KeyHighlight, Text, Text) -> Widget Name
drawPaddedCmd = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Name -> Widget Name)
-> ((KeyHighlight, Text, Text) -> Widget Name)
-> (KeyHighlight, Text, Text)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHighlight, Text, Text) -> 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
"" (AppState
s AppState -> Getting (First Text) AppState Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Const (First Text) GameState)
-> AppState -> Const (First Text) AppState
Lens' AppState GameState
gameState ((GameState -> Const (First Text) GameState)
 -> AppState -> Const (First Text) AppState)
-> ((Text -> Const (First Text) Text)
    -> GameState -> Const (First Text) GameState)
-> Getting (First Text) AppState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Text -> Const (First Text) Text)
-> GameState
-> Const (First Text) GameState
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 = [(KeyHighlight, Text, Text)] -> Widget Name
mkCmdRow [(KeyHighlight, Text, Text)]
focusedPanelCmds
  focusedPanelCmds :: [(KeyHighlight, Text, Text)]
focusedPanelCmds =
    ((Text, Text) -> (KeyHighlight, Text, Text))
-> [(Text, Text)] -> [(KeyHighlight, Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (KeyHighlight, Text, Text)
forall {b} {c}. (b, c) -> (KeyHighlight, b, c)
highlightKeyCmds
      ([(Text, Text)] -> [(KeyHighlight, Text, Text)])
-> (AppState -> [(Text, Text)])
-> AppState
-> [(KeyHighlight, Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Name -> [(Text, Text)]
keyCmdsFor
      (Maybe Name -> [(Text, Text)])
-> (AppState -> Maybe Name) -> AppState -> [(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)
-> (AppState -> FocusRing Name) -> AppState -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (FocusRing Name) AppState (FocusRing Name)
-> AppState -> FocusRing Name
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UIState -> Const (FocusRing Name) UIState)
-> AppState -> Const (FocusRing Name) AppState
Lens' AppState UIState
uiState ((UIState -> Const (FocusRing Name) UIState)
 -> AppState -> Const (FocusRing Name) AppState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIState -> Const (FocusRing Name) UIState)
-> Getting (FocusRing Name) AppState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> UIState -> Const (FocusRing Name) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> UIState -> Const (FocusRing Name) UIState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIState
-> Const (FocusRing Name) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay (FocusRing Name)
uiFocusRing)
      (AppState -> [(KeyHighlight, Text, Text)])
-> AppState -> [(KeyHighlight, Text, Text)]
forall a b. (a -> b) -> a -> b
$ AppState
s

  isReplWorking :: Bool
isReplWorking = AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> Getting Bool GameState Bool -> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 = AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> Getting Bool GameState Bool -> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 -> AppState -> Bool
hasDebugCapability Bool
creative AppState
s
  viewingBase :: Bool
viewingBase = (AppState
s AppState
-> Getting ViewCenterRule AppState ViewCenterRule -> ViewCenterRule
forall s a. s -> Getting a s a -> a
^. (GameState -> Const ViewCenterRule GameState)
-> AppState -> Const ViewCenterRule AppState
Lens' AppState GameState
gameState ((GameState -> Const ViewCenterRule GameState)
 -> AppState -> Const ViewCenterRule AppState)
-> ((ViewCenterRule -> Const ViewCenterRule ViewCenterRule)
    -> GameState -> Const ViewCenterRule GameState)
-> Getting ViewCenterRule AppState ViewCenterRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robots -> Const ViewCenterRule Robots)
-> GameState -> Const ViewCenterRule GameState
Lens' GameState Robots
robotInfo ((Robots -> Const ViewCenterRule Robots)
 -> GameState -> Const ViewCenterRule GameState)
-> ((ViewCenterRule -> Const ViewCenterRule ViewCenterRule)
    -> Robots -> Const ViewCenterRule Robots)
-> (ViewCenterRule -> Const ViewCenterRule ViewCenterRule)
-> GameState
-> Const ViewCenterRule GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViewCenterRule -> Const ViewCenterRule ViewCenterRule)
-> Robots -> Const ViewCenterRule Robots
Lens' Robots ViewCenterRule
viewCenterRule) ViewCenterRule -> ViewCenterRule -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ViewCenterRule
VCRobot Int
0
  creative :: Bool
creative = AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> Getting Bool GameState Bool -> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool GameState Bool
Lens' GameState Bool
creativeMode
  cheat :: Bool
cheat = 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
uiCheatMode
  goal :: Bool
goal = GoalTracking -> Bool
hasAnythingToShow (GoalTracking -> Bool) -> GoalTracking -> Bool
forall a b. (a -> b) -> a -> b
$ AppState
s AppState
-> Getting GoalTracking AppState GoalTracking -> GoalTracking
forall s a. s -> Getting a s a -> a
^. (UIState -> Const GoalTracking UIState)
-> AppState -> Const GoalTracking AppState
Lens' AppState UIState
uiState ((UIState -> Const GoalTracking UIState)
 -> AppState -> Const GoalTracking AppState)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
    -> UIState -> Const GoalTracking UIState)
-> Getting GoalTracking AppState GoalTracking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const GoalTracking UIGameplay)
-> UIState -> Const GoalTracking UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const GoalTracking UIGameplay)
 -> UIState -> Const GoalTracking UIState)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
    -> UIGameplay -> Const GoalTracking UIGameplay)
-> (GoalTracking -> Const GoalTracking GoalTracking)
-> UIState
-> Const GoalTracking UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const GoalTracking GoalDisplay)
-> UIGameplay -> Const GoalTracking UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal ((GoalDisplay -> Const GoalTracking GoalDisplay)
 -> UIGameplay -> Const GoalTracking UIGameplay)
-> ((GoalTracking -> Const GoalTracking GoalTracking)
    -> GoalDisplay -> Const GoalTracking GoalDisplay)
-> (GoalTracking -> Const GoalTracking GoalTracking)
-> UIGameplay
-> Const GoalTracking UIGameplay
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 = 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
. (UIGameplay -> Const Bool UIGameplay)
-> UIState -> Const Bool UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Bool -> Const Bool Bool)
-> UIGameplay
-> Const Bool UIGameplay
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 = AppState
s AppState
-> Getting InventorySortOptions AppState InventorySortOptions
-> InventorySortOptions
forall s a. s -> Getting a s a -> a
^. (UIState -> Const InventorySortOptions UIState)
-> AppState -> Const InventorySortOptions AppState
Lens' AppState UIState
uiState ((UIState -> Const InventorySortOptions UIState)
 -> AppState -> Const InventorySortOptions AppState)
-> ((InventorySortOptions
     -> Const InventorySortOptions InventorySortOptions)
    -> UIState -> Const InventorySortOptions UIState)
-> Getting InventorySortOptions AppState InventorySortOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const InventorySortOptions UIGameplay)
-> UIState -> Const InventorySortOptions UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const InventorySortOptions UIGameplay)
 -> UIState -> Const InventorySortOptions UIState)
-> ((InventorySortOptions
     -> Const InventorySortOptions InventorySortOptions)
    -> UIGameplay -> Const InventorySortOptions UIGameplay)
-> (InventorySortOptions
    -> Const InventorySortOptions InventorySortOptions)
-> UIState
-> Const InventorySortOptions UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (InventorySortOptions
    -> Const InventorySortOptions InventorySortOptions)
-> UIGameplay
-> Const InventorySortOptions UIGameplay
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 = AppState
s AppState
-> Getting (Maybe Text) AppState (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe Text) UIState)
-> AppState -> Const (Maybe Text) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe Text) UIState)
 -> AppState -> Const (Maybe Text) AppState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIState -> Const (Maybe Text) UIState)
-> Getting (Maybe Text) AppState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Text) UIGameplay)
-> UIState -> Const (Maybe Text) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Text) UIGameplay)
 -> UIState -> Const (Maybe Text) UIState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIGameplay -> Const (Maybe Text) UIGameplay)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIState
-> Const (Maybe Text) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIGameplay
-> Const (Maybe Text) UIGameplay
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 = AppState
s AppState
-> Getting ReplControlMode AppState ReplControlMode
-> ReplControlMode
forall s a. s -> Getting a s a -> a
^. (UIState -> Const ReplControlMode UIState)
-> AppState -> Const ReplControlMode AppState
Lens' AppState UIState
uiState ((UIState -> Const ReplControlMode UIState)
 -> AppState -> Const ReplControlMode AppState)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> UIState -> Const ReplControlMode UIState)
-> Getting ReplControlMode AppState ReplControlMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const ReplControlMode UIGameplay)
-> UIState -> Const ReplControlMode UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const ReplControlMode UIGameplay)
 -> UIState -> Const ReplControlMode UIState)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> UIGameplay -> Const ReplControlMode UIGameplay)
-> (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> UIState
-> Const ReplControlMode UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> UIGameplay
-> Const ReplControlMode UIGameplay
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
|| (AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> Getting Bool GameState Bool -> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 (AppState
s AppState
-> Getting (Maybe (Text, Value)) AppState (Maybe (Text, Value))
-> Maybe (Text, Value)
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe (Text, Value)) GameState)
-> AppState -> Const (Maybe (Text, Value)) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Maybe (Text, Value)) GameState)
 -> AppState -> Const (Maybe (Text, Value)) AppState)
-> ((Maybe (Text, Value)
     -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
    -> GameState -> Const (Maybe (Text, Value)) GameState)
-> Getting (Maybe (Text, Value)) AppState (Maybe (Text, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (Maybe (Text, Value)
    -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
-> GameState
-> Const (Maybe (Text, Value)) GameState
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 :: [(KeyHighlight, Text, Text)]
globalKeyCmds =
    [Maybe (KeyHighlight, Text, Text)] -> [(KeyHighlight, Text, Text)]
forall a. [Maybe a] -> [a]
catMaybes
      [ Bool
-> (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall {a}. Bool -> a -> Maybe a
may Bool
goal (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.ViewGoalEvent, Text
"goal")
      , Bool
-> (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall {a}. Bool -> a -> Maybe a
may Bool
cheat (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.ToggleCreativeModeEvent, Text
"creative")
      , Bool
-> (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall {a}. Bool -> a -> Maybe a
may Bool
cheat (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.ToggleWorldEditorEvent, Text
"editor")
      , (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.PauseEvent, if Bool
isPaused then Text
"unpause" else Text
"pause")
      , Bool
-> (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall {a}. Bool -> a -> Maybe a
may Bool
isPaused (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.RunSingleTickEvent, Text
"step")
      , Bool
-> (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall {a}. Bool -> a -> Maybe a
may
          (Bool
isPaused Bool -> Bool -> Bool
&& Bool
hasDebug)
          ( if 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
. (UIGameplay -> Const Bool UIGameplay)
-> UIState -> Const Bool UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIGameplay -> Const Bool UIGameplay
Lens' UIGameplay Bool
uiShowDebug then KeyHighlight
Alert else KeyHighlight
NoHighlight
          , MainEvent -> Text
keyM MainEvent
SE.ShowCESKDebugEvent
          , Text
"debug"
          )
      , (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, MainEvent -> Text
keyM MainEvent
SE.IncreaseTpsEvent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MainEvent -> Text
keyM MainEvent
SE.DecreaseTpsEvent, Text
"speed")
      , (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall a. a -> Maybe a
Just
          ( KeyHighlight
NoHighlight
          , MainEvent -> Text
keyM MainEvent
SE.ToggleREPLVisibilityEvent
          , if 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
. (UIGameplay -> Const Bool UIGameplay)
-> UIState -> Const Bool UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIGameplay -> Const Bool UIGameplay
Lens' UIGameplay Bool
uiShowREPL then Text
"hide REPL" else Text
"show REPL"
          )
      , (KeyHighlight, Text, Text) -> Maybe (KeyHighlight, Text, Text)
forall a. a -> Maybe a
Just
          ( if 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
. (UIGameplay -> Const Bool UIGameplay)
-> UIState -> Const Bool UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIGameplay -> Const Bool UIGameplay
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 :: (b, c) -> (KeyHighlight, b, c)
highlightKeyCmds (b
k, c
n) = (KeyHighlight
PanelSpecific, b
k, c
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]
      [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(WorldEvent -> Text
keyW WorldEvent
SE.ViewBaseEvent, Text
"recenter") | Bool -> Bool
not Bool
viewingBase]
      [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(WorldEvent -> Text
keyW WorldEvent
SE.ShowFpsEvent, Text
"FPS")]
  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 = AppState -> SwarmEvent -> Text
VU.bindingText AppState
s (SwarmEvent -> Text)
-> (MainEvent -> SwarmEvent) -> MainEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MainEvent -> SwarmEvent
SE.Main
  keyR :: REPLEvent -> Text
keyR = AppState -> SwarmEvent -> Text
VU.bindingText AppState
s (SwarmEvent -> Text)
-> (REPLEvent -> SwarmEvent) -> REPLEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLEvent -> SwarmEvent
SE.REPL
  keyE :: RobotEvent -> Text
keyE = AppState -> SwarmEvent -> Text
VU.bindingText AppState
s (SwarmEvent -> Text)
-> (RobotEvent -> SwarmEvent) -> RobotEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RobotEvent -> SwarmEvent
SE.Robot
  keyW :: WorldEvent -> Text
keyW = AppState -> SwarmEvent -> Text
VU.bindingText AppState
s (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 :: (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd :: (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd (KeyHighlight
h, Text
key, Text
cmd) =
  [Widget Name] -> Widget Name
forall {n}. [Widget n] -> Widget n
hBox
    [ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
attr (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
    ]
 where
  attr :: AttrName
attr = 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
-> ((Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
    -> GameState -> Const (Cosmic Location) GameState)
-> 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)
-> (Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
-> GameState
-> Const (Cosmic Location) GameState
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 :: AppState -> Widget Name
drawRobotPanel :: AppState -> Widget Name
drawRobotPanel AppState
s
  -- If the focused robot is too far away to communicate, just leave the panel blank.
  -- There should be no way to tell the difference between a robot that is too far
  -- away and a robot that does not exist.
  | Just Robot
r <- AppState
s AppState
-> Getting (Maybe Robot) AppState (Maybe Robot) -> Maybe Robot
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe Robot) GameState)
-> AppState -> Const (Maybe Robot) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Maybe Robot) GameState)
 -> AppState -> Const (Maybe Robot) AppState)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> GameState -> Const (Maybe Robot) GameState)
-> Getting (Maybe Robot) AppState (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) <- AppState
s AppState
-> Getting
     (Maybe (Int, List Name InventoryListEntry))
     AppState
     (Maybe (Int, List Name InventoryListEntry))
-> Maybe (Int, List Name InventoryListEntry)
forall s a. s -> Getting a s a -> a
^. (UIState
 -> Const (Maybe (Int, List Name InventoryListEntry)) UIState)
-> AppState
-> Const (Maybe (Int, List Name InventoryListEntry)) AppState
Lens' AppState UIState
uiState ((UIState
  -> Const (Maybe (Int, List Name InventoryListEntry)) UIState)
 -> AppState
 -> Const (Maybe (Int, List Name InventoryListEntry)) AppState)
-> ((Maybe (Int, List Name InventoryListEntry)
     -> Const
          (Maybe (Int, List Name InventoryListEntry))
          (Maybe (Int, List Name InventoryListEntry)))
    -> UIState
    -> Const (Maybe (Int, List Name InventoryListEntry)) UIState)
-> Getting
     (Maybe (Int, List Name InventoryListEntry))
     AppState
     (Maybe (Int, List Name InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay)
-> UIState
-> Const (Maybe (Int, List Name InventoryListEntry)) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay)
 -> UIState
 -> Const (Maybe (Int, List Name InventoryListEntry)) UIState)
-> ((Maybe (Int, List Name InventoryListEntry)
     -> Const
          (Maybe (Int, List Name InventoryListEntry))
          (Maybe (Int, List Name InventoryListEntry)))
    -> UIGameplay
    -> Const (Maybe (Int, List Name InventoryListEntry)) UIGameplay)
-> (Maybe (Int, List Name InventoryListEntry)
    -> Const
         (Maybe (Int, List Name InventoryListEntry))
         (Maybe (Int, List Name InventoryListEntry)))
-> UIState
-> Const (Maybe (Int, List Name InventoryListEntry)) UIState
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
          row :: [Widget n]
row =
            [ 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]
row
              , 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
  (if 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) then Widget Name -> Widget Name
forall n. Widget n -> Widget n
visible else Widget Name -> Widget Name
forall a. a -> a
id) (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 :: AppState -> Widget Name
drawInfoPanel :: AppState -> Widget Name
drawInfoPanel AppState
s
  | Just RobotRange
Far <- AppState
s AppState
-> Getting (Maybe RobotRange) AppState (Maybe RobotRange)
-> Maybe RobotRange
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe RobotRange) GameState)
-> AppState -> Const (Maybe RobotRange) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Maybe RobotRange) GameState)
 -> AppState -> Const (Maybe RobotRange) AppState)
-> ((Maybe RobotRange
     -> Const (Maybe RobotRange) (Maybe RobotRange))
    -> GameState -> Const (Maybe RobotRange) GameState)
-> Getting (Maybe RobotRange) AppState (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
$ AppState -> Widget Name
explainFocusedItem AppState
s

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

explainEntry :: AppState -> Entity -> Widget Name
explainEntry :: AppState -> Entity -> Widget Name
explainEntry AppState
s 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 (AppState
s AppState -> Getting GameState AppState GameState -> GameState
forall s a. s -> Getting a s a -> a
^. Getting GameState AppState GameState
Lens' AppState GameState
gameState) Entity
e
    , AppState -> Entity -> Widget Name
explainRecipes AppState
s Entity
e
    ]
      [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. Semigroup a => a -> a -> a
<> [AppState -> Bool -> Widget Name
drawRobotMachine AppState
s 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
<> [AppState -> Widget Name
drawRobotLog AppState
s | Capability
CLog 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"
  -- 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

  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
    Left Text
x ->
      String -> [CommandsAndCost Entity]
forall a. HasCallStack => String -> a
error (String -> [CommandsAndCost Entity])
-> String -> [CommandsAndCost Entity]
forall a b. (a -> b) -> a -> b
$
        [String] -> String
unwords
          [ String
"Error: somehow an invalid entity reference escaped the parse-time check"
          , Text -> String
T.unpack Text
x
          ]

  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 :: AppState -> Entity -> Widget Name
explainRecipes :: AppState -> Entity -> Widget Name
explainRecipes AppState
s 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 = AppState -> Entity -> [Recipe Entity]
recipesWith AppState
s 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
$ AppState
s AppState
-> Getting (First Inventory) AppState Inventory -> Maybe Inventory
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Const (First Inventory) GameState)
-> AppState -> Const (First Inventory) AppState
Lens' AppState GameState
gameState ((GameState -> Const (First Inventory) GameState)
 -> AppState -> Const (First Inventory) AppState)
-> Getting (First Inventory) GameState Inventory
-> Getting (First Inventory) AppState Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 :: AppState -> Entity -> [Recipe Entity]
recipesWith :: AppState -> Entity -> [Recipe Entity]
recipesWith AppState
s Entity
e =
  let getRecipes :: ((IntMap [Recipe Entity]
  -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
 -> Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> [Recipe Entity]
getRecipes (IntMap [Recipe Entity]
 -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> Recipes -> Const (IntMap [Recipe Entity]) Recipes
select = IntMap [Recipe Entity] -> Entity -> [Recipe Entity]
recipesFor (AppState
s AppState
-> Getting
     (IntMap [Recipe Entity]) AppState (IntMap [Recipe Entity])
-> IntMap [Recipe Entity]
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (IntMap [Recipe Entity]) GameState)
-> AppState -> Const (IntMap [Recipe Entity]) AppState
Lens' AppState GameState
gameState ((GameState -> Const (IntMap [Recipe Entity]) GameState)
 -> AppState -> Const (IntMap [Recipe Entity]) AppState)
-> ((IntMap [Recipe Entity]
     -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
    -> GameState -> Const (IntMap [Recipe Entity]) GameState)
-> Getting
     (IntMap [Recipe Entity]) AppState (IntMap [Recipe Entity])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (IntMap [Recipe Entity]
    -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> GameState
-> Const (IntMap [Recipe Entity]) GameState
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 :: AppState -> [LogEntry]
getLogEntriesToShow :: AppState -> [LogEntry]
getLogEntriesToShow AppState
s = 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 = AppState
s AppState
-> Getting (Seq LogEntry) AppState (Seq LogEntry) -> Seq LogEntry
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Seq LogEntry) GameState)
-> AppState -> Const (Seq LogEntry) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Seq LogEntry) GameState)
 -> AppState -> Const (Seq LogEntry) AppState)
-> ((Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
    -> GameState -> Const (Seq LogEntry) GameState)
-> Getting (Seq LogEntry) AppState (Seq LogEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
-> (Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
-> GameState
-> Const (Seq LogEntry) GameState
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 :: AppState -> Widget Name
drawRobotLog :: AppState -> Widget Name
drawRobotLog AppState
s =
  [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 = AppState -> [LogEntry]
getLogEntriesToShow AppState
s
  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 =
    (if 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
&& 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
. (UIGameplay -> Const Bool UIGameplay)
-> UIState -> Const Bool UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIGameplay -> Const Bool UIGameplay
Lens' UIGameplay Bool
uiScrollToEnd then Widget n -> Widget n
forall n. Widget n -> Widget n
visible else Widget n -> Widget n
forall a. a -> a
id) (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 = AppState
s AppState -> Getting (First Int) AppState Int -> Maybe Int
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Const (First Int) GameState)
-> AppState -> Const (First Int) AppState
Lens' AppState GameState
gameState ((GameState -> Const (First Int) GameState)
 -> AppState -> Const (First Int) AppState)
-> ((Int -> Const (First Int) Int)
    -> GameState -> Const (First Int) GameState)
-> Getting (First Int) AppState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
-> (Int -> Const (First Int) Int)
-> GameState
-> Const (First Int) GameState
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 :: AppState -> Bool -> Widget Name
drawRobotMachine :: AppState -> Bool -> Widget Name
drawRobotMachine AppState
s Bool
showName = case AppState
s AppState
-> Getting (Maybe Robot) AppState (Maybe Robot) -> Maybe Robot
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe Robot) GameState)
-> AppState -> Const (Maybe Robot) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Maybe Robot) GameState)
 -> AppState -> Const (Maybe Robot) AppState)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> GameState -> Const (Maybe Robot) GameState)
-> Getting (Maybe Robot) AppState (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 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 :: AppState -> Widget Name
drawREPL :: AppState -> Widget Name
drawREPL AppState
s =
  [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
  -- 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 (AppState
s AppState
-> Getting (FocusRing Name) AppState (FocusRing Name)
-> FocusRing Name
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (FocusRing Name) UIState)
-> AppState -> Const (FocusRing Name) AppState
Lens' AppState UIState
uiState ((UIState -> Const (FocusRing Name) UIState)
 -> AppState -> Const (FocusRing Name) AppState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIState -> Const (FocusRing Name) UIState)
-> Getting (FocusRing Name) AppState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> UIState -> Const (FocusRing Name) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> UIState -> Const (FocusRing Name) UIState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIState
-> Const (FocusRing Name) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay -> Const (FocusRing Name) UIGameplay
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 = AppState
s AppState -> Getting REPLState AppState REPLState -> REPLState
forall s a. s -> Getting a s a -> a
^. (UIState -> Const REPLState UIState)
-> AppState -> Const REPLState AppState
Lens' AppState UIState
uiState ((UIState -> Const REPLState UIState)
 -> AppState -> Const REPLState AppState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIState -> Const REPLState UIState)
-> Getting REPLState AppState REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLState UIGameplay)
-> UIState -> Const REPLState UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLState UIGameplay)
 -> UIState -> Const REPLState UIState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIGameplay -> Const REPLState UIGameplay)
-> (REPLState -> Const REPLState REPLState)
-> UIState
-> Const REPLState UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLState REPLState)
-> UIGameplay -> Const REPLState UIGameplay
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 = AppState
s AppState
-> Getting (Maybe Robot) AppState (Maybe Robot) -> Maybe Robot
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe Robot) GameState)
-> AppState -> Const (Maybe Robot) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Maybe Robot) GameState)
 -> AppState -> Const (Maybe Robot) AppState)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> GameState -> Const (Maybe Robot) GameState)
-> Getting (Maybe Robot) AppState (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 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 = [AppState -> Bool -> Widget Name
drawRobotMachine AppState
s Bool
True | 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
. (UIGameplay -> Const Bool UIGameplay)
-> UIState -> Const Bool UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIGameplay -> Const Bool UIGameplay
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
      }