{-# LANGUAGE BangPatterns
           , FlexibleContexts #-}

-- | Provides a way to estimate the value of a pixel at rational coordinates
-- using a linear interpolation.
module Vision.Image.Interpolate (
      Interpolable (..), bilinearInterpol
    ) where

import Data.Int
import Data.RatioInt (denominator, numerator)
import Data.Word

import Vision.Image.Class (Pixel (..), Image (..), ImagePixel, ImageChannel)
import Vision.Primitive (RPoint (..), ix2)

-- | Provides a way to apply the interpolation to every component of a pixel.
class Interpolable p where
    -- | Given a function which interpolates two points over a single channel,
    -- returns a function which interpolates two points over every channel of
    -- two pixels.
    interpol :: (PixelChannel p -> PixelChannel p -> PixelChannel p)
             -> p -> p -> p

instance Interpolable Int16 where
    interpol :: (PixelChannel Int16 -> PixelChannel Int16 -> PixelChannel Int16)
-> Int16 -> Int16 -> Int16
interpol = forall a. a -> a
id

instance Interpolable Int32 where
    interpol :: (PixelChannel Int32 -> PixelChannel Int32 -> PixelChannel Int32)
-> Int32 -> Int32 -> Int32
interpol = forall a. a -> a
id

instance Interpolable Int where
    interpol :: (PixelChannel Int -> PixelChannel Int -> PixelChannel Int)
-> Int -> Int -> Int
interpol = forall a. a -> a
id

instance Interpolable Word8 where
    interpol :: (PixelChannel Word8 -> PixelChannel Word8 -> PixelChannel Word8)
-> Word8 -> Word8 -> Word8
interpol = forall a. a -> a
id

instance Interpolable Word16 where
    interpol :: (PixelChannel Word16 -> PixelChannel Word16 -> PixelChannel Word16)
-> Word16 -> Word16 -> Word16
interpol = forall a. a -> a
id

instance Interpolable Word32 where
    interpol :: (PixelChannel Word32 -> PixelChannel Word32 -> PixelChannel Word32)
-> Word32 -> Word32 -> Word32
interpol = forall a. a -> a
id

instance Interpolable Word where
    interpol :: (PixelChannel Word -> PixelChannel Word -> PixelChannel Word)
-> Word -> Word -> Word
interpol = forall a. a -> a
id

instance Interpolable Float where
    interpol :: (PixelChannel Float -> PixelChannel Float -> PixelChannel Float)
-> Float -> Float -> Float
interpol = forall a. a -> a
id

instance Interpolable Double where
    interpol :: (PixelChannel Double -> PixelChannel Double -> PixelChannel Double)
-> Double -> Double -> Double
interpol = forall a. a -> a
id

instance Interpolable Bool where
    interpol :: (PixelChannel Bool -> PixelChannel Bool -> PixelChannel Bool)
-> Bool -> Bool -> Bool
interpol = forall a. a -> a
id

-- | Uses a bilinear interpolation to find the value of the pixel at the
-- rational coordinates.
--
-- Estimates the value of a rational point @p@ using @a@, @b@, @c@ and @d@ :
--
-- @
--       x1       x2
--
-- y1    a ------ b
--       -        -
--       -  p     -
--       -        -
-- y2    c ------ d
-- @
bilinearInterpol :: (Image i, Interpolable (ImagePixel i)
                   , Integral (ImageChannel i))
                 => i -> RPoint -> ImagePixel i
i
img bilinearInterpol :: forall i.
(Image i, Interpolable (ImagePixel i),
 Integral (ImageChannel i)) =>
i -> RPoint -> ImagePixel i
`bilinearInterpol` RPoint RatioInt
x RatioInt
y
    | Bool -> Bool
not Bool
integralX Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
integralY =
        let (!Int
x1, !RatioInt
deltaX1) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction RatioInt
x
            (!Int
y1, !RatioInt
deltaY1) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction RatioInt
y
            !x2 :: Int
x2 = Int
x1 forall a. Num a => a -> a -> a
+ Int
1
            !y2 :: Int
y2 = Int
y1 forall a. Num a => a -> a -> a
+ Int
1
            !a :: ImagePixel i
a = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 Int
y1 Int
x1
            !b :: ImagePixel i
b = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 Int
y1 Int
x2
            !c :: ImagePixel i
c = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 Int
y2 Int
x1
            !d :: ImagePixel i
d = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 Int
y2 Int
x2

            -- Computes the relative distance to the four points.
            !deltaX2 :: RatioInt
deltaX2 = RatioInt -> RatioInt
compl RatioInt
deltaX1
            !deltaY2 :: RatioInt
deltaY2 = RatioInt -> RatioInt
compl RatioInt
deltaY1

            !interpolX1 :: ImagePixel i
interpolX1 = forall p.
Interpolable p =>
(PixelChannel p -> PixelChannel p -> PixelChannel p) -> p -> p -> p
interpol (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
RatioInt -> RatioInt -> a -> a -> b
interpolChannel RatioInt
deltaX1 RatioInt
deltaX2) ImagePixel i
a ImagePixel i
b
            !interpolX2 :: ImagePixel i
interpolX2 = forall p.
Interpolable p =>
(PixelChannel p -> PixelChannel p -> PixelChannel p) -> p -> p -> p
interpol (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
RatioInt -> RatioInt -> a -> a -> b
interpolChannel RatioInt
deltaX1 RatioInt
deltaX2) ImagePixel i
c ImagePixel i
d
        in forall p.
Interpolable p =>
(PixelChannel p -> PixelChannel p -> PixelChannel p) -> p -> p -> p
interpol (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
RatioInt -> RatioInt -> a -> a -> b
interpolChannel RatioInt
deltaY1 RatioInt
deltaY2) ImagePixel i
interpolX1 ImagePixel i
interpolX2
    | Bool -> Bool
not Bool
integralX =
        let (!Int
x1, !RatioInt
deltaX1) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction RatioInt
x
            !y1 :: Int
y1     = forall a b. (RealFrac a, Integral b) => a -> b
truncate RatioInt
y
            !x2 :: Int
x2     = Int
x1 forall a. Num a => a -> a -> a
+ Int
1
            !a :: ImagePixel i
a = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 Int
y1 Int
x1
            !b :: ImagePixel i
b = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 Int
y1 Int
x2
            !deltaX2 :: RatioInt
deltaX2 = RatioInt -> RatioInt
compl RatioInt
deltaX1
        in forall p.
Interpolable p =>
(PixelChannel p -> PixelChannel p -> PixelChannel p) -> p -> p -> p
interpol (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
RatioInt -> RatioInt -> a -> a -> b
interpolChannel RatioInt
deltaX1 RatioInt
deltaX2) ImagePixel i
a ImagePixel i
b
    | Bool -> Bool
not Bool
integralY =
        let !x1 :: Int
x1     = forall a b. (RealFrac a, Integral b) => a -> b
truncate RatioInt
x
            (!Int
y1, !RatioInt
deltaY1) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction RatioInt
y
            !y2 :: Int
y2     = Int
y1 forall a. Num a => a -> a -> a
+ Int
1
            !a :: ImagePixel i
a      = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 Int
y1 Int
x1
            !c :: ImagePixel i
c      = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 Int
y2 Int
x1
            !deltaY2 :: RatioInt
deltaY2 = RatioInt -> RatioInt
compl RatioInt
deltaY1
        in forall p.
Interpolable p =>
(PixelChannel p -> PixelChannel p -> PixelChannel p) -> p -> p -> p
interpol (forall {b} {a} {a}.
(Integral b, Integral a, Integral a) =>
RatioInt -> RatioInt -> a -> a -> b
interpolChannel RatioInt
deltaY1 RatioInt
deltaY2) ImagePixel i
a ImagePixel i
c
    | Bool
otherwise = i
img forall i. Image i => i -> Point -> ImagePixel i
`index` Int -> Int -> Point
ix2 (RatioInt -> Int
numerator RatioInt
y) (RatioInt -> Int
numerator RatioInt
x)
  where
    integralX :: Bool
integralX = RatioInt -> Int
denominator RatioInt
x forall a. Eq a => a -> a -> Bool
== Int
1
    integralY :: Bool
integralY = RatioInt -> Int
denominator RatioInt
y forall a. Eq a => a -> a -> Bool
== Int
1

    -- compl delta = 1 - delta
    compl :: RatioInt -> RatioInt
compl RatioInt
delta = RatioInt
delta {
          numerator :: Int
numerator = RatioInt -> Int
denominator RatioInt
delta forall a. Num a => a -> a -> a
- RatioInt -> Int
numerator RatioInt
delta
        }
    {-# INLINE compl #-}

    -- Interpolates the value of a single channel given its two surrounding
    -- points.
    interpolChannel :: RatioInt -> RatioInt -> a -> a -> b
interpolChannel RatioInt
deltaA RatioInt
deltaB a
chanA a
chanB = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$
    -- (fromIntegral chanA) * deltaB + (fromIntegral chanB) * deltaA
    --   deltaB { numerator = int chanA * numerator deltaB }
    -- + deltaA { numerator = int chanB * numerator deltaA }
        RatioInt
deltaA {
              numerator :: Int
numerator = forall a. Integral a => a -> Int
int a
chanA forall a. Num a => a -> a -> a
* RatioInt -> Int
numerator RatioInt
deltaB
                        forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Int
int a
chanB forall a. Num a => a -> a -> a
* RatioInt -> Int
numerator RatioInt
deltaA
            }
    {-# INLINE interpolChannel #-}
{-# INLINE bilinearInterpol #-}

int :: Integral a => a -> Int
int :: forall a. Integral a => a -> Int
int = forall a b. (Integral a, Num b) => a -> b
fromIntegral