-- Copyright 2009-2010 Corey O'Connor
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
-- | A Vty program makes 'Picture's from 'Image's. This module provides
-- the core constructors for creating, combining, and modifying
-- 'Image's.
module Graphics.Vty.Image
  (
  -- * Images
    Image
  , imageWidth
  , imageHeight
  -- * Image constructors
  , emptyImage
  , char
  , string
  , iso10646String
  , utf8String
  , text
  , text'
  , backgroundFill
  , utf8Bytestring
  , utf8Bytestring'
  , charFill
  -- * Combinators
  , horizJoin
  , (<|>)
  , vertJoin
  , (<->)
  , horizCat
  , vertCat
  -- * Image modifications
  , crop
  , cropRight
  , cropLeft
  , cropBottom
  , cropTop
  , pad
  , resize
  , resizeWidth
  , resizeHeight
  , translate
  , translateX
  , translateY
  -- * Character width functions
  , safeWcwidth
  , safeWcswidth
  , safeWctwidth
  , safeWctlwidth
  , wcwidth
  , wcswidth
  , wctwidth
  , wctlwidth
  -- * Display Regions
  , DisplayText
  , DisplayRegion
  , regionWidth
  , regionHeight
  )
where

import Graphics.Vty.Attributes
import Graphics.Vty.Image.Internal
import Graphics.Text.Width

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Data.Word

-- | A region of the display (first width, then height)
type DisplayRegion = (Int,Int)

regionWidth :: DisplayRegion -> Int
regionWidth :: DisplayRegion -> Int
regionWidth = DisplayRegion -> Int
forall a b. (a, b) -> a
fst

regionHeight :: DisplayRegion -> Int
regionHeight :: DisplayRegion -> Int
regionHeight = DisplayRegion -> Int
forall a b. (a, b) -> b
snd

infixr 5 <|>
infixr 4 <->

-- | An area of the picture's background (See 'Background').
backgroundFill :: Int
               -- ^ Fill width in columns
               -> Int
               -- ^ Fill height in rows
               -> Image
backgroundFill :: Int -> Int -> Image
backgroundFill Int
w Int
h
    | Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Image
EmptyImage
    | Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Image
EmptyImage
    | Bool
otherwise = Int -> Int -> Image
BGFill Int
w Int
h

-- | Combines two images horizontally. This is an alias for 'horizJoin'.
--
-- infixr 5
(<|>) :: Image -> Image -> Image
<|> :: Image -> Image -> Image
(<|>) = Image -> Image -> Image
horizJoin

-- | Combines two images vertically. This is an alias for 'vertJoin'.
--
-- infixr 4
(<->) :: Image -> Image -> Image
<-> :: Image -> Image -> Image
(<->) = Image -> Image -> Image
vertJoin

-- | Compose any number of images together horizontally, with the first
-- in the list being leftmost.
horizCat :: [Image] -> Image
horizCat :: [Image] -> Image
horizCat = (Image -> Image -> Image) -> Image -> [Image] -> Image
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Image -> Image -> Image
horizJoin Image
EmptyImage

-- | Compose any number of images vertically, with the first in the list
-- being topmost.
vertCat :: [Image] -> Image
vertCat :: [Image] -> Image
vertCat = (Image -> Image -> Image) -> Image -> [Image] -> Image
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Image -> Image -> Image
vertJoin Image
EmptyImage

-- | Make an 'Image' from a lazy text value. The text value should be
-- sanitized of escape sequences (ASCII 27) and carriage returns;
-- otherwise layout and attribute problems may result.
text :: Attr -> TL.Text -> Image
text :: Attr -> Text -> Image
text Attr
a Text
txt = let displayWidth :: Int
displayWidth = Text -> Int
safeWctlwidth Text
txt
             in Attr -> Text -> Int -> Int -> Image
HorizText Attr
a Text
txt Int
displayWidth (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$! Text -> Int64
TL.length Text
txt)

-- | Make an 'Image' from a text value. The text value should be
-- sanitized of escape sequences (ASCII 27) and carriage returns;
-- otherwise layout and attribute problems may result.
text' :: Attr -> T.Text -> Image
text' :: Attr -> Text -> Image
text' Attr
a Text
txt = let displayWidth :: Int
displayWidth = Text -> Int
safeWctwidth Text
txt
              in Attr -> Text -> Int -> Int -> Image
