{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- |
-- 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,
  runFrame,
  ticksPerFrameCap,
  runFrameTicks,
  runGameTickUI,
  runGameTick,
  updateUI,

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

  -- ** World panel
  handleWorldEvent,
  keyToDir,
  scrollView,
  adjustTPS,

  -- ** Info panel
  handleInfoPanelEvent,

  -- ** Utils
  getTutorials,
) where

import Brick hiding (Direction, Location)
import Brick.Focus
import Brick.Widgets.Dialog
import Brick.Widgets.Edit (handleEditorEvent)
import Brick.Widgets.List (handleListEvent)
import Brick.Widgets.List qualified as BL
import Control.Applicative (liftA2, pure)
import Control.Carrier.Lift qualified as Fused
import Control.Carrier.State.Lazy qualified as Fused
import Control.Lens as Lens
import Control.Lens.Extras as Lens (is)
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.Bits
import Data.Either (isRight)
import Data.Foldable (toList)
import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time (getZonedTime)
import Data.Vector qualified as V
import Graphics.Vty qualified as V
import Linear
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Achievement.Persistence
import Swarm.Game.CESK (CESK (Out), Frame (FApp, FExec), cancel, emptyStore, initMachine)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Location
import Swarm.Game.ResourceLoading (getSwarmHistoryPath)
import Swarm.Game.Robot
import Swarm.Game.ScenarioInfo
import Swarm.Game.State
import Swarm.Game.Step (finishGameTick, gameTick)
import Swarm.Language.Capability (Capability (CDebug, CMake))
import Swarm.Language.Context
import Swarm.Language.Key (KeyCombo, mkKeyCombo)
import Swarm.Language.Module
import Swarm.Language.Parse (reservedWords)
import Swarm.Language.Pipeline
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Pretty
import Swarm.Language.Requirement qualified as R
import Swarm.Language.Syntax hiding (Key)
import Swarm.Language.Typed (Typed (..))
import Swarm.Language.Types
import Swarm.Language.Value (Value (VKey, VUnit), prettyValue, stripVResult)
import Swarm.Log
import Swarm.TUI.Controller.Util
import Swarm.TUI.Editor.Controller qualified as EC
import Swarm.TUI.Editor.Model
import Swarm.TUI.Inventory.Sorting (cycleSortDirection, cycleSortOrder)
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.Goal
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.StateUpdate
import Swarm.TUI.Model.UI
import Swarm.TUI.View.Objective qualified as GR
import Swarm.TUI.View.Util (generateModal)
import Swarm.Util hiding (both, (<<.=))
import Swarm.Version (NewReleaseFailure (..))
import System.Clock
import System.FilePath (splitDirectories)
import Witch (into)
import Prelude hiding (Applicative (..)) -- See Note [liftA2 re-export from Prelude]

-- ~~~~ Note [liftA2 re-export from Prelude]
--
-- As of base-4.18 (GHC 9.6), liftA2 is re-exported from Prelude.  See
-- https://github.com/haskell/core-libraries-committee/issues/50 .  In
-- order to compile warning-free on both GHC 9.6 and older versions,
-- we hide the import of Applicative functions from Prelude and import
-- explicitly from Control.Applicative.  In theory, if at some point
-- in the distant future we end up dropping support for GHC < 9.6 then
-- we could get rid of both explicit imports and just get liftA2 and
-- pure implicitly from Prelude.

tutorialsDirname :: FilePath
tutorialsDirname :: FilePath
tutorialsDirname = FilePath
"Tutorials"

-- | The top-level event handler for the TUI.
handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent = \case
  -- the query for upstream version could finish at any time, so we have to handle it here
  AppEvent (UpstreamVersion Either NewReleaseFailure FilePath
ev) -> do
    let logReleaseEvent :: LogSource -> Severity -> a -> m ()
logReleaseEvent LogSource
l Severity
sev a
e = Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Notifications LogEntry)
eventLog 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
l Severity
sev Text
"Release" (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show a
e)
    case Either NewReleaseFailure FilePath
ev of
      Left NewReleaseFailure
e ->
        let sev :: Severity
sev = case NewReleaseFailure
e of
              FailedReleaseQuery {} -> Severity
Error
              OnDevelopmentBranch {} -> Severity
Info
              NewReleaseFailure
_ -> Severity
Warning
         in forall {m :: * -> *} {a}.
(MonadState AppState m, Show a) =>
LogSource -> Severity -> a -> m ()
logReleaseEvent LogSource
SystemLog Severity
sev NewReleaseFailure
e
      Right FilePath
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Either NewReleaseFailure FilePath)
upstreamRelease forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Either NewReleaseFailure FilePath
ev
  BrickEvent Name AppEvent
e -> do
    AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
    if AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiPlaying
      then BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent BrickEvent Name AppEvent
e
      else
        BrickEvent Name AppEvent
e forall a b. a -> (a -> b) -> b
& case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu of
          -- 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 -> forall a b. a -> b -> a
const forall n s. EventM n s ()
halt
          MainMenu List Name MainMenuEntry
l -> List Name MainMenuEntry
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent List Name MainMenuEntry
l
          NewGameMenu NonEmpty (List Name ScenarioItem)
l ->
            if AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls FileBrowserControl
fileBrowser forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileBrowserControl Bool
fbIsDisplayed
              then BrickEvent Name AppEvent -> EventM Name AppState ()
handleFBEvent
              else case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (Maybe ScenarioInfoPair)
isDisplayedFor of
                Maybe ScenarioInfoPair
Nothing -> NonEmpty (List Name ScenarioItem)
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent NonEmpty (List Name ScenarioItem)
l
                Just ScenarioInfoPair
siPair -> ScenarioInfoPair
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleLaunchOptionsEvent ScenarioInfoPair
siPair
          Menu
MessagesMenu -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent
          AchievementsMenu List Name CategorizedAchievement
l -> List Name CategorizedAchievement
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainAchievementsEvent List Name CategorizedAchievement
l
          Menu
AboutMenu -> Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey (List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
About))

-- | The event handler for the main menu.
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 ->
    case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name MainMenuEntry
menu of
      Maybe MainMenuEntry
Nothing -> forall n s. EventM n s ()
continueWithoutRedraw
      Just MainMenuEntry
x0 -> case MainMenuEntry
x0 of
        MainMenuEntry
NewGame -> do
          Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
          ScenarioCollection
ss <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState ScenarioCollection
scenarios
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
ss)
        MainMenuEntry
Tutorial -> do
          -- Set up the menu stack as if the user had chosen "New Game > Tutorials"
          Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
          ScenarioCollection
ss <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState ScenarioCollection
scenarios
          let tutorialCollection :: ScenarioCollection
tutorialCollection = ScenarioCollection -> ScenarioCollection
getTutorials ScenarioCollection
ss
              topMenu :: List Name ScenarioItem
topMenu =
                forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy
                  ((forall a. Eq a => a -> a -> Bool
== FilePath
tutorialsDirname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioItem -> Text
scenarioItemName)
                  (Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
ss)
              tutorialMenu :: List Name ScenarioItem
tutorialMenu = Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
tutorialCollection
              menuStack :: NonEmpty (List Name ScenarioItem)
menuStack = List Name ScenarioItem
tutorialMenu forall a. a -> [a] -> NonEmpty a
:| forall (f :: * -> *) a. Applicative f => a -> f a
pure List Name ScenarioItem
topMenu
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu NonEmpty (List Name ScenarioItem)
menuStack

          -- Extract the first tutorial challenge and run it
          let firstTutorial :: ScenarioInfoPair
firstTutorial = case ScenarioCollection -> Maybe [FilePath]
scOrder ScenarioCollection
tutorialCollection of
                Just (FilePath
t : [FilePath]
_) -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
t (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
tutorialCollection) of
                  Just (SISingle ScenarioInfoPair
siPair) -> ScenarioInfoPair
siPair
                  Maybe ScenarioItem
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"No first tutorial found!"
                Maybe [FilePath]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"No first tutorial found!"
          forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
firstTutorial forall a. Maybe a
Nothing
        MainMenuEntry
Achievements -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name CategorizedAchievement -> Menu
AchievementsMenu (forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
AchievementList (forall a. [a] -> Vector a
V.fromList [CategorizedAchievement]
listAchievements) Int
1)
        MainMenuEntry
Messages -> do
          Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState (Notifications LogEntry)
eventLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Int
notificationsCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
MessagesMenu
        MainMenuEntry
About -> do
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
AboutMenu
          forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
CategorizedAchievement -> m ()
attainAchievement forall a b. (a -> b) -> a -> b
$ GlobalAchievement -> CategorizedAchievement
GlobalAchievement GlobalAchievement
LookedAtAboutScreen
        MainMenuEntry
Quit -> forall n s. EventM n s ()
halt
  CharKey Char
'q' -> forall n s. EventM n s ()
halt
  ControlChar Char
'q' -> forall n s. EventM n s ()
halt
  VtyEvent Event
ev -> do
    List Name MainMenuEntry
menu' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name MainMenuEntry
menu (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu 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
_ -> forall n s. EventM n s ()
continueWithoutRedraw

getTutorials :: ScenarioCollection -> ScenarioCollection
getTutorials :: ScenarioCollection -> ScenarioCollection
getTutorials ScenarioCollection
sc = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
tutorialsDirname (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
sc) of
  Just (SICollection Text
_ ScenarioCollection
c) -> ScenarioCollection
c
  Maybe ScenarioItem
_ -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"No tutorials exist: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show ScenarioCollection
sc

-- | 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 = Prism' Menu (NonEmpty (List Name ScenarioItem))
_NewGameMenu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ 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' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name CategorizedAchievement
l (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu 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
_ -> forall n s. EventM n s ()
continueWithoutRedraw
 where
  returnToMainMenu :: EventM Name AppState ()
returnToMainMenu = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu 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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  returnToMainMenu :: EventM Name AppState ()
returnToMainMenu = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu 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)

handleNewGameMenuEvent ::
  NonEmpty (BL.List Name ScenarioItem) ->
  BrickEvent Name AppEvent ->
  EventM Name AppState ()
handleNewGameMenuEvent :: NonEmpty (List Name ScenarioItem)
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent scenarioStack :: NonEmpty (List Name ScenarioItem)
scenarioStack@(List Name ScenarioItem
curMenu :| [List Name ScenarioItem]
rest) = \case
  Key Key
V.KEnter ->
    case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name ScenarioItem
curMenu of
      Maybe ScenarioItem
Nothing -> forall n s. EventM n s ()
continueWithoutRedraw
      Just (SISingle ScenarioInfoPair
siPair) -> forall n s. Ord n => EventM n s ()
invalidateCache forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
siPair forall a. Maybe a
Nothing
      Just (SICollection Text
_ ScenarioCollection
c) -> do
        Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
c) NonEmpty (List Name ScenarioItem)
scenarioStack)
  CharKey Char
