{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_HADDOCK hide #-}

module Graphics.Vty.Image.Internal
  ( Image(..)
  , imageHeight
  , imageWidth
  , horizJoin
  , vertJoin

  , ppImageStructure
  , clipText
  )
where

import Graphics.Vty.Attributes
import Graphics.Text.Width

import GHC.Generics

import Control.DeepSeq

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import qualified Data.Text.Lazy as TL

clipText :: TL.Text -> Int -> Int -> TL.Text
clipText :: Text -> Int -> Int -> Text
clipText Text
txt Int
leftSkip Int
rightClip =
    -- CPS would clarify this I think
    let (Int64
toDrop,Bool
padPrefix) = forall {t}. Num t => Int -> Text -> t -> (t, Bool)
clipForCharWidth Int
leftSkip Text
txt Int64
0
        txt' :: Text
txt' = if Bool
padPrefix then Char -> Text -> Text
TL.cons Char
'…' (Int64 -> Text -> Text
TL.drop (Int64
toDropforall a. Num a => a -> a -> a
+Int64
1) Text
txt) else Int64 -> Text -> Text
TL.drop Int64
toDrop Text
txt
        (Int64
toTake,Bool
padSuffix) = forall {t}. Num t => Int -> Text -> t -> (t, Bool)
clipForCharWidth Int
rightClip Text
txt' Int64
0
        txt'' :: Text
txt'' = Text -> Text -> Text
TL.append (Int64 -> Text -> Text
TL.take Int64
toTake Text
txt') (if Bool
padSuffix then Char -> Text
TL.singleton Char
'…' else Text
TL.empty)
        -- Note: some characters and zero-width and combining characters
        -- combine to the left, so keep taking characters even if the
        -- width is zero.
        clipForCharWidth :: Int -> Text -> t -> (t, Bool)
clipForCharWidth Int
w Text
t t
n
            | Text -> Bool
TL.null Text
t = (t
n, Bool
False)
            | Int
w forall a. Ord a => a -> a -> Bool
< Int
cw    = (t
n, Int
w forall a. Eq a => a -> a -> Bool
/= Int
0)
            | Bool
otherwise = Int -> Text -> t -> (t, Bool)
clipForCharWidth (Int
w forall a. Num a => a -> a -> a
- Int
cw) (Text -> Text
TL.tail Text
t) (t
n forall a. Num a => a -> a -> a
+ t
1)
            where cw :: Int
cw = Char -> Int
safeWcwidth (Text -> Char
TL.head Text
t)
    in Text
txt''

-- | This is the internal representation of Images. Use the constructors
-- in "Graphics.Vty.Image" to create instances.
--
-- Images are:
--
-- * a horizontal span of text
--
-- * a horizontal or vertical join of two images
--
-- * a two dimensional fill of the 'Picture's background character
--
-- * a cropped image
--
-- * an empty image of no size or content.
data Image =
    -- | A horizontal text span has a row height of 1.
      HorizText
      { Image -> Attr
attr :: Attr
      -- | The text to display. The display width of the text is always
      -- outputWidth.
      , Image -> Text
displayText :: TL.Text
      -- | The number of display columns for the text.
      , Image -> Int
outputWidth :: Int
      -- | the number of characters in the text.
      , Image -> Int
charWidth :: Int
      }
    -- | A horizontal join can be constructed between any two images.
    -- However a HorizJoin instance is required to be between two images
    -- of equal height. The horizJoin constructor adds background fills
    -- to the provided images that assure this is true for the HorizJoin
    -- value produced.
    | HorizJoin
      { Image -> Image
partLeft :: Image
      , Image -> Image
partRight :: Image
      , outputWidth :: Int
      -- ^ imageWidth partLeft == imageWidth partRight. Always > 0
      , Image -> Int
outputHeight :: Int
      -- ^ imageHeight partLeft == imageHeight partRight. Always > 0
      }
    -- | A veritical join can be constructed between any two images.
    -- However a VertJoin instance is required to be between two images
    -- of equal width. The vertJoin constructor adds background fills
    -- to the provides images that assure this is true for the VertJoin
    -- value produced.
    | VertJoin
      { Image -> Image
partTop :: Image
      , Image -> Image
partBottom :: Image
      , outputWidth :: Int
      -- ^ imageWidth partTop == imageWidth partBottom. always > 0
      , outputHeight :: Int
      -- ^ imageHeight partTop == imageHeight partBottom. always > 1
      }
    -- | A background fill will be filled with the background char. The
    -- background char is defined as a property of the Picture this
    -- Image is used to form.
    | BGFill
      { outputWidth :: Int -- ^ always > 0
      , outputHeight :: Int -- ^ always > 0
      }
    -- | Crop an image
    | Crop
      { Image -> Image
croppedImage :: Image
      , Image -> Int
leftSkip :: Int
      , Image -> Int
topSkip :: Int
      , outputWidth :: Int
      , outputHeight :: Int
      }
    -- | The empty image
    --
    -- The combining operators identity constant.
    -- EmptyImage <|> a = a
    -- EmptyImage <-> a = a
    --
    -- Any image of zero size equals the empty image.
    | EmptyImage
    deriving (Image -> Image -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, ReadPrec [Image]
ReadPrec Image
Int -> ReadS Image
ReadS [Image]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Image]
$creadListPrec :: ReadPrec [Image]
readPrec :: ReadPrec Image
$creadPrec :: ReadPrec Image
readList :: ReadS [Image]
$creadList :: ReadS [Image]
readsPrec :: Int -> ReadS Image
$creadsPrec :: Int -> ReadS Image
Read)

