-- Copyright Corey O'Connor
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE GADTs #-}
-- | A picture is translated into a sequences of state changes and
-- character spans. The attribute is applied to all following spans,
-- including spans of the next row. The nth element of the sequence
-- represents the nth row (from top to bottom) of the picture to render.
--
-- A span op sequence will be defined for all rows and columns (and no
-- more) of the region provided with the picture to 'spansForPic'.
module Graphics.Vty.Span where

import Graphics.Vty.Attributes (Attr)
import Graphics.Vty.Image
import Graphics.Vty.Image.Internal ( clipText )

import qualified Data.Text.Lazy as TL
import Data.Vector (Vector)
import qualified Data.Vector as Vector

-- | This represents an operation on the terminal: either an attribute
-- change or the output of a text string.
data SpanOp =
    -- | A span of UTF-8 text occupies a specific number of screen space
    -- columns. A single UTF character does not necessarily represent 1
    -- colunm. See Codec.Binary.UTF8.Width TextSpan [Attr] [output width
    -- in columns] [number of characters] [data]
      TextSpan
      { SpanOp -> Attr
textSpanAttr :: !Attr
      , SpanOp -> Int
textSpanOutputWidth :: !Int
      , SpanOp -> Int
textSpanCharWidth :: !Int
      , SpanOp -> DisplayText
textSpanText :: DisplayText
      }
    -- | Skips the given number of columns.
    | Skip !Int
    -- | Marks the end of a row. Specifies how many columns are
    -- remaining. These columns will not be explicitly overwritten with
    -- the span ops. The terminal is require to assure the remaining
    -- columns are clear.
    | RowEnd !Int
    deriving SpanOp -> SpanOp -> Bool
(SpanOp -> SpanOp -> Bool)
-> (SpanOp -> SpanOp -> Bool) -> Eq SpanOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanOp -> SpanOp -> Bool
$c/= :: SpanOp -> SpanOp -> Bool
== :: SpanOp -> SpanOp -> Bool
$c== :: SpanOp -> SpanOp -> Bool
Eq

-- | A vector of span operations executed in succession. This represents
-- the operations required to render a row of the terminal. The
-- operations in one row may affect subsequent rows. For example,
-- setting the foreground color in one row will affect all subsequent
-- rows until the foreground color is changed.
type SpanOps = Vector SpanOp

dropOps :: Int -> SpanOps -> SpanOps
dropOps :: Int -> SpanOps -> SpanOps
dropOps Int
w = (SpanOps, SpanOps) -> SpanOps
forall a b. (a, b) -> b
snd ((SpanOps, SpanOps) -> SpanOps)
-> (SpanOps -> (SpanOps, SpanOps)) -> SpanOps -> SpanOps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt Int
w

splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt :: Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt Int
inW SpanOps
inOps = Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt' Int
inW SpanOps
inOps
    where
        splitOpsAt' :: Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt' Int
0 SpanOps
ops = (SpanOps
forall a. Vector a
Vector.empty, SpanOps
ops)
        splitOpsAt' Int
remainingColumns SpanOps
ops = case SpanOps -> SpanOp
forall a. Vector a -> a
Vector.head SpanOps
ops of
            t :: SpanOp
t@(TextSpan {}) -> if Int
remainingColumns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SpanOp -> Int
textSpanOutputWidth SpanOp
t
                then let (SpanOps
pre,SpanOps
post) = Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt' (Int
remainingColumns Int -> Int -> Int
forall a. Num a => a -> a -> a
- SpanOp -> Int
textSpanOutputWidth SpanOp
t)
                                                  (SpanOps -> SpanOps
forall a. Vector a -> Vector a
Vector.tail SpanOps
ops)
                     in (SpanOp -> SpanOps -> SpanOps
forall a. a -> Vector a -> Vector a
Vector.cons SpanOp
t SpanOps
pre, SpanOps
post)
                else let preTxt :: DisplayText
preTxt = DisplayText -> Int -> Int -> DisplayText
clipText (SpanOp -> DisplayText
textSpanText SpanOp
t) Int
0 Int
remainingColumns
                         preOp :: SpanOp
preOp = TextSpan :: Attr -> Int -> Int -> DisplayText -> SpanOp
TextSpan { textSpanAttr :: Attr
textSpanAttr = SpanOp -> Attr
textSpanAttr SpanOp
t
                                           , textSpanOutputWidth :: Int
textSpanOutputWidth = Int
remainingColumns
                                           , textSpanCharWidth :: Int
textSpanCharWidth = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$! DisplayText -> Int64
TL.length DisplayText
preTxt
                                           , textSpanText :: DisplayText
textSpanText = DisplayText
preTxt
                                           }
                         postWidth :: Int
postWidth = SpanOp -> Int
textSpanOutputWidth SpanOp
t Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remainingColumns
                         postTxt :: DisplayText
postTxt = DisplayText -> Int -> Int -> DisplayText
clipText (SpanOp -> DisplayText
textSpanText SpanOp
t) Int
remainingColumns Int
postWidth
                         postOp :: SpanOp
postOp = TextSpan :: Attr -> Int -> Int -> DisplayText -> SpanOp
TextSpan { textSpanAttr :: Attr
textSpanAttr = SpanOp -> Attr
textSpanAttr SpanOp
t
                                            , textSpanOutputWidth :: Int
textSpanOutputWidth = Int
postWidth
                                            , textSpanCharWidth :: Int
textSpanCharWidth = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$! DisplayText -> Int64
TL.length DisplayText
postTxt
                                            , textSpanText :: DisplayText
textSpanText = DisplayText
postTxt
                                            }
                     in ( SpanOp -> SpanOps
forall a. a -> Vector a
Vector.singleton SpanOp
preOp
                        , SpanOp -> SpanOps -> SpanOps
forall a. a -> Vector a -> Vector a
Vector.cons SpanOp
postOp (SpanOps -> SpanOps
forall a. Vector a -> Vector a
Vector.tail SpanOps
ops)
                        )
            Skip Int
