{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Event handlers for the TUI.
module Swarm.TUI.Controller (
  -- * Event handling
  handleEvent,
  quitGame,

  -- ** Handling 'Swarm.TUI.Model.Frame' events
  runFrameUI,
  ticksPerFrameCap,
  runGameTickUI,

  -- ** REPL panel
  runBaseWebCode,
  handleREPLEvent,
  validateREPLForm,
  adjReplHistIndex,
  TimeDir (..),

  -- ** Info panel
  handleInfoPanelEvent,
) where

import Brick hiding (Direction, Location)
import Brick.Animation (stopAnimationManager)
import Brick.Focus
import Brick.Keybindings qualified as B
import Brick.Widgets.Dialog
import Brick.Widgets.Edit (Editor, applyEdit, editContentsL, handleEditorEvent)
import Brick.Widgets.List (handleListEvent, listElements)
import Brick.Widgets.List qualified as BL
import Brick.Widgets.TabularList.Grid qualified as BG
import Control.Applicative ((<|>))
import Control.Category ((>>>))
import Control.Lens as Lens
import Control.Monad (forM_, unless, void, when)
import Control.Monad.Extra (whenJust)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.State (MonadState, execState)
import Data.List (find)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, listToMaybe, mapMaybe)
import Data.Set (Set)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Text.Zipper qualified as TZ
import Data.Text.Zipper.Generic.Words qualified as TZ
import Data.Vector qualified as V
import Graphics.Vty qualified as V
import Swarm.Game.Achievement.Definitions
import Swarm.Game.CESK (CESK (Out), Frame (FApp, FExec, FSuspend))
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Land
import Swarm.Game.Robot.Concrete
import Swarm.Game.Scenario (scenarioMetadata, scenarioName)
import Swarm.Game.Scenario.Scoring.Best (scenarioBestByTime)
import Swarm.Game.Scenario.Scoring.GenericMetrics
import Swarm.Game.Scenario.Status (ScenarioPath (..), ScenarioWith (..), getScenario)
import Swarm.Game.ScenarioInfo
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Game.State.Runtime
import Swarm.Game.State.Substate
import Swarm.Language.Capability (
  Capability (CGod),
  constCaps,
 )
import Swarm.Language.Context
import Swarm.Language.Key (KeyCombo, mkKeyCombo)
import Swarm.Language.Parser (readTerm')
import Swarm.Language.Parser.Core (defaultParserConfig)
import Swarm.Language.Parser.Lex (reservedWords)
import Swarm.Language.Parser.Util (showErrorPos)
import Swarm.Language.Pipeline (processParsedTerm', processTerm')
import Swarm.Language.Syntax hiding (Key)
import Swarm.Language.Typecheck (
  ContextualTypeErr (..),
 )
import Swarm.Language.Value (Value (VKey), emptyEnv, envTypes)
import Swarm.Log
import Swarm.ResourceLoading (getSwarmHistoryPath)
import Swarm.TUI.Controller.EventHandlers
import Swarm.TUI.Controller.SaveScenario (saveScenarioInfoOnQuit)
import Swarm.TUI.Controller.UpdateUI
import Swarm.TUI.Controller.Util
import Swarm.TUI.Editor.Controller qualified as EC
import Swarm.TUI.Editor.Model
import Swarm.TUI.Launch.Controller
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.Prep (prepareLaunchDialog)
import Swarm.TUI.List
import Swarm.TUI.Model
import Swarm.TUI.Model.Dialog hiding (Completed)
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.StateUpdate
import Swarm.TUI.Model.UI
import Swarm.TUI.Model.UI.Gameplay
import Swarm.TUI.View.Popup (startPopupAnimation)
import Swarm.TUI.View.Robot
import Swarm.TUI.View.Robot.Type
import Swarm.Util hiding (both, (<<.=))

-- | The top-level event handler for the TUI.
handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent BrickEvent Name AppEvent
e = do
  Bool
playing <- 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
$ (UIState -> Const Bool UIState) -> AppState -> Const Bool AppState
Lens' AppState UIState
uiState ((UIState -> Const Bool UIState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> UIState -> Const Bool UIState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIState -> Const Bool UIState
Lens' UIState Bool
uiPlaying
  case BrickEvent Name AppEvent
e of
    -- the query for upstream version could finish at any time, so we have to handle it here
    AppEvent (UpstreamVersion Either (Severity, Text) String
ev) -> Either (Severity, Text) String -> EventM Name AppState ()
handleUpstreamVersionResponse Either (Severity, Text) String
ev
    AppEvent (Web (RunWebCode {Text
WebInvocationState -> IO ()
webEntry :: Text
webReply :: WebInvocationState -> IO ()
webReply :: WebCommand -> WebInvocationState -> IO ()
webEntry :: WebCommand -> Text
..})) | Bool -> Bool
not Bool
playing -> IO () -> EventM Name AppState ()
forall a. IO a -> EventM Name AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name AppState ())
-> (WebInvocationState -> IO ())
-> WebInvocationState
-> EventM Name AppState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebInvocationState -> IO ()
webReply (WebInvocationState -> EventM Name AppState ())
-> WebInvocationState -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ RejectionReason -> WebInvocationState
Rejected RejectionReason
NoActiveGame
    AppEvent (PopupEvent EventM Name AppState ()
event) -> EventM Name AppState ()
event EventM Name AppState ()
-> EventM Name AppState () -> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> EventM Name AppState b -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
    BrickEvent Name AppEvent
_ -> do
      -- Handle popup display at the very top level, so it is
      -- unaffected by any other state, e.g. even when starting or
      -- quitting a game, moving around the menu, the popup
      -- display will continue as normal.
      AnimationState
popupAnimState <- Getting AnimationState AppState AnimationState
-> EventM Name AppState AnimationState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting AnimationState AppState AnimationState
 -> EventM Name AppState AnimationState)
-> Getting AnimationState AppState AnimationState
-> EventM Name AppState AnimationState
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const AnimationState PlayState)
-> AppState -> Const AnimationState AppState
Lens' AppState PlayState
playState ((PlayState -> Const AnimationState PlayState)
 -> AppState -> Const AnimationState AppState)
-> ((AnimationState -> Const AnimationState AnimationState)
    -> PlayState -> Const AnimationState PlayState)
-> Getting AnimationState AppState AnimationState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> Const AnimationState ProgressionState)
-> PlayState -> Const AnimationState PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> Const AnimationState ProgressionState)
 -> PlayState -> Const AnimationState PlayState)
-> ((AnimationState -> Const AnimationState AnimationState)
    -> ProgressionState -> Const AnimationState ProgressionState)
-> (AnimationState -> Const AnimationState AnimationState)
-> PlayState
-> Const AnimationState PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnimationState -> Const AnimationState AnimationState)
-> ProgressionState -> Const AnimationState ProgressionState
Lens' ProgressionState AnimationState
uiPopupAnimationState
      Bool
forceRedraw <- case AnimationState
popupAnimState of
        AnimationState
AnimInactive -> do
          LensLike' (Zoomed (EventM Name PopupState) ()) AppState PopupState
-> EventM Name PopupState () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name PopupState) c) AppState PopupState
-> EventM Name PopupState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Zoomed (EventM Name PopupState) () PlayState)
-> AppState -> Zoomed (EventM Name PopupState) () AppState
Lens' AppState PlayState
playState ((PlayState -> Zoomed (EventM Name PopupState) () PlayState)
 -> AppState -> Zoomed (EventM Name PopupState) () AppState)
-> ((PopupState -> Zoomed (EventM Name PopupState) () PopupState)
    -> PlayState -> Zoomed (EventM Name PopupState) () PlayState)
-> LensLike'
     (Zoomed (EventM Name PopupState) ()) AppState PopupState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Zoomed (EventM Name PopupState) () ProgressionState)
-> PlayState -> Zoomed (EventM Name PopupState) () PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Zoomed (EventM Name PopupState) () ProgressionState)
 -> PlayState -> Zoomed (EventM Name PopupState) () PlayState)
-> ((PopupState -> Zoomed (EventM Name PopupState) () PopupState)
    -> ProgressionState
    -> Zoomed (EventM Name PopupState) () ProgressionState)
-> (PopupState -> Zoomed (EventM Name PopupState) () PopupState)
-> PlayState
-> Zoomed (EventM Name PopupState) () PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PopupState -> Zoomed (EventM Name PopupState) () PopupState)
-> ProgressionState
-> Zoomed (EventM Name PopupState) () ProgressionState
Lens' ProgressionState PopupState
uiPopups) EventM Name PopupState ()
forall (m :: * -> *). MonadState PopupState m => m ()
nextPopup
          EventM Name AppState ()
startPopupIfNeeded
          Bool -> EventM Name AppState Bool
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        AnimationState
AnimScheduled -> Bool -> EventM Name AppState Bool
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        AnimActive Animation AppState Name
_ -> Bool -> EventM Name AppState Bool
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

      if Bool
playing
        then Bool -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent Bool
forceRedraw BrickEvent Name AppEvent
e
        else BrickEvent Name AppEvent -> EventM Name AppState ()
handleMenuEvent BrickEvent Name AppEvent
e

startPopupIfNeeded :: EventM Name AppState ()
startPopupIfNeeded :: EventM Name AppState ()
startPopupIfNeeded = do
  Maybe Popup
mPopup <- Getting (Maybe Popup) AppState (Maybe Popup)
-> EventM Name AppState (Maybe Popup)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe Popup) AppState (Maybe Popup)
 -> EventM Name AppState (Maybe Popup))
-> Getting (Maybe Popup) AppState (Maybe Popup)
-> EventM Name AppState (Maybe Popup)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (Maybe Popup) PlayState)
-> AppState -> Const (Maybe Popup) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (Maybe Popup) PlayState)
 -> AppState -> Const (Maybe Popup) AppState)
-> ((Maybe Popup -> Const (Maybe Popup) (Maybe Popup))
    -> PlayState -> Const (Maybe Popup) PlayState)
-> Getting (Maybe Popup) AppState (Maybe Popup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> Const (Maybe Popup) ProgressionState)
-> PlayState -> Const (Maybe Popup) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> Const (Maybe Popup) ProgressionState)
 -> PlayState -> Const (Maybe Popup) PlayState)
-> ((Maybe Popup -> Const (Maybe Popup) (Maybe Popup))
    -> ProgressionState -> Const (Maybe Popup) ProgressionState)
-> (Maybe Popup -> Const (Maybe Popup) (Maybe Popup))
-> PlayState
-> Const (Maybe Popup) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PopupState -> Const (Maybe Popup) PopupState)
-> ProgressionState -> Const (Maybe Popup) ProgressionState
Lens' ProgressionState PopupState
uiPopups ((PopupState -> Const (Maybe Popup) PopupState)
 -> ProgressionState -> Const (Maybe Popup) ProgressionState)
-> ((Maybe Popup -> Const (Maybe Popup) (Maybe Popup))
    -> PopupState -> Const (Maybe Popup) PopupState)
-> (Maybe Popup -> Const (Maybe Popup) (Maybe Popup))
-> ProgressionState
-> Const (Maybe Popup) ProgressionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Popup -> Const (Maybe Popup) (Maybe Popup))
-> PopupState -> Const (Maybe Popup) PopupState
Lens' PopupState (Maybe Popup)
currentPopup
  case Maybe Popup
mPopup of
    Just Popup
popup -> do
      -- Ensures we don't grab another popup while waiting for the animation manager to start the event.
      -- The animation state will be set to AnimActive when the animation manager actually starts the animation
      (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((AnimationState -> Identity AnimationState)
    -> PlayState -> Identity PlayState)
-> (AnimationState -> Identity AnimationState)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> Identity ProgressionState)
-> PlayState -> Identity PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> Identity ProgressionState)
 -> PlayState -> Identity PlayState)
-> ((AnimationState -> Identity AnimationState)
    -> ProgressionState -> Identity ProgressionState)
-> (AnimationState -> Identity AnimationState)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnimationState -> Identity AnimationState)
-> ProgressionState -> Identity ProgressionState
Lens' ProgressionState AnimationState
uiPopupAnimationState ((AnimationState -> Identity AnimationState)
 -> AppState -> Identity AppState)
-> AnimationState -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AnimationState
AnimScheduled
      AnimationManager AppState AppEvent Name
animMgr <- Getting
  (AnimationManager AppState AppEvent Name)
  AppState
  (AnimationManager AppState AppEvent Name)
-> EventM Name AppState (AnimationManager AppState AppEvent Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (AnimationManager AppState AppEvent Name)
  AppState
  (AnimationManager AppState AppEvent Name)
Lens' AppState (AnimationManager AppState AppEvent Name)
animationMgr
      AnimationManager AppState AppEvent Name
-> Popup -> EventM Name AppState ()
forall (m :: * -> *).
MonadIO m =>
AnimationManager AppState AppEvent Name -> Popup -> m ()
startPopupAnimation AnimationManager AppState AppEvent Name
animMgr Popup
popup
    Maybe Popup
Nothing -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Halt the app, properly cleaning up the animation manager.
haltApp :: EventM Name AppState ()
haltApp :: EventM Name AppState ()
haltApp = Getting
  (AnimationManager AppState AppEvent Name)
  AppState
  (AnimationManager AppState AppEvent Name)
-> EventM Name AppState (AnimationManager AppState AppEvent Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (AnimationManager AppState AppEvent Name)
  AppState
  (AnimationManager AppState AppEvent Name)
Lens' AppState (AnimationManager AppState AppEvent Name)
animationMgr EventM Name AppState (AnimationManager AppState AppEvent Name)
-> (AnimationManager AppState AppEvent Name
    -> EventM Name AppState ())
-> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> (a -> EventM Name AppState b) -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnimationManager AppState AppEvent Name -> EventM Name AppState ()
forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> m ()
stopAnimationManager EventM Name AppState ()
-> EventM Name AppState () -> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> EventM Name AppState b -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name AppState ()
forall n s. EventM n s ()
halt

handleUpstreamVersionResponse :: Either (Severity, Text) String -> EventM Name AppState ()
handleUpstreamVersionResponse :: Either (Severity, Text) String -> EventM Name AppState ()
handleUpstreamVersionResponse Either (Severity, Text) String
ev = do
  case Either (Severity, Text) String
ev of
    Left (Severity
sev, Text
e) -> (RuntimeState -> Identity RuntimeState)
-> AppState -> Identity AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Identity RuntimeState)
 -> AppState -> Identity AppState)
-> ((Notifications LogEntry -> Identity (Notifications LogEntry))
    -> RuntimeState -> Identity RuntimeState)
-> (Notifications LogEntry -> Identity (Notifications LogEntry))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications LogEntry -> Identity (Notifications LogEntry))
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState (Notifications LogEntry)
eventLog ((Notifications LogEntry -> Identity (Notifications LogEntry))
 -> AppState -> Identity AppState)
-> (Notifications LogEntry -> Notifications LogEntry)
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= LogSource
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
SystemLog Severity
sev Text
"Release" Text
e
    Right String
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  (RuntimeState -> Identity RuntimeState)
-> AppState -> Identity AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Identity RuntimeState)
 -> AppState -> Identity AppState)
-> ((Either (Severity, Text) String
     -> Identity (Either (Severity, Text) String))
    -> RuntimeState -> Identity RuntimeState)
-> (Either (Severity, Text) String
    -> Identity (Either (Severity, Text) String))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Severity, Text) String
 -> Identity (Either (Severity, Text) String))
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState (Either (Severity, Text) String)
upstreamRelease ((Either (Severity, Text) String
  -> Identity (Either (Severity, Text) String))
 -> AppState -> Identity AppState)
-> Either (Severity, Text) String -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Either (Severity, Text) String
ev

handleMenuEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMenuEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMenuEvent BrickEvent Name AppEvent
e =
  Getting Menu AppState Menu -> EventM Name AppState Menu
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((UIState -> Const Menu UIState) -> AppState -> Const Menu AppState
Lens' AppState UIState
uiState ((UIState -> Const Menu UIState)
 -> AppState -> Const Menu AppState)
-> ((Menu -> Const Menu Menu) -> UIState -> Const Menu UIState)
-> Getting Menu AppState Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Const Menu Menu) -> UIState -> Const Menu UIState
Lens' UIState Menu
uiMenu) EventM Name AppState Menu
-> (Menu -> EventM Name AppState ()) -> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> (a -> EventM Name AppState b) -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- If we reach the NoMenu case when uiPlaying is False, just
    -- quit the app.  We should actually never reach this code (the
    -- quitGame function would have already halted the app).
    Menu
NoMenu -> EventM Name AppState ()
haltApp
    MainMenu List Name MainMenuEntry
l -> List Name MainMenuEntry
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent List Name MainMenuEntry
l BrickEvent Name AppEvent
e
    NewGameMenu NonEmpty (List Name (ScenarioItem ScenarioPath))
l -> do
      LaunchControls
launchControls <- Getting LaunchControls AppState LaunchControls
-> EventM Name AppState LaunchControls
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting LaunchControls AppState LaunchControls
 -> EventM Name AppState LaunchControls)
-> Getting LaunchControls AppState LaunchControls
-> EventM Name AppState LaunchControls
forall a b. (a -> b) -> a -> b
$ (UIState -> Const LaunchControls UIState)
-> AppState -> Const LaunchControls AppState
Lens' AppState UIState
uiState ((UIState -> Const LaunchControls UIState)
 -> AppState -> Const LaunchControls AppState)
-> ((LaunchControls -> Const LaunchControls LaunchControls)
    -> UIState -> Const LaunchControls UIState)
-> Getting LaunchControls AppState LaunchControls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchOptions -> Const LaunchControls LaunchOptions)
-> UIState -> Const LaunchControls UIState
Lens' UIState LaunchOptions
uiLaunchConfig ((LaunchOptions -> Const LaunchControls LaunchOptions)
 -> UIState -> Const LaunchControls UIState)
-> ((LaunchControls -> Const LaunchControls LaunchControls)
    -> LaunchOptions -> Const LaunchControls LaunchOptions)
-> (LaunchControls -> Const LaunchControls LaunchControls)
-> UIState
-> Const LaunchControls UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchControls -> Const LaunchControls LaunchControls)
-> LaunchOptions -> Const LaunchControls LaunchOptions
Lens' LaunchOptions LaunchControls
controls
      if LaunchControls
launchControls LaunchControls -> Getting Bool LaunchControls Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (FileBrowserControl -> Const Bool FileBrowserControl)
-> LaunchControls -> Const Bool LaunchControls
Lens' LaunchControls FileBrowserControl
fileBrowser ((FileBrowserControl -> Const Bool FileBrowserControl)
 -> LaunchControls -> Const Bool LaunchControls)
-> ((Bool -> Const Bool Bool)
    -> FileBrowserControl -> Const Bool FileBrowserControl)
-> Getting Bool LaunchControls Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> FileBrowserControl -> Const Bool FileBrowserControl
Lens' FileBrowserControl Bool
fbIsDisplayed
        then BrickEvent Name AppEvent -> EventM Name AppState ()
handleFBEvent BrickEvent Name AppEvent
e
        else case LaunchControls
launchControls LaunchControls
-> Getting
     (Maybe (ScenarioWith ScenarioInfo))
     LaunchControls
     (Maybe (ScenarioWith ScenarioInfo))
-> Maybe (ScenarioWith ScenarioInfo)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ScenarioWith ScenarioInfo))
  LaunchControls
  (Maybe (ScenarioWith ScenarioInfo))
Lens' LaunchControls (Maybe (ScenarioWith ScenarioInfo))
isDisplayedFor of
          Maybe (ScenarioWith ScenarioInfo)
Nothing -> NonEmpty (List Name (ScenarioItem ScenarioPath))
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent NonEmpty (List Name (ScenarioItem ScenarioPath))
l BrickEvent Name AppEvent
e
          Just ScenarioWith ScenarioInfo
siPair -> ScenarioWith ScenarioInfo
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleLaunchOptionsEvent ScenarioWith ScenarioInfo
siPair BrickEvent Name AppEvent
e
    Menu
MessagesMenu -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent BrickEvent Name AppEvent
e
    AchievementsMenu List Name CategorizedAchievement
l -> List Name CategorizedAchievement
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainAchievementsEvent List Name CategorizedAchievement
l BrickEvent Name AppEvent
e
    Menu
AboutMenu -> Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey (List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
About)) BrickEvent Name AppEvent
e

-- | The event handler for the main menu.
--
-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleMainMenuEvent ::
  BL.List Name MainMenuEntry -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent :: List Name MainMenuEntry
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent List Name MainMenuEntry
menu = \case
  Key Key
V.KEnter ->
    Maybe MainMenuEntry
-> (MainMenuEntry -> EventM Name AppState ())
-> EventM Name AppState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((Int, MainMenuEntry) -> MainMenuEntry
forall a b. (a, b) -> b
snd ((Int, MainMenuEntry) -> MainMenuEntry)
-> Maybe (Int, MainMenuEntry) -> Maybe MainMenuEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List Name MainMenuEntry -> Maybe (Int, MainMenuEntry)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name MainMenuEntry
menu) ((MainMenuEntry -> EventM Name AppState ())
 -> EventM Name AppState ())
-> (MainMenuEntry -> EventM Name AppState ())
-> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ \case
      MainMenuEntry
NewGame -> do
        ScenarioCollection ScenarioInfo
ss <- Getting
  (ScenarioCollection ScenarioInfo)
  AppState
  (ScenarioCollection ScenarioInfo)
-> EventM Name AppState (ScenarioCollection ScenarioInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (ScenarioCollection ScenarioInfo)
   AppState
   (ScenarioCollection ScenarioInfo)
 -> EventM Name AppState (ScenarioCollection ScenarioInfo))
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
-> EventM Name AppState (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> AppState -> Const (ScenarioCollection ScenarioInfo) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
 -> AppState -> Const (ScenarioCollection ScenarioInfo) AppState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
 -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> ProgressionState
    -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> (ScenarioCollection ScenarioInfo
    -> Const
         (ScenarioCollection ScenarioInfo)
         (ScenarioCollection ScenarioInfo))
-> PlayState
-> Const (ScenarioCollection ScenarioInfo) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> Const
      (ScenarioCollection ScenarioInfo)
      (ScenarioCollection ScenarioInfo))
-> ProgressionState
-> Const (ScenarioCollection ScenarioInfo) ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios
        (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name (ScenarioItem ScenarioPath)) -> Menu
NewGameMenu (List Name (ScenarioItem ScenarioPath)
-> NonEmpty (List Name (ScenarioItem ScenarioPath))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List Name (ScenarioItem ScenarioPath)
 -> NonEmpty (List Name (ScenarioItem ScenarioPath)))
-> List Name (ScenarioItem ScenarioPath)
-> NonEmpty (List Name (ScenarioItem ScenarioPath))
forall a b. (a -> b) -> a -> b
$ ScenarioCollection ScenarioPath
-> List Name (ScenarioItem ScenarioPath)
forall a. ScenarioCollection a -> List Name (ScenarioItem a)
mkScenarioList (ScenarioCollection ScenarioPath
 -> List Name (ScenarioItem ScenarioPath))
-> ScenarioCollection ScenarioPath
-> List Name (ScenarioItem ScenarioPath)
forall a b. (a -> b) -> a -> b
$ ScenarioCollection ScenarioInfo -> ScenarioCollection ScenarioPath
forall (f :: * -> *). Functor f => f ScenarioInfo -> f ScenarioPath
pathifyCollection ScenarioCollection ScenarioInfo
ss)
      MainMenuEntry
Tutorial -> do
        ScenarioCollection ScenarioInfo
ss <- Getting
  (ScenarioCollection ScenarioInfo)
  AppState
  (ScenarioCollection ScenarioInfo)
-> EventM Name AppState (ScenarioCollection ScenarioInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (ScenarioCollection ScenarioInfo)
   AppState
   (ScenarioCollection ScenarioInfo)
 -> EventM Name AppState (ScenarioCollection ScenarioInfo))
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
-> EventM Name AppState (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> AppState -> Const (ScenarioCollection ScenarioInfo) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
 -> AppState -> Const (ScenarioCollection ScenarioInfo) AppState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
 -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> ProgressionState
    -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> (ScenarioCollection ScenarioInfo
    -> Const
         (ScenarioCollection ScenarioInfo)
         (ScenarioCollection ScenarioInfo))
-> PlayState
-> Const (ScenarioCollection ScenarioInfo) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> Const
      (ScenarioCollection ScenarioInfo)
      (ScenarioCollection ScenarioInfo))