-- | pretty print just the structure of an image.
ppImageStructure :: Image -> String
ppImageStructure :: Image -> String
ppImageStructure = Int -> Image -> String
go Int
0
    where
        go :: Int -> Image -> String
go Int
indent Image
img = Int -> String
tab Int
indent forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
pp Int
indent Image
img
        tab :: Int -> String
tab Int
indent = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
indent String
"  "
        pp :: Int -> Image -> String
pp Int
_ (HorizText {Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth}) = String
"HorizText(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth forall a. [a] -> [a] -> [a]
++ String
")"
        pp Int
_ (BGFill {Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
            = String
"BGFill(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputHeight forall a. [a] -> [a] -> [a]
++ String
")"
        pp Int
i (HorizJoin {partLeft :: Image -> Image
partLeft = Image
l, partRight :: Image -> Image
partRight = Image
r, outputWidth :: Image -> Int
outputWidth = Int
c})
            = String
"HorizJoin(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
c forall a. [a] -> [a] -> [a]
++ String
")\n" forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Image
l forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Image
r
        pp Int
i (VertJoin {partTop :: Image -> Image
partTop = Image
t, partBottom :: Image -> Image
partBottom = Image
b, outputWidth :: Image -> Int
outputWidth = Int
c, outputHeight :: Image -> Int
outputHeight = Int
r})
            = String
"VertJoin(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
c forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
r forall a. [a] -> [a] -> [a]
++ String
")\n"
              forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Image
t forall a. [a] -> [a] -> [a]
++ String
"\n"
              forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Image
b
        pp Int
i (Crop {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
leftSkip :: Int
leftSkip :: Image -> Int
leftSkip, Int
topSkip :: Int
topSkip :: Image -> Int
topSkip, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
            = String
"Crop(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
leftSkip forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
topSkip forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputWidth forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
outputHeight forall a. [a] -> [a] -> [a]
++ String
")\n"
              forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Image
croppedImage
        pp Int
_ Image
EmptyImage = String
"EmptyImage"

instance NFData Image where
    rnf :: Image -> ()
rnf Image
EmptyImage = ()
    rnf (Crop Image
i Int
x Int
y Int
w Int
h) = Image
i forall a b. NFData a => a -> b -> b
`deepseq` Int
x seq :: forall a b. a -> b -> b
`seq` Int
y seq :: forall a b. a -> b -> b
`seq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
    rnf (BGFill Int
w Int
h) = Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
    rnf (VertJoin Image
t Image
b Int
w Int
h) = Image
t forall a b. NFData a => a -> b -> b
`deepseq` Image
b forall a b. NFData a => a -> b -> b
`deepseq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
    rnf (HorizJoin Image
l Image
r Int
w Int
h) = Image
l forall a b. NFData a => a -> b -> b
`deepseq` Image
r forall a b. NFData a => a -> b -> b
`deepseq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
h seq :: forall a b. a -> b -> b
`seq` ()
    rnf (HorizText Attr
a Text
s Int
w Int
cw) = Attr
a seq :: forall a b. a -> b -> b
`seq` Text
s forall a b. NFData a => a -> b -> b
`deepseq` Int
w seq :: forall a b. a -> b -> b
`seq` Int
cw seq :: forall a b. a -> b -> b
`seq` ()

-- | The width of an Image. This is the number display columns the image
-- will occupy.
imageWidth :: Image -> Int
imageWidth :: Image -> Int
imageWidth HorizText { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth HorizJoin { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth VertJoin { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth BGFill { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth Crop { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth Image
EmptyImage = Int
0

-- | The height of an Image. This is the number of display rows the
-- image will occupy.
imageHeight :: Image -> Int
imageHeight :: Image -> Int
imageHeight HorizText {} = Int
1
imageHeight HorizJoin { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight VertJoin { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight BGFill { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight Crop { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight Image
EmptyImage = Int
0

-- | Append in the 'Semigroup' instance is equivalent to '<->'.
instance Semigroup Image where
    <> :: Image -> Image -> Image
(<>) = Image -> Image -> Image
vertJoin

-- | Append in the 'Monoid' instance is equivalent to '<->'.
instance Monoid Image where
    mempty :: Image
mempty = Image
EmptyImage
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif

-- | combines two images side by side
--
-- Combines text chunks where possible. Assures outputWidth and
-- outputHeight properties are not violated.
--
-- The result image will have a width equal to the sum of the two images
-- width. And the height will equal the largest height of the two
-- images. The area not defined in one image due to a height mismatch
-- will be filled with the background pattern.
horizJoin :: Image -> Image -> Image
horizJoin :: Image -> Image -> Image
horizJoin Image
EmptyImage Image
i          = Image
i
horizJoin Image
i          Image
EmptyImage = Image
i
horizJoin i0 :: Image
i0@(HorizText Attr
a0 Text
t0 Int
w0 Int
cw0) i1 :: Image
i1@(HorizText Attr
a1 Text
t1 Int
w1 Int
cw1)
    | Attr
a0 forall a. Eq a => a -> a -> Bool
== Attr
a1 = Attr -> Text -> Int -> Int -> Image
HorizText Attr
a0 (Text -> Text -> Text
TL.append Text
t0 Text
t1) (Int
w0 forall a. Num a => a -> a -> a
+ Int
w1) (Int
cw0 forall a. Num a => a -> a -> a
+ Int
cw1)
    -- assumes horiz text height is always 1
    | Bool
otherwise  = Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 Image
i1 (Int
w0 forall a. Num a => a -> a -> a
+ Int
w1) Int
1
horizJoin Image
i0 Image
i1
    -- If the images are of the same height then no padding is required
    | Int
h0 forall a. Eq a => a -> a -> Bool
== Int
h1 = Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 Image
i1 Int
w Int
h0
    -- otherwise one of the images needs to be padded to the right size.
    | Int
h0 forall a. Ord a => a -> a -> Bool
< Int
h1  -- Pad i0
        = let padAmount :: Int
padAmount = Int
h1 forall a. Num a => a -> a -> a
- Int
h0
          in Image -> Image -> Int -> Int -> Image
HorizJoin (Image -> Image -> Int -> Int -> Image
VertJoin Image
i0 (Int -> Int -> Image
BGFill Int
w0 Int
padAmount) Int
w0 Int
h1) Image
i1 Int
w Int
h1
    | Int
h0 forall a. Ord a => a -> a -> Bool
> Int
h1  -- Pad i1
        = let padAmount :: Int
padAmount = Int
h0 forall a. Num a => a -> a -> a
- Int
h1
          in Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 (Image -> Image -> Int -> Int -> Image
VertJoin Image
i1 (Int -> Int -> Image
BGFill Int
w1 Int
padAmount) Int
w1 Int
h0) Int
w Int
h0
    where
        w0 :: Int
w0 = Image -> Int
imageWidth Image
i0
        w1 :: Int
w1 = Image -> Int
imageWidth Image
i1
        w :: Int
w   = Int
w0 forall a. Num a => a -> a -> a
+ Int
w1
        h0 :: Int
h0 = Image -> Int
imageHeight Image
i0
        h1 :: Int
h1 = Image -> Int
imageHeight Image
i1
horizJoin Image
_ Image
_ = forall a. HasCallStack => String -> a
error String
"horizJoin applied to undefined values."

-- | combines two images vertically
--
-- The result image will have a height equal to the sum of the heights
-- of both images. The width will equal the largest width of the two
-- images. The area not defined in one image due to a width mismatch
-- will be filled with the background pattern.
vertJoin :: Image -> Image -> Image
vertJoin :: Image -> Image -> Image
vertJoin Image
EmptyImage Image
i          = Image
i
vertJoin Image
i          Image
EmptyImage = Image
i
vertJoin Image
i0 Image
i1
    -- If the images are of the same width then no background padding is
    -- required
    | Int
w0 forall a. Eq a => a -> a -> Bool
== Int
w1 = Image -> Image -> Int -> Int -> Image
VertJoin Image
i0 Image
i1 Int
w0 Int
h
    -- Otherwise one of the images needs to be padded to the size of the
    -- other image.
    | Int
w0 forall a. Ord a => a -> a -> Bool
< Int
w1
        = let padAmount :: Int
padAmount = Int
w1 forall a. Num a => a -> a -> a
- Int
w0
          in Image -> Image -> Int -> Int -> Image
VertJoin (Image -> Image -> Int -> Int -> Image
HorizJoin Image
i0 (Int -> Int -> Image
BGFill Int
padAmount Int
h0) Int
w1 Int
h0) Image
i1 Int
w1 Int
h
    | Int
w0 forall a. Ord a => a -> a -> Bool
> Int
w1
        = let padAmount :: Int
padAmount = Int
w0 forall a. Num a => a -> a -> a
- Int
w1
          in Image -> Image -> Int -> Int -> Image
VertJoin Image
i0 (Image -> Image -> Int -> Int -> Image
HorizJoin Image
i1 (Int -> Int -> Image
BGFill Int
padAmount Int
h1) Int
w0 Int
h1) Int
w0 Int
h
    where
        w0 :: Int
w0 = Image -> Int
imageWidth Image
i0
        w1 :: Int
w1 = Image -> Int
imageWidth Image
i1
        h0 :: Int
h0 = Image -> Int
imageHeight Image
i0
        h1 :: Int
h1 = Image -> Int
imageHeight Image
i1
        h :: Int
h   = Int
h0 forall a. Num a => a -> a -> a
+ Int
h1
vertJoin Image
_ Image
_ = forall a. HasCallStack => String -> a
error String
"vertJoin applied to undefined values."