'o' -> EventM Name AppState ()
showLaunchDialog
  CharKey Char
'O' -> EventM Name AppState ()
showLaunchDialog
  Key Key
V.KEsc -> NonEmpty (List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name ScenarioItem)
scenarioStack
  CharKey Char
'q' -> NonEmpty (List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name ScenarioItem)
scenarioStack
  ControlChar Char
'q' -> forall n s. EventM n s ()
halt
  VtyEvent Event
ev -> do
    List Name ScenarioItem
menu' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name ScenarioItem
curMenu (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (List Name ScenarioItem
menu' forall a. a -> [a] -> NonEmpty a
:| [List Name ScenarioItem]
rest)
  BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
 where
  showLaunchDialog :: EventM Name AppState ()
showLaunchDialog = case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name ScenarioItem
curMenu of
    Just (SISingle ScenarioInfoPair
siPair) -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig) forall a b. (a -> b) -> a -> b
$ ScenarioInfoPair -> EventM Name LaunchOptions ()
prepareLaunchDialog ScenarioInfoPair
siPair
    Maybe ScenarioItem
_ -> forall n s. EventM n s ()
continueWithoutRedraw

exitNewGameMenu :: NonEmpty (BL.List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu :: NonEmpty (List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name ScenarioItem)
stk = do
  Lens' AppState UIState
uiState
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case forall a b. (a, b) -> b
snd (forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons NonEmpty (List Name ScenarioItem)
stk) of
      Maybe (NonEmpty (List Name ScenarioItem))
Nothing -> List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
NewGame)
      Just NonEmpty (List Name ScenarioItem)
stk' -> NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu NonEmpty (List Name ScenarioItem)
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]
_)) = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
m
pressAnyKey Menu
_ BrickEvent Name AppEvent
_ = forall n s. EventM n s ()
continueWithoutRedraw

-- | The top-level event handler while we are running the game itself.
handleMainEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent BrickEvent Name AppEvent
ev = do
  AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
  Maybe ModalType
mt <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Modal ModalType
modalType
  let isRunning :: Bool
isRunning = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ModalType -> Bool
isRunningModal Maybe ModalType
mt
  let isPaused :: Bool
isPaused = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter TemporalState Bool
paused
  let isCreative :: Bool
isCreative = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode
  let hasDebug :: Bool
hasDebug = forall a. a -> Maybe a -> a
fromMaybe Bool
isCreative forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot (Set Capability)
robotCapabilities forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
Lens.contains Capability
CDebug
  case BrickEvent Name AppEvent
ev of
    AppEvent AppEvent
ae -> case AppEvent
ae of
      AppEvent
Frame
        | AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter TemporalState Bool
paused -> forall n s. EventM n s ()
continueWithoutRedraw
        | Bool
otherwise -> EventM Name AppState ()
runFrameUI
      Web (RunWebCode Text
c) -> forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseWebCode Text
c
      AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
    -- ctrl-q works everywhere
    ControlChar Char
'q' ->
      case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition of
        WinConditions (Won Bool
_) ObjectiveCompletion
_ -> ModalType -> EventM Name AppState ()
toggleModal forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
WinModal
        WinConditions (Unwinnable Bool
_) ObjectiveCompletion
_ -> ModalType -> EventM Name AppState ()
toggleModal forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
LoseModal
        WinCondition
_ -> ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
    VtyEvent (V.EvResize Int
_ Int
_) -> forall n s. Ord n => EventM n s ()
invalidateCache
    Key Key
V.KEsc
      | Just Modal
m <- AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal -> do
          EventM Name AppState ()
safeAutoUnpause
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
          -- message modal is not autopaused, so update notifications when leaving it
          case Modal
m forall s a. s -> Getting a s a -> a
^. Lens' Modal ModalType
modalType of
            ModalType
MessagesModal -> do
              Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages TickNumber
lastSeenMessageTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
            ModalType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    FKey Int
1 -> ModalType -> EventM Name AppState ()
toggleModal ModalType
HelpModal
    FKey Int
2 -> ModalType -> EventM Name AppState ()
toggleModal ModalType
RobotsModal
    FKey Int
3 | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications (Recipe Entity))
availableRecipes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent)) -> do
      ModalType -> EventM Name AppState ()
toggleModal ModalType
RecipesModal
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications (Recipe Entity))
availableRecipes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Int
notificationsCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
    FKey Int
4 | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications Const)
availableCommands forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent)) -> do
      ModalType -> EventM Name AppState ()
toggleModal ModalType
CommandsModal
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications Const)
availableCommands forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Notifications a) Int
notificationsCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
    FKey Int
5 | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameState (Notifications LogEntry)
messageNotifications forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent)) -> do
      ModalType -> EventM Name AppState ()
toggleModal ModalType
MessagesModal
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages TickNumber
lastSeenMessageTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
    -- show goal
    ControlChar Char
'g' ->
      if GoalTracking -> Bool
hasAnythingToShow forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay GoalTracking
goalsContent
        then ModalType -> EventM Name AppState ()
toggleModal ModalType
GoalModal
        else forall n s. EventM n s ()
continueWithoutRedraw
    -- hide robots
    MetaChar Char
'h' -> do
      TimeSpec
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
      TimeSpec
h <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
uiHideRobotsUntil
      if TimeSpec
h forall a. Ord a => a -> a -> Bool
>= TimeSpec
t
        then -- ignore repeated keypresses
          forall n s. EventM n s ()
continueWithoutRedraw
        else -- hide for two seconds
        do
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
uiHideRobotsUntil forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
t forall a. Num a => a -> a -> a
+ Int64 -> Int64 -> TimeSpec
TimeSpec Int64
2 Int64
0
          forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
    -- debug focused robot
    MetaChar Char
'd' | Bool
isPaused Bool -> Bool -> Bool
&& Bool
hasDebug -> do
      Bool
debug <- Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowDebug forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
Lens.<%= Bool -> Bool
not
      if Bool
debug
        then Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SingleStep -> Step
RobotStep SingleStep
SBefore
        else forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
finishGameTick forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Functor f => f a -> f ()
void EventM Name AppState Bool
updateUI
    -- pausing and stepping
    ControlChar Char
'p' | Bool
isRunning -> EventM Name AppState ()
safeTogglePause
    ControlChar Char
'o' | Bool
isRunning -> do
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RunStatus
runStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RunStatus
ManualPause
      EventM Name AppState ()
runGameTickUI
    -- speed controls
    ControlChar Char
'x' | Bool
isRunning -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> AppState -> AppState
adjustTPS forall a. Num a => a -> a -> a
(+)
    ControlChar Char
'z' | Bool
isRunning -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> AppState -> AppState
adjustTPS (-)
    -- special keys that work on all panels
    MetaChar Char
'w' -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
WorldPanel
    MetaChar Char
'e' -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
RobotPanel
    MetaChar Char
'r' -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
REPLPanel
    MetaChar Char
't' -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
InfoPanel
    -- pass keys on to modal event handler if a modal is open
    VtyEvent Event
vev
      | forall a. Maybe a -> Bool
isJust (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal) -> Event -> EventM Name AppState ()
handleModalEvent Event
vev
    -- toggle creative mode if in "cheat mode"

    MouseDown (TerrainListItem Int
pos) Button
V.BLeft [Modifier]
_ Location
_ ->
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n TerrainType)
terrainList forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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
_ ->
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n EntityFacade)
entityPaintList forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
pos
    ControlChar Char
'v'
      | AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode -> Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
    -- toggle world editor mode if in "cheat mode"
    ControlChar Char
'e'
      | AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode -> do
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) WorldOverdraw
worldOverdraw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' WorldOverdraw Bool
isWorldEditorEnabled forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
          FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
WorldEditorPanel
    MouseDown Name
WorldPositionIndicator Button
_ [Modifier]
_ Location
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Cosmic Coords))
uiWorldCursor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BMiddle [Modifier]
_ Location
mouseLoc ->
      -- Eye Dropper tool
      Location -> EventM Name AppState ()
EC.handleMiddleClick Location
mouseLoc
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BRight [Modifier]
_ Location
mouseLoc ->
      -- Eraser tool
      Location -> EventM Name AppState ()
EC.handleRightClick Location
mouseLoc
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BLeft [Modifier
V.MCtrl] Location
mouseLoc ->
      -- Paint with the World Editor
      Location -> EventM Name AppState ()
EC.handleCtrlLeftClick Location
mouseLoc
    -- toggle collapse/expand REPL
    MetaChar Char
',' -> do
      forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowREPL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
    MouseDown Name
n Button
_ [Modifier]
_ Location
mouseLoc ->
      case Name
n of
        FocusablePanel FocusablePanel
