{-# LANGUAGE PatternSynonyms #-}

module Swarm.TUI.Controller.Util where

import Brick hiding (Direction)
import Brick.Focus
import Control.Lens
import Control.Monad (unless)
import Graphics.Vty qualified as V
import Swarm.Game.State
import Swarm.TUI.Model
import Swarm.TUI.Model.UI
import Swarm.TUI.View.Util (generateModal)

-- | Pattern synonyms to simplify brick event handler
pattern Key :: V.Key -> BrickEvent n e
pattern $bKey :: forall n e. Key -> BrickEvent n e
$mKey :: forall {r} {n} {e}.
BrickEvent n e -> (Key -> r) -> ((# #) -> r) -> r
Key k = VtyEvent (V.EvKey k [])

pattern CharKey, ControlChar, MetaChar :: Char -> BrickEvent n e
pattern $bCharKey :: forall n e. Char -> BrickEvent n e
$mCharKey :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
CharKey c = VtyEvent (V.EvKey (V.KChar c) [])
pattern $bControlChar :: forall n e. Char -> BrickEvent n e
$mControlChar :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
ControlChar c = VtyEvent (V.EvKey (V.KChar c) [V.MCtrl])
pattern $bMetaChar :: forall n e. Char -> BrickEvent n e
$mMetaChar :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
MetaChar c = VtyEvent (V.EvKey (V.KChar c) [V.MMeta])

pattern ShiftKey :: V.Key -> BrickEvent n e
pattern $bShiftKey :: forall n e. Key -> BrickEvent n e
$mShiftKey :: forall {r} {n} {e}.
BrickEvent n e -> (Key -> r) -> ((# #) -> r) -> r
ShiftKey k = VtyEvent (V.EvKey k [V.MShift])

pattern EscapeKey :: BrickEvent n e
pattern $bEscapeKey :: forall n e. BrickEvent n e
$mEscapeKey :: forall {r} {n} {e}.
BrickEvent n e -> ((# #) -> r) -> ((# #) -> r) -> r
EscapeKey = VtyEvent (V.EvKey V.KEsc [])

pattern FKey :: Int -> BrickEvent n e
pattern $bFKey :: forall n e. Int -> BrickEvent n e
$mFKey :: forall {r} {n} {e}.
BrickEvent n e -> (Int -> r) -> ((# #) -> r) -> r
FKey c = VtyEvent (V.EvKey (V.KFun c) [])

openModal :: ModalType -> EventM Name AppState ()
openModal :: ModalType -> EventM Name AppState ()
openModal ModalType
mt = do
  Modal
newModal <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip AppState -> ModalType -> Modal
generateModal ModalType
mt
  EventM Name AppState ()
ensurePause
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Modal
newModal
 where
  -- Set the game to AutoPause if needed
  ensurePause :: EventM Name AppState ()
ensurePause = do
    Bool
pause <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState Bool
paused
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
pause Bool -> Bool -> Bool
|| ModalType -> Bool
isRunningModal ModalType
mt) forall a b. (a -> b) -> a -> b
$ do
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState RunStatus
runStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RunStatus
AutoPause

-- | The running modals do not autopause the game.
isRunningModal :: ModalType -> Bool
isRunningModal :: ModalType -> Bool
isRunningModal = \case
  ModalType
RobotsModal -> Bool
True
  ModalType
MessagesModal -> Bool
True
  ModalType
_ -> Bool
False

setFocus :: FocusablePanel -> EventM Name AppState ()
setFocus :: FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
name = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (FocusablePanel -> Name
FocusablePanel FocusablePanel
name)