-> ProgressionState
-> Const (ScenarioCollection ScenarioInfo) ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios

        -- Extract the first unsolved tutorial challenge
        let tutorialCollection :: ScenarioCollection ScenarioInfo
tutorialCollection = ScenarioCollection ScenarioInfo -> ScenarioCollection ScenarioInfo
forall a. ScenarioCollection a -> ScenarioCollection a
getTutorials ScenarioCollection ScenarioInfo
ss
            tutorials :: [ScenarioItem ScenarioInfo]
tutorials = ScenarioCollection ScenarioInfo -> [ScenarioItem ScenarioInfo]
forall a. ScenarioCollection a -> [ScenarioItem a]
scenarioCollectionToList ScenarioCollection ScenarioInfo
tutorialCollection
            -- Find first unsolved tutorial, or first tutorial if all are solved
            firstUnsolved :: Maybe (ScenarioItem ScenarioInfo)
            firstUnsolved :: Maybe (ScenarioItem ScenarioInfo)
firstUnsolved = (ScenarioItem ScenarioInfo -> Bool)
-> [ScenarioItem ScenarioInfo] -> Maybe (ScenarioItem ScenarioInfo)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ScenarioItem ScenarioInfo -> Bool
unsolved [ScenarioItem ScenarioInfo]
tutorials Maybe (ScenarioItem ScenarioInfo)
-> Maybe (ScenarioItem ScenarioInfo)
-> Maybe (ScenarioItem ScenarioInfo)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ScenarioItem ScenarioInfo] -> Maybe (ScenarioItem ScenarioInfo)
forall a. [a] -> Maybe a
listToMaybe [ScenarioItem ScenarioInfo]
tutorials
            unsolved :: ScenarioItem ScenarioInfo -> Bool
unsolved = \case
              SISingle (ScenarioWith Scenario
_ ScenarioInfo
si) -> case ScenarioInfo
si ScenarioInfo
-> Getting ScenarioStatus ScenarioInfo ScenarioStatus
-> ScenarioStatus
forall s a. s -> Getting a s a -> a
^. Getting ScenarioStatus ScenarioInfo ScenarioStatus
Lens' ScenarioInfo ScenarioStatus
scenarioStatus of
                Played SerializableLaunchParams
_ ProgressMetric
_ BestRecords
best
                  | Metric Progress
Completed ProgressStats
_ <- BestRecords
best BestRecords
-> Getting ProgressMetric BestRecords ProgressMetric
-> ProgressMetric
forall s a. s -> Getting a s a -> a
^. Getting ProgressMetric BestRecords ProgressMetric
Lens' BestRecords ProgressMetric
scenarioBestByTime -> Bool
False
                  | Bool
otherwise -> Bool
True
                ScenarioStatus
_ -> Bool
True
              ScenarioItem ScenarioInfo
_ -> Bool
False

        case Maybe (ScenarioItem ScenarioInfo)
firstUnsolved of
          Just (SISingle ScenarioWith ScenarioInfo
firstUnsolvedInfo) -> do
            let firstUnsolvedName :: Text
firstUnsolvedName = ScenarioWith ScenarioInfo
firstUnsolvedInfo ScenarioWith ScenarioInfo
-> Getting Text (ScenarioWith ScenarioInfo) Text -> Text
forall s a. s -> Getting a s a -> a
^. (Scenario -> Const Text Scenario)
-> ScenarioWith ScenarioInfo
-> Const Text (ScenarioWith ScenarioInfo)
forall a (f :: * -> *).
Functor f =>
(Scenario -> f Scenario) -> ScenarioWith a -> f (ScenarioWith a)
getScenario ((Scenario -> Const Text Scenario)
 -> ScenarioWith ScenarioInfo
 -> Const Text (ScenarioWith ScenarioInfo))
-> ((Text -> Const Text Text) -> Scenario -> Const Text Scenario)
-> Getting Text (ScenarioWith ScenarioInfo) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioMetadata -> Const Text ScenarioMetadata)
-> Scenario -> Const Text Scenario
Lens' Scenario ScenarioMetadata
scenarioMetadata ((ScenarioMetadata -> Const Text ScenarioMetadata)
 -> Scenario -> Const Text Scenario)
-> ((Text -> Const Text Text)
    -> ScenarioMetadata -> Const Text ScenarioMetadata)
-> (Text -> Const Text Text)
-> Scenario
-> Const Text Scenario
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> ScenarioMetadata -> Const Text ScenarioMetadata
Lens' ScenarioMetadata Text
scenarioName

            -- Now set up the menu stack as if the user had chosen "New Game > Tutorials > t"
            -- where t is the tutorial scenario we identified as the first unsolved one
            let topMenu :: List Name (ScenarioItem ScenarioPath)
topMenu =
                  (ScenarioItem ScenarioPath -> Bool)
-> List Name (ScenarioItem ScenarioPath)
-> List Name (ScenarioItem ScenarioPath)
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy
                    ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
tutorialsDirname) (String -> Bool)
-> (ScenarioItem ScenarioPath -> String)
-> ScenarioItem ScenarioPath
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> (ScenarioItem ScenarioPath -> Text)
-> ScenarioItem ScenarioPath
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioItem ScenarioPath -> Text
forall a. ScenarioItem a -> Text
scenarioItemName)
                    (ScenarioCollection ScenarioPath
-> List Name (ScenarioItem ScenarioPath)
forall a. ScenarioCollection a -> List Name (ScenarioItem a)
mkScenarioList (ScenarioCollection ScenarioPath
 -> List Name (ScenarioItem ScenarioPath))
-> ScenarioCollection ScenarioPath
-> List Name (ScenarioItem ScenarioPath)
forall a b. (a -> b) -> a -> b
$ ScenarioCollection ScenarioInfo -> ScenarioCollection ScenarioPath
forall (f :: * -> *). Functor f => f ScenarioInfo -> f ScenarioPath
pathifyCollection ScenarioCollection ScenarioInfo
ss)
                tutorialMenu :: List Name (ScenarioItem ScenarioPath)
tutorialMenu =
                  (ScenarioItem ScenarioPath -> Bool)
-> List Name (ScenarioItem ScenarioPath)
-> List Name (ScenarioItem ScenarioPath)
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy
                    ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
firstUnsolvedName) (Text -> Bool)
-> (ScenarioItem ScenarioPath -> Text)
-> ScenarioItem ScenarioPath
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioItem ScenarioPath -> Text
forall a. ScenarioItem a -> Text
scenarioItemName)
                    (ScenarioCollection ScenarioPath
-> List Name (ScenarioItem ScenarioPath)
forall a. ScenarioCollection a -> List Name (ScenarioItem a)
mkScenarioList (ScenarioCollection ScenarioPath
 -> List Name (ScenarioItem ScenarioPath))
-> ScenarioCollection ScenarioPath
-> List Name (ScenarioItem ScenarioPath)
forall a b. (a -> b) -> a -> b
$ ScenarioCollection ScenarioInfo -> ScenarioCollection ScenarioPath
forall (f :: * -> *). Functor f => f ScenarioInfo -> f ScenarioPath
pathifyCollection ScenarioCollection ScenarioInfo
tutorialCollection)
                menuStack :: NonEmpty (List Name (ScenarioItem ScenarioPath))
menuStack = List Name (ScenarioItem ScenarioPath)
tutorialMenu List Name (ScenarioItem ScenarioPath)
-> [List Name (ScenarioItem ScenarioPath)]
-> NonEmpty (List Name (ScenarioItem ScenarioPath))
forall a. a -> [a] -> NonEmpty a
:| List Name (ScenarioItem ScenarioPath)
-> [List Name (ScenarioItem ScenarioPath)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure List Name (ScenarioItem ScenarioPath)
topMenu

            -- Finally, set the menu stack, and start the scenario!
            (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name (ScenarioItem ScenarioPath)) -> Menu
NewGameMenu NonEmpty (List Name (ScenarioItem ScenarioPath))
menuStack

            let remainingTutorials :: [ScenarioWith ScenarioPath]
remainingTutorials = [ScenarioWith ScenarioPath]
-> (Int -> [ScenarioWith ScenarioPath])
-> Maybe Int
-> [ScenarioWith ScenarioPath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ScenarioWith ScenarioPath]
forall a. Monoid a => a
mempty (List Name (ScenarioItem ScenarioPath)
-> Int -> [ScenarioWith ScenarioPath]
forall n a.
GenericList n Vector (ScenarioItem a) -> Int -> [ScenarioWith a]
getScenariosAfterSelection List Name (ScenarioItem ScenarioPath)
tutorialMenu) (Maybe Int -> [ScenarioWith ScenarioPath])
-> Maybe Int -> [ScenarioWith ScenarioPath]
forall a b. (a -> b) -> a -> b
$ List Name (ScenarioItem ScenarioPath) -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
BL.listSelected List Name (ScenarioItem ScenarioPath)
tutorialMenu
            NonEmpty (ScenarioWith ScenarioPath)
-> Maybe CodeToRun -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
NonEmpty (ScenarioWith ScenarioPath) -> Maybe CodeToRun -> m ()
startGame (ScenarioWith ScenarioInfo -> ScenarioWith ScenarioPath
forall (f :: * -> *). Functor f => f ScenarioInfo -> f ScenarioPath
pathifyCollection ScenarioWith ScenarioInfo
firstUnsolvedInfo ScenarioWith ScenarioPath
-> [ScenarioWith ScenarioPath]
-> NonEmpty (ScenarioWith ScenarioPath)
forall a. a -> [a] -> NonEmpty a
:| [ScenarioWith ScenarioPath]
remainingTutorials) Maybe CodeToRun
forall a. Maybe a
Nothing

          -- This shouldn't normally happen, but it could if the
          -- correct data files aren't installed.  In that case, log
          -- an error.
          Maybe (ScenarioItem ScenarioInfo)
_ -> (RuntimeState -> Identity RuntimeState)
-> AppState -> Identity AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Identity RuntimeState)
 -> AppState -> Identity AppState)
-> ((Notifications LogEntry -> Identity (Notifications LogEntry))
    -> RuntimeState -> Identity RuntimeState)
-> (Notifications LogEntry -> Identity (Notifications LogEntry))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications LogEntry -> Identity (Notifications LogEntry))
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState (Notifications LogEntry)
eventLog ((Notifications LogEntry -> Identity (Notifications LogEntry))
 -> AppState -> Identity AppState)
-> (Notifications LogEntry -> Notifications LogEntry)
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= LogSource
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
SystemLog Severity
Error Text
"Tutorials" Text
"No tutorials found!"
      MainMenuEntry
Achievements -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name CategorizedAchievement -> Menu
AchievementsMenu (Name
-> Vector CategorizedAchievement
-> Int
-> List Name CategorizedAchievement
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
AchievementList ([CategorizedAchievement] -> Vector CategorizedAchievement
forall a. [a] -> Vector a
V.fromList [CategorizedAchievement]
listAchievements) Int
1)
      MainMenuEntry
Messages -> do
        (RuntimeState -> Identity RuntimeState)
-> AppState -> Identity AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Identity RuntimeState)
 -> AppState -> Identity AppState)
-> ((Int -> Identity Int) -> RuntimeState -> Identity RuntimeState)
-> (Int -> Identity Int)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications LogEntry -> Identity (Notifications LogEntry))
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState (Notifications LogEntry)
eventLog ((Notifications LogEntry -> Identity (Notifications LogEntry))
 -> RuntimeState -> Identity RuntimeState)
-> ((Int -> Identity Int)
    -> Notifications LogEntry -> Identity (Notifications LogEntry))
-> (Int -> Identity Int)
-> RuntimeState
-> Identity RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int)
-> Notifications LogEntry -> Identity (Notifications LogEntry)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> Notifications a -> f (Notifications a)
notificationsCount ((Int -> Identity Int) -> AppState -> Identity AppState)
-> Int -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
        (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
MessagesMenu
      MainMenuEntry
About -> do
        (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
AboutMenu
        LensLike'
  (Zoomed (EventM Name ProgressionState) ())
  AppState
  ProgressionState
-> EventM Name ProgressionState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ProgressionState) c) AppState ProgressionState
-> EventM Name ProgressionState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ProgressionState
     -> Focusing (StateT (EventState Name) IO) () ProgressionState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ProgressionState
    -> Focusing (StateT (EventState Name) IO) () ProgressionState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Focusing (StateT (EventState Name) IO) () ProgressionState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ProgressionState
progression) (EventM Name ProgressionState () -> EventM Name AppState ())
-> EventM Name ProgressionState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$
          CategorizedAchievement -> EventM Name ProgressionState ()
forall n. CategorizedAchievement -> EventM n ProgressionState ()
attainAchievement (CategorizedAchievement -> EventM Name ProgressionState ())
-> CategorizedAchievement -> EventM Name ProgressionState ()
forall a b. (a -> b) -> a -> b
$
            GlobalAchievement -> CategorizedAchievement
GlobalAchievement GlobalAchievement
LookedAtAboutScreen
      MainMenuEntry
Quit -> EventM Name AppState ()
haltApp
  CharKey Char
'q' -> EventM Name AppState ()
haltApp
  ControlChar Char
'q' -> EventM Name AppState ()
haltApp
  VtyEvent Event
ev -> do
    List Name MainMenuEntry
menu' <- List Name MainMenuEntry
-> EventM Name (List Name MainMenuEntry) ()
-> EventM Name AppState (List Name MainMenuEntry)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name MainMenuEntry
menu (Event -> EventM Name (List Name MainMenuEntry) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name MainMenuEntry -> Menu
MainMenu List Name MainMenuEntry
menu'
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | If we are in a New Game menu, advance the menu to the next item in order.
--
--   NOTE: be careful to maintain the invariant that the currently selected
--   menu item is always the same as the currently played scenario!  `quitGame`
--   is the only place this function should be called.
advanceMenu :: Menu -> Menu
advanceMenu :: Menu -> Menu
advanceMenu = (NonEmpty (List Name (ScenarioItem ScenarioPath))
 -> Identity (NonEmpty (List Name (ScenarioItem ScenarioPath))))
-> Menu -> Identity Menu
Prism' Menu (NonEmpty (List Name (ScenarioItem ScenarioPath)))
_NewGameMenu ((NonEmpty (List Name (ScenarioItem ScenarioPath))
  -> Identity (NonEmpty (List Name (ScenarioItem ScenarioPath))))
 -> Menu -> Identity Menu)
-> ((List Name (ScenarioItem ScenarioPath)
     -> Identity (List Name (ScenarioItem ScenarioPath)))
    -> NonEmpty (List Name (ScenarioItem ScenarioPath))
    -> Identity (NonEmpty (List Name (ScenarioItem ScenarioPath))))
-> (List Name (ScenarioItem ScenarioPath)
    -> Identity (List Name (ScenarioItem ScenarioPath)))
-> Menu
-> Identity Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (NonEmpty (List Name (ScenarioItem ScenarioPath)))
-> Traversal'
     (NonEmpty (List Name (ScenarioItem ScenarioPath)))
     (IxValue (NonEmpty (List Name (ScenarioItem ScenarioPath))))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (NonEmpty (List Name (ScenarioItem ScenarioPath)))
0 ((List Name (ScenarioItem ScenarioPath)
  -> Identity (List Name (ScenarioItem ScenarioPath)))
 -> Menu -> Identity Menu)
-> (List Name (ScenarioItem ScenarioPath)
    -> List Name (ScenarioItem ScenarioPath))
-> Menu
-> Menu
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ List Name (ScenarioItem ScenarioPath)
-> List Name (ScenarioItem ScenarioPath)
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
BL.listMoveDown

handleMainAchievementsEvent ::
  BL.List Name CategorizedAchievement ->
  BrickEvent Name AppEvent ->
  EventM Name AppState ()
handleMainAchievementsEvent :: List Name CategorizedAchievement
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainAchievementsEvent List Name CategorizedAchievement
l BrickEvent Name AppEvent
e = case BrickEvent Name AppEvent
e of
  Key Key
V.KEsc -> EventM Name AppState ()
returnToMainMenu
  CharKey Char
'q' -> EventM Name AppState ()
returnToMainMenu
  ControlChar Char
'q' -> EventM Name AppState ()
returnToMainMenu
  VtyEvent Event
ev -> do
    List Name CategorizedAchievement
l' <- List Name CategorizedAchievement
-> EventM Name (List Name CategorizedAchievement) ()
-> EventM Name AppState (List Name CategorizedAchievement)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name CategorizedAchievement
l (Event -> EventM Name (List Name CategorizedAchievement) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name CategorizedAchievement -> Menu
AchievementsMenu List Name CategorizedAchievement
l'
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  returnToMainMenu :: EventM Name AppState ()
returnToMainMenu = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
Messages)

handleMainMessagesEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent = \case
  Key Key
V.KEsc -> EventM Name AppState ()
returnToMainMenu
  CharKey Char
'q' -> EventM Name AppState ()
returnToMainMenu
  ControlChar Char
'q' -> EventM Name AppState ()
returnToMainMenu
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  returnToMainMenu :: EventM Name AppState ()
returnToMainMenu = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
Messages)

-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleNewGameMenuEvent ::
  NonEmpty (BL.List Name (ScenarioItem ScenarioPath)) ->
  BrickEvent Name AppEvent ->
  EventM Name AppState ()
handleNewGameMenuEvent :: NonEmpty (List Name (ScenarioItem ScenarioPath))
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent scenarioStack :: NonEmpty (List Name (ScenarioItem ScenarioPath))
scenarioStack@(List Name (ScenarioItem ScenarioPath)
curMenu :| [List Name (ScenarioItem ScenarioPath)]
rest) = \case
  Key Key
V.KEnter ->
    Maybe (Int, ScenarioItem ScenarioPath)
-> ((Int, ScenarioItem ScenarioPath) -> EventM Name AppState ())
-> EventM Name AppState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (List Name (ScenarioItem ScenarioPath)
-> Maybe (Int, ScenarioItem ScenarioPath)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name (ScenarioItem ScenarioPath)
curMenu) (((Int, ScenarioItem ScenarioPath) -> EventM Name AppState ())
 -> EventM Name AppState ())
-> ((Int, ScenarioItem ScenarioPath) -> EventM Name AppState ())
-> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
pos, ScenarioItem ScenarioPath
item) -> case ScenarioItem ScenarioPath
item of
      SISingle ScenarioWith ScenarioPath
siPair -> do
        EventM Name AppState ()
forall n s. Ord n => EventM n s ()
invalidateCache
        let remaining :: [ScenarioWith ScenarioPath]
remaining = List Name (ScenarioItem ScenarioPath)
-> Int -> [ScenarioWith ScenarioPath]
forall n a.
GenericList n Vector (ScenarioItem a) -> Int -> [ScenarioWith a]
getScenariosAfterSelection List Name (ScenarioItem ScenarioPath)
curMenu Int
pos
        NonEmpty (ScenarioWith ScenarioPath)
-> Maybe CodeToRun -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
NonEmpty (ScenarioWith ScenarioPath) -> Maybe CodeToRun -> m ()
startGame (ScenarioWith ScenarioPath
siPair ScenarioWith ScenarioPath
-> [ScenarioWith ScenarioPath]
-> NonEmpty (ScenarioWith ScenarioPath)
forall a. a -> [a] -> NonEmpty a
:| [ScenarioWith ScenarioPath]
remaining) Maybe CodeToRun
forall a. Maybe a
Nothing
      SICollection Text
_ ScenarioCollection ScenarioPath
c -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name (ScenarioItem ScenarioPath)) -> Menu
NewGameMenu (List Name (ScenarioItem ScenarioPath)
-> NonEmpty (List Name (ScenarioItem ScenarioPath))
-> NonEmpty (List Name (ScenarioItem ScenarioPath))
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (ScenarioCollection ScenarioPath
-> List Name (ScenarioItem ScenarioPath)
forall a. ScenarioCollection a -> List Name (ScenarioItem a)
mkScenarioList ScenarioCollection ScenarioPath
c) NonEmpty (List Name (ScenarioItem ScenarioPath))
scenarioStack)
  CharKey Char
'o' -> EventM Name AppState ()
showLaunchDialog
  CharKey Char
'O' -> EventM Name AppState ()
showLaunchDialog
  Key Key
V.KEsc -> NonEmpty (List Name (ScenarioItem ScenarioPath))
-> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name (ScenarioItem ScenarioPath))
scenarioStack
  CharKey Char
'q' -> NonEmpty (List Name (ScenarioItem ScenarioPath))
-> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name (ScenarioItem ScenarioPath))
scenarioStack
  ControlChar Char
'q' -> EventM Name AppState ()
haltApp
  VtyEvent Event
ev -> do
    List Name (ScenarioItem ScenarioPath)
menu' <- List Name (ScenarioItem ScenarioPath)
-> EventM Name (List Name (ScenarioItem ScenarioPath)) ()
-> EventM Name AppState (List Name (ScenarioItem ScenarioPath))
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name (ScenarioItem ScenarioPath)
curMenu (Event -> EventM Name (List Name (ScenarioItem ScenarioPath)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name (ScenarioItem ScenarioPath)) -> Menu
NewGameMenu (List Name (ScenarioItem ScenarioPath)
menu' List Name (ScenarioItem ScenarioPath)
-> [List Name (ScenarioItem ScenarioPath)]
-> NonEmpty (List Name (ScenarioItem ScenarioPath))
forall a. a -> [a] -> NonEmpty a
:| [List Name (ScenarioItem ScenarioPath)]
rest)
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  showLaunchDialog :: EventM Name AppState ()
showLaunchDialog = case (Int, ScenarioItem ScenarioPath) -> ScenarioItem ScenarioPath
forall a b. (a, b) -> b
snd ((Int, ScenarioItem ScenarioPath) -> ScenarioItem ScenarioPath)
-> Maybe (Int, ScenarioItem ScenarioPath)
-> Maybe (ScenarioItem ScenarioPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List Name (ScenarioItem ScenarioPath)
-> Maybe (Int, ScenarioItem ScenarioPath)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name (ScenarioItem ScenarioPath)
curMenu of
    Just (SISingle (ScenarioWith Scenario
s (ScenarioPath String
p))) -> do
      ScenarioCollection ScenarioInfo
ss <- Getting
  (ScenarioCollection ScenarioInfo)
  AppState
  (ScenarioCollection ScenarioInfo)
-> EventM Name AppState (ScenarioCollection ScenarioInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (ScenarioCollection ScenarioInfo)
   AppState
   (ScenarioCollection ScenarioInfo)
 -> EventM Name AppState (ScenarioCollection ScenarioInfo))
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
-> EventM Name AppState (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> AppState -> Const (ScenarioCollection ScenarioInfo) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
 -> AppState -> Const (ScenarioCollection ScenarioInfo) AppState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
 -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> ProgressionState
    -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> (ScenarioCollection ScenarioInfo
    -> Const
         (ScenarioCollection ScenarioInfo)
         (ScenarioCollection ScenarioInfo))
-> PlayState
-> Const (ScenarioCollection ScenarioInfo) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> Const
      (ScenarioCollection ScenarioInfo)
      (ScenarioCollection ScenarioInfo))
-> ProgressionState
-> Const (ScenarioCollection ScenarioInfo) ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios
      let si :: ScenarioInfo
si = ScenarioCollection ScenarioInfo -> String -> ScenarioInfo
getScenarioInfoFromPath ScenarioCollection ScenarioInfo
ss String
p
      LensLike'
  (Zoomed (EventM Name LaunchOptions) ()) AppState LaunchOptions
-> EventM Name LaunchOptions () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name LaunchOptions) c) AppState LaunchOptions
-> EventM Name LaunchOptions c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState UIState
uiState ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((LaunchOptions
     -> Focusing (StateT (EventState Name) IO) () LaunchOptions)
    -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> (LaunchOptions
    -> Focusing (StateT (EventState Name) IO) () LaunchOptions)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchOptions
 -> Focusing (StateT (EventState Name) IO) () LaunchOptions)
-> UIState -> Focusing (StateT (EventState Name) IO) () UIState
Lens' UIState LaunchOptions
uiLaunchConfig) (EventM Name LaunchOptions () -> EventM Name AppState ())
-> EventM Name LaunchOptions () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ ScenarioWith ScenarioInfo -> EventM Name LaunchOptions ()
prepareLaunchDialog (ScenarioWith ScenarioInfo -> EventM Name LaunchOptions ())
-> ScenarioWith ScenarioInfo -> EventM Name LaunchOptions ()
forall a b. (a -> b) -> a -> b
$ Scenario -> ScenarioInfo -> ScenarioWith ScenarioInfo
forall a. Scenario -> a -> ScenarioWith a
ScenarioWith Scenario
s ScenarioInfo
si
    Maybe (ScenarioItem ScenarioPath)
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

