{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Swarm.TUI.View
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Code for drawing the TUI.
module Swarm.TUI.View (
  drawUI,
  drawTPS,

  -- * Dialog box
  drawDialog,
  generateModal,
  chooseCursor,

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

  -- * World
  drawWorld,

  -- * Robot panel
  drawRobotPanel,
  drawItem,
  drawLabelledEntityName,

  -- * Info panel
  drawInfoPanel,
  explainFocusedItem,

  -- * REPL
  drawREPL,
) where

import Brick hiding (Direction)
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.List qualified as BL
import Brick.Widgets.Table qualified as BT
import Control.Lens hiding (Const, from)
import Control.Monad (guard)
import Control.Monad.Reader (withReaderT)
import Data.Array (range)
import Data.Bits (shiftL, shiftR, (.&.))
import Data.Foldable qualified as F
import Data.Functor (($>))
import Data.IntMap qualified as IM
import Data.List (intersperse)
import Data.List qualified as L
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.List.Split (chunksOf)
import Data.Map qualified as M
import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
import Data.Semigroup (sconcat)
import Data.Sequence qualified as Seq
import Data.String (fromString)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (NominalDiffTime, defaultTimeLocale, formatTime)
import Graphics.Vty qualified as V
import Linear
import Network.Wai.Handler.Warp (Port)
import Swarm.Game.CESK (CESK (..))
import Swarm.Game.Display
import Swarm.Game.Entity as E
import Swarm.Game.Recipe
import Swarm.Game.Robot
import Swarm.Game.Scenario (scenarioAuthor, scenarioDescription, scenarioName, scenarioObjectives)
import Swarm.Game.ScenarioInfo (
  ScenarioItem (..),
  ScenarioStatus (..),
  scenarioBestTicks,
  scenarioBestTime,
  scenarioItemName,
  scenarioStatus,
 )
import Swarm.Game.State
import Swarm.Game.Terrain (terrainMap)
import Swarm.Game.World qualified as W
import Swarm.Language.Pretty (prettyText)
import Swarm.Language.Syntax
import Swarm.Language.Typecheck (inferConst)
import Swarm.Language.Types (Polytype)
import Swarm.TUI.Attr
import Swarm.TUI.Border
import Swarm.TUI.Model
import Swarm.TUI.Panel
import Swarm.Util
import Swarm.Version (NewReleaseFailure (..))
import System.Clock (TimeSpec (..))
import Text.Printf
import Text.Wrap
import Witch (from, into)

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

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

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

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

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

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

drawNewGameMenuUI :: NonEmpty (BL.List Name ScenarioItem) -> Widget Name
drawNewGameMenuUI :: NonEmpty (List Name ScenarioItem) -> Widget Name
drawNewGameMenuUI (List Name ScenarioItem
l :| [List Name ScenarioItem]
ls) =
  forall n. Count -> Widget n -> Widget n
padLeftRight Count
20
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n
centerLayer
    forall a b. (a -> b) -> a -> b
$ forall {n}. [Widget n] -> Widget n
hBox
      [ forall {n}. [Widget n] -> Widget n
vBox
          [ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ [List Name ScenarioItem] -> Text
breadcrumbs [List Name ScenarioItem]
ls
          , forall n. Text -> Widget n
txt Text
" "
          , forall n. Count -> Widget n -> Widget n
vLimit Count
20 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
hLimit Count
35
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
BL.renderList (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. ScenarioItem -> Widget n
drawScenarioItem) Bool
True
              forall a b. (a -> b) -> a -> b
$ List Name ScenarioItem
l
          ]
      , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
5) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall n. Text -> Widget n
txt Text
"") (ScenarioItem -> Widget Name
drawDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Count, e)
BL.listSelectedElement List Name ScenarioItem
l))
      ]
 where
  drawScenarioItem :: ScenarioItem -> Widget n
drawScenarioItem (SISingle Scenario
s ScenarioInfo
si) = forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) (forall {n}. Scenario -> ScenarioInfo -> Widget n
drawStatusInfo Scenario
s ScenarioInfo
si) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt (Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario Text
scenarioName)
  drawScenarioItem (SICollection Text
nm ScenarioCollection
_) = forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" > ") forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
nm
  drawStatusInfo :: Scenario -> ScenarioInfo -> Widget n
drawStatusInfo Scenario
s ScenarioInfo
si = case ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioBestTime of
    ScenarioStatus
NotStarted -> forall n. Text -> Widget n
txt Text
" ○ "
    InProgress {} -> case Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Objective]
scenarioObjectives of
      [] -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ◉ "
      [Objective]
_ -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ◎ "
    Complete {} -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ● "

  describeStatus :: ScenarioStatus -> Widget n
describeStatus = \case
    ScenarioStatus
NotStarted -> forall n. Text -> Widget n
txt Text
"none"
    InProgress ZonedTime
_s NominalDiffTime
e Integer
_t ->
      forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
        [ forall n. Text -> Widget n
txt Text
"in progress"
        , forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"(played for " forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
formatTimeDiff NominalDiffTime
e forall a. Semigroup a => a -> a -> a
<> Text
")"
        ]
    Complete ZonedTime
