module Graphics.Image.ColorSpace (
ColorSpace, Pixel(..), AlphaSpace(..), Elevator(..),
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,
Word8, Word16, Word32, Word64
) where
import Data.Word
import Data.Int
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 :: (Eq (Pixel cs e), Num (Pixel cs 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) = broadcastC g
instance ToRGBA YA where
instance ToRGB HSI where
toPixelRGB (PixelHSI h' s i) = getRGB (h'*2*pi) where
!is = i*s
!second = i is
getFirst !a !b = i + is*cos a/cos b
getThird !v1 !v2 = i + 2*is + v1 v2
getRGB h
| h < 0 = error ("HSI pixel is not properly scaled, Hue: "++show h')
| 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') / (2*pi)
!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
dropDown :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
dropDown !e = fromIntegral $ fromIntegral e `div` ((maxBound :: a) `div`
fromIntegral (maxBound :: b))
raiseUp :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
raiseUp !e = fromIntegral e * ((maxBound :: b) `div` fromIntegral (maxBound :: a))
squashTo1 :: forall a b. (Fractional b, Integral a, Bounded a) => a -> b
squashTo1 !e = fromIntegral e / fromIntegral (maxBound :: a)
stretch :: forall a b. (RealFrac a, Floating a, Integral b, Bounded b) => a -> b
stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e)
clamp01 :: (Ord a, Floating a) => a -> a
clamp01 !x = min (max 0 x) 1
instance Elevator Word8 where
toWord8 = id
toWord16 = raiseUp
toWord32 = raiseUp
toWord64 = raiseUp
toFloat = squashTo1
toDouble = squashTo1
fromDouble = toWord8
instance Elevator Word16 where
toWord8 = dropDown
toWord16 = id
toWord32 = raiseUp
toWord64 = raiseUp
toFloat = squashTo1
toDouble = squashTo1
fromDouble = toWord16
instance Elevator Word32 where
toWord8 = dropDown
toWord16 = dropDown
toWord32 = id
toWord64 = raiseUp
toFloat = squashTo1
toDouble = squashTo1
fromDouble = toWord32
instance Elevator Word64 where
toWord8 = dropDown
toWord16 = dropDown
toWord32 = dropDown
toWord64 = id
toFloat = squashTo1
toDouble = squashTo1
fromDouble = toWord64
instance Elevator Word where
toWord8 = dropDown
toWord16 = dropDown
toWord32 = dropDown
toWord64 = fromIntegral
toFloat = squashTo1
toDouble = squashTo1
fromDouble = stretch . clamp01
instance Elevator Int8 where
toWord8 = fromIntegral . (max 0)
toWord16 = raiseUp . (max 0)
toWord32 = raiseUp . (max 0)
toWord64 = raiseUp . (max 0)
toFloat = squashTo1 . (max 0)
toDouble = squashTo1 . (max 0)
fromDouble = stretch . clamp01
instance Elevator Int16 where
toWord8 = dropDown . (max 0)
toWord16 = fromIntegral . (max 0)
toWord32 = raiseUp . (max 0)
toWord64 = raiseUp . (max 0)
toFloat = squashTo1 . (max 0)
toDouble = squashTo1 . (max 0)
fromDouble = stretch . clamp01
instance Elevator Int32 where
toWord8 = dropDown . (max 0)
toWord16 = dropDown . (max 0)
toWord32 = fromIntegral . (max 0)
toWord64 = raiseUp . (max 0)
toFloat = squashTo1 . (max 0)
toDouble = squashTo1 . (max 0)
fromDouble = stretch . clamp01
instance Elevator Int64 where
toWord8 = dropDown . (max 0)
toWord16 = dropDown . (max 0)
toWord32 = dropDown . (max 0)
toWord64 = fromIntegral . (max 0)
toFloat = squashTo1 . (max 0)
toDouble = squashTo1 . (max 0)
fromDouble = stretch . clamp01
instance Elevator Int where
toWord8 = dropDown . (max 0)
toWord16 = dropDown . (max 0)
toWord32 = dropDown . (max 0)
toWord64 = fromIntegral . (max 0)
toFloat = squashTo1 . (max 0)
toDouble = squashTo1 . (max 0)
fromDouble = stretch . clamp01
instance Elevator Float where
toWord8 = stretch . clamp01
toWord16 = stretch . clamp01
toWord32 = stretch . clamp01
toWord64 = stretch . clamp01
toFloat = id
toDouble = float2Double
fromDouble = toFloat
instance Elevator Double where
toWord8 = stretch . clamp01
toWord16 = stretch . clamp01
toWord32 = stretch . clamp01
toWord64 = stretch . clamp01
toFloat = double2Float
toDouble = id
fromDouble = id