WorldPanel -> do
          Maybe (Cosmic Coords)
mouseCoordsM <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom Lens' AppState GameState
gameState forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
          Bool
shouldUpdateCursor <- Maybe (Cosmic Coords) -> EventM Name AppState Bool
EC.updateAreaBounds Maybe (Cosmic Coords)
mouseCoordsM
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdateCursor forall a b. (a -> b) -> a -> b
$
            Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe (Cosmic Coords))
uiWorldCursor 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
        Name
_ -> forall n s. EventM n s ()
continueWithoutRedraw
    MouseUp Name
n Maybe Button
_ Location
_mouseLoc -> do
      case Name
n of
        InventoryListItem Int
pos -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (FocusRing n)
editorFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent Name
x
          WorldEditorFocusable -> EventM Name AppState ()
EC.activateWorldEditorFunction WorldEditorFocusable
y
        Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust FocusablePanel -> EventM Name AppState ()
setFocus forall a b. (a -> b) -> a -> b
$ case Name
n of
        -- Adapt click event origin to their right panel.
        -- For the REPL and the World view, using 'Brick.Widgets.Core.clickable' correctly set the origin.
        -- However this does not seems to work for the robot and info panel.
        -- Thus we force the destination focus here.
        Name
InventoryList -> forall a. a -> Maybe a
Just FocusablePanel
RobotPanel
        InventoryListItem Int
_ -> forall a. a -> Maybe a
Just FocusablePanel
RobotPanel
        Name
InfoViewport -> forall a. a -> Maybe a
Just FocusablePanel
InfoPanel
        Name
REPLInput -> forall a. a -> Maybe a
Just FocusablePanel
REPLPanel
        WorldEditorPanelControl WorldEditorFocusable
_ -> forall a. a -> Maybe a
Just FocusablePanel
WorldEditorPanel
        Name
_ -> forall a. Maybe a
Nothing
      case Name
n of
        FocusablePanel FocusablePanel
x -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
x
        Name
_ -> 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing
      case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fring of
        Just (FocusablePanel FocusablePanel
x) -> (forall a b. (a -> b) -> a -> b
$ BrickEvent Name AppEvent
ev) forall a b. (a -> b) -> a -> b
$ case FocusablePanel
x of
          FocusablePanel
REPLPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent
          FocusablePanel
WorldPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEvent
          FocusablePanel
WorldEditorPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
EC.handleWorldEditorPanelEvent
          FocusablePanel
RobotPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent
          FocusablePanel
InfoPanel -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
infoScroll
        Maybe Name
_ -> forall n s. EventM n s ()
continueWithoutRedraw

-- | Set the game to Running if it was (auto) paused otherwise to paused.
--
-- Also resets the last frame time to now. If we are pausing, it
-- doesn't matter; if we are unpausing, this is critical to
-- ensure the next frame doesn't think it has to catch up from
-- whenever the game was paused!
safeTogglePause :: EventM Name AppState ()
safeTogglePause :: EventM Name AppState ()
safeTogglePause = do
  TimeSpec
curTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastFrameTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowDebug forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
  RunStatus
p <- Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RunStatus
runStatus forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
Lens.<%= RunStatus -> RunStatus
toggleRunStatus
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunStatus
p forall a. Eq a => a -> a -> Bool
== RunStatus
Running) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
finishGameTick

-- | Only unpause the game if leaving autopaused modal.
--
-- Note that the game could have been paused before opening
-- the modal, in that case, leave the game paused.
safeAutoUnpause :: EventM Name AppState ()
safeAutoUnpause :: EventM Name AppState ()
safeAutoUnpause = do
  RunStatus
runs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RunStatus
runStatus
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RunStatus
runs forall a. Eq a => a -> a -> Bool
== RunStatus
AutoPause) EventM Name AppState ()
safeTogglePause

toggleModal :: ModalType -> EventM Name AppState ()
toggleModal :: ModalType -> EventM Name AppState ()
toggleModal ModalType
mt = do
  Maybe Modal
modal <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal
  case Maybe Modal
modal of
    Maybe Modal
Nothing -> ModalType -> EventM Name AppState ()
openModal ModalType
mt
    Just Modal
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name AppState ()
safeAutoUnpause

handleModalEvent :: V.Event -> EventM Name AppState ()
handleModalEvent :: Event -> EventM Name AppState ()
handleModalEvent = \case
  V.EvKey Key
V.KEnter [] -> do
    Maybe (Dialog ButtonAction Name)
mdialog <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Modal (Dialog ButtonAction Name)
modalDialog
    ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
    case forall n a. Eq n => Dialog a n -> Maybe (n, a)
dialogSelection forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Dialog ButtonAction Name)
mdialog of
      Just (Button Button
QuitButton, ButtonAction
_) -> EventM Name AppState ()
quitGame
      Just (Button Button
KeepPlayingButton, ButtonAction
_) -> ModalType -> EventM Name AppState ()
toggleModal ModalType
KeepPlayingModal
      Just (Button Button
StartOverButton, StartOver Int
currentSeed ScenarioInfoPair
siPair) -> do
        forall n s. Ord n => EventM n s ()
invalidateCache
        forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Int -> ScenarioInfoPair -> m ()
restartGame Int
currentSeed ScenarioInfoPair
siPair
      Just (Button Button
NextButton, Next ScenarioInfoPair
siPair) -> do
        EventM Name AppState ()
quitGame
        forall n s. Ord n => EventM n s ()
invalidateCache
        forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
siPair forall a. Maybe a
Nothing
      Maybe (Name, ButtonAction)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Event
ev -> do
    forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Modal (Dialog ButtonAction Name)
modalDialog) (forall n a. Event -> EventM n (Dialog a n) ()
handleDialogEvent Event
ev)
    Maybe ModalType
modal <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Modal ModalType
modalType
    case Maybe ModalType
modal of
      Just ModalType
TerrainPaletteModal ->
        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 forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n TerrainType)
terrainList
      Just ModalType
EntityPaletteModal -> do
        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 forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (WorldEditor Name)
uiWorldEditor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Lens' (WorldEditor n) (List n EntityFacade)
entityPaintList
      Just ModalType
GoalModal -> case Event
ev of
        V.EvKey (V.KChar Char
'\t') [] -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay (FocusRing Name)
focus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
        Event
_ -> do
          FocusRing Name
focused <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay (FocusRing Name)
focus
          case 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay (List Name GoalEntry)
listWidget
                List Name GoalEntry
newList <- 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
                Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay (List Name GoalEntry)
listWidget 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 AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
            Maybe Name
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
      Maybe ModalType
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (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 = forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList n t GoalEntry
lw forall a b. (a -> b) -> a -> b
$ 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 = 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)
z forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
BL.handleListEvent Event
ev

getNormalizedCurrentScenarioPath :: (MonadIO m, MonadState AppState m) => m (Maybe FilePath)
getNormalizedCurrentScenarioPath :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
m (Maybe FilePath)
getNormalizedCurrentScenarioPath =
  -- the path should be normalized and good to search in scenario collection
  forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (Maybe FilePath)
currentScenarioPath) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Just FilePath
p' -> do
      ScenarioCollection
gs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState ScenarioCollection
scenarios
      forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *).
MonadIO m =>
ScenarioCollection -> FilePath -> m FilePath
normalizeScenarioPath ScenarioCollection
gs FilePath
p')

saveScenarioInfoOnFinish :: (MonadIO m, MonadState AppState m) => FilePath -> m (Maybe ScenarioInfo)
saveScenarioInfoOnFinish :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
FilePath -> m (Maybe ScenarioInfo)
saveScenarioInfoOnFinish FilePath
p = do
  Maybe ProcessedTerm
initialRunCode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe ProcessedTerm)
initiallyRunCode
  ZonedTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
  WinCondition
wc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition
  let won :: Bool
won = case WinCondition
wc of
        WinConditions (Won Bool
_) ObjectiveCompletion
_ -> Bool
True
        WinCondition
_ -> Bool
False
  TickNumber
ts <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks

  -- NOTE: This traversal is apparently not the same one as used by
  -- the scenario selection menu, so the menu needs to be updated separately.
  -- See Note [scenario menu update]
  let currentScenarioInfo :: Traversal' AppState ScenarioInfo
      currentScenarioInfo :: Traversal' AppState ScenarioInfo
currentScenarioInfo = Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState ScenarioCollection
scenarios forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath FilePath
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2

  REPLHistory
replHist <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory
  let determinator :: CodeSizeDeterminators
determinator = Maybe ProcessedTerm -> Bool -> CodeSizeDeterminators
CodeSizeDeterminators Maybe ProcessedTerm
initialRunCode forall a b. (a -> b) -> a -> b
$ REPLHistory
replHist forall s a. s -> Getting a s a -> a
^. Lens' REPLHistory Bool
replHasExecutedManualInput
  Traversal' AppState ScenarioInfo
currentScenarioInfo
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CodeSizeDeterminators
-> ZonedTime -> TickNumber -> Bool -> ScenarioInfo -> ScenarioInfo
updateScenarioInfoOnFinish CodeSizeDeterminators
determinator ZonedTime
t TickNumber
ts Bool
won
  Maybe ScenarioInfo
status <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse Traversal' AppState ScenarioInfo
currentScenarioInfo
  case Maybe ScenarioInfo
status of
    Maybe ScenarioInfo
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just ScenarioInfo
si -> do
      let segments :: [FilePath]
segments = FilePath -> [FilePath]
splitDirectories FilePath
p
      case [FilePath]
segments of
        FilePath