_s NominalDiffTime
e Integer
t ->
      forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
        [ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"completed in " forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
formatTimeDiff NominalDiffTime
e
        , forall {n}. [Widget n] -> Widget n
hBox
            [ forall n. Text -> Widget n
txt Text
"("
            , forall n. Integer -> Bool -> Widget n
drawTime Integer
t Bool
True
            , forall n. Text -> Widget n
txt Text
" ticks)"
            ]
        ]

  formatTimeDiff :: NominalDiffTime -> Text
  formatTimeDiff :: NominalDiffTime -> Text
formatTimeDiff = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%hh %Mm %Ss"

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

  drawDescription :: ScenarioItem -> Widget Name
  drawDescription :: ScenarioItem -> Widget Name
drawDescription (SICollection Text
_ ScenarioCollection
_) = forall n. Text -> Widget n
txtWrap Text
" "
  drawDescription (SISingle Scenario
s ScenarioInfo
si) = do
    let oneBest :: Bool
oneBest = ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioBestTime forall a. Eq a => a -> a -> Bool
== ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioBestTicks
    let bestRealTime :: Text
bestRealTime = if Bool
oneBest then Text
"best:" else Text
"best real time:"
    let noSame :: a -> Maybe a
noSame = if Bool
oneBest then forall a b. a -> b -> a
const forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just
    let lastText :: Widget n
lastText = let la :: Text
la = Text
"last:" in forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad forall a b. (a -> b) -> a -> b
$ Text -> Count
T.length Text
bestRealTime forall a. Num a => a -> a -> a
- Text -> Count
T.length Text
la) (forall n. Text -> Widget n
txt Text
la)
    forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
      [ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txtWrap (forall {a}. (Eq a, IsString a) => a -> a
nonBlank (Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario Text
scenarioDescription))
      , forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dimAttr
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall n. Text -> Widget n
txt Text
"Author: " forall n. Widget n -> Widget n -> Widget n
<+>)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe Text)
scenarioAuthor)
      , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
          forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
3) forall a b. (a -> b) -> a -> b
$
            forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) (forall n. Text -> Widget n
txt Text
bestRealTime) forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. ScenarioStatus -> Widget n
describeStatus (ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioBestTime)
      , forall a. a -> Maybe a
noSame forall a b. (a -> b) -> a -> b
$ -- hide best game time if it is same as best real time
          forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$
            forall n. Text -> Widget n
txt Text
"best game time: " forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. ScenarioStatus -> Widget n
describeStatus (ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioBestTicks)
      , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
          forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$
            forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) forall {n}. Widget n
lastText forall n. Widget n -> Widget n -> Widget n
<+> forall {n}. ScenarioStatus -> Widget n
describeStatus (ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioStatus)
      ]

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

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

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

-- | Draw the main game UI.  Generates a list of widgets, where each
--   represents a layer.  Right now we just generate two layers: the
--   main layer and a layer for a floating dialog that can be on top.
drawGameUI :: AppState -> [Widget Name]
drawGameUI :: AppState -> [Widget Name]
drawGameUI AppState
s =
  [ AppState -> Widget Name
drawDialog AppState
s
  , forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$
      forall {n}. [Widget n] -> Widget n
hBox
        [ forall n. Count -> Widget n -> Widget n
hLimitPercent Count
25 forall a b. (a -> b) -> a -> b
$
            forall {n}. [Widget n] -> Widget n
vBox
              [ forall n. Count -> Widget n -> Widget n
vLimitPercent Count
50 forall a b. (a -> b) -> a -> b
$ forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel AttrName
highlightAttr FocusRing Name
fr Name
RobotPanel forall n. BorderLabels n
plainBorder forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
drawRobotPanel AppState
s
              , forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel
                  AttrName
highlightAttr
                  FocusRing Name
fr
                  Name
InfoPanel
                  ( forall n. BorderLabels n
plainBorder
                      forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
topLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
centerLabel
                      forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if Bool
moreTop then forall a. a -> Maybe a
Just (forall n. Text -> Widget n
txt Text
" · · · ") else forall a. Maybe a
Nothing)
                      forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
bottomLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
centerLabel
                      forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if Bool
moreBot then forall a. a -> Maybe a
Just (forall n. Text -> Widget n
txt Text
" · · · ") else forall a. Maybe a
Nothing)
                  )
                  forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
drawInfoPanel AppState
s
              ]
        , forall {n}. [Widget n] -> Widget n
vBox
            [ forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel
                AttrName
highlightAttr
                FocusRing Name
fr
                Name
WorldPanel
                ( forall n. BorderLabels n
plainBorder
                    forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
bottomLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
rightLabel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 (AppState -> Widget Name
drawTPS AppState
s)
                    forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
topLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
leftLabel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ AppState -> Widget Name
drawModalMenu AppState
s
                    forall a b. a -> (a -> b) -> b
& BorderLabels Name -> BorderLabels Name
addCursorPos
                    forall a b. a -> (a -> b) -> b
& forall {n}. BorderLabels n -> BorderLabels n
addClock
                )
                (GameState -> Widget Name
drawWorld forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState)
            , AppState -> Widget Name
drawKeyMenu AppState
s
            , forall n. Ord n => n -> Widget n -> Widget n
clickable Name
REPLPanel forall a b. (a -> b) -> a -> b
$
                forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel
                  AttrName
highlightAttr
                  FocusRing Name
fr
                  Name
REPLPanel
                  ( forall n. BorderLabels n
plainBorder
                      forall a b. a -> (a -> b) -> b
& forall n. Lens' (BorderLabels n) (HBorderLabels n)
topLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
rightLabel forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Polytype -> Widget Name
drawType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Polytype)
uiReplType))
                  )
                  ( forall n. Count -> Widget n -> Widget n
vLimit Count
replHeight
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
padLeftRight Count
1
                      forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
drawREPL AppState
s
                  )
            ]
        ]
  ]
 where
  addCursorPos :: BorderLabels Name -> BorderLabels Name
