{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

-- |
-- Module      :  Swarm.TUI.Controller
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Event handlers for the TUI.
module Swarm.TUI.Controller (
  -- * Event handling
  handleEvent,
  quitGame,

  -- ** Handling 'Frame' events
  runFrameUI,
  runFrame,
  runFrameTicks,
  runGameTickUI,
  runGameTick,
  updateUI,

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

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

  -- ** Info panel
  handleInfoPanelEvent,
) where

import Brick hiding (Direction)
import Brick.Focus
import Brick.Forms
import Brick.Widgets.Dialog
import Brick.Widgets.List (handleListEvent)
import Brick.Widgets.List qualified as BL
import Control.Carrier.Lift qualified as Fused
import Control.Carrier.State.Lazy qualified as Fused
import Control.Lens
import Control.Lens.Extras (is)
import Control.Monad.Except
import Control.Monad.State
import Data.Bits
import Data.Either (isRight)
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time (getZonedTime)
import Graphics.Vty qualified as V
import Linear
import Swarm.Game.CESK (cancel, emptyStore, initMachine)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Robot
import Swarm.Game.ScenarioInfo
import Swarm.Game.State
import Swarm.Game.Step (gameTick)
import Swarm.Game.Value (Value (VUnit), prettyValue)
import Swarm.Game.World qualified as W
import Swarm.Language.Capability (Capability (CMake))
import Swarm.Language.Context
import Swarm.Language.Parse (reservedWords)
import Swarm.Language.Pipeline
import Swarm.Language.Pretty
import Swarm.Language.Requirement qualified as R
import Swarm.Language.Syntax
import Swarm.Language.Types
import Swarm.TUI.List
import Swarm.TUI.Model
import Swarm.TUI.View (generateModal)
import Swarm.Util hiding ((<<.=))
import Swarm.Version (NewReleaseFailure (..))
import System.Clock
import Witch (into)

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

pattern CharKey, ControlKey, MetaKey :: Char -> BrickEvent n e
pattern $bCharKey :: forall n e. Char -> BrickEvent n e
$mCharKey :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
CharKey c = VtyEvent (V.EvKey (V.KChar c) [])
pattern $bControlKey :: forall n e. Char -> BrickEvent n e
$mControlKey :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
ControlKey c = VtyEvent (V.EvKey (V.KChar c) [V.MCtrl])
pattern $bMetaKey :: forall n e. Char -> BrickEvent n e
$mMetaKey :: forall {r} {n} {e}.
BrickEvent n e -> (Char -> r) -> ((# #) -> r) -> r
MetaKey c = VtyEvent (V.EvKey (V.KChar c) [V.MMeta])

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

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

-- | 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 -> a -> m ()
logReleaseEvent LogSource
l 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
-> (Text, Int)
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
l (Text
"Release", -Int
7) (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 e :: NewReleaseFailure
e@(FailedReleaseQuery FilePath
_e) -> forall {m :: * -> *} {a}.
(MonadState AppState m, Show a) =>
LogSource -> a -> m ()
logReleaseEvent LogSource
ErrorTrace NewReleaseFailure
e
      Left NewReleaseFailure
e -> forall {m :: * -> *} {a}.
(MonadState AppState m, Show a) =>
LogSource -> a -> m ()
logReleaseEvent LogSource
Said 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 -> NonEmpty (List Name ScenarioItem)
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent NonEmpty (List Name ScenarioItem)
l
          Menu
MessagesMenu -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent
          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 GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState 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 a. [a] -> NonEmpty a
NE.fromList [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 GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState 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
== Text
"Tutorials") 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 = forall a. [a] -> NonEmpty a
NE.fromList [List Name ScenarioItem
tutorialMenu, 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 :: (Scenario, ScenarioInfo)
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 Scenario
scene ScenarioInfo
si) -> (Scenario
scene, ScenarioInfo
si)
                  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 a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Scenario -> ScenarioInfo -> Maybe FilePath -> m ()
startGame (Scenario, ScenarioInfo)
firstTutorial forall a. Maybe a
Nothing
        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 -> 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
        MainMenuEntry
Quit -> forall n s. EventM n s ()
halt
  CharKey Char
'q' -> forall n s. EventM n s ()
halt
  ControlKey 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
"Tutorials" (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
sc) of
  Just (SICollection Text
_ ScenarioCollection
c) -> ScenarioCollection
c
  Maybe ScenarioItem
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"No tutorials exist!"

-- | If we are in a New Game menu, advance the menu to the next item in order.
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

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
  ControlKey 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 Scenario
scene ScenarioInfo
si) -> forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Scenario -> ScenarioInfo -> Maybe FilePath -> m ()
startGame Scenario
scene ScenarioInfo
si 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)
  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
  ControlKey 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

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
  case BrickEvent Name AppEvent
ev of
    AppEvent 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
. Getter GameState Bool
paused -> forall n s. EventM n s ()
continueWithoutRedraw
      | Bool
otherwise -> EventM Name AppState ()
runFrameUI
    -- ctrl-q works everywhere
    ControlKey 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
        Won Bool
_ -> ModalType -> EventM Name AppState ()
toggleModal ModalType
WinModal
        WinCondition
_ -> ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
    VtyEvent (V.EvResize Int
_ Int
_) -> forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
WorldCache
    Key Key
V.KEsc
      | 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 Text)
uiError) -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiError forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
      | 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
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Modal
m forall s a. s -> Getting a s a -> a
^. Lens' Modal ModalType
modalType forall a. Eq a => a -> a -> Bool
== ModalType
MessagesModal) forall a b. (a -> b) -> a -> b
$ do
          Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState Integer
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 Integer
ticks
    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 (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 (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 (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 (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 Integer
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 Integer
ticks
    ControlKey Char
'g' -> 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 (Maybe [Text])
uiGoal of
      Just [Text]
g | [Text]
g forall a. Eq a => a -> a -> Bool
/= [] -> ModalType -> EventM Name AppState ()
toggleModal ([Text] -> ModalType
GoalModal [Text]
g)
      Maybe [Text]
_ -> forall n s. EventM n s ()
continueWithoutRedraw
    -- pausing and stepping
    ControlKey Char
'p' | Bool
isRunning -> EventM Name AppState ()
safeTogglePause
    ControlKey Char
'o' | Bool
isRunning -> do
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState RunStatus
runStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= RunStatus
ManualPause
      EventM Name AppState ()
runGameTickUI
    -- speed controls
    ControlKey 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
(+)
    ControlKey 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
    MetaKey Char
'w' -> Name -> EventM Name AppState ()
setFocus Name
WorldPanel
    MetaKey Char
'e' -> Name -> EventM Name AppState ()
setFocus Name
RobotPanel
    MetaKey Char
'r' -> Name -> EventM Name AppState ()
setFocus Name
REPLPanel
    MetaKey Char
't' -> Name -> EventM Name AppState ()
setFocus Name
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"
    ControlKey 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
    MouseDown Name
n Button
_ [Modifier]
_ Location
mouseLoc ->
      case Name
n of
        Name
WorldPanel -> do
          Maybe 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 (Location -> EventM Name GameState (Maybe Coords)
mouseLocToWorldCoords Location
mouseLoc)
          Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Coords)
uiWorldCursor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Coords
mouseCoordsM
        Name
REPLPanel ->
          -- Do not clear the world cursor when going back to the REPL
          forall n s. EventM n s ()
continueWithoutRedraw
        Name
_ -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Coords)
uiWorldCursor 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
>> 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, List Name 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
        Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Name -> 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 -> Name
RobotPanel
        InventoryListItem Int
_ -> Name
RobotPanel
        Name
InfoViewport -> Name
InfoPanel
        Name
_ -> Name
n
    -- 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 Name
REPLPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
ev
        Just Name
WorldPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleWorldEvent BrickEvent Name AppEvent
ev
        Just Name
RobotPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent BrickEvent Name AppEvent
ev
        Just Name
InfoPanel -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
infoScroll BrickEvent Name AppEvent
ev
        Maybe Name
_ -> forall n s. EventM n s ()
continueWithoutRedraw

mouseLocToWorldCoords :: Brick.Location -> EventM Name GameState (Maybe W.Coords)
mouseLocToWorldCoords :: Location -> EventM Name GameState (Maybe Coords)
mouseLocToWorldCoords (Brick.Location (Int, Int)
mouseLoc) = do
  Maybe (Extent Name)
mext <- forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
lookupExtent Name
WorldExtent
  case Maybe (Extent Name)
mext of
    Maybe (Extent Name)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just Extent Name
ext -> do
      (Coords, Coords)
region <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip GameState -> (Int64, Int64) -> (Coords, Coords)
viewingRegion (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall n. Extent n -> (Int, Int)
extentSize Extent Name
ext))
      let regionStart :: (Int64, Int64)
regionStart = Coords -> (Int64, Int64)
W.unCoords (forall a b. (a, b) -> a
fst (Coords, Coords)
region)
          mouseLoc' :: (Int64, Int64)
mouseLoc' = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int, Int)
mouseLoc
          mx :: Int64
mx = forall a b. (a, b) -> b
snd (Int64, Int64)
mouseLoc' forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> a
fst (Int64, Int64)
regionStart
          my :: Int64
my = forall a b. (a, b) -> a
fst (Int64, Int64)
mouseLoc' forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (Int64, Int64)
regionStart
       in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int64, Int64) -> Coords
