module Vision.Image.HSV.Conversion () where
import Data.Convertible (Convertible (..), ConvertResult)
import Data.Word
import Vision.Image.HSV.Type (HSVPixel (..))
import Vision.Image.RGB.Type (RGBPixel (..))
import Vision.Image.RGB.Conversion ()
import Vision.Image.RGBA.Type (RGBAPixel (..))
import Vision.Image.RGBA.Conversion ()
instance Convertible HSVPixel HSVPixel where
safeConvert = Right
instance Convertible RGBPixel HSVPixel where
safeConvert !(RGBPixel r g b) =
Right pix
where
(!r', !g', !b') = (int r, int g, int b)
!pix | r >= g && r >= b =
let !c = r' min b' g'
!h = fixHue $ hue c b' g'
in HSVPixel (word8 h) (sat c r') r
| g >= r && g >= b =
let !c = g' min r' b'
!h = 60 + hue c r' b'
in HSVPixel (word8 h) (sat c g') g
| otherwise =
let !c = b' min r' g'
!h = 120 + hue c g' r'
in HSVPixel (word8 h) (sat c b') b
hue 0 _ _ = 0
hue !c !left !right = (30 * (right left)) `quot` c
sat _ 0 = 0
sat !c v = word8 $ (c * 255) `quot` v
fixHue !h | h < 0 = h + 180
| otherwise = h
instance Convertible HSVPixel RGBPixel where
safeConvert !(HSVPixel h s v) =
Right $! case h `quot` 30 of
0 -> RGBPixel v (word8 x1') (word8 m)
1 -> RGBPixel (word8 (x2 60)) v (word8 m)
2 -> RGBPixel (word8 m) v (word8 (x1 60))
3 -> RGBPixel (word8 m) (word8 (x2 120)) v
4 -> RGBPixel (word8 (x1 120)) (word8 m) v
5 -> RGBPixel v (word8 m) (word8 (x2 180))
_ -> error "Invalid hue value."
where
(!h', v') = (int h, int v)
!m = (v' * (255 int s)) `quot` 255
x1 d = (d * m d * v' + h' * v' h' * m + 30 * m) `quot` 30
x1' = ( h' * v' h' * m + 30 * m) `quot` 30
x2 d = (d * v' d * m + h' * m h' * v' + 30 * m) `quot` 30
instance Convertible RGBAPixel HSVPixel where
safeConvert pix = (safeConvert pix :: ConvertResult RGBPixel)
>>= safeConvert
instance Convertible HSVPixel RGBAPixel where
safeConvert pix = (safeConvert pix :: ConvertResult RGBPixel)
>>= safeConvert
int :: Integral a => a -> Int
int = fromIntegral
word8 :: Integral a => a -> Word8
word8 = fromIntegral