addCursorPos = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Coords)
uiWorldCursor of
    Just Coords
coord -> forall n. Lens' (BorderLabels n) (HBorderLabels n)
bottomLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
leftLabel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 (GameState -> Coords -> Widget Name
drawWorldCursorInfo (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState) Coords
coord)
    Maybe Coords
Nothing -> forall a. a -> a
id
  -- Add clock display in top right of the world view if focused robot
  -- has a clock installed
  addClock :: BorderLabels n -> BorderLabels n
addClock = forall n. Lens' (BorderLabels n) (HBorderLabels n)
topLabels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (HBorderLabels n) (Maybe (Widget n))
rightLabel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 (forall n. GameState -> Widget n
drawClockDisplay forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState)
  fr :: FocusRing Name
fr = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing
  moreTop :: Bool
moreTop = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiMoreInfoTop
  moreBot :: Bool
moreBot = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiMoreInfoBot

drawWorldCursorInfo :: GameState -> W.Coords -> Widget Name
drawWorldCursorInfo :: GameState -> Coords -> Widget Name
drawWorldCursorInfo GameState
g i :: Coords
i@(W.Coords (Int64
y, Int64
x)) =
  forall {n}. [Widget n] -> Widget n
hBox [GameState -> Coords -> Widget Name
drawLoc GameState
g Coords
i, forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
" at " forall a. Semigroup a => a -> a -> a
<> forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show Int64
x) forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show (Int64
y forall a. Num a => a -> a -> a
* (-Int64
1)))]

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

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

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

-- | Return a possible time display, if the currently focused robot
--   has a clock device installed.  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 :: Integer -> Bool -> GameState -> Maybe (Widget n)
maybeDrawTime :: forall n. Integer -> Bool -> GameState -> Maybe (Widget n)
maybeDrawTime Integer
t Bool
showTicks GameState
gs = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GameState -> Bool
clockInstalled GameState
gs) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall n. Integer -> Bool -> Widget n
drawTime Integer
t Bool
showTicks

-- | Render the type of the current REPL input to be shown to the user.
drawType :: Polytype -> Widget Name
drawType :: Polytype -> Widget Name
drawType = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrettyPrec a => a -> Text
prettyText

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

  rateInfo :: [Widget n]
rateInfo
    | AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowFPS =
      [ forall n. Text -> Widget n
txt Text
" ("
      , forall n. String -> Widget n
str (forall r. PrintfType r => String -> r
printf String
"%0.1f" (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Double
uiTPF))
      , forall n. Text -> Widget n
txt Text
" tpf, "
      , forall n. String -> Widget n
str (forall r. PrintfType r => String -> r
printf String
"%0.1f" (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Double
uiFPS))
      , forall n. Text -> Widget n
txt Text
" fps)"
      ]
    | Bool
otherwise = []

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

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

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

-- | Width cap for modal and error message windows
maxModalWindowWidth :: Int
maxModalWindowWidth :: Count
maxModalWindowWidth = Count
500

-- | Render the error dialog window with a given error message
renderErrorDialog :: Text -> Widget Name
renderErrorDialog :: Text -> Widget Name
renderErrorDialog Text
err = forall a n. Dialog a -> Widget n -> Widget n
renderDialog (forall a.
Maybe String -> Maybe (Count, [(String, a)]) -> Count -> Dialog a
dialog (forall a. a -> Maybe a
Just String
"Error") forall a. Maybe a
Nothing (Count
maxModalWindowWidth forall a. Ord a => a -> a -> a
`min` Count
requiredWidth)) forall {n}. Widget n
errContent
 where
  errContent :: Widget n
errContent = forall n. WrapSettings -> Text -> Widget n
txtWrapWith WrapSettings
indent2 {preserveIndentation :: Bool
preserveIndentation = Bool
True} Text
err
  requiredWidth :: Count
requiredWidth = Count
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a. TextWidth a => a -> Count
textWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
err)

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

-- | Make a widget scrolling if it is bigger than the available
--   vertical space.  Thanks to jtdaugherty for this code.
maybeScroll :: (Ord n, Show n) => n -> Widget n -> Widget n
maybeScroll :: forall n. (Ord n, Show n) => n -> Widget n -> Widget n
maybeScroll n
vpName Widget n
contents =
  forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
    Context n
ctx <- forall n. RenderM n (Context n)
getContext
    Result n
result <- forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall n. Lens' (Context n) Count
availHeightL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Count
10000) (forall n. Widget n -> RenderM n (Result n)
render Widget n
contents)
    if Image -> Count
