module Graphics.Image.Processing.Geometric (
downsampleRows, downsampleCols, downsample,
upsampleRows, upsampleCols, upsample,
leftToRight, topToBottom,
crop,
flipV, flipH,
rotate90, rotate180, rotate270,
resize, scale
) where
#if MIN_VERSION_base(4,8,0)
import Prelude hiding (traverse)
#endif
import Graphics.Image.Interface
import Graphics.Image.Processing.Interpolation
downsampleF :: Array arr cs e => Int -> Int -> Image arr cs e -> Image arr cs e
downsampleF !fm !fn !img = traverse img
(\ !(m, n) -> (m `div` fm, n `div` fn))
(\ !getPx !(i, j) -> getPx (i*fm, j*fn))
upsampleF :: Array arr cs e => Int -> Int -> Image arr cs e -> Image arr cs e
upsampleF !fm !fn !img = traverse img
(\ !(m, n) -> (m*fm, n*fn))
(\ !getPx !(i, j) ->
if i `mod` fm == 0 && j `mod` fn == 0
then getPx (i `div` fm, j `div` fn)
else fromChannel 0)
downsampleRows :: Array arr cs e => Image arr cs e -> Image arr cs e
downsampleRows = downsampleF 2 1
downsampleCols :: Array arr cs e => Image arr cs e -> Image arr cs e
downsampleCols = downsampleF 1 2
downsample :: Array arr cs e => Image arr cs e -> Image arr cs e
downsample = downsampleF 2 2
upsampleRows :: Array arr cs e => Image arr cs e -> Image arr cs e
upsampleRows = upsampleF 2 1
upsampleCols :: Array arr cs e => Image arr cs e -> Image arr cs e
upsampleCols = upsampleF 1 2
upsample :: Array arr cs e => Image arr cs e -> Image arr cs e
upsample = upsampleF 2 2
leftToRight :: Array arr cs e => Image arr cs e -> Image arr cs e -> Image arr cs e
leftToRight !img1@(dims -> (_, n1)) !img2 = traverse2 img1 img2 newDims newPx where
newDims !(m1, _) !(m2, n2)
| m1 == m2 = (m1, n1 + n2)
| otherwise = error ("Images must agree in numer of rows, but received: "
++ show img1 ++ " and " ++ show img2)
newPx !getPx1 !getPx2 !(i, j) = if j < n1 then getPx1 (i, j) else getPx2 (i, jn1)
topToBottom :: Array arr cs e => Image arr cs e -> Image arr cs e -> Image arr cs e
topToBottom !img1@(dims -> (m1, _)) !img2 = traverse2 img1 img2 newDims newPx where
newDims !(_, n1) !(m2, n2)
| n1 == n2 = (m1 + m2, n1)
| otherwise = error ("Images must agree in numer of columns, but received: "
++ show img1 ++ " and " ++ show img2)
newPx !getPx1 !getPx2 !(i, j) = if i < m1 then getPx1 (i, j) else getPx2 (im1, j)
crop :: Array arr cs e =>
(Int, Int)
-> (Int, Int)
-> Image arr cs e
-> Image arr cs e
crop !(i, j) sz = backpermute sz (\ !(i', j') -> (i' + i, j' + j))
flipUsing :: Array arr cs e =>
((Int, Int) -> (Int, Int) -> (Int, Int)) -> Image arr cs e -> Image arr cs e
flipUsing getNewIndex !img@(dims -> d) = backpermute d (getNewIndex d) img
flipV :: Array arr cs e => Image arr cs e -> Image arr cs e
flipV = flipUsing (\ (m, _) !(i, j) -> (m 1 i, j))
flipH :: Array arr cs e => Image arr cs e -> Image arr cs e
flipH = flipUsing (\ (_, n) !(i, j) -> (i, n 1 j))
rotate90 :: Array arr cs e => Image arr cs e -> Image arr cs e
rotate90 = transpose . flipV
rotate180 :: Array arr cs e => Image arr cs e -> Image arr cs e
rotate180 = flipUsing (\ !(m, n) !(i, j) -> (m 1 i, n 1 j))
rotate270 :: Array arr cs e => Image arr cs e -> Image arr cs e
rotate270 = transpose . flipH
resize :: (Interpolation method, Array arr cs e, Elevator e) =>
method (Pixel cs e)
-> (Int, Int)
-> Image arr cs e
-> Image arr cs e
resize !method !sz'@(m', n') !img = traverse img (const sz') getNewPx where
!sz@(m, n) = dims img
!(fM, fN) = (fromIntegral m' / fromIntegral m, fromIntegral n' / fromIntegral n)
getNewPx !getPx !(i, j) =
interpolate method sz getPx ((fromIntegral i + 0.5) / fM 0.5, (fromIntegral j + 0.5) / fN 0.5)
scale :: (Interpolation method, Array arr cs e, Elevator e) =>
method (Pixel cs e)
-> (Double, Double)
-> Image arr cs e
-> Image arr cs e
scale !method !(fM, fN) !img@(dims -> (m, n)) =
if fM <= 0 || fN <= 0
then error "scale: scaling factor must be greater than 0."
else resize method (round (fM * fromIntegral m), round (fN * fromIntegral n)) img