exitNewGameMenu ::
  NonEmpty (BL.List Name (ScenarioItem ScenarioPath)) ->
  EventM Name AppState ()
exitNewGameMenu :: NonEmpty (List Name (ScenarioItem ScenarioPath))
-> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name (ScenarioItem ScenarioPath))
stk =
  (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState
    ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu
    ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case (List Name (ScenarioItem ScenarioPath),
 Maybe (NonEmpty (List Name (ScenarioItem ScenarioPath))))
-> Maybe (NonEmpty (List Name (ScenarioItem ScenarioPath)))
forall a b. (a, b) -> b
snd (NonEmpty (List Name (ScenarioItem ScenarioPath))
-> (List Name (ScenarioItem ScenarioPath),
    Maybe (NonEmpty (List Name (ScenarioItem ScenarioPath))))
forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons NonEmpty (List Name (ScenarioItem ScenarioPath))
stk) of
      Maybe (NonEmpty (List Name (ScenarioItem ScenarioPath)))
Nothing -> List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
NewGame)
      Just NonEmpty (List Name (ScenarioItem ScenarioPath))
stk' -> NonEmpty (List Name (ScenarioItem ScenarioPath)) -> Menu
NewGameMenu NonEmpty (List Name (ScenarioItem ScenarioPath))
stk'

pressAnyKey :: Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey :: Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey Menu
m (VtyEvent (V.EvKey Key
_ [Modifier]
_)) = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
m
pressAnyKey Menu
_ BrickEvent Name AppEvent
_ = () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | The top-level event handler while we are running the game itself.
handleMainEvent :: Bool -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent :: Bool -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent Bool
forceRedraw BrickEvent Name AppEvent
ev = do
  AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
  let keyHandler :: KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler = AppState
s AppState
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
-> KeyDispatcher SwarmEvent (EventM Name AppState)
forall s a. s -> Getting a s a -> a
^. (KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> AppState
-> Const (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       KeyEventHandlingState)
 -> AppState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> KeyEventHandlingState
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         KeyEventHandlingState)
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      SwarmKeyDispatchers)
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
Lens' KeyEventHandlingState SwarmKeyDispatchers
keyDispatchers ((SwarmKeyDispatchers
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       SwarmKeyDispatchers)
 -> KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> SwarmKeyDispatchers
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         SwarmKeyDispatchers)
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> KeyDispatcher SwarmEvent (EventM Name AppState))
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> SwarmKeyDispatchers
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     SwarmKeyDispatchers
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SwarmKeyDispatchers
-> KeyDispatcher SwarmEvent (EventM Name AppState)
mainGameDispatcher
  case BrickEvent Name AppEvent
ev of
    AppEvent AppEvent
ae -> case AppEvent
ae of
      -- If the game is paused, don't run any game ticks, but do redraw if needed.
      AppEvent
Frame ->
        if AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (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
. (TemporalState -> Const Bool TemporalState)
-> GameState -> Const Bool GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const Bool TemporalState)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> TemporalState -> Const Bool TemporalState)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> TemporalState -> Const Bool TemporalState
Getter TemporalState Bool
paused
          then Bool -> EventM Name AppState ()
updateAndRedrawUI Bool
forceRedraw
          else Bool -> EventM Name AppState ()
runFrameUI Bool
forceRedraw
      Web (RunWebCode Text
e WebInvocationState -> IO ()
r) -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> AppState -> Zoomed (EventM Name ScenarioState) () AppState
Lens' AppState PlayState
playState ((PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
 -> AppState -> Zoomed (EventM Name ScenarioState) () AppState)
-> ((ScenarioState
     -> Zoomed (EventM Name ScenarioState) () ScenarioState)
    -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> LensLike'
     (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ Text
-> (WebInvocationState -> IO ()) -> EventM Name ScenarioState ()
forall (m :: * -> *).
(MonadState ScenarioState m, MonadIO m) =>
Text -> (WebInvocationState -> IO ()) -> m ()
runBaseWebCode Text
e WebInvocationState -> IO ()
r
      -- UpstreamVersion event should already be handled by top-level handler, so
      -- in theory this case cannot happen.
      UpstreamVersion Either (Severity, Text) String
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      -- PopupEvent event should already be handled by top-level handler, so this shouldn't happen.
      PopupEvent EventM Name AppState ()
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    VtyEvent (V.EvResize Int
_ Int
_) -> EventM Name AppState ()
forall n s. Ord n => EventM n s ()
invalidateCache
    BrickEvent Name AppEvent
EscapeKey
      | Just Modal
m <- AppState
s AppState
-> Getting (Maybe Modal) AppState (Maybe Modal) -> Maybe Modal
forall s a. s -> Getting a s a -> a
^. (PlayState -> Const (Maybe Modal) PlayState)
-> AppState -> Const (Maybe Modal) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (Maybe Modal) PlayState)
 -> AppState -> Const (Maybe Modal) AppState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> PlayState -> Const (Maybe Modal) PlayState)
-> Getting (Maybe Modal) AppState (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const (Maybe Modal) ScenarioState)
-> PlayState -> Const (Maybe Modal) PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const (Maybe Modal) ScenarioState)
 -> PlayState -> Const (Maybe Modal) PlayState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> PlayState
-> Const (Maybe Modal) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ScenarioState -> Const (Maybe Modal) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> ScenarioState
-> Const (Maybe Modal) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (Maybe Modal) UIDialogs)
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (Maybe Modal) UIDialogs)
 -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIDialogs -> Const (Maybe Modal) UIDialogs)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay
-> Const (Maybe Modal) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIDialogs -> Const (Maybe Modal) UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ->
          LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$
            if AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (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
. (UIGameplay -> Const Bool UIGameplay)
-> ScenarioState -> Const Bool ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> ScenarioState -> Const Bool ScenarioState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> ScenarioState
-> Const Bool ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const Bool UIDialogs)
-> UIGameplay -> Const Bool UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const Bool UIDialogs)
 -> UIGameplay -> Const Bool UIGameplay)
-> ((Bool -> Const Bool Bool) -> UIDialogs -> Const Bool UIDialogs)
-> (Bool -> Const Bool Bool)
-> UIGameplay
-> Const Bool UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RobotDisplay -> Const Bool RobotDisplay)
-> UIDialogs -> Const Bool UIDialogs
Lens' UIDialogs RobotDisplay
uiRobot ((RobotDisplay -> Const Bool RobotDisplay)
 -> UIDialogs -> Const Bool UIDialogs)
-> ((Bool -> Const Bool Bool)
    -> RobotDisplay -> Const Bool RobotDisplay)
-> (Bool -> Const Bool Bool)
-> UIDialogs
-> Const Bool UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> RobotDisplay -> Const Bool RobotDisplay
Lens' RobotDisplay Bool
isDetailsOpened
              then (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((Bool -> Identity Bool) -> UIDialogs -> Identity UIDialogs)
-> (Bool -> Identity Bool)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RobotDisplay -> Identity RobotDisplay)
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs RobotDisplay
uiRobot ((RobotDisplay -> Identity RobotDisplay)
 -> UIDialogs -> Identity UIDialogs)
-> ((Bool -> Identity Bool)
    -> RobotDisplay -> Identity RobotDisplay)
-> (Bool -> Identity Bool)
-> UIDialogs
-> Identity UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> RobotDisplay -> Identity RobotDisplay
Lens' RobotDisplay Bool
isDetailsOpened ((Bool -> Identity Bool)
 -> ScenarioState -> Identity ScenarioState)
-> Bool -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
              else Modal -> EventM Name ScenarioState ()
closeModal Modal
m
    -- Pass to key handler (allows users to configure bindings)
    -- See Note [how Swarm event handlers work]
    VtyEvent (V.EvKey Key
k [Modifier]
m)
      | Maybe (KeyHandler SwarmEvent (EventM Name AppState)) -> Bool
forall a. Maybe a -> Bool
isJust (Key
-> [Modifier]
-> KeyDispatcher SwarmEvent (EventM Name AppState)
-> Maybe (KeyHandler SwarmEvent (EventM Name AppState))
forall k (m :: * -> *).
Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
B.lookupVtyEvent Key
k [Modifier]
m KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler) -> EventM Name AppState Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM Name AppState Bool -> EventM Name AppState ())
-> EventM Name AppState Bool -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ KeyDispatcher SwarmEvent (EventM Name AppState)
-> Key -> [Modifier] -> EventM Name AppState Bool
forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
B.handleKey KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler Key
k [Modifier]
m
    -- pass keys on to modal event handler if a modal is open
    VtyEvent Event
vev
      | Maybe Modal -> Bool
forall a. Maybe a -> Bool
isJust (AppState
s AppState
-> Getting (Maybe Modal) AppState (Maybe Modal) -> Maybe Modal
forall s a. s -> Getting a s a -> a
^. (PlayState -> Const (Maybe Modal) PlayState)
-> AppState -> Const (Maybe Modal) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (Maybe Modal) PlayState)
 -> AppState -> Const (Maybe Modal) AppState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> PlayState -> Const (Maybe Modal) PlayState)
-> Getting (Maybe Modal) AppState (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const (Maybe Modal) ScenarioState)
-> PlayState -> Const (Maybe Modal) PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const (Maybe Modal) ScenarioState)
 -> PlayState -> Const (Maybe Modal) PlayState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> PlayState
-> Const (Maybe Modal) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ScenarioState -> Const (Maybe Modal) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> ScenarioState -> Const (Maybe Modal) ScenarioState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> ScenarioState
-> Const (Maybe Modal) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (Maybe Modal) UIDialogs)
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (Maybe Modal) UIDialogs)
 -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIDialogs -> Const (Maybe Modal) UIDialogs)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay
-> Const (Maybe Modal) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIDialogs -> Const (Maybe Modal) UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal) -> Event -> EventM Name AppState ()
handleModalEvent Event
vev
    MouseDown (TerrainListItem Int
pos) Button
V.BLeft [Modifier]
_ Location
_ ->
      (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((List Name TerrainType -> Identity (List Name TerrainType))
    -> PlayState -> Identity PlayState)
-> (List Name TerrainType -> Identity (List Name TerrainType))
-> 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)
-> ((List Name TerrainType -> Identity (List Name TerrainType))
    -> ScenarioState -> Identity ScenarioState)
-> (List Name TerrainType -> Identity (List Name TerrainType))
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((List Name TerrainType -> Identity (List Name TerrainType))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name TerrainType -> Identity (List Name TerrainType))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name TerrainType -> Identity (List Name TerrainType))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (List Name TerrainType -> Identity (List Name TerrainType))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name TerrainType -> Identity (List Name TerrainType))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n TerrainType -> f (List n TerrainType))
-> WorldEditor n -> f (WorldEditor n)
terrainList ((List Name TerrainType -> Identity (List Name TerrainType))
 -> AppState -> Identity AppState)
-> (List Name TerrainType -> List Name TerrainType)
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> List Name TerrainType -> List Name TerrainType
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
pos
    MouseDown (EntityPaintListItem Int
pos) Button
V.BLeft [Modifier]
_ Location
_ ->
      (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> PlayState -> Identity PlayState)
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> 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)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> ScenarioState -> Identity ScenarioState)
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name EntityFacade -> Identity (List Name EntityFacade))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList ((List Name EntityFacade -> Identity (List Name EntityFacade))
 -> AppState -> Identity AppState)
-> (List Name EntityFacade -> List Name EntityFacade)
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> List Name EntityFacade -> List Name EntityFacade
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
pos
    MouseDown Name
WorldPositionIndicator Button
_ [Modifier]
_ Location
_ ->
      (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
    -> PlayState -> Identity PlayState)
-> (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> 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)
-> ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
    -> ScenarioState -> Identity ScenarioState)
-> (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe (Cosmic Coords))
uiWorldCursor ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
 -> AppState -> Identity AppState)
-> Maybe (Cosmic Coords) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Cosmic Coords)
forall a. Maybe a
Nothing
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BMiddle [Modifier]
_ Location
mouseLoc ->
      -- Eye Dropper tool
      LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ Location -> EventM Name ScenarioState ()
EC.handleMiddleClick Location
mouseLoc
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BRight [Modifier]
_ Location
mouseLoc ->
      -- Eraser tool
      LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ Location -> EventM Name ScenarioState ()
EC.handleRightClick Location
mouseLoc
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BLeft [Modifier
V.MCtrl] Location
mouseLoc ->
      -- Paint with the World Editor
      LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ Location -> EventM Name ScenarioState ()
EC.handleCtrlLeftClick Location
mouseLoc
    MouseDown Name
n Button
_ [Modifier]
_ Location
mouseLoc ->
      case Name
n of
        FocusablePanel FocusablePanel
WorldPanel -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
          Maybe (Cosmic Coords)
mouseCoordsM <- LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  ScenarioState
  GameState
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
forall c.
LensLike'
  (Zoomed (EventM Name GameState) c) ScenarioState GameState
-> EventM Name GameState c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GameState
 -> Focusing
      (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) GameState)
-> ScenarioState
-> Focusing
     (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) ScenarioState
LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  ScenarioState
  GameState
Lens' ScenarioState GameState
gameState (EventM Name GameState (Maybe (Cosmic Coords))
 -> EventM Name ScenarioState (Maybe (Cosmic Coords)))
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name ScenarioState (Maybe (Cosmic Coords))
forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
          Bool
shouldUpdateCursor <- Maybe (Cosmic Coords) -> EventM Name ScenarioState Bool
EC.updateAreaBounds Maybe (Cosmic Coords)
mouseCoordsM
          Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdateCursor (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$
            (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe (Cosmic Coords))
uiWorldCursor ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
 -> ScenarioState -> Identity ScenarioState)
-> Maybe (Cosmic Coords) -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Cosmic Coords)
mouseCoordsM
        Name
REPLInput -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
ev
        (UIShortcut Text
"Help") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ MidScenarioModalType -> EventM Name ScenarioState ()
toggleMidScenarioModal MidScenarioModalType
HelpModal
        (UIShortcut Text
"Robots") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ MidScenarioModalType -> EventM Name ScenarioState ()
toggleMidScenarioModal MidScenarioModalType
RobotsModal
        (UIShortcut Text
"Commands") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ MidScenarioModalType
-> Lens' Discovery (Notifications Const)
-> EventM Name ScenarioState ()
forall a.
MidScenarioModalType
-> Lens' Discovery (Notifications a)
-> EventM Name ScenarioState ()
toggleDiscoveryNotificationModal MidScenarioModalType
CommandsModal (Notifications Const -> f (Notifications Const))
-> Discovery -> f Discovery
Lens' Discovery (Notifications Const)
availableCommands
        (UIShortcut Text
"Recipes") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ MidScenarioModalType
-> Lens' Discovery (Notifications (Recipe Entity))
-> EventM Name ScenarioState ()
forall a.
MidScenarioModalType
-> Lens' Discovery (Notifications a)
-> EventM Name ScenarioState ()
toggleDiscoveryNotificationModal MidScenarioModalType
RecipesModal (Notifications (Recipe Entity)
 -> f (Notifications (Recipe Entity)))
-> Discovery -> f Discovery
Lens' Discovery (Notifications (Recipe Entity))
availableRecipes
        (UIShortcut Text
"Messages") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) EventM Name ScenarioState ()
toggleMessagesModal
        (UIShortcut Text
"pause") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ EventM Name ScenarioState () -> EventM Name ScenarioState ()
whenRunningPlayState EventM Name ScenarioState ()
safeTogglePause
        (UIShortcut Text
"unpause") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ EventM Name ScenarioState () -> EventM Name ScenarioState ()
whenRunningPlayState EventM Name ScenarioState ()
safeTogglePause
        (UIShortcut Text
"step") -> EventM Name AppState () -> EventM Name AppState ()
whenRunningAppState EventM Name AppState ()
runSingleTick
        (UIShortcut Text
"speed-up") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ EventM Name ScenarioState () -> EventM Name ScenarioState ()
whenRunningPlayState (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> ((ScenarioState -> ScenarioState)
    -> EventM Name ScenarioState ())
-> (ScenarioState -> ScenarioState)
-> EventM Name ScenarioState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScenarioState -> ScenarioState) -> EventM Name ScenarioState ())
-> (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> ScenarioState -> ScenarioState
adjustTPS Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
        (UIShortcut Text
"speed-down") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ EventM Name ScenarioState () -> EventM Name ScenarioState ()
whenRunningPlayState (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> ((ScenarioState -> ScenarioState)
    -> EventM Name ScenarioState ())
-> (ScenarioState -> ScenarioState)
-> EventM Name ScenarioState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScenarioState -> ScenarioState) -> EventM Name ScenarioState ())
-> (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> ScenarioState -> ScenarioState
adjustTPS (-)
        (UIShortcut Text
"hide REPL") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) EventM Name ScenarioState ()
toggleREPLVisibility
        (UIShortcut Text
"show REPL") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) EventM Name ScenarioState ()
toggleREPLVisibility
        (UIShortcut Text
"debug") -> EventM Name AppState ()
showCESKDebug
        (UIShortcut Text
"hide robots") -> LensLike' (Zoomed (EventM Name UIGameplay) ()) AppState UIGameplay
-> EventM Name UIGameplay () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name UIGameplay) c) AppState UIGameplay
-> EventM Name UIGameplay c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((UIGameplay
     -> Focusing (StateT (EventState Name) IO) () UIGameplay)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState
  -> Focusing (StateT (EventState Name) IO) () ScenarioState)
 -> PlayState
 -> Focusing (StateT (EventState Name) IO) () PlayState)
-> ((UIGameplay
     -> Focusing (StateT (EventState Name) IO) () UIGameplay)
    -> ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> (UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> PlayState
-> Focusing (StateT (EventState Name) IO) () PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay) EventM Name UIGameplay ()
hideRobots
        (UIShortcut Text
"goal") -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) EventM Name ScenarioState ()
viewGoal
        Name
_ -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
    MouseUp Name
n Maybe Button
_ Location
_mouseLoc ->
      LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
        case Name
n of
          InventoryListItem Int
pos -> (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory -> Identity UIInventory)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Identity UIInventory)
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> UIInventory -> Identity UIInventory)
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Int, List Name InventoryListEntry)
 -> Identity (Maybe (Int, List Name InventoryListEntry)))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe (Int, List Name InventoryListEntry))
uiInventoryList ((Maybe (Int, List Name InventoryListEntry)
  -> Identity (Maybe (Int, List Name InventoryListEntry)))
 -> UIInventory -> Identity UIInventory)
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> Maybe (Int, List Name InventoryListEntry)
    -> Identity (Maybe (Int, List Name InventoryListEntry)))
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> UIInventory
-> Identity UIInventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, List Name InventoryListEntry)
 -> Identity (Int, List Name InventoryListEntry))
-> Maybe (Int, List Name InventoryListEntry)
-> Identity (Maybe (Int, List Name InventoryListEntry))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (((Int, List Name InventoryListEntry)
  -> Identity (Int, List Name InventoryListEntry))
 -> Maybe (Int, List Name InventoryListEntry)
 -> Identity (Maybe (Int, List Name InventoryListEntry)))
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> (Int, List Name InventoryListEntry)
    -> Identity (Int, List Name InventoryListEntry))
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> Maybe (Int, List Name InventoryListEntry)
-> Identity (Maybe (Int, List Name InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name InventoryListEntry
 -> Identity (List Name InventoryListEntry))
-> (Int, List Name InventoryListEntry)
-> Identity (Int, List Name InventoryListEntry)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Int, List Name InventoryListEntry)
  (Int, List Name InventoryListEntry)
  (List Name InventoryListEntry)
  (List Name InventoryListEntry)
_2 ((List Name InventoryListEntry
  -> Identity (List Name InventoryListEntry))
 -> ScenarioState -> Identity ScenarioState)
-> (List Name InventoryListEntry -> List Name InventoryListEntry)
-> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> List Name InventoryListEntry -> List Name InventoryListEntry
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
pos
          x :: Name
x@(WorldEditorPanelControl WorldEditorFocusable
y) -> do
            (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n))
-> WorldEditor n -> f (WorldEditor n)
editorFocusRing ((FocusRing Name -> Identity (FocusRing Name))
 -> ScenarioState -> Identity ScenarioState)
-> (FocusRing Name -> FocusRing Name)
-> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Name -> FocusRing Name -> FocusRing Name
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent Name
x
            WorldEditorFocusable -> EventM Name ScenarioState ()
EC.activateWorldEditorFunction WorldEditorFocusable
y
          Name
_ -> () -> EventM Name ScenarioState ()
forall a. a -> EventM Name ScenarioState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (Maybe FocusablePanel
 -> (FocusablePanel -> EventM Name ScenarioState ())
 -> EventM Name ScenarioState ())
-> (FocusablePanel -> EventM Name ScenarioState ())
-> Maybe FocusablePanel
-> EventM Name ScenarioState ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe FocusablePanel
-> (FocusablePanel -> EventM Name ScenarioState ())
-> EventM Name ScenarioState ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust FocusablePanel -> EventM Name ScenarioState ()
setFocus (Maybe FocusablePanel -> EventM Name ScenarioState ())
-> Maybe FocusablePanel -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ case Name
n of
          -- Adapt click event origin to the right panel.  For the world
          -- view, we just use 'Brick.Widgets.Core.clickable'.  However,
          -- the other panels all have a viewport, requiring us to
          -- explicitly set their focus here.
          Name
InventoryList -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
RobotPanel
          InventoryListItem Int
_ -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
RobotPanel
          Name
InfoViewport -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
InfoPanel
          Name
REPLViewport -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
REPLPanel
          Name
REPLInput -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
REPLPanel
          WorldEditorPanelControl WorldEditorFocusable
_ -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
WorldEditorPanel
          Name
_ -> Maybe FocusablePanel
forall a. Maybe a
Nothing
        case Name
n of
          FocusablePanel FocusablePanel
x -> FocusablePanel -> EventM Name ScenarioState ()
setFocus FocusablePanel
x
          Name
_ -> () -> EventM Name ScenarioState ()
forall a. a -> EventM Name ScenarioState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    -- dispatch any other events to the focused panel handler
    BrickEvent Name AppEvent
_ev -> do
      FocusRing Name
fring <- Getting (FocusRing Name) AppState (FocusRing Name)
-> EventM Name AppState (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (FocusRing Name) AppState (FocusRing Name)
 -> EventM Name AppState (FocusRing Name))
-> Getting (FocusRing Name) AppState (FocusRing Name)
-> EventM Name AppState (FocusRing Name)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (FocusRing Name) PlayState)
-> AppState -> Const (FocusRing Name) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (FocusRing Name) PlayState)
 -> AppState -> Const (FocusRing Name) AppState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> PlayState -> Const (FocusRing Name) PlayState)
-> Getting (FocusRing Name) AppState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const (FocusRing Name) ScenarioState)
-> PlayState -> Const (FocusRing Name) PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const (FocusRing Name) ScenarioState)
 -> PlayState -> Const (FocusRing Name) PlayState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> PlayState
-> Const (FocusRing Name) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ScenarioState -> Const (FocusRing Name) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> ScenarioState
-> Const (FocusRing Name) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay (FocusRing Name)
uiFocusRing
      case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fring of
        Just (FocusablePanel FocusablePanel
x) -> case FocusablePanel
x of
          FocusablePanel
REPLPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
ev
          -- Pass to key handler (allows users to configure bindings)
          -- See Note [how Swarm event handlers work]
          FocusablePanel
WorldPanel | VtyEvent (V.EvKey Key
k [Modifier]
m) <- BrickEvent Name AppEvent
ev -> do
            KeyDispatcher SwarmEvent (EventM Name AppState)
wh <- Getting
  (KeyDispatcher SwarmEvent (EventM Name AppState))
  AppState
  (KeyDispatcher SwarmEvent (EventM Name AppState))
-> EventM
     Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (KeyDispatcher SwarmEvent (EventM Name AppState))
   AppState
   (KeyDispatcher SwarmEvent (EventM Name AppState))
 -> EventM
      Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
-> EventM
     Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState))