V.imageHeight (Result n
result forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Result n) Image
imageL) forall a. Ord a => a -> a -> Bool
<= Context n
ctx forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Context n) Count
availHeightL
      then forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
      else
        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$
          forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight forall a b. (a -> b) -> a -> b
$
            forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport n
vpName ViewportType
Vertical forall a b. (a -> b) -> a -> b
$
              forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result

-- | Draw one of the various types of modal dialog.
drawModal :: AppState -> ModalType -> Widget Name
drawModal :: AppState -> ModalType -> Widget Name
drawModal AppState
s = \case
  ModalType
HelpModal -> Count -> Maybe Count -> Widget Name
helpWidget (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Count
seed) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Maybe Count)
webPort)
  ModalType
RobotsModal -> AppState -> Widget Name
robotsListWidget AppState
s
  ModalType
RecipesModal -> GameState -> NotificationList -> Widget Name
availableListWidget (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState) NotificationList
RecipeList
  ModalType
CommandsModal -> GameState -> NotificationList -> Widget Name
availableListWidget (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState) NotificationList
CommandList
  ModalType
MessagesModal -> GameState -> NotificationList -> Widget Name
availableListWidget (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState) NotificationList
MessageList
  ModalType
WinModal -> forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Congratulations!"
  DescriptionModal Entity
e -> AppState -> Entity -> Widget Name
descriptionWidget AppState
s Entity
e
  ModalType
QuitModal -> forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt (Menu -> Text
quitMsg (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu))
  GoalModal [Text]
g -> forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 ([Text] -> Widget Name
displayParagraphs [Text]
g)

quitMsg :: Menu -> Text
quitMsg :: Menu -> Text
quitMsg Menu
m = Text
"Are you sure you want to " forall a. Semigroup a => a -> a -> a
<> Text
quitAction forall a. Semigroup a => a -> a -> a
<> Text
"? All progress will be lost!"
 where
  quitAction :: Text
quitAction = case Menu
m of
    Menu
NoMenu -> Text
"quit"
    Menu
_ -> Text
"quit and return to the menu"

-- | Generate a fresh modal window of the requested type.
generateModal :: AppState -> ModalType -> Modal
generateModal :: AppState -> ModalType -> Modal
generateModal AppState
s ModalType
mt = ModalType -> Dialog ButtonSelection -> Modal
Modal ModalType
mt (forall a.
Maybe String -> Maybe (Count, [(String, a)]) -> Count -> Dialog a
dialog (forall a. a -> Maybe a
Just String
title) Maybe (Count, [(String, ButtonSelection)])
buttons (Count
maxModalWindowWidth forall a. Ord a => a -> a -> a
`min` Count
requiredWidth))
 where
  haltingMessage :: Maybe String
haltingMessage = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu of
    Menu
NoMenu -> forall a. a -> Maybe a
Just String
"Quit"
    Menu
_ -> forall a. Maybe a
Nothing
  descriptionWidth :: Count
descriptionWidth = Count
100
  helpWidth :: Count
helpWidth = Count
80
  (String
title, Maybe (Count, [(String, ButtonSelection)])
buttons, Count
requiredWidth) =
    case ModalType
mt of
      ModalType
HelpModal -> (String
" Help ", forall a. Maybe a
Nothing, Count
helpWidth)
      ModalType
RobotsModal -> (String
"Robots", forall a. Maybe a
Nothing, Count
descriptionWidth)
      ModalType
RecipesModal -> (String
"Available Recipes", forall a. Maybe a
Nothing, Count
descriptionWidth)
      ModalType
CommandsModal -> (String
"Available Commands", forall a. Maybe a
Nothing, Count
descriptionWidth)
      ModalType
MessagesModal -> (String
"Messages", forall a. Maybe a
Nothing, Count
descriptionWidth)
      ModalType
WinModal ->
        let nextMsg :: String
nextMsg = String
"Next challenge!"
            stopMsg :: String
stopMsg = forall a. a -> Maybe a -> a
fromMaybe String
"Return to the menu" Maybe String
haltingMessage
            continueMsg :: String
continueMsg = String
"Keep playing"
         in ( String
""
            , forall a. a -> Maybe a
Just
                ( Count
0
                , [ (String
nextMsg, (Scenario, ScenarioInfo) -> ButtonSelection
NextButton (Scenario, ScenarioInfo)
scene)
                  | Just (Scenario, ScenarioInfo)
scene <- [Menu -> Maybe (Scenario, ScenarioInfo)
nextScenario (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu)]
                  ]
                    forall a. [a] -> [a] -> [a]
++ [ (String
stopMsg, ButtonSelection
QuitButton)
                       , (String
continueMsg, ButtonSelection
CancelButton)
                       ]
                )
            , forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Count
length [String
nextMsg, String
stopMsg, String
continueMsg]) forall a. Num a => a -> a -> a
+ Count
32
            )
      DescriptionModal Entity
e -> (Entity -> String
descriptionTitle Entity
e, forall a. Maybe a
Nothing, Count
descriptionWidth)
      ModalType
QuitModal ->
        let stopMsg :: String
