packages feed

prizm 1.1.0 → 2.0.0

raw patch · 15 files changed

+557/−444 lines, 15 filesdep +HUnit

Dependencies added: HUnit

Files

README.md view
@@ -4,7 +4,7 @@  `prizm` is a Haskell library for transforming colors. Specifically, providing functions for transforming between different color spaces (`CIE` and `sRGB`),-interpolating colors and adjusting the tint, shade, hue, or lightness or a+interpolating colors and adjusting the tint, shade, hue, or lightness of a color.  The inspiration for this library came from a desire to blend two colors@@ -14,11 +14,36 @@ accurately represents how the human eye sees hue and therefore preserves (and blends) hue the most accurately. -## Colour Module-There is a bit of overlap with the Haskell Colour Module; however, this library-is filling a couple of needs the other doesn't satisfy. Primarily-transformations and color mutations in the `CIE L*Ch` space.+## Quickstart+```haskell+{-# LANGUAGE ScopedTypeVariables #-} +import Data.Convertible+import Data.Prizm.Color+import Data.Prizm.Color.CIE as CIE++main = do+  -- Convert RGB colors to the CIE.LCH color space+  let green :: CIE.LCH = convert $ RGB 102 255 0+      pink  :: CIE.LCH = convert $ RGB 255 0 255++      -- Blend with a weight of 50%+      blended50 = pink <~> green++      -- Blend with a weight of 20%+      blended20 = interpolate 20 (pink,green)++  -- Print the CIE.LCH representation+  putStrLn $ show blended50++  -- Print the RGB representation of the blended color+  putStrLn . show $ (convert blended20) :: RGB++  -- Print the CSS-friendly hexadecimal RGB representation of the blended color+  putStrLn . show $ (convert blended20) :: Hex+      +```+ ## Supported Algorithms - `sRGB     <-> CIE XYZ ` - `CIE XYZ  <-> CIE L*ab`@@ -31,10 +56,12 @@ - Hue - Chroma/Saturation -All of these functions operate on color within the `CIE L*Ch`-representation. The percentage values may range between -100 and 100.+## Examples+[Example blending with CIELCH converted back to RGB](./blending-test.html). -- [General Color Formulas, Data, and Algorithms](http://www.brucelindbloom.com/index.html?Info.html)+# References+- [General Color Formulas, Data, and Algorithms](http://www.brucelindbloom.com) - [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 formulas](https://github.com/mikeemoo/ColorJizz-PHP/blob/master/src/MischiefCollective/ColorJizz/ColorJizz.php)+
prizm.cabal view
@@ -1,6 +1,6 @@ name:                prizm-version:             1.1.0-synopsis:            Color transformations in different color spaces+version:             2.0.0+synopsis:            Convert colors to different color spaces, interpolate colors, and transform colors homepage:            https://github.com/ixmatus/prizm license:             BSD3 license-file:        LICENSE@@ -19,7 +19,7 @@   @prizm@ is a Haskell library for transforming colors. Specifically,   providing functions for transforming between different color spaces   (@CIE@ and @sRGB@), interpolating colors and adjusting the tint,-  shade, hue, or lightness or a color.+  shade, hue, or lightness of a color.   .   The inspiration for this library came from a desire to blend two   colors represented in the @sRGB@ color space. My research about color@@ -28,44 +28,6 @@   for blending because it most accurately represents how the human eye   sees hue and therefore preserves (and blends) hue the most   accurately.-  .-  /Colour Module/-  .-  There is a bit of overlap with the Haskell Colour Module; however,-  this library is filling a couple of needs the other doesn't-  satisfy. Primarily transformations and color mutations in the @CIE-  L*Ch@ space.-  .-  /Supported Algorithms & Functions/-  .-  All of these functions operate on color within the @CIE L*Ch@ color-  space. The percentage values may range between -100 and 100.-  .-  * @sRGB     <-> CIE XYZ @-  .-  * @CIE XYZ  <-> CIE L*ab@-  .-  * @CIE L*ab <-> CIE L*Ch@-  .-  * Color interpolation-  .-  * Tinting / Darkening-  .-  * Lightness-  .-  * Hue-  .-  * Chroma/Saturation-  .-  /Formulas, Resources, and Links/-  .-  * <http://www.brucelindbloom.com/index.html?Info.html General Color Formulas, Data, and Algorithms>-  .-  * <http://rip94550.wordpress.com/2011/07/04/color-cielab-and-tristimulus-xyz/ CIE Conversion Mathematics>-  .-  * <http://www.easyrgb.com/index.php?X=MATH&H=01 Conversion Algorithm Sources>-  .-  * <https://github.com/mikeemoo/ColorJizz-PHP/blob/master/src/MischiefCollective/ColorJizz/ColorJizz.php Good list of useful color manipulation formulas>  extra-source-files:     LICENSE@@ -78,14 +40,18 @@ library   hs-source-dirs: src   default-language: Haskell2010+  other-modules:+    Data.Prizm.Color.CIE.Types+    Data.Prizm.Color.Constants+    Data.Prizm.Color.Matrices.RGB+    Data.Prizm.Color.Matrices.XYZ+    Data.Prizm.Color.RGB.Types   exposed-modules:-    Data.Prizm.Types     Data.Prizm.Color-    Data.Prizm.Color.Transform-    Data.Prizm.Color.SRGB     Data.Prizm.Color.CIE-    Data.Prizm.Color.Matrices.RGB-    Data.Prizm.Color.Matrices.XYZ+    Data.Prizm.Color.RGB+    Data.Prizm.Color.Transform+    Data.Prizm.Types      ghc-options: -Wall -fno-warn-orphans @@ -101,8 +67,10 @@   main-is:        Test.hs   default-language: Haskell2010   other-modules:-    QC.SRGB-    QC.CIE+                QC.RGB+                QC.CIE+                HUnit.Blending+                    ghc-options:     -Wall -threaded -rtsopts@@ -111,6 +79,7 @@                 prizm,                 base                       >= 4,                 QuickCheck                 >= 2.5,+                HUnit                      >= 1.5,                 convertible                >= 1.1,                 test-framework             >= 0.8,                 mono-traversable           >= 1.0,
src/Data/Prizm/Color.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ConstrainedClassMethods #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Prizm.Color@@ -6,33 +8,147 @@ -- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com> -- Stability   :  stable ----- 'Data.Prizm.Color' exports instances for blending colors,--- convenience blending ('tint' and 'shade'), and adjusting the 'hue',--- 'lightness', or 'chroma' of a given color.+-- @Data.Prizm.Color@ exports all of the specific color space modules+-- and types for blending colors, convenience blending ('tint' and+-- 'shade'), and adjusting the 'hue', 'lightness', or 'chroma' of a+-- given color. You should import this module. ----- Currently, there are only instances for colors in the in @CIE L*Ch@--- color space. The reason for this is because the @CIE L*Ch@ color--- space represents the hue of a color closest to how the human eye--- perceives it. Blending and transforming a color in @CIE L*Ch@--- maintains the brightness of the colors more accurately than the--- other color spaces.+-- Note that blending colors in a polar-coordinate color space, such+-- as 'CIELCH', preserves the saturation and brightness of the colors+-- being interpolated better than blending in RGB. It also turns out+-- to be an effective even when converting from 'RGB' to 'CIELCH',+-- blending, then converting back again! ----- Here is a link to a blog post by someone detailing the differences--- and documenting them well:--- <https://web.archive.org/web/20150214062932/http://www.stuartdenman.com/improved-color-blending Improved--- Color Blending>.+-- Here is an excellent blog post by someone discussing the differences:+-- <https://web.archive.org/web/20150214062932/http://www.stuartdenman.com/improved-color-blending Improved Color Blending>. ---------------------------------------------------------------------------- module Data.Prizm.Color (--- * Convertible Instances+-- * Color Transformations+  interpolate+, (<~>)+, shade+, tint+, lightness+, chroma+, hue+-- * Preset Colors+, white+, black+-- * Individual Color Spaces -- ** CIE Color Space-  module Data.Prizm.Color.CIE--- ** SRGB Color Space-, module Data.Prizm.Color.SRGB--- * Types+, module Data.Prizm.Color.CIE+-- ** RGB Color Space+, module Data.Prizm.Color.RGB+-- * Package Types (re-exports the individual color space type modules too) , module Data.Prizm.Types ) where -import           Data.Prizm.Color.CIE  hiding (clamp)-import           Data.Prizm.Color.SRGB hiding (clamp)+import           Data.MonoTraversable+import           Data.Prizm.Color.CIE ()+import qualified Data.Prizm.Color.CIE as CIE+import           Data.Prizm.Color.RGB () import           Data.Prizm.Types++-- | Preset white and black for a color space.+class PresetColor c where+  white :: c+  black :: c++-- | A blendable color.+class BlendableColor c where++  -- | Linear interpolation of a color with another color, applying a+  -- weight.+  interpolate :: Percent -> (c,c) -> c++  -- | Blend two 'BlendableColor' colors using an interpolation weight+  -- of 50%.+  (<~>) :: c -> c -> c+  (<~>) l r = interpolate 50 (l,r)++  -- | Shade a color by blending it using a weight and the+  -- @PresetColor@ black.+  shade :: PresetColor c => c -> Percent -> c+  shade c w = interpolate (pctClamp w) (c, black)++  -- | Tint a color by blending it using a weight and the+  -- @PresetColor@ white.+  tint :: PresetColor c => c -> Percent -> c+  tint c w = interpolate (pctClamp w) (c, white)++-- | An adjustable color.+class AdjustableColor c where+  -- | Adjust the lightness of a color+  lightness :: c -> Percent -> c++  -- | Adjust the chroma of a color+  --+  -- NB: not all color spaces will support this easily but it should+  -- be possible to convert into a color space that does then convert+  -- back+  chroma    :: c -> Percent -> c++  -- | Adjust the hue of a color+  hue       :: c -> Percent -> c++instance PresetColor CIE.LCH where+  white = CIE.LCH 0.0 0.0 360.0+  black = CIE.LCH 100.0 0.0 360.0++instance PresetColor RGB where+  white = RGB 255 255 255+  black = RGB 0   0   0++instance BlendableColor CIE.LCH where+  -- | Interpolate two colors in the @CIE L*C*h@ color space with a+  -- weight.+  --+  -- 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%.+  interpolate w ((CIE.LCH al ac ah), (CIE.LCH bl bc bh)) =+    let w' = pct w+        (CIE.LCH nl nc nh) = omap (*w') (CIE.LCH (bl - al) (bc - ac) (shortestPath (bh - ah)))+    in CIE.LCH (al + nl) (ac + nc) (ah + nh)++instance AdjustableColor CIE.LCH where+  -- | Adjust the lightness / darkness of a color.+  lightness (CIE.LCH l c h) w =+    CIE.LCH (clamp (l + (100*(pct (pctClamp w)))) 100.0) c h++  -- | Adjust the hue of a color.+  hue (CIE.LCH l c h) w =+    CIE.LCH l c (clamp (h + (360*(pct (pctClamp w)))) 360.0)++  -- | Adjust the saturation/chroma of a color.+  --+  -- A maximum chroma value of 120 is assumed here, anything more is+  -- generally considered out of gamut.+  chroma (CIE.LCH l c h) w =+    CIE.LCH l (clamp (c + (120*(pct (pctClamp w)))) 120.0) h++------------------------------------------------------------------------------+-- Utilities+------------------------------------------------------------------------------+-- | Give the shortest path to the hue value.+shortestPath :: Double -> Double+shortestPath h | h > 180    = h - 360+               | h < (-180) = h + 360+               | otherwise  = h++-- | Give the decimal value for the given "percent" value.+--+-- The @Percent@ value may range from -100 to 100.+pct :: Percent -> Double+pct i = fromIntegral m / 100+  where+    m = pctClamp i++-- | Clamp a 'Percent' value in the range -100 to 100.+pctClamp :: Percent -> Percent+pctClamp i = max (min i 100) (-100)++-- | Clamp a 'Double' with a bottom of at least 0.0.+clamp :: Double -> Double -> Double+clamp i clmp = max (min i clmp) 0.0
src/Data/Prizm/Color/CIE.hs view
@@ -10,213 +10,188 @@ -- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com> -- Stability   :  stable ----- Basic utility functions for the @CIE@ transformations and @CIE@--- convertible instances between the different color space--- representations within @CIE@ and @RGB@.+-- 'Convertible' instances for converting to and from colors in one of+-- the CIE color space representations provided by this library:+-- * 'CIEXYZ'+-- * 'CIELAB'+-- * 'CIELCH' ---------------------------------------------------------------------------- module Data.Prizm.Color.CIE-( clamp-, refWhite-, toRGBMatrix-, transformLAB-, calcLCHHue-, transformRGB-, transformXYZ-, v1-, v2+( module Data.Prizm.Color.CIE.Types ) where  import           Control.Applicative import           Data.Convertible.Base import           Data.Convertible.Utils-import           Data.MonoTraversable+import           Data.Prizm.Color.CIE.Types+import           Data.Prizm.Color.CIE.Types    as CIE+import qualified Data.Prizm.Color.Constants    as Constants import           Data.Prizm.Color.Matrices.XYZ-import qualified Data.Prizm.Color.SRGB         as S+import qualified Data.Prizm.Color.RGB          as RGB 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 two colors in the @CIE L*C*h@ color space with a-  -- weight.-  ---  -- 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%.-  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-  -- | Adjust the lightness / darkness of a color.-  lightness (CIELCH l c h) w =-    CIELCH (clamp (l + (100*(pct (pctClamp w)))) 100.0) c h--  -- | Adjust the hue of a color.-  hue (CIELCH l c h) w =-    CIELCH l c (clamp (h + (360*(pct (pctClamp w)))) 360.0)--  -- | Adjust the saturation/chroma of a color.-  ---  -- A maximum chroma value of 120 is assumed here, anything more is-  -- generally considered out of gamut.-  chroma (CIELCH l c h) w =-    CIELCH l (clamp (c + (120*(pct (pctClamp w)))) 120.0) h- ------------------------------------------------------------------------------ -- Utilities -------------------------------------------------------------------------------clamp :: Double -> Double -> Double-clamp i clmp = max (min i clmp) 0.0---- | Exact rational of the "0.008856" value.-v1 :: Double-v1 = (6/29) ** 3---- | Exact rational of the "7.787" value.-v2 :: Double-v2 = 1/3 * ((29/6) ** 2)---- | Reference white, 2deg observer, d65 illuminant.+-- | Reference white, 2° observer, d65 illuminant. ----- @[x,y,z]@+-- These values came from Bruce Lindbloom's website: <https://web.archive.org/web/20161110173539/http://www.brucelindbloom.com/index.html?Eqn_ChromAdapt.html Chromatic Adaptation> -- -- TODO: this should probably be a triple.+-- TODO: move to another module and make the reference white+-- parameterizable by type so different references can be used!+--+-- @[x,y,z]@+--+-- For future reference (also found in the above linked website), here+-- is a list of reference white illuminant values:+--+-- * @A    1.09850 1.00000 0.35585@+-- * @B    0.99072 1.00000 0.85223@+-- * @C    0.98074 1.00000 1.18232@+-- * @D50  0.96422 1.00000 0.82521@+-- * @D55  0.95682 1.00000 0.92149@+-- * @D65  0.95047 1.00000 1.08883@+-- * @D75  0.94972 1.00000 1.22638@+-- * @E    1.00000 1.00000 1.00000@+-- * @F2   0.99186 1.00000 0.67393@+-- * @F7   0.95041 1.00000 1.08747@+-- * @F11  1.00962 1.00000 0.64350@ refWhite :: [Double] refWhite = [95.047, 100.000, 108.883] --- | Transform a 'CIEXYZ' point.+-- | Transform a 'CIE.XYZ' point. -- -- TODO: should provide *much* better documentation on what this is -- actually doing in the algorithms. transformXYZ :: Double -> Double-transformXYZ v | cv > v1   = cv-               | otherwise = (v - 16 / 116) / v2+transformXYZ v | cv > Constants.ζ  = cv+               | otherwise         = (v - 16 / 116) / Constants.ξ   where cv = v**3 --- | Calculate the hue for a conversion to 'CIELCH' from the 'atan2'--- of the *a* and *b* color opponents of a 'CIELAB' color.+-- | Calculate the hue for a conversion to 'CIE.LCH' from the 'atan2'+-- of the *a* and *b* color opponents of a 'CIE.LAB' color. -- -- TODO: should provide *much* better documentation on what this is -- actually doing in the algorithms. calcLCHHue :: Double -> Double-calcLCHHue v | v > 0      = (v / pi) * 180+calcLCHHue v | v > 0        = (v / pi) * 180                | otherwise  = 360 - ((abs v) / pi) * 180 --- | Transform a 'CIELAB' point.+-- | Transform a 'CIE.LAB' point. -- -- TODO: should provide *much* better documentation on what this is -- actually doing in the algorithms. transformLAB :: Double -> Double-transformLAB v | v > v1    = v ** (1/3)-               | otherwise = (v2 * v) + (16 / 116)+transformLAB v | v > Constants.ζ = v ** (1/3)+               | otherwise       = (Constants.ξ * v) + (16 / 116) --- | Transform an 'CIEXYZ' 'Double' to be computed against the+-- | Transform an 'CIE.XYZ' 'Double' to be computed against the -- xyzToRGB matrix. 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 --- | Convert an XYZ color to an SRGB color.+-- | Convert an XYZ color to an RGB color. -- -- 'XYZtoRGB' is the pre-calculated illuminant matrix, it is -- preferable to use 'toRG' as it uses the most "common" one.-toRGBMatrix :: XYZtoRGB -> CIEXYZ -> RGB-toRGBMatrix (XYZtoRGB m) (CIEXYZ x y z) =+toRGBMatrix :: XYZtoRGB -> CIE.XYZ -> RGB+toRGBMatrix (XYZtoRGB m) (CIE.XYZ x y z) =     let t = ZipList ((/100) <$> [x,y,z])         -- NB: be sure to clamp before converting to a Word8,         -- otherwise we can overflow!-        [r,g,b] = (fromIntegral . S.clamp . transformRGB) <$> ((zipTransform t) <$> m)+        [r,g,b] = (fromIntegral . RGB.clamp . transformRGB) <$> ((zipTransform t) <$> m)     in RGB r g b  ------------------------------------------------------------------------------ -- Convertible --------------------------------------------------------------------------------instance Convertible CIELAB CIELCH where-  -- | Convert a 'CIELAB' to a 'CIELCH'-  safeConvert (CIELAB l a b) =+instance Convertible CIE.LAB CIE.LCH where+  -- | Convert a 'CIE.LAB' to a 'CIE.LCH'+  safeConvert (CIE.LAB l a b) =     let h = calcLCHHue (atan2 b a)         c = sqrt ((a^(2 :: Int)) + (b^(2 :: Int)))-    in Right $ CIELCH l c h+    in Right $ CIE.LCH l c h -instance Convertible CIELAB CIEXYZ where-  -- | Convert a 'CIELAB' to a 'CIEXYZ'-  safeConvert (CIELAB l a b) =+instance Convertible CIE.LAB CIE.XYZ where+  -- | Convert a 'CIE.LAB' to a 'CIE.XYZ'+  safeConvert (CIE.LAB 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+    in Right $ CIE.XYZ nx ny nz -instance Convertible CIELAB RGB where-  -- | Convert a 'CIELAB' to a S'RGB'-  safeConvert = convertVia (undefined :: CIEXYZ)+instance Convertible CIE.LAB RGB where+  -- | Convert a 'CIE.LAB' to a S'RGB'+  safeConvert = convertVia (undefined :: CIE.XYZ) -instance Convertible CIELAB Hex where-  -- | Convert a 'CIELAB' to an S'RGB' hexadecimal color+instance Convertible CIE.LAB Hex where+  -- | Convert a 'CIE.LAB' to an S'RGB' hexadecimal color   safeConvert = convertVia (undefined :: RGB) -instance Convertible RGB CIELAB where-  -- | Convert a S'RGB' to a 'CIELAB'-  safeConvert = convertVia (undefined :: CIEXYZ)+instance Convertible RGB CIE.LAB where+  -- | Convert a S'RGB' to a 'CIE.LAB'+  safeConvert = convertVia (undefined :: CIE.XYZ) -instance Convertible RGB CIELCH where-  -- | Convert a S'RGB' to a 'CIELCH'-  safeConvert = convertVia (undefined :: CIELAB)+instance Convertible RGB CIE.LCH where+  -- | Convert a S'RGB' to a 'CIE.LCH'+  safeConvert = convertVia (undefined :: CIE.LAB) -instance Convertible Hex CIELAB where-  -- | Convert an S'RGB' hexadecimal color to a 'CIELAB'+instance Convertible Hex CIE.LAB where+  -- | Convert an S'RGB' hexadecimal color to a 'CIE.LAB'   safeConvert = convertVia (undefined :: RGB) -instance Convertible Hex CIELCH where-  -- | Convert an S'RGB' hexadecimal color to a 'CIELCH'+instance Convertible Hex CIE.LCH where+  -- | Convert an S'RGB' hexadecimal color to a 'CIE.LCH'   safeConvert = convertVia (undefined :: RGB) -instance Convertible CIELCH CIELAB where-  -- | Convert a 'CIELCH' to a 'CIELAB'-  safeConvert (CIELCH l c h) =+instance Convertible CIE.LCH CIE.LAB where+  -- | Convert a 'CIE.LCH' to a 'CIE.LAB'+  safeConvert (CIE.LCH l c h) =     let v = h * pi / 180-    in Right $ CIELAB l ((cos v)*c) ((sin v)*c)+    in Right $ CIE.LAB l ((cos v)*c) ((sin v)*c) -instance Convertible CIELCH RGB where-  -- | Convert a 'CIELCH' to a S'RGB'-  safeConvert = convertVia (undefined :: CIELAB)+instance Convertible CIE.LCH RGB where+  -- | Convert a 'CIE.LCH' to a S'RGB'+  safeConvert = convertVia (undefined :: CIE.LAB) -instance Convertible CIELCH CIEXYZ where-  safeConvert = convertVia (undefined :: CIELAB)+instance Convertible CIE.LCH Hex where+  -- | Convert a 'CIE.LCH' to a RGB hexadecimal representation+  safeConvert = convertVia (undefined :: RGB) -instance Convertible CIEXYZ RGB where-  -- | Convert a 'CIEXYZ' to an S'RGB'+instance Convertible CIE.LCH CIE.XYZ where+  safeConvert = convertVia (undefined :: CIE.LAB)++instance Convertible CIE.XYZ RGB where+  -- | Convert a 'CIE.XYZ' to an S'RGB'   --   -- This function uses the default d65 illuminant matrix.   safeConvert = Right . toRGBMatrix d65SRGB -instance Convertible CIEXYZ Hex where-  -- | Convert a 'CIEXYZ' to an S'RGB' hexadecimal color+instance Convertible CIE.XYZ Hex where+  -- | Convert a 'CIE.XYZ' to an S'RGB' hexadecimal color   safeConvert = convertVia (undefined :: RGB) -instance Convertible CIEXYZ CIELCH where-  -- | Convert a 'CIEXYZ' to a 'CIELCH' via 'CIELAB'-  safeConvert = convertVia (undefined :: CIELAB)+instance Convertible CIE.XYZ CIE.LCH where+  -- | Convert a 'CIE.XYZ' to a 'CIE.LCH' via 'CIE.LAB'+  safeConvert = convertVia (undefined :: CIE.LAB) -instance Convertible CIEXYZ CIELAB where-  -- | Convert an 'CIEXYZ' to a 'CIELAB'+instance Convertible CIE.XYZ CIE.LAB where+  -- | Convert an 'CIE.XYZ' to a 'CIE.LAB'   --   -- This function uses the default reference white (2deg observer,   -- d65 illuminant).-  safeConvert (CIEXYZ x y z) =+  safeConvert (CIE.XYZ 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+    in Right $ CIE.LAB l a b -instance Convertible Hex CIEXYZ where-  -- | Convert a hexadecimal S'RGB' color to a 'CIEXYZ'+instance Convertible Hex CIE.XYZ where+  -- | Convert a hexadecimal S'RGB' color to a 'CIE.XYZ'   safeConvert = convertVia (undefined :: RGB)
+ src/Data/Prizm/Color/CIE/Types.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE TypeFamilies            #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Prizm.Color.CIE.Types+-- Copyright   :  (C) 2017 Parnell Springmeyer+-- License     :  BSD3+-- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com>+-- Stability   :  stable+-----------------------------------------------------------------------------+module Data.Prizm.Color.CIE.Types where++import           Data.MonoTraversable++-- | A color in the @CIE XYZ@ color space.+data XYZ = XYZ !Double !Double !Double+  deriving (Eq, Ord, Show)++-- | A color in the @CIE L*a*b*@ color space.+data LAB = LAB !Double !Double !Double+  deriving (Eq, Ord, Show)++-- | A color in the @CIE L*C*h(uv)@ color space.+data LCH = LCH !Double !Double !Double+  deriving (Eq, Ord, Show)++type instance Element XYZ = Double+type instance Element LCH = Double+type instance Element LAB = Double++instance MonoFunctor XYZ where+  omap f (XYZ x y z) = XYZ (f x) (f y) (f z)+instance MonoFunctor LAB where+  omap f (LAB l a b) = LAB (f l) (f a) (f b)+instance MonoFunctor LCH where+  omap f (LCH l c h) = LCH (f l) (f c) (f h)
+ src/Data/Prizm/Color/Constants.hs view
@@ -0,0 +1,18 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Prizm.Color.Constants+-- Copyright   :  (C) 2017 Parnell Springmeyer+-- License     :  BSD3+-- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com>+-- Stability   :  stable+--+----------------------------------------------------------------------------+module Data.Prizm.Color.Constants where++-- | Exact rational of the "0.008856" value.+ζ :: Double+ζ = (6/29) ** 3++-- | Exact rational of the "7.787" value.+ξ :: Double+ξ = 1/3 * ((29/6) ** 2)
+ src/Data/Prizm/Color/RGB.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances  #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Prizm.Color.RGB+-- Copyright   :  (C) 2013 Parnell Springmeyer+-- License     :  BSD3+-- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com>+-- Stability   :  stable+--+-- Transformation functions and convenience functions to do the base+-- conversion between 'RGB' and 'CIEXYZ'.+----------------------------------------------------------------------------+module Data.Prizm.Color.RGB+( clamp+, module Data.Prizm.Color.RGB.Types+) where++import           Control.Applicative+import           Data.Convertible.Base+import           Data.Monoid+import           Data.Prizm.Color.CIE.Types    as CIE+import           Data.Prizm.Color.Matrices.RGB+import           Data.Prizm.Color.RGB.Types+import           Data.Prizm.Color.Transform+import           Data.Prizm.Types+import           Data.String+import qualified Data.Text                     as T+import           Data.Text.Read                as R+import           Numeric                       (showHex)++------------------------------------------------------------------------------+-- Utilities+------------------------------------------------------------------------------+-- | Transform an RGB integer to be computed against a matrix.+transform :: Integer -> Double+transform v | dv > 0.04045 = (((dv + 0.055) / ap) ** 2.4) * 100+            | otherwise    = (dv / 12.92) * 100+  where dv = fromIntegral v / 255+        ap = 1.0 + 0.055++-- | Clamp a 'Word8' with an upper-bound of 255 (the maximum RGB+-- value).+clamp :: Integral a => a -> a+clamp i = max (min i 255) 0++-- All credit for the below three functions go to the HSColour module.++-- | Show a colour in hexadecimal form, e.g. @#00aaff@+showRGB :: RGB -> Hex+showRGB c =+  (("#"++) . showHex2 r' . showHex2 g' . showHex2 b') ""+ where+  (RGB r' g' b') = c+  showHex2 x | x <= 0xf = ("0"++) . showHex x+             | otherwise = showHex x++-- | Parse a 'Hex' into an s'RGB' type.+parse :: T.Text -> RGB+parse t =+  case T.uncons t of+    Just ('#', cs) | T.all isHex cs ->+      case T.unpack cs of+        [a, b, c, d, e, f, _g, _h] -> RGB (hex a b) (hex c d) (hex e f)+        [a, b, c, d, e, f      ]   -> RGB (hex a b) (hex c d) (hex e f)+        [a, b, c, _d            ]  -> RGB (hex a a) (hex b b) (hex c c)+        [a, b, c               ]   -> RGB (hex a a) (hex b b) (hex c c)+        _                          -> err+    _                              -> err++  where+    hex a b = either err fst (R.hexadecimal (T.singleton a <> T.singleton b))+    isHex a = (a >= 'a' && a <= 'f') || (a >= 'A' && a <= 'F') || (a >= '0' && a <= '9')+    err     = error "Invalid color string"++------------------------------------------------------------------------------+-- Convertible+------------------------------------------------------------------------------+instance Convertible RGB CIE.XYZ where+  -- | Convert an S'RGB' value to a 'CIE.XYZ' value with the default+  -- @d65@ illuminant matrix.+  safeConvert = Right . (toXYZMatrix d65SRGB)++instance Convertible RGB Hex where+  -- | Convert an S'RGB' value to a hexadecimal representation.+  safeConvert = Right . showRGB++instance Convertible Hex RGB where+  -- | Convert a hexadecimal value to an S'RGB'.+  safeConvert = Right . parse . fromString++-- | Convert an s'RGB' value to a 'CIE.XYZ' given a pre-calculated+-- illuminant matrix.+toXYZMatrix :: RGBtoXYZ -> RGB -> CIE.XYZ+toXYZMatrix (RGBtoXYZ m) (RGB r g b) =+  let t = ZipList ((transform . fromIntegral) <$> (clamp <$> [r,g,b]))+      [x,y,z] = (roundN 3) <$> ((zipTransform t) <$> m)+  in CIE.XYZ x y z
+ src/Data/Prizm/Color/RGB/Types.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies      #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Prizm.Color.RGB.Types+-- Copyright   :  (C) 2017 Parnell Springmeyer+-- License     :  BSD3+-- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com>+-- Stability   :  stable+-----------------------------------------------------------------------------+module Data.Prizm.Color.RGB.Types where++import           Data.MonoTraversable+import           Data.Word++-- | A color in the @sRGB@ color space.+data RGB = RGB !Word8 !Word8 !Word8+  deriving (Eq, Ord, Show)++-- | Monomorphic functor instances for the color spaces.+type instance Element RGB = Word8++instance MonoFunctor RGB where+  omap f (RGB r g b) = RGB (f r) (f g) (f b)
− src/Data/Prizm/Color/SRGB.hs 
@@ -1,105 +0,0 @@-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeSynonymInstances  #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Prizm.Color.SRGB--- Copyright   :  (C) 2013 Parnell Springmeyer--- License     :  BSD3--- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com>--- Stability   :  stable------ Transformation functions and convenience functions to do the base--- conversion between S'RGB' and 'CIEXYZ'.------------------------------------------------------------------------------module Data.Prizm.Color.SRGB-( clamp-, parse-, showRGB-, toXYZMatrix-, transform-) where--import           Control.Applicative-import           Data.Convertible.Base-import           Data.Monoid-import           Data.Prizm.Color.Matrices.RGB-import           Data.Prizm.Color.Transform-import           Data.Prizm.Types-import           Data.String-import qualified Data.Text                     as T-import           Data.Text.Read                as R-import           Numeric                       (showHex)--instance PresetColor RGB where-  white = RGB 255 255 255-  black = RGB 0   0   0----------------------------------------------------------------------------------- Utilities---------------------------------------------------------------------------------- | Transform an RGB integer to be computed against a matrix.-transform :: Integer -> Double-transform v | dv > 0.04045 = (((dv + 0.055) / ap) ** 2.4) * 100-            | otherwise    = (dv / 12.92) * 100-  where dv = fromIntegral v / 255-        ap = 1.0 + 0.055---- | Clamp a 'Word8' with an upper-bound of 255 (the maximum RGB--- value).-clamp :: Integral a => a -> a-clamp i = max (min i 255) 0---- All credit for the below three functions go to the HSColour module.---- | Show a colour in hexadecimal form, e.g. @#00aaff@-showRGB :: RGB -> Hex-showRGB c =-  (("#"++) . showHex2 r' . showHex2 g' . showHex2 b') ""- where-  (RGB r' g' b') = c-  showHex2 x | x <= 0xf = ("0"++) . showHex x-             | otherwise = showHex x---- | Parse a 'Hex' into an s'RGB' type.-parse :: T.Text -> RGB-parse t =-  case T.uncons t of-    Just ('#', cs) | T.all isHex cs ->-      case T.unpack cs of-        [a, b, c, d, e, f, _g, _h] -> RGB (hex a b) (hex c d) (hex e f)-        [a, b, c, d, e, f      ]   -> RGB (hex a b) (hex c d) (hex e f)-        [a, b, c, _d            ]  -> RGB (hex a a) (hex b b) (hex c c)-        [a, b, c               ]   -> RGB (hex a a) (hex b b) (hex c c)-        _                          -> err-    _                              -> err--  where-    hex a b = either err fst (R.hexadecimal (T.singleton a <> T.singleton b))-    isHex a = (a >= 'a' && a <= 'f') || (a >= 'A' && a <= 'F') || (a >= '0' && a <= '9')-    err     = error "Invalid color string"----------------------------------------------------------------------------------- Convertible--------------------------------------------------------------------------------instance Convertible RGB CIEXYZ where-  -- | Convert an S'RGB' value to a 'CIEXYZ' value with the default-  -- @d65@ illuminant matrix.-  safeConvert = Right . (toXYZMatrix d65SRGB)--instance Convertible RGB Hex where-  -- | Convert an S'RGB' value to a hexadecimal representation.-  safeConvert = Right . showRGB--instance Convertible Hex RGB where-  -- | Convert a hexadecimal value to an S'RGB'.-  safeConvert = Right . parse . fromString---- | Convert an s'RGB' value to a 'CIEXYZ' given a pre-calculated--- illuminant matrix.-toXYZMatrix :: RGBtoXYZ -> RGB -> CIEXYZ-toXYZMatrix (RGBtoXYZ m) (RGB r g b) =-  let t = ZipList ((transform . fromIntegral) <$> (clamp <$> [r,g,b]))-      [x,y,z] = (roundN 3) <$> ((zipTransform t) <$> m)-  in CIEXYZ x y z
src/Data/Prizm/Types.hs view
@@ -9,10 +9,21 @@ -- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com> -- Stability   :  stable ------------------------------------------------------------------------------module Data.Prizm.Types where+module Data.Prizm.Types+(+-- * Generic Utility Types+  RGBtoXYZ(..)+, XYZtoRGB(..)+, Hex+, Percent+-- * CIE Color Space Types+, module Data.Prizm.Color.CIE.Types+-- * RGB Color Space Types+, module Data.Prizm.Color.RGB.Types+) where -import           Data.MonoTraversable-import           Data.Word+import           Data.Prizm.Color.CIE.Types+import           Data.Prizm.Color.RGB.Types  -- | Working space matrix to convert from sRGB to CIE XYZ. newtype RGBtoXYZ = RGBtoXYZ [[Double]]@@ -28,99 +39,3 @@  -- | A percent value ranging from -100 to 100; e.g: -82%, 80%, 10%. type Percent = Integer---- | A color in the sRGB color space.-data RGB = RGB !Word8 !Word8 !Word8-  deriving (Eq, Ord, Show)---- | A color in the CIE XYZ color space.-data CIEXYZ = CIEXYZ !Double !Double !Double-  deriving (Eq, Ord, Show)---- | A color in the @CIE L*a*b*@ color space.-data CIELAB = CIELAB !Double !Double !Double-  deriving (Eq, Ord, Show)---- | A color in the @CIE L*C*h(uv)@ color space.-data CIELCH = CIELCH !Double !Double !Double-  deriving (Eq, Ord, Show)---- | Monomorphic functor instances for the color spaces.-type instance Element RGB    = Word8-type instance Element CIEXYZ = Double-type instance Element CIELCH = Double-type instance Element CIELAB = Double--instance MonoFunctor RGB where-  omap f (RGB r g b) = RGB (f r) (f g) (f b)--instance MonoFunctor CIEXYZ where-  omap f (CIEXYZ x y z) = CIEXYZ (f x) (f y) (f z)--instance MonoFunctor CIELAB where-  omap f (CIELAB l a b) = CIELAB (f l) (f a) (f b)--instance MonoFunctor CIELCH where-  omap f (CIELCH l c h) = CIELCH (f l) (f c) (f h)---- | Preset white and black for a color space.-class PresetColor c where-  white :: c-  black :: c---- | A blendable color.-class BlendableColor c where--  -- | Interpolate a color with another color, applying a weight.-  interpolate :: Percent -> (c,c) -> c--  -- | Blend two @Blendable@ colors using an interpolation weight of-  -- 50%.-  (<~>) :: c -> c -> c-  (<~>) l r = interpolate 50 (l,r)--  -- | Shade a color by blending it using a weight and the-  -- @PresetColor@ black.-  shade :: PresetColor c => c -> Percent -> c-  shade c w = interpolate (pctClamp w) (c, black)--  -- | Tint a color by blending it using a weight and the-  -- @PresetColor@ white.-  tint :: PresetColor c => c -> Percent -> c-  tint c w = interpolate (pctClamp w) (c, white)---- | An adjustable color.-class AdjustableColor c where-  -- | Adjust the lightness of a color-  lightness :: c -> Percent -> c--  -- | Adjust the chroma of a color-  ---  -- NB: not all color spaces will support this easily but it should-  -- be possible to convert into a color space that does then convert-  -- back-  chroma    :: c -> Percent -> c--  -- | Adjust the hue of a color-  hue       :: c -> Percent -> c----------------------------------------------------------------------------------- Utilities---------------------------------------------------------------------------------- | Give the shortest path to the hue value.-shortestPath :: Double -> Double-shortestPath h | h > 180    = h - 360-               | h < (-180) = h + 360-               | otherwise  = h---- | Give the decimal value for the given "percent" value.------ The @Percent@ value may range from -100 to 100.-pct :: Percent -> Double-pct i = fromIntegral m / 100-  where-    m = pctClamp i---- | Clamp a @Percent@ value in the range -100 to 100.-pctClamp :: Percent -> Percent-pctClamp i = max (min i 100) (-100)
+ tests/HUnit/Blending.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HUnit.Blending (tests) where++import           Data.Convertible+import           Data.Prizm.Color+import           Data.Prizm.Color.CIE           as CIE+import           Test.Framework                 (Test)+import           Test.Framework.Providers.HUnit as HUnit+import           Test.HUnit                     (Assertion, (@?=))++tests :: [Test]+tests =+  [ testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 0%"  $ blendPinkGreen 0  (RGB 255 0 255)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 10%" $ blendPinkGreen 10 (RGB 255 0 210)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 20%" $ blendPinkGreen 20 (RGB 255 0 163)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 30%" $ blendPinkGreen 30 (RGB 255 0 115)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 40%" $ blendPinkGreen 40 (RGB 255 51 67)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 50%" $ blendPinkGreen 50 (RGB 255 111 0)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 60%" $ blendPinkGreen 60 (RGB 255 152 0)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 70%" $ blendPinkGreen 70 (RGB 255 186 0)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 80%" $ blendPinkGreen 80 (RGB 222 213 0)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 90%" $ blendPinkGreen 90 (RGB 172 236 0)+  , testCase "Blend #ff00ff (pink) with #66ff00 (green) @ 100%" $ blendPinkGreen 100 (RGB 102 255 0)+  ]++blendPinkGreen :: Percent -> RGB -> Assertion+blendPinkGreen pct expected =+  let pink    :: CIE.LCH = convert $ RGB 255 0 255+      green   :: CIE.LCH = convert $ RGB 102 255 0+      blended :: RGB     = convert $ interpolate pct (pink,green)+  in blended @?= expected
tests/QC/CIE.hs view
@@ -8,37 +8,38 @@ import           Data.Convertible import           Data.MonoTraversable import           Data.Prizm.Color+import           Data.Prizm.Color.CIE                 as CIE import           Data.Prizm.Color.Transform import           Test.Framework                       (Test) import           Test.Framework.Providers.QuickCheck2 as QuickCheck import           Test.QuickCheck -instance Arbitrary CIEXYZ where-  arbitrary = liftM3 CIEXYZ (choose (0, 95.047)) (choose (0, 100.000)) (choose (0, 108.883))+instance Arbitrary CIE.XYZ where+  arbitrary = liftM3 CIE.XYZ (choose (0, 95.047)) (choose (0, 100.000)) (choose (0, 108.883)) -instance Arbitrary CIELAB where-  arbitrary = liftM3 CIELAB (choose (0, 100)) (choose ((-129), 129)) (choose ((-129), 129))+instance Arbitrary CIE.LAB where+  arbitrary = liftM3 CIE.LAB (choose (0, 100)) (choose ((-129), 129)) (choose ((-129), 129))  rN :: Double -> Double rN = roundN 11 -xyz2LAB :: CIEXYZ -> Bool+xyz2LAB :: CIE.XYZ -> Bool xyz2LAB ((omap rN ) -> genVal) = genVal == xyz   where     ((omap rN) -> xyz) =-      convert ((convert genVal) :: CIELAB)+      convert ((convert genVal) :: CIE.LAB) -lab2XYZ :: CIELAB -> Bool+lab2XYZ :: CIE.LAB -> Bool lab2XYZ ((omap rN ) -> genVal) = genVal == lab   where     ((omap rN) -> lab) =-      convert ((convert genVal) :: CIEXYZ)+      convert ((convert genVal) :: CIE.XYZ) -lab2LCH :: CIELAB -> Bool+lab2LCH :: CIE.LAB -> Bool lab2LCH ((omap rN ) -> genVal) = genVal == lch   where     ((omap rN) -> lch) =-      convert ((convert genVal) :: CIELCH)+      convert ((convert genVal) :: CIE.LCH)  tests :: [Test] tests =
+ tests/QC/RGB.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module QC.RGB (tests) where++import           Control.Monad                        (liftM3)+import           Data.Convertible+import           Data.Prizm.Color                     (Hex, RGB (..))+import           Data.Prizm.Color.CIE                 as CIE+import           Test.Framework                       (Test)+import           Test.Framework.Providers.QuickCheck2 as QuickCheck+import           Test.QuickCheck++instance Arbitrary RGB where+  arbitrary = liftM3 RGB (choose rgbRange) (choose rgbRange) (choose rgbRange)+    where+      rgbRange = (0, 255)++rgb2XYZ :: RGB -> Bool+rgb2XYZ gVal = gVal == iso+  where+    iso = convert ((convert gVal) :: CIE.XYZ)++rgb2HEX :: RGB -> Bool+rgb2HEX gVal = gVal == iso+  where+    iso = convert ((convert gVal) :: Hex)++tests :: [Test]+tests =+  [ QuickCheck.testProperty "RGB <-> CIE XYZ" rgb2XYZ+  , QuickCheck.testProperty "HEX <-> RGB   " rgb2HEX+  ]
− tests/QC/SRGB.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module QC.SRGB (tests) where--import           Control.Monad                        (liftM3)-import           Data.Convertible-import           Data.Prizm.Color-import           Test.Framework                       (Test)-import           Test.Framework.Providers.QuickCheck2 as QuickCheck-import           Test.QuickCheck--instance Arbitrary RGB where-  arbitrary = liftM3 RGB (choose rgbRange) (choose rgbRange) (choose rgbRange)-    where-      rgbRange = (0, 255)--rgb2XYZ :: RGB -> Bool-rgb2XYZ gVal = gVal == iso-  where-    iso = convert ((convert gVal) :: CIEXYZ)--rgb2HEX :: RGB -> Bool-rgb2HEX gVal = gVal == iso-  where-    iso = convert ((convert gVal) :: Hex)--tests :: [Test]-tests =-  [ QuickCheck.testProperty "SRGB <-> CIE XYZ" rgb2XYZ-  , QuickCheck.testProperty "HEX  <-> SRGB   " rgb2HEX-  ]
tests/Test.hs view
@@ -2,8 +2,9 @@  module Main (main) where +import qualified HUnit.Blending as Blending import qualified QC.CIE         as CIE-import qualified QC.SRGB        as SRGB+import qualified QC.RGB         as RGB import           Test.Framework (Test, defaultMain, testGroup)  main :: IO ()@@ -11,6 +12,7 @@  tests :: [Test] tests =-  [ testGroup "SRGB" SRGB.tests-  , testGroup "CIE"  CIE.tests+  [ testGroup "RGB" RGB.tests+  , testGroup "CIE" CIE.tests+  , testGroup "Blending" Blending.tests   ]