forall a b. (a -> b) -> a -> b
$ (KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> AppState
-> Const (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       KeyEventHandlingState)
 -> AppState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> KeyEventHandlingState
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         KeyEventHandlingState)
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      SwarmKeyDispatchers)
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
Lens' KeyEventHandlingState SwarmKeyDispatchers
keyDispatchers ((SwarmKeyDispatchers
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       SwarmKeyDispatchers)
 -> KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> SwarmKeyDispatchers
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         SwarmKeyDispatchers)
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> KeyDispatcher SwarmEvent (EventM Name AppState))
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> SwarmKeyDispatchers
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     SwarmKeyDispatchers
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SwarmKeyDispatchers
-> KeyDispatcher SwarmEvent (EventM Name AppState)
worldDispatcher
            EventM Name AppState Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM Name AppState Bool -> EventM Name AppState ())
-> EventM Name AppState Bool -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ KeyDispatcher SwarmEvent (EventM Name AppState)
-> Key -> [Modifier] -> EventM Name AppState Bool
forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
B.handleKey KeyDispatcher SwarmEvent (EventM Name AppState)
wh Key
k [Modifier]
m
          FocusablePanel
WorldPanel | Bool
otherwise -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
          FocusablePanel
WorldEditorPanel -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent Name AppEvent -> EventM Name ScenarioState ()
EC.handleWorldEditorPanelEvent BrickEvent Name AppEvent
ev
          FocusablePanel
RobotPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent BrickEvent Name AppEvent
ev
          FocusablePanel
InfoPanel -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
forall s.
ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name s ()
handleInfoPanelEvent ViewportScroll Name
infoScroll BrickEvent Name AppEvent
ev
        Maybe Name
_ -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw

closeModal :: Modal -> EventM Name ScenarioState ()
closeModal :: Modal -> EventM Name ScenarioState ()
closeModal Modal
m = do
  EventM Name ScenarioState ()
safeAutoUnpause
  (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Modal -> Identity (Maybe Modal))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIDialogs -> Identity UIDialogs)
-> (Maybe Modal -> Identity (Maybe Modal))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Identity (Maybe Modal))
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ((Maybe Modal -> Identity (Maybe Modal))
 -> ScenarioState -> Identity ScenarioState)
-> Maybe Modal -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Modal
forall a. Maybe a
Nothing
  -- message modal is not autopaused, so update notifications when leaving it
  Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Modal
m Modal -> Getting ModalType Modal ModalType -> ModalType
forall s a. s -> Getting a s a -> a
^. Getting ModalType Modal ModalType
Lens' Modal ModalType
modalType ModalType -> ModalType -> Bool
forall a. Eq a => a -> a -> Bool
== MidScenarioModalType -> ModalType
MidScenarioModal MidScenarioModalType
MessagesModal) (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    TickNumber
t <- Getting TickNumber ScenarioState TickNumber
-> EventM Name ScenarioState TickNumber
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting TickNumber ScenarioState TickNumber
 -> EventM Name ScenarioState TickNumber)
-> Getting TickNumber ScenarioState TickNumber
-> EventM Name ScenarioState TickNumber
forall a b. (a -> b) -> a -> b
$ (GameState -> Const TickNumber GameState)
-> ScenarioState -> Const TickNumber ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const TickNumber GameState)
 -> ScenarioState -> Const TickNumber ScenarioState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> GameState -> Const TickNumber GameState)
-> Getting TickNumber ScenarioState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> (TickNumber -> Const TickNumber TickNumber)
-> GameState
-> Const TickNumber GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks
    (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((TickNumber -> Identity TickNumber)
    -> GameState -> Identity GameState)
-> (TickNumber -> Identity TickNumber)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Messages -> Identity Messages) -> GameState -> Identity GameState
Lens' GameState Messages
messageInfo ((Messages -> Identity Messages)
 -> GameState -> Identity GameState)
-> ((TickNumber -> Identity TickNumber)
    -> Messages -> Identity Messages)
-> (TickNumber -> Identity TickNumber)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Identity TickNumber)
-> Messages -> Identity Messages
Lens' Messages TickNumber
lastSeenMessageTime ((TickNumber -> Identity TickNumber)
 -> ScenarioState -> Identity ScenarioState)
-> TickNumber -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TickNumber
t

-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleModalEvent :: V.Event -> EventM Name AppState ()
handleModalEvent :: Event -> EventM Name AppState ()
handleModalEvent = \case
  V.EvKey Key
V.KEnter [] -> do
    Maybe ModalType
modal <- Getting (First ModalType) AppState ModalType
-> EventM Name AppState (Maybe ModalType)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting (First ModalType) AppState ModalType
 -> EventM Name AppState (Maybe ModalType))
-> Getting (First ModalType) AppState ModalType
-> EventM Name AppState (Maybe ModalType)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (First ModalType) PlayState)
-> AppState -> Const (First ModalType) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (First ModalType) PlayState)
 -> AppState -> Const (First ModalType) AppState)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> PlayState -> Const (First ModalType) PlayState)
-> Getting (First ModalType) AppState ModalType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const (First ModalType) ScenarioState)
-> PlayState -> Const (First ModalType) PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const (First ModalType) ScenarioState)
 -> PlayState -> Const (First ModalType) PlayState)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> ScenarioState -> Const (First ModalType) ScenarioState)
-> (ModalType -> Const (First ModalType) ModalType)
-> PlayState
-> Const (First ModalType) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (First ModalType) UIGameplay)
-> ScenarioState -> Const (First ModalType) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (First ModalType) UIGameplay)
 -> ScenarioState -> Const (First ModalType) ScenarioState)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> UIGameplay -> Const (First ModalType) UIGameplay)
-> (ModalType -> Const (First ModalType) ModalType)
-> ScenarioState
-> Const (First ModalType) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (First ModalType) UIDialogs)
-> UIGameplay -> Const (First ModalType) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (First ModalType) UIDialogs)
 -> UIGameplay -> Const (First ModalType) UIGameplay)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> UIDialogs -> Const (First ModalType) UIDialogs)
-> (ModalType -> Const (First ModalType) ModalType)
-> UIGameplay
-> Const (First ModalType) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> UIDialogs -> Const (First ModalType) UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ((Maybe Modal -> Const (First ModalType) (Maybe Modal))
 -> UIDialogs -> Const (First ModalType) UIDialogs)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> (ModalType -> Const (First ModalType) ModalType)
-> UIDialogs
-> Const (First ModalType) UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modal -> Const (First ModalType) Modal)
-> Maybe Modal -> Const (First ModalType) (Maybe Modal)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Modal -> Const (First ModalType) Modal)
 -> Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> ((ModalType -> Const (First ModalType) ModalType)
    -> Modal -> Const (First ModalType) Modal)
-> (ModalType -> Const (First ModalType) ModalType)
-> Maybe Modal
-> Const (First ModalType) (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModalType -> Const (First ModalType) ModalType)
-> Modal -> Const (First ModalType) Modal
Lens' Modal ModalType
modalType
    case Maybe ModalType
modal of
      Just (MidScenarioModal MidScenarioModalType
RobotsModal) -> do
        RobotDisplay
robotDialog <- Getting RobotDisplay AppState RobotDisplay
-> EventM Name AppState RobotDisplay
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting RobotDisplay AppState RobotDisplay
 -> EventM Name AppState RobotDisplay)
-> Getting RobotDisplay AppState RobotDisplay
-> EventM Name AppState RobotDisplay
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const RobotDisplay PlayState)
-> AppState -> Const RobotDisplay AppState
Lens' AppState PlayState
playState ((PlayState -> Const RobotDisplay PlayState)
 -> AppState -> Const RobotDisplay AppState)
-> ((RobotDisplay -> Const RobotDisplay RobotDisplay)
    -> PlayState -> Const RobotDisplay PlayState)
-> Getting RobotDisplay AppState RobotDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const RobotDisplay ScenarioState)
-> PlayState -> Const RobotDisplay PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const RobotDisplay ScenarioState)
 -> PlayState -> Const RobotDisplay PlayState)
-> ((RobotDisplay -> Const RobotDisplay RobotDisplay)
    -> ScenarioState -> Const RobotDisplay ScenarioState)
-> (RobotDisplay -> Const RobotDisplay RobotDisplay)
-> PlayState
-> Const RobotDisplay PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const RobotDisplay UIGameplay)
-> ScenarioState -> Const RobotDisplay ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const RobotDisplay UIGameplay)
 -> ScenarioState -> Const RobotDisplay ScenarioState)
-> ((RobotDisplay -> Const RobotDisplay RobotDisplay)
    -> UIGameplay -> Const RobotDisplay UIGameplay)
-> (RobotDisplay -> Const RobotDisplay RobotDisplay)
-> ScenarioState
-> Const RobotDisplay ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const RobotDisplay UIDialogs)
-> UIGameplay -> Const RobotDisplay UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const RobotDisplay UIDialogs)
 -> UIGameplay -> Const RobotDisplay UIGameplay)
-> ((RobotDisplay -> Const RobotDisplay RobotDisplay)
    -> UIDialogs -> Const RobotDisplay UIDialogs)
-> (RobotDisplay -> Const RobotDisplay RobotDisplay)
-> UIGameplay
-> Const RobotDisplay UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RobotDisplay -> Const RobotDisplay RobotDisplay)
-> UIDialogs -> Const RobotDisplay UIDialogs
Lens' UIDialogs RobotDisplay
uiRobot
        Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RobotDisplay
robotDialog RobotDisplay
-> ((Bool -> Const Bool Bool)
    -> RobotDisplay -> Const Bool RobotDisplay)
-> Bool
forall s a. s -> Getting a s a -> a
^. (Bool -> Const Bool Bool)
-> RobotDisplay -> Const Bool RobotDisplay
Lens' RobotDisplay Bool
isDetailsOpened) (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
          GameState
g <- Getting GameState AppState GameState
-> EventM Name AppState GameState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting GameState AppState GameState
 -> EventM Name AppState GameState)
-> Getting GameState AppState GameState
-> EventM Name AppState GameState
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const GameState PlayState)
-> AppState -> Const GameState AppState
Lens' AppState PlayState
playState ((PlayState -> Const GameState PlayState)
 -> AppState -> Const GameState AppState)
-> ((GameState -> Const GameState GameState)
    -> PlayState -> Const GameState PlayState)
-> Getting GameState AppState GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const GameState ScenarioState)
-> PlayState -> Const GameState PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const GameState ScenarioState)
 -> PlayState -> Const GameState PlayState)
-> ((GameState -> Const GameState GameState)
    -> ScenarioState -> Const GameState ScenarioState)
-> (GameState -> Const GameState GameState)
-> PlayState
-> Const GameState PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const GameState GameState)
-> ScenarioState -> Const GameState ScenarioState
Lens' ScenarioState GameState
gameState
          let widget :: GridTabularList Name Int
widget = RobotDisplay
robotDialog RobotDisplay
-> Getting
     (GridTabularList Name Int) RobotDisplay (GridTabularList Name Int)
-> GridTabularList Name Int
forall s a. s -> Getting a s a -> a
^. Getting
  (GridTabularList Name Int) RobotDisplay (GridTabularList Name Int)
Lens' RobotDisplay (GridTabularList Name Int)
robotsGridList
          Maybe Robot
-> (Robot -> EventM Name AppState ()) -> EventM Name AppState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (GameState -> GridTabularList Name Int -> Maybe Robot
getSelectedRobot GameState
g GridTabularList Name Int
widget) ((Robot -> EventM Name AppState ()) -> EventM Name AppState ())
-> (Robot -> EventM Name AppState ()) -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ \Robot
rob -> LensLike'
  (Zoomed (EventM Name RobotDisplay) ()) AppState RobotDisplay
-> EventM Name RobotDisplay () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name RobotDisplay) c) AppState RobotDisplay
-> EventM Name RobotDisplay c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Zoomed (EventM Name RobotDisplay) () PlayState)
-> AppState -> Zoomed (EventM Name RobotDisplay) () AppState
Lens' AppState PlayState
playState ((PlayState -> Zoomed (EventM Name RobotDisplay) () PlayState)
 -> AppState -> Zoomed (EventM Name RobotDisplay) () AppState)
-> ((RobotDisplay
     -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
    -> PlayState -> Zoomed (EventM Name RobotDisplay) () PlayState)
-> LensLike'
     (Zoomed (EventM Name RobotDisplay) ()) AppState RobotDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Zoomed (EventM Name RobotDisplay) () ScenarioState)
-> PlayState -> Zoomed (EventM Name RobotDisplay) () PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState
  -> Zoomed (EventM Name RobotDisplay) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name RobotDisplay) () PlayState)
-> ((RobotDisplay
     -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
    -> ScenarioState
    -> Zoomed (EventM Name RobotDisplay) () ScenarioState)
-> (RobotDisplay
    -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
-> PlayState
-> Zoomed (EventM Name RobotDisplay) () PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay)
-> ScenarioState
-> Zoomed (EventM Name RobotDisplay) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay)
 -> ScenarioState
 -> Zoomed (EventM Name RobotDisplay) () ScenarioState)
-> ((RobotDisplay
     -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
    -> UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay)
-> (RobotDisplay
    -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
-> ScenarioState
-> Zoomed (EventM Name RobotDisplay) () ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Zoomed (EventM Name RobotDisplay) () UIDialogs)
-> UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Zoomed (EventM Name RobotDisplay) () UIDialogs)
 -> UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay)
-> ((RobotDisplay
     -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
    -> UIDialogs -> Zoomed (EventM Name RobotDisplay) () UIDialogs)
-> (RobotDisplay
    -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
-> UIGameplay
-> Zoomed (EventM Name RobotDisplay) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RobotDisplay -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
-> UIDialogs -> Zoomed (EventM Name RobotDisplay) () UIDialogs
Lens' UIDialogs RobotDisplay
uiRobot) (EventM Name RobotDisplay () -> EventM Name AppState ())
-> EventM Name RobotDisplay () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
            (Bool -> Identity Bool) -> RobotDisplay -> Identity RobotDisplay
Lens' RobotDisplay Bool
isDetailsOpened ((Bool -> Identity Bool) -> RobotDisplay -> Identity RobotDisplay)
-> Bool -> EventM Name RobotDisplay ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
            LensLike'
  (Zoomed (EventM Name RobotDetailsPaneState) ())
  RobotDisplay
  RobotDetailsPaneState
-> EventM Name RobotDetailsPaneState ()
-> EventM Name RobotDisplay ()
forall c.
LensLike'
  (Zoomed (EventM Name RobotDetailsPaneState) c)
  RobotDisplay
  RobotDetailsPaneState
-> EventM Name RobotDetailsPaneState c
-> EventM Name RobotDisplay c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (RobotDetailsPaneState
 -> Focusing (StateT (EventState Name) IO) () RobotDetailsPaneState)
-> RobotDisplay
-> Focusing (StateT (EventState Name) IO) () RobotDisplay
LensLike'
  (Zoomed (EventM Name RobotDetailsPaneState) ())
  RobotDisplay
  RobotDetailsPaneState
Lens' RobotDisplay RobotDetailsPaneState
robotDetailsPaneState (EventM Name RobotDetailsPaneState ()
 -> EventM Name RobotDisplay ())
-> EventM Name RobotDetailsPaneState ()
-> EventM Name RobotDisplay ()
forall a b. (a -> b) -> a -> b
$ Robot -> EventM Name RobotDetailsPaneState ()
updateRobotDetailsPane Robot
rob
      Maybe ModalType
_ -> do
        Menu
menu <- Getting Menu AppState Menu -> EventM Name AppState Menu
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Menu AppState Menu -> EventM Name AppState Menu)
-> Getting Menu AppState Menu -> EventM Name AppState Menu
forall a b. (a -> b) -> a -> b
$ (UIState -> Const Menu UIState) -> AppState -> Const Menu AppState
Lens' AppState UIState
uiState ((UIState -> Const Menu UIState)
 -> AppState -> Const Menu AppState)
-> ((Menu -> Const Menu Menu) -> UIState -> Const Menu UIState)
-> Getting Menu AppState Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Const Menu Menu) -> UIState -> Const Menu UIState
Lens' UIState Menu
uiMenu

        Maybe (Dialog ButtonAction Name)
mdialog <- Getting
  (First (Dialog ButtonAction Name))
  AppState
  (Dialog ButtonAction Name)
-> EventM Name AppState (Maybe (Dialog ButtonAction Name))
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting
   (First (Dialog ButtonAction Name))
   AppState
   (Dialog ButtonAction Name)
 -> EventM Name AppState (Maybe (Dialog ButtonAction Name)))
-> Getting
     (First (Dialog ButtonAction Name))
     AppState
     (Dialog ButtonAction Name)
-> EventM Name AppState (Maybe (Dialog ButtonAction Name))
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (First (Dialog ButtonAction Name)) PlayState)
-> AppState -> Const (First (Dialog ButtonAction Name)) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (First (Dialog ButtonAction Name)) PlayState)
 -> AppState -> Const (First (Dialog ButtonAction Name)) AppState)
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> PlayState -> Const (First (Dialog ButtonAction Name)) PlayState)
-> Getting
     (First (Dialog ButtonAction Name))
     AppState
     (Dialog ButtonAction Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Const (First (Dialog ButtonAction Name)) ScenarioState)
-> PlayState -> Const (First (Dialog ButtonAction Name)) PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState
  -> Const (First (Dialog ButtonAction Name)) ScenarioState)
 -> PlayState -> Const (First (Dialog ButtonAction Name)) PlayState)
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> ScenarioState
    -> Const (First (Dialog ButtonAction Name)) ScenarioState)
-> (Dialog ButtonAction Name
    -> Const
         (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> PlayState
-> Const (First (Dialog ButtonAction Name)) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (First (Dialog ButtonAction Name)) UIGameplay)
-> ScenarioState
-> Const (First (Dialog ButtonAction Name)) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Const (First (Dialog ButtonAction Name)) UIGameplay)
 -> ScenarioState
 -> Const (First (Dialog ButtonAction Name)) ScenarioState)
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> UIGameplay
    -> Const (First (Dialog ButtonAction Name)) UIGameplay)
-> (Dialog ButtonAction Name
    -> Const
         (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> ScenarioState
-> Const (First (Dialog ButtonAction Name)) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (First (Dialog ButtonAction Name)) UIDialogs)
-> UIGameplay
-> Const (First (Dialog ButtonAction Name)) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (First (Dialog ButtonAction Name)) UIDialogs)
 -> UIGameplay
 -> Const (First (Dialog ButtonAction Name)) UIGameplay)
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> UIDialogs -> Const (First (Dialog ButtonAction Name)) UIDialogs)
-> (Dialog ButtonAction Name
    -> Const
         (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> UIGameplay
-> Const (First (Dialog ButtonAction Name)) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal
 -> Const (First (Dialog ButtonAction Name)) (Maybe Modal))
-> UIDialogs -> Const (First (Dialog ButtonAction Name)) UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ((Maybe Modal
  -> Const (First (Dialog ButtonAction Name)) (Maybe Modal))
 -> UIDialogs -> Const (First (Dialog ButtonAction Name)) UIDialogs)
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> Maybe Modal
    -> Const (First (Dialog ButtonAction Name)) (Maybe Modal))
-> (Dialog ButtonAction Name
    -> Const
         (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> UIDialogs
-> Const (First (Dialog ButtonAction Name)) UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modal -> Const (First (Dialog ButtonAction Name)) Modal)
-> Maybe Modal
-> Const (First (Dialog ButtonAction Name)) (Maybe Modal)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Modal -> Const (First (Dialog ButtonAction Name)) Modal)
 -> Maybe Modal
 -> Const (First (Dialog ButtonAction Name)) (Maybe Modal))
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> Modal -> Const (First (Dialog ButtonAction Name)) Modal)
-> (Dialog ButtonAction Name
    -> Const
         (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> Maybe Modal
-> Const (First (Dialog ButtonAction Name)) (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dialog ButtonAction Name
 -> Const
      (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> Modal -> Const (First (Dialog ButtonAction Name)) Modal
Lens' Modal (Dialog ButtonAction Name)
modalDialog
        LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
-> EventM Name PlayState () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name PlayState) c) AppState PlayState
-> EventM Name PlayState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
Lens' AppState PlayState
playState (EventM Name PlayState () -> EventM Name AppState ())
-> EventM Name PlayState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ EndScenarioModalType -> Menu -> EventM Name PlayState ()
toggleEndScenarioModal EndScenarioModalType
QuitModal Menu
menu

        let isNoMenu :: Bool
isNoMenu = case Menu
menu of
              Menu
NoMenu -> Bool
True
              Menu
_ -> Bool
False

        case Dialog ButtonAction Name -> Maybe (Name, ButtonAction)
forall n a. Eq n => Dialog a n -> Maybe (n, a)
dialogSelection (Dialog ButtonAction Name -> Maybe (Name, ButtonAction))
-> Maybe (Dialog ButtonAction Name) -> Maybe (Name, ButtonAction)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Dialog ButtonAction Name)
mdialog of
          Just (Button Button
QuitButton, ButtonAction
_) -> Bool -> EventM Name AppState ()
quitGame Bool
isNoMenu
          Just (Button Button
KeepPlayingButton, ButtonAction
_) -> LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
-> EventM Name PlayState () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name PlayState) c) AppState PlayState
-> EventM Name PlayState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
Lens' AppState PlayState
playState (EventM Name PlayState () -> EventM Name AppState ())
-> EventM Name PlayState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ EndScenarioModalType -> Menu -> EventM Name PlayState ()
toggleEndScenarioModal EndScenarioModalType
KeepPlayingModal Menu
menu
          Just (Button Button
StartOverButton, StartOver Int
currentSeed ScenarioWith ScenarioPath
siPair) -> do
            EventM Name AppState ()
forall n s. Ord n => EventM n s ()
invalidateCache
            Int -> ScenarioWith ScenarioPath -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Int -> ScenarioWith ScenarioPath -> m ()
restartGame Int
currentSeed ScenarioWith ScenarioPath
siPair
          Just (Button Button
NextButton, Next NonEmpty (ScenarioWith ScenarioPath)
remainingScenarios) -> do
            Bool -> EventM Name AppState ()
quitGame Bool
isNoMenu
            EventM Name AppState ()
forall n s. Ord n => EventM n s ()
invalidateCache
            NonEmpty (ScenarioWith ScenarioPath)
-> Maybe CodeToRun -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
NonEmpty (ScenarioWith ScenarioPath) -> Maybe CodeToRun -> m ()
startGame NonEmpty (ScenarioWith ScenarioPath)
remainingScenarios Maybe CodeToRun
forall a. Maybe a
Nothing
          Maybe (Name, ButtonAction)
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Event
ev -> LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
    LensLike'
  (Zoomed (EventM Name (Dialog ButtonAction Name)) ())
  ScenarioState
  (Dialog ButtonAction Name)
-> EventM Name (Dialog ButtonAction Name) ()
-> EventM Name ScenarioState ()
forall c.
LensLike'
  (Zoomed (EventM Name (Dialog ButtonAction Name)) c)
  ScenarioState
  (Dialog ButtonAction Name)
