{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Display logic for Structures.
module Swarm.TUI.View.Structure (
  renderStructuresDisplay,
  makeListWidget,
) where

import Brick hiding (Direction, Location, getName)
import Brick.Focus
import Brick.Widgets.Center (hCenter)
import Brick.Widgets.List qualified as BL
import Control.Lens hiding (Const, from)
import Data.Map.NonEmpty qualified as NEM
import Data.Map.Strict qualified as M
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Vector qualified as V
import Swarm.Game.Entity (Entity, entityDisplay)
import Swarm.Game.Scenario (StructureCells)
import Swarm.Game.Scenario.Topography.Area
import Swarm.Game.Scenario.Topography.Placement (getStructureName)
import Swarm.Game.Scenario.Topography.Structure qualified as Structure
import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute (getEntityGrid)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByName)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Swarm.Game.State
import Swarm.Game.State.Substate (structureRecognition)
import Swarm.Language.Syntax.Direction (directionJsonModifier)
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Structure
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.CellDisplay
import Swarm.TUI.View.Util
import Swarm.Util (commaList)

-- | Render a two-pane widget with structure selection on the left
-- and single-structure details on the right.
structureWidget :: GameState -> StructureInfo StructureCells Entity -> Widget n
structureWidget :: forall n.
GameState -> StructureInfo StructureCells Entity -> Widget n
structureWidget GameState
gs StructureInfo StructureCells Entity
s =
  [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
    [ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox
        [ Text -> Text -> Widget n
forall {n}. Text -> Text -> Widget n
headerItem Text
"Name" Text
theName
        , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2)
            (Widget n -> Widget n)
-> ([[AtomicKeySymbol Entity]] -> Widget n)
-> [[AtomicKeySymbol Entity]]
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Widget n
forall {n}. Text -> Text -> Widget n
headerItem Text
"Size"
            (Text -> Widget n)
-> ([[AtomicKeySymbol Entity]] -> Text)
-> [[AtomicKeySymbol Entity]]
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
            (String -> Text)
-> ([[AtomicKeySymbol Entity]] -> String)
-> [[AtomicKeySymbol Entity]]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AreaDimensions -> String
renderRectDimensions
            (AreaDimensions -> String)
-> ([[AtomicKeySymbol Entity]] -> AreaDimensions)
-> [[AtomicKeySymbol Entity]]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[AtomicKeySymbol Entity]] -> AreaDimensions
forall a. [[a]] -> AreaDimensions
getAreaDimensions
            ([[AtomicKeySymbol Entity]] -> Widget n)
-> [[AtomicKeySymbol Entity]] -> Widget n
forall a b. (a -> b) -> a -> b
$ StructureInfo StructureCells Entity -> [[AtomicKeySymbol Entity]]
forall b a. StructureInfo b a -> [SymbolSequence a]
entityProcessedGrid StructureInfo StructureCells Entity
s
        , Widget n
forall {n}. Widget n
occurrenceCountSuffix
        ]
    , Widget n
forall {n}. Widget n
reorientabilityWidget
    , Widget n
forall {n}. Widget n
maybeDescriptionWidget
    , 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
hBox
          [ Widget n
forall {n}. Widget n
structureIllustration
          , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4) Widget n
forall {n}. Widget n
ingredientsBox
          ]
    ]
 where
  headerItem :: Text -> Text -> Widget n
headerItem Text
h 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
padRight (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
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
      , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
content
      ]

  annotatedStructureGrid :: SymmetryAnnotatedGrid StructureCells
annotatedStructureGrid = StructureInfo StructureCells Entity
-> SymmetryAnnotatedGrid StructureCells
forall b a. StructureInfo b a -> SymmetryAnnotatedGrid b
annotatedGrid StructureInfo StructureCells Entity
s

  supportedOrientations :: [AbsoluteDir]