firstDir : [FilePath]
_ -> do
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
won Bool -> Bool -> Bool
&& FilePath
firstDir forall a. Eq a => a -> a -> Bool
== FilePath
tutorialsDirname) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ZonedTime -> Maybe FilePath -> CategorizedAchievement -> m ()
attainAchievement' ZonedTime
t (forall a. a -> Maybe a
Just FilePath
p) (GlobalAchievement -> CategorizedAchievement
GlobalAchievement GlobalAchievement
CompletedSingleTutorial)
        [FilePath]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> ScenarioInfo -> IO ()
saveScenarioInfo FilePath
p ScenarioInfo
si
  forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ScenarioInfo
status

-- | Write the @ScenarioInfo@ out to disk when finishing a game (i.e. on winning or exit).
saveScenarioInfoOnFinishNocheat :: (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnFinishNocheat :: forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnFinishNocheat = do
  -- Don't save progress if we are in cheat mode
  Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cheat forall a b. (a -> b) -> a -> b
$ do
    -- the path should be normalized and good to search in scenario collection
    forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
m (Maybe FilePath)
getNormalizedCurrentScenarioPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just FilePath
p -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
FilePath -> m (Maybe ScenarioInfo)
saveScenarioInfoOnFinish FilePath
p

-- | Write the @ScenarioInfo@ out to disk when exiting a game.
saveScenarioInfoOnQuit :: (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit :: forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit = do
  -- Don't save progress if we are in cheat mode
  -- NOTE This check is duplicated in "saveScenarioInfoOnFinishNocheat"
  Bool
cheat <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cheat forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
m (Maybe FilePath)
getNormalizedCurrentScenarioPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just FilePath
p -> do
        Maybe ScenarioInfo
maybeSi <- forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
FilePath -> m (Maybe ScenarioInfo)
saveScenarioInfoOnFinish FilePath
p
        -- Note [scenario menu update]
        -- Ensures that the scenario selection menu gets updated
        -- with the high score/completion status
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
          Maybe ScenarioInfo
maybeSi
          ( Lens' AppState UIState
uiState
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Menu (NonEmpty (List Name ScenarioItem))
_NewGameMenu
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
Traversal' (GenericList n t e) e
BL.listSelectedElementL
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ScenarioItem ScenarioInfoPair
_SISingle
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
              forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=
          )

        -- See what scenario is currently focused in the menu.  Depending on how the
        -- previous scenario ended (via quit vs. via win), it might be the same as
        -- currentScenarioPath or it might be different.
        Maybe FilePath
curPath <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' Menu (NonEmpty (List Name ScenarioItem))
_NewGameMenu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
Traversal' (GenericList n t e) e
BL.listSelectedElementL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ScenarioInfo FilePath
scenarioPath
        -- Now rebuild the NewGameMenu so it gets the updated ScenarioInfo,
        -- being sure to preserve the same focused scenario.
        ScenarioCollection
sc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState RuntimeState
runtimeState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RuntimeState ScenarioCollection
scenarios
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Bool -> ScenarioCollection -> FilePath -> Maybe Menu
mkNewGameMenu Bool
cheat ScenarioCollection
sc (forall a. a -> Maybe a -> a
fromMaybe FilePath
p Maybe FilePath
curPath)) (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)

-- | 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 :: EventM Name AppState ()
quitGame :: EventM Name AppState ()
quitGame = do
  -- Write out REPL history.
  REPLHistory
history <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory
  let hist :: [Text]
hist = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe REPLHistItem -> Maybe Text
getREPLEntry forall a b. (a -> b) -> a -> b
$ Int -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems forall a. Bounded a => a
maxBound REPLHistory
history
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (FilePath -> Text -> IO ()
`T.appendFile` [Text] -> Text
T.unlines [Text]
hist) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO FilePath
getSwarmHistoryPath Bool
True

  -- Save scenario status info.
  forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit

  -- Automatically advance the menu to the next scenario iff the
  -- player has won the current one.
  WinCondition
wc <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition
  case WinCondition
wc of
    WinConditions (Won Bool
_) ObjectiveCompletion
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Menu -> Menu
advanceMenu
    WinCondition
_ -> 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).
  Menu
menu <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Menu
uiMenu
  case Menu
menu of
    Menu
NoMenu -> forall n s. EventM n s ()
halt
    Menu
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiPlaying forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

------------------------------------------------------------
-- Handling Frame events
------------------------------------------------------------

-- | Run the game for a single /frame/ (/i.e./ screen redraw), then
--   update the UI.  Depending on how long it is taking to draw each
--   frame, and how many ticks per second we are trying to achieve,
--   this may involve stepping the game any number of ticks (including
--   zero).
runFrameUI :: EventM Name AppState ()
runFrameUI :: EventM Name AppState ()
runFrameUI = do
  EventM Name AppState ()
runFrame
  Bool
redraw <- EventM Name AppState Bool
updateUI
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
redraw forall n s. EventM n s ()
continueWithoutRedraw

-- | Run the game for a single frame, without updating the UI.
runFrame :: EventM Name AppState ()
runFrame :: EventM Name AppState ()
runFrame = do
  -- Reset the needsRedraw flag.  While processing the frame and stepping the robots,
  -- the flag will get set to true if anything changes that requires redrawing the
  -- world (e.g. a robot moving or disappearing).
  Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
needsRedraw forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

  -- The logic here is taken from https://gafferongames.com/post/fix_your_timestep/ .

  -- Find out how long the previous frame took, by subtracting the
  -- previous time from the current time.
  TimeSpec
prevTime <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastFrameTime)
  TimeSpec
curTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  let frameTime :: TimeSpec
frameTime = TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
curTime TimeSpec
prevTime

  -- Remember now as the new previous time.
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastFrameTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime

  -- We now have some additional accumulated time to play with.  The
  -- idea is to now "catch up" by doing as many ticks as are supposed
  -- to fit in the accumulated time.  Some accumulated time may be
  -- left over, but it will roll over to the next frame.  This way we
  -- deal smoothly with things like a variable frame rate, the frame
  -- rate not being a nice multiple of the desired ticks per second,
  -- etc.
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
accumulatedTime forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= TimeSpec
frameTime

  -- Figure out how many ticks per second we're supposed to do,
  -- and compute the timestep `dt` for a single tick.
  Int
lgTPS <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
lgTicksPerSecond)
  let oneSecond :: Integer
oneSecond = Integer
1_000_000_000 -- one second = 10^9 nanoseconds
      dt :: Integer
dt
        | Int
lgTPS forall a. Ord a => a -> a -> Bool
>= Int
0 = Integer
oneSecond forall a. Integral a => a -> a -> a
`div` (Integer
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
lgTPS)
        | Bool
otherwise = Integer
oneSecond forall a. Num a => a -> a -> a
* (Integer
1 forall a. Bits a => a -> Int -> a
`shiftL` forall a. Num a => a -> a
abs Int
lgTPS)

  -- Update TPS/FPS counters every second
  TimeSpec
infoUpdateTime <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastInfoTime)
  let updateTime :: Integer
updateTime = TimeSpec -> Integer
toNanoSecs forall a b. (a -> b) -> a -> b
$ TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
curTime TimeSpec
infoUpdateTime
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
updateTime forall a. Ord a => a -> a -> Bool
>= Integer
oneSecond) forall a b. (a -> b) -> a -> b
$ do
    -- Wait for at least one second to have elapsed
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeSpec
infoUpdateTime forall a. Eq a => a -> a -> Bool
/= TimeSpec
0) forall a b. (a -> b) -> a -> b
$ do
      -- set how much frame got processed per second
      Int
frames <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameCount)
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Double
uiFPS forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
frames forall a. Num a => a -> a -> a
* forall a. Num a => Integer -> a
fromInteger Integer
oneSecond) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
updateTime

      -- set how much ticks got processed per frame
      Int
uiTicks <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
tickCount)
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Double
uiTPF forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
uiTicks forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frames

      -- ensure this frame gets drawn
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
needsRedraw forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

    -- Reset the counter and wait another seconds for the next update
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
tickCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
lastInfoTime forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TimeSpec
curTime

  -- Increment the frame count
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameCount forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1

  -- Now do as many ticks as we need to catch up.
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameTickCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
  TimeSpec -> EventM Name AppState ()
runFrameTicks (Integer -> TimeSpec
fromNanoSecs Integer
dt)

ticksPerFrameCap :: Int
ticksPerFrameCap :: Int
ticksPerFrameCap = Int
30

-- | Do zero or more ticks, with each tick notionally taking the given
--   timestep, until we have used up all available accumulated time,
--   OR until we have hit the cap on ticks per frame, whichever comes
--   first.
runFrameTicks :: TimeSpec -> EventM Name AppState ()
runFrameTicks :: TimeSpec -> EventM Name AppState ()
runFrameTicks TimeSpec
dt = do
  TimeSpec
a <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
accumulatedTime)
  Int
t <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameTickCount)

  -- Ensure there is still enough time left, and we haven't hit the
  -- tick limit for this frame.
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeSpec
a forall a. Ord a => a -> a -> Bool
>= TimeSpec
dt Bool -> Bool -> Bool
&& Int
t forall a. Ord a => a -> a -> Bool
< Int
ticksPerFrameCap) forall a b. (a -> b) -> a -> b
$ do
    -- If so, do a tick, count it, subtract dt from the accumulated time,
    -- and loop!
    EventM Name AppState ()
runGameTick
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
tickCount forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
frameTickCount forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState TimeSpec
accumulatedTime forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
-= TimeSpec
dt
    TimeSpec -> EventM Name AppState ()
runFrameTicks TimeSpec
dt

-- | Run the game for a single tick, and update the UI.
runGameTickUI :: EventM Name AppState ()
runGameTickUI :: EventM Name AppState ()
runGameTickUI = EventM Name AppState ()
runGameTick forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Functor f => f a -> f ()
void EventM Name AppState Bool
updateUI