HorizText Attr
a (Text -> Text
TL.fromStrict Text
txt) Int
displayWidth (Text -> Int
T.length Text
txt)

-- | Make an image from a single character. This is a standard Haskell
-- 31-bit character assumed to be in the ISO-10646 encoding.
char :: Attr -> Char -> Image
char :: Attr -> Char -> Image
char Attr
a Char
c =
    let displayWidth :: Int
displayWidth = Char -> Int
safeWcwidth Char
c
    in Attr -> Text -> Int -> Int -> Image
HorizText Attr
a (Char -> Text
TL.singleton Char
c) Int
displayWidth Int
1

-- | Make an image from a string of characters layed out on a single
-- row with the same display attribute. The string is assumed to be a
-- sequence of ISO-10646 characters. The input string should be
-- sanitized of escape sequences (ASCII 27) and carriage returns;
-- otherwise layout and attribute problems may result.
--
-- Note: depending on how the Haskell compiler represents string
-- literals, a string literal in a UTF-8 encoded source file, for
-- example, may be represented as a ISO-10646 string. That is, I think,
-- the case with GHC 6.10. This means, for the most part, you don't need
-- to worry about the encoding format when outputting string literals.
-- Just provide the string literal directly to iso10646String or string.
iso10646String :: Attr -> String -> Image
iso10646String :: Attr -> String -> Image
iso10646String Attr
a String
str =
    let displayWidth :: Int
displayWidth = String -> Int
safeWcswidth String
str
    in Attr -> Text -> Int -> Int -> Image
HorizText Attr
a (String -> Text
TL.pack String
str) Int
displayWidth (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str)

-- | Make an 'Image' from a 'String'.
--
-- This is an alias for iso10646String since the usual case is that a
-- literal string like "foo" is represented internally as a list of ISO
-- 10646 31 bit characters.
--
-- Note: Keep in mind that GHC will compile source encoded as UTF-8
-- but the literal strings, while UTF-8 encoded in the source, will be
-- transcoded to a ISO 10646 31 bit characters runtime representation.
string :: Attr -> String -> Image
string :: Attr -> String -> Image
string = Attr -> String -> Image
iso10646String

-- | Make an 'Image' from a string of characters layed out on a single
-- row. The input is assumed to be the bytes for UTF-8 encoded text.
utf8String :: Attr -> [Word8] -> Image
utf8String :: Attr -> [Word8] -> Image
utf8String Attr
a [Word8]
bytes = Attr -> ByteString -> Image
utf8Bytestring Attr
a ([Word8] -> ByteString
BL.pack [Word8]
bytes)

-- | Make an 'Image' from a UTF-8 encoded lazy bytestring.
utf8Bytestring :: Attr -> BL.ByteString -> Image
utf8Bytestring :: Attr -> ByteString -> Image
utf8Bytestring Attr
a ByteString
bs = Attr -> Text -> Image
text Attr
a (ByteString -> Text
TL.decodeUtf8 ByteString
bs)

-- | Make an 'Image' from a UTF-8 encoded strict bytestring.
utf8Bytestring' :: Attr -> B.ByteString -> Image
utf8Bytestring' :: Attr -> ByteString -> Image
utf8Bytestring' Attr
a ByteString
bs = Attr -> Text -> Image
text' Attr
a (ByteString -> Text
T.decodeUtf8 ByteString
bs)

-- | Make an image filling a region with the specified character.
--
-- If either the width or height are less than or equal to 0, then
-- the result is the empty image.
charFill :: Integral d
         => Attr
         -- ^ The attribute to use.
         -> Char
         -- ^ The character to use in filling the region.
         -> d
         -- ^ The region width.
         -> d
         -- ^ The region height.
         -> Image
charFill :: Attr -> Char -> d -> d -> Image
charFill Attr
a Char
c d
w d
h
  | d
w d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 Bool -> Bool -> Bool
|| d
h d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = Image
EmptyImage
  | Bool
otherwise        = [Image] -> Image
vertCat
                     ([Image] -> Image) -> [Image] -> Image
forall a b. (a -> b) -> a -> b
$ Int -> Image -> [Image]
forall a. Int -> a -> [a]
replicate (d -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral d
h)
                     (Image -> [Image]) -> Image -> [Image]
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Int -> Int -> Image
HorizText Attr
a Text
txt Int
displayWidth Int
forall a. Num a => a
charWidth
  where
    txt :: Text
