{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Rendering (& animating) notification popups.
module Swarm.TUI.View.Popup (
  drawPopups,
  startPopupAnimation,
  popupFrameDuration,
  popupFrames,
) where

import Brick (Widget (..), cropTopTo, padLeftRight, txt, vBox)
import Brick.Animation (Animation, AnimationManager, Clip, RunMode (..), newClip, renderAnimation, startAnimation)
import Brick.Widgets.Border (border)
import Brick.Widgets.Center (hCenterLayer)
import Brick.Widgets.Core (emptyWidget, hBox, withAttr)
import Control.Lens (Traversal', (^.), (^?))
import Control.Monad.IO.Class (MonadIO)
import Swarm.Game.Achievement.Definitions (title)
import Swarm.Game.Achievement.Description (describe)
import Swarm.Game.Popup (Popup (..))
import Swarm.Language.Syntax (constInfo, syntax)
import Swarm.TUI.Model (AppEvent, AppState, animTraversal, keyConfig, keyEventHandling, playState, progression, uiPopupAnimationState, _AnimActive)
import Swarm.TUI.Model.Event qualified as SE
import Swarm.TUI.Model.Name
import Swarm.TUI.View.Attribute.Attr (notifAttr)
import Swarm.TUI.View.Util (bindingText)
import Swarm.Util (commaList, squote)

-- | The number of milliseconds taken by each animation frame of the notification popup
popupFrameDuration :: Integer
popupFrameDuration :: Integer
popupFrameDuration = Integer
50

-- | The number of animation frames for which to display a popup.
popupFrames :: Int
popupFrames :: Int
popupFrames = Int
125

-- | Draw the current notification popup (if any).
drawPopups :: AppState -> Widget Name
drawPopups :: AppState -> Widget Name
drawPopups AppState
s = (AppState -> Widget Name)
-> AppState -> Maybe (Animation AppState Name) -> Widget Name
forall s n.
(s -> Widget n) -> s -> Maybe (Animation s n) -> Widget n
renderAnimation (Widget Name -> AppState -> Widget Name
forall a b. a -> b -> a
const Widget Name
forall n. Widget n
emptyWidget) AppState
s Maybe (Animation AppState Name)
mAnim
 where
  mAnim :: Maybe (Animation AppState Name)
mAnim = AppState
s AppState
-> Getting
     (First (Animation AppState Name))
     AppState
     (Animation AppState Name)
-> Maybe (Animation AppState Name)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (PlayState -> Const (First (Animation AppState Name)) PlayState)
-> AppState -> Const (First (Animation AppState Name)) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (First (Animation AppState Name)) PlayState)
 -> AppState -> Const (First (Animation AppState Name)) AppState)
-> ((Animation AppState Name
     -> Const
          (First (Animation AppState Name)) (Animation AppState Name))
    -> PlayState -> Const (First (Animation AppState Name)) PlayState)
-> Getting
     (First (Animation AppState Name))
     AppState
     (Animation AppState Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Const (First (Animation AppState Name)) ProgressionState)
-> PlayState -> Const (First (Animation AppState Name)) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (First (Animation AppState Name)) ProgressionState)
 -> PlayState -> Const (First (Animation AppState Name)) PlayState)
-> ((Animation AppState Name
     -> Const
          (First (Animation AppState Name)) (Animation AppState Name))
    -> ProgressionState
    -> Const (First (Animation AppState Name)) ProgressionState)
-> (Animation AppState Name
    -> Const
         (First (Animation AppState Name)) (Animation AppState Name))
-> PlayState
-> Const (First (Animation AppState Name)) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnimationState
 -> Const (First (Animation AppState Name)) AnimationState)
-> ProgressionState
-> Const (First (Animation AppState Name)) ProgressionState
Lens' ProgressionState AnimationState
uiPopupAnimationState ((AnimationState
  -> Const (First (Animation AppState Name)) AnimationState)
 -> ProgressionState
 -> Const (First (Animation AppState Name)) ProgressionState)
-> ((Animation AppState Name
     -> Const
          (First (Animation AppState Name)) (Animation AppState Name))
    -> AnimationState
    -> Const (First (Animation AppState Name)) AnimationState)
