#if __GLASGOW_HASKELL__ >= 800
#endif
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 qualified Data.Complex as C
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
instance (Num e, Elevator e, RealFloat e) => Elevator (C.Complex e) where
toWord8 = toWord8 . C.realPart
toWord16 = toWord16 . C.realPart
toWord32 = toWord32 . C.realPart
toWord64 = toWord64 . C.realPart
toFloat = toFloat . C.realPart
toDouble = toDouble . C.realPart
fromDouble = (C.:+ 0) . fromDouble