-- | Modifies the game state using a fused-effect state action.
zoomGameState :: (MonadState AppState m, MonadIO m) => Fused.StateC GameState (Fused.LiftC IO) a -> m a
zoomGameState :: forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
zoomGameState StateC GameState (LiftC IO) a
f = do
  GameState
gs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' AppState GameState
gameState
  (GameState
gs', a
a) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a. LiftC m a -> m a
Fused.runM (forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
Fused.runState GameState
gs StateC GameState (LiftC IO) a
f))
  Lens' AppState GameState
gameState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GameState
gs'
  forall (m :: * -> *) a. Monad m => a -> m a
return a
a

updateAchievements :: EventM Name AppState ()
updateAchievements :: EventM Name AppState ()
updateAchievements = do
  -- Merge the in-game achievements with the master list in UIState
  Map GameplayAchievement Attainment
achievementsFromGame <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Map GameplayAchievement Attainment)
gameAchievements
  let wrappedGameAchievements :: Map CategorizedAchievement Attainment
wrappedGameAchievements = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys GameplayAchievement -> CategorizedAchievement
GameplayAchievement Map GameplayAchievement Attainment
achievementsFromGame

  Map CategorizedAchievement Attainment
oldMasterAchievementsList <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Map CategorizedAchievement Attainment)
uiAchievements
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Map CategorizedAchievement Attainment)
uiAchievements forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map CategorizedAchievement Attainment
wrappedGameAchievements

  -- Don't save to disk unless there was a change in the attainment list.
  let incrementalAchievements :: Map CategorizedAchievement Attainment
incrementalAchievements = Map CategorizedAchievement Attainment
wrappedGameAchievements forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map CategorizedAchievement Attainment
oldMasterAchievementsList
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map CategorizedAchievement Attainment
incrementalAchievements) forall a b. (a -> b) -> a -> b
$ do
    -- TODO: #916 This is where new achievements would be displayed in a popup
    Map CategorizedAchievement Attainment
newAchievements <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Map CategorizedAchievement Attainment)
uiAchievements
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Attainment] -> IO ()
saveAchievementsInfo forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map CategorizedAchievement Attainment
newAchievements

-- | Run the game for a single tick (/without/ updating the UI).
--   Every robot is given a certain amount of maximum computation to
--   perform a single world action (like moving, turning, grabbing,
--   etc.).
runGameTick :: EventM Name AppState ()
runGameTick :: EventM Name AppState ()
runGameTick = do
  Bool
ticked <- forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m Bool
gameTick
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ticked EventM Name AppState ()
updateAchievements

-- | Update the UI.  This function is used after running the
--   game for some number of ticks.
updateUI :: EventM Name AppState Bool
updateUI :: EventM Name AppState Bool
updateUI = do
  EventM Name AppState ()
loadVisibleRegion

  -- If the game state indicates a redraw is needed, invalidate the
  -- world cache so it will be redrawn.
  GameState
g <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' AppState GameState
gameState
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
needsRedraw) forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache

  -- The hash of the robot whose inventory is currently displayed (if any)
  Maybe Int
listRobotHash <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory)

  -- The hash of the focused robot (if any)
  Maybe Robot
fr <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe Robot
focusedRobot)
  let focusedRobotHash :: Maybe Int
focusedRobotHash = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter Robot Int
inventoryHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
fr

  -- Check if the inventory list needs to be updated.
  Bool
shouldUpdate <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate)

  -- Whether the focused robot is too far away to sense, & whether
  -- that has recently changed
  Maybe RobotRange
dist <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Maybe RobotRange
focusedRange)
  Bool
farOK <- forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode)) (forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable))
  let tooFar :: Bool
tooFar = Bool -> Bool
not Bool
farOK Bool -> Bool -> Bool
&& Maybe RobotRange
dist forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just RobotRange
Far
      farChanged :: Bool
farChanged = Bool
tooFar forall a. Eq a => a -> a -> Bool
/= forall a. Maybe a -> Bool
isNothing Maybe Int
listRobotHash

  -- If the robot moved in or out of range, or hashes don't match
  -- (either because which robot (or whether any robot) is focused
  -- changed, or the focused robot's inventory changed), or the
  -- inventory was flagged to be updated, regenerate the inventory list.
  Bool
inventoryUpdated <-
    if Bool
farChanged Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
farChanged Bool -> Bool -> Bool
&& Maybe Int
listRobotHash forall a. Eq a => a -> a -> Bool
/= Maybe Int
focusedRobotHash) Bool -> Bool -> Bool
|| Bool
shouldUpdate
      then do
        forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom Lens' AppState UIState
uiState forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadState UIState m => Maybe Robot -> m ()
populateInventoryList (if Bool
tooFar then forall a. Maybe a
Nothing else Maybe Robot
fr)
        (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

  -- Now check if the base finished running a program entered at the REPL.
  Bool
replUpdated <- case GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus of
    -- It did, and the result was the unit value.  Just reset replStatus.
    REPLWorking (Typed (Just Value
VUnit) Polytype
typ Requirements
reqs) -> do
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Typed Value) -> REPLStatus
REPLDone (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall v. v -> Polytype -> Requirements -> Typed v
Typed Value
VUnit Polytype
typ Requirements
reqs)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

    -- It did, and returned some other value.  Pretty-print the
    -- result as a REPL output, with its type, and reset the replStatus.
    REPLWorking (Typed (Just Value
v) Polytype
pty Requirements
reqs) -> do
      let finalType :: Polytype
finalType = Polytype -> Polytype
stripCmd Polytype
pty
      let val :: Typed Value
val = forall v. v -> Polytype -> Requirements -> Typed v
Typed (Value -> Value
stripVResult Value
v) Polytype
finalType Requirements
reqs
      Integer
itIx <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls Integer
replNextValueIndex)
      let itName :: Text
itName = forall a. IsString a => FilePath -> a
fromString forall a b. (a -> b) -> a -> b
$ FilePath
"it" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Integer
itIx
      let out :: Text
out = Text -> [Text] -> Text
T.intercalate Text
" " [Text
itName, Text
":", forall a. PrettyPrec a => a -> Text
prettyText Polytype
finalType, Text
"=", forall target source. From source target => source -> target
into (Value -> Text
prettyValue Value
v)]
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem (Text -> REPLHistItem
REPLOutput Text
out)
      forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache
      forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
replScroll
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Typed Value) -> REPLStatus
REPLDone (forall a. a -> Maybe a
Just Typed Value
val)
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
itName forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Typed Value
val
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls Integer
replNextValueIndex forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Num a => a -> a -> a
+ Integer
1)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

    -- Otherwise, do nothing.
    REPLStatus
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

  -- If the focused robot's log has been updated and the UI focus
  -- isn't currently on the inventory or info panels, attempt to
  -- automatically switch to the logger and scroll all the way down so
  -- the new message can be seen.
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiScrollToEnd forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
  Bool
logUpdated <- do
    -- If the inventory or info panels are currently focused, it would
    -- be rude to update them right under the user's nose, so consider
    -- them "sticky".  They will be updated as soon as the player moves
    -- the focus away.
    FocusRing Name
fring <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (FocusRing Name)
uiFocusRing
    let sticky :: Bool
sticky = forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fring forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusablePanel -> Name
FocusablePanel) [FocusablePanel
RobotPanel, FocusablePanel
InfoPanel]

    -- Check if the robot log was updated and we are allowed to change
    -- the inventory+info panels.
    case forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Robot Bool
robotLogUpdated) Maybe Robot
fr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
sticky of
      Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Bool
True -> do
        -- Reset the log updated flag
        forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m a
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
clearFocusedRobotLogUpdated

        -- Find and focus an equipped "logger" device in the inventory list.
        let isLogger :: InventoryListEntry -> Bool
isLogger (EquippedEntry Entity
e) = Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName forall a. Eq a => a -> a -> Bool
== Text
"logger"
            isLogger InventoryListEntry
_ = Bool
False
            focusLogger :: GenericList n Vector InventoryListEntry
-> GenericList n Vector InventoryListEntry
focusLogger = forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy InventoryListEntry -> Bool
isLogger

        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall {n}.
GenericList n Vector InventoryListEntry
-> GenericList n Vector InventoryListEntry
focusLogger

        -- Now inform the UI that it should scroll the info panel to
        -- the very end.
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiScrollToEnd forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

  Bool
goalOrWinUpdated <- EventM Name AppState Bool
doGoalUpdates

  let redraw :: Bool
redraw =
        GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
needsRedraw
          Bool -> Bool -> Bool
|| Bool
inventoryUpdated
          Bool -> Bool -> Bool
|| Bool
replUpdated
          Bool -> Bool -> Bool
|| Bool
logUpdated
          Bool -> Bool -> Bool
|| Bool
goalOrWinUpdated
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
redraw

-- | Either pops up the updated Goals modal
-- or pops up the Congratulations (Win) modal, or pops
-- up the Condolences (Lose) modal.
-- The Win modal will take precedence if the player
-- has met the necessary conditions to win the game.
--
-- If the player chooses to "Keep Playing" from the Win modal, the
-- updated Goals will then immediately appear.
-- This is desirable for:
-- * feedback as to the final goal the player accomplished,
-- * as a summary of all of the goals of the game
-- * shows the player more "optional" goals they can continue to pursue
doGoalUpdates :: EventM Name AppState Bool
doGoalUpdates :: EventM Name AppState Bool
doGoalUpdates = do
  GoalTracking
curGoal <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GoalDisplay GoalTracking
goalsContent)
  Bool
isCheating <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiCheatMode)
  WinCondition
curWinCondition <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition)
  Seq Announcement
announcementsSeq <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq Announcement)
announcementQueue)
  let announcementsList :: [Announcement]
announcementsList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Announcement
announcementsSeq

  -- Decide whether we need to update the current goal text and pop
  -- up a modal dialog.
  case WinCondition
curWinCondition of
    WinCondition
