colour 0.0.0 → 1.0.0

raw patch · 17 files changed

+921/−593 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Colour.hs +8/−14
• Data/Colour/CIE.hs +0/−95
• Data/Colour/CIE/Chromaticity.hs +57/−0
• Data/Colour/CIE/Illuminant.hs +107/−0
• Data/Colour/Chan.hs +6/−0
• Data/Colour/Internal.hs +81/−60
• Data/Colour/Luma.hs +0/−69
• Data/Colour/Matrix.hs +8/−2
• Data/Colour/Names.hs +321/−163
• Data/Colour/RGB.hs +73/−0
• Data/Colour/RGBSpace.hs +47/−0
• Data/Colour/Rec601.hs +0/−61
• Data/Colour/Rec709.hs +0/−67
• Data/Colour/SRGB.hs +16/−25
• README +6/−5
• Tests.hs +181/−22
• colour.cabal +10/−10

@@ -25,29 +25,23 @@ -- The most common way of creating colours is either by name -- (see "Data.Colour.Names") or by giving an sRGB triple  -- (see "Data.Colour.SRGB").------ Methods of specifying Colours can be found in ------ - "Data.Colour.SRGB"------ - "Data.Colour.CIE"------ - "Data.Colour.Rec709"------ - "Data.Colour.Rec601" module Data.Colour- (Colour+ ( -- *Colour type+  Colour  ,colourConvert   ,AlphaColour- ,alphaColour, fade, withOpacity+ ,opaque, withOpacity  ,transparent  ,alphaColourConvert- ,alphaChannel, colourChannel+ ,alphaChannel + -- *Colour operations+ -- |These operations allow combine and modify existing colours  ,AffineSpace(..), blend - ,Composite(..), compositeWith+ ,ColourOps(..)+ ,disolve, atop  ) where 

@@ -1,95 +0,0 @@-{--Copyright (c) 2008-Russell O'Connor--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN-THE SOFTWARE.--}--- | Colour operations defined by the International Commission on --- Illumination (CIE).-module Data.Colour.CIE- (cieXYZ, toCIEXYZ, luminance- ,lightness, cieLab, cieLuv- )-where--import Data.Colour.Internal-import Data.Colour.Names-import Data.Colour.Matrix---- |Construct a 'Colour' from XYZ coordinates for the 2° standard--- (colourimetric) observer.-cieXYZ :: (Fractional a) => a -> a -> a -> Colour a-cieXYZ x y z = rgb709 r g b- where-  [r,g,b] = mult (map (map fromRational) xyz2rgb) [x,y,z]---- |Return the XYZ colour coordinates for the 2° standard--- (colourimetric) observer.-toCIEXYZ :: (Fractional a) => Colour a -> (a,a,a)-toCIEXYZ c = (x,y,z)- where-  (r,g,b) = toRGB709 c-  [x,y,z] = mult (map (map fromRational) rgb2xyz) [r,g,b]--rgb2xyz = [[0.412453, 0.357580, 0.180423]-          ,[0.212671, 0.715160, 0.072169]-          ,[0.019334, 0.119193, 0.950227]]--xyz2rgb = inverse rgb2xyz--{- CIE luminance -}--- |Returns the Y colour coordinate (luminance) for the 2° standard--- (colourimetric) observer.-luminance :: (Fractional a) => Colour a -> a-luminance c = y- where-  (x,y,z) = toCIEXYZ c---- |Returns the lightness of a colour, which is a perceptually uniform--- measure.-lightness :: (Ord a, Floating a) => Colour a -> a-lightness c | 0.008856 < y = 116*y**(1/3) - 16-            | otherwise = 903.3*y- where-  y = luminance c---- |Returns the CIELAB coordinates of a colour, which is a--- perceptually uniform colour space.-cieLab :: (Ord a, Floating a) => Colour a -> (a,a,a)-cieLab c = (lightness c, a, b)- where-  (x,y,z) = toCIEXYZ c-  (xn,yn,zn) = toCIEXYZ white-  a = 500*((x/xn)**(1/3) - (y/yn)**(1/3))-  b = 200*((y/yn)**(1/3) - (z/zn)**(1/3))---- |Returns the CIELUV coordinates of a colour, which is a--- perceptually uniform colour space.-cieLuv :: (Ord a, Floating a) => Colour a -> (a,a,a)-cieLuv c = (l, 13*l*(u'-un'), 13*l*(v'-vn'))- where-  (u', v') = u'v' c-  (un', vn') = u'v' white-  l = lightness c----------------------------------------------------------------------------{- not for export -}-u'v' :: (Ord a, Floating a) => Colour a -> (a,a)-u'v' c = (4*x/(x+15*y+3*z), 9*y/(x+15*y+3*z))- where-  (x,y,z) = toCIEXYZ c

@@ -0,0 +1,57 @@+{-+Copyright (c) 2008+Russell O'Connor++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.+-}+module Data.Colour.CIE.Chromaticity where++data Chromaticity a = Chroma !a !a deriving (Eq)++-- |Returns the CIE little /x/, little /y/, little /z/ coordinates+-- for the 2&#176; standard (colourimetric) observer.+chroma_coords :: (Fractional a) => Chromaticity a -> (a, a, a)+chroma_coords (Chroma x y) = (x, y, 1 - x - y)++-- |Constructs 'Chromaticity' from the CIE little /x/, little /y/+-- coordinates for the 2&#176; standard (colourimetric) observer.+cieChroma :: (Fractional a) => a -> a -> Chromaticity a+cieChroma = Chroma++instance (Fractional a) => Show (Chromaticity a) where+  showsPrec d c = showParen (d > app_prec) showStr+   where+    showStr = showString "cieChroma " . (showsPrec (app_prec+1) x)+            . showString " "          . (showsPrec (app_prec+1) y)+    (x,y,z) = chroma_coords c++instance (Fractional a, Read a) => Read (Chromaticity a) where+  readsPrec d r = readParen (d > app_prec)+                  (\r -> [(cieChroma x y,t)+                         |("cieChroma",s) <- lex r+                         ,(x,s0) <- readsPrec (app_prec+1) s+                         ,(y,t) <- readsPrec (app_prec+1) s0]) r++--------------------------------------------------------------------------+-- not for export+--------------------------------------------------------------------------++app_prec = 10++infix_prec = 9 `asTypeOf` app_prec

@@ -0,0 +1,107 @@+{-+Copyright (c) 2008+Russell O'Connor++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.+-}+-- |Standard illuminants defined by the International Commission on +-- Illumination (CIE).+module Data.Colour.CIE.Illuminant where++import Data.Colour.CIE.Chromaticity++-- |Incandescent \/ Tungsten+a   :: (Fractional a) => Chromaticity a+a   = cieChroma 0.44757 0.40745 ++-- |{obsolete} Direct sunlight at noon+b   :: (Fractional a) => Chromaticity a+b   = cieChroma 0.34842 0.35161++-- |{obsolete} Average \/ North sky Daylight+c   :: (Fractional a) => Chromaticity a+c   = cieChroma 0.31006 0.31616++-- |Horizon Light. ICC profile PCS+d50 :: (Fractional a) => Chromaticity a+d50 = cieChroma 0.34567 0.35850++-- |Mid-morning \/ Mid-afternoon Daylight+d55 :: (Fractional a) => Chromaticity a+d55 = cieChroma 0.33242 0.34743++-- |Noon Daylight: Television, sRGB color space+d65 :: (Fractional a) => Chromaticity a+d65 = cieChroma 0.31271 0.32902++-- |North sky Daylight+d75 :: (Fractional a) => Chromaticity a+d75 = cieChroma 0.29902 0.31485++-- |Equal energy+e   :: (Fractional a) => Chromaticity a+e   = cieChroma (1/3)   (1/3)++-- |Daylight Fluorescent+f1  :: (Fractional a) => Chromaticity a+f1  = cieChroma 0.31310 0.33727++-- |Cool White Fluorescent+f2  :: (Fractional a) => Chromaticity a+f2  = cieChroma 0.37208 0.37529++-- |White Fluorescent+f3  :: (Fractional a) => Chromaticity a+f3  = cieChroma 0.40910 0.39430++-- |Warm White Fluorescent+f4  :: (Fractional a) => Chromaticity a+f4  = cieChroma 0.44018 0.40329++-- |Daylight Fluorescent+f5  :: (Fractional a) => Chromaticity a+f5  = cieChroma 0.31379 0.34531++-- |Lite White Fluorescent+f6  :: (Fractional a) => Chromaticity a+f6  = cieChroma 0.37790 0.38835++-- |D65 simulator, Daylight simulator+f7  :: (Fractional a) => Chromaticity a+f7  = cieChroma 0.31292 0.32933++-- |D50 simulator, Sylvania F40 Design 50+f8  :: (Fractional a) => Chromaticity a+f8  = cieChroma 0.34588 0.35875++-- |Cool White Deluxe Fluorescent+f9  :: (Fractional a) => Chromaticity a+f9  = cieChroma 0.37417 0.37281++-- |Philips TL85, Ultralume 50+f10 :: (Fractional a) => Chromaticity a+f10 = cieChroma 0.34609 0.35986++-- |Philips TL84, Ultralume 40+f11 :: (Fractional a) => Chromaticity a+f11 = cieChroma 0.38052 0.37713++-- |Philips TL83, Ultralume 30+f12 :: (Fractional a) => Chromaticity a+f12 = cieChroma 0.43695 0.40441

@@ -23,6 +23,9 @@ module Data.Colour.Chan where {- For internal use only:    Not to be exported from the package -}++import qualified Data.List+ newtype Chan p a = Chan a deriving (Eq)  empty :: (Num a) => Chan p a@@ -44,3 +47,6 @@  convert :: (Fractional b, Real a) => Chan p a -> Chan p b convert (Chan x) = Chan (realToFrac x)++sum :: (Num a) => [Chan p a] -> Chan p a+sum l = Chan (Data.List.sum [x |Chan x <- l])

@@ -23,57 +23,72 @@ module Data.Colour.Internal where  import Data.List+import qualified Data.Colour.RGB+import Data.Colour.RGB (RGBSpace(..))+import Data.Colour.CIE.Chromaticity+import Data.Colour.CIE.Illuminant import qualified Data.Colour.Chan as Chan import Data.Colour.Chan (Chan(Chan))+import Data.Monoid  data Red = Red data Green = Green data Blue = Blue  -- |This type represents the human preception of colour.--- The @a@ parameter is a numeric type used internally for the representation.+-- The @a@ parameter is a numeric type used internally for the+-- representation.+--+-- The 'Monoid' instance allows one to add colours, but beware that adding+-- colours can take you out of gamut.  Consider using 'blend' whenever+-- possible.  -- Internally we store the colour in linear ITU-R BT.709 RGB colour space. -data Colour a = RGB !(Chan Red a) !(Chan Green a) !(Chan Blue a) deriving (Eq)+data Colour a = RGB !(Chan Red a) !(Chan Green a) !(Chan Blue a) +                deriving (Eq)  -- |Constructs a 'Colour' from RGB values using the /linear/ RGB colour -- space specified in Rec.709.-rgb709 :: a -> a -> a -> Colour a+rgb709 :: (Fractional a) => a -> a -> a -> Colour a rgb709 r g b = RGB (Chan r) (Chan g) (Chan b)  -- |Return RGB values using the /linear/ RGB colour space specified in -- Rec.709.-toRGB709 :: Colour a -> (a,a,a)-toRGB709 (RGB (Chan r) (Chan g) (Chan b)) = (r,g,b)+toRGB709 :: (Fractional a) => Colour a -> Data.Colour.RGB.RGB a+toRGB709 (RGB (Chan r) (Chan g) (Chan b)) = Data.Colour.RGB.RGB r g b  -- |Change the type used to represent the colour coordinates. colourConvert :: (Fractional b, Real a) => Colour a -> Colour b colourConvert (RGB r g b) =   RGB (Chan.convert r) (Chan.convert g) (Chan.convert b) -instance (Show a) => Show (Colour a) where-  showsPrec _ c = ("(rgb709 "++) . (shows r) . (" "++)-                                 . (shows g) . (" "++)-                                 . (shows b) . (")"++)+instance (Num a) => Monoid (Colour a) where+  mempty = RGB Chan.empty Chan.empty Chan.empty+  (RGB r1 g1 b1) `mappend` (RGB r2 g2 b2) =+    RGB (r1 `Chan.add` r2) (g1 `Chan.add` g2) (b1 `Chan.add` b2)+  mconcat l = RGB (Chan.sum lr) (Chan.sum lg) (Chan.sum lb)    where-    (r,g,b) = toRGB709 c+    (lr,lg,lb) = unzip3 (map toRGB l)+    toRGB (RGB r g b) = (r,g,b)  data Alpha = Alpha  -- |This type represents a 'Colour' that may be semi-transparent.+--+-- The 'Monoid' instance allows you to composite colours.+--+-- >x `mappend` y == x `over` y+--+-- To get the (pre-multiplied) colour channel of an 'AlphaColour' @c@,+-- simply composite @c@ over black.+--+-- >c `over` (mempty :: Colour a)  -- Internally we use a premultiplied-alpha representation. data AlphaColour a = RGBA !(Colour a) !(Chan Alpha a) deriving (Eq) -instance (Fractional a) => Show (AlphaColour a) where-  showsPrec _ ac | a == 0 = ("transparent"++)-                 | otherwise = shows c . (" `withOpacity` "++) . shows a-   where-    a = alphaChannel ac-    c = colourChannel ac- -- |This 'AlphaColour' is entirely transparent and has no associated--- 'colourChannel'.+-- colour channel. transparent :: (Num a) => AlphaColour a transparent = RGBA (RGB Chan.empty Chan.empty Chan.empty) Chan.empty @@ -83,18 +98,18 @@ alphaColourConvert (RGBA c a) = RGBA (colourConvert c) (Chan.convert a)  -- |Creates an opaque 'AlphaColour' from a 'Colour'.-alphaColour :: (Num a) => Colour a -> AlphaColour a-alphaColour c = RGBA c Chan.full+opaque :: (Num a) => Colour a -> AlphaColour a+opaque c = RGBA c Chan.full --- |Returns a 'AlphaColour' more transparent by a factor of @o@.-fade :: (Num a) => a -> AlphaColour a -> AlphaColour a-fade o (RGBA c a) = RGBA (scale o c) (Chan.scale o a)+-- |Returns an 'AlphaColour' more transparent by a factor of @o@.+disolve :: (Num a) => a -> AlphaColour a -> AlphaColour a+disolve o (RGBA c a) = RGBA (darken o c) (Chan.scale o a)  -- |Creates an 'AlphaColour' from a 'Colour' with a given opacity. ----- >c `withOpacity` o == fade o (alphaColour c) +-- >c `withOpacity` o == disolve o (opaque c)  withOpacity :: (Num a) => Colour a -> a -> AlphaColour a-c `withOpacity` o = RGBA (scale o c) (Chan o)+c `withOpacity` o = RGBA (darken o c) (Chan o)  -------------------------------------------------------------------------- -- Blending@@ -106,24 +121,30 @@  -- e.g.  --  -- >affineCombo [(0.2,a), (0.3,b)] c == 0.2*a + 0.3*b + 0.4*c+ --+ -- Weights can be negative, or greater than 1.0; however, be aware+ -- that non-convex combinations may lead to out of gamut colours.  affineCombo :: (Num a) => [(a,f a)] -> f a -> f a  -- |Compute the weighted average of two points. -- e.g. -- -- >blend 0.4 a b = 0.4*a + 0.6*b+--+-- The weight can be negative, or greater than 1.0; however, be aware+-- that non-convex combinations may lead to out of gamut colours. blend :: (Num a, AffineSpace f) => a -> f a -> f a -> f a blend weight c1 c2 = affineCombo [(weight,c1)] c2  instance AffineSpace Colour where  affineCombo l z =-   foldl1' rgbAdd [scale w a | (w,a) <- (1-total,z):l]+   foldl1' mappend [darken w a | (w,a) <- (1-total,z):l]   where    total = sum $ map fst l  instance AffineSpace AlphaColour where  affineCombo l z =-   foldl1' rgbaAdd [fade w a | (w,a) <- (1-total,z):l]+   foldl1' rgbaAdd [disolve w a | (w,a) <- (1-total,z):l]   where    total = sum $ map fst l @@ -131,26 +152,46 @@ -- composite -------------------------------------------------------------------------- -class Composite f where+class ColourOps f where  -- |@c1 \`over\` c2@ returns the 'Colour' created by compositing the  -- 'AlphaColour' @c1@ over @c2@, which may be either a 'Colour' or  -- 'AlphaColour'.  over :: (Num a) => AlphaColour a -> f a -> f a+ -- |@darken s c@ blends a colour with black without changing it's opacity.+ --+ -- For 'Colour', @darken s c = blend s c mempty@+ darken :: (Num a) => a -> f a -> f a -instance Composite Colour where+instance ColourOps Colour where  (RGBA (RGB r0 g0 b0) (Chan a0)) `over` (RGB r1 g1 b1) =    RGB (Chan.over r0 a0 r1)        (Chan.over g0 a0 g1)        (Chan.over b0 a0 b1)+ darken s (RGB r g b) = RGB (Chan.scale s r)+                            (Chan.scale s g)+                            (Chan.scale s b) -instance Composite AlphaColour where+instance ColourOps AlphaColour where  c0@(RGBA _ a0@(Chan a0')) `over` (RGBA c1 a1) =    RGBA (c0 `over` c1) (Chan.over a0 a0' a1)+ darken s (RGBA c a) = RGBA (darken s c) a --- |Composites @c1@ over @c2@ using opacity @a@.-compositeWith :: (Num a) => a -> Colour a -> Colour a -> Colour a-compositeWith a c1 c2 = (c1 `withOpacity` a) `over` c2+-- | 'AlphaColour' forms a monoid with 'over' and 'transparent'.+instance (Num a) => Monoid (AlphaColour a) where+  mempty = transparent+  mappend = over +-- | @c1 \`atop\` c2@ returns the 'AlphaColour' produced by covering+-- the portion of @c2@ visible by @c1@.+-- The resulting alpha channel is always the same as the alpha channel+-- of @c2@.+--+-- >c1 `atop` (opaque c2) == c1 `over` (opaque c2)+-- >AlphaChannel (c1 `atop` c2) == AlphaChannel c2+atop :: (Fractional a) => AlphaColour a -> AlphaColour a -> AlphaColour a+atop (RGBA c0 (Chan a0)) (RGBA c1 (Chan a1)) = +  RGBA (darken a1 c0 `mappend` darken (1-a0) c1) (Chan a1)+ -- |'round's and then clamps @x@ between 0 and 'maxBound'. quantize :: (RealFrac a1, Integral a, Bounded a) => a1 -> a quantize x | x <= fromIntegral l = l@@ -162,39 +203,19 @@  {- Avoid using -} -- |Returns the opacity of an 'AlphaColour'.--- This function is provided only for converting to other datatypes.--- Its use is discouraged.--- Instead compose the 'AlphaColour' with another 'Colour' and extract--- the resulting 'Colour' components. alphaChannel :: AlphaColour a -> a alphaChannel (RGBA _ (Chan a)) = a --- |Returns the colour of an 'AlphaColour'.--- @colourChannel transparent@ is undefined and may result in @nan@ or an--- error.--- This function is provided only for converting to other datatypes.--- Its use is discouraged.--- Instead compose the 'AlphaColour' with another 'Colour' and extract the--- resulting 'Colour' components.-colourChannel :: (Fractional a) => AlphaColour a -> Colour a-colourChannel (RGBA (RGB r g b) (Chan a)) =-  RGB (Chan.scale a' r)-      (Chan.scale a' g)-      (Chan.scale a' b)-- where-  a' = recip a+rgb709Space :: Fractional a => RGBSpace a+rgb709Space = RGBSpace (Data.Colour.RGB.RGB+                        (cieChroma 0.64 0.33)+                        (cieChroma 0.30 0.60)+                        (cieChroma 0.15 0.06))+                       d65  -------------------------------------------------------------------------- -- not for export -------------------------------------------------------------------------- -scale s (RGB r g b) = RGB (Chan.scale s r)-                          (Chan.scale s g)-                          (Chan.scale s b)--rgbAdd (RGB r1 g1 b1) (RGB r2 g2 b2) =-  RGB (r1 `Chan.add` r2) (g1 `Chan.add` g2) (b1 `Chan.add` b2)- rgbaAdd (RGBA c1 a1) (RGBA c2 a2) =-  RGBA (c1 `rgbAdd` c2) (a1 `Chan.add` a2)+  RGBA (c1 `mappend` c2) (a1 `Chan.add` a2)

@@ -1,69 +0,0 @@-{--Copyright (c) 2008-Russell O'Connor--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN-THE SOFTWARE.--}-module Data.Colour.Luma where-{- For internal use only:-   Not to be exported from the package -}-import Data.Colour.SRGB-import Data.Colour.Internal-import Data.Word--type LumaCoef = (Rational, Rational, Rational)--{- rec 709 luma -}-luma :: (Floating a, RealFrac a) => LumaCoef -> Colour a -> a-luma (lr, lg, lb) c =-  transformBy [fromRational lr, fromRational lg, fromRational lb]- where-  (r',g',b') = toSRGB c-  transformBy l = sum $ zipWith (*) l [r',g',b']--y'PbPr :: (Floating a, RealFrac a) => LumaCoef -> a -> a -> a -> Colour a-y'PbPr (lr, lg, lb) y' pb pr = sRGB r' g' b'- where-  r' = y' + fromRational ((lg + lb)/0.5)*pr-  g' = (y' - fromRational lr*r' - fromRational lb*b')/fromRational lg-  b' = y' + fromRational ((lg + lr)/0.5)*pb--toY'PbPr :: (Floating a, RealFrac a) => LumaCoef -> Colour a -> (a, a, a)-toY'PbPr l@(lr, lg, lb) c = (y', pb, pr)- where-  y' = luma l c-  (r', g', b') = toSRGB c-  pb = fromRational (0.5/(lg + lr))*(b' - y')-  pr = fromRational (0.5/(lg + lb))*(r' - y')--y'CbCr :: (Floating a, RealFrac a) =>-          LumaCoef -> Word8 -> Word8 -> Word8 -> Colour a-y'CbCr l y' cb cr = y'PbPr l y'0 pb pr- where-  y'0 = ((fromIntegral y') - 16)/219-  pb  = ((fromIntegral cb) - 128)/224-  pr  = ((fromIntegral cr) - 128)/224--toY'CbCr :: (Floating a, RealFrac a) =>-            LumaCoef -> Colour a -> (Word8, Word8, Word8)-toY'CbCr l c = (quantize $ 16 + 219*y'-             ,quantize $ 128 + 224*pb-             ,quantize $ 128 + 224*pr)- where-  (y', pb, pr) = toY'PbPr l c

@@ -22,13 +22,19 @@ -} module Data.Colour.Matrix where +import Data.List+ default (Rational) -inverse [[a,b,c],[d,e,f],[g,h,i]] =+inverse m@[[a,b,c],[d,e,f],[g,h,i]] =   [[(e*i-f*h)/det, -(b*i-c*h)/det, (b*f-c*e)/det]   ,[-(d*i-f*g)/det, (a*i-c*g)/det, -(a*f-c*d)/det]   ,[(d*h-e*g)/det, -(a*h-b*g)/det, (a*e-b*d)/det]]  where-  det = a*(e*i-f*h) - b*(d*i-f*g) + c*(d*h-e*g)+  det = determinant m+determinant [[a,b,c],[d,e,f],[g,h,i]] =+  a*(e*i-f*h) - b*(d*i-f*g) + c*(d*h-e*g)  mult l x = map (sum . (zipWith (*) x)) l++matrixMult l m = transpose (map (mult l) (transpose m))

@@ -22,448 +22,606 @@ -}  -- |Names for colours.--- Names taken from SVG 1.0 specification.+-- Names taken from SVG 1.1 specification,+-- <http://www.w3.org/TR/SVG11/types.html#ColorKeywords>.+--+-- 'readColourName' takes a string naming a colour (must be all lowercase)+-- and returns the colour.+-- Fails if the name is not recognized. module Data.Colour.Names where  import Prelude hiding (tan) import Data.Colour.SRGB import Data.Colour +readColourName :: (Monad m, Ord a, Floating a) => String -> m (Colour a)+readColourName "aliceblue" = return aliceblue+readColourName "antiquewhite" = return antiquewhite+readColourName "aqua" = return aqua+readColourName "aquamarine" = return aquamarine+readColourName "azure" = return azure+readColourName "beige" = return beige+readColourName "bisque" = return bisque+readColourName "black" = return black+readColourName "blanchedalmond" = return blanchedalmond+readColourName "blue" = return blue+readColourName "blueviolet" = return blueviolet+readColourName "brown" = return brown+readColourName "burlywood" = return burlywood+readColourName "cadetblue" = return cadetblue+readColourName "chartreuse" = return chartreuse+readColourName "chocolate" = return chocolate+readColourName "coral" = return coral+readColourName "cornflowerblue" = return cornflowerblue+readColourName "cornsilk" = return cornsilk+readColourName "crimson" = return crimson+readColourName "cyan" = return cyan+readColourName "darkblue" = return darkblue+readColourName "darkcyan" = return darkcyan+readColourName "darkgoldenrod" = return darkgoldenrod+readColourName "darkgray" = return darkgray+readColourName "darkgreen" = return darkgreen+readColourName "darkgrey" = return darkgrey+readColourName "darkkhaki" = return darkkhaki+readColourName "darkmagenta" = return darkmagenta+readColourName "darkolivegreen" = return darkolivegreen+readColourName "darkorange" = return darkorange+readColourName "darkorchid" = return darkorchid+readColourName "darkred" = return darkred+readColourName "darksalmon" = return darksalmon+readColourName "darkseagreen" = return darkseagreen+readColourName "darkslateblue" = return darkslateblue+readColourName "darkslategray" = return darkslategray+readColourName "darkslategrey" = return darkslategrey+readColourName "darkturquoise" = return darkturquoise+readColourName "darkviolet" = return darkviolet+readColourName "deeppink" = return deeppink+readColourName "deepskyblue" = return deepskyblue+readColourName "dimgray" = return dimgray+readColourName "dimgrey" = return dimgrey+readColourName "dodgerblue" = return dodgerblue+readColourName "firebrick" = return firebrick+readColourName "floralwhite" = return floralwhite+readColourName "forestgreen" = return forestgreen+readColourName "fuchsia" = return fuchsia+readColourName "gainsboro" = return gainsboro+readColourName "ghostwhite" = return ghostwhite+readColourName "gold" = return gold+readColourName "goldenrod" = return goldenrod+readColourName "gray" = return gray+readColourName "grey" = return grey+readColourName "green" = return green+readColourName "greenyellow" = return greenyellow+readColourName "honeydew" = return honeydew+readColourName "hotpink" = return hotpink+readColourName "indianred" = return indianred+readColourName "indigo" = return indigo+readColourName "ivory" = return ivory+readColourName "khaki" = return khaki+readColourName "lavender" = return lavender+readColourName "lavenderblush" = return lavenderblush+readColourName "lawngreen" = return lawngreen+readColourName "lemonchiffon" = return lemonchiffon+readColourName "lightblue" = return lightblue+readColourName "lightcoral" = return lightcoral+readColourName "lightcyan" = return lightcyan+readColourName "lightgoldenrodyellow" = return lightgoldenrodyellow+readColourName "lightgray" = return lightgray+readColourName "lightgreen" = return lightgreen+readColourName "lightgrey" = return lightgrey+readColourName "lightpink" = return lightpink+readColourName "lightsalmon" = return lightsalmon+readColourName "lightseagreen" = return lightseagreen+readColourName "lightskyblue" = return lightskyblue+readColourName "lightslategray" = return lightslategray+readColourName "lightslategrey" = return lightslategrey+readColourName "lightsteelblue" = return lightsteelblue+readColourName "lightyellow" = return lightyellow+readColourName "lime" = return lime+readColourName "limegreen" = return limegreen+readColourName "linen" = return linen+readColourName "magenta" = return magenta+readColourName "maroon" = return maroon+readColourName "mediumaquamarine" = return mediumaquamarine+readColourName "mediumblue" = return mediumblue+readColourName "mediumorchid" = return mediumorchid+readColourName "mediumpurple" = return mediumpurple+readColourName "mediumseagreen" = return mediumseagreen+readColourName "mediumslateblue" = return mediumslateblue+readColourName "mediumspringgreen" = return mediumspringgreen+readColourName "mediumturquoise" = return mediumturquoise+readColourName "mediumvioletred" = return mediumvioletred+readColourName "midnightblue" = return midnightblue+readColourName "mintcream" = return mintcream+readColourName "mistyrose" = return mistyrose+readColourName "moccasin" = return moccasin+readColourName "navajowhite" = return navajowhite+readColourName "navy" = return navy+readColourName "oldlace" = return oldlace+readColourName "olive" = return olive+readColourName "olivedrab" = return olivedrab+readColourName "orange" = return orange+readColourName "orangered" = return orangered+readColourName "orchid" = return orchid+readColourName "palegoldenrod" = return palegoldenrod+readColourName "palegreen" = return palegreen+readColourName "paleturquoise" = return paleturquoise+readColourName "palevioletred" = return palevioletred+readColourName "papayawhip" = return papayawhip+readColourName "peachpuff" = return peachpuff+readColourName "peru" = return peru+readColourName "pink" = return pink+readColourName "plum" = return plum+readColourName "powderblue" = return powderblue+readColourName "purple" = return purple+readColourName "red" = return red+readColourName "rosybrown" = return rosybrown+readColourName "royalblue" = return royalblue+readColourName "saddlebrown" = return saddlebrown+readColourName "salmon" = return salmon+readColourName "sandybrown" = return sandybrown+readColourName "seagreen" = return seagreen+readColourName "seashell" = return seashell+readColourName "sienna" = return sienna+readColourName "silver" = return silver+readColourName "skyblue" = return skyblue+readColourName "slateblue" = return slateblue+readColourName "slategray" = return slategray+readColourName "slategrey" = return slategrey+readColourName "snow" = return snow+readColourName "springgreen" = return springgreen+readColourName "steelblue" = return steelblue+readColourName "tan" = return tan+readColourName "teal" = return teal+readColourName "thistle" = return thistle+readColourName "tomato" = return tomato+readColourName "turquoise" = return turquoise+readColourName "violet" = return violet+readColourName "wheat" = return wheat+readColourName "white" = return white+readColourName "whitesmoke" = return whitesmoke+readColourName "yellow" = return yellow+readColourName "yellowgreen" = return yellowgreen+readColourName x = fail $ +  "Data.Colour.Names.readColourNames: Unknown colour name "++show x+ aliceblue :: (Ord a, Floating a) => Colour a-aliceblue = sRGB24 0xF0 0xF8 0xFF+aliceblue = sRGB24 240 248 255  antiquewhite :: (Ord a, Floating a) => Colour a-antiquewhite = sRGB24 0xFA 0xEB 0xD7+antiquewhite = sRGB24 250 235 215  aqua :: (Ord a, Floating a) => Colour a-aqua = sRGB24 0x00 0xFF 0xFF+aqua = sRGB24 0 255 255  aquamarine :: (Ord a, Floating a) => Colour a-aquamarine = sRGB24 0x7F 0xFF 0xD4+aquamarine = sRGB24 127 255 212  azure :: (Ord a, Floating a) => Colour a-azure = sRGB24 0xF0 0xFF 0xFF+azure = sRGB24 240 255 255  beige :: (Ord a, Floating a) => Colour a-beige = sRGB24 0xF5 0xF5 0xDC+beige = sRGB24 245 245 220  bisque :: (Ord a, Floating a) => Colour a-bisque = sRGB24 0xFF 0xE4 0xC4+bisque = sRGB24 255 228 196  black :: (Ord a, Floating a) => Colour a-black = sRGB24 0x00 0x00 0x00+black = sRGB24 0 0 0  blanchedalmond :: (Ord a, Floating a) => Colour a-blanchedalmond = sRGB24 0xFF 0xEB 0xCD+blanchedalmond = sRGB24 255 235 205  blue :: (Ord a, Floating a) => Colour a-blue = sRGB24 0x00 0x00 0xFF+blue = sRGB24 0 0 255  blueviolet :: (Ord a, Floating a) => Colour a-blueviolet = sRGB24 0x8A 0x2B 0xE2+blueviolet = sRGB24 138 43 226  brown :: (Ord a, Floating a) => Colour a-brown = sRGB24 0xA5 0x2A 0x2A+brown = sRGB24 165 42 42  burlywood :: (Ord a, Floating a) => Colour a-burlywood = sRGB24 0xDE 0xB8 0x87+burlywood = sRGB24 222 184 135  cadetblue :: (Ord a, Floating a) => Colour a-cadetblue = sRGB24 0x5F 0x9E 0xA0+cadetblue = sRGB24 95 158 160  chartreuse :: (Ord a, Floating a) => Colour a-chartreuse = sRGB24 0x7F 0xFF 0x00+chartreuse = sRGB24 127 255 0  chocolate :: (Ord a, Floating a) => Colour a-chocolate = sRGB24 0xD2 0x69 0x1E+chocolate = sRGB24 210 105 30  coral :: (Ord a, Floating a) => Colour a-coral = sRGB24 0xFF 0x7F 0x50+coral = sRGB24 255 127 80  cornflowerblue :: (Ord a, Floating a) => Colour a-cornflowerblue = sRGB24 0x64 0x95 0xED+cornflowerblue = sRGB24 100 149 237  cornsilk :: (Ord a, Floating a) => Colour a-cornsilk = sRGB24 0xFF 0xF8 0xDC+cornsilk = sRGB24 255 248 220  crimson :: (Ord a, Floating a) => Colour a-crimson = sRGB24 0xDC 0x14 0x3C+crimson = sRGB24 220 20 60  cyan :: (Ord a, Floating a) => Colour a-cyan = sRGB24 0x00 0xFF 0xFF+cyan = sRGB24 0 255 255  darkblue :: (Ord a, Floating a) => Colour a-darkblue = sRGB24 0x00 0x00 0x8B+darkblue = sRGB24 0 0 139  darkcyan :: (Ord a, Floating a) => Colour a-darkcyan = sRGB24 0x00 0x8B 0x8B+darkcyan = sRGB24 0 139 139  darkgoldenrod :: (Ord a, Floating a) => Colour a-darkgoldenrod = sRGB24 0xB8 0x86 0x0B--darkgrey :: (Ord a, Floating a) => Colour a-darkgrey = sRGB24 0xA9 0xA9 0xA9+darkgoldenrod = sRGB24 184 134 11  darkgray :: (Ord a, Floating a) => Colour a-darkgray = darkgrey+darkgray = sRGB24 169 169 169  darkgreen :: (Ord a, Floating a) => Colour a-darkgreen = sRGB24 0x00 0x64 0x00+darkgreen = sRGB24 0 100 0 +darkgrey :: (Ord a, Floating a) => Colour a+darkgrey = sRGB24 169 169 169+ darkkhaki :: (Ord a, Floating a) => Colour a-darkkhaki = sRGB24 0xBD 0xB7 0x6B+darkkhaki = sRGB24 189 183 107  darkmagenta :: (Ord a, Floating a) => Colour a-darkmagenta = sRGB24 0x8B 0x00 0x8B+darkmagenta = sRGB24 139 0 139  darkolivegreen :: (Ord a, Floating a) => Colour a-darkolivegreen = sRGB24 0x55 0x6B 0x2F+darkolivegreen = sRGB24 85 107 47  darkorange :: (Ord a, Floating a) => Colour a-darkorange = sRGB24 0xFF 0x8C 0x00+darkorange = sRGB24 255 140 0  darkorchid :: (Ord a, Floating a) => Colour a-darkorchid = sRGB24 0x99 0x32 0xCC+darkorchid = sRGB24 153 50 204  darkred :: (Ord a, Floating a) => Colour a-darkred = sRGB24 0x8B 0x00 0x00+darkred = sRGB24 139 0 0  darksalmon :: (Ord a, Floating a) => Colour a-darksalmon = sRGB24 0xE9 0x96 0x7A+darksalmon = sRGB24 233 150 122  darkseagreen :: (Ord a, Floating a) => Colour a-darkseagreen = sRGB24 0x8F 0xBC 0x8F+darkseagreen = sRGB24 143 188 143  darkslateblue :: (Ord a, Floating a) => Colour a-darkslateblue = sRGB24 0x48 0x3D 0x8B+darkslateblue = sRGB24 72 61 139 -darkturqoise :: (Ord a, Floating a) => Colour a-darkturqoise = sRGB24 0x00 0xCE 0xD1+darkslategray :: (Ord a, Floating a) => Colour a+darkslategray = sRGB24 47 79 79  darkslategrey :: (Ord a, Floating a) => Colour a-darkslategrey = sRGB24 0x2F 0x4F 0x4F+darkslategrey = sRGB24 47 79 79 -darkslategray :: (Ord a, Floating a) => Colour a-darkslategray = darkslategrey+darkturquoise :: (Ord a, Floating a) => Colour a+darkturquoise = sRGB24 0 206 209  darkviolet :: (Ord a, Floating a) => Colour a-darkviolet = sRGB24 0x94 0x00 0xD3+darkviolet = sRGB24 148 0 211  deeppink :: (Ord a, Floating a) => Colour a-deeppink = sRGB24 0xFF 0x14 0x93+deeppink = sRGB24 255 20 147  deepskyblue :: (Ord a, Floating a) => Colour a-deepskyblue = sRGB24 0x00 0xBF 0xFF--dimgrey :: (Ord a, Floating a) => Colour a-dimgrey = sRGB24 0x69 0x69 0x69+deepskyblue = sRGB24 0 191 255  dimgray :: (Ord a, Floating a) => Colour a-dimgray = dimgrey+dimgray = sRGB24 105 105 105 +dimgrey :: (Ord a, Floating a) => Colour a+dimgrey = sRGB24 105 105 105+ dodgerblue :: (Ord a, Floating a) => Colour a-dodgerblue = sRGB24 0x1E 0x90 0xFF+dodgerblue = sRGB24 30 144 255  firebrick :: (Ord a, Floating a) => Colour a-firebrick = sRGB24 0xB2 0x22 0x22+firebrick = sRGB24 178 34 34  floralwhite :: (Ord a, Floating a) => Colour a-floralwhite = sRGB24 0xFF 0xFA 0xF0+floralwhite = sRGB24 255 250 240  forestgreen :: (Ord a, Floating a) => Colour a-forestgreen = sRGB24 0x22 0x8B 0x22+forestgreen = sRGB24 34 139 34  fuchsia :: (Ord a, Floating a) => Colour a-fuchsia = sRGB24 0xFF 0x00 0xFF+fuchsia = sRGB24 255 0 255  gainsboro :: (Ord a, Floating a) => Colour a-gainsboro = sRGB24 0xDC 0xDC 0xDC+gainsboro = sRGB24 220 220 220  ghostwhite :: (Ord a, Floating a) => Colour a-ghostwhite = sRGB24 0xF8 0xF8 0xFF+ghostwhite = sRGB24 248 248 255  gold :: (Ord a, Floating a) => Colour a-gold = sRGB24 0xFF 0xD7 0x00+gold = sRGB24 255 215 0  goldenrod :: (Ord a, Floating a) => Colour a-goldenrod = sRGB24 0xDA 0xA5 0x20--grey :: (Ord a, Floating a) => Colour a-grey = sRGB24 0x80 0x80 0x80+goldenrod = sRGB24 218 165 32  gray :: (Ord a, Floating a) => Colour a-gray = grey+gray = sRGB24 128 128 128 +grey :: (Ord a, Floating a) => Colour a+grey = sRGB24 128 128 128+ green :: (Ord a, Floating a) => Colour a-green = sRGB24 0x00 0x80 0x00+green = sRGB24 0 128 0  greenyellow :: (Ord a, Floating a) => Colour a-greenyellow = sRGB24 0xAD 0xFF 0x2F+greenyellow = sRGB24 173 255 47  honeydew :: (Ord a, Floating a) => Colour a-honeydew = sRGB24 0xF0 0xFF 0xF0+honeydew = sRGB24 240 255 240  hotpink :: (Ord a, Floating a) => Colour a-hotpink = sRGB24 0xFF 0x69 0xB4+hotpink = sRGB24 255 105 180  indianred :: (Ord a, Floating a) => Colour a-indianred = sRGB24 0xCD 0x5C 0x5C+indianred = sRGB24 205 92 92  indigo :: (Ord a, Floating a) => Colour a-indigo = sRGB24 0x4B 0x00 0x82+indigo = sRGB24 75 0 130  ivory :: (Ord a, Floating a) => Colour a-ivory = sRGB24 0xFF 0xFF 0xF0+ivory = sRGB24 255 255 240  khaki :: (Ord a, Floating a) => Colour a-khaki = sRGB24 0xF0 0xE6 0x8C+khaki = sRGB24 240 230 140  lavender :: (Ord a, Floating a) => Colour a-lavender = sRGB24 0xE6 0xE6 0xFA+lavender = sRGB24 230 230 250  lavenderblush :: (Ord a, Floating a) => Colour a-lavenderblush = sRGB24 0xFF 0xF0 0xF5+lavenderblush = sRGB24 255 240 245  lawngreen :: (Ord a, Floating a) => Colour a-lawngreen = sRGB24 0x7C 0xFC 0x00+lawngreen = sRGB24 124 252 0  lemonchiffon :: (Ord a, Floating a) => Colour a-lemonchiffon = sRGB24 0xFF 0xFA 0xCD+lemonchiffon = sRGB24 255 250 205  lightblue :: (Ord a, Floating a) => Colour a-lightblue = sRGB24 0xAD 0xD8 0xE6+lightblue = sRGB24 173 216 230  lightcoral :: (Ord a, Floating a) => Colour a-lightcoral = sRGB24 0xF0 0x80 0x80+lightcoral = sRGB24 240 128 128  lightcyan :: (Ord a, Floating a) => Colour a-lightcyan = sRGB24 0xE0 0xFF 0xFF+lightcyan = sRGB24 224 255 255  lightgoldenrodyellow :: (Ord a, Floating a) => Colour a-lightgoldenrodyellow = sRGB24 0xFA 0xFA 0xD2+lightgoldenrodyellow = sRGB24 250 250 210 +lightgray :: (Ord a, Floating a) => Colour a+lightgray = sRGB24 211 211 211+ lightgreen :: (Ord a, Floating a) => Colour a-lightgreen = sRGB24 0x90 0xEE 0x90+lightgreen = sRGB24 144 238 144  lightgrey :: (Ord a, Floating a) => Colour a-lightgrey = sRGB24 0xD3 0xD3 0xD3--lightgray :: (Ord a, Floating a) => Colour a-lightgray = lightgrey+lightgrey = sRGB24 211 211 211  lightpink :: (Ord a, Floating a) => Colour a-lightpink = sRGB24 0xFF 0xB6 0xC1+lightpink = sRGB24 255 182 193  lightsalmon :: (Ord a, Floating a) => Colour a-lightsalmon = sRGB24 0xFF 0xA0 0x7A+lightsalmon = sRGB24 255 160 122  lightseagreen :: (Ord a, Floating a) => Colour a-lightseagreen = sRGB24 0x20 0xB2 0xAA+lightseagreen = sRGB24 32 178 170  lightskyblue :: (Ord a, Floating a) => Colour a-lightskyblue = sRGB24 0x87 0xCE 0xFA--lightslategrey :: (Ord a, Floating a) => Colour a-lightslategrey = sRGB24 0x77 0x88 0x99+lightskyblue = sRGB24 135 206 250  lightslategray :: (Ord a, Floating a) => Colour a-lightslategray = lightslategrey+lightslategray = sRGB24 119 136 153 -lisghtsteelblue :: (Ord a, Floating a) => Colour a-lisghtsteelblue = sRGB24 0xB0 0xC4 0xDE+lightslategrey :: (Ord a, Floating a) => Colour a+lightslategrey = sRGB24 119 136 153 +lightsteelblue :: (Ord a, Floating a) => Colour a+lightsteelblue = sRGB24 176 196 222+ lightyellow :: (Ord a, Floating a) => Colour a-lightyellow = sRGB24 0xFF 0xFF 0xE0+lightyellow = sRGB24 255 255 224  lime :: (Ord a, Floating a) => Colour a-lime = sRGB24 0x00 0xFF 0x00+lime = sRGB24 0 255 0  limegreen :: (Ord a, Floating a) => Colour a-limegreen = sRGB24 0x32 0xCD 0x32+limegreen = sRGB24 50 205 50  linen :: (Ord a, Floating a) => Colour a-linen = sRGB24 0xFA 0xF0 0xE6+linen = sRGB24 250 240 230  magenta :: (Ord a, Floating a) => Colour a-magenta = sRGB24 0xFF 0x00 0xFF+magenta = sRGB24 255 0 255  maroon :: (Ord a, Floating a) => Colour a-maroon = sRGB24 0x80 0x00 0x00+maroon = sRGB24 128 0 0  mediumaquamarine :: (Ord a, Floating a) => Colour a-mediumaquamarine = sRGB24 0x66 0xCD 0xAA+mediumaquamarine = sRGB24 102 205 170  mediumblue :: (Ord a, Floating a) => Colour a-mediumblue = sRGB24 0x00 0x00 0xCD+mediumblue = sRGB24 0 0 205  mediumorchid :: (Ord a, Floating a) => Colour a-mediumorchid = sRGB24 0xBA 0x55 0xD3+mediumorchid = sRGB24 186 85 211  mediumpurple :: (Ord a, Floating a) => Colour a-mediumpurple = sRGB24 0x93 0x70 0xDB+mediumpurple = sRGB24 147 112 219  mediumseagreen :: (Ord a, Floating a) => Colour a-mediumseagreen = sRGB24 0x3C 0xB3 0x71+mediumseagreen = sRGB24 60 179 113  mediumslateblue :: (Ord a, Floating a) => Colour a-mediumslateblue = sRGB24 0x7B 0x68 0xEE+mediumslateblue = sRGB24 123 104 238  mediumspringgreen :: (Ord a, Floating a) => Colour a-mediumspringgreen = sRGB24 0x00 0xFA 0x9A+mediumspringgreen = sRGB24 0 250 154  mediumturquoise :: (Ord a, Floating a) => Colour a-mediumturquoise = sRGB24 0x48 0xD1 0xCC+mediumturquoise = sRGB24 72 209 204  mediumvioletred :: (Ord a, Floating a) => Colour a-mediumvioletred = sRGB24 0xC7 0x15 0x85+mediumvioletred = sRGB24 199 21 133  midnightblue :: (Ord a, Floating a) => Colour a-midnightblue = sRGB24 0x19 0x19 0x70+midnightblue = sRGB24 25 25 112  mintcream :: (Ord a, Floating a) => Colour a-mintcream = sRGB24 0xF5 0xFF 0xFA+mintcream = sRGB24 245 255 250  mistyrose :: (Ord a, Floating a) => Colour a-mistyrose = sRGB24 0xFF 0xE4 0xE1+mistyrose = sRGB24 255 228 225  moccasin :: (Ord a, Floating a) => Colour a-moccasin = sRGB24 0xFF 0xE4 0xB5+moccasin = sRGB24 255 228 181  navajowhite :: (Ord a, Floating a) => Colour a-navajowhite = sRGB24 0xFF 0xDE 0xAD+navajowhite = sRGB24 255 222 173  navy :: (Ord a, Floating a) => Colour a-navy = sRGB24 0x00 0x00 0x80--navyblue :: (Ord a, Floating a) => Colour a-navyblue = sRGB24 0x9F 0xAF 0xDF+navy = sRGB24 0 0 128  oldlace :: (Ord a, Floating a) => Colour a-oldlace = sRGB24 0xFD 0xF5 0xE6+oldlace = sRGB24 253 245 230  olive :: (Ord a, Floating a) => Colour a-olive = sRGB24 0x80 0x80 0x00+olive = sRGB24 128 128 0  olivedrab :: (Ord a, Floating a) => Colour a-olivedrab = sRGB24 0x6B 0x8E 0x23+olivedrab = sRGB24 107 142 35  orange :: (Ord a, Floating a) => Colour a-orange = sRGB24 0xFF 0xA5 0x00+orange = sRGB24 255 165 0  orangered :: (Ord a, Floating a) => Colour a-orangered = sRGB24 0xFF 0x45 0x00+orangered = sRGB24 255 69 0  orchid :: (Ord a, Floating a) => Colour a-orchid = sRGB24 0xDA 0x70 0xD6+orchid = sRGB24 218 112 214  palegoldenrod :: (Ord a, Floating a) => Colour a-palegoldenrod = sRGB24 0xEE 0xE8 0xAA+palegoldenrod = sRGB24 238 232 170  palegreen :: (Ord a, Floating a) => Colour a-palegreen = sRGB24 0x98 0xFB 0x98+palegreen = sRGB24 152 251 152  paleturquoise :: (Ord a, Floating a) => Colour a-paleturquoise = sRGB24 0xAF 0xEE 0xEE+paleturquoise = sRGB24 175 238 238  palevioletred :: (Ord a, Floating a) => Colour a-palevioletred = sRGB24 0xDB 0x70 0x93+palevioletred = sRGB24 219 112 147  papayawhip :: (Ord a, Floating a) => Colour a-papayawhip = sRGB24 0xFF 0xEF 0xD5+papayawhip = sRGB24 255 239 213  peachpuff :: (Ord a, Floating a) => Colour a-peachpuff = sRGB24 0xFF 0xDA 0xB9+peachpuff = sRGB24 255 218 185  peru :: (Ord a, Floating a) => Colour a-peru = sRGB24 0xCD 0x85 0x3F+peru = sRGB24 205 133 63  pink :: (Ord a, Floating a) => Colour a-pink = sRGB24 0xFF 0xC0 0xCB+pink = sRGB24 255 192 203  plum :: (Ord a, Floating a) => Colour a-plum = sRGB24 0xDD 0xA0 0xDD+plum = sRGB24 221 160 221  powderblue :: (Ord a, Floating a) => Colour a-powderblue = sRGB24 0xB0 0xE0 0xE6+powderblue = sRGB24 176 224 230  purple :: (Ord a, Floating a) => Colour a-purple = sRGB24 0x80 0x00 0x80+purple = sRGB24 128 0 128  red :: (Ord a, Floating a) => Colour a-red = sRGB24 0xFF 0x00 0x00+red = sRGB24 255 0 0  rosybrown :: (Ord a, Floating a) => Colour a-rosybrown = sRGB24 0xBC 0x8F 0x8F+rosybrown = sRGB24 188 143 143  royalblue :: (Ord a, Floating a) => Colour a-royalblue = sRGB24 0x41 0x69 0xE1+royalblue = sRGB24 65 105 225  saddlebrown :: (Ord a, Floating a) => Colour a-saddlebrown = sRGB24 0x8B 0x45 0x13+saddlebrown = sRGB24 139 69 19  salmon :: (Ord a, Floating a) => Colour a-salmon = sRGB24 0xFA 0x80 0x72+salmon = sRGB24 250 128 114  sandybrown :: (Ord a, Floating a) => Colour a-sandybrown = sRGB24 0xF4 0xA4 0x60+sandybrown = sRGB24 244 164 96  seagreen :: (Ord a, Floating a) => Colour a-seagreen = sRGB24 0x2E 0x8B 0x57+seagreen = sRGB24 46 139 87  seashell :: (Ord a, Floating a) => Colour a-seashell = sRGB24 0xFF 0xF5 0xEE+seashell = sRGB24 255 245 238  sienna :: (Ord a, Floating a) => Colour a-sienna = sRGB24 0xA0 0x52 0x2D+sienna = sRGB24 160 82 45  silver :: (Ord a, Floating a) => Colour a-silver = sRGB24 0xC0 0xC0 0xC0+silver = sRGB24 192 192 192  skyblue :: (Ord a, Floating a) => Colour a-skyblue = sRGB24 0x87 0xCE 0xEB+skyblue = sRGB24 135 206 235  slateblue :: (Ord a, Floating a) => Colour a-slateblue = sRGB24 0x6A 0x5A 0xCD+slateblue = sRGB24 106 90 205 +slategray :: (Ord a, Floating a) => Colour a+slategray = sRGB24 112 128 144++slategrey :: (Ord a, Floating a) => Colour a+slategrey = sRGB24 112 128 144+ snow :: (Ord a, Floating a) => Colour a-snow = sRGB24 0xFF 0xFA 0xFA+snow = sRGB24 255 250 250  springgreen :: (Ord a, Floating a) => Colour a-springgreen = sRGB24 0x00 0xFF 0x7F+springgreen = sRGB24 0 255 127  steelblue :: (Ord a, Floating a) => Colour a-steelblue = sRGB24 0x46 0x82 0xB4+steelblue = sRGB24 70 130 180  tan :: (Ord a, Floating a) => Colour a-tan = sRGB24 0xD2 0xB4 0x8C+tan = sRGB24 210 180 140  teal :: (Ord a, Floating a) => Colour a-teal = sRGB24 0x00 0x80 0x80+teal = sRGB24 0 128 128  thistle :: (Ord a, Floating a) => Colour a-thistle = sRGB24 0xD8 0xBF 0xD8+thistle = sRGB24 216 191 216  tomato :: (Ord a, Floating a) => Colour a-tomato = sRGB24 0xFF 0x63 0x47+tomato = sRGB24 255 99 71  turquoise :: (Ord a, Floating a) => Colour a-turquoise = sRGB24 0x40 0xE0 0xD0+turquoise = sRGB24 64 224 208  violet :: (Ord a, Floating a) => Colour a-violet = sRGB24 0xEE 0x82 0xEE+violet = sRGB24 238 130 238  wheat :: (Ord a, Floating a) => Colour a-wheat = sRGB24 0xF5 0xDE 0xB3+wheat = sRGB24 245 222 179  white :: (Ord a, Floating a) => Colour a-white = sRGB24 0xFF 0xFF 0xFF+white = sRGB24 255 255 255  whitesmoke :: (Ord a, Floating a) => Colour a-whitesmoke = sRGB24 0xF5 0xF5 0xF5+whitesmoke = sRGB24 245 245 245  yellow :: (Ord a, Floating a) => Colour a-yellow = sRGB24 0xFF 0xFF 0x00+yellow = sRGB24 255 255 0  yellowgreen :: (Ord a, Floating a) => Colour a-yellowgreen = sRGB24 0x9A 0xCD 0x32-+yellowgreen = sRGB24 154 205 50

@@ -0,0 +1,73 @@+{-+Copyright (c) 2008+Russell O'Connor++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.+-}+module Data.Colour.RGB where++import Data.List+import Data.Colour.Matrix+import Data.Colour.CIE.Chromaticity++-- |An RGB triple for an unspecified colour space.+data RGB a = RGB {channelRed :: !a+                 ,channelGreen :: !a+                 ,channelBlue :: !a+                 } deriving (Eq, Show, Read)++instance Functor RGB where+ fmap f (RGB r g b) = RGB (f r) (f g) (f b)++-- |Uncurries a function expecting three r, g, b parameters.+uncurryRGB :: (a -> a -> a -> b) -> RGB a -> b+uncurryRGB f (RGB r g b) = f r g b++-- |Curries a function expecting one RGB parameter.+curryRGB :: (RGB a -> b) -> a -> a -> a -> b+curryRGB f r g b = f (RGB r g b)++-- Should a always be Rational?+data RGBSpace a = RGBSpace {primaries :: !(RGB (Chromaticity a))+                           ,whitePoint   :: !(Chromaticity a)+                           } deriving (Eq, Read, Show)++{- not for export -}++primaryMatrix :: (Fractional a) => (RGB (Chromaticity a)) -> [[a]]+primaryMatrix p =+  [[xr, xg, xb]+  ,[yr, yg, yb]+  ,[zr, zg, zb]]+ where+  RGB (xr, yr, zr)+      (xg, yg, zg)+      (xb, yb, zb) = fmap chroma_coords p++rgb2xyz :: (Fractional a) => RGBSpace a -> [[a]]+rgb2xyz space =+  transpose (zipWith (map . (*)) as (transpose matrix))+ where+  (xn, yn, zn) = chroma_coords (whitePoint space)+  matrix = primaryMatrix (primaries space)+  as = mult (inverse matrix) [xn/yn, 1, zn/yn]++xyz2rgb :: (Fractional a) => RGBSpace a -> [[a]]+xyz2rgb = inverse . rgb2xyz+

@@ -0,0 +1,47 @@+{-+Copyright (c) 2008+Russell O'Connor++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.+-}+module Data.Colour.RGBSpace+ (RGB(..)+ ,uncurryRGB, curryRGB+ )+where++import Data.Colour+import Data.Colour.CIE.Chromaticity+import Data.Colour.Internal (rgb709, toRGB709, rgb709Space)+import Data.Colour.Matrix+import Data.Colour.RGB++rgbSpace :: (Fractional a) => RGBSpace a -> a -> a -> a -> Colour a+rgbSpace space r g b = rgb709 r0 g0 b0+ where+  matrix = matrixMult (xyz2rgb rgb709Space) (rgb2xyz space)+  [r0,g0,b0] = mult matrix [r,g,b]++toRGBSpace :: (Fractional a) => RGBSpace a -> Colour a -> RGB a+toRGBSpace space c = RGB r g b+ where+  RGB r0 g0 b0 = toRGB709 c+  matrix = matrixMult (xyz2rgb space) (rgb2xyz rgb709Space)+  [r,g,b] = mult matrix [r0,g0,b0]+

@@ -1,61 +0,0 @@-{--Copyright (c) 2008-Russell O'Connor--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN-THE SOFTWARE.--}--- |Defines the Y'CbCr and Y'PbPr colour spaces in accordance with--- ITU-R Recommendation BT.601 used for standard definition television--- (SDTV).------ For high definition television (HDTV) see "Data.Colour.Rec709".-module Data.Colour.Rec601- (luma- ,y'PbPr, toY'PbPr- ,y'CbCr, toY'CbCr- )-where--import Data.Word-import Data.Colour-import qualified Data.Colour.Luma as L--{- rec 601 luma -}--- |Luma (Y') approximates the 'Data.Colour.CIE.lightness' of a 'Colour'.-luma :: (Floating a, RealFrac a) => Colour a -> a-luma = L.luma lumaCoef---- |Construct a 'Colour' from Y'PbPr coordinates.-y'PbPr :: (Floating a, RealFrac a)  => a -> a -> a -> Colour a-y'PbPr = L.y'PbPr lumaCoef---- |Returns the Y'PbPr coordinates of a 'Colour'.-toY'PbPr :: (Floating a, RealFrac a)  => Colour a -> (a, a, a)-toY'PbPr = L.toY'PbPr lumaCoef---- |Construct a 'Colour' from Y'CbRr 8-bit coordinates.-y'CbCr :: (Floating a, RealFrac a)  => Word8 -> Word8 -> Word8 -> Colour a-y'CbCr = L.y'CbCr lumaCoef---- |Returns the Y'CbCr 8-bit coordinates of a 'Colour'.-toY'CbCr :: (Floating a, RealFrac a)  => Colour a -> (Word8, Word8, Word8)-toY'CbCr = L.toY'CbCr lumaCoef--{- Not for export -}-lumaCoef = (0.299, 0.587, 0.114)

@@ -1,67 +0,0 @@-{--Copyright (c) 2008-Russell O'Connor--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN-THE SOFTWARE.--}--- |Defines the Y'CbCr and Y'PbPr colour spaces in accordance with--- ITU-R Recommendation BT.601 used for high definition television--- (HDTV).------ For standard definition television (SDTV) see "Data.Colour.Rec601".------ Also allows you to create a colour from /linear/ coordinates using--- the ITU-R Recommendation BT.601 RGB primaries, which are the--- primaries used in sRGB.--- See also "Data.Colour.SRGB".-module Data.Colour.Rec709- (luma- ,y'PbPr, toY'PbPr- ,y'CbCr, toY'CbCr- ,rgb709, toRGB709- )-where--import Data.Word-import Data.Colour.Internal-import qualified Data.Colour.Luma as L--{- rec 601 luma -}--- |Luma (Y') approximates the 'Data.Colour.CIE.lightness' of a 'Colour'.-luma :: (Floating a, RealFrac a) => Colour a -> a-luma = L.luma lumaCoef---- |Construct a 'Colour' from Y'PbPr coordinates.-y'PbPr :: (Floating a, RealFrac a)  => a -> a -> a -> Colour a-y'PbPr = L.y'PbPr lumaCoef---- |Returns the Y'PbPr coordinates of a 'Colour'.-toY'PbPr :: (Floating a, RealFrac a)  => Colour a -> (a, a, a)-toY'PbPr = L.toY'PbPr lumaCoef---- |Construct a 'Colour' from Y'CbRr 8-bit coordinates.-y'CbCr :: (Floating a, RealFrac a)  => Word8 -> Word8 -> Word8 -> Colour a-y'CbCr = L.y'CbCr lumaCoef---- |Returns the Y'CbCr 8-bit coordinates of a 'Colour'.-toY'CbCr :: (Floating a, RealFrac a)  => Colour a -> (Word8, Word8, Word8)-toY'CbCr = L.toY'CbCr lumaCoef--{- Not for export -}-lumaCoef = (0.2126, 0.7152, 0.0722)

@@ -33,7 +33,9 @@  import Data.Word import Numeric-import Data.Colour.Internal+import Data.Colour+import Data.Colour.Internal (rgb709, toRGB709, quantize)+import Data.Colour.RGBSpace  {- Non-linear colour space -} {- the sRGB transfer function approximates a gamma of about 2.2 -}@@ -53,20 +55,15 @@ -- |Construct a colour from an sRGB specification. -- Input components are expected to be in the range [0..1]. sRGB :: (Ord b, Floating b) =>  b -> b -> b -> Colour b-sRGB r' g' b' = rgb709 r g b- where-  r = invTransferFunction r'-  g = invTransferFunction g'-  b = invTransferFunction b'+sRGB = curryRGB (uncurryRGB rgb709 . fmap invTransferFunction)  -- |Construct a colour from an sRGB specification. -- Input components are expected to be in the range [0..'maxBound']. sRGBBounded :: (Ord b, Floating b, Integral a, Bounded a) =>                a -> a -> a -> Colour b-sRGBBounded r' g' b' = sRGB (fromIntegral r'/m)-                            (fromIntegral g'/m)-                            (fromIntegral b'/m)+sRGBBounded r' g' b' = uncurryRGB sRGB (fmap f (RGB r' g' b'))  where+  f x' = (fromIntegral x'/m)   m = fromIntegral $ maxBound `asTypeOf` r'  -- |Construct a colour from a 24-bit (three 8-bit words) sRGB@@ -75,30 +72,24 @@ sRGB24 = sRGBBounded  -- |Return the sRGB colour components in the range [0..1].-toSRGB :: (RealFrac b, Floating b) => Colour b -> (b, b, b)-toSRGB c = (r', g', b')- where-  (r,g,b) = toRGB709 c-  r' = transferFunction r-  g' = transferFunction g-  b' = transferFunction b+toSRGB :: (Ord b, Floating b) => Colour b -> RGB b+toSRGB c = fmap transferFunction (toRGB709 c)  {- Results are clamped and quantized -} -- |Return the approximate sRGB colour components in the range -- [0..'maxBound']. -- Out of range values are clamped. toSRGBBounded :: (RealFrac b, Floating b, Integral a, Bounded a) =>-                 Colour b -> (a,a,a)-toSRGBBounded c = (r', g', b')+                 Colour b -> RGB a+toSRGBBounded c = fmap f (toSRGB c)  where-  (r'0, g'0, b'0) = toSRGB c-  (r', g', b') = (quantize (m*r'0), quantize (m*g'0), quantize (m*b'0))-  m = fromIntegral $ maxBound `asTypeOf` r'+  f x' = quantize (m*x')+  m = fromIntegral $ maxBound `asTypeOf` (f undefined)  -- |Return the approximate 24-bit sRGB colour components as three 8-bit -- components. -- Out of range values are clamped.-toSRGB24 :: (RealFrac b, Floating b) => Colour b -> (Word8, Word8, Word8)+toSRGB24 :: (RealFrac b, Floating b) => Colour b -> RGB Word8 toSRGB24 = toSRGBBounded  -- |Show a colour in hexadecimal form, e.g. \"#00aaff\"@@ -106,7 +97,7 @@ sRGB24shows c =   ("#"++) . showHex2 r' . showHex2 g' . showHex2 b'  where-  (r', g', b') = toSRGB24 c+  RGB r' g' b' = toSRGB24 c   showHex2 x | x <= 0xf = ("0"++) . showHex x              | otherwise = showHex x @@ -115,7 +106,7 @@ sRGB24show x = sRGB24shows x ""  -- |Read a colour in hexadecimal form, e.g. \"#00aaff\" or \"00aaff\"-sRGB24reads :: (RealFrac b, Floating b) => ReadS (Colour b)+sRGB24reads :: (Ord b, Floating b) => ReadS (Colour b) sRGB24reads "" = [] sRGB24reads x =   [(sRGB24 a b c, c0)@@ -130,7 +121,7 @@     (a0,a1) = splitAt 2 a  -- |Read a colour in hexadecimal form, e.g. \"#00aaff\" or \"00aaff\"-sRGB24read :: (RealFrac b, Floating b) => String -> (Colour b)+sRGB24read :: (Ord b, Floating b) => String -> (Colour b) sRGB24read x | length rx /= 1 || not (null (snd (head rx))) =   error "Data.Colour.SRGB.sRGB24read: no parse"              | otherwise = fst (head rx)

@@ -1,11 +1,12 @@ I hope for this library to become the standard colour library for Haskell. Most software does not properly blend colours because they fail to-gamma-correct the colours before blending.  Hopefully by using this library,-Haskell programs dealing with colour blending will avoid this problem.+gamma-correct the colours before blending.  By using this library, Haskell+programs dealing with colour blending will avoid this problem. -I am making an early release of my colour library to get some feedback.-I am especially interested in getting feedback on the interfaces: should-functions be renamed, should functions be moved, etc.+This 1.0.0 release only contains the sRGB colour space.  Support for other+colour spaces is in development.  I'm releasing this now because I believe+sRGB support is all that is needed for many uses of this library.  I hope+that this sRGB interface will be stable.  Bug reports and any patches are also welcome.  Be warned, I haven't extensively tested this library yet.

@@ -27,13 +27,19 @@ import Control.Monad import Test.QuickCheck import Text.Printf+import Data.Monoid +import Data.Colour.Matrix import Data.Colour+import Data.Colour.Internal hiding (RGB)+import Data.Colour.Chan (Chan(..))+import Data.Colour.CIE.Chromaticity import Data.Colour.SRGB import Data.Colour.CIE import Data.Colour.Names-import Data.Colour.Rec709 as Rec709-import qualified Data.Colour.Rec601 as Rec601+import Data.Colour.HDTV as HDTV+import Data.Colour.RGB+import Data.Colour.RGBSpace  default (Rational, Double, Float) @@ -57,7 +63,9 @@   arbitrary = liftM3 mkColour arbitrary arbitrary arbitrary    where     mkColour r' g' b' = colourConvert (sRGB24 r' g' b'::Colour Double)-  coarbitrary = coarbitrary . toRGB709+  coarbitrary c = coarbitrary (r,g,b)+   where+    (RGB r g b) = toRGB709 c  instance (Real a, Fractional a, Arbitrary a) =>          Arbitrary (AlphaColour a) where@@ -66,19 +74,94 @@     mkAlphaColour :: (Fractional a) => Colour a -> Word8 -> AlphaColour a     mkAlphaColour c a =       c `withOpacity` (fromIntegral a/fromIntegral (maxBound `asTypeOf` a))-  coarbitrary ac | a == 0 = coarbitrary a-                | otherwise = coarbitrary a . coarbitrary c+  coarbitrary ac = coarbitrary a . coarbitrary c    where     a = alphaChannel ac+    c = ac `over` mempty+    d = opaque c `asTypeOf` ac -- to help the type sytem++instance (Fractional a, Arbitrary a) =>+         Arbitrary (Chromaticity a) where+  arbitrary = liftM2 cieChroma arbitrary arbitrary+  coarbitrary c = coarbitrary x . coarbitrary y+   where+    (x,y,_) = chroma_coords c++instance (Arbitrary a) => Arbitrary (RGB a) where+  arbitrary = liftM3 RGB arbitrary arbitrary arbitrary+  coarbitrary (RGB r g b) = coarbitrary (r,g,b)++instance (Fractional a, Arbitrary a) =>+         Arbitrary (RGBSpace a) where+  arbitrary = liftM2 RGBSpace arbitrary arbitrary+  coarbitrary (RGBSpace p w) = coarbitrary p . coarbitrary w++instance (Fractional a) => Show (Colour a) where+  showsPrec d c = showParen (d > app_prec) showStr+   where+    showStr = showString "rgb709 " . (showsPrec (app_prec+1) r)+            . showString " "       . (showsPrec (app_prec+1) g)+            . showString " "       . (showsPrec (app_prec+1) b)+    Data.Colour.RGB.RGB r g b = toRGB709 c++instance (Fractional a, Read a) => Read (Colour a) where+  readsPrec d r = readParen (d > app_prec)+                  (\r -> [(rgb709 r0 g0 b0,t)+                         |("rgb709",s) <- lex r+                         ,(r0,s0) <- readsPrec (app_prec+1) s+                         ,(g0,s1) <- readsPrec (app_prec+1) s0+                         ,(b0,t)  <- readsPrec (app_prec+1) s1]) r++instance (Fractional a) => Show (AlphaColour a) where+  showsPrec d ac = showParen (d > infix_prec) showStr+   where+    showStr | a == 0 = showString "transparent"+            | otherwise = showsPrec (infix_prec+1) c+                        . showString " `withOpacity` "+                        . showsPrec (infix_prec+1) a+    a = alphaChannel ac     c = colourChannel ac -prop_toFromRGB709 :: RColour -> Bool-prop_toFromRGB709 c = (rgb709 r g b) == c+instance (Fractional a, Read a) => Read (AlphaColour a) where+  readsPrec d r = [(transparent,s)|("transparent",s) <- lex r]+               ++ readParen (d > infix_prec)+                  (\r -> [(c `withOpacity` o,s)+                         |(c,r0) <- readsPrec (infix_prec+1) r+                         ,("`",r1) <- lex r0+                         ,("withOpacity",r2) <- lex r1+                         ,("`",r3) <- lex r2+                         ,(o,s)  <- readsPrec (infix_prec+1) r3]) r++-- |Returns the colour of an 'AlphaColour'.+-- @colourChannel transparent@ is undefined and may result in @nan@ or an+-- error.+-- Its use is discouraged.+-- If you are desparate, use+--+-- >darken (recip (alphaChannel c)) (c `over` black)+colourChannel :: (Fractional a) => AlphaColour a -> Colour a+colourChannel (RGBA c (Chan a)) = darken (recip a) c+++good (RGBSpace p w) = p1 && p2  where-  (r,g,b) = toRGB709 c+  p1 = 0 /= determinant (primaryMatrix p)+  p2 = 0 /= let (x,y,z) = chroma_coords w in y +prop_matrixMult (a1,b1,c1) (d1,e1,f1) (g1,h1,i1)+                (a2,b2,c2) (d2,e2,f2) (g2,h2,i2)+                (x,y,z) = mult m1 (mult m2 v) == mult (matrixMult m1 m2) v+ where +  m1 = [[a1,b1,c1],[d1,e1,f1],[g1,h1,i1]]+  m2 = [[a2,b2,c2],[d2,e2,f2],[g2,h2,i2]]+  v :: [Rational]+  v = [x,y,z]++prop_toFromRGB709 :: RColour -> Bool+prop_toFromRGB709 c = uncurryRGB rgb709 (toRGB709 c) == c+ prop_fromToRGB709 :: Rational -> Rational -> Rational -> Bool-prop_fromToRGB709 r g b = toRGB709 (rgb709 r g b) == (r,g,b)+prop_fromToRGB709 r g b = toRGB709 (rgb709 r g b) == RGB r g b  prop_toFromXYZ :: RColour -> Bool prop_toFromXYZ c = (cieXYZ x y z) == c@@ -90,21 +173,27 @@  -- Uses the fact that an Arbitrary colour is an sRGB24 colour. prop_toFromSRGB :: DColour -> Bool-prop_toFromSRGB c = (sRGB24 r' g' b') == c- where-  (r',g',b') = toSRGB24 c+prop_toFromSRGB c = uncurryRGB sRGB24 (toSRGB24 c) == c  prop_fromToSRGB :: Word8 -> Word8 -> Word8 -> Bool-prop_fromToSRGB r' g' b' = toSRGB24 (sRGB24 r' g' b') == (r',g',b')+prop_fromToSRGB r' g' b' = toSRGB24 (sRGB24 r' g' b') == RGB r' g' b'  prop_fromToY'CbCr709 :: Word8 -> Word8 -> Word8 -> Bool prop_fromToY'CbCr709 y' cb cr =-  Rec709.toY'CbCr (Rec709.y'CbCr y' cb cr) == (y',cb,cr)+  HDTV.toY'CbCr (HDTV.y'CbCr y' cb cr) == (y',cb,cr) +{- prop_fromToY'CbCr601 :: Word8 -> Word8 -> Word8 -> Bool prop_fromToY'CbCr601 y' cb cr =-  Rec601.toY'CbCr (Rec601.y'CbCr y' cb cr) == (y',cb,cr)+  SDTV.toY'CbCr (SDTV.y'CbCr y' cb cr) == (y',cb,cr)+-} +prop_disolveId :: RAlphaColour -> Bool+prop_disolveId c = disolve 1 c == c++prop_disolveTransparent :: RAlphaColour -> Bool+prop_disolveTransparent c = disolve 0 c == transparent+ prop_transparentOver :: RColour -> Bool prop_transparentOver c = transparent `over` c == c @@ -112,8 +201,51 @@ prop_overTransparent c = c `over` transparent == c  prop_opaqueOver :: RColour -> RColour -> Bool-prop_opaqueOver c1 c2 = alphaColour c1 `over` c2 == c1+prop_opaqueOver c1 c2 = opaque c1 `over` c2 == c1 +prop_overOpaque :: RAlphaColour -> RColour -> Bool+prop_overOpaque c1 c2 = c1 `over` opaque c2 == opaque (c1 `over` c2)++prop_blendOver :: Rational -> RColour -> RColour -> Bool+prop_blendOver o c1 c2 = +  (c1 `withOpacity` o) `over` c2 == blend o c1 c2++prop_blendTransparent :: Rational -> Rational -> RColour -> Bool+prop_blendTransparent o a c = +  blend o (c `withOpacity` a) transparent == c `withOpacity ` (o*a)++prop_blendFlip :: Rational -> RColour -> RColour -> Bool+prop_blendFlip o c1 c2 = +  blend (1-o) c2 c1 == blend o c1 c2++prop_darkenBlend :: Rational -> RColour -> Bool+prop_darkenBlend w c = +  blend w c mempty == darken w c++prop_darkenBlack :: RAlphaColour -> Bool+prop_darkenBlack c = darken 0 c == mempty `withOpacity` (alphaChannel c)++prop_darkenId :: RAlphaColour -> Bool+prop_darkenId c = darken 1 c == c++prop_atopOpaque :: RAlphaColour -> RColour -> Bool+prop_atopOpaque c0 c1 = c0 `atop` (opaque c1) == opaque (c0 `over` c1)++prop_transparentAtop :: RAlphaColour -> Bool+prop_transparentAtop c = transparent `atop` c == c++prop_atopTransparent :: RAlphaColour -> Bool+prop_atopTransparent c = c `atop` transparent == transparent++prop_atopAlpha :: RAlphaColour -> RAlphaColour -> Bool+prop_atopAlpha c0 c1 = alphaChannel (c0 `atop` c1) == alphaChannel c1++prop_showReadC :: RColour -> Bool+prop_showReadC c = read (show c) == c++prop_showReadAC :: RAlphaColour -> Bool+prop_showReadAC c = read (show c) == c+ prop_sRGB24showlength :: DColour -> Bool prop_sRGB24showlength c = length (sRGB24show c) == 7 @@ -121,24 +253,51 @@ prop_readshowSRGB24 c =   sRGB24show (sRGB24read (sRGB24show c)) == sRGB24show c -prop_luminance_white :: Bool-prop_luminance_white = luminance white == 1+{-+prop_luminance_white :: RGBSpace Rational -> Property+prop_luminance_white space =+  good space ==> luminance (rgbSpace space 1 1 1) == 1 -tests = [("RGB709-to-from", test prop_toFromRGB709)+prop_rgb709 :: Rational -> Rational -> Rational -> Bool+prop_rgb709 r g b =+  rgbSpace rgb709Space r g b == rgb709 r g b++prop_toRGB709 :: RColour -> Bool+prop_toRGB709 c =+  toRGBSpace rgb709Space c == toRGB709 c+-}+tests = [("matrix-mult", test prop_matrixMult)+        ,("RGB709-to-from", test prop_toFromRGB709)         ,("RGB709-from-to", test prop_fromToRGB709)         ,("XYZ-to-from", test prop_toFromXYZ)         ,("XYZ-from-to", test prop_fromToXYZ)         ,("sRGB-to-from", test prop_toFromSRGB)         ,("sRGB-from-to", test prop_fromToSRGB)         ,("Y'CbCr-709-from-to", test prop_fromToY'CbCr709)-        ,("Y'CbCr-601-from-to", test prop_fromToY'CbCr709)+--        ,("Y'CbCr-601-from-to", test prop_fromToY'CbCr601)+        ,("disolve-id", test prop_disolveId)+        ,("disolve-transparent", test prop_disolveTransparent)         ,("transparent-over", test prop_transparentOver)         ,("over-transparent", test prop_overTransparent)         ,("opaque-over", test prop_opaqueOver)+        ,("over-opaque", test prop_overOpaque)+        ,("blend-over", test prop_blendOver)+        ,("blend-transparent", test prop_blendTransparent)+        ,("blend-flip", test prop_blendFlip)+        ,("darken-blend", test prop_darkenBlend)+        ,("darken-black", test prop_darkenBlack)+        ,("darken-id", test prop_darkenId)+        ,("atop-opaque", test prop_atopOpaque)+        ,("trasnparent-atop", test prop_transparentAtop)+        ,("atop-transparent", test prop_atopTransparent)+        ,("atop-alpha", test prop_atopAlpha)+        ,("colour-show-read", test prop_showReadC)+        ,("alphaColour-show-read", test prop_showReadAC)         ,("sRGB24-show-length", test prop_sRGB24showlength)         ,("sRGB24-read-show", test prop_readshowSRGB24)-        ,("luminance-white", check defaultConfig{configMaxTest = 1}-                             prop_luminance_white)+--        ,("luminance-white", test prop_luminance_white)+--        ,("rgb709", test prop_rgb709)+--        ,("toRGB709", test prop_toRGB709)         ]  main  = mapM_ (\(s,a) -> printf "%-25s: " s >> a) tests

@@ -1,16 +1,16 @@ Name:                colour-Version:             0.0.0+Version:             1.0.0 Cabal-Version:       >= 1.2 License:             OtherLicense License-file:        LICENSE Author:              Russell O'Connor-Maintainer:          roconnor@theorem.ca+Maintainer:          Russell O'Connor <roconnor@theorem.ca> Build-Type:          Simple-Category:            data-Synopsis:            A colour model for human vision-Description:         This package provides a data type for colours.+Category:            data, graphics+Synopsis:            A model for human colour/color perception+Description:         This package provides a data type for colours and transparency.                      Colours can be blended and composed.-                     Various colour spaces are supported.+                     sRGB colour space is supported ("Data.Colour.SRGB").                      A module of colour names ("Data.Colour.Names") is provided. Tested-with:         GHC == 6.8.2 extra-source-files:  Tests.hs README@@ -19,11 +19,11 @@   Build-Depends:     base   Exposed-Modules:   Data.Colour                      Data.Colour.SRGB-                     Data.Colour.CIE+                     Data.Colour.RGBSpace                      Data.Colour.Names-                     Data.Colour.Rec601-                     Data.Colour.Rec709   Other-Modules:     Data.Colour.Internal                      Data.Colour.Chan-                     Data.Colour.Luma+                     Data.Colour.RGB                      Data.Colour.Matrix+                     Data.Colour.CIE.Chromaticity+                     Data.Colour.CIE.Illuminant