W.Coords (Int64
mx, Int64
my)

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

-- | 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 GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState RunStatus
runStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= RunStatus -> RunStatus
toggleRunStatus

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

-- | The running modals do not autopause the game.
isRunningModal :: ModalType -> Bool
isRunningModal :: ModalType -> Bool
isRunningModal ModalType
mt = ModalType
mt forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModalType
RobotsModal, ModalType
MessagesModal]

handleModalEvent :: V.Event -> EventM Name AppState ()
handleModalEvent :: Event -> EventM Name AppState ()
handleModalEvent = \case
  V.EvKey Key
V.KEnter [] -> do
    Maybe (Dialog ButtonSelection)
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 ButtonSelection)
modalDialog
    ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
    case forall a. Dialog a -> Maybe a
dialogSelection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Dialog ButtonSelection)
mdialog of
      Just (Just ButtonSelection
QuitButton) -> EventM Name AppState ()
quitGame
      Just (Just (NextButton (Scenario, ScenarioInfo)
scene)) -> forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Scenario -> ScenarioInfo -> Maybe FilePath -> m ()
startGame (Scenario, ScenarioInfo)
scene forall a. Maybe a
Nothing
      Maybe (Maybe ButtonSelection)
_ -> 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 ButtonSelection)
modalDialog) (forall n a. Event -> EventM n (Dialog a) ()
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
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
      Maybe ModalType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | 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
  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
    Maybe FilePath
mp' <- 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 (Maybe FilePath)
currentScenarioPath
    case Maybe FilePath
mp' of
      Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      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 GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState ScenarioCollection
scenarios
        FilePath
p <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ScenarioCollection -> FilePath -> IO FilePath
normalizeScenarioPath ScenarioCollection
gs FilePath
p'
        ZonedTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
        Bool
won <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' WinCondition Bool
_Won)
        Integer
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 Integer
ticks
        let currentScenarioInfo :: Traversal' AppState ScenarioInfo
            currentScenarioInfo :: Traversal' AppState ScenarioInfo
