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

module Graphics.Vty.Image.Internal 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

-- | A display text is a Data.Text.Lazy
type DisplayText = TL.Text

clipText :: DisplayText -> Int -> Int -> DisplayText
clipText :: DisplayText -> Int -> Int -> DisplayText
clipText DisplayText
txt Int
leftSkip Int
rightClip =
    -- CPS would clarify this I think
    let (Int64
toDrop,Bool
padPrefix) = Int -> DisplayText -> Int64 -> (Int64, Bool)
forall t. Num t => Int -> DisplayText -> t -> (t, Bool)
clipForCharWidth Int
leftSkip DisplayText
txt Int64
0
        txt' :: DisplayText
txt' = if Bool
padPrefix then Char -> DisplayText -> DisplayText
TL.cons Char
'…' (Int64 -> DisplayText -> DisplayText
TL.drop (Int64
toDropInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1) DisplayText
txt) else Int64 -> DisplayText -> DisplayText
TL.drop Int64
toDrop DisplayText
txt
        (Int64
toTake,Bool
padSuffix) = Int -> DisplayText -> Int64 -> (Int64, Bool)
forall t. Num t => Int -> DisplayText -> t -> (t, Bool)
clipForCharWidth Int
rightClip DisplayText
txt' Int64
0
        txt'' :: DisplayText
txt'' = DisplayText -> DisplayText -> DisplayText
TL.append (Int64 -> DisplayText -> DisplayText
TL.take Int64
toTake DisplayText
txt') (if Bool
padSuffix then Char -> DisplayText
TL.singleton Char
'…' else DisplayText
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 -> DisplayText -> t -> (t, Bool)
clipForCharWidth Int
w DisplayText
t t
n
            | DisplayText -> Bool
TL.null DisplayText
t = (t
n, Bool
False)
            | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cw    = (t
n, Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
            | Bool
otherwise = Int -> DisplayText -> t -> (t, Bool)
clipForCharWidth (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cw) (DisplayText -> DisplayText
TL.tail DisplayText
t) (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
            where cw :: Int
cw = Char -> Int
safeWcwidth (DisplayText -> Char
TL.head DisplayText
t)
    in DisplayText
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 -> DisplayText
displayText :: DisplayText
      -- | 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 horizontally to a size by reducing the size from
    -- the right.
    | CropRight
      { Image -> Image
croppedImage :: Image
      -- | Always < imageWidth croppedImage > 0
      , outputWidth :: Int
      , outputHeight :: Int -- ^ imageHeight croppedImage
      }
    -- | Crop an image horizontally to a size by reducing the size from
    -- the left.
    | CropLeft
      { croppedImage :: Image
      -- | Always < imageWidth croppedImage > 0
      , Image -> Int
leftSkip :: Int
      -- | Always < imageWidth croppedImage > 0
      , outputWidth :: Int
      , outputHeight :: Int
      }
    -- | Crop an image vertically to a size by reducing the size from
    -- the bottom
    | CropBottom
      { croppedImage :: Image
      -- | imageWidth croppedImage
      , outputWidth :: Int
      -- | height image is cropped to. Always < imageHeight croppedImage > 0
      , outputHeight :: Int
      }
    -- | Crop an image vertically to a size by reducing the size from
    -- the top
    | CropTop
      { croppedImage :: Image
      -- | Always < imageHeight croppedImage > 0
      , Image -> Int
topSkip :: Int
      -- | imageWidth croppedImage
      , outputWidth :: Int
      -- | Always < imageHeight croppedImage > 0
      , 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
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
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. Image -> Rep Image x)
-> (forall x. Rep Image x -> Image) -> Generic Image
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
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
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]
(Int -> ReadS Image)
-> ReadS [Image]
-> ReadPrec Image
-> ReadPrec [Image]
-> Read 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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
pp Int
indent Image
img
        tab :: Int -> String
tab Int
indent = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
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(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
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(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
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(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall 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(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
b
        pp Int
i (CropRight {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
            = String
"CropRight(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
croppedImage
        pp Int
i (CropLeft {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
leftSkip :: Int
leftSkip :: Image -> Int
leftSkip, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
            = String
"CropLeft(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
leftSkip String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
croppedImage
        pp Int
i (CropBottom {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
            = String
"CropBottom(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Image
croppedImage
        pp Int
i (CropTop {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
topSkip :: Int
topSkip :: Image -> Int
topSkip, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
            = String
"CropTop("String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputWidth String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
topSkip String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"->" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outputHeight String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Image -> String
go (Int
iInt -> Int -> Int
forall 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 (CropRight Image
i Int
w Int
h) = Image
i Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
    rnf (CropLeft Image
i Int
s Int
w Int
h) = Image
i Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
s Int -> () -> ()
`seq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
    rnf (CropBottom Image
i Int
w Int
h) = Image
i Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
    rnf (CropTop Image
i Int
s Int
w Int
h) = Image
i Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
s Int -> () -> ()
`seq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
    rnf (BGFill Int
w Int
h) = Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
    rnf (VertJoin Image
t Image
b Int
w Int
h) = Image
t Image -> Image -> Image
forall a b. NFData a => a -> b -> b
`deepseq` Image
b Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
    rnf (HorizJoin Image
l Image
r Int
w Int
h) = Image
l Image -> Image -> Image
forall a b. NFData a => a -> b -> b
`deepseq` Image
r Image -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
h Int -> () -> ()
`seq` ()
    rnf (HorizText Attr
a DisplayText
s Int
w Int
cw) = Attr
a Attr -> () -> ()
`seq` DisplayText
s DisplayText -> Int -> Int
forall a b. NFData a => a -> b -> b
`deepseq` Int
w Int -> () -> ()
`seq` Int
cw Int -> () -> ()
`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 CropRight { outputWidth :: Image -> Int
outputWidth  = Int
w } = Int
w
imageWidth CropLeft { outputWidth :: Image -> Int
outputWidth  = Int
w } = Int
w
imageWidth CropBottom { outputWidth :: Image -> Int
outputWidth = Int
w } = Int
w
imageWidth CropTop { 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 CropRight { outputHeight :: Image -> Int
outputHeight  = Int
h } = Int
h
imageHeight CropLeft { outputHeight :: Image -> Int
outputHeight  = Int
h } = Int
h
imageHeight CropBottom { outputHeight :: Image -> Int
outputHeight = Int
h } = Int
h
imageHeight CropTop { 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 missmatch
-- 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 DisplayText
t0 Int
w0 Int
cw0) i1 :: Image
i1@(HorizText Attr
a1 DisplayText
t1 Int
w1 Int
cw1)
    | Attr
a0 Attr -> Attr -> Bool
forall a. Eq a => a -> a -> Bool
== Attr
a1 = Attr -> DisplayText -> Int -> Int -> Image
HorizText Attr
a0 (DisplayText -> DisplayText -> DisplayText
TL.append DisplayText
t0 DisplayText
t1) (Int
w0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w1) (Int
cw0 Int -> Int -> Int
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 Int -> Int -> Int
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 Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h1  -- Pad i0
        = let padAmount :: Int
padAmount = Int
h1 Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
h1  -- Pad i1
        = let padAmount :: Int
padAmount = Int
h0 Int -> Int -> Int
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 Int -> Int -> Int
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
_ = String -> 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 missmatch
-- 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 Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w1
        = let padAmount :: Int
padAmount = Int
w1 Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w1
        = let padAmount :: Int
padAmount = Int
w0 Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h1
vertJoin Image
_ Image
_ = String -> Image
forall a. HasCallStack => String -> a
error String
"vertJoin applied to undefined values."