-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.Editor.View where

import Brick hiding (Direction)
import Brick.Focus
import Brick.Widgets.Center (hCenter)
import Brick.Widgets.List qualified as BL
import Control.Lens hiding (Const, from)
import Data.List qualified as L
import Swarm.Game.Land
import Swarm.Game.Scenario
import Swarm.Game.Scenario.Topography.Area qualified as EA
import Swarm.Game.Scenario.Topography.EntityFacade
import Swarm.Game.Terrain (TerrainMap, TerrainType)
import Swarm.Game.Universe
import Swarm.Game.World.Coords
import Swarm.TUI.Border
import Swarm.TUI.Editor.Model
import Swarm.TUI.Model
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.UI
import Swarm.TUI.Panel
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.CellDisplay (renderDisplay)
import Swarm.TUI.View.Util qualified as VU

extractTerrainMap :: UIState -> TerrainMap
extractTerrainMap :: UIState -> TerrainMap
extractTerrainMap UIState
uis =
  TerrainMap
-> ((Scenario, ScenarioInfo) -> TerrainMap)
-> Maybe (Scenario, ScenarioInfo)
-> TerrainMap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TerrainMap
forall a. Monoid a => a
mempty (Getting TerrainMap Scenario TerrainMap -> Scenario -> TerrainMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ScenarioLandscape -> Const TerrainMap ScenarioLandscape)
-> Scenario -> Const TerrainMap Scenario
Lens' Scenario ScenarioLandscape
scenarioLandscape ((ScenarioLandscape -> Const TerrainMap ScenarioLandscape)
 -> Scenario -> Const TerrainMap Scenario)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> ScenarioLandscape -> Const TerrainMap ScenarioLandscape)
-> Getting TerrainMap Scenario TerrainMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> ScenarioLandscape -> Const TerrainMap ScenarioLandscape
Lens' ScenarioLandscape TerrainEntityMaps
scenarioTerrainAndEntities ((TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
 -> ScenarioLandscape -> Const TerrainMap ScenarioLandscape)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> (TerrainMap -> Const TerrainMap TerrainMap)
-> ScenarioLandscape
-> Const TerrainMap ScenarioLandscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainMap -> Const TerrainMap TerrainMap)
-> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps
Lens' TerrainEntityMaps TerrainMap
terrainMap) (Scenario -> TerrainMap)
-> ((Scenario, ScenarioInfo) -> Scenario)
-> (Scenario, ScenarioInfo)
-> TerrainMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scenario, ScenarioInfo) -> Scenario
forall a b. (a, b) -> a
fst) (Maybe (Scenario, ScenarioInfo) -> TerrainMap)
-> Maybe (Scenario, ScenarioInfo) -> TerrainMap
forall a b. (a -> b) -> a -> b
$
    UIState
uis UIState
-> Getting
     (Maybe (Scenario, ScenarioInfo))
     UIState
     (Maybe (Scenario, ScenarioInfo))
-> Maybe (Scenario, ScenarioInfo)
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
-> UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
 -> UIState -> Const (Maybe (Scenario, ScenarioInfo)) UIState)
-> ((Maybe (Scenario, ScenarioInfo)
     -> Const
          (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
    -> UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay)
-> Getting
     (Maybe (Scenario, ScenarioInfo))
     UIState
     (Maybe (Scenario, ScenarioInfo))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Scenario, ScenarioInfo)
 -> Const
      (Maybe (Scenario, ScenarioInfo)) (Maybe (Scenario, ScenarioInfo)))
-> UIGameplay -> Const (Maybe (Scenario, ScenarioInfo)) UIGameplay
Lens' UIGameplay (Maybe (Scenario, ScenarioInfo))
scenarioRef

drawWorldEditor :: FocusRing Name -> UIState -> Widget Name
drawWorldEditor :: FocusRing Name -> UIState -> Widget Name
drawWorldEditor FocusRing Name
toplevelFocusRing UIState
uis =
  if WorldEditor Name
