    {-# LANGUAGE RankNTypes, TupleSections #-}
    -- | Screen overlays.
    module Game.LambdaHack.Client.UI.Overlay
      ( -- * DisplayFont
        DisplayFont, isPropFont, isSquareFont, isMonoFont, textSize
      , -- * FontSetup
        FontSetup(..), multiFontSetup, singleFontSetup
      , -- * AttrString
        AttrString, blankAttrString, textToAS, textFgToAS, stringToAS
      , attrStringToString
      , (<+:>), (<\:>)
        -- * AttrLine
      , AttrLine, attrLine, emptyAttrLine, attrStringToAL, firstParagraph
      , textToAL, textFgToAL, stringToAL, linesAttr
      , splitAttrString, indentSplitAttrString
        -- * Overlay
      , Overlay, xytranslateOverlay, xtranslateOverlay, ytranslateOverlay
      , offsetOverlay, offsetOverlayX, typesetXY
      , updateLine, rectangleOfSpaces, maxYofOverlay, labDescOverlay
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , nonbreakableRev, isPrefixOfNonbreakable, breakAtSpace, splitAttrPhrase
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Data.Char (isSpace)
    import qualified Data.Text as T

    import           Game.LambdaHack.Client.UI.PointUI
    import qualified Game.LambdaHack.Definition.Color as Color

    -- * DisplayFont

    -- | Three types of fonts used in the UI. Overlays (layers, more or less)
    -- in proportional font are overwritten by layers in square font,
    -- which are overwritten by layers in mono font.
    -- All overlays overwrite the rendering of the game map, which is
    -- the underlying basic UI frame, comprised of square font glyps.
    --
    -- This type needs to be kept abstract to ensure that frontend-enforced
    -- or user config-enforced font assignments in 'FontSetup'
    -- (e.g., stating that the supposedly proportional font is overriden
    -- to be the square font) can't be ignored. Otherwise a programmer
    -- could use arbirary @DisplayFont@, instead of the one taken from 'FontSetup',
    -- and so, e.g., calculating the width of an overlay so constructed
    -- in order to decide where another overlay can start would be inconsistent
    -- what what font is really eventually used when rendering.
    --
    -- Note that the order of constructors has limited effect,
    -- but it illustrates how overwriting is explicitly implemented
    -- in frontends that support all fonts.
    data DisplayFont = PropFont | SquareFont | MonoFont
      deriving (Int -> DisplayFont -> ShowS
    [DisplayFont] -> ShowS
    DisplayFont -> [Char]
    (Int -> DisplayFont -> ShowS)
    -> (DisplayFont -> [Char])
    -> ([DisplayFont] -> ShowS)
    -> Show DisplayFont
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DisplayFont -> ShowS
    showsPrec :: Int -> DisplayFont -> ShowS
    $cshow :: DisplayFont -> [Char]
    show :: DisplayFont -> [Char]
    $cshowList :: [DisplayFont] -> ShowS
    showList :: [DisplayFont] -> ShowS
    Show, DisplayFont -> DisplayFont -> Bool
    (DisplayFont -> DisplayFont -> Bool)
    -> (DisplayFont -> DisplayFont -> Bool) -> Eq DisplayFont
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DisplayFont -> DisplayFont -> Bool
    == :: DisplayFont -> DisplayFont -> Bool
    $c/= :: DisplayFont -> DisplayFont -> Bool
    /= :: DisplayFont -> DisplayFont -> Bool
    Eq, Int -> DisplayFont
    DisplayFont -> Int
    DisplayFont -> [DisplayFont]
    DisplayFont -> DisplayFont
    DisplayFont -> DisplayFont -> [DisplayFont]
    DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
    (DisplayFont -> DisplayFont)
    -> (DisplayFont -> DisplayFont)
    -> (Int -> DisplayFont)
    -> (DisplayFont -> Int)
    -> (DisplayFont -> [DisplayFont])
    -> (DisplayFont -> DisplayFont -> [DisplayFont])
    -> (DisplayFont -> DisplayFont -> [DisplayFont])
    -> (DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont])
    -> Enum DisplayFont
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: DisplayFont -> DisplayFont
    succ :: DisplayFont -> DisplayFont
    $cpred :: DisplayFont -> DisplayFont
    pred :: DisplayFont -> DisplayFont
    $ctoEnum :: Int -> DisplayFont
    toEnum :: Int -> DisplayFont
    $cfromEnum :: DisplayFont -> Int
    fromEnum :: DisplayFont -> Int
    $cenumFrom :: DisplayFont -> [DisplayFont]
    enumFrom :: DisplayFont -> [DisplayFont]
    $cenumFromThen :: DisplayFont -> DisplayFont -> [DisplayFont]
    enumFromThen :: DisplayFont -> DisplayFont -> [DisplayFont]
    $cenumFromTo :: DisplayFont -> DisplayFont -> [DisplayFont]
    enumFromTo :: DisplayFont -> DisplayFont -> [DisplayFont]
    $cenumFromThenTo :: DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
    enumFromThenTo :: DisplayFont -> DisplayFont -> DisplayFont -> [DisplayFont]
    Enum)

    isPropFont, isSquareFont, isMonoFont :: DisplayFont -> Bool
    isPropFont :: DisplayFont -> Bool
    isPropFont = (DisplayFont -> DisplayFont -> Bool
    forall a. Eq a => a -> a -> Bool
    == DisplayFont
    PropFont)
    isSquareFont :: DisplayFont -> Bool
    isSquareFont = (DisplayFont -> DisplayFont -> Bool
    forall a. Eq a => a -> a -> Bool
    == DisplayFont
    SquareFont)
    isMonoFont :: DisplayFont -> Bool
    isMonoFont = (DisplayFont -> DisplayFont -> Bool
    forall a. Eq a => a -> a -> Bool
    == DisplayFont
    MonoFont)

    textSize :: DisplayFont -> [a] -> Int
    textSize :: forall a. DisplayFont -> [a] -> Int
    textSize DisplayFont
    SquareFont [a]
    l = Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [a] -> Int
    forall a. [a] -> Int
    length [a]
    l
    textSize DisplayFont
    MonoFont [a]
    l = [a] -> Int
    forall a. [a] -> Int
    length [a]
    l
    textSize DisplayFont
    PropFont [a]
    _ = [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "size of proportional font texts is not defined"

    -- * FontSetup

    data FontSetup = FontSetup
      { FontSetup -> DisplayFont
    squareFont :: DisplayFont
      , FontSetup -> DisplayFont
    monoFont   :: DisplayFont
      , FontSetup -> DisplayFont
    propFont   :: DisplayFont
      }
      deriving (FontSetup -> FontSetup -> Bool
    (FontSetup -> FontSetup -> Bool)
    -> (FontSetup -> FontSetup -> Bool) -> Eq FontSetup
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FontSetup -> FontSetup -> Bool
    == :: FontSetup -> FontSetup -> Bool
    $c/= :: FontSetup -> FontSetup -> Bool
    /= :: FontSetup -> FontSetup -> Bool
    Eq, Int -> FontSetup -> ShowS
    [FontSetup] -> ShowS
    FontSetup -> [Char]
    (Int -> FontSetup -> ShowS)
    -> (FontSetup -> [Char])
    -> ([FontSetup] -> ShowS)
    -> Show FontSetup
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FontSetup -> ShowS
    showsPrec :: Int -> FontSetup -> ShowS
    $cshow :: FontSetup -> [Char]
    show :: FontSetup -> [Char]
    $cshowList :: [FontSetup] -> ShowS
    showList :: [FontSetup] -> ShowS
    Show)  -- for unit tests

    multiFontSetup :: FontSetup
    multiFontSetup :: FontSetup
    multiFontSetup = DisplayFont -> DisplayFont -> DisplayFont -> FontSetup
    FontSetup DisplayFont
    SquareFont DisplayFont
    MonoFont DisplayFont
    PropFont

    singleFontSetup :: FontSetup
    singleFontSetup :: FontSetup
    singleFontSetup = DisplayFont -> DisplayFont -> DisplayFont -> FontSetup
    FontSetup DisplayFont
    SquareFont DisplayFont
    SquareFont DisplayFont
    SquareFont

    -- * AttrString

    -- | String of colourful text. End of line characters permitted.
    type AttrString = [Color.AttrCharW32]

    blankAttrString :: Int -> AttrString
    blankAttrString :: Int -> AttrString
    blankAttrString Int
    w = Int -> AttrCharW32 -> AttrString
    forall a. Int -> a -> [a]
    replicate Int
    w AttrCharW32
    Color.spaceAttrW32

    textToAS :: Text -> AttrString
    textToAS :: Text -> AttrString
    textToAS !Text
    t =
      let f :: Char -> AttrString -> AttrString
    f Char
    c AttrString
    l = let !ac :: AttrCharW32
    ac = Char -> AttrCharW32
    Color.attrChar1ToW32 Char
    c
                  in AttrCharW32
    ac AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    l
      in (Char -> AttrString -> AttrString)
    -> AttrString -> Text -> AttrString
    forall a. (Char -> a -> a) -> a -> Text -> a
    T.foldr Char -> AttrString -> AttrString
    f [] Text
    t

    textFgToAS :: Color.Color -> Text -> AttrString
    textFgToAS :: Color -> Text -> AttrString
    textFgToAS !Color
    fg !Text
    t =
      let f :: Char -> AttrString -> AttrString
    f Char
    ' ' AttrString
    l = AttrCharW32
    Color.spaceAttrW32 AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    l
                      -- for speed and simplicity (testing if char is a space)
                      -- we always keep the space @White@
          f Char
    c AttrString
    l = let !ac :: AttrCharW32
    ac = Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    fg Char
    c
                  in AttrCharW32
    ac AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    l
      in (Char -> AttrString -> AttrString)
    -> AttrString -> Text -> AttrString
    forall a. (Char -> a -> a) -> a -> Text -> a
    T.foldr Char -> AttrString -> AttrString
    f [] Text
    t

    stringToAS :: String -> AttrString
    stringToAS :: [Char] -> AttrString
    stringToAS = (Char -> AttrCharW32) -> [Char] -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> AttrCharW32
    Color.attrChar1ToW32

    -- | Transform 'AttrString' type to 'String'.
    attrStringToString :: AttrString -> String
    attrStringToString :: AttrString -> [Char]
    attrStringToString = (AttrCharW32 -> Char) -> AttrString -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map AttrCharW32 -> Char
    Color.charFromW32

    -- Follows minimorph.<+>.
    infixr 6 <+:>  -- matches Monoid.<>
    (<+:>) :: AttrString -> AttrString -> AttrString
    <+:> :: AttrString -> AttrString -> AttrString
    (<+:>) [] AttrString
    l2 = AttrString
    l2
    (<+:>) AttrString
    l1 [] = AttrString
    l1
    (<+:>) AttrString
    l1 l2 :: AttrString
    l2@(AttrCharW32
    c2 : AttrString
    _) =
      if Char -> Bool
    isSpace (AttrCharW32 -> Char
    Color.charFromW32 AttrCharW32
    c2) Bool -> Bool -> Bool
    || Char -> Bool
    isSpace (AttrCharW32 -> Char
    Color.charFromW32 (AttrString -> AttrCharW32
    forall a. HasCallStack => [a] -> a
    last AttrString
    l1))
      then AttrString
    l1 AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    l2
      else AttrString
    l1 AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ [AttrCharW32
    Color.spaceAttrW32] AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    l2

    infixr 6 <\:>  -- matches Monoid.<>
    (<\:>) :: AttrString -> AttrString -> AttrString
    <\:> :: AttrString -> AttrString -> AttrString
    (<\:>) [] AttrString
    l2 = AttrString
    l2
    (<\:>) AttrString
    l1 [] = AttrString
    l1
    (<\:>) AttrString
    l1 l2 :: AttrString
    l2@(AttrCharW32
    c2 : AttrString
    _) =
      if AttrCharW32 -> Char
    Color.charFromW32 AttrCharW32
    c2 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n' Bool -> Bool -> Bool
    || AttrCharW32 -> Char
    Color.charFromW32 (AttrString -> AttrCharW32
    forall a. HasCallStack => [a] -> a
    last AttrString
    l1) Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n'
      then AttrString
    l1 AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    l2
      else AttrString
    l1 AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> AttrString
    stringToAS [Char]
    "\n" AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    l2

    -- We consider only these, because they are short and form a closed category.
    nonbreakableRev :: [String]
    nonbreakableRev :: [[Char]]
    nonbreakableRev = [[Char]
    "eht", [Char]
    "a", [Char]
    "na", [Char]
    "ehT", [Char]
    "A", [Char]
    "nA", [Char]
    "I"]

    isPrefixOfNonbreakable :: AttrString -> Bool
    isPrefixOfNonbreakable :: AttrString -> Bool
    isPrefixOfNonbreakable AttrString
    s =
      let isPrefixOfNb :: [Char] -> [Char] -> Bool
    isPrefixOfNb [Char]
    sRev [Char]
    nbRev = case [Char] -> [Char] -> Maybe [Char]
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix [Char]
    nbRev [Char]
    sRev of
            Maybe [Char]
    Nothing -> Bool
    False
            Just [] -> Bool
    True
            Just (Char
    c : [Char]
    _) -> Char -> Bool
    isSpace Char
    c
      in ([Char] -> Bool) -> [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([Char] -> [Char] -> Bool
    isPrefixOfNb ([Char] -> [Char] -> Bool) -> [Char] -> [Char] -> Bool
    forall a b. (a -> b) -> a -> b
    $ AttrString -> [Char]
    attrStringToString AttrString
    s) [[Char]]
    nonbreakableRev

    breakAtSpace :: AttrString -> (AttrString, AttrString)
    breakAtSpace :: AttrString -> (AttrString, AttrString)
    breakAtSpace AttrString
    lRev =
      let (AttrString
    pre, AttrString
    post) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (AttrCharW32 -> AttrCharW32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == AttrCharW32
    Color.spaceAttrW32) AttrString
    lRev
      in case AttrString
    post of
        AttrCharW32
    c : AttrString
    rest | AttrCharW32
    c AttrCharW32 -> AttrCharW32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == AttrCharW32
    Color.spaceAttrW32 ->
          if AttrString -> Bool
    isPrefixOfNonbreakable AttrString
    rest
          then let (AttrString
    pre2, AttrString
    post2) = AttrString -> (AttrString, AttrString)
    breakAtSpace AttrString
    rest
               in (AttrString
    pre AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrCharW32
    c AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    pre2, AttrString
    post2)
          else (AttrString
    pre, AttrString
    post)
        AttrString
    _ -> (AttrString
    pre, AttrString
    post)  -- no space found, give up

    -- * AttrLine

    -- | Line of colourful text. End of line characters forbidden. Trailing
    -- @White@ space forbidden.
    newtype AttrLine = AttrLine {AttrLine -> AttrString
    attrLine :: AttrString}
      deriving (Int -> AttrLine -> ShowS
    [AttrLine] -> ShowS
    AttrLine -> [Char]
    (Int -> AttrLine -> ShowS)
    -> (AttrLine -> [Char]) -> ([AttrLine] -> ShowS) -> Show AttrLine
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AttrLine -> ShowS
    showsPrec :: Int -> AttrLine -> ShowS
    $cshow :: AttrLine -> [Char]
    show :: AttrLine -> [Char]
    $cshowList :: [AttrLine] -> ShowS
    showList :: [AttrLine] -> ShowS
    Show, AttrLine -> AttrLine -> Bool
    (AttrLine -> AttrLine -> Bool)
    -> (AttrLine -> AttrLine -> Bool) -> Eq AttrLine
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AttrLine -> AttrLine -> Bool
    == :: AttrLine -> AttrLine -> Bool
    $c/= :: AttrLine -> AttrLine -> Bool
    /= :: AttrLine -> AttrLine -> Bool
    Eq)

    emptyAttrLine :: AttrLine
    emptyAttrLine :: AttrLine
    emptyAttrLine = AttrString -> AttrLine
    AttrLine []

    attrStringToAL :: AttrString -> AttrLine
    attrStringToAL :: AttrString -> AttrLine
    attrStringToAL AttrString
    s =
    #ifdef WITH_EXPENSIVE_ASSERTIONS
      assert (allB (\ac -> Color.charFromW32 ac /= '\n') s) $  -- expensive in menus
      assert (null s || last s /= Color.spaceAttrW32
              `blame` attrStringToString s) $
        -- only expensive for menus, but often violated by code changes, so disabled
        -- outside test runs
    #endif
        AttrString -> AttrLine
    AttrLine AttrString
    s

    firstParagraph :: AttrString -> AttrLine
    firstParagraph :: AttrString -> AttrLine
    firstParagraph AttrString
    s = case AttrString -> [AttrLine]
    linesAttr AttrString
    s of
      [] -> AttrLine
    emptyAttrLine
      AttrLine
    l : [AttrLine]
    _ -> AttrLine
    l

    textToAL :: Text -> AttrLine
    textToAL :: Text -> AttrLine
    textToAL !Text
    t =
      let f :: Char -> AttrString -> AttrString
    f Char
    '\n' AttrString
    _ = [Char] -> AttrString
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> AttrString) -> [Char] -> AttrString
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "illegal end of line in: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    T.unpack Text
    t
          f Char
    c AttrString
    l = let !ac :: AttrCharW32
    ac = Char -> AttrCharW32
    Color.attrChar1ToW32 Char
    c
                  in AttrCharW32
    ac AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    l
          s :: AttrString
    s = (Char -> AttrString -> AttrString)
    -> AttrString -> Text -> AttrString
    forall a. (Char -> a -> a) -> a -> Text -> a
    T.foldr Char -> AttrString -> AttrString
    f [] Text
    t
      in AttrString -> AttrLine
    AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
    forall a b. (a -> b) -> a -> b
    $
    #ifdef WITH_EXPENSIVE_ASSERTIONS
      assert (null s || last s /= Color.spaceAttrW32 `blame` t)
    #endif
        AttrString
    s

    textFgToAL :: Color.Color -> Text -> AttrLine
    textFgToAL :: Color -> Text -> AttrLine
    textFgToAL !Color
    fg !Text
    t =
      let f :: Char -> AttrString -> AttrString
    f Char
    '\n' AttrString
    _ = [Char] -> AttrString
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> AttrString) -> [Char] -> AttrString
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "illegal end of line in: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    T.unpack Text
    t
          f Char
    ' ' AttrString
    l = AttrCharW32
    Color.spaceAttrW32 AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    l
                      -- for speed and simplicity (testing if char is a space)
                      -- we always keep the space @White@
          f Char
    c AttrString
    l = let !ac :: AttrCharW32
    ac = Color -> Char -> AttrCharW32
    Color.attrChar2ToW32 Color
    fg Char
    c
                  in AttrCharW32
    ac AttrCharW32 -> AttrString -> AttrString
    forall a. a -> [a] -> [a]
    : AttrString
    l
          s :: AttrString
    s = (Char -> AttrString -> AttrString)
    -> AttrString -> Text -> AttrString
    forall a. (Char -> a -> a) -> a -> Text -> a
    T.foldr Char -> AttrString -> AttrString
    f [] Text
    t
      in AttrString -> AttrLine
    AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
    forall a b. (a -> b) -> a -> b
    $
    #ifdef WITH_EXPENSIVE_ASSERTIONS
      assert (null s || last s /= Color.spaceAttrW32 `blame` t)
    #endif
        AttrString
    s

    stringToAL :: String -> AttrLine
    stringToAL :: [Char] -> AttrLine
    stringToAL [Char]
    s = AttrString -> AttrLine
    attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
    forall a b. (a -> b) -> a -> b
    $ (Char -> AttrCharW32) -> [Char] -> AttrString
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> AttrCharW32
    Color.attrChar1ToW32 [Char]
    s

    -- Mimics @lines@.
    linesAttr :: AttrString -> [AttrLine]
    linesAttr :: AttrString -> [AttrLine]
    linesAttr [] = []
    linesAttr AttrString
    l = (AttrLine, [AttrLine]) -> [AttrLine]
    forall {a}. (a, [a]) -> [a]
    cons (case (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (\AttrCharW32
    ac -> AttrCharW32 -> Char
    Color.charFromW32 AttrCharW32
    ac Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n') AttrString
    l of
      (AttrString
    h, AttrString
    t) -> (AttrString -> AttrLine
    attrStringToAL AttrString
    h, case AttrString
    t of
                                     [] -> []
                                     AttrCharW32
    _ : AttrString
    tt -> AttrString -> [AttrLine]
    linesAttr AttrString
    tt))
     where
      cons :: (a, [a]) -> [a]
    cons ~(a
    h, [a]
    t) = a
    h a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    t

    -- | Split a string into lines. Avoid breaking the line at a character
    -- other than space. Remove the spaces on which lines are broken,
    -- keep other spaces. In expensive assertions mode (dev debug mode)
    -- fail at trailing spaces, but keep leading spaces, e.g., to make
    -- distance from a text in another font. Newlines are respected.
    --
    -- Note that we only split wrt @White@ space, nothing else,
    -- and the width, in the first argument, is calculated in characters,
    -- not in UI (mono font) coordinates, so that taking and dropping characters
    -- is performed correctly.
    splitAttrString :: Int -> Int -> AttrString -> [AttrLine]
    splitAttrString :: Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    w0 Int
    w1 AttrString
    l = case AttrString -> [AttrLine]
    linesAttr AttrString
    l of
      [] -> []
      AttrLine
    x : [AttrLine]
    xs -> Int -> Int -> AttrLine -> [AttrLine]
    splitAttrPhrase Int
    w0 Int
    w1 AttrLine
    x [AttrLine] -> [AttrLine] -> [AttrLine]
    forall a. [a] -> [a] -> [a]
    ++ (AttrLine -> [AttrLine]) -> [AttrLine] -> [AttrLine]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Int -> Int -> AttrLine -> [AttrLine]
    splitAttrPhrase Int
    w1 Int
    w1) [AttrLine]
    xs

    indentSplitAttrString :: DisplayFont -> Int -> AttrString -> [AttrLine]
    indentSplitAttrString :: DisplayFont -> Int -> AttrString -> [AttrLine]
    indentSplitAttrString DisplayFont
    font Int
    w AttrString
    l = Bool -> [AttrLine] -> [AttrLine]
    forall a. HasCallStack => Bool -> a -> a
    assert (Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    4) ([AttrLine] -> [AttrLine]) -> [AttrLine] -> [AttrLine]
    forall a b. (a -> b) -> a -> b
    $
      -- Sadly this depends on how wide the space is in propotional font,
      -- which varies wildly, so we err on the side of larger indent.
      let nspaces :: Int
    nspaces = case DisplayFont
    font of
            DisplayFont
    SquareFont -> Int
    1
            DisplayFont
    MonoFont -> Int
    2
            DisplayFont
    PropFont -> Int
    4
          ts :: [AttrLine]
    ts = Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    w (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    nspaces) AttrString
    l
          -- Proportional spaces are very narrow.
          spaces :: AttrString
    spaces = Int -> AttrCharW32 -> AttrString
    forall a. Int -> a -> [a]
    replicate Int
    nspaces AttrCharW32
    Color.spaceAttrW32
      in case [AttrLine]
    ts of
        [] -> []
        AttrLine
    hd : [AttrLine]
    tl -> AttrLine
    hd AttrLine -> [AttrLine] -> [AttrLine]
    forall a. a -> [a] -> [a]
    : (AttrLine -> AttrLine) -> [AttrLine] -> [AttrLine]
    forall a b. (a -> b) -> [a] -> [b]
    map (AttrString -> AttrLine
    AttrLine (AttrString -> AttrLine)
    -> (AttrLine -> AttrString) -> AttrLine -> AttrLine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AttrString
    spaces AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++) (AttrString -> AttrString)
    -> (AttrLine -> AttrString) -> AttrLine -> AttrString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrLine -> AttrString
    attrLine) [AttrLine]
    tl

    -- We pass empty line along for the case of appended buttons, which need
    -- either space or new lines before them.
    splitAttrPhrase :: Int -> Int -> AttrLine -> [AttrLine]
    splitAttrPhrase :: Int -> Int -> AttrLine -> [AttrLine]
    splitAttrPhrase Int
    w0 Int
    w1 (AttrLine AttrString
    xs)
      | Int
    w0 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    xs = [AttrString -> AttrLine
    AttrLine AttrString
    xs]  -- no problem, everything fits
      | Bool
    otherwise =
          let (AttrString
    pre, AttrString
    postRaw) = Int -> AttrString -> (AttrString, AttrString)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    w0 AttrString
    xs
              preRev :: AttrString
    preRev = AttrString -> AttrString
    forall a. [a] -> [a]
    reverse AttrString
    pre
              ((AttrString
    ppre, AttrString
    ppost), AttrString
    post) = case AttrString
    postRaw of
                AttrCharW32
    c : AttrString
    rest | AttrCharW32
    c AttrCharW32 -> AttrCharW32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == AttrCharW32
    Color.spaceAttrW32
                           Bool -> Bool -> Bool
    && Bool -> Bool
    not (AttrString -> Bool
    isPrefixOfNonbreakable AttrString
    preRev) ->
                  (([], AttrString
    preRev), AttrString
    rest)
                AttrString
    _ -> (AttrString -> (AttrString, AttrString)
    breakAtSpace AttrString
    preRev, AttrString
    postRaw)
          in if (AttrCharW32 -> Bool) -> AttrString -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (AttrCharW32 -> AttrCharW32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == AttrCharW32
    Color.spaceAttrW32) AttrString
    ppost
             then AttrString -> AttrLine
    AttrLine (AttrString -> AttrString
    forall a. [a] -> [a]
    reverse (AttrString -> AttrString) -> AttrString -> AttrString
    forall a b. (a -> b) -> a -> b
    $ (AttrCharW32 -> Bool) -> AttrString -> AttrString
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (AttrCharW32 -> AttrCharW32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == AttrCharW32
    Color.spaceAttrW32) AttrString
    preRev)
                  AttrLine -> [AttrLine] -> [AttrLine]
    forall a. a -> [a] -> [a]
    : Int -> Int -> AttrLine -> [AttrLine]
    splitAttrPhrase Int
    w1 Int
    w1 (AttrString -> AttrLine
    AttrLine AttrString
    post)
             else AttrString -> AttrLine
    AttrLine (AttrString -> AttrString
    forall a. [a] -> [a]
    reverse (AttrString -> AttrString) -> AttrString -> AttrString
    forall a b. (a -> b) -> a -> b
    $ (AttrCharW32 -> Bool) -> AttrString -> AttrString
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (AttrCharW32 -> AttrCharW32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == AttrCharW32
    Color.spaceAttrW32) AttrString
    ppost)
                  AttrLine -> [AttrLine] -> [AttrLine]
    forall a. a -> [a] -> [a]
    : Int -> Int -> AttrLine -> [AttrLine]
    splitAttrPhrase Int
    w1 Int
    w1 (AttrString -> AttrLine
    AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
    forall a b. (a -> b) -> a -> b
    $ AttrString -> AttrString
    forall a. [a] -> [a]
    reverse AttrString
    ppre AttrString -> AttrString -> AttrString
    forall a. [a] -> [a] -> [a]
    ++ AttrString
    post)

    -- * Overlay

    -- | A series of screen lines with start positions at which they should
    -- be overlayed over the base frame or a blank screen, depending on context.
    -- The position point is represented as in integer that is an index into the
    -- frame character array.
    -- The lines either fit the width of the screen or are intended
    -- for truncation when displayed. The start positions of lines may fall outside
    -- the length of the screen, too, unlike in @SingleFrame@. Then they are
    -- simply not shown.
    type Overlay = [(PointUI, AttrLine)]

    xytranslateOverlay :: Int -> Int -> Overlay -> Overlay
    xytranslateOverlay :: Int -> Int -> Overlay -> Overlay
    xytranslateOverlay Int
    dx Int
    dy =
      ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
    forall a b. (a -> b) -> [a] -> [b]
    map (\(PointUI Int
    x Int
    y, AttrLine
    al) -> (Int -> Int -> PointUI
    PointUI (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    dx) (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    dy), AttrLine
    al))

    xtranslateOverlay :: Int -> Overlay -> Overlay
    xtranslateOverlay :: Int -> Overlay -> Overlay
    xtranslateOverlay Int
    dx = Int -> Int -> Overlay -> Overlay
    xytranslateOverlay Int
    dx Int
    0

    ytranslateOverlay :: Int -> Overlay -> Overlay
    ytranslateOverlay :: Int -> Overlay -> Overlay
    ytranslateOverlay = Int -> Int -> Overlay -> Overlay
    xytranslateOverlay Int
    0

    offsetOverlay :: [AttrLine] -> Overlay
    offsetOverlay :: [AttrLine] -> Overlay
    offsetOverlay = (Int -> AttrLine -> (PointUI, AttrLine))
    -> [Int] -> [AttrLine] -> Overlay
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (((Int, AttrLine) -> (PointUI, AttrLine))
    -> Int -> AttrLine -> (PointUI, AttrLine)
    forall a b c. ((a, b) -> c) -> a -> b -> c
    curry ((Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine))
    -> (Int -> PointUI) -> (Int, AttrLine) -> (PointUI, AttrLine)
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> PointUI
    PointUI Int
    0)) [Int
    0..]

    offsetOverlayX :: [(Int, AttrLine)] -> Overlay
    offsetOverlayX :: [(Int, AttrLine)] -> Overlay
    offsetOverlayX = (Int -> (Int, AttrLine) -> (PointUI, AttrLine))
    -> [Int] -> [(Int, AttrLine)] -> Overlay
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Int
    y (Int
    x, AttrLine
    al) -> (Int -> Int -> PointUI
    PointUI Int
    x Int
    y, AttrLine
    al)) [Int
    0..]

    typesetXY :: (Int, Int) -> [AttrLine] -> Overlay
    typesetXY :: (Int, Int) -> [AttrLine] -> Overlay
    typesetXY (Int
    xoffset, Int
    yoffset) =
      (Int -> AttrLine -> (PointUI, AttrLine))
    -> [Int] -> [AttrLine] -> Overlay
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Int
    y AttrLine
    al -> (Int -> Int -> PointUI
    PointUI Int
    xoffset (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    yoffset), AttrLine
    al)) [Int
    0..]

    -- @f@ should not enlarge the line beyond screen width nor introduce linebreaks.
    updateLine :: Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
    updateLine :: Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
    updateLine Int
    y Int -> AttrString -> AttrString
    f Overlay
    ov =
      let upd :: (PointUI, AttrLine) -> (PointUI, AttrLine)
    upd (p :: PointUI
    p@(PointUI Int
    px Int
    py), AttrLine AttrString
    l) =
            if Int
    py Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    y then (PointUI
    p, AttrString -> AttrLine
    AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
    forall a b. (a -> b) -> a -> b
    $ Int -> AttrString -> AttrString
    f Int
    px AttrString
    l) else (PointUI
    p, AttrString -> AttrLine
    AttrLine AttrString
    l)
      in ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
    forall a b. (a -> b) -> [a] -> [b]
    map (PointUI, AttrLine) -> (PointUI, AttrLine)
    upd Overlay
    ov

    rectangleOfSpaces :: Int -> Int -> Overlay
    rectangleOfSpaces :: Int -> Int -> Overlay
    rectangleOfSpaces Int
    x Int
    y =
      let blankAttrLine :: AttrLine
    blankAttrLine = AttrString -> AttrLine
    AttrLine (AttrString -> AttrLine) -> AttrString -> AttrLine
    forall a b. (a -> b) -> a -> b
    $ Int -> AttrCharW32 -> AttrString
    forall a. Int -> a -> [a]
    replicate Int
    x AttrCharW32
    Color.nbspAttrW32
      in [AttrLine] -> Overlay
    offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
    forall a b. (a -> b) -> a -> b
    $ Int -> AttrLine -> [AttrLine]
    forall a. Int -> a -> [a]
    replicate Int
    y AttrLine
    blankAttrLine

    maxYofOverlay :: Overlay -> Int
    maxYofOverlay :: Overlay -> Int
    maxYofOverlay Overlay
    ov = let yOfOverlay :: (PointUI, b) -> Int
    yOfOverlay (PointUI Int
    _ Int
    y, b
    _) = Int
    y
                       in [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    0 Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : ((PointUI, AttrLine) -> Int) -> Overlay -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (PointUI, AttrLine) -> Int
    forall {b}. (PointUI, b) -> Int
    yOfOverlay Overlay
    ov

    labDescOverlay :: DisplayFont -> Int -> AttrString -> (Overlay, Overlay)
    labDescOverlay :: DisplayFont -> Int -> AttrString -> (Overlay, Overlay)
    labDescOverlay DisplayFont
    labFont Int
    width AttrString
    as =
      let (AttrString
    tLab, AttrString
    tDesc) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (AttrCharW32 -> AttrCharW32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= AttrCharW32
    Color.spaceAttrW32) AttrString
    as
          labLen :: Int
    labLen = DisplayFont -> AttrString -> Int
    forall a. DisplayFont -> [a] -> Int
    textSize DisplayFont
    labFont AttrString
    tLab
          len :: Int
    len = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - AttrString -> Int
    forall a. [a] -> Int
    length AttrString
    tLab  -- not labLen; TODO: type more strictly
          ovLab :: Overlay
    ovLab = [AttrLine] -> Overlay
    offsetOverlay [AttrString -> AttrLine
    attrStringToAL AttrString
    tLab]
          ovDesc :: Overlay
    ovDesc = [(Int, AttrLine)] -> Overlay
    offsetOverlayX ([(Int, AttrLine)] -> Overlay) -> [(Int, AttrLine)] -> Overlay
    forall a b. (a -> b) -> a -> b
    $
            case Int -> Int -> AttrString -> [AttrLine]
    splitAttrString Int
    len Int
    width AttrString
    tDesc of
              [] -> []
              AttrLine
    l : [AttrLine]
    ls -> (Int
    labLen, AttrLine
    l) (Int, AttrLine) -> [(Int, AttrLine)] -> [(Int, AttrLine)]
    forall a. a -> [a] -> [a]
    : (AttrLine -> (Int, AttrLine)) -> [AttrLine] -> [(Int, AttrLine)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int
    0,) [AttrLine]
    ls
      in (Overlay
    ovLab, Overlay
    ovDesc)