swarm-0.7.0.0: src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs
{-# LANGUAGE OverloadedStrings #-}
-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- The main TUI update logic that is called from other controller parts.
module Swarm.TUI.Controller.UpdateUI (
updateUI,
updateAndRedrawUI,
updateRobotDetailsPane,
) where
-- See Note [liftA2 re-export from Prelude]
import Brick hiding (Direction, Location, on)
import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Lens as Lens
import Control.Monad (forM_, unless, when)
import Control.Monad.IO.Class (liftIO)
import Data.Foldable (toList)
import Data.List.Extra (enumerate)
import Data.Map.Strict qualified as M
import Data.Maybe (fromMaybe, isNothing)
import Data.Set (Set)
import Data.Set qualified as S
import Data.String (fromString)
import Data.Text qualified as T
import Data.Vector qualified as V
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Popup (Popup (..), addPopup)
import Swarm.Game.Robot
import Swarm.Game.Robot.Activity
import Swarm.Game.Robot.Concrete
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Substate
import Swarm.Language.Typed (Typed (..))
import Swarm.Language.Types
import Swarm.Language.Value (Value (VExc, VUnit), emptyEnv, envTydefs, prettyValue)
import Swarm.Pretty
import Swarm.TUI.Controller.SaveScenario (saveScenarioInfoOnFinishNocheat)
import Swarm.TUI.Controller.Util
import Swarm.TUI.Model
import Swarm.TUI.Model.DebugOption (DebugOption (..))
import Swarm.TUI.Model.Dialog.Goal
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.UI
import Swarm.TUI.Model.UI.Gameplay
import Swarm.TUI.View.Objective qualified as GR
import Swarm.TUI.View.Robot
import Swarm.TUI.View.Robot.Type
import Witch (into)
-- | Update the UI and redraw if needed.
--
-- This function is used after running the game for some number of ticks.
updateAndRedrawUI :: Bool -> EventM Name AppState ()
updateAndRedrawUI forceRedraw = do
redraw <- updateUI
unless (forceRedraw || redraw) continueWithoutRedraw
checkInventoryUpdated :: Maybe Robot -> EventM Name ScenarioState Bool
checkInventoryUpdated fr = do
-- The hash of the robot whose inventory is currently displayed (if any)
listRobotHash <- fmap fst <$> use (uiGameplay . uiInventory . uiInventoryList)
-- The hash of the focused robot (if any)
let focusedRobotHash = view inventoryHash <$> fr
-- Check if the inventory list needs to be updated.
shouldUpdate <- use (uiGameplay . uiInventory . uiInventoryShouldUpdate)
-- Whether the focused robot is too far away to sense, & whether
-- that has recently changed
dist <- use (gameState . to focusedRange)
farOK <- liftA2 (||) (use (gameState . creativeMode)) (use (gameState . landscape . worldScrollable))
let tooFar = not farOK && dist == Just Far
farChanged = tooFar /= isNothing listRobotHash
-- If the robot moved in or out of range, or hashes don't match
-- (either because which robot (or whether any robot) is focused
-- changed, or the focused robot's inventory changed), or the
-- inventory was flagged to be updated, regenerate the inventory list.
let shouldRegenerateInventory = farChanged || listRobotHash /= focusedRobotHash || shouldUpdate
when shouldRegenerateInventory $
Brick.zoom (uiGameplay . uiInventory) $ do
populateInventoryList $ if tooFar then Nothing else fr
uiInventoryShouldUpdate .= False
return shouldRegenerateInventory
checkReplUpdated :: GameState -> EventM Name ScenarioState Bool
checkReplUpdated g = case g ^. gameControls . replStatus of
-- Now check if the base finished running a program entered at the REPL.
REPLWorking pty (Just v)
-- It did, and the result was the unit value or an exception. Just reset replStatus.
| v `elem` [VUnit, VExc] -> do
listener <- use $ gameState . gameControls . replListener
liftIO $ listener ""
gameState . gameControls . replStatus .= REPLDone (Just (pty, v))
pure True
-- It did, and returned some other value. Create new 'it'
-- variables, pretty-print the result as a REPL output, with its
-- type, and reset the replStatus.
| otherwise -> do
itIx <- use (gameState . gameControls . replNextValueIndex)
env <- fromMaybe emptyEnv <$> preuse (gameState . baseEnv)
let finalType = stripCmd (env ^. envTydefs) pty
itName = fromString $ "it" ++ show itIx
out = T.intercalate " " [itName, ":", prettyText finalType, "=", into (prettyValue v)]
addREPLHistItem REPLOutput out
listener <- use $ gameState . gameControls . replListener
liftIO $ listener out
invalidateCacheEntry REPLHistoryCache
vScrollToEnd replScroll
Brick.zoom gameState $ do
gameControls . replStatus .= REPLDone (Just (finalType, v))
baseEnv . at itName .= Just (Typed v finalType mempty)
baseEnv . at "it" .= Just (Typed v finalType mempty)
gameControls . replNextValueIndex %= (+ 1)
pure True
-- Otherwise, do nothing.
_ -> pure False
checkLogUpdated :: Maybe Robot -> EventM Name ScenarioState Bool
checkLogUpdated fr = do
-- If the inventory or info panels are currently focused, it would
-- be rude to update them right under the user's nose, so consider
-- them "sticky". They will be updated as soon as the player moves
-- the focus away.
fring <- use $ uiGameplay . uiFocusRing
let sticky = focusGetCurrent fring `elem` map (Just . FocusablePanel) [RobotPanel, InfoPanel]
-- Check if the robot log was updated and we are allowed to change
-- the inventory+info panels.
case maybe False (view robotLogUpdated) fr && not sticky of
False -> pure False
True -> do
-- Reset the log updated flag
zoomGameStateFromScenarioState $ zoomRobots clearFocusedRobotLogUpdated
-- Find and focus an equipped "logger" device in the inventory list.
let isLogger (EquippedEntry e) = e ^. entityName == "logger"
isLogger _ = False
focusLogger = BL.listFindBy isLogger
uiGameplay . uiInventory . uiInventoryList . _Just . _2 %= focusLogger
-- Now inform the UI that it should scroll the info panel to
-- the very end.
uiGameplay . uiScrollToEnd .= True
pure True
-- | Update the UI. This function is used after running the
-- game for some number of ticks.
updateUI :: EventM Name AppState Bool
updateUI = do
g <- use $ playState . scenarioState . gameState
Brick.zoom (playState . scenarioState . gameState) loadVisibleRegion
-- If the game state indicates a redraw is needed, invalidate the
-- world cache so it will be redrawn.
when (g ^. needsRedraw) $ invalidateCacheEntry WorldCache
let fr = g ^. to focusedRobot
inventoryUpdated <- Brick.zoom (playState . scenarioState) $ checkInventoryUpdated fr
-- Now check if the base finished running a program entered at the REPL.
replUpdated <- Brick.zoom (playState . scenarioState) $ checkReplUpdated g
-- If the focused robot's log has been updated and the UI focus
-- isn't currently on the inventory or info panels, attempt to
-- automatically switch to the logger and scroll all the way down so
-- the new message can be seen.
playState . scenarioState . uiGameplay . uiScrollToEnd .= False
logUpdated <- Brick.zoom (playState . scenarioState) $ checkLogUpdated fr
menu <- use $ uiState . uiMenu
dOps <- use $ uiState . uiDebugOptions
goalOrWinUpdated <- Brick.zoom playState $ doGoalUpdates dOps menu
newPopups <- Brick.zoom playState generateNotificationPopups
-- Update the robots modal only when it is enabled. See #2370.
curModal <- use $ playState . scenarioState . uiGameplay . uiDialogs . uiModal
when ((view modalType <$> curModal) == Just (MidScenarioModal RobotsModal)) $
Brick.zoom (playState . scenarioState . uiGameplay . uiDialogs . uiRobot) $
doRobotListUpdate dOps g
let redraw =
g ^. needsRedraw
|| inventoryUpdated
|| replUpdated
|| logUpdated
|| goalOrWinUpdated
|| newPopups
pure redraw
doRobotListUpdate :: Set DebugOption -> GameState -> EventM Name RobotDisplay ()
doRobotListUpdate dOps g = do
robotsGridList %= updateRobotList dOps g
rList <- use robotsGridList
let mRob = getSelectedRobot g rList
forM_ mRob $ \r -> do
Brick.zoom robotDetailsPaneState $ updateRobotDetailsPane r
updateRobotDetailsPane :: Robot -> EventM Name RobotDetailsPaneState ()
updateRobotDetailsPane rob = do
cmdHistogramList . BL.listElementsL .= V.fromList (M.toList (rob ^. activityCounts . commandsHistogram))
logsList . BL.listElementsL .= (rob ^. robotLog)
-- | Either pops up the updated Goals modal
-- or pops up the Congratulations (Win) modal, or pops
-- up the Condolences (Lose) modal.
-- The Win modal will take precedence if the player
-- has met the necessary conditions to win the game.
--
-- If the player chooses to "Keep Playing" from the Win modal, the
-- updated Goals will then immediately appear.
-- This is desirable for:
-- * feedback as to the final goal the player accomplished,
-- * as a summary of all of the goals of the game
-- * shows the player more "optional" goals they can continue to pursue
doGoalUpdates :: Set DebugOption -> Menu -> EventM Name PlayState Bool
doGoalUpdates dOpts menu = do
curGoal <- use (scenarioState . uiGameplay . uiDialogs . uiGoal . goalsContent)
curWinCondition <- use (scenarioState . gameState . winCondition)
announcementsList <- use (scenarioState . gameState . messageInfo . announcementQueue . to toList)
let showHiddenGoals = ShowHiddenGoals `S.member` dOpts
-- Decide whether we need to update the current goal text and pop
-- up a modal dialog.
case curWinCondition of
NoWinCondition -> return False
WinConditions (Unwinnable False) x ->
setFinishState LoseModal (Unwinnable True) x
WinConditions (Won False ts) x -> do
setFinishState WinModal (Won True ts) x
WinConditions _ oc -> Brick.zoom scenarioState $ do
currentModal <- preuse $ uiGameplay . uiDialogs . uiModal . _Just . modalType
let newGoalTracking = GoalTracking announcementsList $ constructGoalMap showHiddenGoals oc
-- The "uiGoal" field is initialized with empty members, so we know that
-- this will be the first time showing it if it will be nonempty after previously
-- being empty.
isFirstGoalDisplay = hasAnythingToShow newGoalTracking && not (hasAnythingToShow curGoal)
goalWasUpdated = isFirstGoalDisplay || not (null announcementsList)
isEnding = maybe False isEndingModal currentModal
-- Decide whether to show a pop-up modal congratulating the user on
-- successfully completing the current challenge.
when (goalWasUpdated && not isEnding) $ do
-- The "uiGoal" field is necessary at least to "persist" the data that is needed
-- if the player chooses to later "recall" the goals dialog with CTRL+g.
uiGameplay . uiDialogs . uiGoal .= goalDisplay newGoalTracking
-- This clears the "flag" that indicate that the goals dialog needs to be
-- automatically popped up.
gameState . messageInfo . announcementQueue .= mempty
showObjectives <- use $ uiGameplay . uiAutoShowObjectives
when showObjectives $ openMidScenarioModal GoalModal
return goalWasUpdated
where
setFinishState :: ScenarioOutcome -> WinStatus -> ObjectiveCompletion -> EventM Name PlayState Bool
setFinishState m result x = do
-- This clears the "flag" that the Lose dialog needs to pop up
scenarioState . gameState . winCondition .= WinConditions result x
openEndScenarioModal menu $ ScenarioFinishModal m
saveScenarioInfoOnFinishNocheat dOpts
-- We do NOT advance the New Game menu to the next item here (we
-- used to!), because we do not know if the user is going to
-- select 'keep playing' or 'next challenge'. We maintain the
-- invariant that the current menu item is always the same as
-- the scenario currently being played. If the user either (1)
-- quits to the menu or (2) selects 'next challenge' we will
-- advance the menu at that point.
return True
goalDisplay :: GoalTracking -> GoalDisplay
goalDisplay newGoalTracking =
let multiple = hasMultipleGoals newGoalTracking
in GoalDisplay
newGoalTracking
(GR.makeListWidget newGoalTracking)
(focusSetCurrent (GoalWidgets $ goalFocus multiple) (goalFocusRing multiple))
goalFocus :: Bool -> GoalWidget
goalFocus hasMultiple = if hasMultiple then ObjectivesList else GoalSummary
goalFocusRing :: Bool -> FocusRing Name
goalFocusRing hasMultiple = focusRing $ GoalWidgets <$> if hasMultiple then enumerate else [GoalSummary]
isEndingModal :: ModalType -> Bool
isEndingModal = \case
EndScenarioModal _ -> True
_ -> False
-- | Pops up notifications when new recipes or commands are unlocked.
generateNotificationPopups :: EventM Name PlayState Bool
generateNotificationPopups = do
rs <- use $ scenarioState . gameState . discovery . availableRecipes
let newRecipes = rs ^. notificationsShouldAlert
when newRecipes $ do
progression . uiPopups %= addPopup RecipesPopup
scenarioState . gameState . discovery . availableRecipes . notificationsShouldAlert .= False
cs <- use $ scenarioState . gameState . discovery . availableCommands
let alertCommands = cs ^. notificationsShouldAlert
when alertCommands $ do
let newCommands = take (cs ^. notificationsCount) (cs ^. notificationsContent)
progression . uiPopups %= addPopup (CommandsPopup newCommands)
scenarioState . gameState . discovery . availableCommands . notificationsShouldAlert .= False
return $ newRecipes || alertCommands
-- | Strips the top-level @Cmd@ from a type, if any (to compute the
-- result type of a REPL command evaluation).
stripCmd :: TDCtx -> Polytype -> Polytype
stripCmd tdCtx = fmap $ \ty -> case whnfType tdCtx ty of
TyCmd resTy -> resTy
_ -> ty