    -- | Text frontend based on ANSI (via ansi-terminal).
    module Game.LambdaHack.Client.UI.Frontend.ANSI
      ( startup, frontendName
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import           Control.Concurrent.Async
    import           Data.Char (chr, ord)
    import qualified Data.Text as T
    import qualified System.Console.ANSI as ANSI
    import           System.Exit (die)
    import qualified System.IO as SIO

    import           Game.LambdaHack.Client.UI.Content.Screen
    import           Game.LambdaHack.Client.UI.Frame
    import           Game.LambdaHack.Client.UI.Frontend.Common
    import qualified Game.LambdaHack.Client.UI.Key as K
    import           Game.LambdaHack.Client.UI.PointUI
    import           Game.LambdaHack.Common.Point
    import qualified Game.LambdaHack.Common.PointArray as PointArray
    import           Game.LambdaHack.Content.TileKind (floorSymbol)
    import qualified Game.LambdaHack.Definition.Color as Color

    -- No session data maintained by this frontend

    -- | The name of the frontend.
    frontendName :: String
    frontendName :: String
    frontendName = String
    "ANSI"

    -- | Starts the main program loop using the frontend input and output.
    startup :: ScreenContent -> IO RawFrontend
    startup :: ScreenContent -> IO RawFrontend
    startup coscreen :: ScreenContent
    coscreen@ScreenContent{Int
    rwidth :: Int
    rwidth :: ScreenContent -> Int
    rwidth, Int
    rheight :: Int
    rheight :: ScreenContent -> Int
    rheight} = do
      IO ()
    ANSI.clearScreen
      myx <- IO (Maybe (Int, Int))
    ANSI.getTerminalSize
      case myx of
        Just (Int
    y, Int
    x) | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    rwidth Bool -> Bool -> Bool
    || Int
    y Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    rheight ->
          -- Unlike @error@, @die@ does not move savefiles aside.
          String -> IO RawFrontend
    forall a. String -> IO a
    die (String -> IO RawFrontend) -> String -> IO RawFrontend
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $
            Text
    "The terminal is too small. It should have"
            Text -> Text -> Text
    <+> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    rwidth
            Text -> Text -> Text
    <+> Text
    "columns and"
            Text -> Text -> Text
    <+> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    rheight
            Text -> Text -> Text
    <+> Text
    "rows, but is has"
            Text -> Text -> Text
    <+> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    x
            Text -> Text -> Text
    <+> Text
    "columns and"
            Text -> Text -> Text
    <+> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    y
            Text -> Text -> Text
    <+> Text
    "rows. Resize it and run the program again."
        Maybe (Int, Int)
    _ -> do
          rf <- ScreenContent -> (SingleFrame -> IO ()) -> IO () -> IO RawFrontend
    createRawFrontend ScreenContent
    coscreen (ScreenContent -> SingleFrame -> IO ()
    display ScreenContent
    coscreen) (ScreenContent -> IO ()
    shutdown ScreenContent
    coscreen)
          let storeKeys :: IO ()
              storeKeys = do
                c <- IO Char
    SIO.getChar  -- blocks here, so no polling
                s <- do
                  if c == '\ESC' then do
                    ready <- SIO.hReady SIO.stdin
                    if ready then do
                      c2 <- SIO.getChar
                      case c2 of
                        Char
    '\ESC' -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char
    c]
                        Char
    '[' -> String -> IO String
    keycodeInput [Char
    c, Char
    c2]
                        Char
    'O' -> String -> IO String
    keycodeInput [Char
    c, Char
    c2]
                        Char
    _ -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Char
    c, Char
    c2]  -- Alt modifier
                    else return [c]
                  else return [c]
                let K.KM{..} = keyTranslate s
                saveKMP rf modifier key (PointUI 0 0)
                storeKeys
              keycodeInput :: String -> IO String
              keycodeInput String
    inputSoFar = do
                ready <- Handle -> IO Bool
    SIO.hReady Handle
    SIO.stdin
                if ready then do
                  c <- SIO.getChar
                  if ord '@' <= ord c && ord c <= ord '~'  -- terminator
                  then return $ inputSoFar ++ [c]
                  else keycodeInput  $ inputSoFar ++ [c]
                else return inputSoFar
          SIO.hSetBuffering SIO.stdin SIO.NoBuffering
          SIO.hSetBuffering SIO.stderr $ SIO.BlockBuffering $
            Just $ 2 * rwidth * rheight
          void $ async storeKeys
          return $! rf

    -- This is contrived, because we don't want to depend on libraries
    -- that read and interpret terminfo or similar on different architectures.
    -- The "works" comments are mostly about Gnome terminal.
    -- On the Gnome terminal, fo the keys mention on game help screen,
    -- the following don't work: C-TAB, C-S-TAB, C-R, C-?. C-/, C-{, C-}, C-q,
    -- C-S, C-P, C-keypad. This is acceptable. No worth adding functionality
    -- for decoding modifiers that would, with much luck, enable C-keypad,
    -- but no other broken keys. Unless more is broken on other terminals.
    -- On rxvt, sadly, KP_5 is a dead key.
    keyTranslate :: String -> K.KM
    keyTranslate :: String -> KM
    keyTranslate String
    e = (\(Key
    key, Modifier
    modifier) -> Modifier -> Key -> KM
    K.KM Modifier
    modifier Key
    key) ((Key, Modifier) -> KM) -> (Key, Modifier) -> KM
    forall a b. (a -> b) -> a -> b
    $
      case String
    e of
        String
    "\ESC" -> (Key
    K.Esc, Modifier
    K.NoModifier)  -- equals @^[@
        Char
    '\ESC' : Char
    '[' : String
    rest -> String -> (Key, Modifier)
    keycodeTranslate String
    rest
        Char
    '\ESC' : Char
    'O' : String
    rest -> String -> (Key, Modifier)
    ocodeTranslate String
    rest
        [Char
    '\ESC', Char
    c] -> (Char -> Key
    K.Char Char
    c, Modifier
    K.Alt)
        String
    "\b" -> (Key
    K.BackSpace, Modifier
    K.NoModifier)  -- same as "\BS" and "\^H" but fails
        String
    "\DEL" -> (Key
    K.BackSpace, Modifier
    K.NoModifier)  -- works; go figure
        String
    "\n" -> (Key
    K.Return, Modifier
    K.NoModifier)
        String
    "\r" -> (Key
    K.Return, Modifier
    K.NoModifier)
        String
    " "  -> (Key
    K.Space, Modifier
    K.NoModifier)
        String
    "\t" -> (Key
    K.Tab, Modifier
    K.NoModifier)  -- apparently equals @\^I@ and @\HT@
        [Char
    c] | Char -> Int
    ord Char
    '\^A' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char -> Int
    ord Char
    c Bool -> Bool -> Bool
    && Char -> Int
    ord Char
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Char -> Int
    ord Char
    '\^Z' ->
              -- Alas, only lower-case letters.
              (Char -> Key
    K.Char (Char -> Key) -> Char -> Key
    forall a b. (a -> b) -> a -> b
    $ Int -> Char
    chr (Int -> Char) -> Int -> Char
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    '\^A' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    'a', Modifier
    K.Control)
            | -- On (some) terminal emulators Shift-keypad direction produces
              -- the same code as number keys. A sensible workaround for that
              -- is using Control for running, but it's not clear how portable
              -- this is, so we do not rely on this exclusively. Since movement
              -- keys are more important than leader picking, we are disabling
              -- the latter and interpreting the keypad numbers as movement.
              --
              -- BTW, S-KP_5 and C-KP_5 are probably still not correctly handled
              -- on some terminals, so this may be the biggest portability problem.
              Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char
    '1'..Char
    '9'] -> (Char -> Key
    K.KP Char
    c, Modifier
    K.NoModifier)
            | Bool
    otherwise           -> (Char -> Key
    K.Char Char
    c, Modifier
    K.NoModifier)
        String
    _ -> (String -> Key
    K.Unknown String
    e, Modifier
    K.NoModifier)

    -- From https://en.wikipedia.org/wiki/ANSI_escape_code#Terminal_input_sequences
    keycodeTranslate :: String -> (K.Key, K.Modifier)
    keycodeTranslate :: String -> (Key, Modifier)
    keycodeTranslate String
    e =
      case String
    e of
        String
    "1~" -> (Key
    K.Home, Modifier
    K.NoModifier)
        String
    "2~" -> (Key
    K.Insert, Modifier
    K.NoModifier)
        String
    "3~" -> (Key
    K.Delete, Modifier
    K.NoModifier)
        String
    "4~" -> (Key
    K.End , Modifier
    K.NoModifier)
        String
    "5~" -> (Key
    K.PgUp, Modifier
    K.NoModifier)
        String
    "6~" -> (Key
    K.PgDn, Modifier
    K.NoModifier)
        String
    "7~" -> (Key
    K.Home, Modifier
    K.NoModifier)
        String
    "8~" -> (Key
    K.End, Modifier
    K.NoModifier)
        String
    "9~" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "10~" -> (Int -> Key
    K.Fun Int
    0, Modifier
    K.NoModifier)
        String
    "11~" -> (Int -> Key
    K.Fun Int
    1, Modifier
    K.NoModifier)
        String
    "12~" -> (Int -> Key
    K.Fun Int
    2, Modifier
    K.NoModifier)
        String
    "13~" -> (Int -> Key
    K.Fun Int
    3, Modifier
    K.NoModifier)
        String
    "14~" -> (Int -> Key
    K.Fun Int
    4, Modifier
    K.NoModifier)
        String
    "15~" -> (Int -> Key
    K.Fun Int
    5, Modifier
    K.NoModifier)
        String
    "17~" -> (Int -> Key
    K.Fun Int
    6, Modifier
    K.NoModifier)
        String
    "18~" -> (Int -> Key
    K.Fun Int
    7, Modifier
    K.NoModifier)
        String
    "19~" -> (Int -> Key
    K.Fun Int
    8, Modifier
    K.NoModifier)
        String
    "20~" -> (Int -> Key
    K.Fun Int
    9, Modifier
    K.NoModifier)
        String
    "21~" -> (Int -> Key
    K.Fun Int
    10, Modifier
    K.NoModifier)
        String
    "22~" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "23~" -> (Int -> Key
    K.Fun Int
    11, Modifier
    K.NoModifier)
        String
    "24~" -> (Int -> Key
    K.Fun Int
    12, Modifier
    K.NoModifier)
        String
    "25~" -> (Int -> Key
    K.Fun Int
    13, Modifier
    K.NoModifier)
        String
    "26~" -> (Int -> Key
    K.Fun Int
    14, Modifier
    K.NoModifier)
        String
    "27~" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "28~" -> (Int -> Key
    K.Fun Int
    15, Modifier
    K.NoModifier)
        String
    "29~" -> (Int -> Key
    K.Fun Int
    16, Modifier
    K.NoModifier)
        String
    "30~" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "32~" -> (Int -> Key
    K.Fun Int
    18 , Modifier
    K.NoModifier)
        String
    "33~" -> (Int -> Key
    K.Fun Int
    19 , Modifier
    K.NoModifier)
        String
    "34~" -> (Int -> Key
    K.Fun Int
    20 , Modifier
    K.NoModifier)
        String
    "35~" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)

        String
    "A" -> (Key
    K.Up, Modifier
    K.NoModifier)
        String
    "B" -> (Key
    K.Down, Modifier
    K.NoModifier)
        String
    "C" -> (Key
    K.Right, Modifier
    K.NoModifier)
        String
    "D" -> (Key
    K.Left, Modifier
    K.NoModifier)
        String
    "E" -> (Key
    K.Begin, Modifier
    K.NoModifier)
        String
    "F" -> (Key
    K.End, Modifier
    K.NoModifier)
        String
    "G" -> (Char -> Key
    K.KP Char
    '5', Modifier
    K.NoModifier)
        String
    "H" -> (Key
    K.Home, Modifier
    K.NoModifier)
        String
    "I" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "J" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "K" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "L" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "M" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "N" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "O" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "1P" -> (Int -> Key
    K.Fun Int
    1, Modifier
    K.NoModifier)
        String
    "1Q" -> (Int -> Key
    K.Fun Int
    2, Modifier
    K.NoModifier)
        String
    "1R" -> (Int -> Key
    K.Fun Int
    3, Modifier
    K.NoModifier)
        String
    "1S" -> (Int -> Key
    K.Fun Int
    4, Modifier
    K.NoModifier)
        String
    "T" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "U" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "V" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "W" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "X" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "Y" -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)
        String
    "Z" -> (Key
    K.BackTab, Modifier
    K.NoModifier)

    --    "r" -> (K.Begin, K.NoModifier)
    --    "u" -> (K.Begin, K.NoModifier)

        String
    _ -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESC[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)

    -- From guesswork, cargo-culting and @sed -n l@.
    ocodeTranslate :: String -> (K.Key, K.Modifier)
    ocodeTranslate :: String -> (Key, Modifier)
    ocodeTranslate String
    e =
      case String
    e of
        String
    "P" -> (Int -> Key
    K.Fun Int
    1, Modifier
    K.NoModifier)
        String
    "Q" -> (Int -> Key
    K.Fun Int
    2, Modifier
    K.NoModifier)
        String
    "R" -> (Int -> Key
    K.Fun Int
    3, Modifier
    K.NoModifier)
        String
    "S" -> (Int -> Key
    K.Fun Int
    4, Modifier
    K.NoModifier)

        String
    "p" -> (Char -> Key
    K.KP Char
    '0', Modifier
    K.Shift)
        String
    "q" -> (Char -> Key
    K.KP Char
    '1', Modifier
    K.Shift)
        String
    "r" -> (Char -> Key
    K.KP Char
    '2', Modifier
    K.Shift)
        String
    "s" -> (Char -> Key
    K.KP Char
    '3', Modifier
    K.Shift)
        String
    "t" -> (Char -> Key
    K.KP Char
    '4', Modifier
    K.Shift)
        String
    "u" -> (Char -> Key
    K.KP Char
    '5', Modifier
    K.Shift)
        String
    "v" -> (Char -> Key
    K.KP Char
    '6', Modifier
    K.Shift)
        String
    "w" -> (Char -> Key
    K.KP Char
    '7', Modifier
    K.Shift)
        String
    "x" -> (Char -> Key
    K.KP Char
    '8', Modifier
    K.Shift)
        String
    "y" -> (Char -> Key
    K.KP Char
    '9', Modifier
    K.Shift)

        String
    _ -> (String -> Key
    K.Unknown (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ String
    "\\ESCO" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e, Modifier
    K.NoModifier)

    shutdown :: ScreenContent -> IO ()
    shutdown :: ScreenContent -> IO ()
    shutdown ScreenContent{Int
    rheight :: ScreenContent -> Int
    rheight :: Int
    rheight} = do
      -- The lowest position guaranteed to exist.
      Handle -> Int -> Int -> IO ()
    ANSI.hSetCursorPosition Handle
    SIO.stderr (Int
    rheight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int
    0
      Handle -> IO ()
    SIO.hFlush Handle
    SIO.stdout IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    SIO.hFlush Handle
    SIO.stderr

    -- | Output to the screen via the frontend.
    display :: ScreenContent
            -> SingleFrame
            -> IO ()
    display :: ScreenContent -> SingleFrame -> IO ()
    display ScreenContent{Int
    rwidth :: ScreenContent -> Int
    rwidth :: Int
    rwidth} SingleFrame{Array AttrCharW32
    singleArray :: Array AttrCharW32
    singleArray :: SingleFrame -> Array AttrCharW32
    singleArray} = do
      Handle -> IO ()
    ANSI.hHideCursor Handle
    SIO.stderr
      let cutInChunks :: [AttrCharW32] -> [[AttrCharW32]]
    cutInChunks [] = []
          cutInChunks [AttrCharW32]
    l = let ([AttrCharW32]
    ch, [AttrCharW32]
    r) = Int -> [AttrCharW32] -> ([AttrCharW32], [AttrCharW32])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    rwidth [AttrCharW32]
    l
                          in [AttrCharW32]
    ch [AttrCharW32] -> [[AttrCharW32]] -> [[AttrCharW32]]
    forall a. a -> [a] -> [a]
    : [AttrCharW32] -> [[AttrCharW32]]
    cutInChunks [AttrCharW32]
    r
          f :: (Int, [AttrCharW32]) -> IO ()
    f (!Int
    y, [AttrCharW32]
    chunk) = do
            Handle -> Int -> Int -> IO ()
    ANSI.hSetCursorPosition Handle
    SIO.stderr Int
    y Int
    0
            Handle -> String -> IO ()
    SIO.hPutStr Handle
    SIO.stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [AttrCharW32] -> String
    g [AttrCharW32]
    chunk
          g :: [AttrCharW32] -> String
    g = (AttrCharW32 -> String) -> [AttrCharW32] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap AttrCharW32 -> String
    h
          -- Not emitting ANSI if the previous character had the same fg and bg
          -- gains little in terms of maximal lag, due to checkerboard levels/rooms
          -- (even though it triples FPS in normal rooms; but comparing with
          -- previous frame gains even more in normal cases and copes well
          -- with checkerboard; both not worth the effort for this frontend).
          h :: AttrCharW32 -> String
    h !AttrCharW32
    w =
            let acChar :: Char
    acChar = Char -> Char
    squashChar (Char -> Char) -> Char -> Char
    forall a b. (a -> b) -> a -> b
    $ AttrCharW32 -> Char
    Color.charFromW32 AttrCharW32
    w
                (Color
    fg, Color
    bg) = Attr -> (Color, Color)
    setAttr (Attr -> (Color, Color)) -> Attr -> (Color, Color)
    forall a b. (a -> b) -> a -> b
    $ AttrCharW32 -> Attr
    Color.attrFromW32 AttrCharW32
    w
            in [SGR] -> String
    ANSI.setSGRCode [ (ColorIntensity -> Color -> SGR) -> (ColorIntensity, Color) -> SGR
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (ConsoleLayer -> ColorIntensity -> Color -> SGR
    ANSI.SetColor ConsoleLayer
    ANSI.Foreground)
                                 ((ColorIntensity, Color) -> SGR) -> (ColorIntensity, Color) -> SGR
    forall a b. (a -> b) -> a -> b
    $ Color -> (ColorIntensity, Color)
    colorTranslate Color
    fg
                               , (ColorIntensity -> Color -> SGR) -> (ColorIntensity, Color) -> SGR
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (ConsoleLayer -> ColorIntensity -> Color -> SGR
    ANSI.SetColor ConsoleLayer
    ANSI.Background)
                                 ((ColorIntensity, Color) -> SGR) -> (ColorIntensity, Color) -> SGR
    forall a b. (a -> b) -> a -> b
    $ Color -> (ColorIntensity, Color)
    colorTranslate Color
    bg ]
               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    acChar]
    {-
    This is dubious, because I can't force bright background colour with that,
    only bright foregrounds. And I have at least one bright backround: bright black.
            -- A hack to get bright colors via the bold attribute.
            -- Depending on terminal settings this is needed or not
            -- and the characters really get bold or not.
            -- HSCurses does this by default, in Vty you have to request the hack,
            -- with ANSI we probably need it as well.
            ANSI.hSetSGR SIO.stderr [ANSI.SetConsoleIntensity
                                     $ if Color.isBright fg
                                       then ANSI.BoldIntensity
                                       else ANSI.NormalIntensity]
    -}
      ((Int, [AttrCharW32]) -> IO ()) -> [(Int, [AttrCharW32])] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Int, [AttrCharW32]) -> IO ()
    f ([(Int, [AttrCharW32])] -> IO ())
    -> [(Int, [AttrCharW32])] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [[AttrCharW32]] -> [(Int, [AttrCharW32])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0 ..] ([[AttrCharW32]] -> [(Int, [AttrCharW32])])
    -> [[AttrCharW32]] -> [(Int, [AttrCharW32])]
    forall a b. (a -> b) -> a -> b
    $ [AttrCharW32] -> [[AttrCharW32]]
    cutInChunks ([AttrCharW32] -> [[AttrCharW32]])
    -> [AttrCharW32] -> [[AttrCharW32]]
    forall a b. (a -> b) -> a -> b
    $ Array AttrCharW32 -> [AttrCharW32]
    forall c. UnboxRepClass c => Array c -> [c]
    PointArray.toListA Array AttrCharW32
    singleArray
      let Point{Int
    px :: Int
    py :: Int
    py :: Point -> Int
    px :: Point -> Int
    ..} = (AttrCharW32 -> AttrCharW32 -> Ordering)
    -> Array AttrCharW32 -> Point
    forall c.
    UnboxRepClass c =>
    (c -> c -> Ordering) -> Array c -> Point
    PointArray.maxIndexByA ((AttrCharW32 -> Highlight)
    -> AttrCharW32 -> AttrCharW32 -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing AttrCharW32 -> Highlight
    Color.bgFromW32) Array AttrCharW32
    singleArray
      Handle -> Int -> Int -> IO ()
    ANSI.hSetCursorPosition Handle
    SIO.stderr Int
    py Int
    px
      Handle -> IO ()
    ANSI.hShowCursor Handle
    SIO.stderr
      -- Do not trash people's terminals when interrupted:
      Handle -> [SGR] -> IO ()
    ANSI.hSetSGR Handle
    SIO.stderr [(ColorIntensity -> Color -> SGR) -> (ColorIntensity, Color) -> SGR
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (ConsoleLayer -> ColorIntensity -> Color -> SGR
    ANSI.SetColor ConsoleLayer
    ANSI.Foreground)
                               ((ColorIntensity, Color) -> SGR) -> (ColorIntensity, Color) -> SGR
    forall a b. (a -> b) -> a -> b
    $ Color -> (ColorIntensity, Color)
    colorTranslate Color
    Color.White]
      Handle -> [SGR] -> IO ()
    ANSI.hSetSGR Handle
    SIO.stderr [(ColorIntensity -> Color -> SGR) -> (ColorIntensity, Color) -> SGR
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (ConsoleLayer -> ColorIntensity -> Color -> SGR
    ANSI.SetColor ConsoleLayer
    ANSI.Background)
                               ((ColorIntensity, Color) -> SGR) -> (ColorIntensity, Color) -> SGR
    forall a b. (a -> b) -> a -> b
    $ Color -> (ColorIntensity, Color)
    colorTranslate Color
    Color.Black]
      Handle -> IO ()
    SIO.hFlush Handle
    SIO.stderr

    squashChar :: Char -> Char
    squashChar :: Char -> Char
    squashChar Char
    c = if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    floorSymbol then Char
    '.' else Char
    c

    setAttr :: Color.Attr -> (Color.Color, Color.Color)
    setAttr :: Attr -> (Color, Color)
    setAttr Color.Attr{Highlight
    Color
    fg :: Color
    bg :: Highlight
    bg :: Attr -> Highlight
    fg :: Attr -> Color
    ..} =
      let (Color
    fg1, Color
    bg1) = case Highlight
    bg of
            Highlight
    Color.HighlightNone -> (Color
    fg, Color
    Color.Black)
            Highlight
    Color.HighlightWhite ->
              if Color
    fg Color -> Color -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Color
    Color.Magenta
              then (Color
    fg, Color
    Color.Magenta)
              else (Color
    fg, Color
    Color.BrBlack)
            Highlight
    Color.HighlightRed ->
              if Color
    fg Color -> Color -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Color
    Color.Red
              then (Color
    fg, Color
    Color.Red)
              else (Color
    fg, Color
    Color.defFG)
            Highlight
    Color.HighlightYellow -> (Color
    fg, Color
    Color.Black)  -- cursor used instead
            Highlight
    Color.HighlightYellowAim -> (Color
    Color.Black, Color
    Color.defFG)
            Highlight
    Color.HighlightRedAim ->
              if Color
    fg Color -> Color -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Color
    Color.Red
              then (Color
    fg, Color
    Color.Red)
              else (Color
    fg, Color
    Color.defFG)
            Highlight
    Color.HighlightNoneCursor -> (Color
    fg, Color
    Color.Black)
            Highlight
    _ -> if Color
    fg Color -> Color -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Highlight -> Color
    Color.highlightToColor Highlight
    bg
                 then (Color
    fg, Highlight -> Color
    Color.highlightToColor Highlight
    bg)
                 else (Color
    fg, if Color
    fg Color -> Color -> Bool
    forall a. Eq a => a -> a -> Bool
    == Color
    Color.BrBlack
                           then Color
    Color.Black
                           else Color
    Color.BrBlack)
      in (Color
    fg1, Color
    bg1)

    colorTranslate :: Color.Color -> (ANSI.ColorIntensity, ANSI.Color)
    colorTranslate :: Color -> (ColorIntensity, Color)
    colorTranslate Color
    Color.Black     = (ColorIntensity
    ANSI.Dull, Color
    ANSI.Black)
    colorTranslate Color
    Color.Red       = (ColorIntensity
    ANSI.Dull, Color
    ANSI.Red)
    colorTranslate Color
    Color.Green     = (ColorIntensity
    ANSI.Dull, Color
    ANSI.Green)
    colorTranslate Color
    Color.Brown     = (ColorIntensity
    ANSI.Dull, Color
    ANSI.Yellow)
    colorTranslate Color
    Color.Blue      = (ColorIntensity
    ANSI.Dull, Color
    ANSI.Blue)
    colorTranslate Color
    Color.Magenta   = (ColorIntensity
    ANSI.Dull, Color
    ANSI.Magenta)
    colorTranslate Color
    Color.Cyan      = (ColorIntensity
    ANSI.Dull, Color
    ANSI.Cyan)
    colorTranslate Color
    Color.White     = (ColorIntensity
    ANSI.Dull, Color
    ANSI.White)
    colorTranslate Color
    Color.AltWhite  = (ColorIntensity
    ANSI.Dull, Color
    ANSI.White)
    colorTranslate Color
    Color.BrBlack   = (ColorIntensity
    ANSI.Vivid, Color
    ANSI.Black)
    colorTranslate Color
    Color.BrRed     = (ColorIntensity
    ANSI.Vivid, Color
    ANSI.Red)
    colorTranslate Color
    Color.BrGreen   = (ColorIntensity
    ANSI.Vivid, Color
    ANSI.Green)
    colorTranslate Color
    Color.BrYellow  = (ColorIntensity
    ANSI.Vivid, Color
    ANSI.Yellow)
    colorTranslate Color
    Color.BrBlue    = (ColorIntensity
    ANSI.Vivid, Color
    ANSI.Blue)
    colorTranslate Color
    Color.BrMagenta = (ColorIntensity
    ANSI.Vivid, Color
    ANSI.Magenta)
    colorTranslate Color
    Color.BrCyan    = (ColorIntensity
    ANSI.Vivid, Color
    ANSI.Cyan)
    colorTranslate Color
    Color.BrWhite   = (ColorIntensity
    ANSI.Vivid, Color
    ANSI.White)