{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      :  Codec.Picture.Extra
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- A collection of functions to scale, crop, flip images with JuicyPixels.
module Codec.Picture.Extra
  ( -- * Scaling
    scaleBilinear,

    -- * Cropping
    crop,
    trim,

    -- * Rotation
    flipHorizontally,
    flipVertically,
    rotateLeft90,
    rotateRight90,
    rotate180,

    -- * Other
    beside,
    below,
    square,
  )
where

import Codec.Picture
import qualified Codec.Picture.Types as M
import Control.Monad.ST
import Data.List (find, foldl1')
import Data.Maybe (fromMaybe)

-- | Scale an image using bi-linear interpolation.
scaleBilinear ::
  ( Pixel a,
    Bounded (PixelBaseComponent a),
    Integral (PixelBaseComponent a)
  ) =>
  -- | Desired width
  Int ->
  -- | Desired height
  Int ->
  -- | Original image
  Image a ->
  -- | Scaled image
  Image a
scaleBilinear :: forall a.
(Pixel a, Bounded (PixelBaseComponent a),
 Integral (PixelBaseComponent a)) =>
Int -> Int -> Image a -> Image a
scaleBilinear Int
width Int
height img :: Image a
img@Image {Int
Vector (PixelBaseComponent a)
imageWidth :: forall a. Image a -> Int
imageHeight :: forall a. Image a -> Int
imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
imageData :: Vector (PixelBaseComponent a)
imageHeight :: Int
imageWidth :: Int
..}
  | Int
width forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Int
height forall a. Ord a => a -> a -> Bool
<= Int
0 =
      forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage (forall a. HasCallStack => [Char] -> a
error [Char]
"scaleBilinear: absurd") (forall a. Ord a => a -> a -> a
max Int
0 Int
width) (forall a. Ord a => a -> a -> a
max Int
0 Int
height)
  | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
      MutableImage (PrimState (ST s)) a
mimg <- forall px (m :: * -> *).
(Pixel px, PrimMonad m) =>
Int -> Int -> m (MutableImage (PrimState m) px)
M.newMutableImage Int
width Int
height
      let sx, sy :: Float
          sx :: Float
sx = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
imageWidth forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width
          sy :: Float
sy = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
imageHeight forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height
          go :: Int -> Int -> ST s (Image a)
go Int
x' Int
y'
            | Int
x' forall a. Ord a => a -> a -> Bool
>= Int
width = Int -> Int -> ST s (Image a)
go Int
0 (Int
y' forall a. Num a => a -> a -> a
+ Int
1)
            | Int
y' forall a. Ord a => a -> a -> Bool
>= Int
height = forall a (m :: * -> *).
(Storable (PixelBaseComponent a), PrimMonad m) =>
MutableImage (PrimState m) a -> m (Image a)
M.unsafeFreezeImage MutableImage (PrimState (ST s)) a
mimg
            | Bool
otherwise = do
                let xf :: Float
xf = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x' forall a. Num a => a -> a -> a
* Float
sx
                    yf :: Float
yf = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y' forall a. Num a => a -> a -> a
* Float
sy
                    x, y :: Int
                    x :: Int
x = forall a b. (RealFrac a, Integral b) => a -> b
floor Float
xf
                    y :: Int
y = forall a b. (RealFrac a, Integral b) => a -> b
floor Float
yf
                    δx :: Float
δx = Float
xf forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
                    δy :: Float
δy = Float
yf forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y
                    pixelAt' :: Int -> Int -> a
pixelAt' Int
i Int
j =
                      forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img (forall a. Ord a => a -> a -> a
min (forall a. Enum a => a -> a
pred Int
imageWidth) Int
i) (forall a. Ord a => a -> a -> a
min (forall a. Enum a => a -> a
pred Int
imageHeight) Int
j)
                forall a (m :: * -> *).
(Pixel a, PrimMonad m) =>
MutableImage (PrimState m) a -> Int -> Int -> a -> m ()
writePixel MutableImage (PrimState (ST s)) a
mimg Int
x' Int
y' forall a b. (a -> b) -> a -> b
$
                  forall a.
(Pixel a, Integral (PixelBaseComponent a)) =>
a -> Float -> a
mulp (Int -> Int -> a
pixelAt' Int
x Int
y) ((Float
1 forall a. Num a => a -> a -> a
- Float
δx) forall a. Num a => a -> a -> a
* (Float
1 forall a. Num a => a -> a -> a
- Float
δy))
                    forall a.
(Pixel a, Bounded (PixelBaseComponent a),
 Integral (PixelBaseComponent a)) =>
a -> a -> a
`addp` forall a.
(Pixel a, Integral (PixelBaseComponent a)) =>
a -> Float -> a
mulp (Int -> Int -> a
pixelAt' (Int
x forall a. Num a => a -> a -> a
+ Int
1) Int
y) (Float
δx forall a. Num a => a -> a -> a
* (Float
1 forall a. Num a => a -> a -> a
- Float
δy))
                    forall a.
(Pixel a, Bounded (PixelBaseComponent a),
 Integral (PixelBaseComponent a)) =>
a -> a -> a
`addp` forall a.
(Pixel a, Integral (PixelBaseComponent a)) =>
a -> Float -> a
mulp (Int -> Int -> a
pixelAt' Int
x (Int
y forall a. Num a => a -> a -> a
+ Int
1)) ((Float
1 forall a. Num a => a -> a -> a
- Float
δx) forall a. Num a => a -> a -> a
* Float
δy)
                    forall a.
(Pixel a, Bounded (PixelBaseComponent a),
 Integral (PixelBaseComponent a)) =>
a -> a -> a
`addp` forall a.
(Pixel a, Integral (PixelBaseComponent a)) =>
a -> Float -> a
mulp (Int -> Int -> a
pixelAt' (Int
x forall a. Num a => a -> a -> a
+ Int
1) (Int
y forall a. Num a => a -> a -> a
+ Int
1)) (Float
δx forall a. Num a => a -> a -> a
* Float
δy)
                Int -> Int -> ST s (Image a)