w -> if Int
remainingColumns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w
                then let (SpanOps
pre,SpanOps
post) = Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt' (Int
remainingColumns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) (SpanOps -> SpanOps
forall a. Vector a -> Vector a
Vector.tail SpanOps
ops)
                     in (SpanOp -> SpanOps -> SpanOps
forall a. a -> Vector a -> Vector a
Vector.cons (Int -> SpanOp
Skip Int
w) SpanOps
pre, SpanOps
post)
                else ( SpanOp -> SpanOps
forall a. a -> Vector a
Vector.singleton (SpanOp -> SpanOps) -> SpanOp -> SpanOps
forall a b. (a -> b) -> a -> b
$ Int -> SpanOp
Skip Int
remainingColumns
                     , SpanOp -> SpanOps -> SpanOps
forall a. a -> Vector a -> Vector a
Vector.cons (Int -> SpanOp
Skip (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remainingColumns)) (SpanOps -> SpanOps
forall a. Vector a -> Vector a
Vector.tail SpanOps
ops)
                     )
            RowEnd Int
_ -> [Char] -> (SpanOps, SpanOps)
forall a. HasCallStack => [Char] -> a
error [Char]
"cannot split ops containing a row end"

-- | A vector of span operation vectors for display, one per row of the
-- output region.
type DisplayOps = Vector SpanOps

instance Show SpanOp where
    show :: SpanOp -> [Char]
show (TextSpan Attr
attr Int
ow Int
cw DisplayText
_) = [Char]
"TextSpan(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Attr -> [Char]
forall a. Show a => a -> [Char]
show Attr
attr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ow [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
cw [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
    show (Skip Int
ow) = [Char]
"Skip(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ow [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
    show (RowEnd Int
ow) = [Char]
"RowEnd(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
ow [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- | The number of columns the DisplayOps are defined for.
--
-- All spans are verified to define same number of columns.
displayOpsColumns :: DisplayOps -> Int
displayOpsColumns :: DisplayOps -> Int
displayOpsColumns DisplayOps
ops
    | DisplayOps -> Int
forall a. Vector a -> Int
Vector.length DisplayOps
ops Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
0
    | Bool
otherwise              = SpanOps -> Int
forall a. Vector a -> Int
Vector.length (SpanOps -> Int) -> SpanOps -> Int
forall a b. (a -> b) -> a -> b
$ DisplayOps -> SpanOps
forall a. Vector a -> a
Vector.head DisplayOps
ops

-- | The number of rows the DisplayOps are defined for.
displayOpsRows :: DisplayOps -> Int
displayOpsRows :: DisplayOps -> Int
displayOpsRows DisplayOps
ops = DisplayOps -> Int
forall a. Vector a -> Int
Vector.length DisplayOps
ops

affectedRegion :: DisplayOps -> DisplayRegion
affectedRegion :: DisplayOps -> DisplayRegion
affectedRegion DisplayOps
ops = (DisplayOps -> Int
displayOpsColumns DisplayOps
ops, DisplayOps -> Int
displayOpsRows DisplayOps
ops)

-- | The number of columns a SpanOps affects.
spanOpsAffectedColumns :: SpanOps -> Int
spanOpsAffectedColumns :: SpanOps -> Int
spanOpsAffectedColumns SpanOps
inOps = (Int -> SpanOp -> Int) -> Int -> SpanOps -> Int
forall a b. (a -> b -> a) -> a -> Vector b -> a
Vector.foldl' Int -> SpanOp -> Int
spanOpsAffectedColumns' Int
0 SpanOps
inOps
    where
        spanOpsAffectedColumns' :: Int -> SpanOp -> Int
spanOpsAffectedColumns' Int
t (TextSpan Attr
_ Int
w Int
_ DisplayText
_ ) = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w
        spanOpsAffectedColumns' Int
t (Skip Int
w) = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w
        spanOpsAffectedColumns' Int
t (RowEnd Int
w) = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w

-- | The width of a single SpanOp in columns.
spanOpHasWidth :: SpanOp -> Maybe (Int, Int)
spanOpHasWidth :: SpanOp -> Maybe DisplayRegion
spanOpHasWidth (TextSpan Attr
_ Int
ow Int
cw DisplayText
_) = DisplayRegion -> Maybe DisplayRegion
forall a. a -> Maybe a
Just (Int
cw, Int
ow)
spanOpHasWidth (Skip Int
ow) = DisplayRegion -> Maybe DisplayRegion
forall a. a -> Maybe a
Just (Int
ow,Int
ow)
spanOpHasWidth (RowEnd Int
ow) = DisplayRegion -> Maybe DisplayRegion
forall a. a -> Maybe a
Just (Int
ow,Int
ow)

-- | The number of columns to the character at the given position in the
-- span op.
columnsToCharOffset :: Int -> SpanOp -> Int
columnsToCharOffset :: Int -> SpanOp -> Int
columnsToCharOffset Int
cx (TextSpan Attr
_ Int
_ Int
_ DisplayText
utf8Str) =
    DisplayText -> Int
wctlwidth (Int64 -> DisplayText -> DisplayText
TL.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cx) DisplayText
utf8Str)
columnsToCharOffset Int
cx (Skip Int
_) = Int
cx
columnsToCharOffset Int
cx (RowEnd Int
_) = Int
cx