-> EventM Name (Dialog ButtonAction Name) c
-> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> ((Dialog ButtonAction Name
     -> Focusing
          (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> (Dialog ButtonAction Name
    -> Focusing
         (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Focusing (StateT (EventState Name) IO) () UIDialogs)
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Focusing (StateT (EventState Name) IO) () UIDialogs)
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((Dialog ButtonAction Name
     -> Focusing
          (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
    -> UIDialogs
    -> Focusing (StateT (EventState Name) IO) () UIDialogs)
-> (Dialog ButtonAction Name
    -> Focusing
         (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal
 -> Focusing (StateT (EventState Name) IO) () (Maybe Modal))
-> UIDialogs -> Focusing (StateT (EventState Name) IO) () UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ((Maybe Modal
  -> Focusing (StateT (EventState Name) IO) () (Maybe Modal))
 -> UIDialogs
 -> Focusing (StateT (EventState Name) IO) () UIDialogs)
-> ((Dialog ButtonAction Name
     -> Focusing
          (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
    -> Maybe Modal
    -> Focusing (StateT (EventState Name) IO) () (Maybe Modal))
-> (Dialog ButtonAction Name
    -> Focusing
         (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> UIDialogs
-> Focusing (StateT (EventState Name) IO) () UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modal -> Focusing (StateT (EventState Name) IO) () Modal)
-> Maybe Modal
-> Focusing (StateT (EventState Name) IO) () (Maybe Modal)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Modal -> Focusing (StateT (EventState Name) IO) () Modal)
 -> Maybe Modal
 -> Focusing (StateT (EventState Name) IO) () (Maybe Modal))
-> ((Dialog ButtonAction Name
     -> Focusing
          (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
    -> Modal -> Focusing (StateT (EventState Name) IO) () Modal)
-> (Dialog ButtonAction Name
    -> Focusing
         (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> Maybe Modal
-> Focusing (StateT (EventState Name) IO) () (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dialog ButtonAction Name
 -> Focusing
      (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> Modal -> Focusing (StateT (EventState Name) IO) () Modal
Lens' Modal (Dialog ButtonAction Name)
modalDialog) (Event -> EventM Name (Dialog ButtonAction Name) ()
forall n a. Event -> EventM n (Dialog a n) ()
handleDialogEvent Event
ev)
    Maybe ModalType
modal <- ((ModalType -> Const (First ModalType) ModalType)
 -> ScenarioState -> Const (First ModalType) ScenarioState)
-> EventM Name ScenarioState (Maybe ModalType)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (((ModalType -> Const (First ModalType) ModalType)
  -> ScenarioState -> Const (First ModalType) ScenarioState)
 -> EventM Name ScenarioState (Maybe ModalType))
-> ((ModalType -> Const (First ModalType) ModalType)
    -> ScenarioState -> Const (First ModalType) ScenarioState)
-> EventM Name ScenarioState (Maybe ModalType)
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const (First ModalType) UIGameplay)
-> ScenarioState -> Const (First ModalType) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (First ModalType) UIGameplay)
 -> ScenarioState -> Const (First ModalType) ScenarioState)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> UIGameplay -> Const (First ModalType) UIGameplay)
-> (ModalType -> Const (First ModalType) ModalType)
-> ScenarioState
-> Const (First ModalType) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (First ModalType) UIDialogs)
-> UIGameplay -> Const (First ModalType) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (First ModalType) UIDialogs)
 -> UIGameplay -> Const (First ModalType) UIGameplay)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> UIDialogs -> Const (First ModalType) UIDialogs)
-> (ModalType -> Const (First ModalType) ModalType)
-> UIGameplay
-> Const (First ModalType) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> UIDialogs -> Const (First ModalType) UIDialogs
Lens' UIDialogs (Maybe Modal)
uiModal ((Maybe Modal -> Const (First ModalType) (Maybe Modal))
 -> UIDialogs -> Const (First ModalType) UIDialogs)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> (ModalType -> Const (First ModalType) ModalType)
-> UIDialogs
-> Const (First ModalType) UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modal -> Const (First ModalType) Modal)
-> Maybe Modal -> Const (First ModalType) (Maybe Modal)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Modal -> Const (First ModalType) Modal)
 -> Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> ((ModalType -> Const (First ModalType) ModalType)
    -> Modal -> Const (First ModalType) Modal)
-> (ModalType -> Const (First ModalType) ModalType)
-> Maybe Modal
-> Const (First ModalType) (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModalType -> Const (First ModalType) ModalType)
-> Modal -> Const (First ModalType) Modal
Lens' Modal ModalType
modalType
    case Maybe ModalType
modal of
      Just (MidScenarioModal MidScenarioModalType
TerrainPaletteModal) ->
        LensLike'
  (Focusing (StateT (EventState Name) IO) ())
  ScenarioState
  (List Name TerrainType)
-> EventM Name ScenarioState ()
forall {t :: * -> *} {n} {t} {e}.
(Foldable t, Splittable t, Ord n) =>
LensLike'
  (Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
-> EventM n t ()
refreshList (LensLike'
   (Focusing (StateT (EventState Name) IO) ())
   ScenarioState
   (List Name TerrainType)
 -> EventM Name ScenarioState ())
-> LensLike'
     (Focusing (StateT (EventState Name) IO) ())
     ScenarioState
     (List Name TerrainType)
-> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> ((List Name TerrainType
     -> Focusing
          (StateT (EventState Name) IO) () (List Name TerrainType))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> LensLike'
     (Focusing (StateT (EventState Name) IO) ())
     ScenarioState
     (List Name TerrainType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name
  -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((List Name TerrainType
     -> Focusing
          (StateT (EventState Name) IO) () (List Name TerrainType))
    -> WorldEditor Name
    -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
-> (List Name TerrainType
    -> Focusing
         (StateT (EventState Name) IO) () (List Name TerrainType))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name TerrainType
 -> Focusing
      (StateT (EventState Name) IO) () (List Name TerrainType))
-> WorldEditor Name
-> Focusing (StateT (EventState Name) IO) () (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n TerrainType -> f (List n TerrainType))
-> WorldEditor n -> f (WorldEditor n)
terrainList
      Just (MidScenarioModal MidScenarioModalType
EntityPaletteModal) -> LensLike'
  (Focusing (StateT (EventState Name) IO) ())
  ScenarioState
  (List Name EntityFacade)
-> EventM Name ScenarioState ()
forall {t :: * -> *} {n} {t} {e}.
(Foldable t, Splittable t, Ord n) =>
LensLike'
  (Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
-> EventM n t ()
refreshList (LensLike'
   (Focusing (StateT (EventState Name) IO) ())
   ScenarioState
   (List Name EntityFacade)
 -> EventM Name ScenarioState ())
-> LensLike'
     (Focusing (StateT (EventState Name) IO) ())
     ScenarioState
     (List Name EntityFacade)
-> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> ((List Name EntityFacade
     -> Focusing
          (StateT (EventState Name) IO) () (List Name EntityFacade))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> LensLike'
     (Focusing (StateT (EventState Name) IO) ())
     ScenarioState
     (List Name EntityFacade)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name
  -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((List Name EntityFacade
     -> Focusing
          (StateT (EventState Name) IO) () (List Name EntityFacade))
    -> WorldEditor Name
    -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
-> (List Name EntityFacade
    -> Focusing
         (StateT (EventState Name) IO) () (List Name EntityFacade))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name EntityFacade
 -> Focusing
      (StateT (EventState Name) IO) () (List Name EntityFacade))
-> WorldEditor Name
-> Focusing (StateT (EventState Name) IO) () (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList
      Just (MidScenarioModal MidScenarioModalType
GoalModal) -> case Event
ev of
        V.EvKey (V.KChar Char
'\t') [] -> (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIDialogs -> Identity UIDialogs)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Identity GoalDisplay)
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs GoalDisplay
uiGoal ((GoalDisplay -> Identity GoalDisplay)
 -> UIDialogs -> Identity UIDialogs)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> GoalDisplay -> Identity GoalDisplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIDialogs
-> Identity UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> GoalDisplay -> Identity GoalDisplay
Lens' GoalDisplay (FocusRing Name)
focus ((FocusRing Name -> Identity (FocusRing Name))
 -> ScenarioState -> Identity ScenarioState)
-> (FocusRing Name -> FocusRing Name)
-> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext
        Event
_ -> do
          FocusRing Name
focused <- ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
 -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> EventM Name ScenarioState (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
  -> ScenarioState -> Const (FocusRing Name) ScenarioState)
 -> EventM Name ScenarioState (FocusRing Name))
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> EventM Name ScenarioState (FocusRing Name)
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ScenarioState -> Const (FocusRing Name) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> ScenarioState
-> Const (FocusRing Name) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (FocusRing Name) UIDialogs)
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (FocusRing Name) UIDialogs)
 -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIDialogs -> Const (FocusRing Name) UIDialogs)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay
-> Const (FocusRing Name) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const (FocusRing Name) GoalDisplay)
-> UIDialogs -> Const (FocusRing Name) UIDialogs
Lens' UIDialogs GoalDisplay
uiGoal ((GoalDisplay -> Const (FocusRing Name) GoalDisplay)
 -> UIDialogs -> Const (FocusRing Name) UIDialogs)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> GoalDisplay -> Const (FocusRing Name) GoalDisplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIDialogs
-> Const (FocusRing Name) UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> GoalDisplay -> Const (FocusRing Name) GoalDisplay
Lens' GoalDisplay (FocusRing Name)
focus
          case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focused of
            Just (GoalWidgets GoalWidget
w) -> case GoalWidget
w of
              GoalWidget
ObjectivesList -> do
                List Name GoalEntry
lw <- Getting (List Name GoalEntry) ScenarioState (List Name GoalEntry)
-> EventM Name ScenarioState (List Name GoalEntry)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (List Name GoalEntry) ScenarioState (List Name GoalEntry)
 -> EventM Name ScenarioState (List Name GoalEntry))
-> Getting
     (List Name GoalEntry) ScenarioState (List Name GoalEntry)
-> EventM Name ScenarioState (List Name GoalEntry)
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const (List Name GoalEntry) UIGameplay)
-> ScenarioState -> Const (List Name GoalEntry) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (List Name GoalEntry) UIGameplay)
 -> ScenarioState -> Const (List Name GoalEntry) ScenarioState)
-> ((List Name GoalEntry
     -> Const (List Name GoalEntry) (List Name GoalEntry))
    -> UIGameplay -> Const (List Name GoalEntry) UIGameplay)
-> Getting
     (List Name GoalEntry) ScenarioState (List Name GoalEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (List Name GoalEntry) UIDialogs)
-> UIGameplay -> Const (List Name GoalEntry) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (List Name GoalEntry) UIDialogs)
 -> UIGameplay -> Const (List Name GoalEntry) UIGameplay)
-> ((List Name GoalEntry
     -> Const (List Name GoalEntry) (List Name GoalEntry))
    -> UIDialogs -> Const (List Name GoalEntry) UIDialogs)
-> (List Name GoalEntry
    -> Const (List Name GoalEntry) (List Name GoalEntry))
-> UIGameplay
-> Const (List Name GoalEntry) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const (List Name GoalEntry) GoalDisplay)
-> UIDialogs -> Const (List Name GoalEntry) UIDialogs
Lens' UIDialogs GoalDisplay
uiGoal ((GoalDisplay -> Const (List Name GoalEntry) GoalDisplay)
 -> UIDialogs -> Const (List Name GoalEntry) UIDialogs)
-> ((List Name GoalEntry
     -> Const (List Name GoalEntry) (List Name GoalEntry))
    -> GoalDisplay -> Const (List Name GoalEntry) GoalDisplay)
-> (List Name GoalEntry
    -> Const (List Name GoalEntry) (List Name GoalEntry))
-> UIDialogs
-> Const (List Name GoalEntry) UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name GoalEntry
 -> Const (List Name GoalEntry) (List Name GoalEntry))
-> GoalDisplay -> Const (List Name GoalEntry) GoalDisplay
Lens' GoalDisplay (List Name GoalEntry)
listWidget
                List Name GoalEntry
newList <- List Name GoalEntry
-> EventM Name ScenarioState (List Name GoalEntry)
forall {t :: * -> *} {n} {s}.
(Foldable t, Splittable t, Ord n, Searchable t) =>
GenericList n t GoalEntry -> EventM n s (GenericList n t GoalEntry)
refreshGoalList List Name GoalEntry
lw
                (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((List Name GoalEntry -> Identity (List Name GoalEntry))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name GoalEntry -> Identity (List Name GoalEntry))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name GoalEntry -> Identity (List Name GoalEntry))
    -> UIDialogs -> Identity UIDialogs)
-> (List Name GoalEntry -> Identity (List Name GoalEntry))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Identity GoalDisplay)
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs GoalDisplay
uiGoal ((GoalDisplay -> Identity GoalDisplay)
 -> UIDialogs -> Identity UIDialogs)
-> ((List Name GoalEntry -> Identity (List Name GoalEntry))
    -> GoalDisplay -> Identity GoalDisplay)
-> (List Name GoalEntry -> Identity (List Name GoalEntry))
-> UIDialogs
-> Identity UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name GoalEntry -> Identity (List Name GoalEntry))
-> GoalDisplay -> Identity GoalDisplay
Lens' GoalDisplay (List Name GoalEntry)
listWidget ((List Name GoalEntry -> Identity (List Name GoalEntry))
 -> ScenarioState -> Identity ScenarioState)
-> List Name GoalEntry -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name GoalEntry
newList
              GoalWidget
GoalSummary -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name ScenarioState ()
forall s.
ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name s ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
            Maybe Name
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name ScenarioState ()
forall s.
ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name s ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
      Just (MidScenarioModal MidScenarioModalType
StructuresModal) -> case Event
ev of
        V.EvKey (V.KChar Char
'\t') [] -> (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIDialogs -> Identity UIDialogs)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay -> Identity StructureDisplay)
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs StructureDisplay
uiStructure ((StructureDisplay -> Identity StructureDisplay)
 -> UIDialogs -> Identity UIDialogs)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> StructureDisplay -> Identity StructureDisplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIDialogs
-> Identity UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> StructureDisplay -> Identity StructureDisplay
Lens' StructureDisplay (FocusRing Name)
structurePanelFocus ((FocusRing Name -> Identity (FocusRing Name))
 -> ScenarioState -> Identity ScenarioState)
-> (FocusRing Name -> FocusRing Name)
-> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext
        Event
_ -> do
          FocusRing Name
focused <- ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
 -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> EventM Name ScenarioState (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
  -> ScenarioState -> Const (FocusRing Name) ScenarioState)
 -> EventM Name ScenarioState (FocusRing Name))
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> EventM Name ScenarioState (FocusRing Name)
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ScenarioState -> Const (FocusRing Name) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> ScenarioState -> Const (FocusRing Name) ScenarioState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> ScenarioState
-> Const (FocusRing Name) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Const (FocusRing Name) UIDialogs)
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Const (FocusRing Name) UIDialogs)
 -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIDialogs -> Const (FocusRing Name) UIDialogs)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay
-> Const (FocusRing Name) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay -> Const (FocusRing Name) StructureDisplay)
-> UIDialogs -> Const (FocusRing Name) UIDialogs
Lens' UIDialogs StructureDisplay
uiStructure ((StructureDisplay -> Const (FocusRing Name) StructureDisplay)
 -> UIDialogs -> Const (FocusRing Name) UIDialogs)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> StructureDisplay -> Const (FocusRing Name) StructureDisplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIDialogs
-> Const (FocusRing Name) UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> StructureDisplay -> Const (FocusRing Name) StructureDisplay
Lens' StructureDisplay (FocusRing Name)
structurePanelFocus
          case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focused of
            Just (StructureWidgets StructureWidget
w) -> case StructureWidget
w of
              StructureWidget
StructuresList ->
                LensLike'
  (Focusing (StateT (EventState Name) IO) ())
  ScenarioState
  (GenericList
     Name Vector (StructureInfo RecognizableStructureContent Entity))
-> EventM Name ScenarioState ()
forall {t :: * -> *} {n} {t} {e}.
(Foldable t, Splittable t, Ord n) =>
LensLike'
  (Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
-> EventM n t ()
refreshList (LensLike'
   (Focusing (StateT (EventState Name) IO) ())
   ScenarioState
   (GenericList
      Name Vector (StructureInfo RecognizableStructureContent Entity))
 -> EventM Name ScenarioState ())
-> LensLike'
     (Focusing (StateT (EventState Name) IO) ())
     ScenarioState
     (GenericList
        Name Vector (StructureInfo RecognizableStructureContent Entity))
-> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> ((GenericList
       Name Vector (StructureInfo RecognizableStructureContent Entity)
     -> Focusing
          (StateT (EventState Name) IO)
          ()
          (GenericList
             Name Vector (StructureInfo RecognizableStructureContent Entity)))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> LensLike'
     (Focusing (StateT (EventState Name) IO) ())
     ScenarioState
     (GenericList
        Name Vector (StructureInfo RecognizableStructureContent Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Focusing (StateT (EventState Name) IO) () UIDialogs)
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Focusing (StateT (EventState Name) IO) () UIDialogs)
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((GenericList
       Name Vector (StructureInfo RecognizableStructureContent Entity)
     -> Focusing
          (StateT (EventState Name) IO)
          ()
          (GenericList
             Name Vector (StructureInfo RecognizableStructureContent Entity)))
    -> UIDialogs
    -> Focusing (StateT (EventState Name) IO) () UIDialogs)
-> (GenericList
      Name Vector (StructureInfo RecognizableStructureContent Entity)
    -> Focusing
         (StateT (EventState Name) IO)
         ()
         (GenericList
            Name Vector (StructureInfo RecognizableStructureContent Entity)))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay
 -> Focusing (StateT (EventState Name) IO) () StructureDisplay)
-> UIDialogs -> Focusing (StateT (EventState Name) IO) () UIDialogs
Lens' UIDialogs StructureDisplay
uiStructure ((StructureDisplay
  -> Focusing (StateT (EventState Name) IO) () StructureDisplay)
 -> UIDialogs
 -> Focusing (StateT (EventState Name) IO) () UIDialogs)
-> ((GenericList
       Name Vector (StructureInfo RecognizableStructureContent Entity)
     -> Focusing
          (StateT (EventState Name) IO)
          ()
          (GenericList
             Name Vector (StructureInfo RecognizableStructureContent Entity)))
    -> StructureDisplay
    -> Focusing (StateT (EventState Name) IO) () StructureDisplay)
-> (GenericList
      Name Vector (StructureInfo RecognizableStructureContent Entity)
    -> Focusing
         (StateT (EventState Name) IO)
         ()
         (GenericList
            Name Vector (StructureInfo RecognizableStructureContent Entity)))
-> UIDialogs
-> Focusing (StateT (EventState Name) IO) () UIDialogs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList
   Name Vector (StructureInfo RecognizableStructureContent Entity)
 -> Focusing
      (StateT (EventState Name) IO)
      ()
      (GenericList
         Name Vector (StructureInfo RecognizableStructureContent Entity)))
-> StructureDisplay
-> Focusing (StateT (EventState Name) IO) () StructureDisplay
Lens'
  StructureDisplay
  (GenericList
     Name Vector (StructureInfo RecognizableStructureContent Entity))
structurePanelListWidget
              StructureWidget
StructureSummary -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name ScenarioState ()
forall s.
ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name s ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
            Maybe Name
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name ScenarioState ()
forall s.
ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name s ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
      Just (MidScenarioModal MidScenarioModalType
RobotsModal) -> do
        UIGameplay
uiGame <- Getting UIGameplay ScenarioState UIGameplay
-> EventM Name ScenarioState UIGameplay
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting UIGameplay ScenarioState UIGameplay
Lens' ScenarioState UIGameplay
uiGameplay
        GameState
g <- ((GameState -> Const GameState GameState)
 -> ScenarioState -> Const GameState ScenarioState)
-> EventM Name ScenarioState GameState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (GameState -> Const GameState GameState)
-> ScenarioState -> Const GameState ScenarioState
Lens' ScenarioState GameState
gameState
        ((RobotDisplay
  -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
 -> ScenarioState
 -> Zoomed (EventM Name RobotDisplay) () ScenarioState)
-> EventM Name RobotDisplay () -> EventM Name ScenarioState ()
forall c.
LensLike'
  (Zoomed (EventM Name RobotDisplay) c) ScenarioState RobotDisplay
-> EventM Name RobotDisplay c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay)
-> ScenarioState
-> Zoomed (EventM Name RobotDisplay) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay)
 -> ScenarioState
 -> Zoomed (EventM Name RobotDisplay) () ScenarioState)
-> ((RobotDisplay
     -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
    -> UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay)
-> (RobotDisplay
    -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
-> ScenarioState
-> Zoomed (EventM Name RobotDisplay) () ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIDialogs -> Zoomed (EventM Name RobotDisplay) () UIDialogs)
-> UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Zoomed (EventM Name RobotDisplay) () UIDialogs)
 -> UIGameplay -> Zoomed (EventM Name RobotDisplay) () UIGameplay)
-> ((RobotDisplay
     -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
    -> UIDialogs -> Zoomed (EventM Name RobotDisplay) () UIDialogs)
-> (RobotDisplay
    -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
-> UIGameplay
-> Zoomed (EventM Name RobotDisplay) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RobotDisplay -> Zoomed (EventM Name RobotDisplay) () RobotDisplay)
-> UIDialogs -> Zoomed (EventM Name RobotDisplay) () UIDialogs
Lens' UIDialogs RobotDisplay
uiRobot) (EventM Name RobotDisplay () -> EventM Name ScenarioState ())
-> EventM Name RobotDisplay () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ case Event
ev of
          V.EvKey (V.KChar Char
'\t') [] -> (RobotDetailsPaneState -> Identity RobotDetailsPaneState)
-> RobotDisplay -> Identity RobotDisplay
Lens' RobotDisplay RobotDetailsPaneState
robotDetailsPaneState ((RobotDetailsPaneState -> Identity RobotDetailsPaneState)
 -> RobotDisplay -> Identity RobotDisplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> RobotDetailsPaneState -> Identity RobotDetailsPaneState)
-> (FocusRing Name -> Identity (FocusRing Name))
-> RobotDisplay
-> Identity RobotDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> RobotDetailsPaneState -> Identity RobotDetailsPaneState
Lens' RobotDetailsPaneState (FocusRing Name)
detailFocus ((FocusRing Name -> Identity (FocusRing Name))
 -> RobotDisplay -> Identity RobotDisplay)
-> (FocusRing Name -> FocusRing Name)
-> EventM Name RobotDisplay ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext
          Event
_ -> do
            Bool
isInDetailsMode <- ((Bool -> Const Bool Bool)
 -> RobotDisplay -> Const Bool RobotDisplay)
-> EventM Name RobotDisplay Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Bool -> Const Bool Bool)
-> RobotDisplay -> Const Bool RobotDisplay
Lens' RobotDisplay Bool
isDetailsOpened
            if Bool
isInDetailsMode
              then LensLike'
  (Zoomed (EventM Name (GenericList Name Seq LogEntry)) ())
  RobotDisplay
  (GenericList Name Seq LogEntry)
-> EventM Name (GenericList Name Seq LogEntry) ()
-> EventM Name RobotDisplay ()
forall c.
LensLike'
  (Zoomed (EventM Name (GenericList Name Seq LogEntry)) c)
  RobotDisplay
  (GenericList Name Seq LogEntry)
-> EventM Name (GenericList Name Seq LogEntry) c
-> EventM Name RobotDisplay c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((RobotDetailsPaneState
 -> Focusing (StateT (EventState Name) IO) () RobotDetailsPaneState)
-> RobotDisplay
-> Focusing (StateT (EventState Name) IO) () RobotDisplay
Lens' RobotDisplay RobotDetailsPaneState
robotDetailsPaneState ((RobotDetailsPaneState
  -> Focusing (StateT (EventState Name) IO) () RobotDetailsPaneState)
 -> RobotDisplay
 -> Focusing (StateT (EventState Name) IO) () RobotDisplay)
-> ((GenericList Name Seq LogEntry
     -> Focusing
          (StateT (EventState Name) IO) () (GenericList Name Seq LogEntry))
    -> RobotDetailsPaneState
    -> Focusing (StateT (EventState Name) IO) () RobotDetailsPaneState)
-> (GenericList Name Seq LogEntry
    -> Focusing
         (StateT (EventState Name) IO) () (GenericList Name Seq LogEntry))
-> RobotDisplay
-> Focusing (StateT (EventState Name) IO) () RobotDisplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Seq LogEntry
 -> Focusing
      (StateT (EventState Name) IO) () (GenericList Name Seq LogEntry))
-> RobotDetailsPaneState
-> Focusing (StateT (EventState Name) IO) () RobotDetailsPaneState
Lens' RobotDetailsPaneState (GenericList Name Seq LogEntry)
logsList) (EventM Name (GenericList Name Seq LogEntry) ()
 -> EventM Name RobotDisplay ())
-> EventM Name (GenericList Name Seq LogEntry) ()
-> EventM Name RobotDisplay ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM Name (GenericList Name Seq LogEntry) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev
              else do
                LensLike'
  (Zoomed (EventM Name (GridTabularList Name Int)) ())
  RobotDisplay
  (GridTabularList Name Int)
-> EventM Name (GridTabularList Name Int) ()
-> EventM Name RobotDisplay ()
forall c.
LensLike'
  (Zoomed (EventM Name (GridTabularList Name Int)) c)
  RobotDisplay
  (GridTabularList Name Int)
-> EventM Name (GridTabularList Name Int) c
-> EventM Name RobotDisplay c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GridTabularList Name Int
 -> Focusing
      (StateT (EventState Name) IO) () (GridTabularList Name Int))
-> RobotDisplay
-> Focusing (StateT (EventState Name) IO) () RobotDisplay
LensLike'
  (Zoomed (EventM Name (GridTabularList Name Int)) ())
  RobotDisplay
  (GridTabularList Name Int)
Lens' RobotDisplay (GridTabularList Name Int)
robotsGridList (EventM Name (GridTabularList Name Int) ()
 -> EventM Name RobotDisplay ())
