{-# LANGUAGE OverloadedStrings #-}
module Swarm.TUI.View.Achievement where
import Brick
import Brick.Widgets.Border (borderWithLabel)
import Brick.Widgets.Center (hCenter)
import Brick.Widgets.List qualified as BL
import Control.Lens ((^.))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Time.Format (defaultTimeLocale, formatTime)
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Achievement.Description
import Swarm.TUI.Model
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.Util (drawMarkdown)
import Text.Wrap
padAllEvenly :: Int -> Widget Name -> Widget Name
padAllEvenly :: Int -> Widget Name -> Widget Name
padAllEvenly Int
x Widget Name
w = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTopBottom Int
x (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
padLeftRight (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x) Widget Name
w
getCompletionIcon :: Bool -> Widget Name
getCompletionIcon :: Bool -> Widget Name
getCompletionIcon = \case
Bool
False -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
" ○ "
Bool
True -> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
greenAttr (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
" ● "
drawAchievementsMenuUI :: AppState -> BL.List Name CategorizedAchievement -> Widget Name
AppState
s List Name CategorizedAchievement
l =
[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
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTopBottom Int
1 (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
"🏆 Achievements 🏆 "
, 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
$
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
[ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
30
(Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
2
(Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Bool -> CategorizedAchievement -> Widget Name)
-> Bool -> List Name CategorizedAchievement -> 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 ((CategorizedAchievement -> Widget Name)
-> Bool -> CategorizedAchievement -> Widget Name
forall a b. a -> b -> a
const ((CategorizedAchievement -> Widget Name)
-> Bool -> CategorizedAchievement -> Widget Name)
-> (CategorizedAchievement -> Widget Name)
-> Bool
-> CategorizedAchievement
-> Widget Name
forall a b. (a -> b) -> a -> b
$ Map CategorizedAchievement Attainment
-> CategorizedAchievement -> Widget Name
drawAchievementListItem Map CategorizedAchievement Attainment
attainedMap) Bool
True List Name CategorizedAchievement
l
, Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
50
(Widget Name -> Widget Name)
-> (Maybe (Int, CategorizedAchievement) -> Widget Name)
-> Maybe (Int, CategorizedAchievement)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name
-> ((Int, CategorizedAchievement) -> Widget Name)
-> Maybe (Int, CategorizedAchievement)
-> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall n. Widget n
emptyWidget (Map CategorizedAchievement Attainment
-> CategorizedAchievement -> Widget Name
singleAchievementDetails Map CategorizedAchievement Attainment
attainedMap (CategorizedAchievement -> Widget Name)
-> ((Int, CategorizedAchievement) -> CategorizedAchievement)
-> (Int, CategorizedAchievement)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, CategorizedAchievement) -> CategorizedAchievement
forall a b. (a, b) -> b
snd)
(Maybe (Int, CategorizedAchievement) -> Widget Name)
-> Maybe (Int, CategorizedAchievement) -> Widget Name
forall a b. (a -> b) -> a -> b
$ List Name CategorizedAchievement
-> Maybe (Int, CategorizedAchievement)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name CategorizedAchievement
l
]
]
where
attainedMap :: Map CategorizedAchievement Attainment
attainedMap = AppState
s AppState
-> Getting
(Map CategorizedAchievement Attainment)
AppState
(Map CategorizedAchievement Attainment)
-> Map CategorizedAchievement Attainment
forall s a. s -> Getting a s a -> a
^. (PlayState
-> Const (Map CategorizedAchievement Attainment) PlayState)
-> AppState
-> Const (Map CategorizedAchievement Attainment) AppState
Lens' AppState PlayState
playState ((PlayState
-> Const (Map CategorizedAchievement Attainment) PlayState)
-> AppState
-> Const (Map CategorizedAchievement Attainment) AppState)
-> ((Map CategorizedAchievement Attainment
-> Const
(Map CategorizedAchievement Attainment)
(Map CategorizedAchievement Attainment))
-> PlayState
-> Const (Map CategorizedAchievement Attainment) PlayState)
-> Getting
(Map CategorizedAchievement Attainment)
AppState
(Map CategorizedAchievement Attainment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
-> Const (Map CategorizedAchievement Attainment) ProgressionState)
-> PlayState
-> Const (Map CategorizedAchievement Attainment) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
-> Const (Map CategorizedAchievement Attainment) ProgressionState)
-> PlayState
-> Const (Map CategorizedAchievement Attainment) PlayState)
-> ((Map CategorizedAchievement Attainment
-> Const
(Map CategorizedAchievement Attainment)
(Map CategorizedAchievement Attainment))
-> ProgressionState
-> Const (Map CategorizedAchievement Attainment) ProgressionState)
-> (Map CategorizedAchievement Attainment
-> Const
(Map CategorizedAchievement Attainment)
(Map CategorizedAchievement Attainment))
-> PlayState
-> Const (Map CategorizedAchievement Attainment) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map CategorizedAchievement Attainment
-> Const
(Map CategorizedAchievement Attainment)
(Map CategorizedAchievement Attainment))
-> ProgressionState
-> Const (Map CategorizedAchievement Attainment) ProgressionState
Lens' ProgressionState (Map CategorizedAchievement Attainment)
attainedAchievements
drawAchievementListItem ::
Map CategorizedAchievement Attainment ->
CategorizedAchievement ->
Widget Name
drawAchievementListItem :: Map CategorizedAchievement Attainment
-> CategorizedAchievement -> Widget Name
drawAchievementListItem Map CategorizedAchievement Attainment
attainedMap CategorizedAchievement
x =
Bool -> Widget Name
getCompletionIcon Bool
wasAttained Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall n. Widget n
titleWidget
where
wasAttained :: Bool
wasAttained = CategorizedAchievement
-> Map CategorizedAchievement Attainment -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member CategorizedAchievement
x Map CategorizedAchievement Attainment
attainedMap
titleWidget :: Widget n
titleWidget = Text -> Widget n
forall n. Text -> Widget n
txtWrap (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ AchievementInfo -> Text
title AchievementInfo
details
details :: AchievementInfo
details = CategorizedAchievement -> AchievementInfo
describe CategorizedAchievement
x
singleAchievementDetails ::
Map CategorizedAchievement Attainment ->
CategorizedAchievement ->
Widget Name
singleAchievementDetails :: Map CategorizedAchievement Attainment
-> CategorizedAchievement -> Widget Name
singleAchievementDetails Map CategorizedAchievement Attainment
attainedMap CategorizedAchievement
x =
Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
forall n. Widget n
titleWidget (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> 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 Padding
Max (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
padAllEvenly Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name
innerContent
where
wasAttained :: Bool
wasAttained = CategorizedAchievement
-> Map CategorizedAchievement Attainment -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member CategorizedAchievement
x Map CategorizedAchievement Attainment
attainedMap
renderFlavorTextWidget :: FlavorText -> Widget Name
renderFlavorTextWidget :: FlavorText -> Widget Name
renderFlavorTextWidget (Freeform Document Syntax
t) = Document Syntax -> Widget Name
drawMarkdown Document Syntax
t
renderFlavorTextWidget (FTQuotation (Quotation Text
author Text
quoteContent)) =
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ Text -> Widget Name
forall n. Text -> Widget n
txtWrap Text
quoteContent
, Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max
(Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> 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
2)
(Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapSettings -> Text -> Widget Name
forall n. WrapSettings -> Text -> Widget n
txtWrapWith (WrapSettings
defaultWrapSettings {fillStrategy = FillIndent 2})
(Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
author
]
innerContent :: Widget Name
innerContent =
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
[ Widget Name
-> (FlavorText -> Widget Name) -> Maybe FlavorText -> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall n. Widget n
emptyWidget (Int -> Widget Name -> Widget Name
padAllEvenly Int
2 (Widget Name -> Widget Name)
-> (FlavorText -> Widget Name) -> FlavorText -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlavorText -> Widget Name
renderFlavorTextWidget) (Maybe FlavorText -> Widget Name)
-> Maybe FlavorText -> Widget Name
forall a b. (a -> b) -> a -> b
$ AchievementInfo -> Maybe FlavorText
humorousElaboration AchievementInfo
details
, if Bool
wasAttained Bool -> Bool -> Bool
|| Bool -> Bool
not (AchievementInfo -> Bool
isObfuscated AchievementInfo
details)
then Document Syntax -> Widget Name
drawMarkdown (Document Syntax -> Widget Name) -> Document Syntax -> Widget Name
forall a b. (a -> b) -> a -> b
$ AchievementInfo -> Document Syntax
attainmentProcess AchievementInfo
details
else Text -> Widget Name
forall n. Text -> Widget n
txt Text
"???"
, case CategorizedAchievement
-> Map CategorizedAchievement Attainment -> Maybe Attainment
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CategorizedAchievement
x Map CategorizedAchievement Attainment
attainedMap of
Maybe Attainment
Nothing -> Widget Name
forall n. Widget n
emptyWidget
Just Attainment
attainment ->
Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad 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
hBox
[ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Obtained: "
, AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr
(Widget Name -> Widget Name)
-> (ZonedTime -> Widget Name) -> ZonedTime -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget Name
forall n. String -> Widget n
str
(String -> Widget Name)
-> (ZonedTime -> String) -> ZonedTime -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%l:%M%P on %b %e, %Y"
(ZonedTime -> Widget Name) -> ZonedTime -> Widget Name
forall a b. (a -> b) -> a -> b
$ Attainment
attainment Attainment -> Getting ZonedTime Attainment ZonedTime -> ZonedTime
forall s a. s -> Getting a s a -> a
^. Getting ZonedTime Attainment ZonedTime
Lens' Attainment ZonedTime
obtainedAt
]
, ((String -> Widget Name) -> Maybe String -> Widget Name)
-> Maybe String -> (String -> Widget Name) -> Widget Name
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Widget Name
-> (String -> Widget Name) -> Maybe String -> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall n. Widget n
emptyWidget) (Attainment
attainment Attainment
-> Getting (Maybe String) Attainment (Maybe String) -> Maybe String
forall s a. s -> Getting a s a -> a
^. Getting (Maybe String) Attainment (Maybe String)
Lens' Attainment (Maybe String)
maybeScenarioPath) ((String -> Widget Name) -> Widget Name)
-> (String -> Widget Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ \String
s ->
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
[ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Scenario: "
, AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr (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
s
]
]
, Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad 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
hBox
[ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Effort: "
, AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Widget Name -> Widget Name)
-> (ExpectedEffort -> Widget Name) -> ExpectedEffort -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name)
-> (ExpectedEffort -> String) -> ExpectedEffort -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpectedEffort -> String
forall a. Show a => a -> String
show (ExpectedEffort -> Widget Name) -> ExpectedEffort -> Widget Name
forall a b. (a -> b) -> a -> b
$ AchievementInfo -> ExpectedEffort
effort AchievementInfo
details
]
]
titleWidget :: Widget n
titleWidget = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight 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
$ AchievementInfo -> Text
title AchievementInfo
details
details :: AchievementInfo
details = CategorizedAchievement -> AchievementInfo
describe CategorizedAchievement
x