currentScenarioInfo = Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState 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 (Scenario, ScenarioInfo)
_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
        Traversal' AppState ScenarioInfo
currentScenarioInfo forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ZonedTime -> Integer -> Bool -> ScenarioInfo -> ScenarioInfo
updateScenarioInfoOnQuit ZonedTime
t Integer
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 -> 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

        -- 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 (Scenario, ScenarioInfo)
_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 GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState 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)
-- * returns to the previous menu
quitGame :: EventM Name AppState ()
quitGame :: EventM Name AppState ()
quitGame = do
  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 REPLHistory
uiReplHistory
  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
  forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit
  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 procssing 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)

  -- Is there still time left?  Or have we hit the cap on ticks per 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 ()
zoomGameState :: forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m ()
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' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a. LiftC m a -> m a
Fused.runM (forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m s
Fused.execState 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'

-- | 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 = forall (m :: * -> *) a.
(MonadState AppState m, MonadIO m) =>
StateC GameState (LiftC IO) a -> m ()
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
gameTick

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

  -- Check if the inventory list needs to be updated.
  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, List Name InventoryListEntry))
uiInventory)
  -- The hash of the robot whose inventory is currently displayed (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
  -- The hash of the focused robot (if any)

  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)
  -- If the hashes don't match (either because which robot (or
  -- whether any robot) is focused changed, or the focused robot's
  -- inventory changed), regenerate the list.
  Bool