worldEditor WorldEditor Name -> Getting Bool (WorldEditor Name) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (WorldOverdraw -> Const Bool WorldOverdraw)
-> WorldEditor Name -> Const Bool (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(WorldOverdraw -> f WorldOverdraw)
-> WorldEditor n -> f (WorldEditor n)
worldOverdraw ((WorldOverdraw -> Const Bool WorldOverdraw)
 -> WorldEditor Name -> Const Bool (WorldEditor Name))
-> ((Bool -> Const Bool Bool)
    -> WorldOverdraw -> Const Bool WorldOverdraw)
-> Getting Bool (WorldEditor Name) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> WorldOverdraw -> Const Bool WorldOverdraw
Lens' WorldOverdraw Bool
isWorldEditorEnabled
    then
      AttrName
-> FocusRing Name
-> Name
-> BorderLabels Name
-> Widget Name
-> Widget Name
forall n.
Eq n =>
AttrName
-> FocusRing n -> n -> BorderLabels n -> Widget n -> Widget n
panel
        AttrName
highlightAttr
        FocusRing Name
toplevelFocusRing
        (FocusablePanel -> Name
FocusablePanel FocusablePanel
WorldEditorPanel)
        BorderLabels Name
forall n. BorderLabels n
plainBorder
        Widget Name
innerWidget
    else Widget Name
forall n. Widget n
emptyWidget
 where
  privateFocusRing :: FocusRing Name
privateFocusRing = WorldEditor Name
worldEditor WorldEditor Name
-> Getting (FocusRing Name) (WorldEditor Name) (FocusRing Name)
-> FocusRing Name
forall s a. s -> Getting a s a -> a
^. Getting (FocusRing Name) (WorldEditor Name) (FocusRing Name)
forall n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n))
-> WorldEditor n -> f (WorldEditor n)
editorFocusRing
  maybeCurrentFocus :: Maybe Name
maybeCurrentFocus = FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
privateFocusRing

  controlsBox :: Widget Name
controlsBox =
    Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
      [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
        [ Widget Name
brushWidget
        , Widget Name
entityWidget
        , Widget Name
clearEntityButtonWidget
        , Widget Name
areaWidget
        , Widget Name
outputWidget
        , String -> Widget Name
forall n. String -> Widget n
str String
" "
        , Widget Name
saveButtonWidget
        ]

  innerWidget :: Widget Name
innerWidget =
    Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
      Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
30 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        Widget Name
controlsBox Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
statusBox

  worldEditor :: WorldEditor Name
worldEditor = UIState
uis UIState
-> Getting (WorldEditor Name) UIState (WorldEditor Name)
-> WorldEditor Name
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> UIState -> Const (WorldEditor Name) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (WorldEditor Name) UIGameplay)
 -> UIState -> Const (WorldEditor Name) UIState)
-> ((WorldEditor Name
     -> Const (WorldEditor Name) (WorldEditor Name))
    -> UIGameplay -> Const (WorldEditor Name) UIGameplay)
-> Getting (WorldEditor Name) UIState (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Const (WorldEditor Name) (WorldEditor Name))
-> UIGameplay -> Const (WorldEditor Name) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor
  maybeAreaBounds :: Maybe (Cosmic BoundsRectangle)
maybeAreaBounds = WorldEditor Name
worldEditor WorldEditor Name
-> Getting
     (Maybe (Cosmic BoundsRectangle))
     (WorldEditor Name)
     (Maybe (Cosmic BoundsRectangle))
-> Maybe (Cosmic BoundsRectangle)
forall s a. s -> Getting a s a -> a
^. (MapEditingBounds
 -> Const (Maybe (Cosmic BoundsRectangle)) MapEditingBounds)
-> WorldEditor Name
-> Const (Maybe (Cosmic BoundsRectangle)) (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
editingBounds ((MapEditingBounds
  -> Const (Maybe (Cosmic BoundsRectangle)) MapEditingBounds)
 -> WorldEditor Name
 -> Const (Maybe (Cosmic BoundsRectangle)) (WorldEditor Name))
-> ((Maybe (Cosmic BoundsRectangle)
     -> Const
          (Maybe (Cosmic BoundsRectangle)) (Maybe (Cosmic BoundsRectangle)))
    -> MapEditingBounds
    -> Const (Maybe (Cosmic BoundsRectangle)) MapEditingBounds)
-> Getting
     (Maybe (Cosmic BoundsRectangle))
     (WorldEditor Name)
     (Maybe (Cosmic BoundsRectangle))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cosmic BoundsRectangle)
 -> Const
      (Maybe (Cosmic BoundsRectangle)) (Maybe (Cosmic BoundsRectangle)))