-> EventM Name (GridTabularList Name Int) ()
-> EventM Name RobotDisplay ()
forall a b. (a -> b) -> a -> b
$ GridRenderers Name Int
-> Event -> EventM Name (GridTabularList Name Int) ()
forall n e.
Ord n =>
GridRenderers n e -> Event -> EventM n (GridTabularList n e) ()
BG.handleGridListEvent (UIGameplay -> GameState -> GridRenderers Name Int
robotGridRenderers UIGameplay
uiGame GameState
g) Event
ev
                -- Ensure list widget content is updated immediately
                Maybe Robot
mRob <- Getting (Maybe Robot) RobotDisplay (Maybe Robot)
-> EventM Name RobotDisplay (Maybe Robot)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe Robot) RobotDisplay (Maybe Robot)
 -> EventM Name RobotDisplay (Maybe Robot))
-> Getting (Maybe Robot) RobotDisplay (Maybe Robot)
-> EventM Name RobotDisplay (Maybe Robot)
forall a b. (a -> b) -> a -> b
$ (GridTabularList Name Int
 -> Const (Maybe Robot) (GridTabularList Name Int))
-> RobotDisplay -> Const (Maybe Robot) RobotDisplay
Lens' RobotDisplay (GridTabularList Name Int)
robotsGridList ((GridTabularList Name Int
  -> Const (Maybe Robot) (GridTabularList Name Int))
 -> RobotDisplay -> Const (Maybe Robot) RobotDisplay)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> GridTabularList Name Int
    -> Const (Maybe Robot) (GridTabularList Name Int))
-> Getting (Maybe Robot) RobotDisplay (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GridTabularList Name Int -> Maybe Robot)
-> (Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
-> GridTabularList Name Int
-> Const (Maybe Robot) (GridTabularList Name Int)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (GameState -> GridTabularList Name Int -> Maybe Robot
getSelectedRobot GameState
g)
                Maybe Robot
-> (Robot -> EventM Name RobotDisplay ())
-> EventM Name RobotDisplay ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Robot
mRob ((Robot -> EventM Name RobotDisplay ())
 -> EventM Name RobotDisplay ())
-> (Robot -> EventM Name RobotDisplay ())
-> EventM Name RobotDisplay ()
forall a b. (a -> b) -> a -> b
$ LensLike'
  (Zoomed (EventM Name RobotDetailsPaneState) ())
  RobotDisplay
  RobotDetailsPaneState
-> EventM Name RobotDetailsPaneState ()
-> EventM Name RobotDisplay ()
forall c.
LensLike'
  (Zoomed (EventM Name RobotDetailsPaneState) c)
  RobotDisplay
  RobotDetailsPaneState
-> EventM Name RobotDetailsPaneState c
-> EventM Name RobotDisplay c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (RobotDetailsPaneState
 -> Focusing (StateT (EventState Name) IO) () RobotDetailsPaneState)
-> RobotDisplay
-> Focusing (StateT (EventState Name) IO) () RobotDisplay
LensLike'
  (Zoomed (EventM Name RobotDetailsPaneState) ())
  RobotDisplay
  RobotDetailsPaneState
Lens' RobotDisplay RobotDetailsPaneState
robotDetailsPaneState (EventM Name RobotDetailsPaneState ()
 -> EventM Name RobotDisplay ())
-> (Robot -> EventM Name RobotDetailsPaneState ())
-> Robot
-> EventM Name RobotDisplay ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Robot -> EventM Name RobotDetailsPaneState ()
updateRobotDetailsPane
      Maybe ModalType
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name ScenarioState ()
forall s.
ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name s ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
   where
    refreshGoalList :: GenericList n t GoalEntry -> EventM n s (GenericList n t GoalEntry)
refreshGoalList GenericList n t GoalEntry
lw = GenericList n t GoalEntry
-> EventM n (GenericList n t GoalEntry) ()
-> EventM n s (GenericList n t GoalEntry)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList n t GoalEntry
lw (EventM n (GenericList n t GoalEntry) ()
 -> EventM n s (GenericList n t GoalEntry))
-> EventM n (GenericList n t GoalEntry) ()
-> EventM n s (GenericList n t GoalEntry)
forall a b. (a -> b) -> a -> b
$ Event
-> (GoalEntry -> Bool) -> EventM n (GenericList n t GoalEntry) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n, Searchable t) =>
Event -> (e -> Bool) -> EventM n (GenericList n t e) ()
handleListEventWithSeparators Event
ev GoalEntry -> Bool
shouldSkipSelection
    refreshList :: LensLike'
  (Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
-> EventM n t ()
refreshList LensLike'
  (Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
z = LensLike'
  (Zoomed (EventM n (GenericList n t e)) ()) t (GenericList n t e)
-> EventM n (GenericList n t e) () -> EventM n t ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n t e)) c) t (GenericList n t e)
-> EventM n (GenericList n t e) c -> EventM n t c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom LensLike'
  (Focusing (StateT (EventState n) IO) ()) t (GenericList n t e)
LensLike'
  (Zoomed (EventM n (GenericList n t e)) ()) t (GenericList n t e)
z (EventM n (GenericList n t e) () -> EventM n t ())
-> EventM n (GenericList n t e) () -> EventM n t ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM n (GenericList n t e) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
BL.handleListEvent Event
ev

-- | Quit a game.
--
-- * writes out the updated REPL history to a @.swarm_history@ file
-- * saves current scenario status (InProgress/Completed)
-- * advances the menu to the next scenario IF the current one was won
-- * returns to the previous menu
quitGame :: Bool -> EventM Name AppState ()
quitGame :: Bool -> EventM Name AppState ()
quitGame Bool
isNoMenu = do
  -- Write out REPL history.
  REPLHistory
history <- Getting REPLHistory AppState REPLHistory
-> EventM Name AppState REPLHistory
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting REPLHistory AppState REPLHistory
 -> EventM Name AppState REPLHistory)
-> Getting REPLHistory AppState REPLHistory
-> EventM Name AppState REPLHistory
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const REPLHistory PlayState)
-> AppState -> Const REPLHistory AppState
Lens' AppState PlayState
playState ((PlayState -> Const REPLHistory PlayState)
 -> AppState -> Const REPLHistory AppState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> PlayState -> Const REPLHistory PlayState)
-> Getting REPLHistory AppState REPLHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const REPLHistory ScenarioState)
-> PlayState -> Const REPLHistory PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const REPLHistory ScenarioState)
 -> PlayState -> Const REPLHistory PlayState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> ScenarioState -> Const REPLHistory ScenarioState)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> PlayState
-> Const REPLHistory PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLHistory UIGameplay)
-> ScenarioState -> Const REPLHistory ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const REPLHistory UIGameplay)
 -> ScenarioState -> Const REPLHistory ScenarioState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> UIGameplay -> Const REPLHistory UIGameplay)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> ScenarioState
-> Const REPLHistory ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLHistory REPLState)
-> UIGameplay -> Const REPLHistory UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLHistory REPLState)
 -> UIGameplay -> Const REPLHistory UIGameplay)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> UIGameplay
-> Const REPLHistory UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory
  let hist :: [Text]
hist = (REPLHistItem -> Maybe Text) -> [REPLHistItem] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe REPLHistItem -> Maybe Text
getREPLSubmitted ([REPLHistItem] -> [Text]) -> [REPLHistItem] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems Int
forall a. Bounded a => a
maxBound REPLHistory
history
  IO () -> EventM Name AppState ()
forall a. IO a -> EventM Name AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name AppState ())
-> IO () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (String -> Text -> IO ()
`T.appendFile` [Text] -> Text
T.unlines [Text]
hist) (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO String
getSwarmHistoryPath Bool
True

  -- Save scenario status info.
  Set DebugOption
dOps <- Getting (Set DebugOption) AppState (Set DebugOption)
-> EventM Name AppState (Set DebugOption)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Set DebugOption) AppState (Set DebugOption)
 -> EventM Name AppState (Set DebugOption))
-> Getting (Set DebugOption) AppState (Set DebugOption)
-> EventM Name AppState (Set DebugOption)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (Set DebugOption) UIState)
-> AppState -> Const (Set DebugOption) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Set DebugOption) UIState)
 -> AppState -> Const (Set DebugOption) AppState)
-> ((Set DebugOption -> Const (Set DebugOption) (Set DebugOption))
    -> UIState -> Const (Set DebugOption) UIState)
-> Getting (Set DebugOption) AppState (Set DebugOption)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set DebugOption -> Const (Set DebugOption) (Set DebugOption))
-> UIState -> Const (Set DebugOption) UIState
Lens' UIState (Set DebugOption)
uiDebugOptions
  LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
-> EventM Name PlayState () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name PlayState) c) AppState PlayState
-> EventM Name PlayState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
Lens' AppState PlayState
playState (EventM Name PlayState () -> EventM Name AppState ())
-> EventM Name PlayState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ Set DebugOption -> EventM Name PlayState ()
forall n. Set DebugOption -> EventM n PlayState ()
saveScenarioInfoOnQuit Set DebugOption
dOps

  -- Automatically advance the menu to the next scenario iff the
  -- player has won the current one.
  WinCondition
wc <- Getting WinCondition AppState WinCondition
-> EventM Name AppState WinCondition
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting WinCondition AppState WinCondition
 -> EventM Name AppState WinCondition)
-> Getting WinCondition AppState WinCondition
-> EventM Name AppState WinCondition
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const WinCondition PlayState)
-> AppState -> Const WinCondition AppState
Lens' AppState PlayState
playState ((PlayState -> Const WinCondition PlayState)
 -> AppState -> Const WinCondition AppState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> PlayState -> Const WinCondition PlayState)
-> Getting WinCondition AppState WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const WinCondition ScenarioState)
-> PlayState -> Const WinCondition PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const WinCondition ScenarioState)
 -> PlayState -> Const WinCondition PlayState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> ScenarioState -> Const WinCondition ScenarioState)
-> (WinCondition -> Const WinCondition WinCondition)
-> PlayState
-> Const WinCondition PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const WinCondition GameState)
-> ScenarioState -> Const WinCondition ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const WinCondition GameState)
 -> ScenarioState -> Const WinCondition ScenarioState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> GameState -> Const WinCondition GameState)
-> (WinCondition -> Const WinCondition WinCondition)
-> ScenarioState
-> Const WinCondition ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState
Lens' GameState WinCondition
winCondition
  case WinCondition
wc of
    WinConditions (Won Bool
_ TickNumber
_) ObjectiveCompletion
_ -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> (Menu -> Menu) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Menu -> Menu
advanceMenu
    WinCondition
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Either quit the entire app (if the scenario was chosen directly
  -- from the command line) or return to the menu (if the scenario was
  -- chosen from the menu).
  if Bool
isNoMenu
    then EventM Name AppState ()
haltApp
    else (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
. (Bool -> Identity Bool) -> UIState -> Identity UIState
Lens' UIState Bool
uiPlaying ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> Bool -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

------------------------------------------------------------
-- REPL events
------------------------------------------------------------

-- | Handle a user input event for the REPL.
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
x = do
  AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
  let controlMode :: ReplControlMode
controlMode = AppState
s AppState
-> Getting ReplControlMode AppState ReplControlMode
-> ReplControlMode
forall s a. s -> Getting a s a -> a
^. (PlayState -> Const ReplControlMode PlayState)
-> AppState -> Const ReplControlMode AppState
Lens' AppState PlayState
playState ((PlayState -> Const ReplControlMode PlayState)
 -> AppState -> Const ReplControlMode AppState)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> PlayState -> Const ReplControlMode PlayState)
-> Getting ReplControlMode AppState ReplControlMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Const ReplControlMode ScenarioState)
-> PlayState -> Const ReplControlMode PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const ReplControlMode ScenarioState)
 -> PlayState -> Const ReplControlMode PlayState)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> ScenarioState -> Const ReplControlMode ScenarioState)
-> (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> PlayState
-> Const ReplControlMode PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const ReplControlMode UIGameplay)
-> ScenarioState -> Const ReplControlMode ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const ReplControlMode UIGameplay)
 -> ScenarioState -> Const ReplControlMode ScenarioState)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> UIGameplay -> Const ReplControlMode UIGameplay)
-> (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> ScenarioState
-> Const ReplControlMode ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const ReplControlMode REPLState)
-> UIGameplay -> Const ReplControlMode UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const ReplControlMode REPLState)
 -> UIGameplay -> Const ReplControlMode UIGameplay)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> REPLState -> Const ReplControlMode REPLState)
-> (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> UIGameplay
-> Const ReplControlMode UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> REPLState -> Const ReplControlMode REPLState
Lens' REPLState ReplControlMode
replControlMode
  let keyHandler :: KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler = AppState
s AppState
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
-> KeyDispatcher SwarmEvent (EventM Name AppState)
forall s a. s -> Getting a s a -> a
^. (KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> AppState
-> Const (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       KeyEventHandlingState)
 -> AppState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> KeyEventHandlingState
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         KeyEventHandlingState)
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      SwarmKeyDispatchers)
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
Lens' KeyEventHandlingState SwarmKeyDispatchers
keyDispatchers ((SwarmKeyDispatchers
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       SwarmKeyDispatchers)
 -> KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> SwarmKeyDispatchers
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         SwarmKeyDispatchers)
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> KeyDispatcher SwarmEvent (EventM Name AppState))
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> SwarmKeyDispatchers
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     SwarmKeyDispatchers
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SwarmKeyDispatchers
-> KeyDispatcher SwarmEvent (EventM Name AppState)
replDispatcher
  let menu :: Menu
menu = AppState
s AppState -> Getting Menu AppState Menu -> Menu
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Menu UIState) -> AppState -> Const Menu AppState
Lens' AppState UIState
uiState ((UIState -> Const Menu UIState)
 -> AppState -> Const Menu AppState)
-> ((Menu -> Const Menu Menu) -> UIState -> Const Menu UIState)
-> Getting Menu AppState Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Const Menu Menu) -> UIState -> Const Menu UIState
Lens' UIState Menu
uiMenu
  case BrickEvent Name AppEvent
x of
    -- Pass to key handler (allows users to configure bindings)
    -- See Note [how Swarm event handlers work]
    VtyEvent (V.EvKey Key
k [Modifier]
m)
      | Maybe (KeyHandler SwarmEvent (EventM Name AppState)) -> Bool
forall a. Maybe a -> Bool
isJust (Key
-> [Modifier]
-> KeyDispatcher SwarmEvent (EventM Name AppState)
-> Maybe (KeyHandler SwarmEvent (EventM Name AppState))
forall k (m :: * -> *).
Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
B.lookupVtyEvent Key
k [Modifier]
m KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler) ->
          EventM Name AppState Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM Name AppState Bool -> EventM Name AppState ())
-> EventM Name AppState Bool -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ KeyDispatcher SwarmEvent (EventM Name AppState)
-> Key -> [Modifier] -> EventM Name AppState Bool
forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
B.handleKey KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler Key
k [Modifier]
m
    -- Handle other events in a way appropriate to the current REPL
    -- control mode.
    BrickEvent Name AppEvent
_ -> LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
-> EventM Name PlayState () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name PlayState) c) AppState PlayState
-> EventM Name PlayState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
LensLike' (Zoomed (EventM Name PlayState) ()) AppState PlayState
Lens' AppState PlayState
playState (EventM Name PlayState () -> EventM Name AppState ())
-> EventM Name PlayState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ case ReplControlMode
controlMode of
      ReplControlMode
Typing -> Menu -> BrickEvent Name AppEvent -> EventM Name PlayState ()
handleREPLEventTyping Menu
menu BrickEvent Name AppEvent
x
      ReplControlMode
Piloting -> Menu -> BrickEvent Name AppEvent -> EventM Name PlayState ()
handleREPLEventPiloting Menu
menu BrickEvent Name AppEvent
x
      ReplControlMode
Handling -> case BrickEvent Name AppEvent
x of
        -- Handle keypresses using the custom installed handler
        VtyEvent (V.EvKey Key
k [Modifier]
mods) -> ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
(ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ KeyCombo -> EventM Name ScenarioState ()
runInputHandler ([Modifier] -> Key -> KeyCombo
mkKeyCombo [Modifier]
mods Key
k)
        -- Handle all other events normally
        BrickEvent Name AppEvent
_ -> Menu -> BrickEvent Name AppEvent -> EventM Name PlayState ()
handleREPLEventTyping Menu
menu BrickEvent Name AppEvent
x

-- | Run the installed input handler on a key combo entered by the user.
runInputHandler :: KeyCombo -> EventM Name ScenarioState ()
runInputHandler :: KeyCombo -> EventM Name ScenarioState ()
runInputHandler KeyCombo
kc = do
  Maybe (Text, Value)
mhandler <- Getting (Maybe (Text, Value)) ScenarioState (Maybe (Text, Value))
-> EventM Name ScenarioState (Maybe (Text, Value))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe (Text, Value)) ScenarioState (Maybe (Text, Value))
 -> EventM Name ScenarioState (Maybe (Text, Value)))
-> Getting
     (Maybe (Text, Value)) ScenarioState (Maybe (Text, Value))
-> EventM Name ScenarioState (Maybe (Text, Value))
forall a b. (a -> b) -> a -> b
$ (GameState -> Const (Maybe (Text, Value)) GameState)
-> ScenarioState -> Const (Maybe (Text, Value)) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (Maybe (Text, Value)) GameState)
 -> ScenarioState -> Const (Maybe (Text, Value)) ScenarioState)
-> ((Maybe (Text, Value)
     -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
    -> GameState -> Const (Maybe (Text, Value)) GameState)
-> Getting
     (Maybe (Text, Value)) ScenarioState (Maybe (Text, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Const (Maybe (Text, Value)) GameControls)
-> GameState -> Const (Maybe (Text, Value)) GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const (Maybe (Text, Value)) GameControls)
 -> GameState -> Const (Maybe (Text, Value)) GameState)
-> ((Maybe (Text, Value)
     -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
    -> GameControls -> Const (Maybe (Text, Value)) GameControls)
-> (Maybe (Text, Value)
    -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
-> GameState
-> Const (Maybe (Text, Value)) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Text, Value)
 -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
-> GameControls -> Const (Maybe (Text, Value)) GameControls
Lens' GameControls (Maybe (Text, Value))
inputHandler
  Maybe (Text, Value)
-> ((Text, Value) -> EventM Name ScenarioState ())
-> EventM Name ScenarioState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Text, Value)
mhandler (((Text, Value) -> EventM Name ScenarioState ())
 -> EventM Name ScenarioState ())
-> ((Text, Value) -> EventM Name ScenarioState ())
-> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ \(Text
_, Value
handler) -> do
    -- Shouldn't be possible to get here if there is no input handler, but
    -- if we do somehow, just do nothing.

    -- Make sure the base is currently idle; if so, apply the
    -- installed input handler function to a `key` value
    -- representing the typed input.
    Bool
working <- ((Bool -> Const Bool Bool)
 -> ScenarioState -> Const Bool ScenarioState)
-> EventM Name ScenarioState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (((Bool -> Const Bool Bool)
  -> ScenarioState -> Const Bool ScenarioState)
 -> EventM Name ScenarioState Bool)
-> ((Bool -> Const Bool Bool)
    -> ScenarioState -> Const Bool ScenarioState)
-> EventM Name ScenarioState Bool
forall a b. (a -> b) -> a -> b
$ (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
. (GameControls -> Const Bool GameControls)
-> GameState -> Const Bool GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const Bool GameControls)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> GameControls -> Const Bool GameControls)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> GameControls -> Const Bool GameControls
Getter GameControls Bool
replWorking
    Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
working (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
      ScenarioState
s <- EventM Name ScenarioState ScenarioState
forall s (m :: * -> *). MonadState s m => m s
get
      let env :: Env
env = Env -> Maybe Env -> Env
forall a. a -> Maybe a -> a
fromMaybe Env
emptyEnv (Maybe Env -> Env) -> Maybe Env -> Env
forall a b. (a -> b) -> a -> b
$ ScenarioState
s ScenarioState -> Getting (First Env) ScenarioState Env -> Maybe Env
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Const (First Env) GameState)
-> ScenarioState -> Const (First Env) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (First Env) GameState)
 -> ScenarioState -> Const (First Env) ScenarioState)
-> ((Env -> Const (First Env) Env)
    -> GameState -> Const (First Env) GameState)
-> Getting (First Env) ScenarioState Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const (First Env) Env)
-> GameState -> Const (First Env) GameState
Traversal' GameState Env
baseEnv
          store :: Store
store = ScenarioState
s ScenarioState -> Getting Store ScenarioState Store -> Store
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Store GameState)
-> ScenarioState -> Const Store ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const Store GameState)
 -> ScenarioState -> Const Store ScenarioState)
-> ((Store -> Const Store Store)
    -> GameState -> Const Store GameState)
-> Getting Store ScenarioState Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Store -> Const Store Store) -> GameState -> Const Store GameState
Getter GameState Store
baseStore
          handlerCESK :: CESK
handlerCESK = Value -> Store -> Cont -> CESK
Out (KeyCombo -> Value
VKey KeyCombo
kc) Store
store [Value -> Frame
FApp Value
handler, Frame
FExec, Env -> Frame
FSuspend Env
env]
      (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((CESK -> Identity CESK) -> GameState -> Identity GameState)
-> (CESK -> Identity CESK)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> GameState -> Identity GameState
Traversal' GameState Robot
baseRobot ((Robot -> Identity Robot) -> GameState -> Identity GameState)
-> ((CESK -> Identity CESK) -> Robot -> Identity Robot)
-> (CESK -> Identity CESK)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Identity CESK) -> Robot -> Identity Robot
Lens' Robot CESK
machine ((CESK -> Identity CESK)
 -> ScenarioState -> Identity ScenarioState)
-> CESK -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= CESK
handlerCESK
      (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> (GameState -> GameState) -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= State GameState () -> GameState -> GameState
forall s a. State s a -> s -> s
execState (StateC Robots Identity () -> State GameState ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity () -> State GameState ())
-> StateC Robots Identity () -> State GameState ()
forall a b. (a -> b) -> a -> b
$ Int -> StateC Robots Identity ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State Robots) sig m =>
Int -> m ()
activateRobot Int
0)

-- | Handle a user "piloting" input event for the REPL.
--
-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleREPLEventPiloting :: Menu -> BrickEvent Name AppEvent -> EventM Name PlayState ()
handleREPLEventPiloting :: Menu -> BrickEvent Name AppEvent -> EventM Name PlayState ()
handleREPLEventPiloting Menu
m BrickEvent Name AppEvent
x = case BrickEvent Name AppEvent
x of
  Key Key
V.KUp -> Text -> EventM Name PlayState ()
inputCmd Text
"move"
  Key Key
V.KDown -> Text -> EventM Name PlayState ()
inputCmd Text
"turn back"
  Key Key
V.KLeft -> Text -> EventM Name PlayState ()
inputCmd Text
"turn left"
  Key Key
V.KRight -> Text -> EventM Name PlayState ()
inputCmd Text
"turn right"
  ShiftKey Key
V.KUp -> Text -> EventM Name PlayState ()
inputCmd Text
"turn north"
  ShiftKey Key
V.KDown -> Text -> EventM Name PlayState ()
inputCmd Text
"turn south"
  ShiftKey Key
V.KLeft -> Text -> EventM Name PlayState ()
inputCmd Text
"turn west"
  ShiftKey Key
V.KRight -> Text -> EventM Name PlayState ()
inputCmd Text
"turn east"
  Key Key
V.KDel -> Text -> EventM Name PlayState ()
inputCmd Text
"selfdestruct"
  CharKey Char
'g' -> Text -> EventM Name PlayState ()
inputCmd Text
"grab"
  CharKey Char
'h' -> Text -> EventM Name PlayState ()
inputCmd Text
"harvest"
  CharKey Char
'd' -> Text -> EventM Name PlayState ()
inputCmd Text
"drill forward"
  CharKey Char
'x' -> Text -> EventM Name PlayState ()
inputCmd Text
"drill down"
  CharKey Char
's' -> Text -> EventM Name PlayState ()
inputCmd Text
"scan forward"
  CharKey Char
'b' -> Text -> EventM Name PlayState ()
inputCmd Text
"blocked"
  CharKey Char
'u' -> Text -> EventM Name PlayState ()
inputCmd Text
"upload base"
  CharKey Char
'p' -> Text -> EventM Name PlayState ()
inputCmd Text
"push"
  BrickEvent Name AppEvent
_ -> Text -> EventM Name PlayState ()
inputCmd Text
"noop"
 where
  inputCmd :: Text -> EventM Name PlayState ()
inputCmd Text
cmdText = do
    (ScenarioState -> Identity ScenarioState)