inventoryUpdated <-
    if 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 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 REPLStatus
replStatus of
    -- It did, and the result was the unit value.  Just reset replStatus.
    REPLWorking Polytype
_ (Just Value
VUnit) -> do
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLStatus
REPLDone
      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 Polytype
pty (Just Value
v) -> do
      let out :: Text
out = Text -> [Text] -> Text
T.intercalate Text
" " [forall target source. From source target => source -> target
into (Value -> Text
prettyValue Value
v), Text
":", forall a. PrettyPrec a => a -> Text
prettyText (Polytype -> Polytype
stripCmd Polytype
pty)]
      Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLHistory
uiReplHistory 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)
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLStatus
REPLDone
      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, attempt to
  -- automatically switch to it 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
    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 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 ()
zoomGameState forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
clearFocusedRobotLogUpdated

        -- Find and focus an installed "logger" device in the inventory list.
        let isLogger :: InventoryListEntry -> Bool
isLogger (InstalledEntry 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, List Name 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

  -- Decide whether the info panel has more content scrolled off the
  -- top and/or bottom, so we can draw some indicators to show it if
  -- so.  Note, because we only know the update size and position of
  -- the viewport *after* it has been rendered, this means the top and
  -- bottom indicators will only be updated one frame *after* the info
  -- panel updates, but this isn't really that big of deal.
  Bool
infoPanelUpdated <- do
    Maybe Viewport
mvp <- forall n s. Ord n => n -> EventM n s (Maybe Viewport)
lookupViewport Name
InfoViewport
    case Maybe Viewport
mvp of
      Maybe Viewport
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Just Viewport
vp -> do
        let topMore :: Bool
topMore = (Viewport
vp forall s a. s -> Getting a s a -> a
^. Lens' Viewport Int
vpTop) forall a. Ord a => a -> a -> Bool
> Int
0
            botMore :: Bool
botMore = (Viewport
vp forall s a. s -> Getting a s a -> a
^. Lens' Viewport Int
vpTop forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> b
snd (Viewport
vp forall s a. s -> Getting a s a -> a
^. Lens' Viewport (Int, Int)
vpSize)) forall a. Ord a => a -> a -> Bool
< forall a b. (a, b) -> b
snd (Viewport
vp forall s a. s -> Getting a s a -> a
^. Lens' Viewport (Int, Int)
vpContentSize)
        Bool
oldTopMore <- Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiMoreInfoTop forall s (m :: * -> *) a b.
MonadState s m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= Bool
topMore
        Bool
oldBotMore <- Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Bool
uiMoreInfoBot forall s (m :: * -> *) a b.
MonadState s m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= Bool
botMore
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
oldTopMore forall a. Eq a => a -> a -> Bool
/= Bool
topMore Bool -> Bool -> Bool
|| Bool
oldBotMore forall a. Eq a => a -> a -> Bool
/= Bool
botMore

  -- Decide whether we need to update the current goal text, and pop
  -- up a modal dialog.
  Maybe [Text]
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 (Maybe [Text])
uiGoal)
  Maybe [Text]
newGoal <-
    forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState WinCondition
winCondition forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' WinCondition (NonEmpty Objective)
_WinConditions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (NonEmpty a) (a, [a])
_NonEmpty 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Objective [Text]
objectiveGoal)

  let goalUpdated :: Bool
goalUpdated = Maybe [Text]
curGoal forall a. Eq a => a -> a -> Bool
/= Maybe [Text]
newGoal
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
goalUpdated forall a b. (a -> b) -> a -> b
$ do
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe [Text])
uiGoal forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe [Text]
newGoal
    case Maybe [Text]
newGoal of
      Just [Text]
goal | [Text]
goal forall a. Eq a => a -> a -> Bool
/= [] -> do
        ModalType -> EventM Name AppState ()
toggleModal ([Text] -> ModalType
GoalModal [Text]
goal)
      Maybe [Text]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Decide whether to show a pop-up modal congratulating the user on
  -- successfully completing the current challenge.
  Bool
winModalUpdated <- do
    WinCondition
w <- 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)
    case WinCondition
w of
      Won Bool
False -> do
        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 ()
.= Bool -> WinCondition
Won Bool
True
        ModalType -> EventM Name AppState ()