go (Int
x' forall a. Num a => a -> a -> a
+ Int
1) Int
y'
      Int -> Int -> ST s (Image a)
go Int
0 Int
0
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelRGBA16 -> Image M.PixelRGBA16 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelRGBA8 -> Image M.PixelRGBA8 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelCMYK16 -> Image M.PixelCMYK16 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelCMYK8 -> Image M.PixelCMYK8 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelYCbCr8 -> Image M.PixelYCbCr8 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelRGB16 -> Image M.PixelRGB16 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelYCbCrK8 -> Image M.PixelYCbCrK8 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelRGB8 -> Image M.PixelRGB8 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelYA16 -> Image M.PixelYA16 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.PixelYA8 -> Image M.PixelYA8 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.Pixel32 -> Image M.Pixel32 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.Pixel16 -> Image M.Pixel16 #-}
{-# SPECIALIZE scaleBilinear :: Int -> Int -> Image M.Pixel8 -> Image M.Pixel8 #-}

mulp :: (Pixel a, Integral (PixelBaseComponent a)) => a -> Float -> a
mulp :: forall a.
(Pixel a, Integral (PixelBaseComponent a)) =>
a -> Float -> a
mulp a
pixel Float
x = forall a.
Pixel a =>
(PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
colorMap (forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Float
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) a
pixel
{-# INLINE mulp #-}

addp ::
  forall a.
  ( Pixel a,
    Bounded (PixelBaseComponent a),
    Integral (PixelBaseComponent a)
  ) =>
  a ->
  a ->
  a
addp :: forall a.
(Pixel a, Bounded (PixelBaseComponent a),
 Integral (PixelBaseComponent a)) =>
a -> a -> a
addp = forall a.
Pixel a =>
(Int
 -> PixelBaseComponent a
 -> PixelBaseComponent a
 -> PixelBaseComponent a)
-> a -> a -> a
mixWith (forall a b. a -> b -> a
const forall {a} {a} {b}. (Integral a, Integral a, Num b) => a -> a -> b
f)
  where
    f :: a -> a -> b
f a
x a
y =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
        (forall a. Bounded a => a
maxBound :: PixelBaseComponent a) forall a. Ord a => a -> a -> a
`min` (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y)
{-# INLINE addp #-}

-- | Crop an image. If the supplied coordinates are greater than the size of
-- the image, the image boundaries are used instead.
crop ::
  Pixel a =>
  -- | Index (X axis) of first pixel to include
  Int ->
  -- | Index (Y axis) of first pixel to include
  Int ->
  -- | Width of resulting image
  Int ->
  -- | Height of resulting image
  Int ->
  -- | Original image
  Image a ->
  -- | Cropped image
  Image a
crop :: forall a. Pixel a => Int -> Int -> Int -> Int -> Image a -> Image a
crop Int
x' Int
y' Int
w' Int
h' img :: Image a
img@Image {Int
Vector (PixelBaseComponent a)
imageData :: Vector (PixelBaseComponent a)
imageHeight :: Int
imageWidth :: Int
imageWidth :: forall a. Image a -> Int
imageHeight :: forall a. Image a -> Int
imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
..} =
  forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
gen Int
w Int
h
  where
    gen :: Int -> Int -> a
gen Int
i Int
j = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img (Int
x forall a. Num a => a -> a -> a
+ Int
i) (Int
y forall a. Num a => a -> a -> a
+ Int
j)
    x :: Int
x = forall a. Ord a => a -> a -> a
min (Int
imageWidth forall a. Num a => a -> a -> a
- Int
1) Int
x'
    y :: Int
y = forall a. Ord a => a -> a -> a
min (Int
imageHeight forall a. Num a => a -> a -> a
- Int
1) Int
y'
    w :: Int
w = forall a. Ord a => a -> a -> a
min (Int
imageWidth forall a. Num a => a -> a -> a
- Int
x) Int
w'
    h :: Int
h = forall a. Ord a => a -> a -> a
min (Int
imageHeight forall a. Num a => a -> a -> a
- Int
y) Int
h'
{-# INLINEABLE crop #-}

-- | Trim the completely transparent edges of an image.
--
-- @since 0.6.0
trim :: (Pixel a, Eq (PixelBaseComponent a)) => Image a -> Image a
trim :: forall a.
(Pixel a, Eq (PixelBaseComponent a)) =>
Image a -> Image a
trim img :: Image a
img@Image {Int
Vector (PixelBaseComponent a)
imageData :: Vector (PixelBaseComponent a)
imageHeight :: Int
imageWidth :: Int
imageWidth :: forall a. Image a -> Int
imageHeight :: forall a. Image a -> Int
imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
..} = forall a. Pixel a => Int -> Int -> Int -> Int -> Image a -> Image a
crop Int
left Int
top Int
width Int
height Image a
img
  where
    isInvisible :: a -> Bool
isInvisible a
p = forall a. Pixel a => a -> PixelBaseComponent a
pixelOpacity a
p forall a. Eq a => a -> a -> Bool
== PixelBaseComponent a
0
    isInvisibleRow :: Int -> Bool
isInvisibleRow Int
y = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {a}. (Pixel a, Eq (PixelBaseComponent a)) => a -> Bool
isInvisible forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img) Int
y forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
imageWidth forall a. Num a => a -> a -> a
- Int
1]
    isInvisibleCol :: Int -> Bool
isInvisibleCol Int
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {a}. (Pixel a, Eq (PixelBaseComponent a)) => a -> Bool
isInvisible forall a b. (a -> b) -> a -> b
$ forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img Int
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
imageHeight forall a. Num a => a -> a -> a
- Int
1]

    top :: Int
top = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
isInvisibleRow) [Int
0 .. Int
imageHeight forall a. Num a => a -> a -> a
- Int
1])
    bottom :: Int
