content: -- | 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]
  