stopMsg = forall a. a -> Maybe a -> a
fromMaybe String
"Quit to menu" Maybe String
haltingMessage
         in ( String
""
            , forall a. a -> Maybe a
Just (Count
0, [(String
"Keep playing", ButtonSelection
CancelButton), (String
stopMsg, ButtonSelection
QuitButton)])
            , Text -> Count
T.length (Menu -> Text
quitMsg (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu)) forall a. Num a => a -> a -> a
+ Count
4
            )
      GoalModal [Text]
_ -> (String
" Goal ", forall a. Maybe a
Nothing, Count
80)

robotsListWidget :: AppState -> Widget Name
robotsListWidget :: AppState -> Widget Name
robotsListWidget AppState
s = forall n. Widget n -> Widget n
hCenter Widget Name
table
 where
  table :: Widget Name
table =
    forall n. Table n -> Widget n
BT.renderTable
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Bool -> Table n -> Table n
BT.columnBorders Bool
False
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. ColumnAlignment -> Table n -> Table n
BT.setDefaultColAlignment ColumnAlignment
BT.AlignCenter
      -- Inventory count is right aligned
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Table n -> Table n
BT.alignRight Count
4
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. [[Widget n]] -> Table n
BT.table
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. Count -> Widget n -> Widget n
padLeftRight Count
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {n}. [Widget n]
headers forall a. a -> [a] -> [a]
: [[Widget Name]]
robotsTable)
  headers :: [Widget n]
headers =
    forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
robotAttr
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ forall n. Text -> Widget n
txt Text
"Name"
          , forall n. Text -> Widget n
txt Text
"Age"
          , forall n. Text -> Widget n
txt Text
"Position"
          , forall n. Text -> Widget n
txt Text
"Inventory"
          , forall n. Text -> Widget n
txt Text
"Status"
          , forall n. Text -> Widget n
txt Text
"Log"
          ]
  robotsTable :: [[Widget Name]]
robotsTable = Robot -> [Widget Name]
mkRobotRow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Robot]
robots
  mkRobotRow :: Robot -> [Widget Name]
mkRobotRow Robot
robot =
    [ forall {n}. Widget n
nameWidget
    , forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ forall source target. From source target => source -> target
from String
ageStr
    , Widget Name
locWidget
    , forall n. Padding -> Widget n -> Widget n
padRight (Count -> Padding
Pad Count
1) (forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ forall source target. From source target => source -> target
from forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Count
rInvCount)
    , forall {n}. Widget n
statusWidget
    , forall n. Text -> Widget n
txt Text
rLog
    ]
   where
    nameWidget :: Widget n
nameWidget = forall {n}. [Widget n] -> Widget n
hBox [forall n. Display -> Widget n
renderDisplay (Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot Display
robotDisplay), forall n. Widget n -> Widget n
higlightSystem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
" " forall a. Semigroup a => a -> a -> a
<> Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot Text
robotName]
    higlightSystem :: Widget n -> Widget n
higlightSystem = if Robot
robot forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
systemRobot then forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
highlightAttr else forall a. a -> a
id

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

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

    locWidget :: Widget Name
locWidget = forall {n}. [Widget n] -> Widget n
hBox [Widget Name
worldCell, forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
" " forall a. Semigroup a => a -> a -> a
<> Text
locStr]
     where
      rloc :: V2 Int64
rloc@(V2 Int64
x Int64
y) = Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot (V2 Int64)
robotLocation
      worldCell :: Widget Name
worldCell = GameState -> Coords -> Widget Name
drawLoc GameState
g (V2 Int64 -> Coords
W.locToCoords V2 Int64
rloc)
      locStr :: Text
locStr = forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show Int64
x) forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show Int64
y)

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

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

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

data NotificationList = RecipeList | CommandList | MessageList

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

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

constHeader :: Widget Name
constHeader :: Widget Name
constHeader = forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
robotAttr forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
1) forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"command name : type"

constWiki :: [Widget Name]
constWiki :: [Widget Name]
constWiki =
  forall n. Count -> Widget n -> Widget n
padLeftRight Count
13
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ forall n. Padding -> Widget n -> Widget n
padTop (Count -> Padding
Pad Count
2) forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"For the full list of available commands see the Wiki at:"
        , forall n. Text -> Widget n
txt Text
"https://github.com/swarm-game/swarm/wiki/Commands-Cheat-Sheet"
        ]

drawConst :: Const -> Widget Name
drawConst :: Const -> Widget Name
drawConst Const
c = forall {n}. [Widget n] -> Widget n
hBox [forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad forall a b. (a -> b) -> a -> b
$ Count
13 forall a. Num a => a -> a -> a
- Text -> Count
T.length Text
constName) (forall n. Text -> Widget n
txt Text
constName), forall n. Text -> Widget n
txt Text
constSig]
 where
  constName :: Text
constName = ConstInfo -> Text
syntax forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> ConstInfo
constInfo forall a b. (a -> b) -> a -> b
$ Const
c
  constSig :: Text
constSig = Text
" : " forall a. Semigroup a => a -> a -> a
<> forall a. PrettyPrec a => a -> Text
prettyText (Const -> Polytype
inferConst Const
c)