bottom = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
isInvisibleRow) [Int
imageHeight forall a. Num a => a -> a -> a
- Int
1, Int
imageHeight forall a. Num a => a -> a -> a
- Int
2 .. Int
0]) forall a. Num a => a -> a -> a
+ Int
1
    height :: Int
height = Int
bottom forall a. Num a => a -> a -> a
- Int
top

    left :: Int
left = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
isInvisibleCol) [Int
0 .. Int
imageWidth forall a. Num a => a -> a -> a
- Int
1])
    right :: Int
right = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
isInvisibleCol) [Int
imageWidth forall a. Num a => a -> a -> a
- Int
1, Int
imageWidth forall a. Num a => a -> a -> a
- Int
2 .. Int
1]) forall a. Num a => a -> a -> a
+ Int
1
    width :: Int
width = Int
right forall a. Num a => a -> a -> a
- Int
left
{-# INLINEABLE trim #-}

-- | Flip an image horizontally.
flipHorizontally :: Pixel a => Image a -> Image a
flipHorizontally :: forall a. Pixel a => Image a -> Image a
flipHorizontally img :: Image a
img@Image {Int
Vector (PixelBaseComponent a)
imageData :: Vector (PixelBaseComponent a)
imageHeight :: Int
imageWidth :: Int
imageWidth :: forall a. Image a -> Int
imageHeight :: forall a. Image a -> Int
imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
..} =
  forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
gen Int
imageWidth Int
imageHeight
  where
    gen :: Int -> Int -> a
gen Int
x = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img (Int
imageWidth forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
x)
{-# INLINEABLE flipHorizontally #-}

-- | Flip an image vertically.
flipVertically :: Pixel a => Image a -> Image a
flipVertically :: forall a. Pixel a => Image a -> Image a
flipVertically img :: Image a
img@Image {Int
Vector (PixelBaseComponent a)
imageData :: Vector (PixelBaseComponent a)
imageHeight :: Int
imageWidth :: Int
imageWidth :: forall a. Image a -> Int
imageHeight :: forall a. Image a -> Int
imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
..} =
  forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
gen Int
imageWidth Int
imageHeight
  where
    gen :: Int -> Int -> a
gen Int
x Int
y = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img Int
x (Int
imageHeight forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
y)
{-# INLINEABLE flipVertically #-}

-- | Rotate an image to the left by 90°.
rotateLeft90 :: Pixel a => Image a -> Image a
rotateLeft90 :: forall a. Pixel a => Image a -> Image a
rotateLeft90 img :: Image a
img@Image {Int
Vector (PixelBaseComponent a)
imageData :: Vector (PixelBaseComponent a)
imageHeight :: Int
imageWidth :: Int
imageWidth :: forall a. Image a -> Int
imageHeight :: forall a. Image a -> Int
imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
..} =
  forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
gen Int
imageHeight Int
imageWidth
  where
    gen :: Int -> Int -> a
gen Int
x Int
y = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img (Int
imageWidth forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
y) Int
x
{-# INLINEABLE rotateLeft90 #-}

-- | Rotate an image to the right by 90°.
rotateRight90 :: Pixel a => Image a -> Image a
rotateRight90 :: forall a. Pixel a => Image a -> Image a
rotateRight90 img :: Image a
img@Image {Int
Vector (PixelBaseComponent a)
imageData :: Vector (PixelBaseComponent a)
imageHeight :: Int
imageWidth :: Int
imageWidth :: forall a. Image a -> Int
imageHeight :: forall a. Image a -> Int
imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
..} =
  forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
gen Int
imageHeight Int
imageWidth
  where
    gen :: Int -> Int -> a
gen Int
x Int
y = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img Int
y (Int
imageHeight forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
x)
{-# INLINEABLE rotateRight90 #-}

-- | Rotate an image by 180°, i.e flip both vertically and horizontally.
--
-- @since 0.2.0
rotate180 :: Pixel a => Image a -> Image a
rotate180 :: forall a. Pixel a => Image a -> Image a
rotate180 img :: Image a
img@(Image Int
w Int
h Vector (PixelBaseComponent a)
_) = forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
g Int
w Int
h
  where
    g :: Int -> Int -> a
g Int
x Int
y = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img (Int
w forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
x) (Int
h forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
y)
{-# INLINEABLE rotate180 #-}

-- | Create an image by placing several images side by side. If the images
-- are of differnet heights the smallest height is used.
--
-- @since 0.2.0
beside :: Pixel a => [Image a] -> Image a
beside :: forall a. Pixel a => [Image a] -> Image a
beside = forall a. (a -> a -> a) -> [a] -> a
foldl1' forall a. Pixel a => Image a -> Image a -> Image a
go
  where
    go :: Pixel a => Image a -> Image a -> Image a
    go :: forall a. Pixel a => Image a -> Image a -> Image a
go img1 :: Image a
img1@(Image Int
w1 Int
h1 Vector (PixelBaseComponent a)
_) img2 :: Image a
img2@(Image Int
w2 Int
h2 Vector (PixelBaseComponent a)
_) =
      forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
g (Int
w1 forall a. Num a => a -> a -> a
+ Int
w2) Int
h
      where
        g :: Int -> Int -> a
g Int
x
          | Int
x forall a. Ord a => a -> a -> Bool
< Int
w1 = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img1 Int
x
          | Bool
otherwise = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img2 (Int
x forall a. Num a => a -> a -> a
- Int
w1)
        h :: Int
h = forall a. Ord a => a -> a -> a
min Int
h1 Int
h2
{-# INLINEABLE beside #-}

-- | Create an image by placing several images in a vertical stack. If the
-- images are of differnet widths the smallest width is used.
--
-- @since 0.2.0
below :: Pixel a => [Image a] -> Image a
below :: forall a. Pixel a => [Image a] -> Image a
below = forall a. (a -> a -> a) -> [a] -> a
foldl1' forall a. Pixel a => Image a -> Image a -> Image a
go
  where
    go :: Pixel a => Image a -> Image a -> Image a
    go :: forall a. Pixel a => Image a -> Image a -> Image a
go img1 :: Image a
img1@(Image Int
w1 Int
h1 Vector (PixelBaseComponent a)
_) img2 :: Image a
img2@(Image Int
w2 Int
h2 Vector (PixelBaseComponent a)
_) =
      forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
g Int
w (Int
h1 forall a. Num a => a -> a -> a
+ Int
h2)
      where
        g :: Int -> Int -> a
g Int
x Int
y
          | Int
y forall a. Ord a => a -> a -> Bool
< Int
h1 = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img1 Int
x Int
y
          | Bool
otherwise = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img2 Int
x (Int
y forall a. Num a => a -> a -> a
- Int
h1)
        w :: Int
w = forall a. Ord a => a -> a -> a
min Int
w1 Int
w2
{-# INLINEABLE below #-}

-- | Make an image a perfect square by adding filler around it.
--
-- @since 0.6.0
square :: Pixel a => a -> Image a -> Image a
square :: forall a. Pixel a => a -> Image a -> Image a
square a
filler img :: Image a
img@Image {Int
Vector (PixelBaseComponent a)
imageData :: Vector (PixelBaseComponent a)
imageHeight :: Int
imageWidth :: Int
imageWidth :: forall a. Image a -> Int
imageHeight :: forall a. Image a -> Int
imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
..} =
  if Int
imageWidth forall a. Eq a => a -> a -> Bool
== Int
imageHeight
    then Image a
img
    else forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
generateImage Int -> Int -> a
gen Int
size Int
size
  where
    size :: Int
size = forall a. Ord a => a -> a -> a
max Int
imageWidth Int
imageHeight
    extraWidth :: Int
extraWidth = Int
size forall a. Num a => a -> a -> a
- Int
imageWidth
    extraHeight :: Int
extraHeight = Int
size forall a. Num a => a -> a -> a
- Int
imageHeight
    offsetX :: Int
offsetX = Int
extraWidth forall a. Integral a => a -> a -> a
`div` Int
2
    offsetY :: Int
offsetY = Int
extraHeight forall a. Integral a => a -> a -> a
`div` Int
2
    gen :: Int -> Int -> a
gen Int
i Int
_ | Int
i forall a. Ord a => a -> a -> Bool
< Int
offsetX = a
filler
    gen Int
i Int
_ | Int
i forall a. Ord a => a -> a -> Bool
>= Int
imageWidth forall a. Num a => a -> a -> a
+ Int
offsetX = a
filler
    gen Int
_ Int
j | Int
j forall a. Ord a => a -> a -> Bool
< Int
offsetY = a
filler
    gen Int
_ Int
j | Int
j forall a. Ord a => a -> a -> Bool
>= Int
imageHeight forall a. Num a => a -> a -> a
+ Int
offsetY = a
filler
    gen Int
i Int
j = forall a. Pixel a => Image a -> Int -> Int -> a
pixelAt Image a
img (Int
i forall a. Num a => a -> a -> a
- Int
offsetX) (Int
j forall a. Num a => a -> a -> a
- Int
offsetY)
{-# INLINEABLE square #-}