-> PlayState -> Identity PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Identity ScenarioState)
 -> PlayState -> Identity PlayState)
-> ((REPLState -> Identity REPLState)
    -> ScenarioState -> Identity ScenarioState)
-> (REPLState -> Identity REPLState)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> PlayState -> Identity PlayState)
-> (REPLState -> REPLState) -> EventM Name PlayState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLState -> REPLState
setCmd (Text
cmdText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";")
    ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ScenarioState -> ScenarioState
validateREPLForm
    Menu -> BrickEvent Name AppEvent -> EventM Name PlayState ()
handleREPLEventTyping Menu
m (BrickEvent Name AppEvent -> EventM Name PlayState ())
-> BrickEvent Name AppEvent -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ Key -> BrickEvent Name AppEvent
forall n e. Key -> BrickEvent n e
Key Key
V.KEnter

  setCmd :: Text -> REPLState -> REPLState
setCmd Text
nt REPLState
theRepl =
    REPLState
theRepl
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> REPLState -> Identity REPLState
Lens' REPLState Text
replPromptText ((Text -> Identity Text) -> REPLState -> Identity REPLState)
-> Text -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
nt
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt []

runBaseWebCode :: (MonadState ScenarioState m, MonadIO m) => T.Text -> (WebInvocationState -> IO ()) -> m ()
runBaseWebCode :: forall (m :: * -> *).
(MonadState ScenarioState m, MonadIO m) =>
Text -> (WebInvocationState -> IO ()) -> m ()
runBaseWebCode Text
uinput WebInvocationState -> IO ()
ureply = do
  ScenarioState
s <- m ScenarioState
forall s (m :: * -> *). MonadState s m => m s
get
  if ScenarioState
s ScenarioState
-> ((Bool -> Const Bool Bool)
    -> ScenarioState -> Const Bool ScenarioState)
-> Bool
forall s a. s -> Getting a s a -> a
^. (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
. (GameControls -> Const Bool GameControls)
-> GameState -> Const Bool GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const Bool GameControls)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> GameControls -> Const Bool GameControls)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> GameControls -> Const Bool GameControls
Getter GameControls Bool
replWorking
    then IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (WebInvocationState -> IO ()) -> WebInvocationState -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebInvocationState -> IO ()
ureply (WebInvocationState -> m ()) -> WebInvocationState -> m ()
forall a b. (a -> b) -> a -> b
$ RejectionReason -> WebInvocationState
Rejected RejectionReason
AlreadyRunning
    else do
      (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> (((Text -> IO ()) -> Identity (Text -> IO ()))
    -> GameState -> Identity GameState)
-> ((Text -> IO ()) -> Identity (Text -> IO ()))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Identity GameControls)
-> GameState -> Identity GameState
Lens' GameState GameControls
gameControls ((GameControls -> Identity GameControls)
 -> GameState -> Identity GameState)
-> (((Text -> IO ()) -> Identity (Text -> IO ()))
    -> GameControls -> Identity GameControls)
-> ((Text -> IO ()) -> Identity (Text -> IO ()))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> IO ()) -> Identity (Text -> IO ()))
-> GameControls -> Identity GameControls
Lens' GameControls (Text -> IO ())
replListener (((Text -> IO ()) -> Identity (Text -> IO ()))
 -> ScenarioState -> Identity ScenarioState)
-> (Text -> IO ()) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= WebInvocationState -> IO ()
ureply (WebInvocationState -> IO ())
-> (Text -> WebInvocationState) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WebInvocationState
Complete (String -> WebInvocationState)
-> (Text -> String) -> Text -> WebInvocationState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
      Text -> m (Either Text ())
forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> m (Either Text ())
runBaseCode Text
uinput
        m (Either Text ()) -> (Either Text () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (Either Text () -> IO ()) -> Either Text () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebInvocationState -> IO ()
ureply (WebInvocationState -> IO ())
-> (Either Text () -> WebInvocationState)
-> Either Text ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
          Left Text
err -> RejectionReason -> WebInvocationState
Rejected (RejectionReason -> WebInvocationState)
-> (String -> RejectionReason) -> String -> WebInvocationState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RejectionReason
ParseError (String -> WebInvocationState) -> String -> WebInvocationState
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
err
          Right () -> WebInvocationState
InProgress

runBaseCode :: (MonadState ScenarioState m) => T.Text -> m (Either Text ())
runBaseCode :: forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> m (Either Text ())
runBaseCode Text
uinput = do
  REPLHistItemType -> Text -> m ()
forall (m :: * -> *).
MonadState ScenarioState m =>
REPLHistItemType -> Text -> m ()
addREPLHistItem (REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
Submitted) Text
uinput
  Text -> REPLPrompt -> m ()
forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
  Env
env <- Env -> Maybe Env -> Env
forall a. a -> Maybe a -> a
fromMaybe Env
emptyEnv (Maybe Env -> Env) -> m (Maybe Env) -> m Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (First Env) ScenarioState Env -> m (Maybe Env)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse ((GameState -> Const (First Env) GameState)
-> ScenarioState -> Const (First Env) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (First Env) GameState)
 -> ScenarioState -> Const (First Env) ScenarioState)
-> ((Env -> Const (First Env) Env)
    -> GameState -> Const (First Env) GameState)
-> Getting (First Env) ScenarioState Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const (First Env) Env)
-> GameState -> Const (First Env) GameState
Traversal' GameState Env
baseEnv)
  case Env -> Text -> Either Text (Maybe TSyntax)
processTerm' Env
env Text
uinput of
    Right Maybe TSyntax
mt -> do
      (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Bool -> Identity Bool) -> REPLState -> Identity REPLState)
-> (Bool -> Identity Bool)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Identity REPLHistory)
-> REPLState -> Identity REPLState
Lens' REPLState REPLHistory
replHistory ((REPLHistory -> Identity REPLHistory)
 -> REPLState -> Identity REPLState)
-> ((Bool -> Identity Bool) -> REPLHistory -> Identity REPLHistory)
-> (Bool -> Identity Bool)
-> REPLState
-> Identity REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> REPLHistory -> Identity REPLHistory
Lens' REPLHistory Bool
replHasExecutedManualInput ((Bool -> Identity Bool)
 -> ScenarioState -> Identity ScenarioState)
-> Bool -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      Maybe TSyntax -> m ()
forall (m :: * -> *).
MonadState ScenarioState m =>
Maybe TSyntax -> m ()
runBaseTerm Maybe TSyntax
mt
      Either Text () -> m (Either Text ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either Text ()
forall a b. b -> Either a b
Right ())
    Left Text
err -> do
      REPLHistItemType -> Text -> m ()
forall (m :: * -> *).
MonadState ScenarioState m =>
REPLHistItemType -> Text -> m ()
addREPLHistItem REPLHistItemType
REPLError Text
err
      Either Text () -> m (Either Text ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ()
forall a b. a -> Either a b
Left Text
err)

-- | Handle a user input event for the REPL.
--
-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleREPLEventTyping :: Menu -> BrickEvent Name AppEvent -> EventM Name PlayState ()
handleREPLEventTyping :: Menu -> BrickEvent Name AppEvent -> EventM Name PlayState ()
handleREPLEventTyping Menu
m = \case
  -- Scroll the REPL on PageUp or PageDown
  Key Key
V.KPageUp -> ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
replScroll Direction
Brick.Up
  Key Key
V.KPageDown -> ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
replScroll Direction
Brick.Down
  BrickEvent Name AppEvent
k -> do
    -- On any other key event, jump to the bottom of the REPL then handle the event
    ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
replScroll
    case BrickEvent Name AppEvent
k of
      Key Key
V.KEnter -> ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
(ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
        ScenarioState
s <- EventM Name ScenarioState ScenarioState
forall s (m :: * -> *). MonadState s m => m s
get
        let theRepl :: REPLState
theRepl = ScenarioState
s ScenarioState
-> Getting REPLState ScenarioState REPLState -> REPLState
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const REPLState UIGameplay)
-> ScenarioState -> Const REPLState ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const REPLState UIGameplay)
 -> ScenarioState -> Const REPLState ScenarioState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIGameplay -> Const REPLState UIGameplay)
-> Getting REPLState ScenarioState REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLState REPLState)
-> UIGameplay -> Const REPLState UIGameplay
Lens' UIGameplay REPLState
uiREPL
            uinput :: Text
uinput = REPLState
theRepl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText

        if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ScenarioState
s ScenarioState
-> ((Bool -> Const Bool Bool)
    -> ScenarioState -> Const Bool ScenarioState)
-> Bool
forall s a. s -> Getting a s a -> a
^. (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
. (GameControls -> Const Bool GameControls)
-> GameState -> Const Bool GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const Bool GameControls)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> GameControls -> Const Bool GameControls)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> GameControls -> Const Bool GameControls
Getter GameControls Bool
replWorking
          then case REPLState
theRepl REPLState -> Getting REPLPrompt REPLState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType of
            CmdPrompt [Text]
_ -> do
              EventM Name ScenarioState (Either Text ())
-> EventM Name ScenarioState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM Name ScenarioState (Either Text ())
 -> EventM Name ScenarioState ())
-> EventM Name ScenarioState (Either Text ())
-> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ Text -> EventM Name ScenarioState (Either Text ())
forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> m (Either Text ())
runBaseCode Text
uinput
              Name -> EventM Name ScenarioState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache
            SearchPrompt REPLHistory
hist ->
              case Text -> REPLHistory -> Maybe Text
lastEntry Text
uinput REPLHistory
hist of
                Maybe Text
Nothing -> Text -> REPLPrompt -> EventM Name ScenarioState ()
forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
                Just Text
found
                  | Text -> Bool
T.null Text
uinput -> Text -> REPLPrompt -> EventM Name ScenarioState ()
forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
                  | Bool
otherwise -> do
                      Text -> REPLPrompt -> EventM Name ScenarioState ()
forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
found ([Text] -> REPLPrompt
CmdPrompt [])
                      (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ScenarioState -> ScenarioState
validateREPLForm
          else EventM Name ScenarioState ()
forall n s. EventM n s ()
continueWithoutRedraw
      Key Key
V.KUp -> ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScenarioState -> ScenarioState) -> EventM Name ScenarioState ())
-> (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ TimeDir -> ScenarioState -> ScenarioState
adjReplHistIndex TimeDir
Older
      Key Key
V.KDown -> ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
        REPLState
repl <- Getting REPLState ScenarioState REPLState
-> EventM Name ScenarioState REPLState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting REPLState ScenarioState REPLState
 -> EventM Name ScenarioState REPLState)
-> Getting REPLState ScenarioState REPLState
-> EventM Name ScenarioState REPLState
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const REPLState UIGameplay)
-> ScenarioState -> Const REPLState ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const REPLState UIGameplay)
 -> ScenarioState -> Const REPLState ScenarioState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIGameplay -> Const REPLState UIGameplay)
-> Getting REPLState ScenarioState REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLState REPLState)
-> UIGameplay -> Const REPLState UIGameplay
Lens' UIGameplay REPLState
uiREPL
        let hist :: REPLHistory
hist = REPLState
repl REPLState
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> REPLHistory
forall s a. s -> Getting a s a -> a
^. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory
            uinput :: Text
uinput = REPLState
repl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
        case REPLState
repl REPLState -> Getting REPLPrompt REPLState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType of
          CmdPrompt {}
            | REPLHistory
hist REPLHistory -> Getting Int REPLHistory Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int REPLHistory Int
Lens' REPLHistory Int
replIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== REPLHistory -> Int
replLength REPLHistory
hist Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
uinput) ->
                -- Special case for hitting "Down" arrow while entering a new non-empty input:
                -- save the input in the history and make the REPL blank.
                do
                  REPLHistItemType -> Text -> EventM Name ScenarioState ()
forall (m :: * -> *).
MonadState ScenarioState m =>
REPLHistItemType -> Text -> m ()
addREPLHistItem (REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
Stashed) Text
uinput
                  Text -> REPLPrompt -> EventM Name ScenarioState ()
forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
                  (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ScenarioState -> ScenarioState
validateREPLForm
          -- Otherwise, just move around in the history as normal.
          REPLPrompt
_ -> (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ScenarioState -> ScenarioState) -> EventM Name ScenarioState ())
-> (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ TimeDir -> ScenarioState -> ScenarioState
adjReplHistIndex TimeDir
Newer
      ControlChar Char
'r' ->
        LensLike' (Zoomed (EventM Name REPLState) ()) PlayState REPLState
-> EventM Name REPLState () -> EventM Name PlayState ()
forall c.
LensLike' (Zoomed (EventM Name REPLState) c) PlayState REPLState
-> EventM Name REPLState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((ScenarioState -> Zoomed (EventM Name REPLState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name REPLState) () PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Zoomed (EventM Name REPLState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name REPLState) () PlayState)
-> ((REPLState -> Zoomed (EventM Name REPLState) () REPLState)
    -> ScenarioState
    -> Zoomed (EventM Name REPLState) () ScenarioState)
-> LensLike'
     (Zoomed (EventM Name REPLState) ()) PlayState REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
-> ScenarioState -> Zoomed (EventM Name REPLState) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
 -> ScenarioState
 -> Zoomed (EventM Name REPLState) () ScenarioState)
-> ((REPLState -> Zoomed (EventM Name REPLState) () REPLState)
    -> UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
-> (REPLState -> Zoomed (EventM Name REPLState) () REPLState)
-> ScenarioState
-> Zoomed (EventM Name REPLState) () ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Zoomed (EventM Name REPLState) () REPLState)
-> UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay
Lens' UIGameplay REPLState
uiREPL) (EventM Name REPLState () -> EventM Name PlayState ())
-> EventM Name REPLState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
          REPLState
uir <- EventM Name REPLState REPLState
forall s (m :: * -> *). MonadState s m => m s
get
          let uinput :: Text
uinput = REPLState
uir REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
          case REPLState
uir REPLState -> Getting REPLPrompt REPLState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType of
            CmdPrompt [Text]
_ -> (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> EventM Name REPLState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLHistory -> REPLPrompt
SearchPrompt (REPLState
uir REPLState
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> REPLHistory
forall s a. s -> Getting a s a -> a
^. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory)
            SearchPrompt REPLHistory
rh -> Maybe Text
-> (Text -> EventM Name REPLState ()) -> EventM Name REPLState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Text -> REPLHistory -> Maybe Text
lastEntry Text
uinput REPLHistory
rh) ((Text -> EventM Name REPLState ()) -> EventM Name REPLState ())
-> (Text -> EventM Name REPLState ()) -> EventM Name REPLState ()
forall a b. (a -> b) -> a -> b
$ \Text
found ->
              (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> EventM Name REPLState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLHistory -> REPLPrompt
SearchPrompt (Text -> REPLHistory -> REPLHistory
removeEntry Text
found REPLHistory
rh)
      CharKey Char
'\t' -> ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
        ScenarioState
s <- EventM Name ScenarioState ScenarioState
forall s (m :: * -> *). MonadState s m => m s
get
        let names :: [Text]
names = ScenarioState
s ScenarioState -> Getting (Endo [Text]) ScenarioState Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (GameState -> Const (Endo [Text]) GameState)
-> ScenarioState -> Const (Endo [Text]) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (Endo [Text]) GameState)
 -> ScenarioState -> Const (Endo [Text]) ScenarioState)
-> ((Text -> Const (Endo [Text]) Text)
    -> GameState -> Const (Endo [Text]) GameState)
-> Getting (Endo [Text]) ScenarioState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const (Endo [Text]) Env)
-> GameState -> Const (Endo [Text]) GameState
Traversal' GameState Env
baseEnv ((Env -> Const (Endo [Text]) Env)
 -> GameState -> Const (Endo [Text]) GameState)
-> ((Text -> Const (Endo [Text]) Text)
    -> Env -> Const (Endo [Text]) Env)
-> (Text -> Const (Endo [Text]) Text)
-> GameState
-> Const (Endo [Text]) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TCtx -> Const (Endo [Text]) TCtx)
-> Env -> Const (Endo [Text]) Env
Lens' Env TCtx
envTypes ((TCtx -> Const (Endo [Text]) TCtx)
 -> Env -> Const (Endo [Text]) Env)
-> ((Text -> Const (Endo [Text]) Text)
    -> TCtx -> Const (Endo [Text]) TCtx)
-> (Text -> Const (Endo [Text]) Text)
-> Env
-> Const (Endo [Text]) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TCtx -> [(Text, Polytype)])
-> ([(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)])
-> TCtx
-> Const (Endo [Text]) TCtx
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to TCtx -> [(Text, Polytype)]
forall v t. Ctx v t -> [(v, t)]
assocs (([(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)])
 -> TCtx -> Const (Endo [Text]) TCtx)
-> ((Text -> Const (Endo [Text]) Text)
    -> [(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)])
-> (Text -> Const (Endo [Text]) Text)
-> TCtx
-> Const (Endo [Text]) TCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Polytype) -> Const (Endo [Text]) (Text, Polytype))
-> [(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((Text, Polytype) -> Const (Endo [Text]) (Text, Polytype))
 -> [(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)])
-> ((Text -> Const (Endo [Text]) Text)
    -> (Text, Polytype) -> Const (Endo [Text]) (Text, Polytype))
-> (Text -> Const (Endo [Text]) Text)
-> [(Text, Polytype)]
-> Const (Endo [Text]) [(Text, Polytype)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> (Text, Polytype) -> Const (Endo [Text]) (Text, Polytype)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Text, Polytype) (Text, Polytype) Text Text
_1
        (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> ScenarioState -> Identity ScenarioState)
-> (REPLState -> REPLState) -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CompletionContext -> [Text] -> EntityMap -> REPLState -> REPLState
tabComplete (Bool -> CompletionContext
CompletionContext (ScenarioState
s ScenarioState
-> ((Bool -> Const Bool Bool)
    -> ScenarioState -> Const Bool ScenarioState)
-> Bool
forall s a. s -> Getting a s a -> a
^. (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)) [Text]
names (ScenarioState
s ScenarioState
-> Getting EntityMap ScenarioState EntityMap -> EntityMap
forall s a. s -> Getting a s a -> a
^. (GameState -> Const EntityMap GameState)
-> ScenarioState -> Const EntityMap ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const EntityMap GameState)
 -> ScenarioState -> Const EntityMap ScenarioState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> GameState -> Const EntityMap GameState)
-> Getting EntityMap ScenarioState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> (EntityMap -> Const EntityMap EntityMap)
-> GameState
-> Const EntityMap GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap)
        (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ScenarioState -> ScenarioState
validateREPLForm
      BrickEvent Name AppEvent
EscapeKey -> ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
(ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ do
        REPLPrompt
formSt <- Getting REPLPrompt ScenarioState REPLPrompt
-> EventM Name ScenarioState REPLPrompt
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting REPLPrompt ScenarioState REPLPrompt
 -> EventM Name ScenarioState REPLPrompt)
-> Getting REPLPrompt ScenarioState REPLPrompt
-> EventM Name ScenarioState REPLPrompt
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const REPLPrompt UIGameplay)
-> ScenarioState -> Const REPLPrompt ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const REPLPrompt UIGameplay)
 -> ScenarioState -> Const REPLPrompt ScenarioState)
-> ((REPLPrompt -> Const REPLPrompt REPLPrompt)
    -> UIGameplay -> Const REPLPrompt UIGameplay)
-> Getting REPLPrompt ScenarioState REPLPrompt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLPrompt REPLState)
-> UIGameplay -> Const REPLPrompt UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLPrompt REPLState)
 -> UIGameplay -> Const REPLPrompt UIGameplay)
-> Getting REPLPrompt REPLState REPLPrompt
-> (REPLPrompt -> Const REPLPrompt REPLPrompt)
-> UIGameplay
-> Const REPLPrompt UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType
        case REPLPrompt
formSt of
          CmdPrompt {} -> EventM Name ScenarioState ()
forall n s. EventM n s ()
continueWithoutRedraw
          SearchPrompt REPLHistory
_ -> Text -> REPLPrompt -> EventM Name ScenarioState ()
forall (m :: * -> *).
MonadState ScenarioState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
      ControlChar Char
'd' -> do
        Text
text <- Getting Text PlayState Text -> EventM Name PlayState Text
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Text PlayState Text -> EventM Name PlayState Text)
-> Getting Text PlayState Text -> EventM Name PlayState Text
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const Text ScenarioState)
-> PlayState -> Const Text PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const Text ScenarioState)
 -> PlayState -> Const Text PlayState)
-> ((Text -> Const Text Text)
    -> ScenarioState -> Const Text ScenarioState)
-> Getting Text PlayState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Text UIGameplay)
-> ScenarioState -> Const Text ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const Text UIGameplay)
 -> ScenarioState -> Const Text ScenarioState)
-> ((Text -> Const Text Text)
    -> UIGameplay -> Const Text UIGameplay)
-> (Text -> Const Text Text)
-> ScenarioState
-> Const Text ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const Text REPLState)
-> UIGameplay -> Const Text UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const Text REPLState)
 -> UIGameplay -> Const Text UIGameplay)
-> Getting Text REPLState Text
-> (Text -> Const Text Text)
-> UIGameplay
-> Const Text UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
        if Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
T.empty
          then EndScenarioModalType -> Menu -> EventM Name PlayState ()
toggleEndScenarioModal EndScenarioModalType
QuitModal Menu
m
          else EventM Name PlayState ()
forall n s. EventM n s ()
continueWithoutRedraw
      MetaKey Key
V.KBS ->
        ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$
          (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> UIGameplay -> Identity UIGameplay)
-> (Editor Text Name -> Identity (Editor Text Name))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> REPLState -> Identity REPLState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text Name -> Identity (Editor Text Name))
-> REPLState -> Identity REPLState
Lens' REPLState (Editor Text Name)
replPromptEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> ScenarioState -> Identity ScenarioState)
-> (Editor Text Name -> Editor Text Name)
-> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
forall a.
(Eq a, GenericTextZipper a) =>
TextZipper a -> TextZipper a
TZ.deletePrevWord
      -- finally if none match pass the event to the editor
      BrickEvent Name AppEvent
ev -> do
        LensLike'
  (Zoomed (EventM Name (Editor Text Name)) ())
  PlayState
  (Editor Text Name)
-> EventM Name (Editor Text Name) () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name (Editor Text Name)) c)
  PlayState
  (Editor Text Name)
-> EventM Name (Editor Text Name) c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState
  -> Focusing (StateT (EventState Name) IO) () ScenarioState)
 -> PlayState
 -> Focusing (StateT (EventState Name) IO) () PlayState)
-> ((Editor Text Name
     -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
    -> ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> (Editor Text Name
    -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
-> PlayState
-> Focusing (StateT (EventState Name) IO) () PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> ((Editor Text Name
     -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> (Editor Text Name
    -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
-> ScenarioState
-> Focusing (StateT (EventState Name) IO) () ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Focusing (StateT (EventState Name) IO) () REPLState)
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Focusing (StateT (EventState Name) IO) () REPLState)
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((Editor Text Name
     -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
    -> REPLState
    -> Focusing (StateT (EventState Name) IO) () REPLState)
-> (Editor Text Name
    -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text Name
 -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
-> REPLState -> Focusing (StateT (EventState Name) IO) () REPLState
Lens' REPLState (Editor Text Name)
replPromptEditor) (EventM Name (Editor Text Name) () -> EventM Name PlayState ())
-> EventM Name (Editor Text Name) () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ case BrickEvent Name AppEvent
ev of
          CharKey Char
c
            | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"([{" :: String) -> Char -> EventM Name (Editor Text Name) ()
insertMatchingPair Char
c
            | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
")]}" :: String) -> Char -> EventM Name (Editor Text Name) ()
insertOrMovePast Char
c
          BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name (Editor Text Name) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent BrickEvent Name AppEvent
ev
        (ScenarioState -> Identity ScenarioState)
-> PlayState -> Identity PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Identity ScenarioState)
 -> PlayState -> Identity PlayState)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> ScenarioState -> Identity ScenarioState)
-> (REPLPrompt -> Identity REPLPrompt)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLPrompt -> Identity REPLPrompt)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> REPLState -> Identity REPLState)
-> (REPLPrompt -> Identity REPLPrompt)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> PlayState -> Identity PlayState)
-> (REPLPrompt -> REPLPrompt) -> EventM Name PlayState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \case
          CmdPrompt [Text]
_ -> [Text] -> REPLPrompt
CmdPrompt [] -- reset completions on any event passed to editor
          SearchPrompt REPLHistory
