-- Copyright Corey O'Connor
{-# 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
  ( SpanOp(..)
  , columnsToCharOffset
  , spanOpHasWidth

  , SpanOps
  , spanOpsAffectedColumns
  , splitOpsAt
  , dropOps

  , DisplayOps
  , displayOpsRows
  , displayOpsColumns
  , affectedRegion
  )
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 -> Text
textSpanText :: TL.Text
      }
    -- | 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
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 = forall a b. (a, b) -> b
snd 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 -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt'
    where
        splitOpsAt' :: Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt' Int
0 SpanOps
ops = (forall a. Vector a
Vector.empty, SpanOps
ops)
        splitOpsAt' Int
remainingColumns SpanOps
ops = case forall a. Vector a -> a
Vector.head SpanOps
ops of
            t :: SpanOp
t@(TextSpan {}) -> if Int
remainingColumns 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 forall a. Num a => a -> a -> a
- SpanOp -> Int
textSpanOutputWidth SpanOp
t)
                                                  (forall a. Vector a -> Vector a
Vector.tail SpanOps
ops)
                     in (forall a. a -> Vector a -> Vector a
Vector.cons SpanOp
t SpanOps
pre, SpanOps
post)
                else let preTxt :: Text
preTxt = Text -> Int -> Int -> Text
clipText (SpanOp -> Text
textSpanText SpanOp
t) Int
0 Int
remainingColumns
                         preOp :: SpanOp
preOp = TextSpan { textSpanAttr :: Attr
textSpanAttr = SpanOp -> Attr
textSpanAttr SpanOp
t
                                           , textSpanOutputWidth :: Int
textSpanOutputWidth = Int
remainingColumns
                                           , textSpanCharWidth :: Int
textSpanCharWidth = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$! Text -> Int64
TL.length Text
preTxt
                                           , textSpanText :: Text
textSpanText = Text
preTxt
                                           }
                         postWidth :: Int
postWidth = SpanOp -> Int
textSpanOutputWidth SpanOp
t forall a. Num a => a -> a -> a
- Int
remainingColumns
                         postTxt :: Text
postTxt = Text -> Int -> Int -> Text
clipText (SpanOp -> Text
textSpanText SpanOp
t) Int
remainingColumns Int
postWidth
                         postOp :: SpanOp
postOp = TextSpan { textSpanAttr :: Attr
textSpanAttr = SpanOp -> Attr
textSpanAttr SpanOp
t
                                            , textSpanOutputWidth :: Int
textSpanOutputWidth = Int
postWidth
                                            , textSpanCharWidth :: Int
textSpanCharWidth = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$! Text -> Int64
TL.length Text
postTxt
                                            , textSpanText :: Text
textSpanText = Text
postTxt
                                            }
                     in ( forall a. a -> Vector a
Vector.singleton SpanOp
preOp
                        , forall a. a -> Vector a -> Vector a
Vector.cons SpanOp
postOp (forall a. Vector a -> Vector a
Vector.tail SpanOps
ops)
                        )
            Skip Int
w -> if Int
remainingColumns forall a. Ord a => a -> a -> Bool
>= Int
w
                then let (SpanOps
pre,SpanOps
post) = Int -> SpanOps -> (SpanOps, SpanOps)
splitOpsAt' (Int
remainingColumns forall a. Num a => a -> a -> a
- Int
w) (forall a. Vector a -> Vector a
Vector.tail SpanOps
ops)
                     in (forall a. a -> Vector a -> Vector a
Vector.cons (Int -> SpanOp
Skip Int
w) SpanOps
pre, SpanOps
post)
                else ( forall a. a -> Vector a
Vector.singleton forall a b. (a -> b) -> a -> b
$ Int -> SpanOp
Skip Int
remainingColumns
                     , forall a. a -> Vector a -> Vector a
Vector.cons (Int -> SpanOp
Skip (Int
w forall a. Num a => a -> a -> a
- Int
remainingColumns)) (forall a. Vector a -> Vector a
Vector.tail SpanOps
ops)
                     )
            RowEnd Int
_ -> 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 Text
_) = [Char]
"TextSpan(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Attr
attr forall a. [a] -> [a] -> [a]
++ [Char]
")(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
ow forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
cw forall a. [a] -> [a] -> [a]
++ [Char]
")"
    show (Skip Int
ow) = [Char]
"Skip(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
ow forall a. [a] -> [a] -> [a]
++ [Char]
")"
    show (RowEnd Int
ow) = [Char]
"RowEnd(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
ow 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
    | forall a. Vector a -> Int
Vector.length DisplayOps
ops forall a. Eq a => a -> a -> Bool
== Int
0 = Int
0
    | Bool
otherwise              = forall a. Vector a -> Int
Vector.length forall a b. (a -> b) -> a -> b
$ 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 = forall a. Vector a -> Int
Vector.length

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 = 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
_ Text
_ ) = Int
t forall a. Num a => a -> a -> a
+ Int
w
        spanOpsAffectedColumns' Int
t (Skip Int
w) = Int
t forall a. Num a => a -> a -> a
+ Int
w
        spanOpsAffectedColumns' Int
t (RowEnd Int
w) = Int
t 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 Text
_) = forall a. a -> Maybe a
Just (Int
cw, Int
ow)
spanOpHasWidth (Skip Int
ow) = forall a. a -> Maybe a
Just (Int
ow,Int
ow)
spanOpHasWidth (RowEnd Int
ow) = 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
_ Text
utf8Str) =
    Text -> Int
wctlwidth (Int64 -> Text -> Text
TL.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cx) Text
utf8Str)
columnsToCharOffset Int
cx (Skip Int
_) = Int
cx
columnsToCharOffset Int
cx (RowEnd Int
_) = Int
cx