txt          = Int64 -> Text -> Text
TL.replicate Int64
forall a. Num a => a
charWidth (Char -> Text
TL.singleton Char
c)
    displayWidth :: Int
displayWidth = Char -> Int
safeWcwidth Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
charWidth

    charWidth   :: Num a => a
    charWidth :: a
charWidth    = d -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral d
w

-- | The empty image. Useful for fold combinators. These occupy no space
-- and do not affect display attributes.
emptyImage :: Image
emptyImage :: Image
emptyImage = Image
EmptyImage

-- | Pad the given image. This adds background character fills to the
-- left, top, right, bottom.
pad :: Int
    -- ^ How much padding to add to the left side of the image.
    -> Int
    -- ^ How much padding to add to the top of the image.
    -> Int
    -- ^ How much padding to add to the right side of the image.
    -> Int
    -- ^ How much padding to add to the bottom of the image.
    -> Image
    -- ^ The image to pad.
    -> Image
pad :: Int -> Int -> Int -> Int -> Image -> Image
pad Int
0 Int
0 Int
0 Int
0 Image
i = Image
i
pad Int
inL Int
inT Int
inR Int
inB Image
inImage
    | Int
inL Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
inT Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
inR Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
inB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Image
forall a. HasCallStack => String -> a
error String
"cannot pad by negative amount"
    | Bool
otherwise = Int -> Int -> Int -> Int -> Image -> Image
go Int
inL Int
inT Int
inR Int
inB Image
inImage
        where
            go :: Int -> Int -> Int -> Int -> Image -> Image
go Int
0 Int
0 Int
0 Int
0 Image
i = Image
i
            go Int
0 Int
0 Int
0 Int
b Image
i = Image -> Image -> Int -> Int -> Image
VertJoin Image
i (Int -> Int -> Image
BGFill Int
w Int
b) Int
w Int
h
                where w :: Int
w = Image -> Int
imageWidth  Image
i
                      h :: Int
h = Image -> Int
imageHeight Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b
            go Int
