{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Rendering of the scenario launch configuration dialog.
module Swarm.TUI.Launch.View where

import Brick
import Brick.Focus
import Brick.Forms qualified as BF
import Brick.Widgets.Border
import Brick.Widgets.Center (centerLayer, hCenter)
import Brick.Widgets.Edit
import Brick.Widgets.Edit qualified as E
import Brick.Widgets.FileBrowser qualified as FB
import Control.Exception qualified as E
import Control.Lens
import Data.Either (isRight)
import Data.Text (Text)
import Data.Text qualified as T
import Swarm.Game.Scenario (scenarioLandscape, scenarioSeed)
import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (..))
import Swarm.Game.State (getRunCodePath)
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.Prep
import Swarm.TUI.Model.Name
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.Util (EllipsisSide (Beginning), withEllipsis)
import Swarm.Util (brackets, parens)

drawFileBrowser :: FB.FileBrowser Name -> Widget Name
drawFileBrowser :: FileBrowser Name -> Widget Name
drawFileBrowser FileBrowser Name
b =
  Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
50 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name
ui Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall {n}. Widget n
help
 where
  ui :: Widget Name
ui =
    Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
15 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
      Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Choose a file") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        Bool -> FileBrowser Name -> Widget Name
forall n. (Show n, Ord n) => Bool -> FileBrowser n -> Widget n
FB.renderFileBrowser Bool
True FileBrowser Name
b

  footerRows :: [Widget n]