NoWinCondition -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    WinConditions (Unwinnable Bool
False) ObjectiveCompletion
x -> do
      -- This clears the "flag" that the Lose dialog needs to pop up
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions (Bool -> WinStatus
Unwinnable Bool
True) ObjectiveCompletion
x
      ModalType -> EventM Name AppState ()
openModal forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
LoseModal
      forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnFinishNocheat
      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    WinConditions (Won Bool
False) ObjectiveCompletion
x -> do
      -- This clears the "flag" that the Win dialog needs to pop up
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions (Bool -> WinStatus
Won Bool
True) ObjectiveCompletion
x
      ModalType -> EventM Name AppState ()
openModal forall a b. (a -> b) -> a -> b
$ ScenarioOutcome -> ModalType
ScenarioEndModal ScenarioOutcome
WinModal
      forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnFinishNocheat
      -- We do NOT advance the New Game menu to the next item here (we
      -- used to!), because we do not know if the user is going to
      -- select 'keep playing' or 'next challenge'.  We maintain the
      -- invariant that the current menu item is always the same as
      -- the scenario currently being played.  If the user either (1)
      -- quits to the menu or (2) selects 'next challenge' we will
      -- advance the menu at that point.
      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    WinConditions WinStatus
_ ObjectiveCompletion
oc -> do
      let newGoalTracking :: GoalTracking
newGoalTracking = [Announcement] -> CategorizedGoals -> GoalTracking
GoalTracking [Announcement]
announcementsList forall a b. (a -> b) -> a -> b
$ Bool -> ObjectiveCompletion -> CategorizedGoals
constructGoalMap Bool
isCheating ObjectiveCompletion
oc
          -- The "uiGoal" field is initialized with empty members, so we know that
          -- this will be the first time showing it if it will be nonempty after previously
          -- being empty.
          isFirstGoalDisplay :: Bool
isFirstGoalDisplay = GoalTracking -> Bool
hasAnythingToShow GoalTracking
newGoalTracking Bool -> Bool -> Bool
&& Bool -> Bool
not (GoalTracking -> Bool
hasAnythingToShow GoalTracking
curGoal)
          goalWasUpdated :: Bool
goalWasUpdated = Bool
isFirstGoalDisplay Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Announcement]
announcementsList)

      -- Decide whether to show a pop-up modal congratulating the user on
      -- successfully completing the current challenge.
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
goalWasUpdated forall a b. (a -> b) -> a -> b
$ do
        let hasMultiple :: Bool
hasMultiple = GoalTracking -> Bool
hasMultipleGoals GoalTracking
newGoalTracking
            defaultFocus :: GoalWidget
defaultFocus =
              if Bool
hasMultiple
                then GoalWidget
ObjectivesList
                else GoalWidget
GoalSummary

            ring :: FocusRing Name
ring =
              forall n. [n] -> FocusRing n
focusRing forall a b. (a -> b) -> a -> b
$
                forall a b. (a -> b) -> [a] -> [b]
map GoalWidget -> Name
GoalWidgets forall a b. (a -> b) -> a -> b
$
                  if Bool
hasMultiple
                    then forall e. (Enum e, Bounded e) => [e]
listEnums
                    else [GoalWidget
GoalSummary]

        -- The "uiGoal" field is necessary at least to "persist" the data that is needed
        -- if the player chooses to later "recall" the goals dialog with CTRL+g.
        Lens' AppState UIState
uiState
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState GoalDisplay
uiGoal
          forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GoalTracking
-> List Name GoalEntry -> FocusRing Name -> GoalDisplay
GoalDisplay
            GoalTracking
newGoalTracking
            (GoalTracking -> List Name GoalEntry
GR.makeListWidget GoalTracking
newGoalTracking)
            (forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (GoalWidget -> Name
GoalWidgets GoalWidget
defaultFocus) FocusRing Name
ring)

        -- This clears the "flag" that indicate that the goals dialog needs to be
        -- automatically popped up.
        Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq Announcement)
announcementQueue forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Monoid a => a
mempty

        Bool
hideGoals <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiHideGoals
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hideGoals forall a b. (a -> b) -> a -> b
$
          ModalType -> EventM Name AppState ()
openModal ModalType
GoalModal

      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
goalWasUpdated

-- | Strips top-level `cmd` from type (in case of REPL evaluation),
--   and returns a boolean to indicate if it happened
stripCmd :: Polytype -> Polytype
stripCmd :: Polytype -> Polytype
stripCmd (Forall [Text]
xs (TyCmd Type
ty)) = forall t. [Text] -> t -> Poly t
Forall [Text]
xs Type
ty
stripCmd Polytype
pty = Polytype
pty

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

-- | Set the REPL to the given text and REPL prompt type.
resetREPL :: T.Text -> REPLPrompt -> UIState -> UIState
resetREPL :: Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
t REPLPrompt
r UIState
ui =
  UIState
ui
    forall a b. a -> (a -> b) -> b
& Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
t
    forall a b. a -> (a -> b) -> b
& Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLPrompt
r

-- | 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 <- forall s (m :: * -> *). MonadState s m => m s
get
  let theRepl :: REPLState
theRepl = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL
      controlMode :: ReplControlMode
controlMode = REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState ReplControlMode
replControlMode
      uinput :: Text
uinput = REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText
  case BrickEvent Name AppEvent
x of
    -- Handle Ctrl-c here so we can always cancel the currently running
    -- base program no matter what REPL control mode we are in.
    ControlChar Char
'c' -> do
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CESK -> CESK
cancel
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Text] -> REPLPrompt
CmdPrompt []
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
""

    -- Handle M-p and M-k, shortcuts for toggling pilot + key handler modes.
    MetaChar Char
'p' ->
      forall (m :: * -> *). MonadState AppState m => m () -> m ()
onlyCreative forall a b. (a -> b) -> a -> b
$ do
        ReplControlMode
curMode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState ReplControlMode
replControlMode
        case ReplControlMode
curMode of
          ReplControlMode
Piloting -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState ReplControlMode
replControlMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ReplControlMode
Typing
          ReplControlMode
_ ->
            if Text -> Bool
T.null Text
uinput
              then Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState ReplControlMode
replControlMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ReplControlMode
Piloting
              else do
                let err :: REPLHistItem
err = Text -> REPLHistItem
REPLError Text
"Please clear the REPL before engaging pilot mode."
                Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem REPLHistItem
err
                forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache
    MetaChar Char
'k' -> do
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe (Text, Value))
inputHandler)) forall a b. (a -> b) -> a -> b
$ do
        ReplControlMode
curMode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState ReplControlMode
replControlMode
        (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState ReplControlMode
replControlMode) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case ReplControlMode
curMode of ReplControlMode
Handling -> ReplControlMode
Typing; ReplControlMode
_ -> ReplControlMode
Handling

    -- Handle other events in a way appropriate to the current REPL
    -- control mode.
    BrickEvent Name AppEvent
_ -> case ReplControlMode
controlMode of
      ReplControlMode
Typing -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping BrickEvent Name AppEvent
x
      ReplControlMode
Piloting -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting 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) -> KeyCombo -> EventM Name AppState ()
runInputHandler ([Modifier] -> Key -> KeyCombo
mkKeyCombo [Modifier]
mods Key
k)
        -- Handle all other events normally
        BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping BrickEvent Name AppEvent
x

-- | Run the installed input handler on a key combo entered by the user.
runInputHandler :: KeyCombo -> EventM Name AppState ()
runInputHandler :: KeyCombo -> EventM Name AppState ()
runInputHandler KeyCombo
kc = do
  Maybe (Text, Value)
mhandler <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe (Text, Value))
inputHandler
  case Maybe (Text, Value)
mhandler of
    -- Shouldn't be possible to get here if there is no input handler, but
    -- if we do somehow, just do nothing.
    Maybe (Text, Value)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Text
_, Value
handler) -> do
      -- 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameControls Bool
replWorking
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
working forall a b. (a -> b) -> a -> b
$ do
        AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
        let topCtx :: RobotContext
topCtx = AppState -> RobotContext
topContext AppState
s
            handlerCESK :: CESK
handlerCESK = Value -> Store -> Cont -> CESK
Out (KeyCombo -> Value
VKey KeyCombo
kc) (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext Store
defStore) [Value -> Frame
FApp Value
handler, Frame
FExec]
        Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= CESK
handlerCESK
        Lens' AppState GameState
gameState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall s a. State s a -> s -> s
execState (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m ()
activateRobot Int
0)

-- | Handle a user "piloting" input event for the REPL.
handleREPLEventPiloting :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting BrickEvent Name AppEvent
x = case BrickEvent Name AppEvent
x of
  Key Key
V.KUp -> Text -> EventM Name AppState ()
inputCmd Text
"move"
  Key Key
V.KDown -> Text -> EventM Name AppState ()
inputCmd Text
"turn back"
  Key Key
V.KLeft -> Text -> EventM Name AppState ()
inputCmd Text
"turn left"
  Key Key
V.KRight -> Text -> EventM Name AppState ()
inputCmd Text
"turn right"
  ShiftKey Key
V.KUp -> Text -> EventM Name AppState ()
inputCmd Text
"turn north"
  ShiftKey Key
V.KDown -> Text -> EventM Name AppState ()
inputCmd Text
"turn south"
  ShiftKey Key
V.KLeft -> Text -> EventM Name AppState ()
inputCmd Text
"turn west"
  ShiftKey Key
V.KRight -> Text -> EventM Name AppState ()
inputCmd Text
"turn east"
  Key Key
V.KDel -> Text -> EventM Name AppState ()
inputCmd Text
"selfdestruct"
  CharKey Char
'g' -> Text -> EventM Name AppState ()
inputCmd Text
"grab"
  CharKey Char
'h' -> Text -> EventM Name AppState ()
inputCmd Text
"harvest"
  CharKey Char
