{-# 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.Topography.Area
import Swarm.Game.Scenario.Topography.Grid
import Swarm.Game.Scenario.Topography.Structure.Named qualified as Structure
import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByName)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Static
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.Dialog.Structure
import Swarm.TUI.Model.Name
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.CellDisplay
import Swarm.TUI.View.Shared (tabControlFooter)
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 b Entity -> Widget n
structureWidget :: forall b n. GameState -> StructureInfo b Entity -> Widget n
structureWidget GameState
gs StructureInfo b 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 -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ StructureName -> Text
Structure.getStructureName StructureName
theName
        , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2)
            (Widget n -> Widget n)
-> (NonEmptyGrid (AtomicKeySymbol Entity) -> Widget n)
-> NonEmptyGrid (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)
-> (NonEmptyGrid (AtomicKeySymbol Entity) -> Text)
-> NonEmptyGrid (AtomicKeySymbol Entity)
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
            (String -> Text)
-> (NonEmptyGrid (AtomicKeySymbol Entity) -> String)
-> NonEmptyGrid (AtomicKeySymbol Entity)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AreaDimensions -> String
renderRectDimensions
            (AreaDimensions -> String)
-> (NonEmptyGrid (AtomicKeySymbol Entity) -> AreaDimensions)
-> NonEmptyGrid (AtomicKeySymbol Entity)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyGrid (AtomicKeySymbol Entity) -> AreaDimensions
forall a. NonEmptyGrid a -> AreaDimensions
getNEGridDimensions
            (NonEmptyGrid (AtomicKeySymbol Entity) -> Widget n)
-> NonEmptyGrid (AtomicKeySymbol Entity) -> Widget n
forall a b. (a -> b) -> a -> b
$ StructureInfo b Entity -> NonEmptyGrid (AtomicKeySymbol Entity)
forall b a. StructureInfo b a -> NonEmptyGrid (AtomicKeySymbol a)
entityProcessedGrid StructureInfo b 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 (ExtractedArea b Entity)
annotatedStructureGrid = StructureInfo b Entity
-> SymmetryAnnotatedGrid (ExtractedArea b Entity)
forall b a.
StructureInfo b a -> SymmetryAnnotatedGrid (ExtractedArea b a)
annotatedGrid StructureInfo b Entity
s
  theNamedGrid :: NamedArea b
theNamedGrid = ExtractedArea b Entity -> NamedArea b
forall b a. ExtractedArea b a -> NamedArea b
originalItem (ExtractedArea b Entity -> NamedArea b)
-> ExtractedArea b Entity -> NamedArea b
forall a b. (a -> b) -> a -> b
$ SymmetryAnnotatedGrid (ExtractedArea b Entity)
-> ExtractedArea b Entity
forall a. SymmetryAnnotatedGrid a -> a
grid SymmetryAnnotatedGrid (ExtractedArea b Entity)
annotatedStructureGrid
  supportedOrientations :: [AbsoluteDir]
supportedOrientations = Set AbsoluteDir -> [AbsoluteDir]
forall a. Set a -> [a]
Set.toList (Set AbsoluteDir -> [AbsoluteDir])
-> (NamedArea b -> Set AbsoluteDir) -> NamedArea b -> [AbsoluteDir]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArea b -> Set AbsoluteDir
forall a. NamedArea a -> Set AbsoluteDir
Structure.recognize (NamedArea b -> [AbsoluteDir]) -> NamedArea b -> [AbsoluteDir]
forall a b. (a -> b) -> a -> b
$ NamedArea b
theNamedGrid

  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 (ExtractedArea b Entity)
-> RotationalSymmetry
forall a. SymmetryAnnotatedGrid a -> RotationalSymmetry
symmetry SymmetryAnnotatedGrid (ExtractedArea b Entity)
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
$
      NamedArea b -> Maybe Text
forall a. NamedArea a -> Maybe Text
Structure.description NamedArea b
theNamedGrid

  registry :: FoundRegistry RecognizableStructureContent Entity
registry = GameState
gs GameState
-> Getting
     (FoundRegistry RecognizableStructureContent Entity)
     GameState
     (FoundRegistry RecognizableStructureContent Entity)