-> MapEditingBounds
-> Const (Maybe (Cosmic BoundsRectangle)) MapEditingBounds
Lens' MapEditingBounds (Maybe (Cosmic BoundsRectangle))
boundsRect

  -- TODO (#1150): Use withFocusRing?
  mkFormControl :: Name -> Widget Name -> Widget Name
mkFormControl Name
n Widget Name
w =
    Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable Name
n (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
transformation Widget Name
w
   where
    transformation :: Widget n -> Widget n
transformation =
      if Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Name
maybeCurrentFocus
        then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
BL.listSelectedFocusedAttr
        else Widget n -> Widget n
forall a. a -> a
id

  swatchContent :: GenericList n t a -> (a -> Widget n) -> Widget n
swatchContent GenericList n t a
list a -> Widget n
drawFunc =
    Widget n -> (a -> Widget n) -> Maybe a -> Widget n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget n
forall n. Widget n
emptyWidget a -> Widget n
drawFunc Maybe a
selectedThing
   where
    selectedThing :: Maybe a
selectedThing = (Int, a) -> a
forall a b. (a, b) -> b
snd ((Int, a) -> a) -> Maybe (Int, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericList n t a -> Maybe (Int, a)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement GenericList n t a
list

  tm :: TerrainMap
tm = UIState -> TerrainMap
extractTerrainMap UIState
uis

  brushWidget :: Widget Name
brushWidget =
    Name -> Widget Name -> Widget Name
mkFormControl (WorldEditorFocusable -> Name
WorldEditorPanelControl WorldEditorFocusable
BrushSelector) (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
padRight (Int -> Padding
Pad Int
1) (String -> Widget Name
forall n. String -> Widget n
str String
"Brush:")
        Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> GenericList Name Vector TerrainType
-> (TerrainType -> Widget Name) -> Widget Name
forall {t :: * -> *} {a} {n} {n}.
(Splittable t, Traversable t, Semigroup (t a)) =>
GenericList n t a -> (a -> Widget n) -> Widget n
swatchContent (WorldEditor Name
worldEditor WorldEditor Name
-> Getting
     (GenericList Name Vector TerrainType)
     (WorldEditor Name)
     (GenericList Name Vector TerrainType)
-> GenericList Name Vector TerrainType
forall s a. s -> Getting a s a -> a
^. Getting
  (GenericList Name Vector TerrainType)
  (WorldEditor Name)
  (GenericList Name Vector TerrainType)
forall n (f :: * -> *).
Functor f =>
(List n TerrainType -> f (List n TerrainType))
-> WorldEditor n -> f (WorldEditor n)
terrainList) (TerrainMap -> TerrainType -> Widget Name
VU.drawLabeledTerrainSwatch TerrainMap
tm)

  entityWidget :: Widget Name
entityWidget =
    Name -> Widget Name -> Widget Name
mkFormControl (WorldEditorFocusable -> Name
WorldEditorPanelControl WorldEditorFocusable
EntitySelector) (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
padRight (Int -> Padding
Pad Int
1) (String -> Widget Name
forall n. String -> Widget n
str String
"Entity:")
        Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> GenericList Name Vector EntityFacade
-> (EntityFacade -> Widget Name) -> Widget Name
forall {t :: * -> *} {a} {n} {n}.
(Splittable t, Traversable t, Semigroup (t a)) =>
GenericList n t a -> (a -> Widget n) -> Widget n
swatchContent (WorldEditor Name
worldEditor WorldEditor Name
-> Getting
     (GenericList Name Vector EntityFacade)
     (WorldEditor Name)
     (GenericList Name Vector EntityFacade)
-> GenericList Name Vector EntityFacade
forall s a. s -> Getting a s a -> a
^. Getting
  (GenericList Name Vector EntityFacade)
  (WorldEditor Name)
  (GenericList Name Vector EntityFacade)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList) EntityFacade -> Widget Name
drawLabeledEntitySwatch

  clearEntityButtonWidget :: Widget Name
clearEntityButtonWidget =
    if Maybe Int -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor WorldEditor Name
-> Getting (Maybe Int) (WorldEditor Name) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (GenericList Name Vector EntityFacade
 -> Const (Maybe Int) (GenericList Name Vector EntityFacade))
-> WorldEditor Name -> Const (Maybe Int) (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList ((GenericList Name Vector EntityFacade
  -> Const (Maybe Int) (GenericList Name Vector EntityFacade))
 -> WorldEditor Name -> Const (Maybe Int) (WorldEditor Name))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> GenericList Name Vector EntityFacade
    -> Const (Maybe Int) (GenericList Name Vector EntityFacade))
-> Getting (Maybe Int) (WorldEditor Name) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> GenericList Name Vector EntityFacade
-> Const (Maybe Int) (GenericList Name Vector EntityFacade)
forall n (t :: * -> *) e (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> GenericList n t e -> f (GenericList n t e)
BL.listSelectedL
      then Widget Name
forall n. Widget n
emptyWidget
      else
        Name -> Widget Name -> Widget Name
mkFormControl (WorldEditorFocusable -> Name
WorldEditorPanelControl WorldEditorFocusable
ClearEntityButton)
          (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
20
          (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
hCenter
          (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
forall n. String -> Widget n
str String
"None"

  areaContent :: Widget n
areaContent = case WorldEditor Name
worldEditor WorldEditor Name
-> Getting
     BoundsSelectionStep (WorldEditor Name) BoundsSelectionStep
-> BoundsSelectionStep
forall s a. s -> Getting a s a -> a
^. (MapEditingBounds -> Const BoundsSelectionStep MapEditingBounds)
-> WorldEditor Name -> Const BoundsSelectionStep (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
editingBounds ((MapEditingBounds -> Const BoundsSelectionStep MapEditingBounds)
 -> WorldEditor Name
 -> Const BoundsSelectionStep (WorldEditor Name))
-> ((BoundsSelectionStep
     -> Const BoundsSelectionStep BoundsSelectionStep)
    -> MapEditingBounds -> Const BoundsSelectionStep MapEditingBounds)
-> Getting
     BoundsSelectionStep (WorldEditor Name) BoundsSelectionStep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BoundsSelectionStep
 -> Const BoundsSelectionStep BoundsSelectionStep)
-> MapEditingBounds -> Const BoundsSelectionStep MapEditingBounds
Lens' MapEditingBounds BoundsSelectionStep
boundsSelectionStep of
    BoundsSelectionStep
UpperLeftPending -> String -> Widget n
forall n. String -> Widget n
str String
"Click top-left"
    LowerRightPending Cosmic Coords
_wcoords -> String -> Widget n
forall n. String -> Widget n
str String
"Click bottom-right"
    BoundsSelectionStep
SelectionComplete -> Widget n
-> (Cosmic BoundsRectangle -> Widget n)
-> Maybe (Cosmic BoundsRectangle)
-> Widget n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget n
forall n. Widget n
emptyWidget (BoundsRectangle -> Widget n
forall {n}. BoundsRectangle -> Widget n
renderBounds (BoundsRectangle -> Widget n)
-> (Cosmic BoundsRectangle -> BoundsRectangle)
-> Cosmic BoundsRectangle
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting BoundsRectangle (Cosmic BoundsRectangle) BoundsRectangle
-> Cosmic BoundsRectangle -> BoundsRectangle
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BoundsRectangle (Cosmic BoundsRectangle) BoundsRectangle
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar) Maybe (Cosmic BoundsRectangle)
maybeAreaBounds

  areaWidget :: Widget Name
areaWidget =
    Name -> Widget Name -> Widget Name
mkFormControl (WorldEditorFocusable -> Name
WorldEditorPanelControl WorldEditorFocusable
AreaSelector) (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
        [ String -> Widget Name
forall n. String -> Widget n
str String
"Area:"
        , Widget Name
forall n. Widget n
areaContent
        ]

  renderBounds :: BoundsRectangle -> Widget n
renderBounds (Coords
upperLeftCoord, Coords
lowerRightCoord) =
    String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$
      [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        String -> [String] -> [String]
forall a. a -> [a] -> [a]
L.intersperse
          String
"@"
          [ AreaDimensions -> String
EA.renderRectDimensions AreaDimensions
rectArea
          , Location -> String
VU.locationToString Location
upperLeftLoc
          ]
   where
    upperLeftLoc :: Location
upperLeftLoc = Coords -> Location
coordsToLoc Coords
upperLeftCoord
    lowerRightLoc :: Location
lowerRightLoc = Coords -> Location
coordsToLoc Coords
lowerRightCoord
    rectArea :: AreaDimensions
rectArea = Location -> Location -> AreaDimensions
EA.cornersToArea Location
upperLeftLoc Location
lowerRightLoc

  outputWidget :: Widget Name
outputWidget =
    Name -> Widget Name -> Widget Name
mkFormControl (WorldEditorFocusable -> Name
WorldEditorPanelControl WorldEditorFocusable
OutputPathSelector) (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
padRight (Int -> Padding
Pad Int
1) (String -> Widget Name
forall n. String -> Widget n
str String
"Output:") Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall n. Widget n
outputWidgetContent

  outputWidgetContent :: Widget n
outputWidgetContent = String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor WorldEditor Name
-> Getting String (WorldEditor Name) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (WorldEditor Name) String
forall n (f :: * -> *).
Functor f =>
(String -> f String) -> WorldEditor n -> f (WorldEditor n)
outputFilePath

  saveButtonWidget :: Widget Name
saveButtonWidget =
    Name -> Widget Name -> Widget Name
mkFormControl (WorldEditorFocusable -> Name
WorldEditorPanelControl WorldEditorFocusable
MapSaveButton)
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
20
      (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
hCenter
      (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
forall n. String -> Widget n
str String
"Save"

  statusBox :: Widget n
statusBox = Widget n -> (String -> Widget n) -> Maybe String -> Widget n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget n
forall n. Widget n
emptyWidget String -> Widget n
forall n. String -> Widget n
str (Maybe String -> Widget n) -> Maybe String -> Widget n
forall a b. (a -> b) -> a -> b
$ WorldEditor Name
worldEditor WorldEditor Name
-> Getting (Maybe String) (WorldEditor Name) (Maybe String)
-> Maybe String
forall s a. s -> Getting a s a -> a
^. Getting (Maybe String) (WorldEditor Name) (Maybe String)
forall n (f :: * -> *).
Functor f =>
(Maybe String -> f (Maybe String))
-> WorldEditor n -> f (WorldEditor n)
lastWorldEditorMessage

drawLabeledEntitySwatch :: EntityFacade -> Widget Name
drawLabeledEntitySwatch :: EntityFacade -> Widget Name
drawLabeledEntitySwatch (EntityFacade EntityName
eName Display
eDisplay) =
  Widget Name
forall n. Widget n
tile Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> EntityName -> Widget Name
forall n. EntityName -> Widget n
txt EntityName
eName
 where
  tile :: Widget n
tile = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Display -> Widget n
forall n. Display -> Widget n
renderDisplay Display
eDisplay

drawTerrainSelector :: AppState -> Widget Name
drawTerrainSelector :: AppState -> Widget Name
drawTerrainSelector AppState
s =
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
1
    (Widget Name -> Widget Name)
-> (GenericList Name Vector TerrainType -> Widget Name)
-> GenericList Name Vector TerrainType
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
hCenter
    (Widget Name -> Widget Name)
-> (GenericList Name Vector TerrainType -> Widget Name)
-> GenericList Name Vector TerrainType
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
8
    (Widget Name -> Widget Name)
-> (GenericList Name Vector TerrainType -> Widget Name)
-> GenericList Name Vector TerrainType
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> TerrainType -> Widget Name)
-> Bool -> GenericList Name Vector TerrainType -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
BL.renderListWithIndex (TerrainMap -> Int -> Bool -> TerrainType -> Widget Name
listDrawTerrainElement (TerrainMap -> Int -> Bool -> TerrainType -> Widget Name)
-> TerrainMap -> Int -> Bool -> TerrainType -> Widget Name
forall a b. (a -> b) -> a -> b
$ UIState -> TerrainMap
extractTerrainMap (UIState -> TerrainMap) -> UIState -> TerrainMap
forall a b. (a -> b) -> a -> b
$ AppState
s AppState -> Getting UIState AppState UIState -> UIState
forall s a. s -> Getting a s a -> a
^. Getting UIState AppState UIState
Lens' AppState UIState
uiState) Bool
True
    (GenericList Name Vector TerrainType -> Widget Name)
-> GenericList Name Vector TerrainType -> Widget Name
forall a b. (a -> b) -> a -> b
$ AppState
s AppState
-> Getting
     (GenericList Name Vector TerrainType)
     AppState
     (GenericList Name Vector TerrainType)
-> GenericList Name Vector TerrainType
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (GenericList Name Vector TerrainType) UIState)
-> AppState -> Const (GenericList Name Vector TerrainType) AppState
Lens' AppState UIState
uiState ((UIState -> Const (GenericList Name Vector TerrainType) UIState)
 -> AppState
 -> Const (GenericList Name Vector TerrainType) AppState)
-> ((GenericList Name Vector TerrainType
     -> Const
          (GenericList Name Vector TerrainType)
          (GenericList Name Vector TerrainType))
    -> UIState -> Const (GenericList Name Vector TerrainType) UIState)
-> Getting
     (GenericList Name Vector TerrainType)
     AppState
     (GenericList Name Vector TerrainType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Const (GenericList Name Vector TerrainType) UIGameplay)
-> UIState -> Const (GenericList Name Vector TerrainType) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Const (GenericList Name Vector TerrainType) UIGameplay)
 -> UIState -> Const (GenericList Name Vector TerrainType) UIState)
-> ((GenericList Name Vector TerrainType
     -> Const
          (GenericList Name Vector TerrainType)
          (GenericList Name Vector TerrainType))
    -> UIGameplay
    -> Const (GenericList Name Vector TerrainType) UIGameplay)
-> (GenericList Name Vector TerrainType
    -> Const
         (GenericList Name Vector TerrainType)
         (GenericList Name Vector TerrainType))
-> UIState
-> Const (GenericList Name Vector TerrainType) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Const (GenericList Name Vector TerrainType) (WorldEditor Name))
-> UIGameplay
-> Const (GenericList Name Vector TerrainType) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name
  -> Const (GenericList Name Vector TerrainType) (WorldEditor Name))
 -> UIGameplay
 -> Const (GenericList Name Vector TerrainType) UIGameplay)
-> Getting
     (GenericList Name Vector TerrainType)
     (WorldEditor Name)
     (GenericList Name Vector TerrainType)
-> (GenericList Name Vector TerrainType
    -> Const
         (GenericList Name Vector TerrainType)
         (GenericList Name Vector TerrainType))
-> UIGameplay
-> Const (GenericList Name Vector TerrainType) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (GenericList Name Vector TerrainType)
  (WorldEditor Name)
  (GenericList Name Vector TerrainType)
forall n (f :: * -> *).
Functor f =>
(List n TerrainType -> f (List n TerrainType))
-> WorldEditor n -> f (WorldEditor n)
terrainList

listDrawTerrainElement :: TerrainMap -> Int -> Bool -> TerrainType -> Widget Name
listDrawTerrainElement :: TerrainMap -> Int -> Bool -> TerrainType -> Widget Name
listDrawTerrainElement TerrainMap
tm Int
pos Bool
_isSelected TerrainType
a =
  Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (Int -> Name
TerrainListItem Int
pos) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ TerrainMap -> TerrainType -> Widget Name
VU.drawLabeledTerrainSwatch TerrainMap
tm TerrainType
a

drawEntityPaintSelector :: AppState -> Widget Name
drawEntityPaintSelector :: AppState -> Widget Name
drawEntityPaintSelector AppState
s =
  Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
1
    (Widget Name -> Widget Name)
-> (GenericList Name Vector EntityFacade -> Widget Name)
-> GenericList Name Vector EntityFacade
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
hCenter
    (Widget Name -> Widget Name)
-> (GenericList Name Vector EntityFacade -> Widget Name)
-> GenericList Name Vector EntityFacade
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
10
    (Widget Name -> Widget Name)
-> (GenericList Name Vector EntityFacade -> Widget Name)
-> GenericList Name Vector EntityFacade
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> EntityFacade -> Widget Name)
-> Bool -> GenericList Name Vector EntityFacade -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
BL.renderListWithIndex Int -> Bool -> EntityFacade -> Widget Name
listDrawEntityPaintElement Bool
True
    (GenericList Name Vector EntityFacade -> Widget Name)
-> GenericList Name Vector EntityFacade -> Widget Name
forall a b. (a -> b) -> a -> b
$ AppState
s AppState
-> Getting
     (GenericList Name Vector EntityFacade)
     AppState
     (GenericList Name Vector EntityFacade)
-> GenericList Name Vector EntityFacade
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (GenericList Name Vector EntityFacade) UIState)
-> AppState
-> Const (GenericList Name Vector EntityFacade) AppState
Lens' AppState UIState
uiState ((UIState -> Const (GenericList Name Vector EntityFacade) UIState)
 -> AppState
 -> Const (GenericList Name Vector EntityFacade) AppState)
-> ((GenericList Name Vector EntityFacade
     -> Const
          (GenericList Name Vector EntityFacade)
          (GenericList Name Vector EntityFacade))
    -> UIState -> Const (GenericList Name Vector EntityFacade) UIState)
-> Getting
     (GenericList Name Vector EntityFacade)
     AppState
     (GenericList Name Vector EntityFacade)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Const (GenericList Name Vector EntityFacade) UIGameplay)
-> UIState -> Const (GenericList Name Vector EntityFacade) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Const (GenericList Name Vector EntityFacade) UIGameplay)
 -> UIState -> Const (GenericList Name Vector EntityFacade) UIState)
-> ((GenericList Name Vector EntityFacade
     -> Const
          (GenericList Name Vector EntityFacade)
          (GenericList Name Vector EntityFacade))
    -> UIGameplay
    -> Const (GenericList Name Vector EntityFacade) UIGameplay)
-> (GenericList Name Vector EntityFacade
    -> Const
         (GenericList Name Vector EntityFacade)
         (GenericList Name Vector EntityFacade))
-> UIState
-> Const (GenericList Name Vector EntityFacade) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Const (GenericList Name Vector EntityFacade) (WorldEditor Name))
-> UIGameplay
-> Const (GenericList Name Vector EntityFacade) UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name
  -> Const (GenericList Name Vector EntityFacade) (WorldEditor Name))
 -> UIGameplay
 -> Const (GenericList Name Vector EntityFacade) UIGameplay)
-> Getting
     (GenericList Name Vector EntityFacade)
     (WorldEditor Name)
     (GenericList Name Vector EntityFacade)
-> (GenericList Name Vector EntityFacade
    -> Const
         (GenericList Name Vector EntityFacade)
         (GenericList Name Vector EntityFacade))
-> UIGameplay
-> Const (GenericList Name Vector EntityFacade) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (GenericList Name Vector EntityFacade)
  (WorldEditor Name)
  (GenericList Name Vector EntityFacade)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList

listDrawEntityPaintElement :: Int -> Bool -> EntityFacade -> Widget Name
listDrawEntityPaintElement :: Int -> Bool -> EntityFacade -> Widget Name
listDrawEntityPaintElement Int
pos Bool
_isSelected EntityFacade
a =
  Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (Int -> Name
EntityPaintListItem Int
pos) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ EntityFacade -> Widget Name
drawLabeledEntitySwatch EntityFacade
a