'd' -> Text -> EventM Name AppState ()
inputCmd Text
"drill forward"
  CharKey Char
'x' -> Text -> EventM Name AppState ()
inputCmd Text
"drill down"
  CharKey Char
's' -> Text -> EventM Name AppState ()
inputCmd Text
"scan forward"
  CharKey Char
'b' -> Text -> EventM Name AppState ()
inputCmd Text
"blocked"
  CharKey Char
'u' -> Text -> EventM Name AppState ()
inputCmd Text
"upload base"
  CharKey Char
'p' -> Text -> EventM Name AppState ()
inputCmd Text
"push"
  BrickEvent Name AppEvent
_ -> Text -> EventM Name AppState ()
inputCmd Text
"noop"
 where
  inputCmd :: Text -> EventM Name AppState ()
inputCmd Text
cmdText = do
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLState -> REPLState
setCmd (Text
cmdText forall a. Semigroup a => a -> a -> a
<> Text
";")
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
    BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping forall a b. (a -> b) -> a -> b
$ forall n e. Key -> BrickEvent n e
Key Key
V.KEnter

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

runBaseWebCode :: (MonadState AppState m) => T.Text -> m ()
runBaseWebCode :: forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseWebCode Text
uinput = do
  AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
  let topCtx :: RobotContext
topCtx = AppState -> RobotContext
topContext AppState
s
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameControls Bool
replWorking) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Text -> m ()
runBaseCode RobotContext
topCtx Text
uinput

runBaseCode :: (MonadState AppState m) => RobotContext -> T.Text -> m ()
runBaseCode :: forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Text -> m ()
runBaseCode RobotContext
topCtx Text
uinput = do
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem (Text -> REPLHistItem
REPLEntry Text
uinput)
  Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
  case TCtx -> ReqCtx -> Text -> Either Text (Maybe ProcessedTerm)
processTerm' (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext TCtx
defTypes) (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext ReqCtx
defReqs) Text
uinput of
    Right Maybe ProcessedTerm
mt -> do
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLHistory Bool
replHasExecutedManualInput forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Maybe ProcessedTerm -> m ()
runBaseTerm RobotContext
topCtx Maybe ProcessedTerm
mt
    Left Text
err -> do
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= REPLHistItem -> REPLHistory -> REPLHistory
addREPLItem (Text -> REPLHistItem
REPLError Text
err)

runBaseTerm :: (MonadState AppState m) => RobotContext -> Maybe ProcessedTerm -> m ()
runBaseTerm :: forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Maybe ProcessedTerm -> m ()
runBaseTerm RobotContext
topCtx =
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id ProcessedTerm -> AppState -> AppState
startBaseProgram
 where
  -- The player typed something at the REPL and hit Enter; this
  -- function takes the resulting ProcessedTerm (if the REPL
  -- input is valid) and sets up the base robot to run it.
  startBaseProgram :: ProcessedTerm -> AppState -> AppState
startBaseProgram t :: ProcessedTerm
t@(ProcessedTerm (Module Syntax' Polytype
tm TCtx
_) Requirements
reqs ReqCtx
reqCtx) =
    -- Set the REPL status to Working
    (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed forall a. Maybe a
Nothing (Syntax' Polytype
tm forall s a. s -> Getting a s a -> a
^. forall ty. Lens' (Syntax' ty) ty
sType) Requirements
reqs))
      -- The `reqCtx` maps names of variables defined in the
      -- term (by `def` statements) to their requirements.
      -- E.g. if we had `def m = move end`, the reqCtx would
      -- record the fact that `m` needs the `move` capability.
      -- We simply add the entire `reqCtx` to the robot's
      -- context, so we can look up requirements if we later
      -- need to requirements-check an argument to `build` or
      -- `reprogram` at runtime.  See the discussion at
      -- https://github.com/swarm-game/swarm/pull/827 for more
      -- details.
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ ReqCtx
reqCtx)
      -- Set up the robot's CESK machine to evaluate/execute the
      -- given term, being sure to initialize the CESK machine
      -- environment and store from the top-level context.
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
t (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext Env
defVals) (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext Store
defStore))
      -- Finally, be sure to activate the base robot.
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' AppState GameState
gameState forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall s a. State s a -> s -> s
execState (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m ()
activateRobot Int
0))

-- | Handle a user input event for the REPL.
handleREPLEventTyping :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping = \case
  -- Scroll the REPL on PageUp or PageDown
  Key Key
V.KPageUp -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
replScroll Direction
Brick.Up
  Key Key
V.KPageDown -> 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
    forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
replScroll
    case BrickEvent Name AppEvent
k of
      Key Key
V.KEnter -> do
        AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
        let topCtx :: RobotContext
topCtx = AppState -> RobotContext
topContext AppState
s
            theRepl :: REPLState
theRepl = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL
            uinput :: Text
uinput = REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText

        if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter GameControls Bool
replWorking
          then case REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLPrompt
replPromptType of
            CmdPrompt [Text]
_ -> do
              forall (m :: * -> *).
MonadState AppState m =>
RobotContext -> Text -> m ()
runBaseCode RobotContext
topCtx Text
uinput
              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 -> Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
                Just Text
found
                  | Text -> Bool
T.null Text
uinput -> Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
                  | Bool
otherwise -> do
                      Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
found ([Text] -> REPLPrompt
CmdPrompt [])
                      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
          else forall n s. EventM n s ()
continueWithoutRedraw
      Key Key
V.KUp -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
Older
      Key Key
V.KDown -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
Newer
      ControlChar Char
'r' -> do
        AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
        let uinput :: Text
uinput = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText
        case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType of
          CmdPrompt [Text]
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLHistory -> REPLPrompt
SearchPrompt (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLHistory
replHistory)
          SearchPrompt REPLHistory
rh -> case Text -> REPLHistory -> Maybe Text
lastEntry Text
uinput REPLHistory
rh of
            Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just Text
found -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType 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' -> do
        AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
        let names :: [Text]
names = AppState
s forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext TCtx
defTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall t. Ctx t -> [(Text, t)]
assocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field1 s t a b => Lens s t a b
_1
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= [Text] -> EntityMap -> REPLState -> REPLState
tabComplete [Text]
names (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap)
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
      BrickEvent Name AppEvent
EscapeKey -> do
        REPLPrompt
formSt <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType
        case REPLPrompt
formSt of
          CmdPrompt {} -> forall n s. EventM n s ()
continueWithoutRedraw
          SearchPrompt REPLHistory
_ ->
            Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLPrompt -> UIState -> UIState
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
      ControlChar Char
'd' -> do
        Text
text <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText
        if Text
text forall a. Eq a => a -> a -> Bool
== Text
T.empty
          then ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
          else forall n s. EventM n s ()
continueWithoutRedraw
      -- finally if none match pass the event to the editor
      BrickEvent Name AppEvent
ev -> do
        forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState (Editor Text Name)
replPromptEditor) (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)
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType 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
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm

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

-- | 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 :: [Var] -> EntityMap -> REPLState -> REPLState
tabComplete :: [Text] -> EntityMap -> REPLState -> REPLState
tabComplete [Text]
names EntityMap
em REPLState
theRepl = case REPLState
theRepl forall s a. s -> Getting a s a -> a
^. 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 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 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 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 = (forall a. Eq a => a -> a -> Bool
== Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 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 = 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, (forall a. Eq a => a -> a -> Bool
/= Char
'"'))
    CompletionType
FunctionName -> ([Text]
possibleWords, Char -> Bool
isIdentChar)

  possibleWords :: [Text]
possibleWords = [Text]
reservedWords forall a. [a] -> [a] -> [a]
++ [Text]
names

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

  t :: Text
t = REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText
  setCmd :: Text -> [Text] -> REPLState
setCmd Text
nt [Text]
ms =
    REPLState
theRepl
      forall a b. a -> (a -> b) -> b
& Lens' REPLState Text
replPromptText forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
nt
      forall a b. a -> (a -> b) -> b
& Lens' REPLState REPLPrompt
replPromptType 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 :: AppState -> AppState
validateREPLForm :: AppState -> AppState
validateREPLForm AppState
s =
  case REPLPrompt
replPrompt of
    CmdPrompt [Text]
_
      | Text -> Bool
T.null Text
uinput ->
          let theType :: Maybe Polytype
theType = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter REPLStatus (Maybe Polytype)
replActiveType
           in AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState (Maybe Polytype)
replType forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
    CmdPrompt [Text]
_
      | Bool
otherwise ->
          let result :: Either Text (Maybe ProcessedTerm)
result = TCtx -> ReqCtx -> Text -> Either Text (Maybe ProcessedTerm)
processTerm' (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext TCtx
defTypes) (RobotContext
topCtx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext ReqCtx
defReqs) Text
uinput
              theType :: Maybe Polytype
theType = case Either Text (Maybe ProcessedTerm)
result of
                Right (Just (ProcessedTerm (Module Syntax' Polytype
tm TCtx
_) Requirements
_ ReqCtx
_)) -> forall a. a -> Maybe a
Just (Syntax' Polytype
tm forall s a. s -> Getting a s a -> a
^. forall ty. Lens' (Syntax' ty) ty
sType)
                Either Text (Maybe ProcessedTerm)
_ -> forall a. Maybe a
Nothing
           in AppState
s
                forall a b. a -> (a -> b) -> b
& Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Bool
replValid forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b. Either a b -> Bool
isRight Either Text (Maybe ProcessedTerm)
result
                forall a b. a -> (a -> b) -> b
& Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState (Maybe Polytype)
replType forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
    SearchPrompt REPLHistory
_ -> AppState
s
 where
  uinput :: Text
uinput = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState Text
replPromptText
  replPrompt :: REPLPrompt