toggleModal ModalType
WinModal
        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
        forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      WinCondition
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

  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
infoPanelUpdated Bool -> Bool -> Bool
|| Bool
goalUpdated Bool -> Bool -> Bool
|| Bool
winModalUpdated
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
redraw

-- | Make sure all tiles covering the visible part of the world are
--   loaded.
loadVisibleRegion :: EventM Name AppState ()
loadVisibleRegion :: EventM Name AppState ()
loadVisibleRegion = do
  Maybe (Extent Name)
mext <- forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
lookupExtent Name
WorldExtent
  case Maybe (Extent Name)
mext of
    Maybe (Extent Name)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Extent Name
_ Location
_ (Int, Int)
size) -> do
      GameState
gs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' AppState GameState
gameState
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (World Int Entity)
world forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall t e.
IArray UArray t =>
(Coords, Coords) -> World t e -> World t e
W.loadRegion (GameState -> (Int64, Int64) -> (Coords, Coords)
viewingRegion GameState
gs (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int, Int)
size))

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

-- | Handle a user input event for the REPL.
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent = \case
  ControlKey Char
'c' -> do
    Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (IntMap Robot)
robotMap 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
. 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 s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Form REPLPrompt AppEvent Name -> UIState -> UIState
resetWithREPLForm (REPLPrompt -> Form REPLPrompt AppEvent Name
mkReplForm forall a b. (a -> b) -> a -> b
$ Text -> REPLPrompt
mkCmdPrompt Text
"")
  Key Key
V.KEnter -> do
    AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
    let entry :: REPLPrompt
entry = forall s e n. Form s e n -> s
formState (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 (Form REPLPrompt AppEvent Name)
uiReplForm)
        topTypeCtx :: TCtx
topTypeCtx = 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 (IntMap Robot)
robotMap 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
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext TCtx
defTypes
        topReqCtx :: ReqCtx
topReqCtx = 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 (IntMap Robot)
robotMap 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
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs
        topValCtx :: Env
topValCtx = 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 (IntMap Robot)
robotMap 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
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext Env
defVals
        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
. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
0 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' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext Store
defStore
        startBaseProgram :: ProcessedTerm -> AppState -> AppState
startBaseProgram t :: ProcessedTerm
t@(ProcessedTerm Term
_ (Module Polytype
ty TCtx
_) Requirements
_ ReqCtx
_) =
          (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ Polytype -> Maybe Value -> REPLStatus
REPLWorking Polytype
ty forall a. Maybe a
Nothing)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (IntMap Robot)
robotMap 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
. Lens' Robot CESK
machine forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
t Env
topValCtx Store
topStore)
            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))

    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
. Getter GameState Bool
replWorking
      then case REPLPrompt
entry of
        CmdPrompt Text
uinput [Text]
_ ->
          case TCtx -> ReqCtx -> Text -> Either Text (Maybe ProcessedTerm)
processTerm' TCtx
topTypeCtx ReqCtx
topReqCtx Text
uinput of
            Right Maybe ProcessedTerm
mt -> do
              Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Form REPLPrompt AppEvent Name -> UIState -> UIState
resetWithREPLForm (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens UIState (Form REPLPrompt AppEvent Name) Text Text
promptUpdateL Text
"" (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UIState
uiState))
              Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLHistory
uiReplHistory 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)
              forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id ProcessedTerm -> AppState -> AppState
startBaseProgram Maybe ProcessedTerm
mt
            Left Text
err -> Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Maybe Text)
uiError forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Text
err
        SearchPrompt Text
t REPLHistory
hist ->
          case Text -> REPLHistory -> Maybe Text
lastEntry Text
t 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 ()
%= Form REPLPrompt AppEvent Name -> UIState -> UIState
resetWithREPLForm (REPLPrompt -> Form REPLPrompt AppEvent Name
mkReplForm forall a b. (a -> b) -> a -> b
$ Text -> REPLPrompt
mkCmdPrompt Text
"")
            Just Text
found
              | Text -> Bool
T.null Text
t -> Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Form REPLPrompt AppEvent Name -> UIState -> UIState
resetWithREPLForm (REPLPrompt -> Form REPLPrompt AppEvent Name
mkReplForm forall a b. (a -> b) -> a -> b
$ Text -> REPLPrompt
mkCmdPrompt Text
"")
              | Bool
