module Graphics.Image.ColorSpace (
ColorSpace(..), Alpha(..),
module Graphics.Image.ColorSpace.Luma,
module Graphics.Image.ColorSpace.RGB,
module Graphics.Image.ColorSpace.HSI,
module Graphics.Image.ColorSpace.CMYK,
module Graphics.Image.ColorSpace.YCbCr,
module Graphics.Image.ColorSpace.Gray,
Binary, Bit, on, off, isOn, isOff, fromBool, complement,
toPixelBinary, fromPixelBinary, toImageBinary, fromImageBinary,
module Graphics.Image.ColorSpace.Complex,
Applicative(..), (<$>), (<$), (<**>), liftA, liftA2, liftA3,
Word8, Word16, Word32, Word64
) where
import Control.Applicative
import Data.Word
import GHC.Float
import Graphics.Image.Interface hiding (map)
import Graphics.Image.ColorSpace.Binary
import Graphics.Image.ColorSpace.Gray
import Graphics.Image.ColorSpace.Luma
import Graphics.Image.ColorSpace.RGB
import Graphics.Image.ColorSpace.HSI
import Graphics.Image.ColorSpace.CMYK
import Graphics.Image.ColorSpace.YCbCr
import Graphics.Image.ColorSpace.Complex
import qualified Graphics.Image.Interface as I (map)
toPixelBinary :: (ColorSpace cs, Eq (Pixel cs e), Num e) => Pixel cs e -> Pixel Binary Bit
toPixelBinary px = if px == 0 then on else off
fromPixelBinary :: Pixel Binary Bit -> Pixel Y Word8
fromPixelBinary b = PixelY $ if isOn b then minBound else maxBound
toImageBinary :: (Array arr cs e, Array arr Binary Bit, Eq (Pixel cs e)) =>
Image arr cs e
-> Image arr Binary Bit
toImageBinary = I.map toPixelBinary
fromImageBinary :: (Array arr Binary Bit, Array arr Y Word8) =>
Image arr Binary Bit
-> Image arr Y Word8
fromImageBinary = I.map fromPixelBinary
instance ToY Gray where
toPixelY (PixelGray y) = PixelY y
instance ToY RGB where
toPixelY (PixelRGB r g b) = PixelY (0.299*r + 0.587*g + 0.114*b)
instance ToYA RGBA where
instance ToY HSI where
toPixelY = toPixelY . toPixelRGB
instance ToYA HSIA where
instance ToY CMYK where
toPixelY = toPixelY . toPixelRGB
instance ToY YCbCr where
toPixelY (PixelYCbCr y _ _) = PixelY y
instance ToYA YCbCrA where
instance ToRGB Y where
toPixelRGB (PixelY g) = fromChannel g
instance ToRGBA YA where
instance ToRGB HSI where
toPixelRGB (PixelHSI h s i) =
let !is = i*s
!second = i is
getFirst !a !b = i + is*cos a/cos b
getThird !v1 !v2 = i + 2*is + v1 v2
in if | h < 2*pi/3 -> let !r = getFirst h (pi/3 h)
!b = second
!g = getThird b r
in PixelRGB r g b
| h < 4*pi/3 -> let !g = getFirst (h 2*pi/3) (h + pi)
!r = second
!b = getThird r g
in PixelRGB r g b
| h < 2*pi -> let !b = getFirst (h 4*pi/3) (2*pi pi/3 h)
!g = second
!r = getThird g b
in PixelRGB r g b
| otherwise -> error ("HSI pixel is not properly scaled, Hue: "++show h)
instance ToRGBA HSIA where
instance ToRGB YCbCr where
toPixelRGB (PixelYCbCr y cb cr) = PixelRGB r g b where
!r = y + 1.402*(cr 0.5)
!g = y 0.34414*(cb 0.5) 0.71414*(cr 0.5)
!b = y + 1.772*(cb 0.5)
instance ToRGBA YCbCrA where
instance ToRGB CMYK where
toPixelRGB (PixelCMYK c m y k) = PixelRGB r g b where
!r = (1c)*(1k)
!g = (1m)*(1k)
!b = (1y)*(1k)
instance ToRGBA CMYKA where
instance ToHSI Y where
toPixelHSI (PixelY g) = PixelHSI 0 0 g
instance ToHSIA YA where
instance ToHSI RGB where
toPixelHSI (PixelRGB r g b) = PixelHSI h s i where
!h' = atan2 y x
!h = if h' < 0 then h' + 2*pi else h'
!s = if i == 0 then 0 else 1 minimum [r, g, b] / i
!i = (r + g + b) / 3
!x = (2*r g b) / 2.449489742783178
!y = (g b) / 1.4142135623730951
instance ToHSIA RGBA where
instance ToYCbCr RGB where
toPixelYCbCr (PixelRGB r g b) = PixelYCbCr y cb cr where
!y = 0.299*r + 0.587*g + 0.114*b
!cb = 0.5 0.168736*r 0.331264*g + 0.5*b
!cr = 0.5 + 0.5*r 0.418688*g 0.081312*b
instance ToYCbCrA RGBA where
instance ToCMYK RGB where
toPixelCMYK (PixelRGB r g b) = PixelCMYK c m y k where
!c = (1 r k)/(1 k)
!m = (1 g k)/(1 k)
!y = (1 b k)/(1 k)
!k = 1 max r (max g b)
instance ToCMYKA RGBA where
instance Elevator Word8 where
toWord8 = id
toWord16 = liftA toWord16' where
toWord16' !e = fromIntegral e * ((maxBound :: Word16) `div` fromIntegral (maxBound :: Word8))
toWord32 = liftA toWord32' where
toWord32' !e = fromIntegral e * ((maxBound :: Word32) `div` fromIntegral (maxBound :: Word8))
toWord64 = liftA toWord64' where
toWord64' !e = fromIntegral e * ((maxBound :: Word64) `div` fromIntegral (maxBound :: Word8))
toFloat = liftA toFloat' where
toFloat' !e = fromIntegral e / (fromIntegral (maxBound :: Word8))
toDouble = liftA toDouble' where
toDouble' !e = fromIntegral e / (fromIntegral (maxBound :: Word8))
fromDouble = toWord8
instance Elevator Word16 where
toWord8 = liftA toWord8' where
toWord8' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word16) `div`
fromIntegral (maxBound :: Word8))
toWord16 = id
toWord32 = liftA toWord32' where
toWord32' !e = fromIntegral e * ((maxBound :: Word32) `div` fromIntegral (maxBound :: Word16))
toWord64 = liftA toWord64' where
toWord64' !e = fromIntegral e * ((maxBound :: Word64) `div` fromIntegral (maxBound :: Word16))
toFloat = liftA toFloat' where
toFloat' !e = fromIntegral e / (fromIntegral (maxBound :: Word16))
toDouble = liftA toDouble' where
toDouble' !e = fromIntegral e / (fromIntegral (maxBound :: Word16))
fromDouble = toWord16
instance Elevator Word32 where
toWord8 = liftA toWord8' where
toWord8' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word32) `div`
fromIntegral (maxBound :: Word8))
toWord16 = liftA toWord16' where
toWord16' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word32) `div`
fromIntegral (maxBound :: Word16))
toWord32 = id
toWord64 = liftA toWord64' where
toWord64' !e = fromIntegral e * ((maxBound :: Word64) `div` fromIntegral (maxBound :: Word32))
toFloat = liftA toFloat' where
toFloat' !e = fromIntegral e / (fromIntegral (maxBound :: Word32))
toDouble = liftA toDouble' where
toDouble' !e = fromIntegral e / (fromIntegral (maxBound :: Word32))
fromDouble = toWord32
instance Elevator Word64 where
toWord8 = liftA toWord8' where
toWord8' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word64) `div`
fromIntegral (maxBound :: Word8))
toWord16 = liftA toWord16' where
toWord16' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word64) `div`
fromIntegral (maxBound :: Word16))
toWord32 = liftA toWord32' where
toWord32' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word64) `div`
fromIntegral (maxBound :: Word32))
toWord64 = id
toFloat = liftA toFloat' where
toFloat' !e = fromIntegral e / (fromIntegral (maxBound :: Word64))
toDouble = liftA toDouble' where
toDouble' !e = fromIntegral e / (fromIntegral (maxBound :: Word64))
fromDouble = toWord64
instance Elevator Float where
toWord8 = liftA toWord8' where
toWord8' !e = round (fromIntegral (maxBound :: Word8) * e)
toWord16 = liftA toWord16' where
toWord16' !e = round (fromIntegral (maxBound :: Word16) * e)
toWord32 = liftA toWord32' where
toWord32' !e = round (fromIntegral (maxBound :: Word32) * e)
toWord64 = liftA toWord64' where
toWord64' !e = round (fromIntegral (maxBound :: Word64) * e)
toFloat = id
toDouble = liftA float2Double
fromDouble = toFloat
instance Elevator Double where
toWord8 = liftA toWord8' where
toWord8' !e = round (fromIntegral (maxBound :: Word8) * e)
toWord16 = liftA toWord16' where
toWord16' !e = round (fromIntegral (maxBound :: Word16) * e)
toWord32 = liftA toWord32' where
toWord32' !e = round (fromIntegral (maxBound :: Word32) * e)
toWord64 = liftA toWord64' where
toWord64' !e = round (fromIntegral (maxBound :: Word64) * e)
toFloat = liftA double2Float
toDouble = id
fromDouble = id