{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Here is the WorldPanel player configurable key event handler.
module Swarm.TUI.Controller.EventHandlers.World (
  worldEventHandlers,
) where

import Brick hiding (Location)
import Brick.Keybindings
import Control.Lens
import Control.Monad (when)
import Data.Int (Int32)
import Linear
import Swarm.Game.Location
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Language.Syntax.Direction (Direction (..), directionSyntax)
import Swarm.TUI.Controller.Util
import Swarm.TUI.Model
import Swarm.TUI.Model.Event
import Swarm.TUI.Model.UI

-- | Handle a user input event in the world view panel.
worldEventHandlers :: [KeyEventHandler SwarmEvent (EventM Name AppState)]
worldEventHandlers :: [KeyEventHandler SwarmEvent (EventM Name AppState)]
worldEventHandlers = (WorldEvent -> SwarmEvent)
-> (WorldEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall e2 e1.
(Ord e2, Enum e1, Bounded e1) =>
(e1 -> e2)
-> (e1 -> (Text, EventM Name AppState ()))
-> [KeyEventHandler e2 (EventM Name AppState)]
allHandlers WorldEvent -> SwarmEvent
World ((WorldEvent -> (Text, EventM Name AppState ()))
 -> [KeyEventHandler SwarmEvent (EventM Name AppState)])
-> (WorldEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall a b. (a -> b) -> a -> b
$ \case
  WorldEvent
ViewBaseEvent -> (Text
"View the base robot", EventM Name AppState ()
viewBase)
  WorldEvent
ShowFpsEvent -> (Text
"Show frames per second", EventM Name AppState ()
showFps)
  MoveViewEvent AbsoluteDir
d -> (Text
"Scroll world view in the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Direction -> Text
directionSyntax (AbsoluteDir -> Direction
DAbsolute AbsoluteDir
d) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" direction", V2 Int32 -> EventM Name AppState ()
scrollViewInDir (V2 Int32 -> EventM Name AppState ())
-> V2 Int32 -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ AbsoluteDir -> V2 Int32
toHeading AbsoluteDir
d)

viewBase :: EventM Name AppState ()
viewBase :: EventM Name AppState ()
viewBase = do
  Name -> EventM Name AppState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
  (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((ViewCenterRule -> Identity ViewCenterRule)
    -> GameState -> Identity GameState)
-> (ViewCenterRule -> Identity ViewCenterRule)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> ((ViewCenterRule -> Identity ViewCenterRule)
    -> Robots -> Identity Robots)
-> (ViewCenterRule -> Identity ViewCenterRule)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViewCenterRule -> Identity ViewCenterRule)
-> Robots -> Identity Robots
Lens' Robots ViewCenterRule
viewCenterRule ((ViewCenterRule -> Identity ViewCenterRule)
 -> AppState -> Identity AppState)
-> ViewCenterRule -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RID -> ViewCenterRule
VCRobot RID
0

showFps :: EventM Name AppState ()
showFps :: EventM Name AppState ()
showFps = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Bool -> Identity Bool) -> UIState -> Identity UIState)
-> (Bool -> Identity Bool)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Identity UITiming)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Identity UITiming)
 -> UIGameplay -> Identity UIGameplay)
-> ((Bool -> Identity Bool) -> UITiming -> Identity UITiming)
-> (Bool -> Identity Bool)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> UITiming -> Identity UITiming
Lens' UITiming Bool
uiShowFPS ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> (Bool -> Bool) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not

scrollViewInDir :: V2 Int32 -> EventM Name AppState ()
scrollViewInDir :: V2 Int32 -> EventM Name AppState ()
scrollViewInDir V2 Int32
d = do
  Bool
c <- Getting Bool AppState Bool -> EventM Name AppState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool AppState Bool -> EventM Name AppState Bool)
-> Getting Bool AppState Bool -> EventM Name AppState Bool
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GameState -> Const Bool GameState
Lens' GameState Bool
creativeMode
  Bool
s <- Getting Bool AppState Bool -> EventM Name AppState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool AppState Bool -> EventM Name AppState Bool)
-> Getting Bool AppState Bool -> EventM Name AppState Bool
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Landscape -> Const Bool Landscape)
-> GameState -> Const Bool GameState
Lens' GameState Landscape
landscape ((Landscape -> Const Bool Landscape)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool) -> Landscape -> Const Bool Landscape)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Landscape -> Const Bool Landscape
Lens' Landscape Bool
worldScrollable
  Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
c Bool -> Bool -> Bool
|| Bool
s) (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (Location -> Location) -> EventM Name AppState ()
scrollView (Location -> Diff (Point V2) Int32 -> Location
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Int32
worldScrollDist Int32 -> V2 Int32 -> V2 Int32
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Int32
d))

worldScrollDist :: Int32
worldScrollDist :: Int32
worldScrollDist = Int32
8

-- | Manually scroll the world view.
scrollView :: (Location -> Location) -> EventM Name AppState ()
scrollView :: (Location -> Location) -> EventM Name AppState ()
scrollView Location -> Location
update = do
  -- Manually invalidate the 'WorldCache' instead of just setting
  -- 'needsRedraw'.  I don't quite understand why the latter doesn't
  -- always work, but there seems to be some sort of race condition
  -- where 'needsRedraw' gets reset before the UI drawing code runs.
  Name -> EventM Name AppState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
  (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> (Robots -> Identity Robots)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> AppState -> Identity AppState)
-> (Robots -> Robots) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Cosmic Location -> Cosmic Location) -> Robots -> Robots
modifyViewCenter ((Location -> Location) -> Cosmic Location -> Cosmic Location
forall a b. (a -> b) -> Cosmic a -> Cosmic b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Location -> Location
update)