otherwise -> do
                Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Form REPLPrompt AppEvent Name -> UIState -> UIState
resetWithREPLForm (REPLPrompt -> Form REPLPrompt AppEvent Name
mkReplForm forall a b. (a -> b) -> a -> b
$ Text -> REPLPrompt
mkCmdPrompt Text
found)
                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
  ControlKey Char
'r' -> do
    AppState
s <- forall s (m :: * -> *). MonadState s m => m s
get
    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 (Form REPLPrompt AppEvent Name)
uiReplForm 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 s e n. Form s e n -> s
formState of
      CmdPrompt Text
uinput [Text]
_ ->
        let newform :: Form REPLPrompt AppEvent Name
newform = REPLPrompt -> Form REPLPrompt AppEvent Name
mkReplForm forall a b. (a -> b) -> a -> b
$ Text -> REPLHistory -> REPLPrompt
SearchPrompt 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 REPLHistory
uiReplHistory)
         in Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Form REPLPrompt AppEvent Name)
uiReplForm forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form REPLPrompt AppEvent Name
newform
      SearchPrompt Text
ftext REPLHistory
rh -> case Text -> REPLHistory -> Maybe Text
lastEntry Text
ftext REPLHistory
rh of
        Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Text
found ->
          let newform :: Form REPLPrompt AppEvent Name
newform = REPLPrompt -> Form REPLPrompt AppEvent Name
mkReplForm forall a b. (a -> b) -> a -> b
$ Text -> REPLHistory -> REPLPrompt
SearchPrompt Text
ftext (Text -> REPLHistory -> REPLHistory
removeEntry Text
found REPLHistory
rh)
           in Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Form REPLPrompt AppEvent Name)
uiReplForm forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form REPLPrompt AppEvent Name
newform
  CharKey Char
'\t' -> 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 (Form REPLPrompt AppEvent Name)
uiReplForm 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 s e n. Form s e n -> s
formState
    Form REPLPrompt AppEvent Name
newform <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ REPLPrompt -> Form REPLPrompt AppEvent Name
mkReplForm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip AppState -> REPLPrompt -> REPLPrompt
tabComplete REPLPrompt
formSt
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Form REPLPrompt AppEvent Name)
uiReplForm forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form REPLPrompt AppEvent Name
newform
    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 (Form REPLPrompt AppEvent Name)
uiReplForm 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 s e n. Form s e n -> s
formState
    case REPLPrompt
formSt of
      CmdPrompt {} -> forall n s. EventM n s ()
continueWithoutRedraw
      SearchPrompt Text
_ REPLHistory
_ ->
        Lens' AppState UIState
uiState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Form REPLPrompt AppEvent Name -> UIState -> UIState
resetWithREPLForm (REPLPrompt -> Form REPLPrompt AppEvent Name
mkReplForm forall a b. (a -> b) -> a -> b
$ Text -> REPLPrompt
mkCmdPrompt Text
"")
  BrickEvent Name AppEvent
ev -> do
    Form REPLPrompt AppEvent Name
replForm <- 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 (Form REPLPrompt AppEvent Name)
uiReplForm
    Form REPLPrompt AppEvent Name
f' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' Form REPLPrompt AppEvent Name
replForm (forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent BrickEvent Name AppEvent
ev)
    case forall s e n. Form s e n -> s
formState Form REPLPrompt AppEvent Name
f' of
      CmdPrompt {} -> do
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Form REPLPrompt AppEvent Name)
uiReplForm forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form REPLPrompt AppEvent Name
f'
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
      SearchPrompt Text
t REPLHistory
_ -> do
        -- TODO: why does promptUpdateL not update the uiState?
        Form REPLPrompt AppEvent Name
newform <- 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
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens UIState (Form REPLPrompt AppEvent Name) Text Text
promptUpdateL Text
t)
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Form REPLPrompt AppEvent Name)
uiReplForm forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Form REPLPrompt AppEvent Name
newform

