{-# LANGUAGE OverloadedStrings #-}

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

import Brick (Widget (..), cropTopTo, padLeftRight, txt, vBox)
import Brick.Widgets.Border (border)
import Brick.Widgets.Center (hCenterLayer)
import Brick.Widgets.Core (emptyWidget, hBox, withAttr)
import Control.Lens ((^.))
import Swarm.Game.Achievement.Definitions (title)
import Swarm.Game.Achievement.Description (describe)
import Swarm.Language.Syntax (constInfo, syntax)
import Swarm.TUI.Model (AppState, Name, uiState)
import Swarm.TUI.Model.Event qualified as SE
import Swarm.TUI.Model.Popup (Popup (..), currentPopup, popupFrames)
import Swarm.TUI.Model.UI (uiPopups)
import Swarm.TUI.View.Attribute.Attr (notifAttr)
import Swarm.TUI.View.Util (bindingText)
import Swarm.Util (commaList, squote)

-- | The number of frames taken by each step of the notification popup
--   animation.
animFrames :: Int
animFrames :: Int
animFrames = Int
3

-- | Draw the current notification popup (if any).
drawPopups :: AppState -> Widget Name
drawPopups :: AppState -> Widget Name
drawPopups 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
$
  case AppState
s AppState
-> Getting (Maybe (Popup, Int)) AppState (Maybe (Popup, Int))
-> Maybe (Popup, Int)
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe (Popup, Int)) UIState)
-> AppState -> Const (Maybe (Popup, Int)) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe (Popup, Int)) UIState)
 -> AppState -> Const (Maybe (Popup, Int)) AppState)
-> ((Maybe (Popup, Int)
     -> Const (Maybe (Popup, Int)) (Maybe (Popup, Int)))
    -> UIState -> Const (Maybe (Popup, Int)) UIState)
-> Getting (Maybe (Popup, Int)) AppState (Maybe (Popup, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PopupState -> Const (Maybe (Popup, Int)) PopupState)
-> UIState -> Const (Maybe (Popup, Int)) UIState
Lens' UIState PopupState
uiPopups ((PopupState -> Const (Maybe (Popup, Int)) PopupState)
 -> UIState -> Const (Maybe (Popup, Int)) UIState)
-> ((Maybe (Popup, Int)
     -> Const (Maybe (Popup, Int)) (Maybe (Popup, Int)))
    -> PopupState -> Const (Maybe (Popup, Int)) PopupState)
-> (Maybe (Popup, Int)
    -> Const (Maybe (Popup, Int)) (Maybe (Popup, Int)))
-> UIState
-> Const (Maybe (Popup, Int)) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Popup, Int)
 -> Const (Maybe (Popup, Int)) (Maybe (Popup, Int)))
-> PopupState -> Const (Maybe (Popup, Int)) PopupState
Lens' PopupState (Maybe (Popup, Int))
currentPopup of
    Just (Popup
notif, Int
f) ->
      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
notif
    Maybe (Popup, Int)
_ -> Widget Name
forall n. Widget n
emptyWidget

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
$ AppState -> SwarmEvent -> Text
bindingText AppState
s (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
<> AppState -> SwarmEvent -> Text
bindingText AppState
s (MainEvent -> SwarmEvent
SE.Main MainEvent
SE.ViewCommandsEvent) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to view all available commands."
      ]

-- | Compute the number of rows of the notification popup we should be
--   showing, based on the number of 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,
  -- divide the number of frames by the number of frames for each step
  -- of the animation (rounded up).  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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
animFrames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
animFrames
  -- Otherwise, divide the number of frames remaining by the number of
  -- frames for each step of the animation (rounded up).
  | Bool
otherwise = (Int
popupFrames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
animFrames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
animFrames