-- A 'Picture' is a background paired with a set of 'Image' layers. The
-- 'Picture' data structure is representative of the final terminal
-- view.
module Graphics.Vty.Picture
  ( Picture(..)
  , Cursor(..)
  , Background(..)
  , emptyPicture
  , addToTop
  , addToBottom
  , picForImage
  , picForLayers
  , picImage
  )
where

import Graphics.Vty.Image
import Graphics.Vty.Attributes

import Control.DeepSeq

-- | A Vty picture.
--
-- These can be constructed directly or using `picForImage`.
data Picture = Picture
    { Picture -> Cursor
picCursor :: Cursor
    -- ^ The picture's cursor.
    , Picture -> [Image]
picLayers :: [Image]
    -- ^ The picture's image layers (top-most first).
    , Picture -> Background
picBackground :: Background
    -- ^ The picture's background to be displayed in locations with no
    -- Image data.
    } deriving (Picture -> Picture -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Picture -> Picture -> Bool
$c/= :: Picture -> Picture -> Bool
== :: Picture -> Picture -> Bool
$c== :: Picture -> Picture -> Bool
Eq, Int -> Picture -> ShowS
[Picture] -> ShowS
Picture -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Picture] -> ShowS
$cshowList :: [Picture] -> ShowS
show :: Picture -> String
$cshow :: Picture -> String
showsPrec :: Int -> Picture -> ShowS
$cshowsPrec :: Int -> Picture -> ShowS
Show)

instance NFData Picture where
    rnf :: Picture -> ()
rnf (Picture Cursor
c [Image]
l Background
b) = Cursor
c forall a b. NFData a => a -> b -> b
`deepseq` [Image]
l forall a b. NFData a => a -> b -> b
`deepseq` Background
b forall a b. NFData a => a -> b -> b
`deepseq` ()

-- | A picture with no cursor, background or image layers.
emptyPicture :: Picture
emptyPicture :: Picture
emptyPicture = Cursor -> [Image] -> Background -> Picture
Picture Cursor
NoCursor [] Background
ClearBackground

-- | Add an 'Image' as the top-most layer of a 'Picture'.
addToTop :: Picture -> Image -> Picture
addToTop :: Picture -> Image -> Picture
addToTop Picture
p Image
i = Picture
p {picLayers :: [Image]
picLayers = Image
i forall a. a -> [a] -> [a]
: Picture -> [Image]
picLayers Picture
p}

-- | Add an 'Image' as the bottom-most layer of a 'Picture'.
addToBottom :: Picture -> Image -> Picture
addToBottom :: Picture -> Image -> Picture
addToBottom Picture
p Image
i = Picture
p {picLayers :: [Image]
picLayers = Picture -> [Image]
picLayers Picture
p forall a. [a] -> [a] -> [a]
++ [Image
i]}

-- | Create a picture from the given image. The picture will not have a
-- displayed cursor and no background pattern (ClearBackground) will be
-- used.
picForImage :: Image -> Picture
picForImage :: Image -> Picture
picForImage Image
i = Picture
    { picCursor :: Cursor
picCursor = Cursor
NoCursor
    , picLayers :: [Image]
picLayers = [Image
i]
    , picBackground :: Background
picBackground = Background
ClearBackground
    }

-- | Create a picture with the given layers, top-most first.
--
-- The picture will not have a displayed cursor and no background
-- pattern (ClearBackgroun) will be used.
picForLayers :: [Image] -> Picture
picForLayers :: [Image] -> Picture
picForLayers [Image]
is = Picture
    { picCursor :: Cursor
picCursor = Cursor
NoCursor
    , picLayers :: [Image]
picLayers = [Image]
is
    , picBackground :: Background
picBackground = Background
ClearBackground
    }

-- | A picture can be configured to hide the cursor or to show the
-- cursor at the specified character position.
--
-- There is not a 1:1 map from character positions to a row and column
-- on the screen due to characters that take more than 1 column.
data Cursor =
    -- | Hide the cursor
    NoCursor
    -- | Set the terminal's cursor position without displaying a cursor
    -- character. This is important for accessibility with screen
    -- readers where a cursor position needs to be reported but we may
    -- not want to show a block cursor in that location for cosmetic
    -- reasons. The boolean argument indicates whether the positioning
    -- should be absolute as with 'AbsoluteCursor' ('True') or logical
    -- as with 'Cursor' ('False').
    | PositionOnly !Bool !Int !Int
    -- | Show the cursor at the given logical column accounting for
    -- character width in the presence of multi-column characters.
    | Cursor !Int !Int
    -- | Show the cursor at the given absolute terminal column and row
    | AbsoluteCursor !Int !Int
    deriving (Cursor -> Cursor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c== :: Cursor -> Cursor -> Bool
Eq, Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cursor] -> ShowS
$cshowList :: [Cursor] -> ShowS
show :: Cursor -> String
$cshow :: Cursor -> String
showsPrec :: Int -> Cursor -> ShowS
$cshowsPrec :: Int -> Cursor -> ShowS
Show)

instance NFData Cursor where
    rnf :: Cursor -> ()
rnf Cursor
c = Cursor
c seq :: forall a b. a -> b -> b
`seq` ()

-- | A 'Picture' has a background pattern. The background is either:
--
-- * ClearBackground, which shows the layer below or is blank if the
--   bottom layer
-- * A character and a display attribute
--
-- If the display attribute used previously should be used for a
-- background fill then use `currentAttr` for the background attribute.
data Background
    = Background
    { Background -> Char
backgroundChar :: Char
    , Background -> Attr
backgroundAttr :: Attr
    }
     -- | A ClearBackground is:
     --
     -- * the space character if there are remaining non-skip ops
     --
     -- * End of line if there are no remaining non-skip ops.
    | ClearBackground
    deriving (Background -> Background -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Background -> Background -> Bool
$c/= :: Background -> Background -> Bool
== :: Background -> Background -> Bool
$c== :: Background -> Background -> Bool
Eq, Int -> Background -> ShowS
[Background] -> ShowS
Background -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Background] -> ShowS
$cshowList :: [Background] -> ShowS
show :: Background -> String
$cshow :: Background -> String
showsPrec :: Int -> Background -> ShowS
$cshowsPrec :: Int -> Background -> ShowS
Show)

instance NFData Background where
    rnf :: Background -> ()
rnf (Background Char
c Attr
a) = Char
c seq :: forall a b. a -> b -> b
`seq` Attr
a seq :: forall a b. a -> b -> b
`seq` ()
    rnf Background
ClearBackground = ()

-- | Return the top-most 'Image' layer for a picture. This is unsafe for
-- 'Picture's without at least one layer.
--
-- This is provided for compatibility with applications that do not use
-- more than a single layer.
picImage :: Picture -> Image
picImage :: Picture -> Image
picImage = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. Picture -> [Image]
picLayers