-- | Monadic operations on slideshows and related data. module Game.LambdaHack.Client.UI.SlideshowM ( overlayToSlideshow, reportToSlideshow, reportToSlideshowKeepHalt , displaySpaceEsc, displayMore, displayMoreKeep, displayYesNo, getConfirms , displayChoiceScreen , displayChoiceScreenWithRightPane , displayChoiceScreenWithDefItemKey , displayChoiceScreenWithRightPaneKMKM , pushFrame, pushReportFrame #ifdef EXPOSE_INTERNAL -- * Internal operations , getMenuIx, saveMenuIx, stepChoiceScreen, navigationKeys, findKYX , drawHighlight, basicFrameWithoutReport #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import qualified Data.Char as Char import Data.Either import qualified Data.EnumMap.Strict as EM import qualified Data.Map.Strict as M import qualified Data.Text as T import Game.LambdaHack.Client.MonadClient import Game.LambdaHack.Client.State import Game.LambdaHack.Client.UI.Content.Screen import Game.LambdaHack.Client.UI.ContentClientUI import Game.LambdaHack.Client.UI.Frame import Game.LambdaHack.Client.UI.FrameM import qualified Game.LambdaHack.Client.UI.Key as K import Game.LambdaHack.Client.UI.MonadClientUI import Game.LambdaHack.Client.UI.Msg import Game.LambdaHack.Client.UI.MsgM import Game.LambdaHack.Client.UI.Overlay import Game.LambdaHack.Client.UI.PointUI import Game.LambdaHack.Client.UI.SessionUI import Game.LambdaHack.Client.UI.Slideshow import Game.LambdaHack.Client.UI.UIOptions import Game.LambdaHack.Common.ClientOptions import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.MonadStateRead import Game.LambdaHack.Common.State import Game.LambdaHack.Common.Types import Game.LambdaHack.Common.Vector import qualified Game.LambdaHack.Definition.Color as Color -- | Add current report to the overlay, split the result and produce, -- possibly, many slides. overlayToSlideshow :: MonadClientUI m => Int -> [K.KM] -> OKX -> m Slideshow overlayToSlideshow y keys okx = do CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui UIOptions{uMsgWrapColumn} <- getsSession sUIOptions report <- getReportUI True recordHistory -- report will be shown soon, remove it to history fontSetup <- getFontSetup curTutorial <- getsSession scurTutorial overrideTut <- getsSession soverrideTut let displayTutorialHints = fromMaybe curTutorial overrideTut return $! splitOverlay fontSetup displayTutorialHints rwidth y uMsgWrapColumn report keys okx -- | Split current report into a slideshow. reportToSlideshow :: MonadClientUI m => [K.KM] -> m Slideshow reportToSlideshow keys = do CCUI{coscreen=ScreenContent{rheight}} <- getsSession sccui overlayToSlideshow (rheight - 2) keys emptyOKX -- | Split current report into a slideshow. Keep report unchanged. -- Assume the game either halts waiting for a key after this is shown, -- or many slides are produced, all but the last are displayed -- with player promts between and the last is either shown -- in full or ignored if inside macro (can be recovered from history, -- if important). Unless the prompts interrupt the macro, which is as well. reportToSlideshowKeepHalt :: MonadClientUI m => Bool -> [K.KM] -> m Slideshow reportToSlideshowKeepHalt insideMenu keys = do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui UIOptions{uMsgWrapColumn} <- getsSession sUIOptions report <- getReportUI insideMenu -- Don't do @recordHistory@; the message is important, but related -- to the messages that come after, so should be shown together. fontSetup <- getFontSetup curTutorial <- getsSession scurTutorial overrideTut <- getsSession soverrideTut let displayTutorialHints = fromMaybe curTutorial overrideTut return $! splitOverlay fontSetup displayTutorialHints rwidth (rheight - 2) uMsgWrapColumn report keys emptyOKX -- | Display a message. Return value indicates if the player wants to continue. -- Feature: if many pages, only the last SPACE exits (but first ESC). displaySpaceEsc :: MonadClientUI m => ColorMode -> Text -> m Bool displaySpaceEsc dm prompt = do unless (T.null prompt) $ msgLnAdd MsgPromptGeneric prompt -- Two frames drawn total (unless @prompt@ very long). slides <- reportToSlideshow [K.spaceKM, K.escKM] km <- getConfirms dm [K.spaceKM, K.escKM] slides return $! km == K.spaceKM -- | Display a message. Ignore keypresses. -- Feature: if many pages, only the last SPACE exits (but first ESC). displayMore :: MonadClientUI m => ColorMode -> Text -> m () displayMore dm prompt = do unless (T.null prompt) $ msgLnAdd MsgPromptGeneric prompt slides <- reportToSlideshow [K.spaceKM] void $ getConfirms dm [K.spaceKM, K.escKM] slides displayMoreKeep :: MonadClientUI m => ColorMode -> Text -> m () displayMoreKeep dm prompt = do unless (T.null prompt) $ msgLnAdd MsgPromptGeneric prompt slides <- reportToSlideshowKeepHalt True [K.spaceKM] void $ getConfirms dm [K.spaceKM, K.escKM] slides -- | Print a yes/no question and return the player's answer. Use black -- and white colours to turn player's attention to the choice. displayYesNo :: MonadClientUI m => ColorMode -> Text -> m Bool displayYesNo dm prompt = do unless (T.null prompt) $ msgLnAdd MsgPromptGeneric prompt let yn = map K.mkChar ['y', 'n'] slides <- reportToSlideshow yn km <- getConfirms dm (K.escKM : yn) slides return $! km == K.mkChar 'y' getConfirms :: MonadClientUI m => ColorMode -> [K.KM] -> Slideshow -> m K.KM getConfirms dm extraKeys slides = do ekm <- displayChoiceScreen "" dm False slides extraKeys return $! either id (error $ "" `showFailure` ekm) ekm -- | Display a, potentially, multi-screen menu and return the chosen -- key or menu slot (and save the index in the whole menu so that the cursor -- can again be placed at that spot next time menu is displayed). -- -- This function is one of only two sources of menus and so, -- effectively, UI modes. displayChoiceScreen :: forall m . MonadClientUI m => String -> ColorMode -> Bool -> Slideshow -> [K.KM] -> m KeyOrSlot displayChoiceScreen = do displayChoiceScreenWithRightPane (const $ return emptyOKX) False -- | Display a, potentially, multi-screen menu and return the chosen -- key or menu slot (and save the index in the whole menu so that the cursor -- can again be placed at that spot next time menu is displayed). -- Additionally, display something on the right half of the screen, -- depending on which menu item is currently highlighted -- -- This function is one of only two sources of menus and so, -- effectively, UI modes. displayChoiceScreenWithRightPane :: forall m . MonadClientUI m => (KeyOrSlot -> m OKX) -> Bool -> String -> ColorMode -> Bool -> Slideshow -> [K.KM] -> m KeyOrSlot displayChoiceScreenWithRightPane displayInRightPane highlightBullet menuName dm sfBlank frsX extraKeys = do kmkm <- displayChoiceScreenWithRightPaneKMKM displayInRightPane highlightBullet menuName dm sfBlank frsX extraKeys return $! case kmkm of Left (km, _) -> Left km Right slot -> Right slot -- | A specialized variant of 'displayChoiceScreenWithRightPane'. displayChoiceScreenWithDefItemKey :: MonadClientUI m => (Int -> MenuSlot -> m OKX) -> Slideshow -> [K.KM] -> String -> m KeyOrSlot displayChoiceScreenWithDefItemKey f sli itemKeys menuName = do CCUI{coscreen=ScreenContent{rwidth}} <- getsSession sccui FontSetup{propFont} <- getFontSetup let g ekm = case ekm of Left{} -> return emptyOKX Right slot -> do if isSquareFont propFont then return emptyOKX else f (rwidth - 2) slot displayChoiceScreenWithRightPane g True menuName ColorFull False sli itemKeys -- | A variant providing for a keypress the information about the label -- of the menu slot which was selected during the keypress. displayChoiceScreenWithRightPaneKMKM :: forall m . MonadClientUI m => (KeyOrSlot -> m OKX) -> Bool -> String -> ColorMode -> Bool -> Slideshow -> [K.KM] -> m (Either (K.KM, KeyOrSlot) MenuSlot) displayChoiceScreenWithRightPaneKMKM displayInRightPane highlightBullet menuName dm sfBlank frsX extraKeys = do (maxIx, initIx, clearIx, m) <- stepChoiceScreen highlightBullet dm sfBlank frsX extraKeys let loop :: Int -> KeyOrSlot -> m (Either (K.KM, KeyOrSlot) MenuSlot, Int) loop pointer km = do okxRight <- displayInRightPane km (final, kmkm1, pointer1) <- m pointer okxRight if final then return (kmkm1, pointer1) else loop pointer1 $ case kmkm1 of Left (km1, _) -> Left km1 Right slot -> Right slot pointer0 <- getMenuIx menuName maxIx initIx clearIx let km0 = case findKYX pointer0 $ slideshow frsX of Nothing -> error $ "no menu keys" `showFailure` frsX Just (_, (ekm, _), _) -> ekm (km, pointer) <- loop pointer0 km0 saveMenuIx menuName initIx pointer return km getMenuIx :: MonadClientUI m => String -> Int -> Int -> Int -> m Int getMenuIx menuName maxIx initIx clearIx = do menuIxMap <- getsSession smenuIxMap -- Beware, values in @menuIxMap@ may be negative (meaning: a key, not slot). let menuIx = if menuName == "" then clearIx else maybe clearIx (+ initIx) (M.lookup menuName menuIxMap) -- this may still be negative, from different context return $! max clearIx $ min maxIx menuIx -- so clamp to point at item, not key saveMenuIx :: MonadClientUI m => String -> Int -> Int -> m () saveMenuIx menuName initIx pointer = unless (menuName == "") $ modifySession $ \sess -> sess {smenuIxMap = M.insert menuName (pointer - initIx) $ smenuIxMap sess} -- | This is one step of UI menu management user session. -- -- There is limited looping involved to return a changed position -- in the menu each time so that the surrounding code has anything -- interesting to do. The exception is when finally confirming a selection, -- in which case it's usually not changed compared to last step, -- but it's presented differently to indicate it was confirmed. -- -- Any extra keys in the `OKX` argument on top of the those in @Slideshow@ -- argument need to be contained in the @[K.KM]@ argument. Otherwise -- they are not accepted. stepChoiceScreen :: forall m . MonadClientUI m => Bool -> ColorMode -> Bool -> Slideshow -> [K.KM] -> m ( Int, Int, Int , Int -> OKX -> m (Bool, Either (K.KM, KeyOrSlot) MenuSlot, Int) ) stepChoiceScreen highlightBullet dm sfBlank frsX extraKeys = do CCUI{coscreen=ScreenContent{rwidth, rheight}} <- getsSession sccui FontSetup{..} <- getFontSetup UIOptions{uVi, uLeftHand} <- getsSession sUIOptions let !_A = assert (K.escKM `elem` extraKeys) () frs = slideshow frsX keys = concatMap (lefts . map fst . snd) frs ++ extraKeys cardinalKeys = K.cardinalAllKM uVi uLeftHand handleDir = K.handleCardinal cardinalKeys legalKeys = keys ++ navigationKeys ++ cardinalKeys allOKX = concatMap snd frs maxIx = length allOKX - 1 initIx = case findIndex (isRight . fst) allOKX of Just p -> p _ -> 0 -- can't be @length allOKX@ or a multi-page item menu -- mangles saved index of other item munus clearIx = if initIx > maxIx then 0 else initIx canvasLength = if sfBlank then rheight else rheight - 2 trimmedY = canvasLength - 1 - 2 -- will be translated down 2 lines trimmedAlert = ( PointUI 0 trimmedY , stringToAL "--a portion of the text trimmed--" ) page :: Int -> OKX -> m (Bool, Either (K.KM, KeyOrSlot) MenuSlot, Int) page pointer (ovsRight0, kyxsRight) = assert (pointer >= 0) $ case findKYX pointer frs of Nothing -> error $ "no menu keys" `showFailure` frs Just ( (ovs0, kyxs2) , (ekm, (PointUI x1 y, buttonWidth)) , ixOnPage ) -> do let ovs1 = EM.map (updateLine y $ drawHighlight x1 buttonWidth) ovs0 ovs2 = if highlightBullet then EM.map (highBullet kyxs2) ovs1 else ovs1 -- We add spaces in proportional font under the report rendered -- in mono font and the right pane text in prop font, -- but over menu lines in proportional font that can be -- very long an should not peek from under the right pane text. -- -- We translate the pane by two characters right, because it looks -- better when a couple last characters of a line vanish -- off-screen than when characters touch in the middle -- of the screen. The code producing right panes should take care -- to generate lines two shorter than usually. -- -- We move the pane two characters down, because normally -- reports should not be longer than three lines -- and the third no longer than half width. -- We also add two to three lines of backdrop at the bottom. ymax = maxYofFontOverlayMap ovsRight0 -- Apparently prop spaces can be really narrow, hence so many. -- With square font, this obscures the link in main menu, -- so would need to complicated. spaceRectangle | isSquareFont propFont = [] | otherwise = rectangleOfSpaces (rwidth * 4) (min canvasLength $ ymax + 5) trim = filter (\(PointUI _ yRight, _) -> yRight < trimmedY) -- The alert not clickable, because the player can enter -- the menu entry and scroll through the unabridged blurb. ovsRight1 = if ymax <= trimmedY then ovsRight0 else EM.unionWith (++) (EM.map trim ovsRight0) (EM.singleton monoFont [trimmedAlert]) ovsRight = EM.unionWith (++) (EM.singleton propFont spaceRectangle) (EM.map (xytranslateOverlay 2 2) ovsRight1) (ovs, kyxs) = if EM.null ovsRight0 then (ovs2, kyxs2) else sideBySideOKX rwidth 0 (ovs2, kyxs2) (ovsRight, kyxsRight) kmkm ekm2 = case ekm2 of Left km -> Left (km, ekm2) Right slot -> Right slot tmpResult pointer1 = case findKYX pointer1 frs of Nothing -> error $ "no menu keys" `showFailure` frs Just (_, (ekm1, _), _) -> return (False, kmkm ekm1, pointer1) ignoreKey = return (False, kmkm ekm, pointer) pageLen = length kyxs xix :: KYX -> Bool xix (_, (PointUI x1' _, _)) = x1' <= x1 + 2 && x1' >= x1 - 2 firstRowOfNextPage = pointer + pageLen - ixOnPage restOKX = drop firstRowOfNextPage allOKX -- This does not take into account the right pane, which is fine. firstItemOfNextPage = case findIndex (isRight . fst) restOKX of Just p -> p + firstRowOfNextPage _ -> firstRowOfNextPage interpretKey :: K.KM -> m (Bool, Either (K.KM, KeyOrSlot) MenuSlot, Int) interpretKey ikm = case K.key ikm of _ | ikm == K.controlP -> do -- Silent, because any prompt would be shown too late. printScreen ignoreKey K.Return -> case ekm of Left km -> if K.key km == K.Return then return (True, Left (km, ekm), pointer) else interpretKey km Right c -> return (True, Right c, pointer) K.LeftButtonRelease -> do PointUI mx my <- getsSession spointer let onChoice (_, (PointUI cx cy, ButtonWidth font clen)) = let blen | isSquareFont font = 2 * clen | otherwise = clen in my == cy && mx >= cx && mx < cx + blen case find onChoice kyxs of Nothing | ikm `elem` keys -> return (True, Left (ikm, ekm), pointer) Nothing -> if K.spaceKM `elem` keys then return (True, Left (K.spaceKM, ekm), pointer) else ignoreKey Just (ckm, _) -> case ckm of Left km -> if K.key km == K.Return && km `elem` keys then return (True, Left (km, ekm), pointer) else interpretKey km Right c -> return (True, Right c, pointer) K.RightButtonRelease -> if ikm `elem` keys then return (True, Left (ikm, ekm), pointer) else return (True, Left (K.escKM, ekm), pointer) K.Space | firstItemOfNextPage <= maxIx -> tmpResult firstItemOfNextPage K.Unknown "SAFE_SPACE" -> if firstItemOfNextPage <= maxIx then tmpResult firstItemOfNextPage else tmpResult clearIx _ | ikm `elem` keys -> return (True, Left (ikm, ekm), pointer) _ | K.key ikm == K.WheelNorth || handleDir ikm == Just (Vector 0 (-1)) -> case findIndex xix $ reverse $ take ixOnPage kyxs of Nothing -> if pointer == 0 then tmpResult maxIx else tmpResult (max 0 (pointer - 1)) Just ix -> tmpResult (max 0 (pointer - ix - 1)) _ | K.key ikm == K.WheelSouth || handleDir ikm == Just (Vector 0 1) -> case findIndex xix $ drop (ixOnPage + 1) kyxs of Nothing -> if pointer == maxIx then tmpResult 0 else tmpResult (min maxIx (pointer + 1)) Just ix -> tmpResult (pointer + ix + 1) _ | handleDir ikm == Just (Vector (-1) 0) -> case findKYX (max 0 (pointer - 1)) frs of Just (_, (_, (PointUI _ y2, _)), _) | y2 == y -> tmpResult (max 0 (pointer - 1)) _ -> ignoreKey _ | handleDir ikm == Just (Vector 1 0) -> case findKYX (min maxIx (pointer + 1)) frs of Just (_, (_, (PointUI _ y2, _)), _) | y2 == y -> tmpResult (min maxIx (pointer + 1)) _ -> ignoreKey K.Home -> tmpResult clearIx K.End -> tmpResult maxIx K.PgUp -> tmpResult (max 0 (pointer - ixOnPage - 1)) K.PgDn -> -- This doesn't scroll by screenful when header very long -- and menu non-empty, but that scenario is rare, so OK, -- arrow keys may be used instead. tmpResult (min maxIx firstItemOfNextPage) K.Space -> ignoreKey _ | K.key ikm `elem` [K.Char '?', K.Fun 1] -> do -- Clear macros and invoke the help macro. modifySession $ \sess -> sess { smacroFrame = emptyMacroFrame {keyPending = KeyMacro [K.mkKM "F1"]} , smacroStack = [] } return (True, Left (K.escKM, ekm), pointer) _ -> error $ "unknown key" `showFailure` ikm pkm <- promptGetKey dm ovs sfBlank legalKeys interpretKey pkm m pointer okxRight = if null frs then return (True, Left (K.escKM, Left K.escKM), pointer) else do (final, km, pointer1) <- page pointer okxRight let !_A1 = assert (either ((`elem` keys) . fst) (const True) km) () -- Pointer at a button included, hence greater than 0, not @clearIx@. let !_A2 = assert (0 <= pointer1 && pointer1 <= maxIx `blame` (pointer1, maxIx)) () return (final, km, pointer1) return (maxIx, initIx, clearIx, m) navigationKeys :: [K.KM] navigationKeys = [ K.leftButtonReleaseKM, K.rightButtonReleaseKM , K.returnKM, K.spaceKM, K.wheelNorthKM, K.wheelSouthKM , K.pgupKM, K.pgdnKM, K.homeKM, K.endKM, K.controlP , K.mkChar '?', K.mkKM "F1" ] -- | Find a position in a menu. -- The arguments go from first menu line and menu page to the last, -- in order. Their indexing is from 0. We select the nearest item -- with the index equal or less to the pointer. findKYX :: Int -> [OKX] -> Maybe (OKX, KYX, Int) findKYX _ [] = Nothing findKYX pointer (okx@(_, kyxs) : frs2) = case drop pointer kyxs of [] -> -- not enough menu items on this page case findKYX (pointer - length kyxs) frs2 of Nothing -> -- no more menu items in later pages case reverse kyxs of [] -> Nothing kyx : _ -> Just (okx, kyx, length kyxs - 1) res -> res kyx : _ -> Just (okx, kyx, pointer) drawHighlight :: Int -> ButtonWidth -> Int -> AttrString -> AttrString drawHighlight x1 (ButtonWidth font len) xstart as = let highableAttrs = [Color.defAttr, Color.defAttr {Color.fg = Color.BrBlack}] highAttr c | Color.acAttr c `notElem` highableAttrs || Color.acChar c == ' ' = c highAttr c = c {Color.acAttr = (Color.acAttr c) {Color.fg = Color.BrWhite}} cursorAttr c = c {Color.acAttr = (Color.acAttr c) {Color.bg = Color.HighlightNoneCursor}} noCursorAttr c = c {Color.acAttr = (Color.acAttr c) {Color.bg = Color.HighlightNone}} -- This also highlights dull white item symbols, but who cares. lenUI = if isSquareFont font then len * 2 else len x1MinusXStartChars = if isSquareFont font then (x1 - xstart) `div` 2 else x1 - xstart (as1, asRest) = splitAt x1MinusXStartChars as (as2, as3) = splitAt len asRest highW32 = Color.attrCharToW32 . highAttr . Color.attrCharFromW32 as2High = map highW32 as2 cursorW32 = Color.attrCharToW32 . cursorAttr . Color.attrCharFromW32 (nonAlpha, alpha) = break (Char.isAlphaNum . Color.charFromW32) as2High as2Cursor = case alpha of [] -> [] ch : chrest -> cursorW32 ch : chrest noCursorW32 = Color.attrCharToW32 . noCursorAttr . Color.attrCharFromW32 in if x1 + lenUI < xstart then as else as1 ++ map noCursorW32 nonAlpha ++ as2Cursor ++ as3 drawBullet :: Int -> ButtonWidth -> Int -> AttrString -> AttrString drawBullet x1 (ButtonWidth font len) xstart as0 = let diminishChar '-' = ' ' diminishChar '^' = '^' diminishChar '"' = '"' diminishChar _ = 'ยท' highableAttr = Color.defAttr {Color.bg = Color.HighlightNoneCursor} highW32 ac32 = let ac = Color.attrCharFromW32 ac32 ch = diminishChar $ Color.acChar ac in if | Color.acAttr ac /= highableAttr -> ac32 | Color.acChar ac == ' ' -> error $ "drawBullet: HighlightNoneCursor space forbidden" `showFailure` (ac, map Color.charFromW32 as0) | ch == ' ' -> Color.spaceAttrW32 | otherwise -> Color.attrCharToW32 $ ac { Color.acAttr = Color.defAttr {Color.fg = Color.BrBlack} , Color.acChar = ch } lenUI = if isSquareFont font then len * 2 else len x1MinusXStartChars = if isSquareFont font then (x1 - xstart) `div` 2 else x1 - xstart (as1, asRest) = splitAt x1MinusXStartChars as0 (as2, as3) = splitAt len asRest highAs = \case toHighlight : rest -> highW32 toHighlight : rest [] -> [] in if x1 + lenUI < xstart then as0 else as1 ++ highAs as2 ++ as3 highBullet :: [KYX] -> Overlay -> Overlay highBullet kyxs ov0 = let f (_, (PointUI x1 y, buttonWidth)) = updateLine y $ drawBullet x1 buttonWidth in foldr f ov0 kyxs -- This is not our turn, so we can't obstruct screen with messages -- and message reformatting causes distraction, so there's no point -- trying to squeeze the report into the single available line, -- except when it's not our turn permanently, because AI runs UI. -- -- The only real drawback of this is that when resting for longer time -- I can't see the boring messages accumulate until a non-boring interrupts me. basicFrameWithoutReport :: MonadClientUI m => LevelId -> Maybe Bool -> m PreFrame3 basicFrameWithoutReport arena forceReport = do FontSetup{propFont} <- getFontSetup sbenchMessages <- getsClient $ sbenchMessages . soptions side <- getsClient sside fact <- getsState $ (EM.! side) . sfactionD truncRep <- if | sbenchMessages -> do slides <- reportToSlideshowKeepHalt False [] case slideshow slides of [] -> return EM.empty (ov, _) : _ -> do -- See @stepQueryUI@. This strips either "--end-" or "--more-". let ovProp = ov EM.! propFont return $! EM.singleton propFont $ if EM.size ov > 1 then ovProp else init ovProp | fromMaybe (gunderAI fact) forceReport -> do report <- getReportUI False let par1 = firstParagraph $ foldr (<+:>) [] $ renderReport True report return $! EM.fromList [(propFont, [(PointUI 0 0, par1)])] | otherwise -> return EM.empty drawOverlay ColorFull False truncRep arena -- | Push the frame depicting the current level to the frame queue. -- Only one line of the report is shown, as in animations, -- because it may not be our turn, so we can't clear the message -- to see what is underneath. pushFrame :: MonadClientUI m => Bool -> m () pushFrame delay = do -- The delay before reaction to keypress was too long in case of many -- projectiles flying and ending flight, so frames need to be skipped. keyPressed <- anyKeyPressed unless keyPressed $ do lidV <- viewedLevelUI frame <- basicFrameWithoutReport lidV Nothing -- Pad with delay before and after to let player see, e.g., door being -- opened a few ticks after it came into vision, the same turn. displayFrames lidV $ if delay then [Nothing, Just frame, Nothing] else [Just frame] pushReportFrame :: MonadClientUI m => m () pushReportFrame = do lidV <- viewedLevelUI frame <- basicFrameWithoutReport lidV (Just True) displayFrames lidV [Just frame]