prizm 0.2.0.0 → 0.2.1.0
raw patch · 9 files changed
+122/−60 lines, 9 filesdep ~QuickCheckdep ~basedep ~test-framework
Dependency ranges changed: QuickCheck, base, test-framework, test-framework-quickcheck2
Files
- CHANGES +7/−0
- README.md +29/−13
- prizm.cabal +5/−5
- src/Data/Prizm/Color.hs +38/−27
- src/Data/Prizm/Color/CIE.hs +24/−6
- src/Data/Prizm/Color/Matrices/RGB.hs +3/−3
- src/Data/Prizm/Color/Matrices/XYZ.hs +3/−3
- src/Data/Prizm/Color/SRGB.hs +1/−1
- src/Data/Prizm/Types.hs +12/−2
CHANGES view
@@ -1,3 +1,10 @@+0.2.1.0+=======++- Adding conversion functions for CIE L*ab and CIE L*Ch.+- Blending is now done in the CIE L*Ch color space.+- Tests for L*ab to L*Ch now pass.+ 0.2.0.0 =======
README.md view
@@ -12,32 +12,48 @@ There is some overlap with the Haskell Colour Module that already exists; however, this library is filling a couple of needs the other doesn't satisfy. +## TODO++This module is getting kind of messy, I want to refactor how everything is organized. I also need to fix the types.+ ## Supported Algorithms - sRGB <-> CIE XYZ - CIE XYZ <-> CIE L\*a\*b\*+- CIE L\*\a\*b <-> CIE L\*C\*h ## Roadmap -### 0.1.0.2-Make sure all of the conversion formulas convert losslessly at an acceptable level of precision.+### 0.3.0.0 -### 0.1.0.3-All color types should have instances for Functor so fmap can work over their values.-All color types should have instances for Applicative to make computations cleaner.+I really want to clean up the API - right now stuff is just "everywhere" and the different color spaces should have+their own modules with their own convenience conversions to/from RGB to minimize the amount of function chaining+required. -### 0.1.0.4-Conversion functions for sRGB to HEX.+I also want to figure out a way of testing the lighten/darken, interpolation, and hue transformation functions. -### 1.0.0.0-Implementations for+### 0.2.1.0 -- color mixing+Blending is now switched over to using CIE L*Ch color space for more accurate blending.++### 0.2.0.0+Functions for++- color blending - tint / shade - darken / lighten-- hue-- saturation-- inversion++### 0.1.0.4+Conversion functions for sRGB to HEX.++### 0.1.0.3+All color types should have instances for Functor so fmap can work over their values.+All color types should have instances for Applicative to make computations cleaner.++### 0.1.0.2+Make sure all of the conversion formulas convert losslessly at an acceptable level of precision.+ [General Color Formulas, Data, and Algorithms](http://www.brucelindbloom.com/index.html?Info.html) [CIE Conversion Mathematics](http://rip94550.wordpress.com/2011/07/04/color-cielab-and-tristimulus-xyz/) [Conversion Algorithm Sources](http://www.easyrgb.com/index.php?X=MATH&H=01)+[Good list of useful color manipulation](https://github.com/mikeemoo/ColorJizz-PHP/blob/master/src/MischiefCollective/ColorJizz/ColorJizz.php)
prizm.cabal view
@@ -1,5 +1,5 @@ Name: prizm-Version: 0.2.0.0+Version: 0.2.1.0 Synopsis: A haskell library for computing with colors Description: Prizm can convert between many different color@@ -44,7 +44,7 @@ ghc-options: -Wall - build-depends: base ==4.5.*,+ build-depends: base >= 4.5 && < 5, text >= 0.11.2.3 test-suite tests@@ -60,6 +60,6 @@ build-depends: prizm, base >= 4,- QuickCheck >= 2.4,- test-framework >= 0.4,- test-framework-quickcheck2 >= 0.2+ QuickCheck >= 2.5,+ test-framework >= 0.8,+ test-framework-quickcheck2 >= 0.3.0
src/Data/Prizm/Color.hs view
@@ -1,8 +1,8 @@ module Data.Prizm.Color where import Control.Applicative+ import Data.Prizm.Types-import Data.Prizm.Color.CIE as C pct :: Integer -> Double pct = (/100) . fromIntegral . (max 0) . (min 100)@@ -10,38 +10,49 @@ pctClamp :: Integer -> Integer pctClamp i = max (min i 100) 0 --- | Blend two colors using a 50% weighted average.-blend :: (CIEXYZ Double, CIEXYZ Double) -> CIEXYZ Double-blend = blendWeighted 50+clamp :: Double -> Double -> Double+clamp i clmp = max (min i clmp) 0.0 +-- | Blend two colors using an interpolation value of 50%.+(<|>) :: (CIELCH Double, CIELCH Double) -> CIELCH Double+(<|>) = interpolate 50+ -- | Shade a color by blending it using a weight and the color black.-shade :: CIEXYZ Double -> Percent -> CIEXYZ Double-shade c w = blendWeighted (pctClamp w) (CIEXYZ 0.0 0.0 0.0, c)+shade :: CIELCH Double -> Percent -> CIELCH Double+shade c w = interpolate (pctClamp w) (c, CIELCH 0.0 0.0 360.0) -- | Tint a color by blending it using a weight and the color white.-tint :: CIEXYZ Double -> Percent -> CIEXYZ Double-tint c w = blendWeighted (pctClamp w) ((CIEXYZ 95.047 100.0 108.883), c)+tint :: CIELCH Double -> Percent -> CIELCH Double+tint c w = interpolate (pctClamp w) (c, CIELCH 100.0 0.0 360.0) -darken :: CIEXYZ Double -> Percent -> CIEXYZ Double-darken c w =- let (CIELAB l a b) = C.toLAB c- l' = l - (l*(pct (pctClamp w)))- in C.toXYZ (CIELAB l' a b)+-- | Darken a color by converting it to CIE L*a*b* first, multiplying+-- it by the weight, and then subtracting that value from the original+-- L* value and converting the whole back to XYZ.+darken :: CIELCH Double -> Percent -> CIELCH Double+darken (CIELCH l c h) w = (CIELCH (l - (l*(pct (pctClamp w)))) c h) -lighten :: CIEXYZ Double -> Percent -> CIEXYZ Double-lighten c w =- let (CIELAB l a b) = C.toLAB c- l' = l + (l*(pct (pctClamp w)))- in C.toXYZ (CIELAB l' a b)+-- | Lighten a color by converting it to CIE L*a*b* first, multiplying+-- it by the weight, and then adding that value to the original L*+-- value and converting the whole back to XYZ.+lighten :: CIELCH Double -> Percent -> CIELCH Double+lighten (CIELCH l c h) w = (CIELCH (l + (l*(pct (pctClamp w)))) c h) --- | Blend using a weighted average for two XYZ colors.+-- | Interpolate two colors -- --- Weight are applied left to right, so if a weight of 25% is--- supplied, then the color on the left will be multiplied by 25% and--- the second color will be multiplied by 75%.-blendWeighted :: Percent -> (CIEXYZ Double, CIEXYZ Double) -> CIEXYZ Double-blendWeighted w (a,b) =+-- Weight is applied left to right, so if a weight of 25% is supplied,+-- then the color on the left will be multiplied by 25% and the second+-- color will be multiplied by 75%.+-- +-- CIE L*Ch is used because the interpolation between the colors is+-- more accurate than L*ab, XYZ, and sRGB color spaces.+interpolate :: Percent -> (CIELCH Double, CIELCH Double) -> CIELCH Double+interpolate w (a,b) = let w' = (pct (pctClamp w))- a1 = (*w') <$> a- b1 = (*(1.0 - w')) <$> b- in (+) <$> a1 <*> b1+ (CIELCH l c h) = (-) <$> b <*> a+ a' = (*w') <$> (CIELCH l c (shortestPath h))+ in (+) <$> a' <*> a++shortestPath :: Double -> Double+shortestPath h | h > 180 = h - 360+ | h < (-180) = h + 360+ | otherwise = h
src/Data/Prizm/Color/CIE.hs view
@@ -4,10 +4,14 @@ , toRGBMatrix , toLAB , toXYZ+, toLCH+, lchToLAB ) where import Control.Applicative +import Data.Angle+ import Data.Prizm.Types import Data.Prizm.Color.SRGB (clamp) import Data.Prizm.Color.Transform@@ -33,12 +37,16 @@ | otherwise = min (round ((12.92 * v) * 255)) 255 transformLAB :: Double -> Double-transformLAB v | v > v1 = v ** (1/3)- | otherwise = (v2 * v) + (16 / 116)+transformLAB v | v > v1 = v ** (1/3)+ | otherwise = (v2 * v) + (16 / 116) +transformLCH :: Double -> Double+transformLCH v | v > 0 = (v / pi) * 180+ | otherwise = 360 - ((abs v) / pi) * 180+ transformXYZ :: Double -> Double-transformXYZ v | cv > v1 = cv- | otherwise = (v - 16 / 116) / v2+transformXYZ v | cv > v1 = cv+ | otherwise = (v - 16 / 116) / v2 where cv = v**3 -- | @toRGB@ convert a CIE color to an SRGB color.@@ -50,7 +58,7 @@ toRGB = (toRGBMatrix d65SRGB) toRGBMatrix :: XYZtoRGB -> CIEXYZ Double -> RGB Integer-toRGBMatrix m (CIEXYZ x y z) =+toRGBMatrix (XYZtoRGB m) (CIEXYZ x y z) = let t = ZipList ((/100) <$> [x,y,z]) [r,g,b] = (transformRGB) <$> ((zipTransform t) <$> m) in (clamp) <$> RGB r g b@@ -64,6 +72,17 @@ b = 200 * (ty - tz) in CIELAB l a b +toLCH :: CIELAB Double -> CIELCH Double+toLCH (CIELAB l a b) =+ let h = transformLCH (atan2 b a)+ c = sqrt ((a^2) + (b^2))+ in CIELCH l c h++lchToLAB :: CIELCH Double -> CIELAB Double+lchToLAB (CIELCH l c h) =+ let v = h * pi / 180+ in CIELAB l ((cos v)*c) ((sin v)*c)+ toXYZ :: CIELAB Double -> CIEXYZ Double toXYZ (CIELAB l a b) = let y = (l + 16) / 116@@ -71,4 +90,3 @@ z = y - b / 200 [nx,ny,nz] = getZipList $ ((*) <$> ZipList ((transformXYZ) <$> [x,y,z])) <*> ZipList refWhite in CIEXYZ nx ny nz-
src/Data/Prizm/Color/Matrices/RGB.hs view
@@ -1,17 +1,17 @@ module Data.Prizm.Color.Matrices.RGB where -import Data.Prizm.Types (RGBtoXYZ)+import Data.Prizm.Types -- http://www.brucelindbloom.com/index.html?Eqn_RGB_XYZ_Matrix.html d65SRGB :: RGBtoXYZ-d65SRGB = [+d65SRGB = RGBtoXYZ [ [0.4124564, 0.3575761, 0.1804375], [0.2126729, 0.7151522, 0.0721750], [0.0193339, 0.1191920, 0.9503041]] d65Adobe :: RGBtoXYZ-d65Adobe = [+d65Adobe = RGBtoXYZ [ [0.5767309],[0.1855540],[0.1881852], [0.2973769],[0.6273491],[0.0752741], [0.0270343],[0.0706872],[0.9911085]]
src/Data/Prizm/Color/Matrices/XYZ.hs view
@@ -1,17 +1,17 @@ module Data.Prizm.Color.Matrices.XYZ where -import Data.Prizm.Types (XYZtoRGB)+import Data.Prizm.Types -- http://www.brucelindbloom.com/index.html?Eqn_RGB_XYZ_Matrix.html d65SRGB :: XYZtoRGB-d65SRGB = [+d65SRGB = XYZtoRGB [ [3.2404542, (-1.5371385), (-0.4985314)], [(-0.9692660), 1.8760108, 0.0415560], [0.0556434, (-0.2040259), 1.0572252]] d65Adobe :: XYZtoRGB-d65Adobe = [+d65Adobe = XYZtoRGB [ [2.0413690],[(-0.5649464)],[(-0.3446944)], [(-0.9692660)],[1.8760108],[0.0415560], [0.0134474],[(-0.1183897)],[1.0154096]]
src/Data/Prizm/Color/SRGB.hs view
@@ -57,7 +57,7 @@ toXYZ = (toXYZMatrix d65SRGB) toXYZMatrix :: RGBtoXYZ -> RGB Integer -> CIEXYZ Double-toXYZMatrix m (RGB r g b) =+toXYZMatrix (RGBtoXYZ m) (RGB r g b) = let t = ZipList (transform <$> (clamp <$> [r,g,b])) [x,y,z] = (roundN 3) <$> ((zipTransform t) <$> m) in CIEXYZ x y z
src/Data/Prizm/Types.hs view
@@ -2,8 +2,8 @@ import Control.Applicative -type RGBtoXYZ = [[Double]]-type XYZtoRGB = [[Double]]+newtype RGBtoXYZ = RGBtoXYZ [[Double]] deriving (Eq, Ord, Show)+newtype XYZtoRGB = XYZtoRGB [[Double]] deriving (Eq, Ord, Show) type Hex = String @@ -18,6 +18,9 @@ data CIELAB a = CIELAB !a !a !a deriving (Eq, Ord, Show) +data CIELCH a = CIELCH !a !a !a+ deriving (Eq, Ord, Show)+ -- | Functor instances instance Functor RGB where fmap f (RGB r g b) = (RGB (f r) (f g) (f b))@@ -28,6 +31,9 @@ instance Functor CIELAB where fmap f (CIELAB l a b) = (CIELAB (f l) (f a) (f b)) +instance Functor CIELCH where+ fmap f (CIELCH l c h) = (CIELCH (f l) (f c) (f h))+ -- | Applicative instances instance Applicative RGB where@@ -41,3 +47,7 @@ instance Applicative CIELAB where pure t = CIELAB t t t CIELAB f1 f2 f3 <*> CIELAB l a b = CIELAB (f1 l) (f2 a) (f3 b)++instance Applicative CIELCH where+ pure t = CIELCH t t t+ CIELCH f1 f2 f3 <*> CIELCH l c h = CIELCH (f1 l) (f2 c) (f3 h)