-> (Animation AppState Name
    -> Const
         (First (Animation AppState Name)) (Animation AppState Name))
-> ProgressionState
-> Const (First (Animation AppState Name)) ProgressionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Animation AppState Name
 -> Const
      (First (Animation AppState Name)) (Animation AppState Name))
-> AnimationState
-> Const (First (Animation AppState Name)) AnimationState
Prism' AnimationState (Animation AppState Name)
_AnimActive

-- | Signal the animation manager to start the popup animation.
startPopupAnimation :: MonadIO m => AnimationManager AppState AppEvent Name -> Popup -> m ()
startPopupAnimation :: forall (m :: * -> *).
MonadIO m =>
AnimationManager AppState AppEvent Name -> Popup -> m ()
startPopupAnimation AnimationManager AppState AppEvent Name
mgr Popup
p = AnimationManager AppState AppEvent Name
-> Clip AppState Name
-> Integer
-> RunMode
-> Traversal' AppState (Maybe (Animation AppState Name))
-> m ()
forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n
-> Clip s n
-> Integer
-> RunMode
-> Traversal' s (Maybe (Animation s n))
-> m ()
startAnimation AnimationManager AppState AppEvent Name
mgr (Popup -> Clip AppState Name
makePopupClip Popup
p) Integer
popupFrameDuration RunMode
Once (Maybe (Animation AppState Name)
 -> f (Maybe (Animation AppState Name)))
-> AppState -> f AppState
Traversal' AppState (Maybe (Animation AppState Name))
trav
 where
  trav :: Traversal' AppState (Maybe (Animation AppState Name))
  trav :: Traversal' AppState (Maybe (Animation AppState Name))
trav = (PlayState -> f PlayState) -> AppState -> f AppState
Lens' AppState PlayState
playState ((PlayState -> f PlayState) -> AppState -> f AppState)
-> ((Maybe (Animation AppState Name)
     -> f (Maybe (Animation AppState Name)))
    -> PlayState -> f PlayState)
-> (Maybe (Animation AppState Name)
    -> f (Maybe (Animation AppState Name)))
-> AppState
-> f AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> f ProgressionState)
-> PlayState -> f PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> f ProgressionState)
 -> PlayState -> f PlayState)
-> ((Maybe (Animation AppState Name)
     -> f (Maybe (Animation AppState Name)))
    -> ProgressionState -> f ProgressionState)
-> (Maybe (Animation AppState Name)
    -> f (Maybe (Animation AppState Name)))
-> PlayState
-> f PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnimationState -> f AnimationState)
-> ProgressionState -> f ProgressionState
Lens' ProgressionState AnimationState
uiPopupAnimationState ((AnimationState -> f AnimationState)
 -> ProgressionState -> f ProgressionState)
-> ((Maybe (Animation AppState Name)
     -> f (Maybe (Animation AppState Name)))
    -> AnimationState -> f AnimationState)
-> (Maybe (Animation AppState Name)
    -> f (Maybe (Animation AppState Name)))
-> ProgressionState
-> f ProgressionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Animation AppState Name)
 -> f (Maybe (Animation AppState Name)))
-> AnimationState -> f AnimationState
Traversal' AnimationState (Maybe (Animation AppState Name))
animTraversal

makePopupClip :: Popup -> Clip AppState Name
makePopupClip :: Popup -> Clip AppState Name
makePopupClip Popup
p = [AppState -> Widget Name] -> Clip AppState Name
forall s n. [s -> Widget n] -> Clip s n
newClip ([AppState -> Widget Name] -> Clip AppState Name)
-> [AppState -> Widget Name] -> Clip AppState Name
forall a b. (a -> b) -> a -> b
$ (Int -> AppState -> Widget Name)
-> [Int] -> [AppState -> Widget Name]
forall a b. (a -> b) -> [a] -> [b]
map Int -> AppState -> Widget Name
drawPopupFrame [Int
0 .. Int
popupFrames]
 where
  drawPopupFrame :: Int -> AppState -> Widget Name