-> FoundRegistry RecognizableStructureContent Entity
forall s a. s -> Getting a s a -> a
^. (Discovery
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> GameState
-> Const
     (FoundRegistry RecognizableStructureContent Entity) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const
       (FoundRegistry RecognizableStructureContent Entity) Discovery)
 -> GameState
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) GameState)
-> ((FoundRegistry RecognizableStructureContent Entity
     -> Const
          (FoundRegistry RecognizableStructureContent Entity)
          (FoundRegistry RecognizableStructureContent Entity))
    -> Discovery
    -> Const
         (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> Getting
     (FoundRegistry RecognizableStructureContent Entity)
     GameState
     (FoundRegistry RecognizableStructureContent Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognitionState RecognizableStructureContent Entity
 -> Const
      (FoundRegistry RecognizableStructureContent Entity)
      (RecognitionState RecognizableStructureContent Entity))
-> Discovery
-> Const
     (FoundRegistry RecognizableStructureContent Entity) Discovery
Lens'
  Discovery (RecognitionState RecognizableStructureContent Entity)
structureRecognition ((RecognitionState RecognizableStructureContent Entity
  -> Const
       (FoundRegistry RecognizableStructureContent Entity)
       (RecognitionState RecognizableStructureContent Entity))
 -> Discovery
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> ((FoundRegistry RecognizableStructureContent Entity
     -> Const
          (FoundRegistry RecognizableStructureContent Entity)
          (FoundRegistry RecognizableStructureContent Entity))
    -> RecognitionState RecognizableStructureContent Entity
    -> Const
         (FoundRegistry RecognizableStructureContent Entity)
         (RecognitionState RecognizableStructureContent Entity))
-> (FoundRegistry RecognizableStructureContent Entity
    -> Const
         (FoundRegistry RecognizableStructureContent Entity)
         (FoundRegistry RecognizableStructureContent Entity))
-> Discovery
-> Const
     (FoundRegistry RecognizableStructureContent Entity) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry RecognizableStructureContent Entity
 -> Const
      (FoundRegistry RecognizableStructureContent Entity)
      (FoundRegistry RecognizableStructureContent Entity))
-> RecognitionState RecognizableStructureContent Entity
-> Const
     (FoundRegistry RecognizableStructureContent Entity)
     (RecognitionState RecognizableStructureContent Entity)
forall b1 a b2 (f :: * -> *).
Functor f =>
(FoundRegistry b1 a -> f (FoundRegistry b2 a))
-> RecognitionState b1 a -> f (RecognitionState b2 a)
foundStructures
  occurrenceCountSuffix :: Widget n
occurrenceCountSuffix = case StructureName
-> Map
     StructureName
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
-> Maybe
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup StructureName
theName (Map
   StructureName
   (NEMap
      (Cosmic Location, AbsoluteDir)
      (StructureWithGrid RecognizableStructureContent Entity))
 -> Maybe
      (NEMap
         (Cosmic Location, AbsoluteDir)
         (StructureWithGrid RecognizableStructureContent Entity)))
-> Map
     StructureName
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
-> Maybe
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
forall a b. (a -> b) -> a -> b
$ FoundRegistry RecognizableStructureContent Entity
-> Map
     StructureName
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
forall b a.
FoundRegistry b a
-> Map
     StructureName
     (NEMap (Cosmic Location, AbsoluteDir) (StructureWithGrid b a))
foundByName FoundRegistry RecognizableStructureContent Entity
registry of
    Maybe
  (NEMap
     (Cosmic Location, AbsoluteDir)
     (StructureWithGrid RecognizableStructureContent Entity))
Nothing -> Widget n
forall {n}. Widget n
emptyWidget
    Just NEMap
  (Cosmic Location, AbsoluteDir)
  (StructureWithGrid RecognizableStructureContent 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, AbsoluteDir)
  (StructureWithGrid RecognizableStructureContent Entity)
-> Int
forall k a. NEMap k a -> Int
NEM.size NEMap
  (Cosmic Location, AbsoluteDir)
  (StructureWithGrid RecognizableStructureContent 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

  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 b Entity -> Map Entity Int
forall b a. StructureInfo b a -> Map a Int
entityCounts StructureInfo b 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 :: StructureName
theName = NamedArea b -> StructureName
forall a. NamedArea a -> StructureName
Structure.name NamedArea b
theNamedGrid
  cells :: [[AtomicKeySymbol Entity]]
cells = Grid (AtomicKeySymbol Entity) -> [[AtomicKeySymbol Entity]]
forall a. Grid a -> [[a]]
getRows (Grid (AtomicKeySymbol Entity) -> [[AtomicKeySymbol Entity]])
-> Grid (AtomicKeySymbol Entity) -> [[AtomicKeySymbol Entity]]
forall a b. (a -> b) -> a -> b
$ NonEmptyGrid (AtomicKeySymbol Entity)
-> Grid (AtomicKeySymbol Entity)
forall c. NonEmptyGrid c -> Grid c
Grid (NonEmptyGrid (AtomicKeySymbol Entity)
 -> Grid (AtomicKeySymbol Entity))
-> NonEmptyGrid (AtomicKeySymbol Entity)
-> Grid (AtomicKeySymbol Entity)
forall a b. (a -> b) -> a -> b
$ StructureInfo b Entity -> NonEmptyGrid (AtomicKeySymbol Entity)
forall b a. StructureInfo b a -> NonEmptyGrid (AtomicKeySymbol a)
entityProcessedGrid StructureInfo b Entity
s

  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 b a] -> BL.List Name (StructureInfo b a)
makeListWidget :: forall b a. [StructureInfo b a] -> List Name (StructureInfo b a)
makeListWidget [StructureInfo b a]
structureDefinitions =
  Int
-> GenericList Name Vector (StructureInfo b a)
-> GenericList Name Vector (StructureInfo b a)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
0 (GenericList Name Vector (StructureInfo b a)
 -> GenericList Name Vector (StructureInfo b a))
-> GenericList Name Vector (StructureInfo b a)
-> GenericList Name Vector (StructureInfo b a)
forall a b. (a -> b) -> a -> b
$ Name
-> Vector (StructureInfo b a)
-> Int
-> GenericList Name Vector (StructureInfo b a)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list (StructureWidget -> Name
StructureWidgets StructureWidget
StructuresList) ([StructureInfo b a] -> Vector (StructureInfo b a)
forall a. [a] -> Vector a
V.fromList [StructureInfo b a]
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
tabControlFooter
    ]
 where
  lw :: List Name (StructureInfo RecognizableStructureContent Entity)
lw = StructureDisplay
-> List Name (StructureInfo RecognizableStructureContent 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 RecognizableStructureContent Entity)
    -> Widget Name)
-> List Name (StructureInfo RecognizableStructureContent 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 RecognizableStructureContent Entity
 -> Widget Name)
-> Bool
-> List Name (StructureInfo RecognizableStructureContent 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 RecognizableStructureContent Entity -> Widget Name
forall b a. Bool -> StructureInfo b a -> Widget Name
drawSidebarListItem) List Name (StructureInfo RecognizableStructureContent 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 RecognizableStructureContent Entity)
    -> Widget Name)