replPrompt = AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLState REPLPrompt
replPromptType
  topCtx :: RobotContext
topCtx = AppState -> RobotContext
topContext AppState
s

-- | Update our current position in the REPL history.
adjReplHistIndex :: TimeDir -> AppState -> AppState
adjReplHistIndex :: TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
d AppState
s =
  AppState
s
    forall a b. a -> (a -> b) -> b
& Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLState
uiREPL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ REPLState -> REPLState
moveREPL
    forall a b. a -> (a -> b) -> b
& AppState -> AppState
validateREPLForm
 where
  moveREPL :: REPLState -> REPLState
  moveREPL :: REPLState -> REPLState
moveREPL REPLState
theRepl =
    REPLState
newREPL
      forall a b. a -> (a -> b) -> b
& (if REPLHistory -> Bool
replIndexIsAtInput (REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState REPLHistory
replHistory) then REPLState -> REPLState
saveLastEntry else forall a. a -> a
id)
      forall a b. a -> (a -> b) -> b
& (if Text
oldEntry forall a. Eq a => a -> a -> Bool
/= Text
newEntry then REPLState -> REPLState
showNewEntry else forall a. a -> a
id)
   where
    -- new AppState after moving the repl index
    newREPL :: REPLState
    newREPL :: REPLState
newREPL = REPLState
theRepl forall a b. a -> (a -> b) -> b
& Lens' REPLState REPLHistory
replHistory 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 = Lens' REPLState Text
replLast forall s t a b. ASetter s t a b -> b -> s -> t
.~ (REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replPromptText)
    showNewEntry :: REPLState -> REPLState
showNewEntry = (Lens' REPLState (Editor Text Name)
replPromptEditor forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Editor Text Name
newREPLEditor Text
newEntry) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' REPLState REPLPrompt
replPromptType forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt [])
    -- get REPL data
    getCurrEntry :: REPLState -> Text
getCurrEntry = forall a. a -> Maybe a -> a
fromMaybe (REPLState
theRepl forall s a. s -> Getting a s a -> a
^. Lens' REPLState Text
replLast) forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistory -> Maybe Text
getCurrentItemText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' REPLState REPLHistory
replHistory
    oldEntry :: Text
oldEntry = REPLState -> Text
getCurrEntry REPLState
theRepl
    newEntry :: Text
newEntry = REPLState -> Text
getCurrEntry REPLState
newREPL

------------------------------------------------------------
-- World events
------------------------------------------------------------

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

onlyCreative :: (MonadState AppState m) => m () -> m ()
onlyCreative :: forall (m :: * -> *). MonadState AppState m => m () -> m ()
onlyCreative m ()
a = do
  Bool
c <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c m ()
a

-- | Handle a user input event in the world view panel.
handleWorldEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEvent = \case
  Key Key
k
    | Key
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
moveKeys -> do
        Bool
c <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Bool
creativeMode
        Bool
s <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
c Bool -> Bool -> Bool
|| Bool
s) forall a b. (a -> b) -> a -> b
$ (Location -> Location) -> EventM Name AppState ()
scrollView (forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Int32
worldScrollDist forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Key -> V2 Int32
keyToDir Key
k))
  CharKey Char
'c' -> do
    forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
    Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ViewCenterRule
viewCenterRule forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> ViewCenterRule
VCRobot Int
0
  -- show fps
  CharKey Char
'f' -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowFPS forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
  -- Fall-through case: don't do anything.
  BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw
 where
  moveKeys :: [Key]
moveKeys =
    [ Key
V.KUp
    , Key
V.KDown
    , Key
V.KLeft
    , Key
V.KRight
    , Char -> Key
V.KChar Char
'h'
    , Char -> Key
V.KChar Char
'j'
    , Char -> Key
V.KChar Char
'k'
    , Char -> Key
V.KChar Char
'l'
    ]

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

-- | Convert a directional key into a direction.
keyToDir :: V.Key -> Heading
keyToDir :: Key -> V2 Int32
keyToDir Key
V.KUp = V2 Int32
north
keyToDir Key
V.KDown = V2 Int32
south
keyToDir Key
V.KRight = V2 Int32
east
keyToDir Key
V.KLeft = V2 Int32
west
keyToDir (V.KChar Char
'h') = V2 Int32
west
keyToDir (V.KChar Char
'j') = V2 Int32
south
keyToDir (V.KChar Char
'k') = V2 Int32
north
keyToDir (V.KChar Char
'l') = V2 Int32
east
keyToDir Key
_ = forall (f :: * -> *) a. (Additive f, Num a) => f a
zero

-- | Adjust the ticks per second speed.
adjustTPS :: (Int -> Int -> Int) -> AppState -> AppState
adjustTPS :: (Int -> Int -> Int) -> AppState -> AppState
adjustTPS Int -> Int -> Int
(+/-) = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Int
lgTicksPerSecond forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
+/- Int
1)

------------------------------------------------------------
-- Robot panel events
------------------------------------------------------------

-- | Handle user input events in the robot panel.
handleRobotPanelEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent BrickEvent Name AppEvent
bev = do
  Maybe Text
search <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiInventorySearch)
  case Maybe Text
search of
    Just Text
_ -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent BrickEvent Name AppEvent
bev
    Maybe Text
Nothing -> case BrickEvent Name AppEvent
bev of
      Key Key
V.KEnter ->
        forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> Maybe Entity
focusedEntity forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n s. EventM n s ()
continueWithoutRedraw Entity -> EventM Name AppState ()
descriptionModal
      CharKey Char
'm' ->
        forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> Maybe Entity
focusedEntity forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n s. EventM n s ()
continueWithoutRedraw Entity -> EventM Name AppState ()
makeEntity
      CharKey Char
'0' -> do
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiShowZero forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not
      CharKey Char
';' -> do
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState InventorySortOptions
uiInventorySort forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= InventorySortOptions -> InventorySortOptions
cycleSortOrder
      CharKey Char
':' -> do
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState InventorySortOptions
uiInventorySort forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= InventorySortOptions -> InventorySortOptions
cycleSortDirection
      CharKey Char
'/' -> do
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just Text
""
      VtyEvent Event
ev -> Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev
      BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw

-- | Handle an event to navigate through the inventory list.
handleInventoryListEvent :: V.Event -> EventM Name AppState ()
handleInventoryListEvent :: Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev = do
  -- Note, refactoring like this is tempting:
  --
  --   Brick.zoom (uiState . uiInventory . _Just . _2) (handleListEventWithSeparators ev (is _Separator))
  --
  -- However, this does not work since we want to skip redrawing in the no-list case!

  Maybe (GenericList Name Vector InventoryListEntry)
mList <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
  case Maybe (GenericList Name Vector InventoryListEntry)
mList of
    Maybe (GenericList Name Vector InventoryListEntry)
Nothing -> forall n s. EventM n s ()
continueWithoutRedraw
    Just GenericList Name Vector InventoryListEntry
l -> do
      GenericList Name Vector InventoryListEntry
l' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector InventoryListEntry
l (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n, Searchable t) =>
Event -> (e -> Bool) -> EventM n (GenericList n t e) ()
handleListEventWithSeparators Event
ev (forall s t a b. APrism s t a b -> s -> Bool
is Prism' InventoryListEntry Text
_Separator))
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GenericList Name Vector InventoryListEntry
l'

-- | Handle a user input event in the robot/inventory panel, while in
--   inventory search mode.
handleInventorySearchEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent = \case
  -- Escape: stop filtering and go back to regular inventory mode
  BrickEvent Name AppEvent
EscapeKey -> do
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
  -- Enter: return to regular inventory mode, and pop out the selected item
  Key Key
V.KEnter -> do
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> Maybe Entity
focusedEntity forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall n s. EventM n s ()
continueWithoutRedraw Entity -> EventM Name AppState ()
descriptionModal
  -- Any old character: append to the current search string
  CharKey Char
c -> do
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s a. Snoc s s a a => s -> a -> s
`snoc` Char
c)
  -- Backspace: chop the last character off the end of the current search string
  BrickEvent Name AppEvent
BackspaceKey -> do
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiInventoryShouldUpdate forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiInventorySearch forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.dropEnd Int
1)
  -- Handle any other event as list navigation, so we can look through
  -- the filtered inventory using e.g. arrow keys
  VtyEvent Event
ev -> Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev
  BrickEvent Name AppEvent
_ -> forall n s. EventM n s ()
continueWithoutRedraw

-- | Attempt to make an entity selected from the inventory, if the
--   base is not currently busy.
makeEntity :: Entity -> EventM Name AppState ()
makeEntity :: Entity -> EventM Name AppState ()
makeEntity Entity
e = do
  AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
  let name :: Text
name = Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName
      mkPT :: ProcessedTerm
mkPT = [tmQ| make $str:name |]
      topStore :: Store
topStore =
        forall a. a -> Maybe a -> a
fromMaybe Store
emptyStore forall a b. (a -> b) -> a -> b
$
          AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext Store
defStore

  case Robot -> Bool
isActive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot) of
    Just Bool
False -> do
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed forall a. Maybe a
Nothing Polytype
PolyUnit (Capability -> Requirements
R.singletonCap Capability
CMake))
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
mkPT forall t. Ctx t
empty Store
topStore
      Lens' AppState GameState
gameState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall s a. State s a -> s -> s
execState (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m ()
activateRobot Int
0)
    Maybe Bool
_ -> forall n s. EventM n s ()
continueWithoutRedraw

-- | Display a modal window with the description of an entity.
descriptionModal :: Entity -> EventM Name AppState ()
descriptionModal :: Entity -> EventM Name AppState ()
descriptionModal Entity
e = do
  AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
  Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Modal)
uiModal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= AppState -> ModalType -> Modal
generateModal AppState
s (Entity -> ModalType
DescriptionModal Entity
e)

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

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