{-# LANGUAGE BangPatterns
           , MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- 'Convertible' instances for conversions between pixel types.
module Vision.Image.Conversion (Convertible (..), convert) where

import Data.Convertible (Convertible (..), ConvertResult, convert)
import Data.Word

import qualified Data.Vector.Storable as VS

import Vision.Image.Grey.Type (GreyPixel (..))
import Vision.Image.HSV.Type (HSVPixel (..))
import Vision.Image.RGBA.Type (RGBAPixel (..))
import Vision.Image.RGB.Type (RGBPixel (..))

-- to Grey ---------------------------------------------------------------------

instance Convertible GreyPixel GreyPixel where
    safeConvert :: GreyPixel -> ConvertResult GreyPixel
safeConvert = forall a b. b -> Either a b
Right
    {-# INLINE safeConvert #-}

instance Convertible HSVPixel GreyPixel where
    safeConvert :: HSVPixel -> ConvertResult GreyPixel
safeConvert HSVPixel
pix = (forall a b. Convertible a b => a -> ConvertResult b
safeConvert HSVPixel
pix :: ConvertResult RGBPixel)
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Convertible a b => a -> ConvertResult b
safeConvert

instance Convertible RGBAPixel GreyPixel where
    safeConvert :: RGBAPixel -> ConvertResult GreyPixel
safeConvert !(RGBAPixel Word8
r Word8
g Word8
b Word8
a) =
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Word8 -> GreyPixel
GreyPixel forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Word8
word8 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Int
int (Word8 -> Word8 -> Word8 -> Word8
rgbToGrey Word8
r Word8
g Word8
b) forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Int
int Word8
a forall a. Integral a => a -> a -> a
`quot` Int
255
    {-# INLINE safeConvert #-}

instance Convertible RGBPixel GreyPixel where
    safeConvert :: RGBPixel -> ConvertResult GreyPixel
safeConvert !(RGBPixel Word8
r Word8
g Word8
b) =
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Word8 -> GreyPixel
GreyPixel forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Word8
rgbToGrey Word8
r Word8
g Word8
b
    {-# INLINE safeConvert #-}

-- | Converts the colors to greyscale using the human eye colors perception.
rgbToGrey :: Word8 -> Word8 -> Word8 -> Word8
rgbToGrey :: Word8 -> Word8 -> Word8 -> Word8
rgbToGrey !Word8
r !Word8
g !Word8
b =   (Vector Word8
redLookupTable   forall a. Storable a => Vector a -> Int -> a
VS.! forall a. Integral a => a -> Int
int Word8
r)
                     forall a. Num a => a -> a -> a
+ (Vector Word8
greenLookupTable forall a. Storable a => Vector a -> Int -> a
VS.! forall a. Integral a => a -> Int
int Word8
g)
                     forall a. Num a => a -> a -> a
+ (Vector Word8
blueLookupTable  forall a. Storable a => Vector a -> Int -> a
VS.! forall a. Integral a => a -> Int
int Word8
b)
{-# INLINE rgbToGrey #-}

redLookupTable, greenLookupTable, blueLookupTable :: VS.Vector Word8
redLookupTable :: Vector Word8
redLookupTable   = forall a. Storable a => Int -> (Int -> a) -> Vector a
VS.generate Int
256 (\Int
val -> forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Double
double Int
val forall a. Num a => a -> a -> a
* Double
0.299)
greenLookupTable :: Vector Word8
greenLookupTable = forall a. Storable a => Int -> (Int -> a) -> Vector a
VS.generate Int
256 (\Int
val -> forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Double
double Int
val forall a. Num a => a -> a -> a
* Double
0.587)
blueLookupTable :: Vector Word8
blueLookupTable  = forall a. Storable a => Int -> (Int -> a) -> Vector a
VS.generate Int
256 (\Int
val -> forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Double
double Int
val forall a. Num a => a -> a -> a
* Double
0.114)

-- to HSV ----------------------------------------------------------------------

instance Convertible HSVPixel HSVPixel where
    safeConvert :: HSVPixel -> ConvertResult HSVPixel
safeConvert = forall a b. b -> Either a b
Right
    {-# INLINE safeConvert #-}

instance Convertible GreyPixel HSVPixel where
    safeConvert :: GreyPixel -> ConvertResult HSVPixel
safeConvert GreyPixel
pix = (forall a b. Convertible a b => a -> ConvertResult b
safeConvert GreyPixel
pix :: ConvertResult RGBPixel)
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Convertible a b => a -> ConvertResult b
safeConvert

instance Convertible RGBPixel HSVPixel where
-- Based on :
-- http://en.wikipedia.org/wiki/HSL_and_HSV#General_approach
    safeConvert :: RGBPixel -> ConvertResult HSVPixel
safeConvert !(RGBPixel Word8
r Word8
g Word8
b) =
        forall a b. b -> Either a b
Right HSVPixel
pix
      where
        (!Int
r', !Int
g', !Int
b') = (forall a. Integral a => a -> Int
int Word8
r, forall a. Integral a => a -> Int
int Word8
g, forall a. Integral a => a -> Int
int Word8
b)

        !pix :: HSVPixel
pix | Word8
r forall a. Ord a => a -> a -> Bool
>= Word8
g Bool -> Bool -> Bool
&& Word8
r forall a. Ord a => a -> a -> Bool
>= Word8
b = -- r == max r g b
                let !c :: Int
c = Int
r' forall a. Num a => a -> a -> a
- forall a. Ord a => a -> a -> a
min Int
b' Int
g'
                    !h :: Int
h = forall {a}. (Ord a, Num a) => a -> a
fixHue forall a b. (a -> b) -> a -> b
$ forall {a}. Integral a => a -> a -> a -> a
hue Int
c Int
b' Int
g' -- Hue can be negative
                in Word8 -> Word8 -> Word8 -> HSVPixel
HSVPixel (forall a. Integral a => a -> Word8
word8 Int
h) (forall {a}. Integral a => a -> a -> Word8
sat Int
c Int
r') Word8
r
             | Word8
g forall a. Ord a => a -> a -> Bool
>= Word8
r Bool -> Bool -> Bool
&& Word8
g forall a. Ord a => a -> a -> Bool
>= Word8
b = -- g == max r g b
                let !c :: Int
c = Int
g' forall a. Num a => a -> a -> a
- forall a. Ord a => a -> a -> a
min Int
r' Int
b'
                    !h :: Int
h = Int
60 forall a. Num a => a -> a -> a
+ forall {a}. Integral a => a -> a -> a -> a
hue Int
c Int
r' Int
b'
                in Word8 -> Word8 -> Word8 -> HSVPixel
HSVPixel (forall a. Integral a => a -> Word8
word8 Int
h) (forall {a}. Integral a => a -> a -> Word8
sat Int
c Int
g') Word8
g
             | Bool
otherwise = -- b == max r g b
                let !c :: Int
c = Int
b' forall a. Num a => a -> a -> a
- forall a. Ord a => a -> a -> a
min Int
r' Int
g'
                    !h :: Int
h = Int
120 forall a. Num a => a -> a -> a
+ forall {a}. Integral a => a -> a -> a -> a
hue Int
c Int
g' Int
r'
                in Word8 -> Word8 -> Word8 -> HSVPixel
HSVPixel (forall a. Integral a => a -> Word8
word8 Int
h) (forall {a}. Integral a => a -> a -> Word8
sat Int
c Int
b') Word8
b

        -- Returns a value in [-30; +30].
        hue :: a -> a -> a -> a
hue a
0  a
_      a
_     = a
0
        hue !a
c !a
left !a
right = (a
30 forall a. Num a => a -> a -> a
* (a
right forall a. Num a => a -> a -> a
- a
left)) forall a. Integral a => a -> a -> a
`quot` a
c

        sat :: a -> a -> Word8
sat a
_  a
0 = Word8
0
        sat !a
c a
v = forall a. Integral a => a -> Word8
word8 forall a b. (a -> b) -> a -> b
$ (a
c forall a. Num a => a -> a -> a
* a
255) forall a. Integral a => a -> a -> a
`quot` a
v

        -- Keeps the value of the hue between [0, 179].
        -- As the Hue's unit is 2°, 180 is equal to 360° and to 0°.
        fixHue :: a -> a
fixHue !a
h | a
h forall a. Ord a => a -> a -> Bool
< a
0     = a
h forall a. Num a => a -> a -> a
+ a
180
                  | Bool
otherwise = a
h

instance Convertible RGBAPixel HSVPixel where
    safeConvert :: RGBAPixel -> ConvertResult HSVPixel
safeConvert RGBAPixel
pix = (forall a b. Convertible a b => a -> ConvertResult b
safeConvert RGBAPixel
pix :: ConvertResult RGBPixel)
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Convertible a b => a -> ConvertResult b
safeConvert

-- to RGB ----------------------------------------------------------------------

instance Convertible RGBPixel RGBPixel where
    safeConvert :: RGBPixel -> ConvertResult RGBPixel
safeConvert = forall a b. b -> Either a b
Right
    {-# INLINE safeConvert #-}

instance Convertible GreyPixel RGBPixel where
    safeConvert :: GreyPixel -> ConvertResult RGBPixel
safeConvert !(GreyPixel Word8
pix) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel Word8
pix Word8
pix Word8
pix
    {-# INLINE safeConvert #-}

instance Convertible RGBAPixel RGBPixel where
    safeConvert :: RGBAPixel -> ConvertResult RGBPixel
safeConvert !(RGBAPixel Word8
r Word8
g Word8
b Word8
a) =
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel (forall a. Integral a => a -> Word8
withAlpha Word8
r) (forall a. Integral a => a -> Word8
withAlpha Word8
g) (forall a. Integral a => a -> Word8
withAlpha Word8
b)
      where
        !a' :: Int
a' = forall a. Integral a => a -> Int
int Word8
a
        withAlpha :: a -> Word8
withAlpha !a
val = forall a. Integral a => a -> Word8
word8 forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Int
int a
val forall a. Num a => a -> a -> a
* Int
a' forall a. Integral a => a -> a -> a
`quot` Int
255
        {-# INLINE withAlpha #-}
    {-# INLINE safeConvert #-}

instance Convertible HSVPixel RGBPixel where
-- Based on :
-- http://en.wikipedia.org/wiki/HSL_and_HSV#Converting_to_RGB
    safeConvert :: HSVPixel -> ConvertResult RGBPixel
safeConvert !(HSVPixel Word8
h Word8
s Word8
v) =
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! case Word8
h forall a. Integral a => a -> a -> a
`quot` Word8
30 of
                Word8
0 -> Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel Word8
v                (forall a. Integral a => a -> Word8
word8 Int
x1')      (forall a. Integral a => a -> Word8
word8 Int
m)
                Word8
1 -> Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel (forall a. Integral a => a -> Word8
word8 (Int -> Int
x2 Int
60))  Word8
v                (forall a. Integral a => a -> Word8
word8 Int
m)
                Word8
2 -> Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel (forall a. Integral a => a -> Word8
word8 Int
m)        Word8
v                (forall a. Integral a => a -> Word8
word8 (Int -> Int
x1 Int
60))
                Word8
3 -> Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel (forall a. Integral a => a -> Word8
word8 Int
m)        (forall a. Integral a => a -> Word8
word8 (Int -> Int
x2 Int
120)) Word8
v
                Word8
4 -> Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel (forall a. Integral a => a -> Word8
word8 (Int -> Int
x1 Int
120)) (forall a. Integral a => a -> Word8
word8 Int
m)        Word8
v
                Word8
5 -> Word8 -> Word8 -> Word8 -> RGBPixel
RGBPixel Word8
v                (forall a. Integral a => a -> Word8
word8 Int
m)        (forall a. Integral a => a -> Word8
word8 (Int -> Int
x2 Int
180))
                Word8
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid hue value."
      where
        (!Int
h', Int
v') = (forall a. Integral a => a -> Int
int Word8
h, forall a. Integral a => a -> Int
int Word8
v)

        -- v is the major color component whereas m is the minor one.
        !m :: Int
m = (Int
v' forall a. Num a => a -> a -> a
* (Int
255 forall a. Num a => a -> a -> a
- forall a. Integral a => a -> Int
int Word8
s)) forall a. Integral a => a -> a -> a
`quot` Int
255

        -- Computes the remaining component by resolving the hue equation,
        -- knowing v and m. x1 is when the component is on the right of the
        -- major one, x2 when on the left.
        x1 :: Int -> Int
x1 Int
d = (Int
d forall a. Num a => a -> a -> a
* Int
m forall a. Num a => a -> a -> a
- Int
d forall a. Num a => a -> a -> a
* Int
v' forall a. Num a => a -> a -> a
+ Int
h' forall a. Num a => a -> a -> a
* Int
v' forall a. Num a => a -> a -> a
- Int
h' forall a. Num a => a -> a -> a
* Int
m forall a. Num a => a -> a -> a
+ Int
30 forall a. Num a => a -> a -> a
* Int
m) forall a. Integral a => a -> a -> a
`quot` Int
30
        x1' :: Int
x1'  = (                 Int
h' forall a. Num a => a -> a -> a
* Int
v' forall a. Num a => a -> a -> a
- Int
h' forall a. Num a => a -> a -> a
* Int
m forall a. Num a => a -> a -> a
+ Int
30 forall a. Num a => a -> a -> a
* Int
m) forall a. Integral a => a -> a -> a
`quot` Int
30 -- == x1 0

        x2 :: Int -> Int
x2 Int
d = (Int
d forall a. Num a => a -> a -> a
* Int
v' forall a. Num a => a -> a -> a
- Int
d forall a. Num a => a -> a -> a
* Int
m forall a. Num a => a -> a -> a
+ Int
h' forall a. Num a => a -> a -> a
* Int
m forall a. Num a => a -> a -> a
- Int
h' forall a. Num a => a -> a -> a
* Int
v' forall a. Num a => a -> a -> a
+ Int
30 forall a. Num a => a -> a -> a
* Int
m) forall a. Integral a => a -> a -> a
`quot` Int
30
    {-# INLINE safeConvert #-}

-- to RGBA ---------------------------------------------------------------------

instance Convertible RGBAPixel RGBAPixel where
    safeConvert :: RGBAPixel -> ConvertResult RGBAPixel
safeConvert = forall a b. b -> Either a b
Right
    {-# INLINE safeConvert #-}

instance Convertible GreyPixel RGBAPixel where
    safeConvert :: GreyPixel -> ConvertResult RGBAPixel
safeConvert !(GreyPixel Word8
pix) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Word8 -> RGBAPixel
RGBAPixel Word8
pix Word8
pix Word8
pix Word8
255
    {-# INLINE safeConvert #-}

instance Convertible HSVPixel RGBAPixel where
    safeConvert :: HSVPixel -> ConvertResult RGBAPixel
safeConvert HSVPixel
pix = (forall a b. Convertible a b => a -> ConvertResult b
safeConvert HSVPixel
pix :: ConvertResult RGBPixel)
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. Convertible a b => a -> ConvertResult b
safeConvert

instance Convertible RGBPixel RGBAPixel where
    safeConvert :: RGBPixel -> ConvertResult RGBAPixel
safeConvert !(RGBPixel Word8
r Word8
g Word8
b) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Word8 -> RGBAPixel
RGBAPixel Word8
r Word8
g Word8
b Word8
255
    {-# INLINE safeConvert #-}

-- -----------------------------------------------------------------------------

double :: Integral a => a -> Double
double :: forall a. Integral a => a -> Double
double = forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

word8 :: Integral a => a -> Word8
word8 :: forall a. Integral a => a -> Word8
word8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral