    -- Copyright Corey O'Connor
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE FlexibleContexts #-}
    -- | This module provides an abstract interface for performing terminal
    -- output. The only user-facing part of this API is 'Output'.
    module Graphics.Vty.Output.Interface
      ( Output(..)
      , AssumedState(..)
      , DisplayContext(..)
      , Mode(..)
      , displayContext
      , outputPicture
      , initialAssumedState
      , limitAttrForDisplay
      )
    where

    import Graphics.Vty.Attributes
    import Graphics.Vty.Image (DisplayRegion, regionHeight)
    import Graphics.Vty.Picture
    import Graphics.Vty.PictureToSpans
    import Graphics.Vty.Span

    import Graphics.Vty.DisplayAttributes

    import Blaze.ByteString.Builder (Write, writeToByteString)
    import Blaze.ByteString.Builder.ByteString (writeByteString)

    import qualified Data.ByteString as BS
    import Data.IORef
    import qualified Data.Text.Encoding as T
    import qualified Data.Text.Lazy as TL
    import qualified Data.Vector as Vector

    -- | Modal terminal features that can be enabled and disabled.
    data Mode = Mouse
              -- ^ Mouse mode (whether the terminal is configured to provide
              -- mouse input events)
              | BracketedPaste
              -- ^ Paste mode (whether the terminal is configured to provide
              -- events on OS pastes)
              | Focus
              -- ^ Focus-in/focus-out events (whether the terminal is
              -- configured to provide events on focus change)
              | Hyperlink
              -- ^ Hyperlink mode via the 'withURL' attribute modifier (see
              -- https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda).
              -- Note that this may not work gracefully in all terminal
              -- emulators so be sure to test this mode with the terminals
              -- you intend to support. It is off by default.
              deriving (Mode -> Mode -> Bool
    (Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Mode -> Mode -> Bool
    $c/= :: Mode -> Mode -> Bool
    == :: Mode -> Mode -> Bool
    $c== :: Mode -> Mode -> Bool
    Eq, ReadPrec [Mode]
    ReadPrec Mode
    Int -> ReadS Mode
    ReadS [Mode]
    (Int -> ReadS Mode)
    -> ReadS [Mode] -> ReadPrec Mode -> ReadPrec [Mode] -> Read Mode
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [Mode]
    $creadListPrec :: ReadPrec [Mode]
    readPrec :: ReadPrec Mode
    $creadPrec :: ReadPrec Mode
    readList :: ReadS [Mode]
    $creadList :: ReadS [Mode]
    readsPrec :: Int -> ReadS Mode
    $creadsPrec :: Int -> ReadS Mode
    Read, Int -> Mode -> ShowS
    [Mode] -> ShowS
    Mode -> String
    (Int -> Mode -> ShowS)
    -> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Mode] -> ShowS
    $cshowList :: [Mode] -> ShowS
    show :: Mode -> String
    $cshow :: Mode -> String
    showsPrec :: Int -> Mode -> ShowS
    $cshowsPrec :: Int -> Mode -> ShowS
    Show)

    -- | The Vty terminal output interface.
    data Output = Output
        { -- | Text identifier for the output device. Used for debugging.
          Output -> String
    terminalID :: String
          -- | Release the terminal just prior to application exit and reset
          -- it to its state prior to application startup.
        , Output -> IO ()
    releaseTerminal :: IO ()
          -- | Clear the display and initialize the terminal to some initial
          -- display state.
          --
          -- The expectation of a program is that the display starts in some
          -- The initial state. initial state would consist of fixed values:
          --
          --  - cursor at top left
          --  - UTF-8 character encoding
          --  - drawing characteristics are the default
        , Output -> IO ()
    reserveDisplay :: IO ()
          -- | Return the display to the state before `reserveDisplay` If no
          -- previous state then set the display state to the initial state.
        , Output -> IO ()
    releaseDisplay :: IO ()
          -- | Returns the current display bounds.
        , Output -> IO DisplayRegion
    displayBounds :: IO DisplayRegion
          -- | Output the bytestring to the terminal device.
        , Output -> ByteString -> IO ()
    outputByteBuffer :: BS.ByteString -> IO ()
          -- | Specifies the maximum number of colors supported by the
          -- context.
        , Output -> Int
    contextColorCount :: Int
          -- | Specifies whether the cursor can be shown / hidden.
        , Output -> Bool
    supportsCursorVisibility :: Bool
          -- | Indicates support for terminal modes for this output device.
        , Output -> Mode -> Bool
    supportsMode :: Mode -> Bool
          -- | Enables or disables a mode (does nothing if the mode is
          -- unsupported).
        , Output -> Mode -> Bool -> IO ()
    setMode :: Mode -> Bool -> IO ()
          -- | Returns whether a mode is enabled.
        , Output -> Mode -> IO Bool
    getModeStatus :: Mode -> IO Bool
        , Output -> IORef AssumedState
    assumedStateRef :: IORef AssumedState
          -- | Acquire display access to the given region of the display.
          -- Currently all regions have the upper left corner of (0,0) and
          -- the lower right corner at (max displayWidth providedWidth, max
          -- displayHeight providedHeight)
        , Output -> Output -> DisplayRegion -> IO DisplayContext
    mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext
          -- | Ring the terminal bell if supported.
        , Output -> IO ()
    ringTerminalBell :: IO ()
          -- | Returns whether the terminal has an audio bell feature.
        , Output -> IO Bool
    supportsBell :: IO Bool
        }

    displayContext :: Output -> DisplayRegion -> IO DisplayContext
    displayContext :: Output -> DisplayRegion -> IO DisplayContext
    displayContext t :: Output
    t = Output -> Output -> DisplayRegion -> IO DisplayContext
    mkDisplayContext Output
    t Output
    t

    data AssumedState = AssumedState
        { AssumedState -> Maybe FixedAttr
    prevFattr :: Maybe FixedAttr
        , AssumedState -> Maybe DisplayOps
    prevOutputOps :: Maybe DisplayOps
        }

    initialAssumedState :: AssumedState
    initialAssumedState :: AssumedState
    initialAssumedState = Maybe FixedAttr -> Maybe DisplayOps -> AssumedState
    AssumedState Maybe FixedAttr
    forall a. Maybe a
    Nothing Maybe DisplayOps
    forall a. Maybe a
    Nothing

    data DisplayContext = DisplayContext
        { DisplayContext -> Output
    contextDevice :: Output
        -- | Provide the bounds of the display context.
        , DisplayContext -> DisplayRegion
    contextRegion :: DisplayRegion
        -- | Sets the output position to the specified row and column
        -- where the number of bytes required for the control codes can be
        -- specified seperate from the actual byte sequence.
        , DisplayContext -> Int -> Int -> Write
    writeMoveCursor :: Int -> Int -> Write
        , DisplayContext -> Write
    writeShowCursor :: Write
        , DisplayContext -> Write
    writeHideCursor :: Write
        -- Ensure that the specified output attributes will be applied to
        -- all the following text until the next output attribute change
        -- where the number of bytes required for the control codes can be
        -- specified seperately from the actual byte sequence. The required
        -- number of bytes must be at least the maximum number of bytes
        -- required by any attribute changes. The serialization equations
        -- must provide the ptr to the next byte to be specified in the
        -- output buffer.
        --
        -- The currently applied display attributes are provided as well.
        -- The Attr data type can specify the style or color should not be
        -- changed from the currently applied display attributes. In order
        -- to support this the currently applied display attributes are
        -- required. In addition it may be possible to optimize the state
        -- changes based off the currently applied display attributes.
        , DisplayContext
    -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write
    writeSetAttr :: Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write
        -- | Reset the display attributes to the default display attributes.
        , DisplayContext -> Bool -> Write
    writeDefaultAttr :: Bool -> Write
        , DisplayContext -> Write
    writeRowEnd :: Write
        -- | See `Graphics.Vty.Output.XTermColor.inlineHack`
        , DisplayContext -> IO ()
    inlineHack :: IO ()
        }

    -- | All terminals serialize UTF8 text to the terminal device exactly as
    -- serialized in memory.
    writeUtf8Text  :: BS.ByteString -> Write
    writeUtf8Text :: ByteString -> Write
    writeUtf8Text = ByteString -> Write
    writeByteString

    -- | Displays the given `Picture`.
    --
    --      1. The image is cropped to the display size.
    --
    --      2. Converted into a sequence of attribute changes and text spans.
    --
    --      3. The cursor is hidden.
    --
    --      4. Serialized to the display.
    --
    --      5. The cursor is then shown and positioned or kept hidden.
    outputPicture :: DisplayContext -> Picture -> IO ()
    outputPicture :: DisplayContext -> Picture -> IO ()
    outputPicture dc :: DisplayContext
    dc pic :: Picture
    pic = do
        Bool
    urlsEnabled <- Output -> Mode -> IO Bool
    getModeStatus (DisplayContext -> Output
    contextDevice DisplayContext
    dc) Mode
    Hyperlink
        AssumedState
    as <- IORef AssumedState -> IO AssumedState
    forall a. IORef a -> IO a
    readIORef (Output -> IORef AssumedState
    assumedStateRef (Output -> IORef AssumedState) -> Output -> IORef AssumedState
    forall a b. (a -> b) -> a -> b
    $ DisplayContext -> Output
    contextDevice DisplayContext
    dc)
        let manipCursor :: Bool
    manipCursor = Output -> Bool
    supportsCursorVisibility (DisplayContext -> Output
    contextDevice DisplayContext
    dc)
            r :: DisplayRegion
    r = DisplayContext -> DisplayRegion
    contextRegion DisplayContext
    dc
            ops :: DisplayOps
    ops = Picture -> DisplayRegion -> DisplayOps
    displayOpsForPic Picture
    pic DisplayRegion
    r
            initialAttr :: FixedAttr
    initialAttr = Style -> Maybe Color -> Maybe Color -> Maybe Text -> FixedAttr
    FixedAttr Style
    defaultStyleMask Maybe Color
    forall a. Maybe a
    Nothing Maybe Color
    forall a. Maybe a
    Nothing Maybe Text
    forall a. Maybe a
    Nothing
            -- Diff the previous output against the requested output.
            -- Differences are currently on a per-row basis.
            [Bool]
    diffs :: [Bool] = case AssumedState -> Maybe DisplayOps
    prevOutputOps AssumedState
    as of
                Nothing -> Int -> Bool -> [Bool]
    forall a. Int -> a -> [a]
    replicate (Int -> Int
    forall a. Enum a => a -> Int
    fromEnum (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ DisplayRegion -> Int
    regionHeight (DisplayRegion -> Int) -> DisplayRegion -> Int
    forall a b. (a -> b) -> a -> b
    $ DisplayOps -> DisplayRegion
    affectedRegion DisplayOps
    ops) Bool
    True
                Just previousOps :: DisplayOps
    previousOps -> if DisplayOps -> DisplayRegion
    affectedRegion DisplayOps
    previousOps DisplayRegion -> DisplayRegion -> Bool
    forall a. Eq a => a -> a -> Bool
    /= DisplayOps -> DisplayRegion
    affectedRegion DisplayOps
    ops
                    then Int -> Bool -> [Bool]
    forall a. Int -> a -> [a]
    replicate (DisplayOps -> Int
    displayOpsRows DisplayOps
    ops) Bool
    True
                    else Vector Bool -> [Bool]
    forall a. Vector a -> [a]
    Vector.toList (Vector Bool -> [Bool]) -> Vector Bool -> [Bool]
    forall a b. (a -> b) -> a -> b
    $ (SpanOps -> SpanOps -> Bool)
    -> DisplayOps -> DisplayOps -> Vector Bool
    forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
    Vector.zipWith SpanOps -> SpanOps -> Bool
    forall a. Eq a => a -> a -> Bool
    (/=) DisplayOps
    previousOps DisplayOps
    ops
            -- build the Write corresponding to the output image
            out :: Write
    out = (if Bool
    manipCursor then DisplayContext -> Write
    writeHideCursor DisplayContext
    dc else Write
    forall a. Monoid a => a
    mempty)
                  Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Bool
    -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write
    writeOutputOps Bool
    urlsEnabled DisplayContext
    dc FixedAttr
    initialAttr [Bool]
    diffs DisplayOps
    ops
                  Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                    (let (w :: Int
    w,h :: Int
    h) = DisplayContext -> DisplayRegion
    contextRegion DisplayContext
    dc
                         clampX :: Int -> Int
    clampX = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 0 (Int -> Int) -> (Int -> Int) -> Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int
    wInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1)
                         clampY :: Int -> Int
    clampY = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 0 (Int -> Int) -> (Int -> Int) -> Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int
    hInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) in
                     case Picture -> Cursor
    picCursor Picture
    pic of
                        _ | Bool -> Bool
    not Bool
    manipCursor -> Write
    forall a. Monoid a => a
    mempty
                        NoCursor            -> Write
    forall a. Monoid a => a
    mempty
                        AbsoluteCursor x :: Int
    x y :: Int
    y ->
                            DisplayContext -> Write
    writeShowCursor DisplayContext
    dc Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                            DisplayContext -> Int -> Int -> Write
    writeMoveCursor DisplayContext
    dc (Int -> Int
    clampX Int
    x) (Int -> Int
    clampY Int
    y)
                        Cursor x :: Int
    x y :: Int
    y           ->
                            let m :: CursorOutputMap
    m = DisplayOps -> Cursor -> CursorOutputMap
    cursorOutputMap DisplayOps
    ops (Cursor -> CursorOutputMap) -> Cursor -> CursorOutputMap
    forall a b. (a -> b) -> a -> b
    $ Picture -> Cursor
    picCursor Picture
    pic
                                (ox :: Int
    ox, oy :: Int
    oy) = CursorOutputMap -> DisplayRegion -> DisplayRegion
    charToOutputPos CursorOutputMap
    m (Int -> Int
    clampX Int
    x, Int -> Int
    clampY Int
    y)
                            in DisplayContext -> Write
    writeShowCursor DisplayContext
    dc Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                               DisplayContext -> Int -> Int -> Write
    writeMoveCursor DisplayContext
    dc (Int -> Int
    clampX Int
    ox) (Int -> Int
    clampY Int
    oy)
                    )
        -- ... then serialize
        Output -> ByteString -> IO ()
    outputByteBuffer (DisplayContext -> Output
    contextDevice DisplayContext
    dc) (Write -> ByteString
    writeToByteString Write
    out)
        -- Cache the output spans.
        let as' :: AssumedState
    as' = AssumedState
    as { prevOutputOps :: Maybe DisplayOps
    prevOutputOps = DisplayOps -> Maybe DisplayOps
    forall a. a -> Maybe a
    Just DisplayOps
    ops }
        IORef AssumedState -> AssumedState -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (Output -> IORef AssumedState
    assumedStateRef (Output -> IORef AssumedState) -> Output -> IORef AssumedState
    forall a b. (a -> b) -> a -> b
    $ DisplayContext -> Output
    contextDevice DisplayContext
    dc) AssumedState
    as'

    writeOutputOps :: Bool -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write
    writeOutputOps :: Bool
    -> DisplayContext -> FixedAttr -> [Bool] -> DisplayOps -> Write
    writeOutputOps urlsEnabled :: Bool
    urlsEnabled dc :: DisplayContext
    dc initialAttr :: FixedAttr
    initialAttr diffs :: [Bool]
    diffs ops :: DisplayOps
    ops =
        let (_, out :: Write
    out, _) = ((Int, Write, [Bool]) -> SpanOps -> (Int, Write, [Bool]))
    -> (Int, Write, [Bool]) -> DisplayOps -> (Int, Write, [Bool])
    forall a b. (a -> b -> a) -> a -> Vector b -> a
    Vector.foldl' (Int, Write, [Bool]) -> SpanOps -> (Int, Write, [Bool])
    writeOutputOps'
                                           (0, Write
    forall a. Monoid a => a
    mempty, [Bool]
    diffs)
                                           DisplayOps
    ops
        in Write
    out
        where
            writeOutputOps' :: (Int, Write, [Bool]) -> SpanOps -> (Int, Write, [Bool])
    writeOutputOps' (y :: Int
    y, out :: Write
    out, True : diffs' :: [Bool]
    diffs') spanOps :: SpanOps
    spanOps
                = let spanOut :: Write
    spanOut = Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write
    writeSpanOps Bool
    urlsEnabled DisplayContext
    dc Int
    y FixedAttr
    initialAttr SpanOps
    spanOps
                      out' :: Write
    out' = Write
    out Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Write
    spanOut
                  in (Int
    yInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1, Write
    out', [Bool]
    diffs')
            writeOutputOps' (y :: Int
    y, out :: Write
    out, False : diffs' :: [Bool]
    diffs') _spanOps :: SpanOps
    _spanOps
                = (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1, Write
    out, [Bool]
    diffs')
            writeOutputOps' (_y :: Int
    _y, _out :: Write
    _out, []) _spanOps :: SpanOps
    _spanOps
                = String -> (Int, Write, [Bool])
    forall a. HasCallStack => String -> a
    error "vty - output spans without a corresponding diff."

    writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write
    writeSpanOps :: Bool -> DisplayContext -> Int -> FixedAttr -> SpanOps -> Write
    writeSpanOps urlsEnabled :: Bool
    urlsEnabled dc :: DisplayContext
    dc y :: Int
    y initialAttr :: FixedAttr
    initialAttr spanOps :: SpanOps
    spanOps =
        -- The first operation is to set the cursor to the start of the row
        let start :: Write
    start = DisplayContext -> Int -> Int -> Write
    writeMoveCursor DisplayContext
    dc 0 Int
    y Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` DisplayContext -> Bool -> Write
    writeDefaultAttr DisplayContext
    dc Bool
    urlsEnabled
        -- then the span ops are serialized in the order specified
        in (Write, FixedAttr) -> Write
    forall a b. (a, b) -> a
    fst ((Write, FixedAttr) -> Write) -> (Write, FixedAttr) -> Write
    forall a b. (a -> b) -> a -> b
    $ ((Write, FixedAttr) -> SpanOp -> (Write, FixedAttr))
    -> (Write, FixedAttr) -> SpanOps -> (Write, FixedAttr)
    forall a b. (a -> b -> a) -> a -> Vector b -> a
    Vector.foldl' (\(out :: Write
    out, fattr :: FixedAttr
    fattr) op :: SpanOp
    op -> case Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)
    writeSpanOp Bool
    urlsEnabled DisplayContext
    dc SpanOp
    op FixedAttr
    fattr of
                                  (opOut :: Write
    opOut, fattr' :: FixedAttr
    fattr') -> (Write
    out Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Write
    opOut, FixedAttr
    fattr')
                               )
                               (Write
    start, FixedAttr
    initialAttr)
                               SpanOps
    spanOps

    writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)
    writeSpanOp :: Bool -> DisplayContext -> SpanOp -> FixedAttr -> (Write, FixedAttr)
    writeSpanOp urlsEnabled :: Bool
    urlsEnabled dc :: DisplayContext
    dc (TextSpan attr :: Attr
    attr _ _ str :: DisplayText
    str) fattr :: FixedAttr
    fattr =
        let attr' :: Attr
    attr' = Output -> Attr -> Attr
    limitAttrForDisplay (DisplayContext -> Output
    contextDevice DisplayContext
    dc) Attr
    attr
            fattr' :: FixedAttr
    fattr' = FixedAttr -> Attr -> FixedAttr
    fixDisplayAttr FixedAttr
    fattr Attr
    attr'
            diffs :: DisplayAttrDiff
    diffs = FixedAttr -> FixedAttr -> DisplayAttrDiff
    displayAttrDiffs FixedAttr
    fattr FixedAttr
    fattr'
            out :: Write
    out =  DisplayContext
    -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write
    writeSetAttr DisplayContext
    dc Bool
    urlsEnabled FixedAttr
    fattr Attr
    attr' DisplayAttrDiff
    diffs
                   Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` ByteString -> Write
    writeUtf8Text (Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $ DisplayText -> Text
    TL.toStrict DisplayText
    str)
        in (Write
    out, FixedAttr
    fattr')
    writeSpanOp _ _ (Skip _) _fattr :: FixedAttr
    _fattr = String -> (Write, FixedAttr)
    forall a. HasCallStack => String -> a
    error "writeSpanOp for Skip"
    writeSpanOp urlsEnabled :: Bool
    urlsEnabled dc :: DisplayContext
    dc (RowEnd _) fattr :: FixedAttr
    fattr = (DisplayContext -> Bool -> Write
    writeDefaultAttr DisplayContext
    dc Bool
    urlsEnabled Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` DisplayContext -> Write
    writeRowEnd DisplayContext
    dc, FixedAttr
    fattr)

    -- | The cursor position is given in X,Y character offsets. Due to
    -- multi-column characters this needs to be translated to column, row
    -- positions.
    data CursorOutputMap = CursorOutputMap
        { CursorOutputMap -> DisplayRegion -> DisplayRegion
    charToOutputPos :: (Int, Int) -> (Int, Int)
        }

    cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap
    cursorOutputMap :: DisplayOps -> Cursor -> CursorOutputMap
    cursorOutputMap spanOps :: DisplayOps
    spanOps _cursor :: Cursor
    _cursor = CursorOutputMap :: (DisplayRegion -> DisplayRegion) -> CursorOutputMap
    CursorOutputMap
        { charToOutputPos :: DisplayRegion -> DisplayRegion
    charToOutputPos = \(cx :: Int
    cx, cy :: Int
    cy) -> (DisplayOps -> Int -> Int -> Int
    cursorColumnOffset DisplayOps
    spanOps Int
    cx Int
    cy, Int
    cy)
        }

    cursorColumnOffset :: DisplayOps -> Int -> Int -> Int
    cursorColumnOffset :: DisplayOps -> Int -> Int -> Int
    cursorColumnOffset ops :: DisplayOps
    ops cx :: Int
    cx cy :: Int
    cy =
        let cursorRowOps :: SpanOps
    cursorRowOps = DisplayOps -> Int -> SpanOps
    forall a. Vector a -> Int -> a
    Vector.unsafeIndex DisplayOps
    ops (Int -> Int
    forall a. Enum a => a -> Int
    fromEnum Int
    cy)
            (outOffset :: Int
    outOffset, _, _)
                = ((Int, Int, Bool) -> SpanOp -> (Int, Int, Bool))
    -> (Int, Int, Bool) -> SpanOps -> (Int, Int, Bool)
    forall a b. (a -> b -> a) -> a -> Vector b -> a
    Vector.foldl' ( \(d :: Int
    d, currentCx :: Int
    currentCx, done :: Bool
    done) op :: SpanOp
    op ->
                            if Bool
    done then (Int
    d, Int
    currentCx, Bool
    done) else case SpanOp -> Maybe DisplayRegion
    spanOpHasWidth SpanOp
    op of
                                Nothing -> (Int
    d, Int
    currentCx, Bool
    False)
                                Just (cw :: Int
    cw, ow :: Int
    ow) -> case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    cx (Int
    currentCx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    cw) of
                                        GT -> ( Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    ow
                                              , Int
    currentCx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    cw
                                              , Bool
    False
                                              )
                                        EQ -> ( Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    ow
                                              , Int
    currentCx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    cw
                                              , Bool
    True
                                              )
                                        LT -> ( Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> SpanOp -> Int
    columnsToCharOffset (Int
    cx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    currentCx) SpanOp
    op
                                              , Int
    currentCx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    cw
                                              , Bool
    True
                                              )
                          )
                          (0, 0, Bool
    False)
                          SpanOps
    cursorRowOps
        in Int
    outOffset

    -- | Not all terminals support all display attributes. This filters a
    -- display attribute to what the given terminal can display.
    limitAttrForDisplay :: Output -> Attr -> Attr
    limitAttrForDisplay :: Output -> Attr -> Attr
    limitAttrForDisplay t :: Output
    t attr :: Attr
    attr
        = Attr
    attr { attrForeColor :: MaybeDefault Color
    attrForeColor = MaybeDefault Color -> MaybeDefault Color
    clampColor (MaybeDefault Color -> MaybeDefault Color)
    -> MaybeDefault Color -> MaybeDefault Color
    forall a b. (a -> b) -> a -> b
    $ Attr -> MaybeDefault Color
    attrForeColor Attr
    attr
               , attrBackColor :: MaybeDefault Color
    attrBackColor = MaybeDefault Color -> MaybeDefault Color
    clampColor (MaybeDefault Color -> MaybeDefault Color)
    -> MaybeDefault Color -> MaybeDefault Color
    forall a b. (a -> b) -> a -> b
    $ Attr -> MaybeDefault Color
    attrBackColor Attr
    attr
               }
        where
            clampColor :: MaybeDefault Color -> MaybeDefault Color
    clampColor Default     = MaybeDefault Color
    forall v. MaybeDefault v
    Default
            clampColor KeepCurrent = MaybeDefault Color
    forall v. MaybeDefault v
    KeepCurrent
            clampColor (SetTo c :: Color
    c)   = Color -> MaybeDefault Color
    clampColor' Color
    c
            clampColor' :: Color -> MaybeDefault Color
    clampColor' (ISOColor v :: Style
    v)
                | Output -> Int
    contextColorCount Output
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 8            = MaybeDefault Color
    forall v. MaybeDefault v
    Default
                | Output -> Int
    contextColorCount Output
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 16 Bool -> Bool -> Bool
    && Style
    v Style -> Style -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 8 = Color -> MaybeDefault Color
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo (Color -> MaybeDefault Color) -> Color -> MaybeDefault Color
    forall a b. (a -> b) -> a -> b
    $ Style -> Color
    ISOColor (Style
    v Style -> Style -> Style
    forall a. Num a => a -> a -> a
    - 8)
                | Bool
    otherwise                          = Color -> MaybeDefault Color
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo (Color -> MaybeDefault Color) -> Color -> MaybeDefault Color
    forall a b. (a -> b) -> a -> b
    $ Style -> Color
    ISOColor Style
    v
            clampColor' (Color240 v :: Style
    v)
                -- Should we choose closest ISO color?
                | Output -> Int
    contextColorCount Output
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <  8           = MaybeDefault Color
    forall v. MaybeDefault v
    Default
                | Output -> Int
    contextColorCount Output
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <  16          = MaybeDefault Color
    forall v. MaybeDefault v
    Default
                | Output -> Int
    contextColorCount Output
    t Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 256         = Color -> MaybeDefault Color
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo (Color -> MaybeDefault Color) -> Color -> MaybeDefault Color
    forall a b. (a -> b) -> a -> b
    $ Style -> Color
    Color240 Style
    v
                | Bool
    otherwise
                    = let Double
    p :: Double = Style -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Style
    v Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 240.0
                          v' :: Style
    v' = Double -> Style
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Style) -> Double -> Style
    forall a b. (a -> b) -> a -> b
    $ Double
    p Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Double) -> Int -> Double
    forall a b. (a -> b) -> a -> b
    $ Output -> Int
    contextColorCount Output
    t)
                      in Color -> MaybeDefault Color
    forall v. (Eq v, Show v, Read v) => v -> MaybeDefault v
    SetTo (Color -> MaybeDefault Color) -> Color -> MaybeDefault Color
    forall a b. (a -> b) -> a -> b
    $ Style -> Color
    Color240 Style
    v'