-- | Try to complete the last word in a partially entered REPL prompt using
--   things reserved words and names in scope.
tabComplete :: AppState -> REPLPrompt -> REPLPrompt
tabComplete :: AppState -> REPLPrompt -> REPLPrompt
tabComplete AppState
_ p :: REPLPrompt
p@(SearchPrompt {}) = REPLPrompt
p
tabComplete AppState
s (CmdPrompt Text
t [Text]
mms)
  | (Text
m : [Text]
ms) <- [Text]
mms = Text -> [Text] -> REPLPrompt
CmdPrompt (Text -> Text -> Text
replaceLast Text
m Text
t) ([Text]
ms forall a. [a] -> [a] -> [a]
++ [Text
m])
  | Text -> Bool
T.null Text
lastWord = Text -> [Text] -> REPLPrompt
CmdPrompt Text
t []
  | Bool
otherwise = case [Text]
matches of
    [] -> Text -> [Text] -> REPLPrompt
CmdPrompt Text
t []
    [Text
m] -> Text -> [Text] -> REPLPrompt
CmdPrompt (Text -> Text
completeWith Text
m) []
    (Text
m : [Text]
ms) -> Text -> [Text] -> REPLPrompt
CmdPrompt (Text -> Text
completeWith Text
m) ([Text]
ms forall a. [a] -> [a] -> [a]
++ [Text
m])
 where
  completeWith :: Text -> Text
completeWith Text
m = Text -> Text -> Text
T.append Text
t (Int -> Text -> Text
T.drop (Text -> Int
T.length Text
lastWord) Text
m)
  lastWord :: Text
lastWord = (Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
isIdentChar Text
t
  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
. Lens' GameState (IntMap Robot)
robotMap 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
. 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
  possibleWords :: [Text]
possibleWords = [Text]
reservedWords forall a. [a] -> [a] -> [a]
++ [Text]
names
  matches :: [Text]
matches = forall a. (a -> Bool) -> [a] -> [a]
filter (Text
lastWord Text -> Text -> Bool
`T.isPrefixOf`) [Text]
possibleWords

-- | 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
uinput [Text]
_ ->
      let result :: Either Text (Maybe ProcessedTerm)
result = TCtx -> ReqCtx -> Text -> Either Text (Maybe ProcessedTerm)
processTerm' TCtx
topTypeCtx ReqCtx
topReqCtx Text
uinput
          theType :: Maybe Polytype
theType = case Either Text (Maybe ProcessedTerm)
result of
            Right (Just (ProcessedTerm Term
_ (Module Polytype
ty TCtx
_) Requirements
_ ReqCtx
_)) -> forall a. a -> Maybe a
Just Polytype
ty
            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 (Form REPLPrompt AppEvent Name)
uiReplForm forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a} {b} {s} {e}.
Either a b -> Form s e Name -> Form s e Name
validate 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 (Maybe Polytype)
uiReplType forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
    SearchPrompt Text
_ REPLHistory
_ -> AppState
s
 where
  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 (Form REPLPrompt AppEvent Name)
uiReplForm 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 s e n. Form s e n -> s
formState
  topTypeCtx :: TCtx
topTypeCtx = 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 (IntMap Robot)
robotMap 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
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext TCtx
defTypes
  topReqCtx :: ReqCtx
topReqCtx = 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 (IntMap Robot)
robotMap 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
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs
  validate :: Either a b -> Form s e Name -> Form s e Name
validate Either a b
result = forall n s e. Eq n => Bool -> n -> Form s e n -> Form s e n
setFieldValid (forall a b. Either a b -> Bool
isRight Either a b
result) Name
REPLInput

-- | Update our current position in the REPL history.
adjReplHistIndex :: TimeDir -> AppState -> AppState
adjReplHistIndex :: TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
d AppState
s =
  AppState
ns
    forall a b. a -> (a -> b) -> b
& (if REPLHistory -> Bool
replIndexIsAtInput (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState REPLHistory
repl) then AppState -> AppState
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 AppState -> AppState
showNewEntry else forall a. a -> a
id)
    forall a b. a -> (a -> b) -> b
& AppState -> AppState
validateREPLForm
 where
  -- new AppState after moving the repl index
  ns :: AppState
ns = AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState REPLHistory
repl forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex TimeDir
d Text
oldEntry

  repl :: Lens' AppState REPLHistory
  repl :: Lens' AppState REPLHistory
repl = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState REPLHistory
uiReplHistory

  replLast :: Text
replLast = 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 Text
uiReplLast
  saveLastEntry :: AppState -> AppState
