    -- | 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 :: forall (m :: * -> *).
    MonadClientUI m =>
    Int -> [KM] -> OKX -> m Slideshow
    overlayToSlideshow Int
    y [KM]
    keys OKX
    okx = do
      CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    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 = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    curTutorial Maybe Bool
    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 :: forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
    reportToSlideshow [KM]
    keys = do
      CCUI{coscreen=ScreenContent{rheight}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    Bool -> [KM] -> m Slideshow
    reportToSlideshowKeepHalt Bool
    insideMenu [KM]
    keys = do
      CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    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 = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    curTutorial Maybe Bool
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> Text -> m Bool
    displaySpaceEsc ColorMode
    dm Text
    prompt = do
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text -> Bool
    T.null Text
    prompt) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgLnAdd MsgClassShow
    MsgPromptGeneric Text
    prompt
      -- Two frames drawn total (unless @prompt@ very long).
      slides <- [KM] -> m Slideshow
    forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
    reportToSlideshow [KM
    K.spaceKM, KM
    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 :: forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
    displayMore ColorMode
    dm Text
    prompt = do
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text -> Bool
    T.null Text
    prompt) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgLnAdd MsgClassShow
    MsgPromptGeneric Text
    prompt
      slides <- [KM] -> m Slideshow
    forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
    reportToSlideshow [KM
    K.spaceKM]
      void $ getConfirms dm [K.spaceKM, K.escKM] slides

    displayMoreKeep :: MonadClientUI m => ColorMode -> Text -> m ()
    displayMoreKeep :: forall (m :: * -> *). MonadClientUI m => ColorMode -> Text -> m ()
    displayMoreKeep ColorMode
    dm Text
    prompt = do
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text -> Bool
    T.null Text
    prompt) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgLnAdd MsgClassShow
    MsgPromptGeneric Text
    prompt
      slides <- Bool -> [KM] -> m Slideshow
    forall (m :: * -> *).
    MonadClientUI m =>
    Bool -> [KM] -> m Slideshow
    reportToSlideshowKeepHalt Bool
    True [KM
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> Text -> m Bool
    displayYesNo ColorMode
    dm Text
    prompt = do
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Text -> Bool
    T.null Text
    prompt) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ MsgClassShow -> Text -> m ()
    forall (m :: * -> *) a.
    (MonadClientUI m, MsgShared a) =>
    a -> Text -> m ()
    msgLnAdd MsgClassShow
    MsgPromptGeneric Text
    prompt
      let yn :: [KM]
    yn = (Char -> KM) -> [Char] -> [KM]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> KM
    K.mkChar [Char
    'y', Char
    'n']
      slides <- [KM] -> m Slideshow
    forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
    reportToSlideshow [KM]
    yn
      km <- getConfirms dm (K.escKM : yn) slides
      return $! km == K.mkChar 'y'

    getConfirms :: MonadClientUI m
                => ColorMode -> [K.KM] -> Slideshow -> m K.KM
    getConfirms :: forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> [KM] -> Slideshow -> m KM
    getConfirms ColorMode
    dm [KM]
    extraKeys Slideshow
    slides = do
      ekm <- [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
    forall (m :: * -> *).
    MonadClientUI m =>
    [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
    displayChoiceScreen [Char]
    "" ColorMode
    dm Bool
    False Slideshow
    slides [KM]
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
    displayChoiceScreen = do
      (KeyOrSlot -> m OKX)
    -> Bool
    -> [Char]
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m KeyOrSlot
    forall (m :: * -> *).
    MonadClientUI m =>
    (KeyOrSlot -> m OKX)
    -> Bool
    -> [Char]
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m KeyOrSlot
    displayChoiceScreenWithRightPane (m OKX -> KeyOrSlot -> m OKX
    forall a b. a -> b -> a
    const (m OKX -> KeyOrSlot -> m OKX) -> m OKX -> KeyOrSlot -> m OKX
    forall a b. (a -> b) -> a -> b
    $ OKX -> m OKX
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OKX
    emptyOKX) Bool
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    (KeyOrSlot -> m OKX)
    -> Bool
    -> [Char]
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m KeyOrSlot
    displayChoiceScreenWithRightPane KeyOrSlot -> m OKX
    displayInRightPane
                                     Bool
    highlightBullet [Char]
    menuName ColorMode
    dm Bool
    sfBlank
                                     Slideshow
    frsX [KM]
    extraKeys = do
      kmkm <- (KeyOrSlot -> m OKX)
    -> Bool
    -> [Char]
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m (Either (KM, KeyOrSlot) MenuSlot)
    forall (m :: * -> *).
    MonadClientUI m =>
    (KeyOrSlot -> m OKX)
    -> Bool
    -> [Char]
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m (Either (KM, KeyOrSlot) MenuSlot)
    displayChoiceScreenWithRightPaneKMKM
                                     KeyOrSlot -> m OKX
    displayInRightPane
                                     Bool
    highlightBullet [Char]
    menuName ColorMode
    dm Bool
    sfBlank
                                     Slideshow
    frsX [KM]
    extraKeys
      return $! case kmkm of
        Left (KM
    km, KeyOrSlot
    _) -> KM -> KeyOrSlot
    forall a b. a -> Either a b
    Left KM
    km
        Right MenuSlot
    slot -> MenuSlot -> KeyOrSlot
    forall a b. b -> Either a b
    Right MenuSlot
    slot

    -- | A specialized variant of 'displayChoiceScreenWithRightPane'.
    displayChoiceScreenWithDefItemKey :: MonadClientUI m
                                      => (Int -> MenuSlot -> m OKX)
                                      -> Slideshow
                                      -> [K.KM]
                                      -> String
                                      -> m KeyOrSlot
    displayChoiceScreenWithDefItemKey :: forall (m :: * -> *).
    MonadClientUI m =>
    (Int -> MenuSlot -> m OKX)
    -> Slideshow -> [KM] -> [Char] -> m KeyOrSlot
    displayChoiceScreenWithDefItemKey Int -> MenuSlot -> m OKX
    f Slideshow
    sli [KM]
    itemKeys [Char]
    menuName = do
      CCUI{coscreen=ScreenContent{rwidth}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      FontSetup{propFont} <- getFontSetup
      let g KeyOrSlot
    ekm = case KeyOrSlot
    ekm of
            Left{} -> OKX -> m OKX
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OKX
    emptyOKX
            Right MenuSlot
    slot -> do
              if DisplayFont -> Bool
    isSquareFont DisplayFont
    propFont
              then OKX -> m OKX
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OKX
    emptyOKX
              else Int -> MenuSlot -> m OKX
    f (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) MenuSlot
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    (KeyOrSlot -> m OKX)
    -> Bool
    -> [Char]
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m (Either (KM, KeyOrSlot) MenuSlot)
    displayChoiceScreenWithRightPaneKMKM KeyOrSlot -> m OKX
    displayInRightPane
                                         Bool
    highlightBullet [Char]
    menuName ColorMode
    dm Bool
    sfBlank
                                         Slideshow
    frsX [KM]
    extraKeys = do
      (maxIx, initIx, clearIx, m)
        <- Bool
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m (Int, Int, Int,
          Int -> OKX -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int))
    forall (m :: * -> *).
    MonadClientUI m =>
    Bool
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m (Int, Int, Int,
          Int -> OKX -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int))
    stepChoiceScreen Bool
    highlightBullet ColorMode
    dm Bool
    sfBlank Slideshow
    frsX [KM]
    extraKeys
      let loop :: Int -> KeyOrSlot -> m (Either (K.KM, KeyOrSlot) MenuSlot, Int)
          loop Int
    pointer KeyOrSlot
    km = do
            okxRight <- KeyOrSlot -> m OKX
    displayInRightPane KeyOrSlot
    km
            (final, kmkm1, pointer1) <- m pointer okxRight
            if final
            then return (kmkm1, pointer1)
            else loop pointer1 $ case kmkm1 of
              Left (KM
    km1, KeyOrSlot
    _) -> KM -> KeyOrSlot
    forall a b. a -> Either a b
    Left KM
    km1
              Right MenuSlot
    slot -> MenuSlot -> KeyOrSlot
    forall a b. b -> Either a b
    Right MenuSlot
    slot
      pointer0 <- getMenuIx menuName maxIx initIx clearIx
      let km0 = case Int -> [OKX] -> Maybe (OKX, KYX, Int)
    findKYX Int
    pointer0 ([OKX] -> Maybe (OKX, KYX, Int)) -> [OKX] -> Maybe (OKX, KYX, Int)
    forall a b. (a -> b) -> a -> b
    $ Slideshow -> [OKX]
    slideshow Slideshow
    frsX of
            Maybe (OKX, KYX, Int)
    Nothing -> [Char] -> KeyOrSlot
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> KeyOrSlot) -> [Char] -> KeyOrSlot
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "no menu keys" [Char] -> Slideshow -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` Slideshow
    frsX
            Just (OKX
    _, (KeyOrSlot
    ekm, (PointUI, ButtonWidth)
    _), Int
    _) -> KeyOrSlot
    ekm
      (km, pointer) <- loop pointer0 km0
      saveMenuIx menuName initIx pointer
      return km

    getMenuIx :: MonadClientUI m => String -> Int -> Int -> Int -> m Int
    getMenuIx :: forall (m :: * -> *).
    MonadClientUI m =>
    [Char] -> Int -> Int -> Int -> m Int
    getMenuIx [Char]
    menuName Int
    maxIx Int
    initIx Int
    clearIx = do
      menuIxMap <- (SessionUI -> Map [Char] Int) -> m (Map [Char] Int)
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> Map [Char] Int
    smenuIxMap
      -- Beware, values in @menuIxMap@ may be negative (meaning: a key, not slot).
      let menuIx = if [Char]
    menuName [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    ""
                   then Int
    clearIx
                   else Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    clearIx (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    initIx) ([Char] -> Map [Char] Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup [Char]
    menuName Map [Char] Int
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    [Char] -> Int -> Int -> m ()
    saveMenuIx [Char]
    menuName Int
    initIx Int
    pointer =
      Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([Char]
    menuName [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "") (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
        (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
          SessionUI
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    Bool
    -> ColorMode
    -> Bool
    -> Slideshow
    -> [KM]
    -> m (Int, Int, Int,
          Int -> OKX -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int))
    stepChoiceScreen Bool
    highlightBullet ColorMode
    dm Bool
    sfBlank Slideshow
    frsX [KM]
    extraKeys = do
      CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> CCUI
    sccui
      FontSetup{..} <- getFontSetup
      UIOptions{uVi, uLeftHand} <- getsSession sUIOptions
      let !_A = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (KM
    K.escKM KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM]
    extraKeys) ()
          frs = Slideshow -> [OKX]
    slideshow Slideshow
    frsX
          keys = (OKX -> [KM]) -> [OKX] -> [KM]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([KeyOrSlot] -> [KM]
    forall a b. [Either a b] -> [a]
    lefts ([KeyOrSlot] -> [KM]) -> (OKX -> [KeyOrSlot]) -> OKX -> [KM]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (KYX -> KeyOrSlot) -> [KYX] -> [KeyOrSlot]
    forall a b. (a -> b) -> [a] -> [b]
    map KYX -> KeyOrSlot
    forall a b. (a, b) -> a
    fst ([KYX] -> [KeyOrSlot]) -> (OKX -> [KYX]) -> OKX -> [KeyOrSlot]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OKX -> [KYX]
    forall a b. (a, b) -> b
    snd) [OKX]
    frs [KM] -> [KM] -> [KM]
    forall a. [a] -> [a] -> [a]
    ++ [KM]
    extraKeys
          cardinalKeys = Bool -> Bool -> [KM]
    K.cardinalAllKM Bool
    uVi Bool
    uLeftHand
          handleDir = [KM] -> KM -> Maybe Vector
    K.handleCardinal [KM]
    cardinalKeys
          legalKeys = [KM]
    keys [KM] -> [KM] -> [KM]
    forall a. [a] -> [a] -> [a]
    ++ [KM]
    navigationKeys [KM] -> [KM] -> [KM]
    forall a. [a] -> [a] -> [a]
    ++ [KM]
    cardinalKeys
          allOKX = (OKX -> [KYX]) -> [OKX] -> [KYX]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap OKX -> [KYX]
    forall a b. (a, b) -> b
    snd [OKX]
    frs
          maxIx = [KYX] -> Int
    forall a. [a] -> Int
    length [KYX]
    allOKX Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
          initIx = case (KYX -> Bool) -> [KYX] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex (KeyOrSlot -> Bool
    forall a b. Either a b -> Bool
    isRight (KeyOrSlot -> Bool) -> (KYX -> KeyOrSlot) -> KYX -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KYX -> KeyOrSlot
    forall a b. (a, b) -> a
    fst) [KYX]
    allOKX of
            Just Int
    p -> Int
    p
            Maybe Int
    _ -> Int
    0  -- can't be @length allOKX@ or a multi-page item menu
                    -- mangles saved index of other item munus
          clearIx = if Int
    initIx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxIx then Int
    0 else Int
    initIx
          canvasLength = if Bool
    sfBlank then Int
    rheight else Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2
          trimmedY = Int
    canvasLength Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2  -- will be translated down 2 lines
          trimmedAlert = ( Int -> Int -> PointUI
    PointUI Int
    0 Int
    trimmedY
                         , [Char] -> AttrLine
    stringToAL [Char]
    "--a portion of the text trimmed--" )
          page :: Int -> OKX -> m (Bool, Either (K.KM, KeyOrSlot) MenuSlot, Int)
          page Int
    pointer (EnumMap DisplayFont Overlay
    ovsRight0, [KYX]
    kyxsRight) = Bool
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    pointer Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0)
                                                (m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
     -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int))
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a b. (a -> b) -> a -> b
    $ case Int -> [OKX] -> Maybe (OKX, KYX, Int)
    findKYX Int
    pointer [OKX]
    frs of
            Maybe (OKX, KYX, Int)
    Nothing -> [Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int))
    -> [Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "no menu keys" [Char] -> [OKX] -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` [OKX]
    frs
            Just ( (EnumMap DisplayFont Overlay
    ovs0, [KYX]
    kyxs2)
                 , (KeyOrSlot
    ekm, (PointUI Int
    x1 Int
    y, ButtonWidth
    buttonWidth))
                 , Int
    ixOnPage ) -> do
              let ovs1 :: EnumMap DisplayFont Overlay
    ovs1 = (Overlay -> Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
    updateLine Int
    y ((Int -> AttrString -> AttrString) -> Overlay -> Overlay)
    -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
    forall a b. (a -> b) -> a -> b
    $ Int -> ButtonWidth -> Int -> AttrString -> AttrString
    drawHighlight Int
    x1 ButtonWidth
    buttonWidth) EnumMap DisplayFont Overlay
    ovs0
                  ovs2 :: EnumMap DisplayFont Overlay
    ovs2 = if Bool
    highlightBullet
                         then (Overlay -> Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map ([KYX] -> Overlay -> Overlay
    highBullet [KYX]
    kyxs2) EnumMap DisplayFont Overlay
    ovs1
                         else EnumMap DisplayFont Overlay
    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 :: Int
    ymax = EnumMap DisplayFont Overlay -> Int
    maxYofFontOverlayMap EnumMap DisplayFont Overlay
    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 :: Overlay
    spaceRectangle | DisplayFont -> Bool
    isSquareFont DisplayFont
    propFont = []
                                 | Bool
    otherwise =
                                     Int -> Int -> Overlay
    rectangleOfSpaces (Int
    rwidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4)
                                                       (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    canvasLength (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    ymax Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    5)
                  trim :: Overlay -> Overlay
    trim = ((PointUI, AttrLine) -> Bool) -> Overlay -> Overlay
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(PointUI Int
    _ Int
    yRight, AttrLine
    _) -> Int
    yRight Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    trimmedY)
                  -- The alert not clickable, because the player can enter
                  -- the menu entry and scroll through the unabridged blurb.
                  ovsRight1 :: EnumMap DisplayFont Overlay
    ovsRight1 = if Int
    ymax Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    trimmedY
                              then EnumMap DisplayFont Overlay
    ovsRight0
                              else (Overlay -> Overlay -> Overlay)
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    forall a k.
    (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
    EM.unionWith Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    (++)
                                     ((Overlay -> Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map Overlay -> Overlay
    trim EnumMap DisplayFont Overlay
    ovsRight0)
                                     (DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    monoFont [(PointUI, AttrLine)
    trimmedAlert])
                  ovsRight :: EnumMap DisplayFont Overlay
    ovsRight = (Overlay -> Overlay -> Overlay)
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    -> EnumMap DisplayFont Overlay
    forall a k.
    (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
    EM.unionWith Overlay -> Overlay -> Overlay
    forall a. [a] -> [a] -> [a]
    (++)
                               (DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    propFont Overlay
    spaceRectangle)
                               ((Overlay -> Overlay)
    -> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
    forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
    EM.map (Int -> Int -> Overlay -> Overlay
    xytranslateOverlay Int
    2 Int
    2) EnumMap DisplayFont Overlay
    ovsRight1)
                  (EnumMap DisplayFont Overlay
    ovs, [KYX]
    kyxs) =
                    if EnumMap DisplayFont Overlay -> Bool
    forall k a. EnumMap k a -> Bool
    EM.null EnumMap DisplayFont Overlay
    ovsRight0
                    then (EnumMap DisplayFont Overlay
    ovs2, [KYX]
    kyxs2)
                    else Int -> Int -> OKX -> OKX -> OKX
    sideBySideOKX Int
    rwidth Int
    0 (EnumMap DisplayFont Overlay
    ovs2, [KYX]
    kyxs2) (EnumMap DisplayFont Overlay
    ovsRight, [KYX]
    kyxsRight)
                  kmkm :: Either a b -> Either (a, Either a b) b
    kmkm Either a b
    ekm2 = case Either a b
    ekm2 of
                    Left a
    km -> (a, Either a b) -> Either (a, Either a b) b
    forall a b. a -> Either a b
    Left (a
    km, Either a b
    ekm2)
                    Right b
    slot -> b -> Either (a, Either a b) b
    forall a b. b -> Either a b
    Right b
    slot
                  tmpResult :: Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult Int
    pointer1 = case Int -> [OKX] -> Maybe (OKX, KYX, Int)
    findKYX Int
    pointer1 [OKX]
    frs of
                    Maybe (OKX, KYX, Int)
    Nothing -> [Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int))
    -> [Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "no menu keys" [Char] -> [OKX] -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` [OKX]
    frs
                    Just (OKX
    _, (KeyOrSlot
    ekm1, (PointUI, ButtonWidth)
    _), Int
    _) -> (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, KeyOrSlot -> Either (KM, KeyOrSlot) MenuSlot
    forall {a} {b}. Either a b -> Either (a, Either a b) b
    kmkm KeyOrSlot
    ekm1, Int
    pointer1)
                  ignoreKey :: m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    ignoreKey = (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, KeyOrSlot -> Either (KM, KeyOrSlot) MenuSlot
    forall {a} {b}. Either a b -> Either (a, Either a b) b
    kmkm KeyOrSlot
    ekm, Int
    pointer)
                  pageLen :: Int
    pageLen = [KYX] -> Int
    forall a. [a] -> Int
    length [KYX]
    kyxs
                  xix :: KYX -> Bool
                  xix :: KYX -> Bool
    xix (KeyOrSlot
    _, (PointUI Int
    x1' Int
    _, ButtonWidth
    _)) = Int
    x1' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 Bool -> Bool -> Bool
    && Int
    x1' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2
                  firstRowOfNextPage :: Int
    firstRowOfNextPage = Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    pageLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ixOnPage
                  restOKX :: [KYX]
    restOKX = Int -> [KYX] -> [KYX]
    forall a. Int -> [a] -> [a]
    drop Int
    firstRowOfNextPage [KYX]
    allOKX
                  -- This does not take into account the right pane, which is fine.
                  firstItemOfNextPage :: Int
    firstItemOfNextPage = case (KYX -> Bool) -> [KYX] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex (KeyOrSlot -> Bool
    forall a b. Either a b -> Bool
    isRight (KeyOrSlot -> Bool) -> (KYX -> KeyOrSlot) -> KYX -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . KYX -> KeyOrSlot
    forall a b. (a, b) -> a
    fst) [KYX]
    restOKX of
                    Just Int
    p -> Int
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    firstRowOfNextPage
                    Maybe Int
    _ -> Int
    firstRowOfNextPage
                  interpretKey :: K.KM
                               -> m (Bool, Either (K.KM, KeyOrSlot) MenuSlot, Int)
                  interpretKey :: KM -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    interpretKey KM
    ikm =
                    case KM -> Key
    K.key KM
    ikm of
                      Key
    _ | KM
    ikm KM -> KM -> Bool
    forall a. Eq a => a -> a -> Bool
    == KM
    K.controlP -> do
                        -- Silent, because any prompt would be shown too late.
                        m ()
    forall (m :: * -> *). MonadClientUI m => m ()
    printScreen
                        m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    ignoreKey
                      Key
    K.Return -> case KeyOrSlot
    ekm of
                        Left KM
    km ->
                          if KM -> Key
    K.key KM
    km Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    K.Return
                          then (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    km, KeyOrSlot
    ekm), Int
    pointer)
                          else KM -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    interpretKey KM
    km
                        Right MenuSlot
    c -> (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, MenuSlot -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. b -> Either a b
    Right MenuSlot
    c, Int
    pointer)
                      Key
    K.LeftButtonRelease -> do
                        PointUI mx my <- (SessionUI -> PointUI) -> m PointUI
    forall a. (SessionUI -> a) -> m a
    forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
    getsSession SessionUI -> PointUI
    spointer
                        let onChoice (KeyOrSlot
    _, (PointUI Int
    cx Int
    cy, ButtonWidth DisplayFont
    font Int
    clen)) =
                              let blen :: Int
    blen | DisplayFont -> Bool
    isSquareFont DisplayFont
    font = Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    clen
                                       | Bool
    otherwise = Int
    clen
                              in Int
    my Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    cy Bool -> Bool -> Bool
    && Int
    mx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    cx Bool -> Bool -> Bool
    && Int
    mx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    cx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    blen
                        case find onChoice kyxs of
                          Maybe KYX
    Nothing | KM
    ikm KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM]
    keys ->
                            (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    ikm, KeyOrSlot
    ekm), Int
    pointer)
                          Maybe KYX
    Nothing ->
                            if KM
    K.spaceKM KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM]
    keys
                            then (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    K.spaceKM, KeyOrSlot
    ekm), Int
    pointer)
                            else m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    ignoreKey
                          Just (KeyOrSlot
    ckm, (PointUI, ButtonWidth)
    _) -> case KeyOrSlot
    ckm of
                            Left KM
    km ->
                              if KM -> Key
    K.key KM
    km Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    K.Return Bool -> Bool -> Bool
    && KM
    km KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM]
    keys
                              then (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    km, KeyOrSlot
    ekm), Int
    pointer)
                              else KM -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    interpretKey KM
    km
                            Right MenuSlot
    c  -> (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, MenuSlot -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. b -> Either a b
    Right MenuSlot
    c, Int
    pointer)
                      Key
    K.RightButtonRelease ->
                        if KM
    ikm KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM]
    keys
                        then (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    ikm, KeyOrSlot
    ekm), Int
    pointer)
                        else (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    K.escKM, KeyOrSlot
    ekm), Int
    pointer)
                      Key
    K.Space | Int
    firstItemOfNextPage Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maxIx ->
                        Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult Int
    firstItemOfNextPage
                      K.Unknown [Char]
    "SAFE_SPACE" ->
                        if Int
    firstItemOfNextPage Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maxIx
                        then Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult Int
    firstItemOfNextPage
                        else Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult Int
    clearIx
                      Key
    _ | KM
    ikm KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM]
    keys ->
                        (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    ikm, KeyOrSlot
    ekm), Int
    pointer)
                      Key
    _ | KM -> Key
    K.key KM
    ikm Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    K.WheelNorth
                          Bool -> Bool -> Bool
    || KM -> Maybe Vector
    handleDir KM
    ikm Maybe Vector -> Maybe Vector -> Bool
    forall a. Eq a => a -> a -> Bool
    == Vector -> Maybe Vector
    forall a. a -> Maybe a
    Just (Int -> Int -> Vector
    Vector Int
    0 (-Int
    1)) ->
                        case (KYX -> Bool) -> [KYX] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex KYX -> Bool
    xix ([KYX] -> Maybe Int) -> [KYX] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ [KYX] -> [KYX]
    forall a. [a] -> [a]
    reverse ([KYX] -> [KYX]) -> [KYX] -> [KYX]
    forall a b. (a -> b) -> a -> b
    $ Int -> [KYX] -> [KYX]
    forall a. Int -> [a] -> [a]
    take Int
    ixOnPage [KYX]
    kyxs of
                          Maybe Int
    Nothing -> if Int
    pointer Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult Int
    maxIx
                                     else Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                          Just Int
    ix -> Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                      Key
    _ | KM -> Key
    K.key KM
    ikm Key -> Key -> Bool
    forall a. Eq a => a -> a -> Bool
    == Key
    K.WheelSouth
                          Bool -> Bool -> Bool
    || KM -> Maybe Vector
    handleDir KM
    ikm Maybe Vector -> Maybe Vector -> Bool
    forall a. Eq a => a -> a -> Bool
    == Vector -> Maybe Vector
    forall a. a -> Maybe a
    Just (Int -> Int -> Vector
    Vector Int
    0 Int
    1) ->
                        case (KYX -> Bool) -> [KYX] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex KYX -> Bool
    xix ([KYX] -> Maybe Int) -> [KYX] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ Int -> [KYX] -> [KYX]
    forall a. Int -> [a] -> [a]
    drop (Int
    ixOnPage Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) [KYX]
    kyxs of
                          Maybe Int
    Nothing -> if Int
    pointer Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    maxIx then Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult Int
    0
                                     else Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    maxIx (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1))
                          Just Int
    ix -> Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                      Key
    _ | KM -> Maybe Vector
    handleDir KM
    ikm Maybe Vector -> Maybe Vector -> Bool
    forall a. Eq a => a -> a -> Bool
    == Vector -> Maybe Vector
    forall a. a -> Maybe a
    Just (Int -> Int -> Vector
    Vector (-Int
    1) Int
    0) ->
                        case Int -> [OKX] -> Maybe (OKX, KYX, Int)
    findKYX (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)) [OKX]
    frs of
                          Just (OKX
    _, (KeyOrSlot
    _, (PointUI Int
    _ Int
    y2, ButtonWidth
    _)), Int
    _) | Int
    y2 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    y ->
                            Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                          Maybe (OKX, KYX, Int)
    _ -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    ignoreKey
                      Key
    _ | KM -> Maybe Vector
    handleDir KM
    ikm Maybe Vector -> Maybe Vector -> Bool
    forall a. Eq a => a -> a -> Bool
    == Vector -> Maybe Vector
    forall a. a -> Maybe a
    Just (Int -> Int -> Vector
    Vector Int
    1 Int
    0) ->
                        case Int -> [OKX] -> Maybe (OKX, KYX, Int)
    findKYX (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    maxIx (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) [OKX]
    frs of
                          Just (OKX
    _, (KeyOrSlot
    _, (PointUI Int
    _ Int
    y2, ButtonWidth
    _)), Int
    _) | Int
    y2 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    y ->
                            Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    maxIx (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1))
                          Maybe (OKX, KYX, Int)
    _ -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    ignoreKey
                      Key
    K.Home -> Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult Int
    clearIx
                      Key
    K.End -> Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult Int
    maxIx
                      Key
    K.PgUp ->
                        Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ixOnPage Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                      Key
    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.
                        Int -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    tmpResult (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    maxIx Int
    firstItemOfNextPage)
                      Key
    K.Space -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    ignoreKey
                      Key
    _ | KM -> Key
    K.key KM
    ikm Key -> [Key] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char -> Key
    K.Char Char
    '?', Int -> Key
    K.Fun Int
    1] -> do
                        -- Clear macros and invoke the help macro.
                        (SessionUI -> SessionUI) -> m ()
    forall (m :: * -> *).
    MonadClientUI m =>
    (SessionUI -> SessionUI) -> m ()
    modifySession ((SessionUI -> SessionUI) -> m ())
    -> (SessionUI -> SessionUI) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \SessionUI
    sess ->
                          SessionUI
    sess { smacroFrame =
                                   emptyMacroFrame {keyPending =
                                                      KeyMacro [K.mkKM "F1"]}
                               , smacroStack = [] }
                        (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    K.escKM, KeyOrSlot
    ekm), Int
    pointer)
                      Key
    _ -> [Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int))
    -> [Char] -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "unknown key" [Char] -> KM -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` KM
    ikm
              pkm <- ColorMode -> EnumMap DisplayFont Overlay -> Bool -> [KM] -> m KM
    forall (m :: * -> *).
    MonadClientUI m =>
    ColorMode -> EnumMap DisplayFont Overlay -> Bool -> [KM] -> m KM
    promptGetKey ColorMode
    dm EnumMap DisplayFont Overlay
    ovs Bool
    sfBlank [KM]
    legalKeys
              interpretKey pkm
          m Int
    pointer OKX
    okxRight =
            if [OKX] -> Bool
    forall a. [a] -> Bool
    null [OKX]
    frs
            then (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, (KM, KeyOrSlot) -> Either (KM, KeyOrSlot) MenuSlot
    forall a b. a -> Either a b
    Left (KM
    K.escKM, KM -> KeyOrSlot
    forall a b. a -> Either a b
    Left KM
    K.escKM), Int
    pointer)
            else do
              (final, km, pointer1) <- Int -> OKX -> m (Bool, Either (KM, KeyOrSlot) MenuSlot, Int)
    page Int
    pointer OKX
    okxRight
              let !_A1 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (((KM, KeyOrSlot) -> Bool)
    -> (MenuSlot -> Bool) -> Either (KM, KeyOrSlot) MenuSlot -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ((KM -> [KM] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [KM]
    keys) (KM -> Bool) -> ((KM, KeyOrSlot) -> KM) -> (KM, KeyOrSlot) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (KM, KeyOrSlot) -> KM
    forall a b. (a, b) -> a
    fst) (Bool -> MenuSlot -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Either (KM, KeyOrSlot) MenuSlot
    km) ()
              -- Pointer at a button included, hence greater than 0, not @clearIx@.
              let !_A2 = Bool -> () -> ()
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    0 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    pointer1 Bool -> Bool -> Bool
    && Int
    pointer1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maxIx
                                 Bool -> (Int, Int) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame`  (Int
    pointer1, Int
    maxIx)) ()
              return (final, km, pointer1)
      return (maxIx, initIx, clearIx, m)

    navigationKeys :: [K.KM]
    navigationKeys :: [KM]
    navigationKeys = [ KM
    K.leftButtonReleaseKM, KM
    K.rightButtonReleaseKM
                     , KM
    K.returnKM, KM
    K.spaceKM, KM
    K.wheelNorthKM, KM
    K.wheelSouthKM
                     , KM
    K.pgupKM, KM
    K.pgdnKM, KM
    K.homeKM, KM
    K.endKM, KM
    K.controlP
                     , Char -> KM
    K.mkChar Char
    '?', [Char] -> KM
    K.mkKM [Char]
    "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 :: Int -> [OKX] -> Maybe (OKX, KYX, Int)
    findKYX Int
    _ [] = Maybe (OKX, KYX, Int)
    forall a. Maybe a
    Nothing
    findKYX Int
    pointer (okx :: OKX
    okx@(EnumMap DisplayFont Overlay
    _, [KYX]
    kyxs) : [OKX]
    frs2) =
      case Int -> [KYX] -> [KYX]
    forall a. Int -> [a] -> [a]
    drop Int
    pointer [KYX]
    kyxs of
        [] ->  -- not enough menu items on this page
          case Int -> [OKX] -> Maybe (OKX, KYX, Int)
    findKYX (Int
    pointer Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [KYX] -> Int
    forall a. [a] -> Int
    length [KYX]
    kyxs) [OKX]
    frs2 of
            Maybe (OKX, KYX, Int)
    Nothing ->  -- no more menu items in later pages
              case [KYX] -> [KYX]
    forall a. [a] -> [a]
    reverse [KYX]
    kyxs of
                [] -> Maybe (OKX, KYX, Int)
    forall a. Maybe a
    Nothing
                KYX
    kyx : [KYX]
    _ -> (OKX, KYX, Int) -> Maybe (OKX, KYX, Int)
    forall a. a -> Maybe a
    Just (OKX
    okx, KYX
    kyx, [KYX] -> Int
    forall a. [a] -> Int
    length [KYX]
    kyxs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
            Maybe (OKX, KYX, Int)
    res -> Maybe (OKX, KYX, Int)
    res
        KYX
    kyx : [KYX]
    _ -> (OKX, KYX, Int) -> Maybe (OKX, KYX, Int)
    forall a. a -> Maybe a
    Just (OKX
    okx, KYX
    kyx, Int
    pointer)

    drawHighlight :: Int -> ButtonWidth -> Int -> AttrString -> AttrString
    drawHighlight :: Int -> ButtonWidth -> Int -> AttrString -> AttrString
    drawHighlight Int
    x1 (ButtonWidth DisplayFont
    font Int
    len) Int
    xstart AttrString
    as =
      let highableAttrs :: [Attr]
    highableAttrs = [Attr
    Color.defAttr, Attr
    Color.defAttr {Color.fg = Color.BrBlack}]
          highAttr :: AttrChar -> AttrChar
    highAttr AttrChar
    c | AttrChar -> Attr
    Color.acAttr AttrChar
    c Attr -> [Attr] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Attr]
    highableAttrs
                       Bool -> Bool -> Bool
    || AttrChar -> Char
    Color.acChar AttrChar
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' = AttrChar
    c
          highAttr AttrChar
    c = AttrChar
    c {Color.acAttr =
                            (Color.acAttr c) {Color.fg = Color.BrWhite}}
          cursorAttr :: AttrChar -> AttrChar
    cursorAttr AttrChar
    c = AttrChar
    c {Color.acAttr =
                              (Color.acAttr c)
                                 {Color.bg = Color.HighlightNoneCursor}}
          noCursorAttr :: AttrChar -> AttrChar
    noCursorAttr AttrChar
    c = AttrChar
    c {Color.acAttr =
                                (Color.acAttr c)
                                   {Color.bg = Color.HighlightNone}}
          -- This also highlights dull white item symbols, but who cares.
          lenUI :: Int
    lenUI = if DisplayFont -> Bool
    isSquareFont DisplayFont
    font then Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2 else Int
    len
          x1MinusXStartChars :: Int
    x1MinusXStartChars = if DisplayFont -> Bool
    isSquareFont DisplayFont
    font
                               then (Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xstart) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                               else Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xstart
          (AttrString
    as1, AttrString
    asRest) = Int -> AttrString -> (AttrString, AttrString)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    x1MinusXStartChars AttrString
    as
          (AttrString
    as2, AttrString
    as3) = Int -> AttrString -> (AttrString, AttrString)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    len AttrString
    asRest
          highW32 :: AttrCharW32 -> AttrCharW32
    highW32 = AttrChar -> AttrCharW32
    Color.attrCharToW32 (AttrChar -> AttrCharW32)
    -> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrCharW32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrChar -> AttrChar
    highAttr (AttrChar -> AttrChar)
    -> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrChar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrCharW32 -> AttrChar
    Color.attrCharFromW32
          as2High :: AttrString
    as2High = (AttrCharW32 -> AttrCharW32) -> AttrString -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map AttrCharW32 -> AttrCharW32
    highW32 AttrString
    as2
          cursorW32 :: AttrCharW32 -> AttrCharW32
    cursorW32 = AttrChar -> AttrCharW32
    Color.attrCharToW32 (AttrChar -> AttrCharW32)
    -> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrCharW32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrChar -> AttrChar
    cursorAttr (AttrChar -> AttrChar)
    -> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrChar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrCharW32 -> AttrChar
    Color.attrCharFromW32
          (AttrString
    nonAlpha, AttrString
    alpha) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Bool
    Char.isAlphaNum (Char -> Bool) -> (AttrCharW32 -> Char) -> AttrCharW32 -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrCharW32 -> Char
    Color.charFromW32) AttrString
    as2High
          as2Cursor :: AttrString
    as2Cursor = case AttrString
    alpha of
            [] -> []
            AttrCharW32
    ch : AttrString
    chrest -> AttrCharW32 -> AttrCharW32
    cursorW32 AttrCharW32
    ch AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    chrest
          noCursorW32 :: AttrCharW32 -> AttrCharW32
    noCursorW32 = AttrChar -> AttrCharW32
    Color.attrCharToW32 (AttrChar -> AttrCharW32)
    -> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrCharW32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrChar -> AttrChar
    noCursorAttr (AttrChar -> AttrChar)
    -> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrChar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrCharW32 -> AttrChar
    Color.attrCharFromW32
      in if Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    lenUI Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    xstart
         then AttrString
    as
         else AttrString
    as1 AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ (AttrCharW32 -> AttrCharW32) -> AttrString -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map AttrCharW32 -> AttrCharW32
    noCursorW32 AttrString
    nonAlpha AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    as2Cursor AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    as3

    drawBullet :: Int -> ButtonWidth -> Int -> AttrString -> AttrString
    drawBullet :: Int -> ButtonWidth -> Int -> AttrString -> AttrString
    drawBullet Int
    x1 (ButtonWidth DisplayFont
    font Int
    len) Int
    xstart AttrString
    as0 =
      let diminishChar :: Char -> Char
    diminishChar Char
    '-' = Char
    ' '
          diminishChar Char
    '^' = Char
    '^'
          diminishChar Char
    '"' = Char
    '"'
          diminishChar Char
    _ = Char
    '·'
          highableAttr :: Attr
    highableAttr = Attr
    Color.defAttr {Color.bg = Color.HighlightNoneCursor}
          highW32 :: AttrCharW32 -> AttrCharW32
    highW32 AttrCharW32
    ac32 =
            let ac :: AttrChar
    ac = AttrCharW32 -> AttrChar
    Color.attrCharFromW32 AttrCharW32
    ac32
                ch :: Char
    ch = Char -> Char
    diminishChar (Char -> Char) -> Char -> Char
    forall a b. (a -> b) -> a -> b
    $ AttrChar -> Char
    Color.acChar AttrChar
    ac
            in if | AttrChar -> Attr
    Color.acAttr AttrChar
    ac Attr -> Attr -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Attr
    highableAttr -> AttrCharW32
    ac32
                  | AttrChar -> Char
    Color.acChar AttrChar
    ac Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' ->
                      [Char] -> AttrCharW32
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> AttrCharW32) -> [Char] -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "drawBullet: HighlightNoneCursor space forbidden"
                              [Char] -> (AttrChar, [Char]) -> [Char]
    forall v. Show v => [Char] -> v -> [Char]
    `showFailure` (AttrChar
    ac, (AttrCharW32 -> Char) -> AttrString -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map AttrCharW32 -> Char
    Color.charFromW32 AttrString
    as0)
                  | Char
    ch Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' -> AttrCharW32
    Color.spaceAttrW32
                  | Bool
    otherwise ->
                      AttrChar -> AttrCharW32
    Color.attrCharToW32
                      (AttrChar -> AttrCharW32) -> AttrChar -> AttrCharW32
    forall a b. (a -> b) -> a -> b
    $ AttrChar
    ac { Color.acAttr = Color.defAttr {Color.fg = Color.BrBlack}
                           , Color.acChar = ch }
          lenUI :: Int
    lenUI = if DisplayFont -> Bool
    isSquareFont DisplayFont
    font then Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2 else Int
    len
          x1MinusXStartChars :: Int
    x1MinusXStartChars = if DisplayFont -> Bool
    isSquareFont DisplayFont
    font
                               then (Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xstart) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
                               else Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xstart
          (AttrString
    as1, AttrString
    asRest) = Int -> AttrString -> (AttrString, AttrString)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    x1MinusXStartChars AttrString
    as0
          (AttrString
    as2, AttrString
    as3) = Int -> AttrString -> (AttrString, AttrString)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    len AttrString
    asRest
          highAs :: AttrString -> AttrString
    highAs = \case
            AttrCharW32
    toHighlight : AttrString
    rest -> AttrCharW32 -> AttrCharW32
    highW32 AttrCharW32
    toHighlight AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    rest
            [] -> []
      in if Int
    x1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    lenUI Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    xstart
         then AttrString
    as0
         else AttrString
    as1 AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString -> AttrString
    highAs AttrString
    as2 AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    as3

    highBullet :: [KYX] -> Overlay -> Overlay
    highBullet :: [KYX] -> Overlay -> Overlay
    highBullet [KYX]
    kyxs Overlay
    ov0 =
      let f :: (a, (PointUI, ButtonWidth)) -> Overlay -> Overlay
    f (a
    _, (PointUI Int
    x1 Int
    y, ButtonWidth
    buttonWidth)) =
            Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
    updateLine Int
    y ((Int -> AttrString -> AttrString) -> Overlay -> Overlay)
    -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
    forall a b. (a -> b) -> a -> b
    $ Int -> ButtonWidth -> Int -> AttrString -> AttrString
    drawBullet Int
    x1 ButtonWidth
    buttonWidth
      in (KYX -> Overlay -> Overlay) -> Overlay -> [KYX] -> Overlay
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr KYX -> Overlay -> Overlay
    forall {a}. (a, (PointUI, ButtonWidth)) -> Overlay -> Overlay
    f Overlay
    ov0 [KYX]
    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 :: forall (m :: * -> *).
    MonadClientUI m =>
    LevelId -> Maybe Bool -> m PreFrame3
    basicFrameWithoutReport LevelId
    arena Maybe Bool
    forceReport = do
      FontSetup{propFont} <- m FontSetup
    forall (m :: * -> *). MonadClientUI m => m FontSetup
    getFontSetup
      sbenchMessages <- getsClient $ sbenchMessages . soptions
      side <- getsClient sside
      fact <- getsState $ (EM.! side) . sfactionD
      truncRep <-
        if | sbenchMessages -> do
             slides <- reportToSlideshowKeepHalt False []
             case slideshow slides of
               [] -> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EnumMap DisplayFont Overlay
    forall k a. EnumMap k a
    EM.empty
               (EnumMap DisplayFont Overlay
    ov, [KYX]
    _) : [OKX]
    _ -> do
                 -- See @stepQueryUI@. This strips either "--end-" or "--more-".
                 let ovProp :: Overlay
    ovProp = EnumMap DisplayFont Overlay
    ov EnumMap DisplayFont Overlay -> DisplayFont -> Overlay
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! DisplayFont
    propFont
                 EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay))
    -> EnumMap DisplayFont Overlay -> m (EnumMap DisplayFont Overlay)
    forall a b. (a -> b) -> a -> b
    $!
                   DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
    forall k a. Enum k => k -> a -> EnumMap k a
    EM.singleton DisplayFont
    propFont
                   (Overlay -> EnumMap DisplayFont Overlay)
    -> Overlay -> EnumMap DisplayFont Overlay
    forall a b. (a -> b) -> a -> b
    $ if EnumMap DisplayFont Overlay -> Int
    forall k a. EnumMap k a -> Int
    EM.size EnumMap DisplayFont Overlay
    ov Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1 then Overlay
    ovProp else Overlay -> Overlay
    forall a. HasCallStack => [a] -> [a]
    init Overlay
    ovProp
           | fromMaybe (gunderAI fact) forceReport -> do
             report <- getReportUI False
             let par1 = AttrString -> AttrLine
    firstParagraph (AttrString -> AttrLine) -> AttrString -> AttrLine
    forall a b. (a -> b) -> a -> b
    $ (AttrString -> AttrString -> AttrString)
    -> AttrString -> [AttrString] -> AttrString
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr AttrString -> AttrString -> AttrString
    (<+:>) [] ([AttrString] -> AttrString) -> [AttrString] -> AttrString
    forall a b. (a -> b) -> a -> b
    $ Bool -> Report -> [AttrString]
    renderReport Bool
    True Report
    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 :: forall (m :: * -> *). MonadClientUI m => Bool -> m ()
    pushFrame Bool
    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 <- m Bool
    forall (m :: * -> *). MonadClientUI m => m Bool
    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 :: forall (m :: * -> *). MonadClientUI m => m ()
    pushReportFrame = do
      lidV <- m LevelId
    forall (m :: * -> *). MonadClientUI m => m LevelId
    viewedLevelUI
      frame <- basicFrameWithoutReport lidV (Just True)
      displayFrames lidV [Just frame]