0 Int
0 Int
r Int
b Image
i = Int -> Int -> Int -> Int -> Image -> Image
go Int
0 Int
0 Int
0 Int
b (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Image -> Image -> Int -> Int -> Image
HorizJoin Image
i (Int -> Int -> Image
BGFill Int
r Int
h) Int
w Int
h
                where w :: Int
w = Image -> Int
imageWidth  Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r
                      h :: Int
h = Image -> Int
imageHeight Image
i
            go Int
0 Int
t Int
r Int
b Image
i = Int -> Int -> Int -> Int -> Image -> Image
go Int
0 Int
0 Int
r Int
b (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Image -> Image -> Int -> Int -> Image
VertJoin (Int -> Int -> Image
BGFill Int
w Int
t) Image
i Int
w Int
h
                where w :: Int
w = Image -> Int
imageWidth  Image
i
                      h :: Int
h = Image -> Int
imageHeight Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t
            go Int
l Int
t Int
r Int
b Image
i = Int -> Int -> Int -> Int -> Image -> Image
go Int
0 Int
t Int
r Int
b (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Image -> Image -> Int -> Int -> Image
HorizJoin (Int -> Int -> Image
BGFill Int
l Int
h) Image
i Int
w Int
h
                where w :: Int
w = Image -> Int
imageWidth  Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
                      h :: Int
h = Image -> Int
imageHeight Image
i

-- | Translates an image by padding or cropping the left and top.
--
-- If translation offsets are negative then the image is cropped.
translate :: Int
          -- ^ The horizontal translation offset (can be negative)
          -> Int
          -- ^ The vertical translation offset (can be negative)
          -> Image
          -- ^ The image to translate.
          -> Image
translate :: Int -> Int -> Image -> Image
translate Int
x Int
y Image
i = Int -> Image -> Image
translateX Int
x (Int -> Image -> Image
translateY Int
y Image
i)

-- | Translates an image by padding or cropping its left side.
translateX :: Int -> Image -> Image
translateX :: Int -> Image -> Image
translateX Int
x Image
i
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& (Int -> Int
forall a. Num a => a -> a
abs Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Image -> Int
imageWidth Image
i) = Image
emptyImage
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = let s :: Int
s = Int -> Int
forall a. Num a => a -> a
abs Int
x in Image -> Int -> Int -> Int -> Image
CropLeft Image
i Int
s (Image -> Int
imageWidth Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Image -> Int
imageHeight Image
i)
    | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Image
i
    | Bool
otherwise = let h :: Int
h = Image -> Int
imageHeight Image
i in Image -> Image -> Int -> Int -> Image
HorizJoin (Int -> Int -> Image
BGFill Int
x Int
h) Image
i (Image -> Int
imageWidth Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) Int
h

-- | Translates an image by padding or cropping its top.
translateY :: Int -> Image -> Image
translateY :: Int -> Image -> Image
translateY Int
y Image
i
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& (Int -> Int
forall a. Num a => a -> a
abs Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Image -> Int
imageHeight Image
i) = Image
emptyImage
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = let s :: Int
s = Int -> Int
forall a. Num a => a -> a
abs Int
y in Image -> Int -> Int -> Int -> Image
CropTop Image
i Int
s (Image -> Int
imageWidth Image
i) (Image -> Int
imageHeight Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s)
    | Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Image
i
    | Bool
otherwise = let w :: Int
w = Image -> Int
imageWidth Image
i in Image -> Image -> Int -> Int -> Image
VertJoin (Int -> Int -> Image
BGFill Int
w Int
y) Image
i Int
w (Image -> Int
imageHeight Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)

-- | Ensure an image is no larger than the provided size. If the image
-- is larger then crop the right or bottom.
--
-- This is equivalent to a vertical crop from the bottom followed by
-- horizontal crop from the right.
crop :: Int
     -- ^ Cropping width
     -> Int
     -- ^ Cropping height
     -> Image
     -- ^ The image to crop
     -> Image
crop :: Int -> Int -> Image -> Image
crop Int
0 Int
_ Image
_ = Image
EmptyImage
crop Int
_ Int
0 Image
_ = Image
EmptyImage
crop Int
w Int
h Image
i = Int -> Image -> Image
cropBottom Int
h (Int -> Image -> Image
cropRight Int
w Image
i)

-- | Crop an image's height. If the image's height is less than or equal
-- to the specified height then this operation has no effect. Otherwise
-- the image is cropped from the bottom.
cropBottom :: Int -> Image -> Image
cropBottom :: Int -> Image -> Image
cropBottom Int
0 Image
_ = Image
EmptyImage
cropBottom Int
h Image
inI
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = String -> Image
forall a. HasCallStack => String -> a
error String
"cannot crop height to less than zero"
    | Bool
otherwise = Image -> Image
go Image
inI
        where
            go :: Image -> Image
go Image
EmptyImage = Image
EmptyImage
            go i :: Image
i@(CropBottom {Image
croppedImage :: Image -> Image
croppedImage :: Image
croppedImage, Int
outputWidth :: Image -> Int
outputWidth :: Int
outputWidth, Int
outputHeight :: Image -> Int
outputHeight :: Int
outputHeight})
                | Int
outputHeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h = Image
i
                | Bool
otherwise          = Image -> Int -> Int -> Image
CropBottom Image
croppedImage Int
outputWidth Int
h
            go Image
i
                | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Image -> Int
imageHeight Image
i = Image
i
                | Bool
otherwise           = Image -> Int -> Int -> Image
CropBottom Image
i (Image -> Int
imageWidth Image
i) Int
h

-- | Crop an image's width. If the image's width is less than or equal
-- to the specified width then this operation has no effect. Otherwise
-- the image is cropped from the right.
cropRight :: Int -> Image -> Image
cropRight :: Int -> Image -> Image
cropRight Int
0 Image
_ = Image
EmptyImage
cropRight Int
w Image
inI
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = String -> Image
forall a. HasCallStack => String -> a
error String
"cannot crop width to less than zero"
    | Bool
otherwise = Image -> Image
go Image
inI
        where
            go :: Image -> Image
go Image
EmptyImage = Image
EmptyImage
            go i :: Image
i@(CropRight {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
                | Int
outputWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = Image
i
                | Bool
otherwise         = Image -> Int -> Int -> Image
CropRight Image
croppedImage Int
w Int
outputHeight
            go Image
i
                | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Image -> Int
imageWidth Image
i = Image
i
                | Bool
otherwise          = Image -> Int -> Int -> Image
CropRight Image
i Int
w (Image -> Int
imageHeight Image
i)

-- | Crop an image's width. If the image's width is less than or equal
-- to the specified width then this operation has no effect. Otherwise
-- the image is cropped from the left.
cropLeft :: Int -> Image -> Image
cropLeft :: Int -> Image -> Image
cropLeft Int
0 Image
_ = Image
EmptyImage
cropLeft Int
w Image
inI
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = String -> Image
forall a. HasCallStack => String -> a
error String
"cannot crop the width to less than zero"
    | Bool
otherwise = Image -> Image
go Image
inI
        where
            go :: Image -> Image
go Image
EmptyImage = Image
EmptyImage
            go i :: Image
i@(CropLeft {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
leftSkip :: Image -> Int
leftSkip :: Int
leftSkip, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
                | Int
outputWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = Image
i
                | Bool
otherwise         =
                    let leftSkip' :: Int
leftSkip' = Int
leftSkip Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outputWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w
                    in Image -> Int -> Int -> Int -> Image
CropLeft Image
croppedImage Int
leftSkip' Int
w Int
outputHeight
            go Image
i
                | Image -> Int
imageWidth Image
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = Image
i
                | Bool
otherwise          = Image -> Int -> Int -> Int -> Image
CropLeft Image
i (Image -> Int
imageWidth Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) Int
w (Image -> Int
imageHeight Image
i)

-- | Crop an image's height. If the image's height is less than or equal
-- to the specified height then this operation has no effect. Otherwise
-- the image is cropped from the top.
cropTop :: Int -> Image -> Image
cropTop :: Int -> Image -> Image
cropTop Int
0 Image
_ = Image
EmptyImage
cropTop Int
h Image
inI
    | Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = String -> Image
forall a. HasCallStack => String -> a
error String
"cannot crop the height to less than zero"
    | Bool
otherwise = Image -> Image
go Image
inI
        where
            go :: Image -> Image
go Image
EmptyImage = Image
EmptyImage
            go i :: Image
i@(CropTop {Image
croppedImage :: Image
croppedImage :: Image -> Image
croppedImage, Int
topSkip :: Image -> Int
topSkip :: Int
topSkip, Int
outputWidth :: Int
outputWidth :: Image -> Int
outputWidth, Int
outputHeight :: Int
outputHeight :: Image -> Int
outputHeight})
                | Int
outputHeight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h = Image
i
                | Bool
otherwise         =
                    let topSkip' :: Int
topSkip' = Int
topSkip Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outputHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h
                    in Image -> Int -> Int -> Int -> Image
CropTop Image
croppedImage Int
topSkip' Int
outputWidth Int
h
            go Image
i
                | Image -> Int
imageHeight Image
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
h = Image
i
                | Bool
otherwise          = Image -> Int -> Int -> Int -> Image
CropTop Image
i (Image -> Int
imageHeight Image
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h) (Image -> Int
imageWidth Image
i) Int
h

-- | Generic resize. Pads and crops are added to ensure that the
-- resulting image matches the specified dimensions. This is biased to
-- pad/crop the right and bottom.
resize :: Int -> Int -> Image -> Image
resize :: Int -> Int -> Image -> Image
resize Int
w Int
h Image
i = Int -> Image -> Image
resizeHeight Int
h (Int -> Image -> Image
resizeWidth Int
w Image
i)

-- | Resize the width. Pads and crops as required to assure the given
-- display width. This is biased to pad/crop on the right.
resizeWidth :: Int -> Image -> Image
resizeWidth :: Int -> Image -> Image
resizeWidth Int
w Image
i = case Int
w Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Image -> Int
imageWidth Image
i of
    Ordering
LT -> Int -> Image -> Image
cropRight Int
w Image
i
    Ordering
EQ -> Image
i
    Ordering
GT -> Image
i Image -> Image -> Image
<|> Int -> Int -> Image
BGFill (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Image -> Int
imageWidth Image
i) (Image -> Int
imageHeight Image
i)

-- | Resize the height. Pads and crops as required to assure the given
-- display height. This is biased to pad/crop on the bottom.
resizeHeight :: Int -> Image -> Image
resizeHeight :: Int -> Image -> Image
resizeHeight Int
h Image
i = case Int
h Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Image -> Int
imageHeight Image
i of
    Ordering
LT -> Int -> Image -> Image
cropBottom Int
h Image
i
    Ordering
EQ -> Image
i
    Ordering
GT -> Image
i Image -> Image -> Image
<-> Int -> Int -> Image
BGFill (Image -> Int
imageWidth Image
i) (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Image -> Int
imageHeight Image
i)