module Data.Prizm.Color.CIE
( clamp
, refWhite
, toRGBMatrix
, transformLAB
, calcLCHHue
, transformRGB
, transformXYZ
, v1
, v2
) where
import Control.Applicative
import Data.Convertible.Base
import Data.Convertible.Utils
import Data.MonoTraversable
import Data.Prizm.Color.Matrices.XYZ
import qualified Data.Prizm.Color.SRGB as S
import Data.Prizm.Color.Transform
import Data.Prizm.Types
instance PresetColor CIELCH where
white = CIELCH 0.0 0.0 360.0
black = CIELCH 100.0 0.0 360.0
instance BlendableColor CIELCH where
interpolate w ((CIELCH al ac ah), (CIELCH bl bc bh)) =
let w' = pct w
(CIELCH nl nc nh) = omap (*w') (CIELCH (bl al) (bc ac) (shortestPath (bh ah)))
in CIELCH (al + nl) (ac + nc) (ah + nh)
instance AdjustableColor CIELCH where
lightness (CIELCH l c h) w =
CIELCH (clamp (l + (100*(pct (pctClamp w)))) 100.0) c h
hue (CIELCH l c h) w =
CIELCH l c (clamp (h + (360*(pct (pctClamp w)))) 360.0)
chroma (CIELCH l c h) w =
CIELCH l (clamp (c + (120*(pct (pctClamp w)))) 120.0) h
clamp :: Double -> Double -> Double
clamp i clmp = max (min i clmp) 0.0
v1 :: Double
v1 = (6/29) ** 3
v2 :: Double
v2 = 1/3 * ((29/6) ** 2)
refWhite :: [Double]
refWhite = [95.047, 100.000, 108.883]
transformXYZ :: Double -> Double
transformXYZ v | cv > v1 = cv
| otherwise = (v 16 / 116) / v2
where cv = v**3
calcLCHHue :: Double -> Double
calcLCHHue v | v > 0 = (v / pi) * 180
| otherwise = 360 ((abs v) / pi) * 180
transformLAB :: Double -> Double
transformLAB v | v > v1 = v ** (1/3)
| otherwise = (v2 * v) + (16 / 116)
transformRGB :: Double -> Integer
transformRGB v | v > 0.0031308 = min (round (255 * (1.055 * (v ** (1 / 2.4)) 0.055))) 255
| otherwise = min (round (255 * (12.92 * v))) 255
toRGBMatrix :: XYZtoRGB -> CIEXYZ -> RGB
toRGBMatrix (XYZtoRGB m) (CIEXYZ x y z) =
let t = ZipList ((/100) <$> [x,y,z])
[r,g,b] = (fromIntegral . S.clamp . transformRGB) <$> ((zipTransform t) <$> m)
in RGB r g b
instance Convertible CIELAB CIELCH where
safeConvert (CIELAB l a b) =
let h = calcLCHHue (atan2 b a)
c = sqrt ((a^(2 :: Int)) + (b^(2 :: Int)))
in Right $ CIELCH l c h
instance Convertible CIELAB CIEXYZ where
safeConvert (CIELAB l a b) =
let y = (l + 16) / 116
x = a / 500 + y
z = y b / 200
[nx,ny,nz] = getZipList $ ((*) <$> ZipList (transformXYZ <$> [x,y,z])) <*> ZipList refWhite
in Right $ CIEXYZ nx ny nz
instance Convertible CIELAB RGB where
safeConvert = convertVia (undefined :: CIEXYZ)
instance Convertible CIELAB Hex where
safeConvert = convertVia (undefined :: RGB)
instance Convertible RGB CIELAB where
safeConvert = convertVia (undefined :: CIEXYZ)
instance Convertible RGB CIELCH where
safeConvert = convertVia (undefined :: CIELAB)
instance Convertible Hex CIELAB where
safeConvert = convertVia (undefined :: RGB)
instance Convertible Hex CIELCH where
safeConvert = convertVia (undefined :: RGB)
instance Convertible CIELCH CIELAB where
safeConvert (CIELCH l c h) =
let v = h * pi / 180
in Right $ CIELAB l ((cos v)*c) ((sin v)*c)
instance Convertible CIELCH RGB where
safeConvert = convertVia (undefined :: CIELAB)
instance Convertible CIELCH CIEXYZ where
safeConvert = convertVia (undefined :: CIELAB)
instance Convertible CIEXYZ RGB where
safeConvert = Right . toRGBMatrix d65SRGB
instance Convertible CIEXYZ Hex where
safeConvert = convertVia (undefined :: RGB)
instance Convertible CIEXYZ CIELCH where
safeConvert = convertVia (undefined :: CIELAB)
instance Convertible CIEXYZ CIELAB where
safeConvert (CIEXYZ x y z) =
let v = getZipList $ ZipList ((/) <$> [x,y,z]) <*> ZipList refWhite
[tx,ty,tz] = (transformLAB) <$> v
l = (116 * ty) 16
a = 500 * (tx ty)
b = 200 * (ty tz)
in Right $ CIELAB l a b
instance Convertible Hex CIEXYZ where
safeConvert = convertVia (undefined :: RGB)