drawPopupFrame Int
f AppState
s = Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenterLayer (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
cropTopTo (Int -> Int
popupRows Int
f) (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
border (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
padLeftRight Int
2 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ AppState -> Popup -> Widget Name
drawPopup AppState
s Popup
p

drawPopup :: AppState -> Popup -> Widget Name
drawPopup :: AppState -> Popup -> Widget Name
drawPopup AppState
s = \case
  AchievementPopup CategorizedAchievement
ach ->
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
      [ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Achievement unlocked: ")
      , Text -> Widget Name
forall n. Text -> Widget n
txt (AchievementInfo -> Text
title (CategorizedAchievement -> AchievementInfo
describe CategorizedAchievement
ach))
      ]
  Popup
RecipesPopup ->
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
      [ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"New recipes unlocked! ")
      , Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ KeyConfig SwarmEvent -> SwarmEvent -> Text
bindingText KeyConfig SwarmEvent
keyConf (MainEvent -> SwarmEvent
SE.Main MainEvent
SE.ViewRecipesEvent) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to view."
      ]
  CommandsPopup [Const]
cmds ->
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
      [ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
          [ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"New commands unlocked: ")
          , Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> ([Text] -> Text) -> [Text] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
commaList ([Text] -> Widget Name) -> [Text] -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
squote (Text -> Text) -> (Const -> Text) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstInfo -> Text
syntax (ConstInfo -> Text) -> (Const -> ConstInfo) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> ConstInfo
constInfo) [Const]
cmds
          ]
      , Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"Hit " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> KeyConfig SwarmEvent -> SwarmEvent -> Text
bindingText KeyConfig SwarmEvent
keyConf (MainEvent -> SwarmEvent
SE.Main MainEvent
SE.ViewCommandsEvent) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to view all available commands."
      ]
  Popup
DebugWarningPopup ->
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
      [ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
notifAttr (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Warning: ")
      , Text -> Widget Name
forall n. Text -> Widget n
txt Text
"No progress will be saved, since debugging flags are in use."
      ]
 where
  keyConf :: KeyConfig SwarmEvent
keyConf = AppState
s AppState
-> Getting (KeyConfig SwarmEvent) AppState (KeyConfig SwarmEvent)
-> KeyConfig SwarmEvent
forall s a. s -> Getting a s a -> a
^. (KeyEventHandlingState
 -> Const (KeyConfig SwarmEvent) KeyEventHandlingState)
-> AppState -> Const (KeyConfig SwarmEvent) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const (KeyConfig SwarmEvent) KeyEventHandlingState)
 -> AppState -> Const (KeyConfig SwarmEvent) AppState)
-> ((KeyConfig SwarmEvent
     -> Const (KeyConfig SwarmEvent) (KeyConfig SwarmEvent))
    -> KeyEventHandlingState
    -> Const (KeyConfig SwarmEvent) KeyEventHandlingState)
-> Getting (KeyConfig SwarmEvent) AppState (KeyConfig SwarmEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyConfig SwarmEvent
 -> Const (KeyConfig SwarmEvent) (KeyConfig SwarmEvent))
-> KeyEventHandlingState
-> Const (KeyConfig SwarmEvent) KeyEventHandlingState
Lens' KeyEventHandlingState (KeyConfig SwarmEvent)
keyConfig

-- | Compute the number of rows of the notification popup we should be
--   showing, based on the number of animation frames the popup has existed.
--   This is what causes the popup to animate in and out of existence.
popupRows :: Int -> Int
popupRows :: Int -> Int
popupRows Int
f
  -- If we're less than halfway through the lifetime of the popup, use
  -- the number of animation frames elapsed since the beginning of the popup animation.
  -- This will become much larger than the actual number of rows in the
  -- popup, but the 'cropTopTo' function simply has no effect when given any value
  -- equal to or larger than the number of rows of a widget. This way the animation
  -- will continue to work for popups with any (reasonable) number of rows.
  | Int
f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
popupFrames Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 = Int
f
  -- Otherwise, use the number of frames remaining.
  | Bool
otherwise = Int
popupFrames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
f