{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}

module Swarm.TUI.Model.Popup (
  -- * Popup types
  Popup (..),

  -- * Popup state
  PopupState,
  currentPopup,
  popupQueue,
  initPopupState,
  addPopup,

  -- * Popup animation
  popupFrames,
  progressPopups,
) where

import Control.Lens (makeLenses, use, (%~), (+=), (.=), _2, _Just)
import Control.Monad.State (MonadState)
import Data.Functor (($>))
import Data.Maybe (isJust)
import Data.Sequence (Seq, (|>), pattern (:<|))
import Data.Sequence qualified as Seq
import Swarm.Game.Achievement.Definitions (CategorizedAchievement)
import Swarm.Language.Syntax (Const)

-- | Different types of popups that can be displayed to the
--   player.
data Popup
  = AchievementPopup CategorizedAchievement
  | RecipesPopup
  | CommandsPopup [Const]

-- | State to track pending popup queue as well as any
--   popup which is currently being displayed.
data PopupState = PopupState
  { PopupState -> Maybe (Popup, Int)
_currentPopup :: Maybe (Popup, Int)
  , PopupState -> Seq Popup
_popupQueue :: Seq Popup
  }

makeLenses ''PopupState

-- | Initial, empty popup state.
initPopupState :: PopupState
initPopupState :: PopupState
initPopupState =
  PopupState
    { _currentPopup :: Maybe (Popup, Int)
_currentPopup = Maybe (Popup, Int)
forall a. Maybe a
Nothing
    , _popupQueue :: Seq Popup
_popupQueue = Seq Popup
forall a. Seq a
Seq.empty
    }

-- | Add a popup to the end of the queue.
addPopup :: Popup -> PopupState -> PopupState
addPopup :: Popup -> PopupState -> PopupState
addPopup Popup
notif = (Seq Popup -> Identity (Seq Popup))
-> PopupState -> Identity PopupState
Lens' PopupState (Seq Popup)
popupQueue ((Seq Popup -> Identity (Seq Popup))
 -> PopupState -> Identity PopupState)
-> (Seq Popup -> Seq Popup) -> PopupState -> PopupState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq Popup -> Popup -> Seq Popup
forall a. Seq a -> a -> Seq a
|> Popup
notif)

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

-- | Progress the popup state by one frame: pull the next
--   popup from the queue if there is no current popup
--   or the current popup has reached the max frame count;
--   otherwise just increment the frame count of the current
--   popup.
--
--   Return True if something was updated that might require redrawing
--   the UI.
progressPopups :: MonadState PopupState m => m Bool
progressPopups :: forall (m :: * -> *). MonadState PopupState m => m Bool
progressPopups = do
  Maybe (Popup, Int)
cur <- Getting (Maybe (Popup, Int)) PopupState (Maybe (Popup, Int))
-> m (Maybe (Popup, Int))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe (Popup, Int)) PopupState (Maybe (Popup, Int))
Lens' PopupState (Maybe (Popup, Int))
currentPopup
  case Maybe (Popup, Int)
cur of
    Maybe (Popup, Int)
Nothing -> m Bool
forall (m :: * -> *). MonadState PopupState m => m Bool
nextPopup
    Just (Popup
_, Int
frameCount)
      | Int
frameCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
popupFrames -> m Bool
forall (m :: * -> *). MonadState PopupState m => m Bool
nextPopup m Bool -> Bool -> m Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
      | Bool
otherwise -> do
          (Maybe (Popup, Int) -> Identity (Maybe (Popup, Int)))
-> PopupState -> Identity PopupState
Lens' PopupState (Maybe (Popup, Int))
currentPopup ((Maybe (Popup, Int) -> Identity (Maybe (Popup, Int)))
 -> PopupState -> Identity PopupState)
-> ((Int -> Identity Int)
    -> Maybe (Popup, Int) -> Identity (Maybe (Popup, Int)))
-> (Int -> Identity Int)
-> PopupState
-> Identity PopupState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Popup, Int) -> Identity (Popup, Int))
-> Maybe (Popup, Int) -> Identity (Maybe (Popup, Int))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Popup, Int) -> Identity (Popup, Int))
 -> Maybe (Popup, Int) -> Identity (Maybe (Popup, Int)))
-> ((Int -> Identity Int) -> (Popup, Int) -> Identity (Popup, Int))
-> (Int -> Identity Int)
-> Maybe (Popup, Int)
-> Identity (Maybe (Popup, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> (Popup, Int) -> Identity (Popup, Int)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Popup, Int) (Popup, Int) Int Int
_2 ((Int -> Identity Int) -> PopupState -> Identity PopupState)
-> Int -> m ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
          Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

-- | Move the next popup (if any) from the queue to the
--   currently displayed popup.  Return True if there was any
--   popup to move.
nextPopup :: MonadState PopupState m => m Bool
nextPopup :: forall (m :: * -> *). MonadState PopupState m => m Bool
nextPopup = do
  Seq Popup
q <- Getting (Seq Popup) PopupState (Seq Popup) -> m (Seq Popup)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Seq Popup) PopupState (Seq Popup)
Lens' PopupState (Seq Popup)
popupQueue
  Maybe (Popup, Int)
cur <- Getting (Maybe (Popup, Int)) PopupState (Maybe (Popup, Int))
-> m (Maybe (Popup, Int))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe (Popup, Int)) PopupState (Maybe (Popup, Int))
Lens' PopupState (Maybe (Popup, Int))
currentPopup
  case Seq Popup
q of
    Seq Popup
Seq.Empty
      | Maybe (Popup, Int) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Popup, Int)
cur -> do
          (Maybe (Popup, Int) -> Identity (Maybe (Popup, Int)))
-> PopupState -> Identity PopupState
Lens' PopupState (Maybe (Popup, Int))
currentPopup ((Maybe (Popup, Int) -> Identity (Maybe (Popup, Int)))
 -> PopupState -> Identity PopupState)
-> Maybe (Popup, Int) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Popup, Int)
forall a. Maybe a
Nothing
          Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      | Bool
otherwise -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Popup
n :<| Seq Popup
ns -> do
      (Maybe (Popup, Int) -> Identity (Maybe (Popup, Int)))
-> PopupState -> Identity PopupState
Lens' PopupState (Maybe (Popup, Int))
currentPopup ((Maybe (Popup, Int) -> Identity (Maybe (Popup, Int)))
 -> PopupState -> Identity PopupState)
-> Maybe (Popup, Int) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Popup, Int) -> Maybe (Popup, Int)
forall a. a -> Maybe a
Just (Popup
n, Int
0)
      (Seq Popup -> Identity (Seq Popup))
-> PopupState -> Identity PopupState
Lens' PopupState (Seq Popup)
popupQueue ((Seq Popup -> Identity (Seq Popup))
 -> PopupState -> Identity PopupState)
-> Seq Popup -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Seq Popup
ns
      Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True