saveLastEntry = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState Text
uiReplLast forall s t a b. ASetter s t a b -> b -> s -> t
.~ (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 (Form REPLPrompt AppEvent Name)
uiReplForm 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 s e n. Form s e n -> s
formState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' REPLPrompt Text
promptTextL)
  showNewEntry :: AppState -> AppState
showNewEntry = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState (Form REPLPrompt AppEvent Name)
uiReplForm forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall s e n. s -> Form s e n -> Form s e n
updateFormState (Text -> REPLPrompt
mkCmdPrompt Text
newEntry)
  -- get REPL data
  getCurrEntry :: AppState -> Text
getCurrEntry = forall a. a -> Maybe a -> a
fromMaybe 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' AppState REPLHistory
repl
  oldEntry :: Text
oldEntry = AppState -> Text
getCurrEntry AppState
s
  newEntry :: Text
newEntry = AppState -> Text
getCurrEntry AppState
ns

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

worldScrollDist :: Int64
worldScrollDist :: Int64
worldScrollDist = Int64
8

-- | Handle a user input event in the world view panel.
handleWorldEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
-- scrolling the world view in Creative mode
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 -> forall {m :: * -> *}. MonadState AppState m => m () -> m ()
onlyCreative forall a b. (a -> b) -> a -> b
$ (V2 Int64 -> V2 Int64) -> EventM Name AppState ()
scrollView (forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (Int64
worldScrollDist forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Key -> V2 Int64
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
  onlyCreative :: 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
  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 :: (V2 Int64 -> V2 Int64) -> EventM Name AppState ()
scrollView :: (V2 Int64 -> V2 Int64) -> EventM Name AppState ()
scrollView V2 Int64 -> V2 Int64
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 ()
%= (V2 Int64 -> V2 Int64) -> GameState -> GameState
modifyViewCenter V2 Int64 -> V2 Int64
update

-- | Convert a directional key into a direction.
keyToDir :: V.Key -> V2 Int64
keyToDir :: Key -> V2 Int64
keyToDir Key
V.KUp = V2 Int64
north
keyToDir Key
V.KDown = V2 Int64
south
keyToDir Key
V.KRight = V2 Int64
east
keyToDir Key
V.KLeft = V2 Int64
west
keyToDir (V.KChar Char
'h') = V2 Int64
west
keyToDir (V.KChar Char
'j') = V2 Int64
south
keyToDir (V.KChar Char
'k') = V2 Int64
north
keyToDir (V.KChar Char
'l') = V2 Int64
east
keyToDir Key
_ = forall a. a -> a -> V2 a
V2 Int64
0 Int64
0

-- | 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 = \case
  (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
  (VtyEvent Event
ev) -> do
    -- This does not work we want to skip redrawing in the no-list case
    -- Brick.zoom (uiState . uiInventory . _Just . _2) (handleListEventWithSeparators ev (is _Separator))
    Maybe (List Name 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, List Name 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 (List Name InventoryListEntry)
mList of
      Maybe (List Name InventoryListEntry)
Nothing -> forall n s. EventM n s ()
continueWithoutRedraw
      Just List Name InventoryListEntry
l -> do
        List Name InventoryListEntry
l' <- forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name InventoryListEntry
l (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
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, List Name 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 ()
.= List Name InventoryListEntry
l'
  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 mkTy :: Polytype
mkTy = forall t. [Text] -> t -> Poly t
Forall [] forall a b. (a -> b) -> a -> b
$ Type -> Type
TyCmd Type
TyUnit
      mkProg :: Term
mkProg = Term -> Term -> Term
TApp (Const -> Term
TConst Const
Make) (Text -> Term
TText (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName))
      mkPT :: ProcessedTerm
mkPT = Term
-> Module Polytype Polytype
-> Requirements
-> ReqCtx
-> ProcessedTerm
ProcessedTerm Term
mkProg (forall s t. s -> Ctx t -> Module s t
Module Polytype
mkTy forall t. Ctx t
empty) (Capability -> Requirements
R.singletonCap Capability
CMake) forall t. Ctx t
empty
      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
. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
0 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' 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 a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
0) of
    Just Bool
False -> do
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState REPLStatus
replStatus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Polytype -> Maybe Value -> REPLStatus
REPLWorking Polytype
mkTy forall a. Maybe a
Nothing
      Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState (IntMap Robot)
robotMap 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
. 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 ()