    -- Copyright Corey O'Connor<coreyoconnor@gmail.com>
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE TemplateHaskell #-}

    -- | Transforms an image into rows of operations.
    module Graphics.Vty.PictureToSpans where

    import Graphics.Vty.Attributes (Attr, currentAttr)
    import Graphics.Vty.Image
    import Graphics.Vty.Image.Internal
    import Graphics.Vty.Picture
    import Graphics.Vty.Span

    import Lens.Micro
    import Lens.Micro.Mtl
    import Lens.Micro.TH
    import Control.Monad.Reader
    import Control.Monad.State.Strict hiding ( state )
    import Control.Monad.ST.Strict

    import qualified Data.Vector as Vector hiding ( take, replicate )
    import Data.Vector.Mutable ( MVector(..))
    import qualified Data.Vector.Mutable as MVector

    import qualified Data.Text.Lazy as TL

    type MRowOps s = MVector s SpanOps

    type MSpanOps s = MVector s SpanOp

    -- transform plus clip. More or less.
    data BlitState = BlitState
        -- we always snoc to the operation vectors. Thus the columnOffset =
        -- length of row at rowOffset although, one possibility is to merge
        -- layers right in snocOp (naming it something else, of course). In
        -- which case columnnOffset would be applicable. Right now we need
        -- it to exist.
        { BlitState -> Int
    _columnOffset :: Int
        , BlitState -> Int
    _rowOffset :: Int
        -- clip coordinate space is in image space. Which means it's >= 0
        -- and < imageWidth.
        , BlitState -> Int
    _skipColumns :: Int
        -- >= 0 and < imageHeight
        , BlitState -> Int
    _skipRows :: Int
        -- includes consideration of skipColumns. In display space. The
        -- number of columns from the next column to be defined to the end
        -- of the display for the row.
        , BlitState -> Int
    _remainingColumns :: Int
        -- includes consideration of skipRows. In display space.
        , BlitState -> Int
    _remainingRows :: Int
        }

    makeLenses ''BlitState

    data BlitEnv s = BlitEnv
        { BlitEnv s -> DisplayRegion
    _region :: DisplayRegion
        , BlitEnv s -> MRowOps s
    _mrowOps :: MRowOps s
        }

    makeLenses ''BlitEnv

    type BlitM s a = ReaderT (BlitEnv s) (StateT BlitState (ST s)) a

    -- | Produces the span ops that will render the given picture, possibly
    -- cropped or padded, into the specified region.
    displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps
    displayOpsForPic :: Picture -> DisplayRegion -> DisplayOps
    displayOpsForPic pic :: Picture
    pic r :: DisplayRegion
    r = (forall s. ST s (MVector s SpanOps)) -> DisplayOps
    forall a. (forall s. ST s (MVector s a)) -> Vector a
    Vector.create (Picture -> DisplayRegion -> ST s (MRowOps s)
    forall s. Picture -> DisplayRegion -> ST s (MRowOps s)
    combinedOpsForLayers Picture
    pic DisplayRegion
    r)

    -- | Returns the DisplayOps for an image rendered to a window the size
    -- of the image.
    --
    -- largerly used only for debugging.
    displayOpsForImage :: Image -> DisplayOps
    displayOpsForImage :: Image -> DisplayOps
    displayOpsForImage i :: Image
    i = Picture -> DisplayRegion -> DisplayOps
    displayOpsForPic (Image -> Picture
    picForImage Image
    i) (Image -> Int
    imageWidth Image
    i, Image -> Int
    imageHeight Image
    i)

    -- | Produces the span ops for each layer then combines them.
    combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)
    combinedOpsForLayers :: Picture -> DisplayRegion -> ST s (MRowOps s)
    combinedOpsForLayers pic :: Picture
    pic r :: DisplayRegion
    r
        | DisplayRegion -> Int
    regionWidth DisplayRegion
    r Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 Bool -> Bool -> Bool
    || DisplayRegion -> Int
    regionHeight DisplayRegion
    r Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 = Int -> ST s (MVector (PrimState (ST s)) SpanOps)
    forall (m :: * -> *) a.
    PrimMonad m =>
    Int -> m (MVector (PrimState m) a)
    MVector.new 0
        | Bool
    otherwise = do
            [MRowOps s]
    layerOps <- (Image -> ST s (MRowOps s)) -> [Image] -> ST s [MRowOps s]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\layer :: Image
    layer -> Image -> DisplayRegion -> ST s (MRowOps s)
    forall s. Image -> DisplayRegion -> ST s (MRowOps s)
    buildSpans Image
    layer DisplayRegion
    r) (Picture -> [Image]
    picLayers Picture
    pic)
            case [MRowOps s]
    layerOps of
                []    -> String -> ST s (MRowOps s)
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "empty picture"
                [ops :: MRowOps s
    ops] -> Background -> MRowOps s -> ST s (MRowOps s)
    forall s. Background -> MRowOps s -> ST s (MRowOps s)
    substituteSkips (Picture -> Background
    picBackground Picture
    pic) MRowOps s
    ops
                -- instead of merging ops after generation the merging can
                -- be performed as part of snocOp.
                topOps :: MRowOps s
    topOps : lowerOps :: [MRowOps s]
    lowerOps -> do
                    MRowOps s
    ops <- (MRowOps s -> MRowOps s -> ST s (MRowOps s))
    -> MRowOps s -> [MRowOps s] -> ST s (MRowOps s)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM MRowOps s -> MRowOps s -> ST s (MRowOps s)
    forall s. MRowOps s -> MRowOps s -> ST s (MRowOps s)
    mergeUnder MRowOps s
    topOps [MRowOps s]
    lowerOps
                    Background -> MRowOps s -> ST s (MRowOps s)
    forall s. Background -> MRowOps s -> ST s (MRowOps s)
    substituteSkips (Picture -> Background
    picBackground Picture
    pic) MRowOps s
    ops

    substituteSkips :: Background -> MRowOps s -> ST s (MRowOps s)
    substituteSkips :: Background -> MRowOps s -> ST s (MRowOps s)
    substituteSkips ClearBackground ops :: MRowOps s
    ops = do
        [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [0 .. MRowOps s -> Int
    forall s a. MVector s a -> Int
    MVector.length MRowOps s
    ops Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \row :: Int
    row -> do
            SpanOps
    rowOps <- MVector (PrimState (ST s)) SpanOps -> Int -> ST s SpanOps
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> m a
    MVector.read MRowOps s
    MVector (PrimState (ST s)) SpanOps
    ops Int
    row
            -- the image operations assure that background fills are
            -- combined. clipping a background fill does not split the
            -- background fill. merging of image layers can split a skip,
            -- but only by the insertion of a non skip. all this combines to
            -- mean we can check the last operation and remove it if it's a
            -- skip
            let rowOps' :: SpanOps
    rowOps' = case SpanOps -> SpanOp
    forall a. Vector a -> a
    Vector.last SpanOps
    rowOps of
                            Skip w :: Int
    w -> SpanOps -> SpanOps
    forall a. Vector a -> Vector a
    Vector.init SpanOps
    rowOps SpanOps -> SpanOp -> SpanOps
    forall a. Vector a -> a -> Vector a
    `Vector.snoc` Int -> SpanOp
    RowEnd Int
    w
                            _      -> SpanOps
    rowOps
            -- now all the skips can be replaced by replications of ' ' of
            -- the required width.
            let rowOps'' :: SpanOps
    rowOps'' = Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForSingleColumnCharSpan ' ' Attr
    currentAttr SpanOps
    rowOps'
            MVector (PrimState (ST s)) SpanOps -> Int -> SpanOps -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> a -> m ()
    MVector.write MRowOps s
    MVector (PrimState (ST s)) SpanOps
    ops Int
    row SpanOps
    rowOps''
        MRowOps s -> ST s (MRowOps s)
    forall (m :: * -> *) a. Monad m => a -> m a
    return MRowOps s
    ops
    substituteSkips (Background {Char
    backgroundChar :: Background -> Char
    backgroundChar :: Char
    backgroundChar, Attr
    backgroundAttr :: Background -> Attr
    backgroundAttr :: Attr
    backgroundAttr}) ops :: MRowOps s
    ops = do
        -- At this point we decide if the background character is single
        -- column or not. obviously, single column is easier.
        case Char -> Int
    safeWcwidth Char
    backgroundChar of
            w :: Int
    w | Int
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 -> String -> ST s ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> ST s ()) -> String -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ "invalid background character " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char -> String
    forall a. Show a => a -> String
    show Char
    backgroundChar
              | Int
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 -> do
                    [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [0 .. MRowOps s -> Int
    forall s a. MVector s a -> Int
    MVector.length MRowOps s
    ops Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \row :: Int
    row -> do
                        SpanOps
    rowOps <- MVector (PrimState (ST s)) SpanOps -> Int -> ST s SpanOps
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> m a
    MVector.read MRowOps s
    MVector (PrimState (ST s)) SpanOps
    ops Int
    row
                        let rowOps' :: SpanOps
    rowOps' = Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForSingleColumnCharSpan Char
    backgroundChar Attr
    backgroundAttr SpanOps
    rowOps
                        MVector (PrimState (ST s)) SpanOps -> Int -> SpanOps -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> a -> m ()
    MVector.write MRowOps s
    MVector (PrimState (ST s)) SpanOps
    ops Int
    row SpanOps
    rowOps'
              | Bool
    otherwise -> do
                    [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [0 .. MRowOps s -> Int
    forall s a. MVector s a -> Int
    MVector.length MRowOps s
    ops Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \row :: Int
    row -> do
                        SpanOps
    rowOps <- MVector (PrimState (ST s)) SpanOps -> Int -> ST s SpanOps
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> m a
    MVector.read MRowOps s
    MVector (PrimState (ST s)) SpanOps
    ops Int
    row
                        let rowOps' :: SpanOps
    rowOps' = Int -> Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForCharSpan Int
    w Char
    backgroundChar Attr
    backgroundAttr SpanOps
    rowOps
                        MVector (PrimState (ST s)) SpanOps -> Int -> SpanOps -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> a -> m ()
    MVector.write MRowOps s
    MVector (PrimState (ST s)) SpanOps
    ops Int
    row SpanOps
    rowOps'
        MRowOps s -> ST s (MRowOps s)
    forall (m :: * -> *) a. Monad m => a -> m a
    return MRowOps s
    ops

    mergeUnder :: MRowOps s -> MRowOps s -> ST s (MRowOps s)
    mergeUnder :: MRowOps s -> MRowOps s -> ST s (MRowOps s)
    mergeUnder upper :: MRowOps s
    upper lower :: MRowOps s
    lower = do
        [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [0 .. MRowOps s -> Int
    forall s a. MVector s a -> Int
    MVector.length MRowOps s
    upper Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \row :: Int
    row -> do
            SpanOps
    upperRowOps <- MVector (PrimState (ST s)) SpanOps -> Int -> ST s SpanOps
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> m a
    MVector.read MRowOps s
    MVector (PrimState (ST s)) SpanOps
    upper Int
    row
            SpanOps
    lowerRowOps <- MVector (PrimState (ST s)) SpanOps -> Int -> ST s SpanOps
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> m a
    MVector.read MRowOps s
    MVector (PrimState (ST s)) SpanOps
    lower Int
    row
            let rowOps :: SpanOps
    rowOps = SpanOps -> SpanOps -> SpanOps
    mergeRowUnder SpanOps
    upperRowOps SpanOps
    lowerRowOps
            MVector (PrimState (ST s)) SpanOps -> Int -> SpanOps -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> a -> m ()
    MVector.write MRowOps s
    MVector (PrimState (ST s)) SpanOps
    upper Int
    row SpanOps
    rowOps
        MRowOps s -> ST s (MRowOps s)
    forall (m :: * -> *) a. Monad m => a -> m a
    return MRowOps s
    upper

    mergeRowUnder :: SpanOps -> SpanOps -> SpanOps
    mergeRowUnder :: SpanOps -> SpanOps -> SpanOps
    mergeRowUnder upperRowOps :: SpanOps
    upperRowOps lowerRowOps :: SpanOps
    lowerRowOps =
        SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps
    onUpperOp SpanOps
    forall a. Vector a
    Vector.empty (SpanOps -> SpanOp
    forall a. Vector a -> a
    Vector.head SpanOps
    upperRowOps) (SpanOps -> SpanOps
    forall a. Vector a -> Vector a
    Vector.tail SpanOps
    upperRowOps) SpanOps
    lowerRowOps
        where
            -- H: it will never be the case that we are out of upper ops
            -- before lower ops.
            onUpperOp :: SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps
            onUpperOp :: SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps
    onUpperOp outOps :: SpanOps
    outOps op :: SpanOp
    op@(TextSpan _ w :: Int
    w _ _) upperOps :: SpanOps
    upperOps lowerOps :: SpanOps
    lowerOps =
                let lowerOps' :: SpanOps
    lowerOps' = Int -> SpanOps -> SpanOps
    dropOps Int
    w SpanOps
    lowerOps
                    outOps' :: SpanOps
    outOps' = SpanOps -> SpanOp -> SpanOps
    forall a. Vector a -> a -> Vector a
    Vector.snoc SpanOps
    outOps SpanOp
    op
                in if SpanOps -> Bool
    forall a. Vector a -> Bool
    Vector.null SpanOps
    lowerOps'
                    then SpanOps
    outOps'
                    else SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps
    onUpperOp SpanOps
    outOps' (SpanOps -> SpanOp
    forall a. Vector a -> a
    Vector.head SpanOps
    upperOps) (SpanOps -> SpanOps
    forall a. Vector a -> Vector a
    Vector.tail SpanOps
    upperOps) SpanOps
    lowerOps'
            onUpperOp outOps :: SpanOps
    outOps (Skip w :: Int
    w) upperOps :: SpanOps
    upperOps lowerOps :: SpanOps
    lowerOps =
                let (ops' :: SpanOps
    ops', lowerOps' :: SpanOps
    lowerOps') = Int -> SpanOps -> (SpanOps, SpanOps)
    splitOpsAt Int
    w SpanOps
    lowerOps
                    outOps' :: SpanOps
    outOps' = SpanOps
    outOps SpanOps -> SpanOps -> SpanOps
    forall a. Monoid a => a -> a -> a
    `mappend` SpanOps
    ops'
                in if SpanOps -> Bool
    forall a. Vector a -> Bool
    Vector.null SpanOps
    lowerOps'
                    then SpanOps
    outOps'
                    else SpanOps -> SpanOp -> SpanOps -> SpanOps -> SpanOps
    onUpperOp SpanOps
    outOps' (SpanOps -> SpanOp
    forall a. Vector a -> a
    Vector.head SpanOps
    upperOps) (SpanOps -> SpanOps
    forall a. Vector a -> Vector a
    Vector.tail SpanOps
    upperOps) SpanOps
    lowerOps'
            onUpperOp _ (RowEnd _) _ _ = String -> SpanOps
    forall a. HasCallStack => String -> a
    error "cannot merge rows containing RowEnd ops"

    swapSkipsForSingleColumnCharSpan :: Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForSingleColumnCharSpan :: Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForSingleColumnCharSpan c :: Char
    c a :: Attr
    a = (SpanOp -> SpanOp) -> SpanOps -> SpanOps
    forall a b. (a -> b) -> Vector a -> Vector b
    Vector.map SpanOp -> SpanOp
    f
        where f :: SpanOp -> SpanOp
    f (Skip ow :: Int
    ow) = let txt :: Text
    txt = String -> Text
    TL.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    ow Char
    c
                            in Attr -> Int -> Int -> Text -> SpanOp
    TextSpan Attr
    a Int
    ow Int
    ow Text
    txt
              f v :: SpanOp
    v = SpanOp
    v

    swapSkipsForCharSpan :: Int -> Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForCharSpan :: Int -> Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForCharSpan w :: Int
    w c :: Char
    c a :: Attr
    a = (SpanOp -> SpanOp) -> SpanOps -> SpanOps
    forall a b. (a -> b) -> Vector a -> Vector b
    Vector.map SpanOp -> SpanOp
    f
        where
            f :: SpanOp -> SpanOp
    f (Skip ow :: Int
    ow) = let txt0Cw :: Int
    txt0Cw = Int
    ow Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    w
                              txt0 :: Text
    txt0 = String -> Text
    TL.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    txt0Cw Char
    c
                              txt1Cw :: Int
    txt1Cw = Int
    ow Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    w
                              txt1 :: Text
    txt1 = String -> Text
    TL.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    txt1Cw '…'
                              cw :: Int
    cw = Int
    txt0Cw Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    txt1Cw
                              txt :: Text
    txt = Text
    txt0 Text -> Text -> Text
    `TL.append` Text
    txt1
                          in Attr -> Int -> Int -> Text -> SpanOp
    TextSpan Attr
    a Int
    ow Int
    cw Text
    txt
            f v :: SpanOp
    v = SpanOp
    v

    -- | Builds a vector of row operations that will output the given
    -- picture to the terminal.
    --
    -- Crops to the given display region.
    buildSpans :: Image -> DisplayRegion -> ST s (MRowOps s)
    buildSpans :: Image -> DisplayRegion -> ST s (MRowOps s)
    buildSpans image :: Image
    image outRegion :: DisplayRegion
    outRegion = do
        -- First we create a mutable vector for each rows output operations.
        MRowOps s
    outOps <- Int -> SpanOps -> ST s (MVector (PrimState (ST s)) SpanOps)
    forall (m :: * -> *) a.
    PrimMonad m =>
    Int -> a -> m (MVector (PrimState m) a)
    MVector.replicate (DisplayRegion -> Int
    regionHeight DisplayRegion
    outRegion) SpanOps
    forall a. Vector a
    Vector.empty
        -- It's possible that building the span operations in display order
        -- would provide better performance.
        --
        -- A depth first traversal of the image is performed. ordered
        -- according to the column range defined by the image from least
        -- to greatest. The output row ops will at least have the region
        -- of the image specified. Iterate over all output rows and output
        -- background fills for all unspecified columns.
        --
        -- The images are made into span operations from left to right. It's
        -- possible that this could easily be made to assure top to bottom
        -- output as well.
        Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DisplayRegion -> Int
    regionHeight DisplayRegion
    outRegion Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 Bool -> Bool -> Bool
    && DisplayRegion -> Int
    regionWidth DisplayRegion
    outRegion Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0) (ST s () -> ST s ()) -> ST s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ do
            -- The ops builder recursively descends the image and outputs
            -- span ops that would display that image. The number of columns
            -- remaining in this row before exceeding the bounds is also
            -- provided. This is used to clip the span ops produced to the
            -- display.
            let fullBuild :: ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    fullBuild = do
                    Image -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. Image -> BlitM s ()
    startImageBuild Image
    image
                    -- Fill in any unspecified columns with a skip.
                    [Int]
    -> (Int -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [0 .. (DisplayRegion -> Int
    regionHeight DisplayRegion
    outRegion Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1)] (DisplayRegion
    -> Int -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. DisplayRegion -> Int -> BlitM s ()
    addRowCompletion DisplayRegion
    outRegion)
                initEnv :: BlitEnv s
    initEnv   = DisplayRegion -> MRowOps s -> BlitEnv s
    forall s. DisplayRegion -> MRowOps s -> BlitEnv s
    BlitEnv DisplayRegion
    outRegion MRowOps s
    outOps
                initState :: BlitState
    initState = Int -> Int -> Int -> Int -> Int -> Int -> BlitState
    BlitState 0 0 0 0 (DisplayRegion -> Int
    regionWidth DisplayRegion
    outRegion) (DisplayRegion -> Int
    regionHeight DisplayRegion
    outRegion)
            ((), BlitState)
    _ <- StateT BlitState (ST s) () -> BlitState -> ST s ((), BlitState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    -> BlitEnv s -> StateT BlitState (ST s) ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    fullBuild BlitEnv s
    initEnv) BlitState
    initState
            () -> ST s ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        MRowOps s -> ST s (MRowOps s)
    forall (m :: * -> *) a. Monad m => a -> m a
    return MRowOps s
    outOps

    -- | Add the operations required to build a given image to the current
    -- set of row operations.
    startImageBuild :: Image -> BlitM s ()
    startImageBuild :: Image -> BlitM s ()
    startImageBuild image :: Image
    image = do
        Bool
    outOfBounds <- Image -> BlitState -> Bool
    isOutOfBounds Image
    image (BlitState -> Bool)
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) BlitState
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT (BlitEnv s) (StateT BlitState (ST s)) BlitState
    forall s (m :: * -> *). MonadState s m => m s
    get
        Bool -> BlitM s () -> BlitM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    outOfBounds) (BlitM s () -> BlitM s ()) -> BlitM s () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    image

    isOutOfBounds :: Image -> BlitState -> Bool
    isOutOfBounds :: Image -> BlitState -> Bool
    isOutOfBounds i :: Image
    i s :: BlitState
    s
        | BlitState
    s BlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^. Getting Int BlitState Int
    Lens' BlitState Int
    remainingColumns Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0              = Bool
    True
        | BlitState
    s BlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^. Getting Int BlitState Int
    Lens' BlitState Int
    remainingRows    Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0              = Bool
    True
        | BlitState
    s BlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^. Getting Int BlitState Int
    Lens' BlitState Int
    skipColumns      Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Image -> Int
    imageWidth Image
    i  = Bool
    True
        | BlitState
    s BlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^. Getting Int BlitState Int
    Lens' BlitState Int
    skipRows         Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Image -> Int
    imageHeight Image
    i = Bool
    True
        | Bool
    otherwise = Bool
    False

    -- | This adds an image that might be partially clipped to the output
    -- ops.
    --
    -- This is a very touchy algorithm. Too touchy. For instance, the
    -- CropRight and CropBottom implementations are odd. They pass the
    -- current tests but something seems terribly wrong about all this.
    addMaybeClipped :: forall s . Image -> BlitM s ()
    addMaybeClipped :: Image -> BlitM s ()
    addMaybeClipped EmptyImage = () -> BlitM s ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    addMaybeClipped (HorizText a :: Attr
    a textStr :: Text
    textStr ow :: Int
    ow _cw :: Int
    _cw) = do
        -- This assumes that text spans are only 1 row high.
        Int
    s <- Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    skipRows
        Bool -> BlitM s () -> BlitM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 1) (BlitM s () -> BlitM s ()) -> BlitM s () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ do
            Int
    leftClip <- Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    skipColumns
            Int
    rightClip <- Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    remainingColumns
            let leftClipped :: Bool
    leftClipped = Int
    leftClip Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0
                rightClipped :: Bool
    rightClipped = (Int
    ow Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    leftClip) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    rightClip
            if Bool
    leftClipped Bool -> Bool -> Bool
    || Bool
    rightClipped
                then let textStr' :: Text
    textStr' = Text -> Int -> Int -> Text
    clipText Text
    textStr Int
    leftClip Int
    rightClip
                     in Attr -> Text -> BlitM s ()
    forall s. Attr -> Text -> BlitM s ()
    addUnclippedText Attr
    a Text
    textStr'
                else Attr -> Text -> BlitM s ()
    forall s. Attr -> Text -> BlitM s ()
    addUnclippedText Attr
    a Text
    textStr
    addMaybeClipped (VertJoin topImage :: Image
    topImage bottomImage :: Image
    bottomImage _ow :: Int
    _ow oh :: Int
    oh) = do
        Bool -> BlitM s () -> BlitM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Image -> Int
    imageHeight Image
    topImage Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Image -> Int
    imageHeight Image
    bottomImage Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0) (BlitM s () -> BlitM s ()) -> BlitM s () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $
            String
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> BlitM s ()
    forall s.
    String
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> BlitM s ()
    addMaybeClippedJoin "vert_join" Lens' BlitState Int
    skipRows Lens' BlitState Int
    remainingRows Lens' BlitState Int
    rowOffset
                                (Image -> Int
    imageHeight Image
    topImage)
                                Image
    topImage
                                Image
    bottomImage
                                Int
    oh
    addMaybeClipped (HorizJoin leftImage :: Image
    leftImage rightImage :: Image
    rightImage ow :: Int
    ow _oh :: Int
    _oh) = do
        Bool -> BlitM s () -> BlitM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Image -> Int
    imageWidth Image
    leftImage Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Image -> Int
    imageWidth Image
    rightImage Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0) (BlitM s () -> BlitM s ()) -> BlitM s () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $
            String
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> BlitM s ()
    forall s.
    String
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> BlitM s ()
    addMaybeClippedJoin "horiz_join" Lens' BlitState Int
    skipColumns Lens' BlitState Int
    remainingColumns Lens' BlitState Int
    columnOffset
                                (Image -> Int
    imageWidth Image
    leftImage)
                                Image
    leftImage
                                Image
    rightImage
                                Int
    ow
    addMaybeClipped BGFill {Int
    outputWidth :: Image -> Int
    outputWidth :: Int
    outputWidth, Int
    outputHeight :: Image -> Int
    outputHeight :: Int
    outputHeight} = do
        BlitState
    s <- ReaderT (BlitEnv s) (StateT BlitState (ST s)) BlitState
    forall s (m :: * -> *). MonadState s m => m s
    get
        let outputWidth' :: Int
    outputWidth'  = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int
    outputWidth  Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - BlitState
    sBlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^.Getting Int BlitState Int
    Lens' BlitState Int
    skipColumns) (BlitState
    sBlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^.Getting Int BlitState Int
    Lens' BlitState Int
    remainingColumns)
            outputHeight' :: Int
    outputHeight' = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int
    outputHeight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - BlitState
    sBlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^.Getting Int BlitState Int
    Lens' BlitState Int
    skipRows   ) (BlitState
    sBlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^.Getting Int BlitState Int
    Lens' BlitState Int
    remainingRows)
        Int
    y <- Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    rowOffset
        [Int] -> (Int -> BlitM s ()) -> BlitM s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    y..Int
    yInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    outputHeight'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -1] ((Int -> BlitM s ()) -> BlitM s ())
    -> (Int -> BlitM s ()) -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ SpanOp -> Int -> BlitM s ()
    forall s. SpanOp -> Int -> BlitM s ()
    snocOp (Int -> SpanOp
    Skip Int
    outputWidth')
    addMaybeClipped CropRight {Image
    croppedImage :: Image -> Image
    croppedImage :: Image
    croppedImage, Int
    outputWidth :: Int
    outputWidth :: Image -> Int
    outputWidth} = do
        Int
    s <- Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    skipColumns
        Int
    r <- Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    remainingColumns
        let x :: Int
    x = Int
    outputWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    s
        Bool -> BlitM s () -> BlitM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    r) (BlitM s () -> BlitM s ()) -> BlitM s () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    remainingColumns ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> Int -> BlitM s ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= Int
    x
        Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    croppedImage
    addMaybeClipped CropLeft {Image
    croppedImage :: Image
    croppedImage :: Image -> Image
    croppedImage, Int
    leftSkip :: Image -> Int
    leftSkip :: Int
    leftSkip} = do
        (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    skipColumns ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> Int -> BlitM s ()
    forall s (m :: * -> *) a.
    (MonadState s m, Num a) =>
    ASetter s s a a -> a -> m ()
    += Int
    leftSkip
        Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    croppedImage
    addMaybeClipped CropBottom {Image
    croppedImage :: Image
    croppedImage :: Image -> Image
    croppedImage, Int
    outputHeight :: Int
    outputHeight :: Image -> Int
    outputHeight} = do
        Int
    s <- Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    skipRows
        Int
    r <- Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    remainingRows
        let x :: Int
    x = Int
    outputHeight Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    s
        Bool -> BlitM s () -> BlitM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    r) (BlitM s () -> BlitM s ()) -> BlitM s () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    remainingRows ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> Int -> BlitM s ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    ASetter s s a b -> b -> m ()
    .= Int
    x
        Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    croppedImage
    addMaybeClipped CropTop {Image
    croppedImage :: Image
    croppedImage :: Image -> Image
    croppedImage, Int
    topSkip :: Image -> Int
    topSkip :: Int
    topSkip} = do
        (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    skipRows ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> Int -> BlitM s ()
    forall s (m :: * -> *) a.
    (MonadState s m, Num a) =>
    ASetter s s a a -> a -> m ()
    += Int
    topSkip
        Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    croppedImage

    addMaybeClippedJoin :: forall s . String
                           -> Lens BlitState BlitState Int Int
                           -> Lens BlitState BlitState Int Int
                           -> Lens BlitState BlitState Int Int
                           -> Int
                           -> Image
                           -> Image
                           -> Int
                           -> BlitM s ()
    addMaybeClippedJoin :: String
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> BlitM s ()
    addMaybeClippedJoin name :: String
    name skip :: Lens' BlitState Int
    skip remaining :: Lens' BlitState Int
    remaining offset :: Lens' BlitState Int
    offset i0Dim :: Int
    i0Dim i0 :: Image
    i0 i1 :: Image
    i1 size :: Int
    size = do
        BlitState
    state <- ReaderT (BlitEnv s) (StateT BlitState (ST s)) BlitState
    forall s (m :: * -> *). MonadState s m => m s
    get
        Bool -> BlitM s () -> BlitM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BlitState
    stateBlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^.Getting Int BlitState Int
    Lens' BlitState Int
    remaining Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0) (BlitM s () -> BlitM s ()) -> BlitM s () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ String -> BlitM s ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> BlitM s ()) -> String -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " with remaining <= 0"
        case BlitState
    stateBlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^.Getting Int BlitState Int
    Lens' BlitState Int
    skip of
            s :: Int
    s | Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    size -> BlitState -> BlitM s ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (BlitState -> BlitM s ()) -> BlitState -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ BlitState
    state BlitState -> (BlitState -> BlitState) -> BlitState
    forall a b. a -> (a -> b) -> b
    & (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    skip ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> (Int -> Int) -> BlitState -> BlitState
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ Int -> Int -> Int
    forall a. Num a => a -> a -> a
    subtract Int
    size
              | Int
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0    -> if BlitState
    stateBlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^.Getting Int BlitState Int
    Lens' BlitState Int
    remaining Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    i0Dim
                                then do
                                    Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i0
                                    BlitState -> BlitM s ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (BlitState -> BlitM s ()) -> BlitState -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ BlitState
    state BlitState -> (BlitState -> BlitState) -> BlitState
    forall a b. a -> (a -> b) -> b
    & (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    offset ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> (Int -> Int) -> BlitState -> BlitState
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i0Dim) BlitState -> (BlitState -> BlitState) -> BlitState
    forall a b. a -> (a -> b) -> b
    & (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    remaining ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> (Int -> Int) -> BlitState -> BlitState
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ Int -> Int -> Int
    forall a. Num a => a -> a -> a
    subtract Int
    i0Dim
                                    Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i1
                                else Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i0
              | Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    i0Dim  ->
                    let i0Dim' :: Int
    i0Dim' = Int
    i0Dim Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    s
                    in if BlitState
    stateBlitState -> Getting Int BlitState Int -> Int
    forall s a. s -> Getting a s a -> a
    ^.Getting Int BlitState Int
    Lens' BlitState Int
    remaining Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    i0Dim'
                        then Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i0
                        else do
                            Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i0
                            BlitState -> BlitM s ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (BlitState -> BlitM s ()) -> BlitState -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ BlitState
    state BlitState -> (BlitState -> BlitState) -> BlitState
    forall a b. a -> (a -> b) -> b
    & (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    offset ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> (Int -> Int) -> BlitState -> BlitState
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i0Dim') BlitState -> (BlitState -> BlitState) -> BlitState
    forall a b. a -> (a -> b) -> b
    & (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    remaining ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> (Int -> Int) -> BlitState -> BlitState
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ Int -> Int -> Int
    forall a. Num a => a -> a -> a
    subtract Int
    i0Dim' BlitState -> (BlitState -> BlitState) -> BlitState
    forall a b. a -> (a -> b) -> b
    & (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    skip ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> Int -> BlitState -> BlitState
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ 0
                            Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i1
              | Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    i0Dim -> do
                    BlitState -> BlitM s ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (BlitState -> BlitM s ()) -> BlitState -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ BlitState
    state BlitState -> (BlitState -> BlitState) -> BlitState
    forall a b. a -> (a -> b) -> b
    & (Int -> Identity Int) -> BlitState -> Identity BlitState
    Lens' BlitState Int
    skip ((Int -> Identity Int) -> BlitState -> Identity BlitState)
    -> (Int -> Int) -> BlitState -> BlitState
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~ Int -> Int -> Int
    forall a. Num a => a -> a -> a
    subtract Int
    i0Dim
                    Image -> BlitM s ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i1
            _ -> String -> BlitM s ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> BlitM s ()) -> String -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " has unhandled skip class"

    addUnclippedText :: Attr -> DisplayText -> BlitM s ()
    addUnclippedText :: Attr -> Text -> BlitM s ()
    addUnclippedText a :: Attr
    a txt :: Text
    txt = do
        let op :: SpanOp
    op = Attr -> Int -> Int -> Text -> SpanOp
    TextSpan Attr
    a Int
    usedDisplayColumns
                          (Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ Text -> Int64
    TL.length Text
    txt)
                          Text
    txt
            usedDisplayColumns :: Int
    usedDisplayColumns = Text -> Int
    wctlwidth Text
    txt
        Getting Int BlitState Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
    use Getting Int BlitState Int
    Lens' BlitState Int
    rowOffset ReaderT (BlitEnv s) (StateT BlitState (ST s)) Int
    -> (Int -> BlitM s ()) -> BlitM s ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= SpanOp -> Int -> BlitM s ()
    forall s. SpanOp -> Int -> BlitM s ()
    snocOp SpanOp
    op

    addRowCompletion :: DisplayRegion -> Int -> BlitM s ()
    addRowCompletion :: DisplayRegion -> Int -> BlitM s ()
    addRowCompletion displayRegion :: DisplayRegion
    displayRegion row :: Int
    row = do
        MRowOps s
    allRowOps <- Getting (MRowOps s) (BlitEnv s) (MRowOps s)
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) (MRowOps s)
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (MRowOps s) (BlitEnv s) (MRowOps s)
    forall s s. Lens (BlitEnv s) (BlitEnv s) (MRowOps s) (MRowOps s)
    mrowOps
        SpanOps
    rowOps <- StateT BlitState (ST s) SpanOps
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) SpanOps
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT BlitState (ST s) SpanOps
     -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) SpanOps)
    -> StateT BlitState (ST s) SpanOps
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) SpanOps
    forall a b. (a -> b) -> a -> b
    $ ST s SpanOps -> StateT BlitState (ST s) SpanOps
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s SpanOps -> StateT BlitState (ST s) SpanOps)
    -> ST s SpanOps -> StateT BlitState (ST s) SpanOps
    forall a b. (a -> b) -> a -> b
    $ MVector (PrimState (ST s)) SpanOps -> Int -> ST s SpanOps
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> m a
    MVector.read MRowOps s
    MVector (PrimState (ST s)) SpanOps
    allRowOps Int
    row
        let endX :: Int
    endX = SpanOps -> Int
    spanOpsAffectedColumns SpanOps
    rowOps
        Bool -> BlitM s () -> BlitM s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    endX Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < DisplayRegion -> Int
    regionWidth DisplayRegion
    displayRegion) (BlitM s () -> BlitM s ()) -> BlitM s () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ do
            let ow :: Int
    ow = DisplayRegion -> Int
    regionWidth DisplayRegion
    displayRegion Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    endX
            SpanOp -> Int -> BlitM s ()
    forall s. SpanOp -> Int -> BlitM s ()
    snocOp (Int -> SpanOp
    Skip Int
    ow) Int
    row

    -- | snocs the operation to the operations for the given row.
    snocOp :: SpanOp -> Int -> BlitM s ()
    snocOp :: SpanOp -> Int -> BlitM s ()
    snocOp !SpanOp
    op !Int
    row = do
        MRowOps s
    theMrowOps <- Getting (MRowOps s) (BlitEnv s) (MRowOps s)
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) (MRowOps s)
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting (MRowOps s) (BlitEnv s) (MRowOps s)
    forall s s. Lens (BlitEnv s) (BlitEnv s) (MRowOps s) (MRowOps s)
    mrowOps
        DisplayRegion
    theRegion <- Getting DisplayRegion (BlitEnv s) DisplayRegion
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) DisplayRegion
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting DisplayRegion (BlitEnv s) DisplayRegion
    forall s. Lens' (BlitEnv s) DisplayRegion
    region
        StateT BlitState (ST s) () -> BlitM s ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT BlitState (ST s) () -> BlitM s ())
    -> StateT BlitState (ST s) () -> BlitM s ()
    forall a b. (a -> b) -> a -> b
    $ ST s () -> StateT BlitState (ST s) ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> StateT BlitState (ST s) ())
    -> ST s () -> StateT BlitState (ST s) ()
    forall a b. (a -> b) -> a -> b
    $ do
            SpanOps
    ops <- MVector (PrimState (ST s)) SpanOps -> Int -> ST s SpanOps
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> m a
    MVector.read MRowOps s
    MVector (PrimState (ST s)) SpanOps
    theMrowOps Int
    row
            let ops' :: SpanOps
    ops' = SpanOps -> SpanOp -> SpanOps
    forall a. Vector a -> a -> Vector a
    Vector.snoc SpanOps
    ops SpanOp
    op
            Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SpanOps -> Int
    spanOpsAffectedColumns SpanOps
    ops' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > DisplayRegion -> Int
    regionWidth DisplayRegion
    theRegion)
                 (ST s () -> ST s ()) -> ST s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ String -> ST s ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> ST s ()) -> String -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ "row " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    row String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " now exceeds region width"
            MVector (PrimState (ST s)) SpanOps -> Int -> SpanOps -> ST s ()
    forall (m :: * -> *) a.
    PrimMonad m =>
    MVector (PrimState m) a -> Int -> a -> m ()
    MVector.write MRowOps s
    MVector (PrimState (ST s)) SpanOps
    theMrowOps Int
    row SpanOps
    ops'