descriptionTitle :: Entity -> String
descriptionTitle :: Entity -> String
descriptionTitle Entity
e = String
" " forall a. [a] -> [a] -> [a]
++ forall source target. From source target => source -> target
from @Text (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall a. [a] -> [a] -> [a]
++ String
" "

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

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

colorLogs :: LogEntry -> AttrName
colorLogs :: LogEntry -> AttrName
colorLogs LogEntry
e = case LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSaid of
  LogSource
Said -> Count -> AttrName
robotColor (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Count
leRobotID)
  LogSource
Logged -> AttrName
notifAttr
  LogSource
ErrorTrace -> AttrName
redAttr
 where
  -- color each robot message with different color of the world
  robotColor :: Count -> AttrName
robotColor Count
rid = [AttrName]
fgCols forall a. [a] -> Count -> a
!! (Count
rid forall a. Integral a => a -> a -> a
`mod` Count
fgColLen)
  fgCols :: [AttrName]
fgCols = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(AttrName, Attr)]
worldAttributes
  fgColLen :: Count
fgColLen = forall (t :: * -> *) a. Foldable t => t a -> Count
length [AttrName]
fgCols

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

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

-- | Draw a menu explaining what key commands are available for the
--   current panel.  This menu is displayed as a single line in
--   between the world panel and the REPL.
--
-- This excludes the F-key modals that are shown elsewhere.
drawKeyMenu :: AppState -> Widget Name
drawKeyMenu :: AppState -> Widget Name
drawKeyMenu AppState
s =
  forall n. Count -> Widget n -> Widget n
vLimit Count
1
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
hBox
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [forall {n}. Widget n
gameModeWidget])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall n. Count -> Widget n -> Widget n
padLeftRight Count
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(KeyHighlight, Text, Text)]
globalKeyCmds forall a. [a] -> [a] -> [a]
++)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
n) -> (KeyHighlight
NoHighlight, Text
k, Text
n))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}.
(IsString a, IsString b, Semigroup b) =>
Maybe Name -> [(a, b)]
keyCmdsFor
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. FocusRing n -> Maybe n
focusGetCurrent
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing)
    forall a b. (a -> b) -> a -> b
$ AppState
s
 where
  isReplWorking :: Bool
isReplWorking = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState Bool
replWorking
  isPaused :: Bool
isPaused = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState Bool
paused
  viewingBase :: Bool
viewingBase = (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ViewCenterRule
viewCenterRule) forall a. Eq a => a -> a -> Bool
== Count -> ViewCenterRule
VCRobot Count
0
  creative :: Bool
creative = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode
  cheat :: Bool
cheat = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
  goal :: Bool
goal = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe [Text])
uiGoal of
    Just [Text]
g | [Text]
g forall a. Eq a => a -> a -> Bool
/= [] -> Bool
True
    Maybe [Text]
_ -> Bool
False
  showZero :: Bool
showZero = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowZero

  gameModeWidget :: Widget n
gameModeWidget =
    forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
padLeftRight Count
1
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> Text
" mode")
      forall a b. (a -> b) -> a -> b
$ case Bool
creative of
        Bool
False -> Text
"Classic"
        Bool
True -> Text
"Creative"
  globalKeyCmds :: [(KeyHighlight, Text, Text)]
globalKeyCmds =
    forall a. [Maybe a] -> [a]
catMaybes
      [ forall {a}. Bool -> a -> Maybe a
may Bool
goal (KeyHighlight
NoHighlight, Text
"^g", Text
"goal")
      , forall {a}. Bool -> a -> Maybe a
may Bool
cheat (KeyHighlight
NoHighlight, Text
"^v", Text
"creative")
      , forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, Text
"^p", if Bool
isPaused then Text
"unpause" else Text
"pause")
      , forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, Text
"^o", Text
"step")
      , forall a. a -> Maybe a
Just (KeyHighlight
NoHighlight, Text
"^zx", Text
"speed")
      ]
  may :: Bool -> a -> Maybe a
may Bool
b = if Bool
b then forall a. a -> Maybe a
Just else forall a b. a -> b -> a
const forall a. Maybe a
Nothing

  keyCmdsFor :: Maybe Name -> [(a, b)]
keyCmdsFor (Just Name
REPLPanel) =
    [ (a
"↓↑", b
"history")
    ]
      forall a. [a] -> [a] -> [a]
++ [(a
"Ret", b
"execute") | Bool -> Bool
not Bool
isReplWorking]
      forall a. [a] -> [a] -> [a]
++ [(a
"^c", b
"cancel") | Bool
isReplWorking]
  keyCmdsFor (Just Name
WorldPanel) =
    [ (a
"←↓↑→ / hjkl", b
"scroll") | Bool
creative
    ]
      forall a. [a] -> [a] -> [a]
++ [(a
"c", b
"recenter") | Bool -> Bool
not Bool
viewingBase]
  keyCmdsFor (Just Name
RobotPanel) =
    [ (a
"Ret", b
"focus")
    , (a
"m", b
"make")
    , (a
"0", (if Bool
showZero then b
"hide" else b
"show") forall a. Semigroup a => a -> a -> a
<> b
" 0")
    ]
  keyCmdsFor (Just Name
InfoPanel) = []
  keyCmdsFor Maybe Name
_ = []

data KeyHighlight = NoHighlight | Highlighted