supportedOrientations = Set AbsoluteDir -> [AbsoluteDir]
forall a. Set a -> [a]
Set.toList (Set AbsoluteDir -> [AbsoluteDir])
-> (SymmetryAnnotatedGrid StructureCells -> Set AbsoluteDir)
-> SymmetryAnnotatedGrid StructureCells
-> [AbsoluteDir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureCells -> Set AbsoluteDir
forall a. NamedArea a -> Set AbsoluteDir
Structure.recognize (StructureCells -> Set AbsoluteDir)
-> (SymmetryAnnotatedGrid StructureCells -> StructureCells)
-> SymmetryAnnotatedGrid StructureCells
-> Set AbsoluteDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymmetryAnnotatedGrid StructureCells -> StructureCells
forall a. SymmetryAnnotatedGrid a -> a
namedGrid (SymmetryAnnotatedGrid StructureCells -> [AbsoluteDir])
-> SymmetryAnnotatedGrid StructureCells -> [AbsoluteDir]
forall a b. (a -> b) -> a -> b
$ SymmetryAnnotatedGrid StructureCells
annotatedStructureGrid

  renderSymmetry :: RotationalSymmetry -> Text
renderSymmetry = \case
    RotationalSymmetry
NoSymmetry -> Text
"no"
    RotationalSymmetry
TwoFold -> Text
"2-fold"
    RotationalSymmetry
FourFold -> Text
"4-fold"

  reorientabilityWidget :: Widget n
reorientabilityWidget =
    Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
T.unwords
        [ Text
"Orientable:"
        , [Text] -> Text
commaList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (AbsoluteDir -> Text) -> [AbsoluteDir] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (AbsoluteDir -> String) -> AbsoluteDir -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
directionJsonModifier (String -> String)
-> (AbsoluteDir -> String) -> AbsoluteDir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsoluteDir -> String
forall a. Show a => a -> String
show) [AbsoluteDir]
supportedOrientations
        , Text
"with"
        , RotationalSymmetry -> Text
renderSymmetry (RotationalSymmetry -> Text) -> RotationalSymmetry -> Text
forall a b. (a -> b) -> a -> b
$ SymmetryAnnotatedGrid StructureCells -> RotationalSymmetry
forall a. SymmetryAnnotatedGrid a -> RotationalSymmetry
symmetry SymmetryAnnotatedGrid StructureCells
annotatedStructureGrid
        , Text
"rotational symmetry."
        ]

  maybeDescriptionWidget :: Widget n
maybeDescriptionWidget =
    Widget n -> (Text -> Widget n) -> Maybe Text -> Widget n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget n
forall {n}. Widget n
emptyWidget (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> (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
italicAttr (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
txtWrap) (Maybe Text -> Widget n) -> Maybe Text -> Widget n
forall a b. (a -> b) -> a -> b
$
      StructureCells -> Maybe Text
forall a. NamedArea a -> Maybe Text
Structure.description (StructureCells -> Maybe Text)
-> (StructureInfo StructureCells Entity -> StructureCells)
-> StructureInfo StructureCells Entity
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymmetryAnnotatedGrid StructureCells -> StructureCells
forall a. SymmetryAnnotatedGrid a -> a
namedGrid (SymmetryAnnotatedGrid StructureCells -> StructureCells)
-> (StructureInfo StructureCells Entity
    -> SymmetryAnnotatedGrid StructureCells)
-> StructureInfo StructureCells Entity
-> StructureCells
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureInfo StructureCells Entity
-> SymmetryAnnotatedGrid StructureCells
forall b a. StructureInfo b a -> SymmetryAnnotatedGrid b
annotatedGrid (StructureInfo StructureCells Entity -> Maybe Text)
-> StructureInfo StructureCells Entity -> Maybe Text
forall a b. (a -> b) -> a -> b
$
        StructureInfo StructureCells Entity
s

  registry :: FoundRegistry StructureCells Entity
registry = GameState
gs GameState
-> Getting
     (FoundRegistry StructureCells Entity)
     GameState
     (FoundRegistry StructureCells Entity)
-> FoundRegistry StructureCells Entity
forall s a. s -> Getting a s a -> a
^. (Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> GameState
-> Const (FoundRegistry StructureCells Entity) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const (FoundRegistry StructureCells Entity) Discovery)
 -> GameState
 -> Const (FoundRegistry StructureCells Entity) GameState)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> Discovery
    -> Const (FoundRegistry StructureCells Entity) Discovery)