footerRows =
    (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map
      (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt)
      [ Text
"Up/Down: navigate"
      , Text
"/: search, Ctrl-C or Esc: cancel search"
      , Text
"Enter: change directory or select file"
      , Text
"Esc: quit"
      ]

  help :: Widget n
help =
    Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
      [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
        [ case FileBrowser Name -> Maybe IOException
forall n. FileBrowser n -> Maybe IOException
FB.fileBrowserException FileBrowser Name
b of
            Maybe IOException
Nothing -> Widget n
forall {n}. Widget n
emptyWidget
            Just IOException
e ->
              Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter
                (Widget n -> Widget n)
-> (String -> Widget n) -> String -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
BF.invalidFormInputAttr
                (Widget n -> Widget n)
-> (String -> Widget n) -> String -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt
                (Text -> Widget n) -> (String -> Text) -> String -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
                (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall e. Exception e => e -> String
E.displayException IOException
e
        ]
          [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [Widget n]
forall {n}. [Widget n]
footerRows

optionDescription :: ScenarioConfigPanelFocusable -> Maybe Text
optionDescription :: ScenarioConfigPanelFocusable -> Maybe Text
optionDescription = \case
  ScenarioConfigPanelFocusable
SeedSelector -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Leaving this field blank will use the default seed for the scenario."
  ScenarioConfigPanelFocusable
ScriptSelector -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Selecting a script to be run upon start permits eligibility for code size scoring."
  ScenarioConfigPanelFocusable
StartGameButton -> Maybe Text
forall a. Maybe a
Nothing

drawLaunchConfigPanel :: LaunchOptions -> [Widget Name]
drawLaunchConfigPanel :: LaunchOptions -> [Widget Name]
drawLaunchConfigPanel (LaunchOptions LaunchControls
lc EditingLaunchParams
launchParams) =
  [Widget Name] -> [Widget Name]
addFileBrowser [Widget Name
panelWidget]
 where
  validatedOptions :: Either Text ValidatedLaunchParams
validatedOptions = EditingLaunchParams -> Either Text ValidatedLaunchParams
toValidatedParams EditingLaunchParams
launchParams
  LaunchControls (FileBrowserControl FileBrowser Name
fb Maybe String
_ Bool
isFbDisplayed) Editor Text Name
seedEditor FocusRing Name
ring Maybe ScenarioInfoPair
displayedFor = LaunchControls
lc
  addFileBrowser :: [Widget Name] -> [Widget Name]
addFileBrowser =
    if Bool
isFbDisplayed
      then (FileBrowser Name -> Widget Name
drawFileBrowser FileBrowser Name
fb Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
:)
      else [Widget Name] -> [Widget Name]
forall a. a -> a
id

  getFocusedConfigPanel :: Maybe ScenarioConfigPanelFocusable
  getFocusedConfigPanel :: Maybe ScenarioConfigPanelFocusable
getFocusedConfigPanel = case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
ring of
    Just (ScenarioConfigControl (ScenarioConfigPanelControl ScenarioConfigPanelFocusable
x)) -> ScenarioConfigPanelFocusable -> Maybe ScenarioConfigPanelFocusable
forall a. a -> Maybe a
Just ScenarioConfigPanelFocusable
x
    Maybe Name
_ -> Maybe ScenarioConfigPanelFocusable
forall a. Maybe a
Nothing

  isFocused :: ScenarioConfigPanelFocusable -> Bool
isFocused = (Maybe ScenarioConfigPanelFocusable
-> Maybe ScenarioConfigPanelFocusable -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ScenarioConfigPanelFocusable
getFocusedConfigPanel) (Maybe ScenarioConfigPanelFocusable -> Bool)
-> (ScenarioConfigPanelFocusable
    -> Maybe ScenarioConfigPanelFocusable)
-> ScenarioConfigPanelFocusable
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioConfigPanelFocusable -> Maybe ScenarioConfigPanelFocusable
forall a. a -> Maybe a
Just

  highlightIfFocused :: ScenarioConfigPanelFocusable -> Widget n -> Widget n
highlightIfFocused ScenarioConfigPanelFocusable
x =
    if ScenarioConfigPanelFocusable -> Bool
isFocused ScenarioConfigPanelFocusable
x
      then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
highlightAttr
      else Widget n -> Widget n
forall a. a -> a
id

  mkButton :: ScenarioConfigPanelFocusable -> Text -> Widget Name
mkButton ScenarioConfigPanelFocusable
name Text
label =
    Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (ScenarioConfigPanel -> Name
ScenarioConfigControl (ScenarioConfigPanel -> Name) -> ScenarioConfigPanel -> Name
forall a b. (a -> b) -> a -> b
$ ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl ScenarioConfigPanelFocusable
name)
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioConfigPanelFocusable -> Widget Name -> Widget Name
forall {n}. ScenarioConfigPanelFocusable -> Widget n -> Widget n
highlightIfFocused ScenarioConfigPanelFocusable
name
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr
      (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
label

  mkSeedEditorWidget :: Widget Name
mkSeedEditorWidget =
    Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
10 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
      AttrName -> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> AttrName -> Widget n -> Widget n
overrideAttr AttrName
E.editFocusedAttr AttrName
customEditFocusedAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        ([Text] -> Widget Name) -> Bool -> Editor Text Name -> Widget Name
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor (Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> ([Text] -> Text) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat) (ScenarioConfigPanelFocusable -> Bool
isFocused ScenarioConfigPanelFocusable
SeedSelector) Editor Text Name
seedEditor
  seedEntryWidget :: Widget Name
seedEntryWidget = case EditingLaunchParams -> Either Text (Maybe Int)
forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe Int)
seedVal EditingLaunchParams
launchParams of
    Left Text
_ -> Widget Name
mkSeedEditorWidget
    Right Maybe Int
x -> Maybe Int -> Widget Name
forall {a}. Show a => Maybe a -> Widget Name
mkSeedEntryWidget Maybe Int
x

  scenarioSeedText :: String
scenarioSeedText =
    String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"random" Int -> String
forall a. Show a => a -> String
show (Maybe Int -> String) -> Maybe Int -> String
forall a b. (a -> b) -> a -> b
$
      Getting (Maybe Int) Scenario (Maybe Int) -> Scenario -> Maybe Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ScenarioLandscape -> Const (Maybe Int) ScenarioLandscape)
-> Scenario -> Const (Maybe Int) Scenario
Lens' Scenario ScenarioLandscape
scenarioLandscape ((ScenarioLandscape -> Const (Maybe Int) ScenarioLandscape)
 -> Scenario -> Const (Maybe Int) Scenario)
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ScenarioLandscape -> Const (Maybe Int) ScenarioLandscape)
-> Getting (Maybe Int) Scenario (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ScenarioLandscape -> Const (Maybe Int) ScenarioLandscape
Lens' ScenarioLandscape (Maybe Int)
scenarioSeed) (Scenario -> Maybe Int)
-> (ScenarioInfoPair -> Scenario) -> ScenarioInfoPair -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioInfoPair -> Scenario
forall a b. (a, b) -> a
fst (ScenarioInfoPair -> Maybe Int)
-> Maybe ScenarioInfoPair -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ScenarioInfoPair
displayedFor

  mkSeedEntryWidget :: Maybe a -> Widget Name
mkSeedEntryWidget Maybe a
seedEntryContent =
    if ScenarioConfigPanelFocusable -> Bool
isFocused ScenarioConfigPanelFocusable
SeedSelector
      then Widget Name
mkSeedEditorWidget
      else case Maybe a
seedEntryContent of
        Just a
x -> String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x
        Maybe a
Nothing ->
          AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$
              [Text] -> Text
T.unwords
                [ Text
"scenario default"
                , Text -> Text
parens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
scenarioSeedText
                ]

  unspecifiedFileMessage :: Widget n
unspecifiedFileMessage =
    if ScenarioConfigPanelFocusable -> Bool
isFocused ScenarioConfigPanelFocusable
ScriptSelector
      then String -> Widget n
forall n. String -> Widget n
str String
"<[Enter] to select>"
      else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"<none>"

  fileEntryWidget :: Widget Name
fileEntryWidget = case EditingLaunchParams -> Either Text (Maybe CodeToRun)
forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe code)
initialCode EditingLaunchParams
launchParams of
    Left Text
_ -> String -> Widget Name
forall n. String -> Widget n
str String
"<invalid>"
    Right Maybe CodeToRun
maybeFilepath ->
      Widget Name
-> (String -> Widget Name) -> Maybe String -> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Widget Name
forall {n}. Widget n
unspecifiedFileMessage
        (EllipsisSide -> Text -> Widget Name
withEllipsis EllipsisSide
Beginning (Text -> Widget Name) -> (String -> Text) -> String -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
        (CodeToRun -> Maybe String
getRunCodePath (CodeToRun -> Maybe String) -> Maybe CodeToRun -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe CodeToRun
maybeFilepath)

  panelWidget :: Widget Name
panelWidget =
    Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (String -> Widget Name
forall n. String -> Widget n
str String
" Configure scenario launch ")
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
60
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
1
      (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [Widget Name]
widgetMembers
   where
    startButton :: Widget Name
startButton =
      Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioConfigPanelFocusable -> Text -> Widget Name
mkButton ScenarioConfigPanelFocusable
StartGameButton (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
T.unwords
          [ Text
">>"
          , Text
"Launch with these settings"
          , Text
"<<"
          ]

    widgetMembers :: [Widget Name]
widgetMembers =
      [ Widget Name
controlsBox
      , Widget Name
forall {n}. Widget n
infoBox
      , if Either Text ValidatedLaunchParams -> Bool
forall a b. Either a b -> Bool
isRight Either Text ValidatedLaunchParams
validatedOptions then Widget Name
startButton else Widget Name
forall {n}. Widget n
emptyWidget
      ]

    formatInfo :: Text -> Text -> Widget n
formatInfo Text
header Text
content =
      [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox
        [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
6) (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Text
brackets Text
header
        , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txtWrap Text
content
        ]

    infoContent :: Widget n
infoContent = case Either Text ValidatedLaunchParams
validatedOptions of
      Left Text
errmsg -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
BF.invalidFormInputAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Widget n
forall {n}. Text -> Text -> Widget n
formatInfo Text
"Error" Text
errmsg
      Right ValidatedLaunchParams
_ -> case ScenarioConfigPanelFocusable -> Maybe Text
optionDescription (ScenarioConfigPanelFocusable -> Maybe Text)
-> Maybe ScenarioConfigPanelFocusable -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ScenarioConfigPanelFocusable
getFocusedConfigPanel of
        Just Text
desc -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Widget n
forall {n}. Text -> Text -> Widget n
formatInfo Text
"Info" Text
desc
        Maybe Text
Nothing -> String -> Widget n
forall n. String -> Widget n
str String
" "

    infoBox :: Widget n
infoBox =
      Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
4
        (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max
        (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
2)
        (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
forall {n}. Widget n
infoContent

    padControl :: ScenarioConfigPanelFocusable -> Text -> Widget Name -> Widget Name
padControl ScenarioConfigPanelFocusable
widgetName Text
label Widget Name
widgetObj =
      Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
          [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
            [ ScenarioConfigPanelFocusable -> Text -> Widget Name
mkButton ScenarioConfigPanelFocusable
widgetName (Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ")
            , Widget Name
widgetObj
            ]

    controlsBox :: Widget Name
controlsBox =
      [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
        [ ScenarioConfigPanelFocusable -> Text -> Widget Name -> Widget Name
padControl ScenarioConfigPanelFocusable
ScriptSelector Text
"Script" Widget Name
fileEntryWidget
        , ScenarioConfigPanelFocusable -> Text -> Widget Name -> Widget Name
padControl ScenarioConfigPanelFocusable
SeedSelector Text
"Seed" Widget Name
seedEntryWidget
        ]