-- | Draw a single key command in the menu.
drawKeyCmd :: (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd :: (KeyHighlight, Text, Text) -> Widget Name
drawKeyCmd (KeyHighlight
Highlighted, Text
key, Text
cmd) = forall {n}. [Widget n] -> Widget n
hBox [forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr (forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"[", Text
key, Text
"] "]), forall n. Text -> Widget n
txt Text
cmd]
drawKeyCmd (KeyHighlight
NoHighlight, Text
key, Text
cmd) = forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"[", Text
key, Text
"] ", Text
cmd]

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

-- | Draw the current world view.
drawWorld :: GameState -> Widget Name
drawWorld :: GameState -> Widget Name
drawWorld GameState
g =
  forall n. Widget n -> Widget n
center
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> Widget n -> Widget n
cached Name
WorldCache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> Widget n -> Widget n
reportExtent Name
WorldExtent
    -- Set the clickable request after the extent to play nice with the cache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Ord n => n -> Widget n -> Widget n
clickable Name
WorldPanel
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed
    forall a b. (a -> b) -> a -> b
$ do
      Context Name
ctx <- forall n. RenderM n (Context n)
getContext
      let w :: Count
w = Context Name
ctx forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Context n) Count
availWidthL
          h :: Count
h = Context Name
ctx forall s a. s -> Getting a s a -> a
^. forall n. Lens' (Context n) Count
availHeightL
          ixs :: [Coords]
ixs = forall a. Ix a => (a, a) -> [a]
range (GameState -> (Int64, Int64) -> (Coords, Coords)
viewingRegion GameState
g (forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
w, forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
h))
      forall n. Widget n -> RenderM n (Result n)
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {n}. [Widget n] -> Widget n
hBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Count -> [e] -> [[e]]
chunksOf Count
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (GameState -> Coords -> Widget Name
drawLoc GameState
g) forall a b. (a -> b) -> a -> b
$ [Coords]
ixs

-- | Render the 'Display' for a specific location.
drawLoc :: GameState -> W.Coords -> Widget Name
drawLoc :: GameState -> Coords -> Widget Name
drawLoc GameState
g = forall n. Display -> Widget n
renderDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameState -> Coords -> Display
displayLoc GameState
g

-- | Get the 'Display' for a specific location, by combining the
--   'Display's for the terrain, entity, and robots at the location.
displayLoc :: GameState -> W.Coords -> Display
displayLoc :: GameState -> Coords -> Display
displayLoc GameState
g Coords
coords =
  forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$
    [Map TerrainType Display
terrainMap forall k a. Ord k => Map k a -> k -> a
M.! forall a. Enum a => Count -> a
toEnum (forall t e. IArray UArray t => Coords -> World t e -> t
W.lookupTerrain Coords
coords (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (World Count Entity)
world))]
      forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList (Entity -> Display
displayForEntity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t e. Coords -> World t e -> Maybe e
W.lookupEntity Coords
coords (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (World Count Entity)
world))
      forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Robot Display
robotDisplay) (V2 Int64 -> GameState -> [Robot]
robotsAtLocation (Coords -> V2 Int64
W.coordsToLoc Coords
coords) GameState
g)
 where
  displayForEntity :: Entity -> Display
  displayForEntity :: Entity -> Display
displayForEntity Entity
e = (if Entity -> Bool
known Entity
e then forall a. a -> a
id else Display -> Display
hidden) (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Display
entityDisplay)

  known :: Entity -> Bool
known Entity
e =
    Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Known
      Bool -> Bool -> Bool
|| (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState [Text]
knownEntities)
      Bool -> Bool -> Bool
|| case GameState -> HideEntity
hidingMode GameState
g of
        HideEntity
HideAllEntities -> Bool
False
        HideEntity
HideNoEntity -> Bool
True
        HideEntityUnknownTo Robot
ro -> Robot
ro Robot -> Entity -> Bool
`robotKnows` Entity
e

data HideEntity = HideAllEntities | HideNoEntity | HideEntityUnknownTo Robot

hidingMode :: GameState -> HideEntity
hidingMode :: GameState -> HideEntity
hidingMode GameState
g
  | GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode = HideEntity
HideNoEntity
  | Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe HideEntity
HideAllEntities Robot -> HideEntity
HideEntityUnknownTo forall a b. (a -> b) -> a -> b
$ GameState -> Maybe Robot
focusedRobot GameState
g

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

-- | Draw info about the currently focused robot, such as its name,
--   position, orientation, and inventory.
drawRobotPanel :: AppState -> Widget Name
drawRobotPanel :: AppState -> Widget Name
drawRobotPanel AppState
s = case (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot, AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Count, List Name InventoryListEntry))
uiInventory) of
  (Just Robot
r, Just (Count
_, List Name InventoryListEntry
lst)) ->
    let V2 Int64
x Int64
y = Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (V2 Int64)
robotLocation
        drawClickableItem :: Count -> Bool -> InventoryListEntry -> Widget Name
drawClickableItem Count
pos Bool
selb = forall n. Ord n => n -> Widget n -> Widget n
clickable (Count -> Name
InventoryListItem Count
pos) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Count -> Count -> Bool -> InventoryListEntry -> Widget Name
drawItem (List Name InventoryListEntry
lst forall s a. s -> Getting a s a -> a
^. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Count)
BL.listSelectedL) Count
pos Bool
selb
     in forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall a b. (a -> b) -> a -> b
