{-# 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

-- | 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 s.
(Ord e2, Enum e1, Bounded e1) =>
(e1 -> e2)
-> (e1 -> (Text, EventM Name s ()))
-> [KeyEventHandler e2 (EventM Name s)]
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
  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)

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
$ (PlayState -> Const Bool PlayState)
-> AppState -> Const Bool AppState
Lens' AppState PlayState
playState ((PlayState -> Const Bool PlayState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> PlayState -> Const Bool PlayState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const Bool ScenarioState)
-> PlayState -> Const Bool PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const Bool ScenarioState)
 -> PlayState -> Const Bool PlayState)
-> ((Bool -> Const Bool Bool)
    -> ScenarioState -> Const Bool ScenarioState)
-> (Bool -> Const Bool Bool)
-> PlayState
-> Const Bool PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const Bool GameState)
-> ScenarioState -> Const Bool ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const Bool GameState)
 -> ScenarioState -> Const Bool ScenarioState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> (Bool -> Const Bool Bool)
-> ScenarioState
-> Const Bool ScenarioState
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
$ (PlayState -> Const Bool PlayState)
-> AppState -> Const Bool AppState
Lens' AppState PlayState
playState ((PlayState -> Const Bool PlayState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> PlayState -> Const Bool PlayState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const Bool ScenarioState)
-> PlayState -> Const Bool PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const Bool ScenarioState)
 -> PlayState -> Const Bool PlayState)
-> ((Bool -> Const Bool Bool)
    -> ScenarioState -> Const Bool ScenarioState)
-> (Bool -> Const Bool Bool)
-> PlayState
-> Const Bool PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const Bool GameState)
-> ScenarioState -> Const Bool ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const Bool GameState)
 -> ScenarioState -> Const Bool ScenarioState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> (Bool -> Const Bool Bool)
-> ScenarioState
-> Const Bool ScenarioState
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
  (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((Robots -> Identity Robots) -> PlayState -> Identity PlayState)
-> (Robots -> Identity Robots)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Identity ScenarioState)
-> PlayState -> Identity PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Identity ScenarioState)
 -> PlayState -> Identity PlayState)
-> ((Robots -> Identity Robots)
    -> ScenarioState -> Identity ScenarioState)
-> (Robots -> Identity Robots)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> (Robots -> Identity Robots)
-> ScenarioState
-> Identity ScenarioState
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)