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

    -- | Transforms an image into rows of operations.
    module Graphics.Vty.PictureToSpans
      ( displayOpsForPic
      )
    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 Control.Monad
    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

    -- 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
        }

    columnOffset :: Lens' BlitState Int
    columnOffset :: Lens' BlitState Int
    columnOffset = (BlitState -> Int)
    -> (BlitState -> Int -> BlitState) -> Lens' BlitState Int
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens BlitState -> Int
    _columnOffset (\BlitState
    e Int
    v -> BlitState
    e { _columnOffset = v })

    rowOffset :: Lens' BlitState Int
    rowOffset :: Lens' BlitState Int
    rowOffset = (BlitState -> Int)
    -> (BlitState -> Int -> BlitState) -> Lens' BlitState Int
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens BlitState -> Int
    _rowOffset (\BlitState
    e Int
    v -> BlitState
    e { _rowOffset = v })

    skipColumns :: Lens' BlitState Int
    skipColumns :: Lens' BlitState Int
    skipColumns = (BlitState -> Int)
    -> (BlitState -> Int -> BlitState) -> Lens' BlitState Int
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens BlitState -> Int
    _skipColumns (\BlitState
    e Int
    v -> BlitState
    e { _skipColumns = v })

    skipRows :: Lens' BlitState Int
    skipRows :: Lens' BlitState Int
    skipRows = (BlitState -> Int)
    -> (BlitState -> Int -> BlitState) -> Lens' BlitState Int
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens BlitState -> Int
    _skipRows (\BlitState
    e Int
    v -> BlitState
    e { _skipRows = v })

    remainingColumns :: Lens' BlitState Int
    remainingColumns :: Lens' BlitState Int
    remainingColumns = (BlitState -> Int)
    -> (BlitState -> Int -> BlitState) -> Lens' BlitState Int
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens BlitState -> Int
    _remainingColumns (\BlitState
    e Int
    v -> BlitState
    e { _remainingColumns = v })

    remainingRows :: Lens' BlitState Int
    remainingRows :: Lens' BlitState Int
    remainingRows = (BlitState -> Int)
    -> (BlitState -> Int -> BlitState) -> Lens' BlitState Int
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens BlitState -> Int
    _remainingRows (\BlitState
    e Int
    v -> BlitState
    e { _remainingRows = v })

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

    region :: Lens' (BlitEnv s) DisplayRegion
    region :: forall s (f :: * -> *).
    Functor f =>
    (DisplayRegion -> f DisplayRegion) -> BlitEnv s -> f (BlitEnv s)
    region = (BlitEnv s -> DisplayRegion)
    -> (BlitEnv s -> DisplayRegion -> BlitEnv s)
    -> Lens (BlitEnv s) (BlitEnv s) DisplayRegion DisplayRegion
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens BlitEnv s -> DisplayRegion
    forall s. BlitEnv s -> DisplayRegion
    _region (\BlitEnv s
    e DisplayRegion
    r -> BlitEnv s
    e { _region = r })

    mrowOps :: Lens' (BlitEnv s) (MRowOps s)
    mrowOps :: forall s (f :: * -> *).
    Functor f =>
    (MRowOps s -> f (MRowOps s)) -> BlitEnv s -> f (BlitEnv s)
    mrowOps = (BlitEnv s -> MRowOps s)
    -> (BlitEnv s -> MRowOps s -> BlitEnv s)
    -> Lens (BlitEnv s) (BlitEnv s) (MRowOps s) (MRowOps s)
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens BlitEnv s -> MRowOps s
    forall s. BlitEnv s -> MRowOps s
    _mrowOps (\BlitEnv s
    e MRowOps s
    r -> BlitEnv s
    e { _mrowOps = r })

    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 Picture
    pic 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)

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

    substituteSkips :: Background -> MRowOps s -> ST s (MRowOps s)
    substituteSkips :: forall s. Background -> MRowOps s -> ST s (MRowOps s)
    substituteSkips Background
    ClearBackground 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_ [Int
    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
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    row -> do
            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' = case SpanOps -> SpanOp
    forall a. Vector a -> a
    Vector.last SpanOps
    rowOps of
                            Skip 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
                            SpanOp
    _      -> SpanOps
    rowOps
            -- now all the skips can be replaced by replications of ' ' of
            -- the required width.
            let rowOps'' = Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForSingleColumnCharSpan Char
    ' ' Attr
    currentAttr SpanOps
    rowOps'
            MVector.write ops row rowOps''
        MRowOps s -> ST s (MRowOps s)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MRowOps s
    ops
    substituteSkips (Background {Char
    backgroundChar :: Char
    backgroundChar :: Background -> Char
    backgroundChar, Attr
    backgroundAttr :: Attr
    backgroundAttr :: Background -> Attr
    backgroundAttr}) 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
            Int
    w | Int
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 -> [Char] -> ST s ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ST s ()) -> [Char] -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "invalid background character " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char -> [Char]
    forall a. Show a => a -> [Char]
    show Char
    backgroundChar
              | Int
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 -> do
                    [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    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
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    row -> do
                        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' = Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForSingleColumnCharSpan Char
    backgroundChar Attr
    backgroundAttr SpanOps
    rowOps
                        MVector.write ops row 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_ [Int
    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
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    row -> do
                        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' = Int -> Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForCharSpan Int
    w Char
    backgroundChar Attr
    backgroundAttr SpanOps
    rowOps
                        MVector.write ops row rowOps'
        MRowOps s -> ST s (MRowOps s)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MRowOps s
    ops

    mergeUnder :: MRowOps s -> MRowOps s -> ST s (MRowOps s)
    mergeUnder :: forall s. MRowOps s -> MRowOps s -> ST s (MRowOps s)
    mergeUnder MRowOps s
    upper 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_ [Int
    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
    - Int
    1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    row -> do
            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
            lowerRowOps <- MVector.read lower row
            let rowOps = SpanOps -> SpanOps -> SpanOps
    mergeRowUnder SpanOps
    upperRowOps SpanOps
    lowerRowOps
            MVector.write upper row rowOps
        MRowOps s -> ST s (MRowOps s)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return MRowOps s
    upper

    mergeRowUnder :: SpanOps -> SpanOps -> SpanOps
    mergeRowUnder :: SpanOps -> SpanOps -> SpanOps
    mergeRowUnder SpanOps
    upperRowOps =
        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)
        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 SpanOps
    outOps op :: SpanOp
    op@(TextSpan Attr
    _ Int
    w Int
    _ Text
    _) SpanOps
    upperOps 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 SpanOps
    outOps (Skip Int
    w) SpanOps
    upperOps SpanOps
    lowerOps =
                let (SpanOps
    ops', 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 SpanOps
    _ (RowEnd Int
    _) SpanOps
    _ SpanOps
    _ = [Char] -> SpanOps
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "cannot merge rows containing RowEnd ops"

    swapSkipsForSingleColumnCharSpan :: Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForSingleColumnCharSpan :: Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForSingleColumnCharSpan Char
    c 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 Int
    ow) = let txt :: Text
    txt = [Char] -> Text
    TL.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> [Char]
    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 SpanOp
    v = SpanOp
    v

    swapSkipsForCharSpan :: Int -> Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForCharSpan :: Int -> Char -> Attr -> SpanOps -> SpanOps
    swapSkipsForCharSpan Int
    w Char
    c 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 Int
    ow) = let txt0Cw :: Int
    txt0Cw = Int
    ow Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    w
                              txt0 :: Text
    txt0 = [Char] -> Text
    TL.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> [Char]
    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 = [Char] -> Text
    TL.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate Int
    txt1Cw Char
    '…'
                              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 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 :: forall s. Image -> DisplayRegion -> ST s (MRowOps s)
    buildSpans Image
    image DisplayRegion
    outRegion = do
        -- First we create a mutable vector for each rows output operations.
        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.
        when (regionHeight outRegion > 0 && regionWidth outRegion > 0) $ 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 = 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_ [Int
    0 .. (DisplayRegion -> Int
    regionHeight DisplayRegion
    outRegion Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)] (DisplayRegion
    -> Int -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. DisplayRegion -> Int -> BlitM s ()
    addRowCompletion DisplayRegion
    outRegion)
                initEnv   = DisplayRegion -> MRowOps s -> BlitEnv s
    forall s. DisplayRegion -> MRowOps s -> BlitEnv s
    BlitEnv DisplayRegion
    outRegion MRowOps s
    outOps
                initState = Int -> Int -> Int -> Int -> Int -> Int -> BlitState
    BlitState Int
    0 Int
    0 Int
    0 Int
    0 (DisplayRegion -> Int
    regionWidth DisplayRegion
    outRegion) (DisplayRegion -> Int
    regionHeight DisplayRegion
    outRegion)
            _ <- runStateT (runReaderT fullBuild initEnv) initState
            return ()
        return outOps

    -- | Add the operations required to build a given image to the current
    -- set of row operations.
    startImageBuild :: Image -> BlitM s ()
    startImageBuild :: forall s. Image -> BlitM s ()
    startImageBuild Image
    image = do
        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
        when (not outOfBounds) $ addMaybeClipped image

    isOutOfBounds :: Image -> BlitState -> Bool
    isOutOfBounds :: Image -> BlitState -> Bool
    isOutOfBounds Image
    i 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
    <= Int
    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
    <= Int
    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
    -- Crop implementations is odd. They pass the current tests but
    -- something seems terribly wrong about all this.
    --
    addMaybeClipped :: forall s . Image -> BlitM s ()
    addMaybeClipped :: forall s. Image -> BlitM s ()
    addMaybeClipped Image
    EmptyImage = () -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall a. a -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    addMaybeClipped (HorizText Attr
    a Text
    textStr Int
    ow Int
    _cw) = do
        -- This assumes that text spans are only 1 row high.
        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
        when (s < 1) $ do
            leftClip <- use skipColumns
            rightClip <- use remainingColumns
            let leftClipped = Int
    leftClip Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                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 leftClipped || rightClipped
                then let textStr' = Text -> Int -> Int -> Text
    clipText Text
    textStr Int
    leftClip Int
    rightClip
                     in addUnclippedText a textStr'
                else addUnclippedText a textStr
    addMaybeClipped (VertJoin Image
    topImage Image
    bottomImage Int
    _ow Int
    oh) = do
        Bool
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    -> ReaderT (BlitEnv s) (StateT BlitState (ST 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
    > Int
    0) (ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
     -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s.
    [Char]
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> BlitM s ()
    addMaybeClippedJoin [Char]
    "vert_join" (Int -> f Int) -> BlitState -> f BlitState
    Lens' BlitState Int
    skipRows (Int -> f Int) -> BlitState -> f BlitState
    Lens' BlitState Int
    remainingRows (Int -> f Int) -> BlitState -> f BlitState
    Lens' BlitState Int
    rowOffset
                                (Image -> Int
    imageHeight Image
    topImage)
                                Image
    topImage
                                Image
    bottomImage
                                Int
    oh
    addMaybeClipped (HorizJoin Image
    leftImage Image
    rightImage Int
    ow Int
    _oh) = do
        Bool
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    -> ReaderT (BlitEnv s) (StateT BlitState (ST 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
    > Int
    0) (ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
     -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s.
    [Char]
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> BlitM s ()
    addMaybeClippedJoin [Char]
    "horiz_join" (Int -> f Int) -> BlitState -> f BlitState
    Lens' BlitState Int
    skipColumns (Int -> f Int) -> BlitState -> f BlitState
    Lens' BlitState Int
    remainingColumns (Int -> f Int) -> BlitState -> f BlitState
    Lens' BlitState Int
    columnOffset
                                (Image -> Int
    imageWidth Image
    leftImage)
                                Image
    leftImage
                                Image
    rightImage
                                Int
    ow
    addMaybeClipped BGFill {Int
    outputWidth :: Int
    outputWidth :: Image -> Int
    outputWidth, Int
    outputHeight :: Int
    outputHeight :: Image -> Int
    outputHeight} = do
        s <- ReaderT (BlitEnv s) (StateT BlitState (ST s)) BlitState
    forall s (m :: * -> *). MonadState s m => m s
    get
        let 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 -> 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)
        y <- use rowOffset
        forM_ [y..y+outputHeight'-1] $ snocOp (Skip outputWidth')
    addMaybeClipped Crop {Image
    croppedImage :: Image
    croppedImage :: Image -> Image
    croppedImage, Int
    leftSkip :: Int
    leftSkip :: Image -> Int
    leftSkip, Int
    topSkip :: Int
    topSkip :: Image -> Int
    topSkip, Int
    outputWidth :: Image -> Int
    outputWidth :: Int
    outputWidth, Int
    outputHeight :: Image -> Int
    outputHeight :: Int
    outputHeight} = do
        sx <- 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
        skipColumns += leftSkip
        modifying remainingColumns (min (outputWidth - sx))
        sy <- use skipRows
        skipRows += topSkip
        modifying remainingRows (min (outputHeight - sy))
        addMaybeClipped 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 :: forall s.
    [Char]
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Lens' BlitState Int
    -> Int
    -> Image
    -> Image
    -> Int
    -> BlitM s ()
    addMaybeClippedJoin [Char]
    name Lens' BlitState Int
    skip Lens' BlitState Int
    remaining Lens' BlitState Int
    offset Int
    i0Dim Image
    i0 Image
    i1 Int
    size = do
        state <- ReaderT (BlitEnv s) (StateT BlitState (ST s)) BlitState
    forall s (m :: * -> *). MonadState s m => m s
    get
        when (state^.remaining <= 0) $ error $ name ++ " with remaining <= 0"
        case state^.skip of
            Int
    s | Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    size -> BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST 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
    == Int
    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 -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i0
                                    BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST 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 -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i1
                                else Image -> ReaderT (BlitEnv s) (StateT BlitState (ST 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 -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i0
                        else do
                            Image -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i0
                            BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST 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
    .~ Int
    0
                            Image -> ReaderT (BlitEnv s) (StateT BlitState (ST 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 -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> BlitState -> ReaderT (BlitEnv s) (StateT BlitState (ST 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 -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. Image -> BlitM s ()
    addMaybeClipped Image
    i1
            Int
    _ -> [Char] -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> [Char] -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    name [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " has unhandled skip class"

    addUnclippedText :: Attr -> TL.Text -> BlitM s ()
    addUnclippedText :: forall s. Attr -> Text -> BlitM s ()
    addUnclippedText Attr
    a 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 -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ())
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall a b.
    ReaderT (BlitEnv s) (StateT BlitState (ST s)) a
    -> (a -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) b)
    -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= SpanOp -> Int -> ReaderT (BlitEnv s) (StateT BlitState (ST s)) ()
    forall s. SpanOp -> Int -> BlitM s ()
    snocOp SpanOp
    op

    addRowCompletion :: DisplayRegion -> Int -> BlitM s ()
    addRowCompletion :: forall s. DisplayRegion -> Int -> BlitM s ()
    addRowCompletion DisplayRegion
    displayRegion Int
    row = do
        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 (f :: * -> *).
    Functor f =>
    (MRowOps s -> f (MRowOps s)) -> BlitEnv s -> f (BlitEnv s)
    mrowOps
        rowOps <- lift $ lift $ MVector.read allRowOps row
        let endX = SpanOps -> Int
    spanOpsAffectedColumns SpanOps
    rowOps
        when (endX < regionWidth displayRegion) $ do
            let ow = DisplayRegion -> Int
    regionWidth DisplayRegion
    displayRegion Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    endX
            snocOp (Skip ow) row

    -- | snocs the operation to the operations for the given row.
    snocOp :: SpanOp -> Int -> BlitM s ()
    snocOp :: forall s. SpanOp -> Int -> BlitM s ()
    snocOp !SpanOp
    op !Int
    row = do
        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 (f :: * -> *).
    Functor f =>
    (MRowOps s -> f (MRowOps s)) -> BlitEnv s -> f (BlitEnv s)
    mrowOps
        theRegion <- view region
        lift $ lift $ do
            ops <- MVector.read theMrowOps row
            let ops' = SpanOps -> SpanOp -> SpanOps
    forall a. Vector a -> a -> Vector a
    Vector.snoc SpanOps
    ops SpanOp
    op
            when (spanOpsAffectedColumns ops' > regionWidth theRegion)
                 $ error $ "row " ++ show row ++ " now exceeds region width"
            MVector.write theMrowOps row ops'