$
          forall {n}. [Widget n] -> Widget n
vBox
            [ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$
                forall {n}. [Widget n] -> Widget n
hBox
                  [ forall n. Text -> Widget n
txt (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Text
robotName)
                  , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
2) forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (forall r. PrintfType r => String -> r
printf String
"(%d, %d)" Int64
x Int64
y)
                  , forall n. Padding -> Widget n -> Widget n
padLeft (Count -> Padding
Pad Count
2) forall a b. (a -> b) -> a -> b
$ forall n. Display -> Widget n
renderDisplay (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Display
robotDisplay)
                  ]
            , forall n. Count -> Widget n -> Widget n
padAll Count
1 (forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Count -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
BL.renderListWithIndex Count -> Bool -> InventoryListEntry -> Widget Name
drawClickableItem Bool
True List Name InventoryListEntry
lst)
            ]
  (Maybe Robot, Maybe (Count, List Name InventoryListEntry))
_ -> forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
" "

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

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

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

-- | Draw the info panel in the bottom-left corner, which shows info
--   about the currently focused inventory item.
drawInfoPanel :: AppState -> Widget Name
drawInfoPanel :: AppState -> Widget Name
drawInfoPanel AppState
s =
  forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport Name
InfoViewport ViewportType
Vertical
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Count -> Widget n -> Widget n
padLeftRight Count
1
    forall a b. (a -> b) -> a -> b
$ AppState -> Widget Name
explainFocusedItem AppState
s

-- | Display info about the currently focused inventory entity,
--   such as its description and relevant recipes.
explainFocusedItem :: AppState -> Widget Name
explainFocusedItem :: AppState -> Widget Name
explainFocusedItem AppState
s = case AppState -> Maybe InventoryListEntry
focusedItem AppState
s of
  Just (InventoryEntry Count
_ Entity
e) -> AppState -> Entity -> Widget Name
explainEntry AppState
s Entity
e
  Just (InstalledEntry Entity
e) ->
    AppState -> Entity -> Widget Name
explainEntry AppState
s Entity
e
      -- Special case: installed logger device displays the robot's log.
      forall n. Widget n -> Widget n -> Widget n
<=> if Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName forall a. Eq a => a -> a -> Bool
== Text
"logger" then AppState -> Widget Name
drawRobotLog AppState
s else forall {n}. Widget n
emptyWidget
  Maybe InventoryListEntry
_ -> forall n. Text -> Widget n
txt Text
" "

explainEntry :: AppState -> Entity -> Widget Name
explainEntry :: AppState -> Entity -> Widget Name
explainEntry AppState
s Entity
e =
  forall {n}. [Widget n] -> Widget n
vBox
    [ [EntityProperty] -> Widget Name
displayProperties (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity [EntityProperty]
entityProperties)
    , [Text] -> Widget Name
displayParagraphs (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity [Text]
entityDescription)
    , AppState -> Entity -> Widget Name
explainRecipes AppState
s Entity
e
    ]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  rn :: Maybe Text
rn = AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Text
robotName
  n :: Count
n = forall (t :: * -> *) a. Foldable t => t a -> Count
length [LogEntry]
logEntries

  allMe :: Bool
allMe = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== Maybe Text
rn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' LogEntry Text
leRobotName) [LogEntry]
logEntries

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

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

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

-- | Draw the REPL.
drawREPL :: AppState -> Widget Name
drawREPL :: AppState -> Widget Name
drawREPL AppState
s =
  forall {n}. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map forall {n}. REPLHistItem -> Widget n
fmt (Count -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems (Count
replHeight forall a. Num a => a -> a -> a
- Count
inputLines) REPLHistory
history)
      forall a. [a] -> [a] -> [a]
++ case Robot -> Bool
isActive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
base of
        Just Bool
False -> [forall n s e. Eq n => Form s e n -> Widget n
renderForm (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Form REPLPrompt AppEvent Name)
uiReplForm)]
        Maybe Bool
_ -> [forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"..."]
      forall a. [a] -> [a] -> [a]
++ [forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
histIdx | Bool
debugging]
 where
  debugging :: Bool
debugging = Bool
False -- Turn ON to get extra line with history index
  inputLines :: Count
inputLines = Count
1 forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Count
fromEnum Bool
debugging
  history :: REPLHistory
history = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLHistory
uiReplHistory
  base :: Maybe Robot
base = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Count
0
  histIdx :: Text
histIdx = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (REPLHistory
history forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Count
replIndex)
  fmt :: REPLHistItem -> Widget n
fmt (REPLEntry Text
e) = forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
"> " forall a. Semigroup a => a -> a -> a
<> Text
e
  fmt (REPLOutput Text
t) = forall n. Text -> Widget n
txt Text
t

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

-- | Display a list of text-wrapped paragraphs with one blank line after
--   each.
displayParagraphs :: [Text] -> Widget Name
displayParagraphs :: [Text] -> Widget Name
displayParagraphs = forall {n}. [Widget n] -> Widget n
vBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall n. Padding -> Widget n -> Widget n
padBottom (Count -> Padding
Pad Count
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txtWrap)