a -> REPLHistory -> REPLPrompt
SearchPrompt REPLHistory
a

        -- Now re-validate the input, unless only the cursor moved.
        case BrickEvent Name AppEvent
ev of
          Key Key
V.KLeft -> () -> EventM Name PlayState ()
forall a. a -> EventM Name PlayState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Key Key
V.KRight -> () -> EventM Name PlayState ()
forall a. a -> EventM Name PlayState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          BrickEvent Name AppEvent
_ -> ((ScenarioState
  -> Zoomed (EventM Name ScenarioState) () ScenarioState)
 -> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState)
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) PlayState ScenarioState
-> EventM Name ScenarioState c -> EventM Name PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ScenarioState
 -> Zoomed (EventM Name ScenarioState) () ScenarioState)
-> PlayState -> Zoomed (EventM Name ScenarioState) () PlayState
Lens' PlayState ScenarioState
scenarioState (EventM Name ScenarioState () -> EventM Name PlayState ())
-> EventM Name ScenarioState () -> EventM Name PlayState ()
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> ScenarioState) -> EventM Name ScenarioState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ScenarioState -> ScenarioState
validateREPLForm

insertMatchingPair :: Char -> EventM Name (Editor Text Name) ()
insertMatchingPair :: Char -> EventM Name (Editor Text Name) ()
insertMatchingPair Char
c = (Editor Text Name -> Editor Text Name)
-> EventM Name (Editor Text Name) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Editor Text Name -> Editor Text Name)
 -> EventM Name (Editor Text Name) ())
-> ((TextZipper Text -> TextZipper Text)
    -> Editor Text Name -> Editor Text Name)
-> (TextZipper Text -> TextZipper Text)
-> EventM Name (Editor Text Name) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit ((TextZipper Text -> TextZipper Text)
 -> EventM Name (Editor Text Name) ())
-> (TextZipper Text -> TextZipper Text)
-> EventM Name (Editor Text Name) ()
forall a b. (a -> b) -> a -> b
$ Char -> TextZipper Text -> TextZipper Text
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
TZ.insertChar Char
c (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Char -> TextZipper Text -> TextZipper Text
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
TZ.insertChar (Char -> Char
close Char
c) (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
TZ.moveLeft
 where
  close :: Char -> Char
close = \case
    Char
'(' -> Char
')'
    Char
'[' -> Char
']'
    Char
'{' -> Char
'}'
    Char
_ -> Char
c

-- | Insert a character in an editor unless it matches the character
--   already at the cursor, in which case we just move past it
--   instead, without inserting an extra copy.
insertOrMovePast :: Char -> EventM Name (Editor Text Name) ()
insertOrMovePast :: Char -> EventM Name (Editor Text Name) ()
insertOrMovePast Char
c = do
  Editor Text Name
e <- EventM Name (Editor Text Name) (Editor Text Name)
forall s (m :: * -> *). MonadState s m => m s
get
  (Editor Text Name -> Editor Text Name)
-> EventM Name (Editor Text Name) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Editor Text Name -> Editor Text Name)
 -> EventM Name (Editor Text Name) ())
-> ((TextZipper Text -> TextZipper Text)
    -> Editor Text Name -> Editor Text Name)
-> (TextZipper Text -> TextZipper Text)
-> EventM Name (Editor Text Name) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit ((TextZipper Text -> TextZipper Text)
 -> EventM Name (Editor Text Name) ())
-> (TextZipper Text -> TextZipper Text)
-> EventM Name (Editor Text Name) ()
forall a b. (a -> b) -> a -> b
$ case TextZipper Text -> Maybe Char
forall a. TextZipper a -> Maybe Char
TZ.currentChar (Editor Text Name
e Editor Text Name
-> Getting (TextZipper Text) (Editor Text Name) (TextZipper Text)
-> TextZipper Text
forall s a. s -> Getting a s a -> a
^. Getting (TextZipper Text) (Editor Text Name) (TextZipper Text)
forall t1 n t2 (f :: * -> *).
Functor f =>
(TextZipper t1 -> f (TextZipper t2))
-> Editor t1 n -> f (Editor t2 n)
editContentsL) of
    Just Char
c' | Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c -> TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
TZ.moveRight
    Maybe Char
_ -> Char -> TextZipper Text -> TextZipper Text
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
TZ.insertChar Char
c

data CompletionType
  = FunctionName
  | EntityName
  deriving (CompletionType -> CompletionType -> Bool
(CompletionType -> CompletionType -> Bool)
-> (CompletionType -> CompletionType -> Bool) -> Eq CompletionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionType -> CompletionType -> Bool
== :: CompletionType -> CompletionType -> Bool
$c/= :: CompletionType -> CompletionType -> Bool
/= :: CompletionType -> CompletionType -> Bool
Eq)

newtype CompletionContext = CompletionContext {CompletionContext -> Bool
ctxCreativeMode :: Bool}
  deriving (CompletionContext -> CompletionContext -> Bool
(CompletionContext -> CompletionContext -> Bool)
-> (CompletionContext -> CompletionContext -> Bool)
-> Eq CompletionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionContext -> CompletionContext -> Bool
== :: CompletionContext -> CompletionContext -> Bool
$c/= :: CompletionContext -> CompletionContext -> Bool
/= :: CompletionContext -> CompletionContext -> Bool
Eq)

-- | Reserved words corresponding to commands that can only be used in
--   creative mode.  We only autocomplete to these when in creative mode.
creativeWords :: Set Text
creativeWords :: Set Text
creativeWords =
  [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
    ([Text] -> Set Text) -> ([Const] -> [Text]) -> [Const] -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ConstInfo -> Text
syntax (ConstInfo -> Text) -> (Const -> ConstInfo) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> ConstInfo
constInfo)
    ([Const] -> [Text]) -> ([Const] -> [Const]) -> [Const] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Bool) -> [Const] -> [Const]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Const
w -> Const -> Maybe Capability
constCaps Const
w Maybe Capability -> Maybe Capability -> Bool
forall a. Eq a => a -> a -> Bool
== Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CGod)
    ([Const] -> Set Text) -> [Const] -> Set Text
forall a b. (a -> b) -> a -> b
$ [Const]
allConst

-- | Try to complete the last word in a partially-entered REPL prompt using
--   reserved words and names in scope (in the case of function names) or
--   entity names (in the case of string literals).
tabComplete :: CompletionContext -> [Text] -> EntityMap -> REPLState -> REPLState
tabComplete :: CompletionContext -> [Text] -> EntityMap -> REPLState -> REPLState
tabComplete CompletionContext {Bool
ctxCreativeMode :: CompletionContext -> Bool
ctxCreativeMode :: Bool
..} [Text]
names EntityMap
em REPLState
theRepl = case REPLState
theRepl REPLState -> Getting REPLPrompt REPLState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType of
  SearchPrompt REPLHistory
_ -> REPLState
theRepl
  CmdPrompt [Text]
mms
    -- Case 1: If completion candidates have already been
    -- populated via case (3), cycle through them.
    -- Note that tabbing through the candidates *does* update the value
    -- of "t", which one might think would narrow the candidate list
    -- to only that match and therefore halt the cycling.
    -- However, the candidate list only gets recomputed (repopulated)
    -- if the user subsequently presses a non-Tab key. Thus the current
    -- value of "t" is ignored for all Tab presses subsequent to the
    -- first.
    | (Text
m : [Text]
ms) <- [Text]
mms -> Text -> [Text] -> REPLState
setCmd (Text -> Text
replacementFunc Text
m) ([Text]
ms [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
m])
    -- Case 2: Require at least one letter to be typed in order to offer completions for
    -- function names.
    -- We allow suggestions for Entity Name strings without anything having been typed.
    | Text -> Bool
T.null Text
lastWord Bool -> Bool -> Bool
&& CompletionType
completionType CompletionType -> CompletionType -> Bool
forall a. Eq a => a -> a -> Bool
== CompletionType
FunctionName -> Text -> [Text] -> REPLState
setCmd Text
t []
    -- Case 3: Typing another character in the REPL clears the completion candidates from
    -- the CmdPrompt, so when Tab is pressed again, this case then gets executed and
    -- repopulates them.
    | Bool
otherwise -> case [Text]
candidateMatches of
        [] -> Text -> [Text] -> REPLState
setCmd Text
t []
        [Text
m] -> Text -> [Text] -> REPLState
setCmd (Text -> Text
completeWith Text
m) []
        -- Perform completion with the first candidate, then populate the list
        -- of all candidates with the current completion moved to the back
        -- of the queue.
        (Text
m : [Text]
ms) -> Text -> [Text] -> REPLState
setCmd (Text -> Text
completeWith Text
m) ([Text]
ms [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
m])
 where
  -- checks the "parity" of the number of quotes. If odd, then there is an open quote.
  hasOpenQuotes :: Text -> Bool
hasOpenQuotes = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2) (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
"\""

  completionType :: CompletionType
completionType =
    if Text -> Bool
hasOpenQuotes Text
t
      then CompletionType
EntityName
      else CompletionType
FunctionName

  replacementFunc :: Text -> Text
replacementFunc = Text -> Text -> Text
T.append (Text -> Text -> Text) -> Text -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
replacementBoundaryPredicate Text
t
  completeWith :: Text -> Text
completeWith Text
m = Text -> Text -> Text
T.append Text
t (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
lastWord) Text
m
  lastWord :: Text
lastWord = (Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
replacementBoundaryPredicate Text
t
  candidateMatches :: [Text]
candidateMatches = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text
lastWord Text -> Text -> Bool
`T.isPrefixOf`) [Text]
replacementCandidates

  ([Text]
replacementCandidates, Char -> Bool
replacementBoundaryPredicate) = case CompletionType
completionType of
    CompletionType
EntityName -> ([Text]
entityNames, (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))
    CompletionType
FunctionName -> ([Text]
possibleWords, Char -> Bool
isIdentChar)

  possibleWords :: [Text]
possibleWords =
    [Text]
names [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (if Bool
ctxCreativeMode then Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
reservedWords else Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Set Text
reservedWords Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Text
creativeWords)

  entityNames :: [Text]
entityNames = Map Text Entity -> [Text]
forall k a. Map k a -> [k]
M.keys (Map Text Entity -> [Text]) -> Map Text Entity -> [Text]
forall a b. (a -> b) -> a -> b
$ EntityMap -> Map Text Entity
entitiesByName EntityMap
em

  t :: Text
t = REPLState
theRepl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
  setCmd :: Text -> [Text] -> REPLState
setCmd Text
nt [Text]
ms =
    REPLState
theRepl
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> REPLState -> Identity REPLState
Lens' REPLState Text
replPromptText ((Text -> Identity Text) -> REPLState -> Identity REPLState)
-> Text -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
nt
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt [Text]
ms

-- | Validate the REPL input when it changes: see if it parses and
--   typechecks, and set the color accordingly.
validateREPLForm :: ScenarioState -> ScenarioState
validateREPLForm :: ScenarioState -> ScenarioState
validateREPLForm ScenarioState
s =
  case REPLPrompt
replPrompt of
    CmdPrompt [Text]
_
      | Text -> Bool
T.null Text
uinput ->
          let theType :: Maybe Polytype
theType = ScenarioState
s ScenarioState
-> Getting (Maybe Polytype) ScenarioState (Maybe Polytype)
-> Maybe Polytype
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe Polytype) GameState)
-> ScenarioState -> Const (Maybe Polytype) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (Maybe Polytype) GameState)
 -> ScenarioState -> Const (Maybe Polytype) ScenarioState)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> GameState -> Const (Maybe Polytype) GameState)
-> Getting (Maybe Polytype) ScenarioState (Maybe Polytype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Const (Maybe Polytype) GameControls)
-> GameState -> Const (Maybe Polytype) GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const (Maybe Polytype) GameControls)
 -> GameState -> Const (Maybe Polytype) GameState)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> GameControls -> Const (Maybe Polytype) GameControls)
-> (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> GameState
-> Const (Maybe Polytype) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLStatus -> Const (Maybe Polytype) REPLStatus)
-> GameControls -> Const (Maybe Polytype) GameControls
Lens' GameControls REPLStatus
replStatus ((REPLStatus -> Const (Maybe Polytype) REPLStatus)
 -> GameControls -> Const (Maybe Polytype) GameControls)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> REPLStatus -> Const (Maybe Polytype) REPLStatus)
-> (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> GameControls
-> Const (Maybe Polytype) GameControls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> REPLStatus -> Const (Maybe Polytype) REPLStatus
Getter REPLStatus (Maybe Polytype)
replActiveType
           in ScenarioState
s ScenarioState -> (ScenarioState -> ScenarioState) -> ScenarioState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> REPLState -> Identity REPLState)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Polytype -> Identity (Maybe Polytype))
-> REPLState -> Identity REPLState
Lens' REPLState (Maybe Polytype)
replType ((Maybe Polytype -> Identity (Maybe Polytype))
 -> ScenarioState -> Identity ScenarioState)
-> Maybe Polytype -> ScenarioState -> ScenarioState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
    CmdPrompt [Text]
_
      | Bool
otherwise ->
          let env :: Env
env = Env -> Maybe Env -> Env
forall a. a -> Maybe a -> a
fromMaybe Env
emptyEnv (Maybe Env -> Env) -> Maybe Env -> Env
forall a b. (a -> b) -> a -> b
$ ScenarioState
s ScenarioState -> Getting (First Env) ScenarioState Env -> Maybe Env
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Const (First Env) GameState)
-> ScenarioState -> Const (First Env) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (First Env) GameState)
 -> ScenarioState -> Const (First Env) ScenarioState)
-> ((Env -> Const (First Env) Env)
    -> GameState -> Const (First Env) GameState)
-> Getting (First Env) ScenarioState Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const (First Env) Env)
-> GameState -> Const (First Env) GameState
Traversal' GameState Env
baseEnv
              (Maybe Polytype
theType, Either SrcLoc ()
errSrcLoc) = case ParserConfig -> Text -> Either ParserError (Maybe Syntax)
readTerm' ParserConfig
defaultParserConfig Text
uinput of
                Left ParserError
err ->
                  let ((Int
_y1, Int
x1), (Int
_y2, Int
x2), Text
_msg) = ParserError -> ((Int, Int), (Int, Int), Text)
showErrorPos ParserError
err
                   in (Maybe Polytype
forall a. Maybe a
Nothing, SrcLoc -> Either SrcLoc ()
forall a b. a -> Either a b
Left (Int -> Int -> SrcLoc
SrcLoc Int
x1 Int
x2))
                Right Maybe Syntax
Nothing -> (Maybe Polytype
forall a. Maybe a
Nothing, () -> Either SrcLoc ()
forall a b. b -> Either a b
Right ())
                Right (Just Syntax
theTerm) -> case Env -> Syntax -> Either ContextualTypeErr TSyntax
processParsedTerm' Env
env Syntax
theTerm of
                  Right TSyntax
t -> (Polytype -> Maybe Polytype
forall a. a -> Maybe a
Just (TSyntax
t TSyntax -> Getting Polytype TSyntax Polytype -> Polytype
forall s a. s -> Getting a s a -> a
^. Getting Polytype TSyntax Polytype
forall ty (f :: * -> *).
Functor f =>
(ty -> f ty) -> Syntax' ty -> f (Syntax' ty)
sType), () -> Either SrcLoc ()
forall a b. b -> Either a b
Right ())
                  Left ContextualTypeErr
err -> (Maybe Polytype
forall a. Maybe a
Nothing, SrcLoc -> Either SrcLoc ()
forall a b. a -> Either a b
Left (ContextualTypeErr -> SrcLoc
cteSrcLoc ContextualTypeErr
err))
           in ScenarioState
s
                ScenarioState -> (ScenarioState -> ScenarioState) -> ScenarioState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Either SrcLoc () -> Identity (Either SrcLoc ()))
    -> UIGameplay -> Identity UIGameplay)
-> (Either SrcLoc () -> Identity (Either SrcLoc ()))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Either SrcLoc () -> Identity (Either SrcLoc ()))
    -> REPLState -> Identity REPLState)
-> (Either SrcLoc () -> Identity (Either SrcLoc ()))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either SrcLoc () -> Identity (Either SrcLoc ()))
-> REPLState -> Identity REPLState
Lens' REPLState (Either SrcLoc ())
replValid ((Either SrcLoc () -> Identity (Either SrcLoc ()))
 -> ScenarioState -> Identity ScenarioState)
-> Either SrcLoc () -> ScenarioState -> ScenarioState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Either SrcLoc ()
errSrcLoc
                ScenarioState -> (ScenarioState -> ScenarioState) -> ScenarioState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> REPLState -> Identity REPLState)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Polytype -> Identity (Maybe Polytype))
-> REPLState -> Identity REPLState
Lens' REPLState (Maybe Polytype)
replType ((Maybe Polytype -> Identity (Maybe Polytype))
 -> ScenarioState -> Identity ScenarioState)
-> Maybe Polytype -> ScenarioState -> ScenarioState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
    SearchPrompt REPLHistory
_ -> ScenarioState
s
 where
  uinput :: Text
uinput = ScenarioState
s ScenarioState
-> ((Text -> Const Text Text)
    -> ScenarioState -> Const Text ScenarioState)
-> Text
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const Text UIGameplay)
-> ScenarioState -> Const Text ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const Text UIGameplay)
 -> ScenarioState -> Const Text ScenarioState)
-> ((Text -> Const Text Text)
    -> UIGameplay -> Const Text UIGameplay)
-> (Text -> Const Text Text)
-> ScenarioState
-> Const Text ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const Text REPLState)
-> UIGameplay -> Const Text UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const Text REPLState)
 -> UIGameplay -> Const Text UIGameplay)
-> Getting Text REPLState Text
-> (Text -> Const Text Text)
-> UIGameplay
-> Const Text UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
  replPrompt :: REPLPrompt
replPrompt = ScenarioState
s ScenarioState
-> Getting REPLPrompt ScenarioState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const REPLPrompt UIGameplay)
-> ScenarioState -> Const REPLPrompt ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const REPLPrompt UIGameplay)
 -> ScenarioState -> Const REPLPrompt ScenarioState)
-> ((REPLPrompt -> Const REPLPrompt REPLPrompt)
    -> UIGameplay -> Const REPLPrompt UIGameplay)
-> Getting REPLPrompt ScenarioState REPLPrompt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLPrompt REPLState)
-> UIGameplay -> Const REPLPrompt UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLPrompt REPLState)
 -> UIGameplay -> Const REPLPrompt UIGameplay)
-> Getting REPLPrompt REPLState REPLPrompt
-> (REPLPrompt -> Const REPLPrompt REPLPrompt)
-> UIGameplay
-> Const REPLPrompt UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType

-- | Update our current position in the REPL history.
adjReplHistIndex :: TimeDir -> ScenarioState -> ScenarioState
adjReplHistIndex :: TimeDir -> ScenarioState -> ScenarioState
adjReplHistIndex TimeDir
d ScenarioState
s =
  ScenarioState
s
    ScenarioState -> (ScenarioState -> ScenarioState) -> ScenarioState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> ScenarioState -> Identity ScenarioState)
-> (REPLState -> REPLState) -> ScenarioState -> ScenarioState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ REPLState -> REPLState
moveREPL
    ScenarioState -> (ScenarioState -> ScenarioState) -> ScenarioState
forall a b. a -> (a -> b) -> b
& ScenarioState -> ScenarioState
validateREPLForm
 where
  moveREPL :: REPLState -> REPLState
  moveREPL :: REPLState -> REPLState
moveREPL REPLState
theRepl =
    REPLState
newREPL
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& Bool -> (REPLState -> REPLState) -> REPLState -> REPLState
forall a. Bool -> (a -> a) -> a -> a
applyWhen (REPLHistory -> Bool
replIndexIsAtInput (REPLState
theRepl REPLState
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> REPLHistory
forall s a. s -> Getting a s a -> a
^. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory)) REPLState -> REPLState
saveLastEntry
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& Bool -> (REPLState -> REPLState) -> REPLState -> REPLState
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Text
oldEntry Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
newEntry) REPLState -> REPLState
showNewEntry
   where
    -- new AppState after moving the repl index
    newREPL :: REPLState
    newREPL :: REPLState
newREPL = REPLState
theRepl REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (REPLHistory -> Identity REPLHistory)
-> REPLState -> Identity REPLState
Lens' REPLState REPLHistory
replHistory ((REPLHistory -> Identity REPLHistory)
 -> REPLState -> Identity REPLState)
-> (REPLHistory -> REPLHistory) -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex TimeDir
d Text
oldEntry

    saveLastEntry :: REPLState -> REPLState
saveLastEntry = (Text -> Identity Text) -> REPLState -> Identity REPLState
Lens' REPLState Text
replLast ((Text -> Identity Text) -> REPLState -> Identity REPLState)
-> Text -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLState
theRepl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
    showNewEntry :: REPLState -> REPLState
showNewEntry = ((Editor Text Name -> Identity (Editor Text Name))
-> REPLState -> Identity REPLState
Lens' REPLState (Editor Text Name)
replPromptEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> REPLState -> Identity REPLState)
-> Editor Text Name -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Editor Text Name
newREPLEditor Text
newEntry) (REPLState -> REPLState)
-> (REPLState -> REPLState) -> REPLState -> REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt [])
    -- get REPL data
    getCurrEntry :: REPLState -> Text
getCurrEntry = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (REPLState
theRepl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replLast) (Maybe Text -> Text)
-> (REPLState -> Maybe Text) -> REPLState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistory -> Maybe Text
getCurrentItemText (REPLHistory -> Maybe Text)
-> (REPLState -> REPLHistory) -> REPLState -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((REPLHistory -> Const REPLHistory REPLHistory)
 -> REPLState -> Const REPLHistory REPLState)
-> REPLState -> REPLHistory
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory
    oldEntry :: Text
oldEntry = REPLState -> Text
getCurrEntry REPLState
theRepl
    newEntry :: Text
newEntry = REPLState -> Text
getCurrEntry REPLState
newREPL

------------------------------------------------------------
-- Info panel events
------------------------------------------------------------

-- | Handle user events in the info panel (just scrolling).
--
-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleInfoPanelEvent :: ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name s ()
handleInfoPanelEvent :: forall s.
ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name s ()
handleInfoPanelEvent ViewportScroll Name
vs = \case
  Key Key
V.KDown -> ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs Int
1
  Key Key
V.KUp -> ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs (-Int
1)
  CharKey Char
'k' -> ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs Int
1
  CharKey Char
'j' -> ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs (-Int
1)
  Key Key
V.KPageDown -> ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
vs Direction
Brick.Down
  Key Key
V.KPageUp -> ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
vs Direction
Brick.Up
  Key Key
V.KHome -> ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll Name
vs
  Key Key
V.KEnd -> ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
vs
  BrickEvent Name AppEvent
_ -> () -> EventM Name s ()
forall a. a -> EventM Name s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * Util

getScenariosAfterSelection ::
  BL.GenericList n V.Vector (ScenarioItem a) ->
  Int ->
  [ScenarioWith a]
getScenariosAfterSelection :: forall n a.
GenericList n Vector (ScenarioItem a) -> Int -> [ScenarioWith a]
getScenariosAfterSelection GenericList n Vector (ScenarioItem a)
m Int
selIndex =
  [ScenarioWith a
x | SISingle ScenarioWith a
x <- Vector (ScenarioItem a) -> [ScenarioItem a]
forall a. Vector a -> [a]
V.toList Vector (ScenarioItem a)
remaining]
 where
  remaining :: Vector (ScenarioItem a)
remaining = (Vector (ScenarioItem a), Vector (ScenarioItem a))
-> Vector (ScenarioItem a)
forall a b. (a, b) -> b
snd ((Vector (ScenarioItem a), Vector (ScenarioItem a))
 -> Vector (ScenarioItem a))
-> (Vector (ScenarioItem a), Vector (ScenarioItem a))
-> Vector (ScenarioItem a)
forall a b. (a -> b) -> a -> b
$ Int
-> Vector (ScenarioItem a)
-> (Vector (ScenarioItem a), Vector (ScenarioItem a))
forall a. Int -> Vector a -> (Vector a, Vector a)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
BL.splitAt (Int
selIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Vector (ScenarioItem a)
 -> (Vector (ScenarioItem a), Vector (ScenarioItem a)))
-> Vector (ScenarioItem a)
-> (Vector (ScenarioItem a), Vector (ScenarioItem a))
forall a b. (a -> b) -> a -> b
$ GenericList n Vector (ScenarioItem a) -> Vector (ScenarioItem a)
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements GenericList n Vector (ScenarioItem a)
m