{-# LANGUAGE OverloadedStrings #-}

-- Display logic for Objectives.
module Swarm.Game.Scenario.Objective.Presentation.Render where

import Brick hiding (Direction, Location)
import Brick.Focus
import Brick.Widgets.Center
import Brick.Widgets.List qualified as BL
import Control.Applicative ((<|>))
import Control.Lens hiding (Const, from)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as M
import Data.Maybe (listToMaybe)
import Data.Vector qualified as V
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Objective.Presentation.Model
import Swarm.TUI.Attr
import Swarm.TUI.Model.Name
import Swarm.TUI.View.Util

makeListWidget :: GoalTracking -> BL.List Name GoalEntry
makeListWidget :: GoalTracking -> List Name GoalEntry
makeListWidget (GoalTracking [Announcement]
_announcements CategorizedGoals
categorizedObjs) =
  forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
1 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list (GoalWidget -> Name
GoalWidgets GoalWidget
ObjectivesList) (forall a. [a] -> Vector a
V.fromList [GoalEntry]
objList) Int
1
 where
  objList :: [GoalEntry]
objList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GoalStatus, NonEmpty Objective) -> [GoalEntry]
f forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList CategorizedGoals
categorizedObjs
  f :: (GoalStatus, NonEmpty Objective) -> [GoalEntry]
f (GoalStatus
h, NonEmpty Objective
xs) = GoalStatus -> GoalEntry
Header GoalStatus
h forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (GoalStatus -> Objective -> GoalEntry
Goal GoalStatus
h) (forall a. NonEmpty a -> [a]
NE.toList NonEmpty Objective
xs)

renderGoalsDisplay :: GoalDisplay -> Widget Name
renderGoalsDisplay :: GoalDisplay -> Widget Name
renderGoalsDisplay GoalDisplay
gd =
  if Bool
hasMultiple
    then
      forall n. [Widget n] -> Widget n
hBox
        [ Widget Name
leftSide
        , forall n. Int -> Widget n -> Widget n
hLimitPercent Int
70 forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) Widget Name
goalElaboration
        ]
    else Widget Name
goalElaboration
 where
  hasMultiple :: Bool
hasMultiple = GoalTracking -> Bool
hasMultipleGoals forall a b. (a -> b) -> a -> b
$ GoalDisplay
gd forall s a. s -> Getting a s a -> a
^. Lens' GoalDisplay GoalTracking
goalsContent
  lw :: List Name GoalEntry
lw = GoalDisplay -> List Name GoalEntry
_listWidget GoalDisplay
gd
  fr :: FocusRing Name
fr = GoalDisplay -> FocusRing Name
_focus GoalDisplay
gd
  leftSide :: Widget Name
leftSide =
    forall n. Int -> Widget n -> Widget n
hLimitPercent Int
30 forall a b. (a -> b) -> a -> b
$
      forall n. Int -> Widget n -> Widget n
padAll Int
1 forall a b. (a -> b) -> a -> b
$
        forall n. [Widget n] -> Widget n
vBox
          [ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Goals"
          , forall n. Int -> Widget n -> Widget n
padAll Int
1 forall a b. (a -> b) -> a -> b
$
              forall n. Int -> Widget n -> Widget n
vLimit Int
10 forall a b. (a -> b) -> a -> b
$
                forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
withFocusRing FocusRing Name
fr (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 -> GoalEntry -> Widget Name
drawGoalListItem) List Name GoalEntry
lw
          ]

  -- Adds very subtle coloring to indicate focus switch
  highlightIfFocused :: Widget n -> Widget n
highlightIfFocused = case (Bool
hasMultiple, forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fr) of
    (Bool
True, Just (GoalWidgets GoalWidget
GoalSummary)) -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
lightCyanAttr
    (Bool, Maybe Name)
_ -> forall a. a -> a
id

  -- Note: An extra "padRight" is inserted to account for the vertical scrollbar,
  -- whether or not it appears.
  goalElaboration :: Widget Name
goalElaboration =
    forall n. Ord n => n -> Widget n -> Widget n
clickable (GoalWidget -> Name
GoalWidgets GoalWidget
GoalSummary) forall a b. (a -> b) -> a -> b
$
      forall n. (Ord n, Show n) => n -> Widget n -> Widget n
maybeScroll Name
ModalViewport forall a b. (a -> b) -> a -> b
$
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n. Widget n
emptyWidget (forall n. Int -> Widget n -> Widget n
padAll Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n
highlightIfFocused forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoalEntry -> Widget Name
singleGoalDetails forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name GoalEntry
lw

getCompletionIcon :: Objective -> GoalStatus -> Widget Name
getCompletionIcon :: Objective -> GoalStatus -> Widget Name
getCompletionIcon Objective
obj = \case
  GoalStatus
Upcoming -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ○  "
  GoalStatus
Active -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ○  "
  GoalStatus
Failed -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ●  "
  GoalStatus
Completed -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
colorAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
" ●  "
   where
    colorAttr :: AttrName
colorAttr =
      if Objective
obj forall s a. s -> Getting a s a -> a
^. Lens' Objective Bool
objectiveHidden
        then AttrName
magentaAttr
        else AttrName
greenAttr

drawGoalListItem ::
  Bool ->
  GoalEntry ->
  Widget Name
drawGoalListItem :: Bool -> GoalEntry -> Widget Name
drawGoalListItem Bool
_isSelected GoalEntry
e = case GoalEntry
e of
  Header GoalStatus
gs -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show GoalStatus
gs
  Goal GoalStatus
gs Objective
obj -> Objective -> GoalStatus -> Widget Name
getCompletionIcon Objective
obj GoalStatus
gs forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
titleWidget
   where
    textSource :: Maybe Text
textSource = Objective
obj forall s a. s -> Getting a s a -> a
^. Lens' Objective (Maybe Text)
objectiveTeaser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Objective
obj forall s a. s -> Getting a s a -> a
^. Lens' Objective (Maybe Text)
objectiveId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [a] -> Maybe a
listToMaybe (Objective
obj forall s a. s -> Getting a s a -> a
^. Lens' Objective [Text]
objectiveGoal)
    titleWidget :: Widget Name
titleWidget = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall n. Text -> Widget n
txt Text
"?") Text -> Widget Name
withEllipsis Maybe Text
textSource

singleGoalDetails :: GoalEntry -> Widget Name
singleGoalDetails :: GoalEntry -> Widget Name
singleGoalDetails = \case
  Header GoalStatus
_gs -> [Text] -> Widget Name
displayParagraphs [Text
" "]
  Goal GoalStatus
_gs Objective
obj -> [Text] -> Widget Name
displayParagraphs forall a b. (a -> b) -> a -> b
$ Objective
obj forall s a. s -> Getting a s a -> a
^. Lens' Objective [Text]
objectiveGoal