-> Maybe (Int, StructureInfo RecognizableStructureContent 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 RecognizableStructureContent Entity)
    -> Widget Name)
-> Maybe (Int, StructureInfo RecognizableStructureContent Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name
-> ((Int, StructureInfo RecognizableStructureContent Entity)
    -> Widget Name)
-> Maybe (Int, StructureInfo RecognizableStructureContent 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 RecognizableStructureContent Entity)
    -> Widget Name)
-> (Int, StructureInfo RecognizableStructureContent 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 RecognizableStructureContent Entity)
    -> Widget Name)
-> (Int, StructureInfo RecognizableStructureContent 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 RecognizableStructureContent Entity)
    -> Widget Name)
-> (Int, StructureInfo RecognizableStructureContent Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameState
-> StructureInfo RecognizableStructureContent Entity -> Widget Name
forall b n. GameState -> StructureInfo b Entity -> Widget n
structureWidget GameState
gs (StructureInfo RecognizableStructureContent Entity -> Widget Name)
-> ((Int, StructureInfo RecognizableStructureContent Entity)
    -> StructureInfo RecognizableStructureContent Entity)
-> (Int, StructureInfo RecognizableStructureContent Entity)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, StructureInfo RecognizableStructureContent Entity)
-> StructureInfo RecognizableStructureContent Entity
forall a b. (a, b) -> b
snd)
      (Maybe (Int, StructureInfo RecognizableStructureContent Entity)
 -> Widget Name)
-> Maybe (Int, StructureInfo RecognizableStructureContent Entity)
-> Widget Name
forall a b. (a -> b) -> a -> b
$ List Name (StructureInfo RecognizableStructureContent Entity)
-> Maybe (Int, StructureInfo RecognizableStructureContent Entity)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name (StructureInfo RecognizableStructureContent Entity)
lw

drawSidebarListItem ::
  Bool ->
  StructureInfo b a ->
  Widget Name
drawSidebarListItem :: forall b a. Bool -> StructureInfo b a -> Widget Name
drawSidebarListItem Bool
_isSelected (StructureInfo SymmetryAnnotatedGrid (ExtractedArea b a)
annotated NonEmptyGrid (AtomicKeySymbol a)
_ Map a Int
_) =
  Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name)
-> (NamedArea b -> Text) -> NamedArea b -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureName -> Text
Structure.getStructureName (StructureName -> Text)
-> (NamedArea b -> StructureName) -> NamedArea b -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArea b -> StructureName
forall a. NamedArea a -> StructureName
Structure.name (NamedArea b -> Widget Name) -> NamedArea b -> Widget Name
forall a b. (a -> b) -> a -> b
$ ExtractedArea b a -> NamedArea b
forall b a. ExtractedArea b a -> NamedArea b
originalItem (ExtractedArea b a -> NamedArea b)
-> ExtractedArea b a -> NamedArea b
forall a b. (a -> b) -> a -> b
$ SymmetryAnnotatedGrid (ExtractedArea b a) -> ExtractedArea b a
forall a. SymmetryAnnotatedGrid a -> a
grid SymmetryAnnotatedGrid (ExtractedArea b a)
annotated