-> Getting
     (FoundRegistry StructureCells Entity)
     GameState
     (FoundRegistry StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (StructureRecognizer StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       (FoundRegistry StructureCells Entity)
       (StructureRecognizer StructureCells Entity))
 -> Discovery
 -> Const (FoundRegistry StructureCells Entity) Discovery)
-> ((FoundRegistry StructureCells Entity
     -> Const
          (FoundRegistry StructureCells Entity)
          (FoundRegistry StructureCells Entity))
    -> StructureRecognizer StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (StructureRecognizer StructureCells Entity))
-> (FoundRegistry StructureCells Entity
    -> Const
         (FoundRegistry StructureCells Entity)
         (FoundRegistry StructureCells Entity))
-> Discovery
-> Const (FoundRegistry StructureCells Entity) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry StructureCells Entity
 -> Const
      (FoundRegistry StructureCells Entity)
      (FoundRegistry StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Const
     (FoundRegistry StructureCells Entity)
     (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(FoundRegistry b a -> f (FoundRegistry b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
foundStructures
  occurrenceCountSuffix :: Widget n
occurrenceCountSuffix = case Text
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
-> Maybe
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
theName (Map
   Text
   (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
 -> Maybe
      (NEMap
         (Cosmic Location) (StructureWithGrid StructureCells Entity)))
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
-> Maybe
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
forall a b. (a -> b) -> a -> b
$ FoundRegistry StructureCells Entity
-> Map
     Text
     (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
forall b a.
FoundRegistry b a
-> Map Text (NEMap (Cosmic Location) (StructureWithGrid b a))
foundByName FoundRegistry StructureCells Entity
registry of
    Maybe
  (NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity))
Nothing -> Widget n
forall {n}. Widget n
emptyWidget
    Just NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity)
inner -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) (Widget n -> Widget n) -> (Int -> Widget n) -> Int -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Widget n
forall {n}. Text -> Text -> Widget n
headerItem Text
"Count" (Text -> Widget n) -> (Int -> Text) -> Int -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Widget n) -> Int -> Widget n
forall a b. (a -> b) -> a -> b
$ NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity)
-> Int
forall k a. NEMap k a -> Int
NEM.size NEMap (Cosmic Location) (StructureWithGrid StructureCells Entity)
inner

  structureIllustration :: Widget n
structureIllustration = [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
$ ([AtomicKeySymbol Entity] -> Widget n)
-> [[AtomicKeySymbol Entity]] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map ([Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n)
-> ([AtomicKeySymbol Entity] -> [Widget n])
-> [AtomicKeySymbol Entity]
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AtomicKeySymbol Entity -> Widget n)
-> [AtomicKeySymbol Entity] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map AtomicKeySymbol Entity -> Widget n
forall {n}. AtomicKeySymbol Entity -> Widget n
renderOneCell) [[AtomicKeySymbol Entity]]
cells
  d :: StructureCells
d = SymmetryAnnotatedGrid StructureCells -> StructureCells
forall a. SymmetryAnnotatedGrid a -> a
namedGrid (SymmetryAnnotatedGrid StructureCells -> StructureCells)
-> SymmetryAnnotatedGrid StructureCells -> StructureCells
forall a b. (a -> b) -> a -> b
$ StructureInfo StructureCells Entity
-> SymmetryAnnotatedGrid StructureCells
forall b a. StructureInfo b a -> SymmetryAnnotatedGrid b
annotatedGrid StructureInfo StructureCells Entity
s

  ingredientsBox :: Widget n
ingredientsBox =
    [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
      [ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"Materials:"
      , Widget n
forall {n}. Widget n
ingredientLines
      ]
  ingredientLines :: Widget n
ingredientLines = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> (Map Entity Int -> [Widget n]) -> Map Entity Int -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Entity, Int) -> Widget n) -> [(Entity, Int)] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Entity, Int) -> Widget n
forall {a} {n}. Show a => (Entity, a) -> Widget n
showCount ([(Entity, Int)] -> [Widget n])
-> (Map Entity Int -> [(Entity, Int)])
-> Map Entity Int
-> [Widget n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Entity Int -> [(Entity, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Entity Int -> Widget n) -> Map Entity Int -> Widget n
forall a b. (a -> b) -> a -> b
$ StructureInfo StructureCells Entity -> Map Entity Int
forall b a. StructureInfo b a -> Map a Int
entityCounts StructureInfo StructureCells Entity
s

  showCount :: (Entity, a) -> Widget n
showCount (Entity
e, a
c) =
    [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox
      [ Entity -> Widget n
forall n. Entity -> Widget n
drawLabelledEntityName Entity
e
      , Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
          [Text] -> Text
T.unwords
            [ Text
":"
            , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
c
            ]
      ]

  theName :: Text
theName = StructureName -> Text
getStructureName (StructureName -> Text) -> StructureName -> Text
forall a b. (a -> b) -> a -> b
$ StructureCells -> StructureName
forall a. NamedArea a -> StructureName
Structure.name StructureCells
d
  cells :: [[AtomicKeySymbol Entity]]
cells = StructureCells -> [[AtomicKeySymbol Entity]]
getEntityGrid StructureCells
d
  renderOneCell :: AtomicKeySymbol Entity -> Widget n
renderOneCell = Widget n
-> (Entity -> Widget n) -> AtomicKeySymbol Entity -> Widget n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Widget n
forall n. Text -> Widget n
txt Text
" ") (Display -> Widget n
forall n. Display -> Widget n
renderDisplay (Display -> Widget n) -> (Entity -> Display) -> Entity -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Display Entity Display -> Entity -> Display
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Display Entity Display
Lens' Entity Display
entityDisplay)

makeListWidget :: [StructureInfo StructureCells Entity] -> BL.List Name (StructureInfo StructureCells Entity)
makeListWidget :: [StructureInfo StructureCells Entity]
-> List Name (StructureInfo StructureCells Entity)
makeListWidget [StructureInfo StructureCells Entity]
structureDefinitions =
  Int
-> List Name (StructureInfo StructureCells Entity)
-> List Name (StructureInfo StructureCells Entity)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
0 (List Name (StructureInfo StructureCells Entity)
 -> List Name (StructureInfo StructureCells Entity))
-> List Name (StructureInfo StructureCells Entity)
-> List Name (StructureInfo StructureCells Entity)
forall a b. (a -> b) -> a -> b
$ Name
-> Vector (StructureInfo StructureCells Entity)
-> Int
-> List Name (StructureInfo StructureCells Entity)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list (StructureWidget -> Name
StructureWidgets StructureWidget
StructuresList) ([StructureInfo StructureCells Entity]
-> Vector (StructureInfo StructureCells Entity)
forall a. [a] -> Vector a
V.fromList [StructureInfo StructureCells Entity]
structureDefinitions) Int
1

renderStructuresDisplay :: GameState -> StructureDisplay -> Widget Name
renderStructuresDisplay :: GameState -> StructureDisplay -> Widget Name
renderStructuresDisplay GameState
gs StructureDisplay
structureDisplay =
  [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
    [ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
        [ Widget Name
leftSide
        , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) Widget Name
structureElaboration
        ]
    , Widget Name
forall {n}. Widget n
footer
    ]
 where
  footer :: Widget n
footer = Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
italicAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"NOTE: [Tab] toggles focus between panes"
  lw :: List Name (StructureInfo StructureCells Entity)
lw = StructureDisplay -> List Name (StructureInfo StructureCells Entity)
_structurePanelListWidget StructureDisplay
structureDisplay
  fr :: FocusRing Name
fr = StructureDisplay -> FocusRing Name
_structurePanelFocus StructureDisplay
structureDisplay
  leftSide :: Widget Name
leftSide =
    Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
25 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
      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 -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr 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
"Candidates"
          , 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
$
              Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
10 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                FocusRing Name
-> (Bool
    -> List Name (StructureInfo StructureCells Entity) -> Widget Name)
-> List Name (StructureInfo StructureCells Entity)
-> Widget Name
forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
withFocusRing FocusRing Name
fr ((Bool -> StructureInfo StructureCells Entity -> Widget Name)
-> Bool
-> List Name (StructureInfo StructureCells Entity)
-> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
BL.renderList Bool -> StructureInfo StructureCells Entity -> Widget Name
drawSidebarListItem) List Name (StructureInfo StructureCells Entity)
lw
          ]

  -- Adds very subtle coloring to indicate focus switch
  highlightIfFocused :: Widget n -> Widget n
highlightIfFocused = case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fr of
    Just (StructureWidgets StructureWidget
StructureSummary) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
lightCyanAttr
    Maybe Name
_ -> Widget n -> Widget n
forall a. a -> a
id

  -- Note: An extra "padRight" is inserted to account for the vertical scrollbar,
  -- whether or not it appears.
  structureElaboration :: Widget Name
structureElaboration =
    Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (StructureWidget -> Name
StructureWidgets StructureWidget
StructureSummary)
      (Widget Name -> Widget Name)
-> (Maybe (Int, StructureInfo StructureCells Entity)
    -> Widget Name)
-> Maybe (Int, StructureInfo StructureCells Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Widget Name -> Widget Name
forall n. (Ord n, Show n) => n -> Widget n -> Widget n
maybeScroll Name
ModalViewport
      (Widget Name -> Widget Name)
-> (Maybe (Int, StructureInfo StructureCells Entity)
    -> Widget Name)
-> Maybe (Int, StructureInfo StructureCells Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name
-> ((Int, StructureInfo StructureCells Entity) -> Widget Name)
-> Maybe (Int, StructureInfo StructureCells Entity)
-> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall {n}. Widget n
emptyWidget (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Name -> Widget Name)
-> ((Int, StructureInfo StructureCells Entity) -> Widget Name)
-> (Int, StructureInfo StructureCells Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name)
-> ((Int, StructureInfo StructureCells Entity) -> Widget Name)
-> (Int, StructureInfo StructureCells Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall n. Widget n -> Widget n
highlightIfFocused (Widget Name -> Widget Name)
-> ((Int, StructureInfo StructureCells Entity) -> Widget Name)
-> (Int, StructureInfo StructureCells Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameState -> StructureInfo StructureCells Entity -> Widget Name
forall n.
GameState -> StructureInfo StructureCells Entity -> Widget n
structureWidget GameState
gs (StructureInfo StructureCells Entity -> Widget Name)
-> ((Int, StructureInfo StructureCells Entity)
    -> StructureInfo StructureCells Entity)
-> (Int, StructureInfo StructureCells Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, StructureInfo StructureCells Entity)
-> StructureInfo StructureCells Entity
forall a b. (a, b) -> b
snd)
      (Maybe (Int, StructureInfo StructureCells Entity) -> Widget Name)
-> Maybe (Int, StructureInfo StructureCells Entity) -> Widget Name
forall a b. (a -> b) -> a -> b
$ List Name (StructureInfo StructureCells Entity)
-> Maybe (Int, StructureInfo StructureCells Entity)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name (StructureInfo StructureCells Entity)
lw

drawSidebarListItem ::
  Bool ->
  StructureInfo StructureCells Entity ->
  Widget Name
drawSidebarListItem :: Bool -> StructureInfo StructureCells Entity -> Widget Name
drawSidebarListItem Bool
_isSelected (StructureInfo SymmetryAnnotatedGrid StructureCells
annotated [[AtomicKeySymbol Entity]]
_ Map Entity Int
_) =
  Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name)
-> (StructureCells -> Text) -> StructureCells -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureName -> Text
getStructureName (StructureName -> Text)
-> (StructureCells -> StructureName) -> StructureCells -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureCells -> StructureName
forall a. NamedArea a -> StructureName
Structure.name (StructureCells -> Widget Name) -> StructureCells -> Widget Name
forall a b. (a -> b) -> a -> b
$ SymmetryAnnotatedGrid StructureCells -> StructureCells
forall a. SymmetryAnnotatedGrid a -> a
namedGrid SymmetryAnnotatedGrid StructureCells
annotated