packages feed

colour (empty) → 0.0.0

raw patch · 15 files changed

+1444/−0 lines, 15 filesdep +basesetup-changed

Dependencies added: base

Files

+ Data/Colour.hs view
@@ -0,0 +1,54 @@+{-+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.+-}+-- |Datatypes for representing the human perception of colour.+-- Includes common operations for blending and compositing colours.+-- 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+ ,colourConvert++ ,AlphaColour+ ,alphaColour, fade, withOpacity+ ,transparent+ ,alphaColourConvert+ ,alphaChannel, colourChannel++ ,AffineSpace(..), blend++ ,Composite(..), compositeWith+ )+where++import Data.Colour.Internal
+ Data/Colour/CIE.hs view
@@ -0,0 +1,95 @@+{-+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
+ Data/Colour/Chan.hs view
@@ -0,0 +1,46 @@+{-+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.Chan where+{- For internal use only:+   Not to be exported from the package -}+newtype Chan p a = Chan a deriving (Eq)++empty :: (Num a) => Chan p a+empty = Chan 0++full :: (Num a) => Chan p a+full = Chan 1++scale :: (Num a) => a -> Chan p a -> Chan p a+scale s (Chan x) =  Chan (s*x)++add :: (Num a) => Chan p a -> Chan p a -> Chan p a+(Chan a) `add` (Chan b) = Chan (a+b)++invert :: (Num a) => Chan p a -> Chan p a+invert (Chan a) = Chan (1-a)++over c0 a c1 = c0 `add` scale (1-a) c1++convert :: (Fractional b, Real a) => Chan p a -> Chan p b+convert (Chan x) = Chan (realToFrac x)
+ Data/Colour/Internal.hs view
@@ -0,0 +1,200 @@+{-+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.Internal where++import Data.List+import qualified Data.Colour.Chan as Chan+import Data.Colour.Chan (Chan(Chan))++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.++-- 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)++-- |Constructs a 'Colour' from RGB values using the /linear/ RGB colour+-- space specified in Rec.709.+rgb709 :: 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)++-- |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) . (")"++)+   where+    (r,g,b) = toRGB709 c++data Alpha = Alpha++-- |This type represents a 'Colour' that may be semi-transparent.++-- 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'.+transparent :: (Num a) => AlphaColour a+transparent = RGBA (RGB Chan.empty Chan.empty Chan.empty) Chan.empty++-- |Change the type used to represent the colour coordinates.+alphaColourConvert :: (Fractional b, Real a) =>+  AlphaColour a -> AlphaColour b+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++-- |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)++-- |Creates an 'AlphaColour' from a 'Colour' with a given opacity.+--+-- >c `withOpacity` o == fade o (alphaColour c) +withOpacity :: (Num a) => Colour a -> a -> AlphaColour a+c `withOpacity` o = RGBA (scale o c) (Chan o)++--------------------------------------------------------------------------+-- Blending+--------------------------------------------------------------------------++class AffineSpace f where+ -- |Compute a affine Combination (weighted-average) of points.+ -- The last parameter will get the remaining weight.+ -- e.g.+ --+ -- >affineCombo [(0.2,a), (0.3,b)] c == 0.2*a + 0.3*b + 0.4*c+ 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+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]+  where+   total = sum $ map fst l++instance AffineSpace AlphaColour where+ affineCombo l z =+   foldl1' rgbaAdd [fade w a | (w,a) <- (1-total,z):l]+  where+   total = sum $ map fst l++--------------------------------------------------------------------------+-- composite+--------------------------------------------------------------------------++class Composite 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++instance Composite 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)++instance Composite AlphaColour where+ c0@(RGBA _ a0@(Chan a0')) `over` (RGBA c1 a1) =+   RGBA (c0 `over` c1) (Chan.over a0 a0' a1)++-- |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++-- |'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+           | fromIntegral h <= x = h+           | otherwise           = round x+ where+  l = minBound+  h = maxBound++{- 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++--------------------------------------------------------------------------+-- 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)
+ Data/Colour/Luma.hs view
@@ -0,0 +1,69 @@+{-+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
+ Data/Colour/Matrix.hs view
@@ -0,0 +1,34 @@+{-+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.Matrix where++default (Rational)++inverse [[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)++mult l x = map (sum . (zipWith (*) x)) l
+ Data/Colour/Names.hs view
@@ -0,0 +1,469 @@+{-+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.+-}++-- |Names for colours.+-- Names taken from SVG 1.0 specification.+module Data.Colour.Names where++import Prelude hiding (tan)+import Data.Colour.SRGB+import Data.Colour++aliceblue :: (Ord a, Floating a) => Colour a+aliceblue = sRGB24 0xF0 0xF8 0xFF++antiquewhite :: (Ord a, Floating a) => Colour a+antiquewhite = sRGB24 0xFA 0xEB 0xD7++aqua :: (Ord a, Floating a) => Colour a+aqua = sRGB24 0x00 0xFF 0xFF++aquamarine :: (Ord a, Floating a) => Colour a+aquamarine = sRGB24 0x7F 0xFF 0xD4++azure :: (Ord a, Floating a) => Colour a+azure = sRGB24 0xF0 0xFF 0xFF++beige :: (Ord a, Floating a) => Colour a+beige = sRGB24 0xF5 0xF5 0xDC++bisque :: (Ord a, Floating a) => Colour a+bisque = sRGB24 0xFF 0xE4 0xC4++black :: (Ord a, Floating a) => Colour a+black = sRGB24 0x00 0x00 0x00++blanchedalmond :: (Ord a, Floating a) => Colour a+blanchedalmond = sRGB24 0xFF 0xEB 0xCD++blue :: (Ord a, Floating a) => Colour a+blue = sRGB24 0x00 0x00 0xFF++blueviolet :: (Ord a, Floating a) => Colour a+blueviolet = sRGB24 0x8A 0x2B 0xE2++brown :: (Ord a, Floating a) => Colour a+brown = sRGB24 0xA5 0x2A 0x2A++burlywood :: (Ord a, Floating a) => Colour a+burlywood = sRGB24 0xDE 0xB8 0x87++cadetblue :: (Ord a, Floating a) => Colour a+cadetblue = sRGB24 0x5F 0x9E 0xA0++chartreuse :: (Ord a, Floating a) => Colour a+chartreuse = sRGB24 0x7F 0xFF 0x00++chocolate :: (Ord a, Floating a) => Colour a+chocolate = sRGB24 0xD2 0x69 0x1E++coral :: (Ord a, Floating a) => Colour a+coral = sRGB24 0xFF 0x7F 0x50++cornflowerblue :: (Ord a, Floating a) => Colour a+cornflowerblue = sRGB24 0x64 0x95 0xED++cornsilk :: (Ord a, Floating a) => Colour a+cornsilk = sRGB24 0xFF 0xF8 0xDC++crimson :: (Ord a, Floating a) => Colour a+crimson = sRGB24 0xDC 0x14 0x3C++cyan :: (Ord a, Floating a) => Colour a+cyan = sRGB24 0x00 0xFF 0xFF++darkblue :: (Ord a, Floating a) => Colour a+darkblue = sRGB24 0x00 0x00 0x8B++darkcyan :: (Ord a, Floating a) => Colour a+darkcyan = sRGB24 0x00 0x8B 0x8B++darkgoldenrod :: (Ord a, Floating a) => Colour a+darkgoldenrod = sRGB24 0xB8 0x86 0x0B++darkgrey :: (Ord a, Floating a) => Colour a+darkgrey = sRGB24 0xA9 0xA9 0xA9++darkgray :: (Ord a, Floating a) => Colour a+darkgray = darkgrey++darkgreen :: (Ord a, Floating a) => Colour a+darkgreen = sRGB24 0x00 0x64 0x00++darkkhaki :: (Ord a, Floating a) => Colour a+darkkhaki = sRGB24 0xBD 0xB7 0x6B++darkmagenta :: (Ord a, Floating a) => Colour a+darkmagenta = sRGB24 0x8B 0x00 0x8B++darkolivegreen :: (Ord a, Floating a) => Colour a+darkolivegreen = sRGB24 0x55 0x6B 0x2F++darkorange :: (Ord a, Floating a) => Colour a+darkorange = sRGB24 0xFF 0x8C 0x00++darkorchid :: (Ord a, Floating a) => Colour a+darkorchid = sRGB24 0x99 0x32 0xCC++darkred :: (Ord a, Floating a) => Colour a+darkred = sRGB24 0x8B 0x00 0x00++darksalmon :: (Ord a, Floating a) => Colour a+darksalmon = sRGB24 0xE9 0x96 0x7A++darkseagreen :: (Ord a, Floating a) => Colour a+darkseagreen = sRGB24 0x8F 0xBC 0x8F++darkslateblue :: (Ord a, Floating a) => Colour a+darkslateblue = sRGB24 0x48 0x3D 0x8B++darkturqoise :: (Ord a, Floating a) => Colour a+darkturqoise = sRGB24 0x00 0xCE 0xD1++darkslategrey :: (Ord a, Floating a) => Colour a+darkslategrey = sRGB24 0x2F 0x4F 0x4F++darkslategray :: (Ord a, Floating a) => Colour a+darkslategray = darkslategrey++darkviolet :: (Ord a, Floating a) => Colour a+darkviolet = sRGB24 0x94 0x00 0xD3++deeppink :: (Ord a, Floating a) => Colour a+deeppink = sRGB24 0xFF 0x14 0x93++deepskyblue :: (Ord a, Floating a) => Colour a+deepskyblue = sRGB24 0x00 0xBF 0xFF++dimgrey :: (Ord a, Floating a) => Colour a+dimgrey = sRGB24 0x69 0x69 0x69++dimgray :: (Ord a, Floating a) => Colour a+dimgray = dimgrey++dodgerblue :: (Ord a, Floating a) => Colour a+dodgerblue = sRGB24 0x1E 0x90 0xFF++firebrick :: (Ord a, Floating a) => Colour a+firebrick = sRGB24 0xB2 0x22 0x22++floralwhite :: (Ord a, Floating a) => Colour a+floralwhite = sRGB24 0xFF 0xFA 0xF0++forestgreen :: (Ord a, Floating a) => Colour a+forestgreen = sRGB24 0x22 0x8B 0x22++fuchsia :: (Ord a, Floating a) => Colour a+fuchsia = sRGB24 0xFF 0x00 0xFF++gainsboro :: (Ord a, Floating a) => Colour a+gainsboro = sRGB24 0xDC 0xDC 0xDC++ghostwhite :: (Ord a, Floating a) => Colour a+ghostwhite = sRGB24 0xF8 0xF8 0xFF++gold :: (Ord a, Floating a) => Colour a+gold = sRGB24 0xFF 0xD7 0x00++goldenrod :: (Ord a, Floating a) => Colour a+goldenrod = sRGB24 0xDA 0xA5 0x20++grey :: (Ord a, Floating a) => Colour a+grey = sRGB24 0x80 0x80 0x80++gray :: (Ord a, Floating a) => Colour a+gray = grey++green :: (Ord a, Floating a) => Colour a+green = sRGB24 0x00 0x80 0x00++greenyellow :: (Ord a, Floating a) => Colour a+greenyellow = sRGB24 0xAD 0xFF 0x2F++honeydew :: (Ord a, Floating a) => Colour a+honeydew = sRGB24 0xF0 0xFF 0xF0++hotpink :: (Ord a, Floating a) => Colour a+hotpink = sRGB24 0xFF 0x69 0xB4++indianred :: (Ord a, Floating a) => Colour a+indianred = sRGB24 0xCD 0x5C 0x5C++indigo :: (Ord a, Floating a) => Colour a+indigo = sRGB24 0x4B 0x00 0x82++ivory :: (Ord a, Floating a) => Colour a+ivory = sRGB24 0xFF 0xFF 0xF0++khaki :: (Ord a, Floating a) => Colour a+khaki = sRGB24 0xF0 0xE6 0x8C++lavender :: (Ord a, Floating a) => Colour a+lavender = sRGB24 0xE6 0xE6 0xFA++lavenderblush :: (Ord a, Floating a) => Colour a+lavenderblush = sRGB24 0xFF 0xF0 0xF5++lawngreen :: (Ord a, Floating a) => Colour a+lawngreen = sRGB24 0x7C 0xFC 0x00++lemonchiffon :: (Ord a, Floating a) => Colour a+lemonchiffon = sRGB24 0xFF 0xFA 0xCD++lightblue :: (Ord a, Floating a) => Colour a+lightblue = sRGB24 0xAD 0xD8 0xE6++lightcoral :: (Ord a, Floating a) => Colour a+lightcoral = sRGB24 0xF0 0x80 0x80++lightcyan :: (Ord a, Floating a) => Colour a+lightcyan = sRGB24 0xE0 0xFF 0xFF++lightgoldenrodyellow :: (Ord a, Floating a) => Colour a+lightgoldenrodyellow = sRGB24 0xFA 0xFA 0xD2++lightgreen :: (Ord a, Floating a) => Colour a+lightgreen = sRGB24 0x90 0xEE 0x90++lightgrey :: (Ord a, Floating a) => Colour a+lightgrey = sRGB24 0xD3 0xD3 0xD3++lightgray :: (Ord a, Floating a) => Colour a+lightgray = lightgrey++lightpink :: (Ord a, Floating a) => Colour a+lightpink = sRGB24 0xFF 0xB6 0xC1++lightsalmon :: (Ord a, Floating a) => Colour a+lightsalmon = sRGB24 0xFF 0xA0 0x7A++lightseagreen :: (Ord a, Floating a) => Colour a+lightseagreen = sRGB24 0x20 0xB2 0xAA++lightskyblue :: (Ord a, Floating a) => Colour a+lightskyblue = sRGB24 0x87 0xCE 0xFA++lightslategrey :: (Ord a, Floating a) => Colour a+lightslategrey = sRGB24 0x77 0x88 0x99++lightslategray :: (Ord a, Floating a) => Colour a+lightslategray = lightslategrey++lisghtsteelblue :: (Ord a, Floating a) => Colour a+lisghtsteelblue = sRGB24 0xB0 0xC4 0xDE++lightyellow :: (Ord a, Floating a) => Colour a+lightyellow = sRGB24 0xFF 0xFF 0xE0++lime :: (Ord a, Floating a) => Colour a+lime = sRGB24 0x00 0xFF 0x00++limegreen :: (Ord a, Floating a) => Colour a+limegreen = sRGB24 0x32 0xCD 0x32++linen :: (Ord a, Floating a) => Colour a+linen = sRGB24 0xFA 0xF0 0xE6++magenta :: (Ord a, Floating a) => Colour a+magenta = sRGB24 0xFF 0x00 0xFF++maroon :: (Ord a, Floating a) => Colour a+maroon = sRGB24 0x80 0x00 0x00++mediumaquamarine :: (Ord a, Floating a) => Colour a+mediumaquamarine = sRGB24 0x66 0xCD 0xAA++mediumblue :: (Ord a, Floating a) => Colour a+mediumblue = sRGB24 0x00 0x00 0xCD++mediumorchid :: (Ord a, Floating a) => Colour a+mediumorchid = sRGB24 0xBA 0x55 0xD3++mediumpurple :: (Ord a, Floating a) => Colour a+mediumpurple = sRGB24 0x93 0x70 0xDB++mediumseagreen :: (Ord a, Floating a) => Colour a+mediumseagreen = sRGB24 0x3C 0xB3 0x71++mediumslateblue :: (Ord a, Floating a) => Colour a+mediumslateblue = sRGB24 0x7B 0x68 0xEE++mediumspringgreen :: (Ord a, Floating a) => Colour a+mediumspringgreen = sRGB24 0x00 0xFA 0x9A++mediumturquoise :: (Ord a, Floating a) => Colour a+mediumturquoise = sRGB24 0x48 0xD1 0xCC++mediumvioletred :: (Ord a, Floating a) => Colour a+mediumvioletred = sRGB24 0xC7 0x15 0x85++midnightblue :: (Ord a, Floating a) => Colour a+midnightblue = sRGB24 0x19 0x19 0x70++mintcream :: (Ord a, Floating a) => Colour a+mintcream = sRGB24 0xF5 0xFF 0xFA++mistyrose :: (Ord a, Floating a) => Colour a+mistyrose = sRGB24 0xFF 0xE4 0xE1++moccasin :: (Ord a, Floating a) => Colour a+moccasin = sRGB24 0xFF 0xE4 0xB5++navajowhite :: (Ord a, Floating a) => Colour a+navajowhite = sRGB24 0xFF 0xDE 0xAD++navy :: (Ord a, Floating a) => Colour a+navy = sRGB24 0x00 0x00 0x80++navyblue :: (Ord a, Floating a) => Colour a+navyblue = sRGB24 0x9F 0xAF 0xDF++oldlace :: (Ord a, Floating a) => Colour a+oldlace = sRGB24 0xFD 0xF5 0xE6++olive :: (Ord a, Floating a) => Colour a+olive = sRGB24 0x80 0x80 0x00++olivedrab :: (Ord a, Floating a) => Colour a+olivedrab = sRGB24 0x6B 0x8E 0x23++orange :: (Ord a, Floating a) => Colour a+orange = sRGB24 0xFF 0xA5 0x00++orangered :: (Ord a, Floating a) => Colour a+orangered = sRGB24 0xFF 0x45 0x00++orchid :: (Ord a, Floating a) => Colour a+orchid = sRGB24 0xDA 0x70 0xD6++palegoldenrod :: (Ord a, Floating a) => Colour a+palegoldenrod = sRGB24 0xEE 0xE8 0xAA++palegreen :: (Ord a, Floating a) => Colour a+palegreen = sRGB24 0x98 0xFB 0x98++paleturquoise :: (Ord a, Floating a) => Colour a+paleturquoise = sRGB24 0xAF 0xEE 0xEE++palevioletred :: (Ord a, Floating a) => Colour a+palevioletred = sRGB24 0xDB 0x70 0x93++papayawhip :: (Ord a, Floating a) => Colour a+papayawhip = sRGB24 0xFF 0xEF 0xD5++peachpuff :: (Ord a, Floating a) => Colour a+peachpuff = sRGB24 0xFF 0xDA 0xB9++peru :: (Ord a, Floating a) => Colour a+peru = sRGB24 0xCD 0x85 0x3F++pink :: (Ord a, Floating a) => Colour a+pink = sRGB24 0xFF 0xC0 0xCB++plum :: (Ord a, Floating a) => Colour a+plum = sRGB24 0xDD 0xA0 0xDD++powderblue :: (Ord a, Floating a) => Colour a+powderblue = sRGB24 0xB0 0xE0 0xE6++purple :: (Ord a, Floating a) => Colour a+purple = sRGB24 0x80 0x00 0x80++red :: (Ord a, Floating a) => Colour a+red = sRGB24 0xFF 0x00 0x00++rosybrown :: (Ord a, Floating a) => Colour a+rosybrown = sRGB24 0xBC 0x8F 0x8F++royalblue :: (Ord a, Floating a) => Colour a+royalblue = sRGB24 0x41 0x69 0xE1++saddlebrown :: (Ord a, Floating a) => Colour a+saddlebrown = sRGB24 0x8B 0x45 0x13++salmon :: (Ord a, Floating a) => Colour a+salmon = sRGB24 0xFA 0x80 0x72++sandybrown :: (Ord a, Floating a) => Colour a+sandybrown = sRGB24 0xF4 0xA4 0x60++seagreen :: (Ord a, Floating a) => Colour a+seagreen = sRGB24 0x2E 0x8B 0x57++seashell :: (Ord a, Floating a) => Colour a+seashell = sRGB24 0xFF 0xF5 0xEE++sienna :: (Ord a, Floating a) => Colour a+sienna = sRGB24 0xA0 0x52 0x2D++silver :: (Ord a, Floating a) => Colour a+silver = sRGB24 0xC0 0xC0 0xC0++skyblue :: (Ord a, Floating a) => Colour a+skyblue = sRGB24 0x87 0xCE 0xEB++slateblue :: (Ord a, Floating a) => Colour a+slateblue = sRGB24 0x6A 0x5A 0xCD++snow :: (Ord a, Floating a) => Colour a+snow = sRGB24 0xFF 0xFA 0xFA++springgreen :: (Ord a, Floating a) => Colour a+springgreen = sRGB24 0x00 0xFF 0x7F++steelblue :: (Ord a, Floating a) => Colour a+steelblue = sRGB24 0x46 0x82 0xB4++tan :: (Ord a, Floating a) => Colour a+tan = sRGB24 0xD2 0xB4 0x8C++teal :: (Ord a, Floating a) => Colour a+teal = sRGB24 0x00 0x80 0x80++thistle :: (Ord a, Floating a) => Colour a+thistle = sRGB24 0xD8 0xBF 0xD8++tomato :: (Ord a, Floating a) => Colour a+tomato = sRGB24 0xFF 0x63 0x47++turquoise :: (Ord a, Floating a) => Colour a+turquoise = sRGB24 0x40 0xE0 0xD0++violet :: (Ord a, Floating a) => Colour a+violet = sRGB24 0xEE 0x82 0xEE++wheat :: (Ord a, Floating a) => Colour a+wheat = sRGB24 0xF5 0xDE 0xB3++white :: (Ord a, Floating a) => Colour a+white = sRGB24 0xFF 0xFF 0xFF++whitesmoke :: (Ord a, Floating a) => Colour a+whitesmoke = sRGB24 0xF5 0xF5 0xF5++yellow :: (Ord a, Floating a) => Colour a+yellow = sRGB24 0xFF 0xFF 0x00++yellowgreen :: (Ord a, Floating a) => Colour a+yellowgreen = sRGB24 0x9A 0xCD 0x32+
+ Data/Colour/Rec601.hs view
@@ -0,0 +1,61 @@+{-+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)
+ Data/Colour/Rec709.hs view
@@ -0,0 +1,67 @@+{-+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)
+ Data/Colour/SRGB.hs view
@@ -0,0 +1,138 @@+{-+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.+-}+-- |Specifies 'Colour's in accordance with the sRGB standard.+module Data.Colour.SRGB+ (sRGB24, sRGBBounded, sRGB+ ,toSRGB24, toSRGBBounded, toSRGB++ ,sRGB24shows, sRGB24show+ ,sRGB24reads, sRGB24read+  --,transferFunction, invTransferFunction -- should these be exported?+ )+where++import Data.Word+import Numeric+import Data.Colour.Internal++{- Non-linear colour space -}+{- the sRGB transfer function approximates a gamma of about 2.2 -}+transferFunction lin | lin == 1         = 1+                     | lin <= 0.0031308 = 12.92*lin+                     | otherwise        = (1 + a)*lin**(1/2.4) - a+ where+  a = 0.055++invTransferFunction nonLin | nonLin == 1       = 1+                           | nonLin <= 0.04045 = nonLin/12.92+                           | otherwise         =+  ((nonLin + a)/(1 + a))**2.4+ where+  a = 0.055++-- |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'++-- |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)+ where+  m = fromIntegral $ maxBound `asTypeOf` r'++-- |Construct a colour from a 24-bit (three 8-bit words) sRGB+-- specification.+sRGB24 :: (Ord b, Floating b) => Word8 -> Word8 -> Word8 -> Colour b+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++{- 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')+ 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'++-- |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 = toSRGBBounded++-- |Show a colour in hexadecimal form, e.g. \"#00aaff\"+sRGB24shows :: (RealFrac b, Floating b) => Colour b -> ShowS+sRGB24shows c =+  ("#"++) . showHex2 r' . showHex2 g' . showHex2 b'+ where+  (r', g', b') = toSRGB24 c+  showHex2 x | x <= 0xf = ("0"++) . showHex x+             | otherwise = showHex x++-- |Show a colour in hexadecimal form, e.g. \"#00aaff\"+sRGB24show :: (RealFrac b, Floating b) => Colour b -> String+sRGB24show x = sRGB24shows x ""++-- |Read a colour in hexadecimal form, e.g. \"#00aaff\" or \"00aaff\"+sRGB24reads :: (RealFrac b, Floating b) => ReadS (Colour b)+sRGB24reads "" = []+sRGB24reads x =+  [(sRGB24 a b c, c0)+  |(a,a0) <- readPair x', (b,b0) <- readPair a0, (c,c0) <- readPair b0]+ where+  x' | head x == '#' = tail x+     | otherwise = x+  readPair [] = []+  readPair [_] = []+  readPair a = [(x,a1)|(x,"") <- readHex a0]+   where+    (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 x | length rx /= 1 || not (null (snd (head rx))) =+  error "Data.Colour.SRGB.sRGB24read: no parse"+             | otherwise = fst (head rx)+ where+  rx = sRGB24reads x
+ LICENSE view
@@ -0,0 +1,20 @@+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.
+ README view
@@ -0,0 +1,14 @@+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.++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.++Bug reports and any patches are also welcome.  Be warned, I haven't+extensively tested this library yet.++-- +Russell O'Connor <roconnor@cs.ru.nl>
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell+ +> import Distribution.Simple+> main = defaultMain
+ Tests.hs view
@@ -0,0 +1,144 @@+{-# OPTIONS_GHC -XTypeSynonymInstances #-}+{-+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 Main where++import Data.Word+import Control.Monad+import Test.QuickCheck+import Text.Printf++import Data.Colour+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++default (Rational, Double, Float)++type RColour = Colour Rational+type DColour = Colour Double+type FColour = Colour Float+type RAlphaColour = AlphaColour Rational+type DAlphaColour = AlphaColour Double++instance Arbitrary Word8 where+  arbitrary = liftM fromIntegral $+              choose (fromIntegral (minBound::Word8)::Int,+                      fromIntegral (maxBound::Word8)::Int)+  coarbitrary x = variant (fromIntegral x)++instance Arbitrary (Rational) where+  arbitrary = liftM (toRational :: Double -> Rational) $ arbitrary+  coarbitrary x = coarbitrary (fromRational x :: Double)++instance (Real a, Fractional a, Arbitrary a) => Arbitrary (Colour a) where+  arbitrary = liftM3 mkColour arbitrary arbitrary arbitrary+   where+    mkColour r' g' b' = colourConvert (sRGB24 r' g' b'::Colour Double)+  coarbitrary = coarbitrary . toRGB709++instance (Real a, Fractional a, Arbitrary a) =>+         Arbitrary (AlphaColour a) where+  arbitrary = liftM2 mkAlphaColour arbitrary arbitrary+   where+    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+   where+    a = alphaChannel ac+    c = colourChannel ac++prop_toFromRGB709 :: RColour -> Bool+prop_toFromRGB709 c = (rgb709 r g b) == c+ where+  (r,g,b) = toRGB709 c++prop_fromToRGB709 :: Rational -> Rational -> Rational -> Bool+prop_fromToRGB709 r g b = toRGB709 (rgb709 r g b) == (r,g,b)++prop_toFromXYZ :: RColour -> Bool+prop_toFromXYZ c = (cieXYZ x y z) == c+ where+  (x,y,z) = toCIEXYZ c++prop_fromToXYZ :: Rational -> Rational -> Rational -> Bool+prop_fromToXYZ x y z = toCIEXYZ (cieXYZ x y z) == (x,y,z)++-- 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_fromToSRGB :: Word8 -> Word8 -> Word8 -> Bool+prop_fromToSRGB r' g' b' = toSRGB24 (sRGB24 r' g' b') == (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)++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)++prop_transparentOver :: RColour -> Bool+prop_transparentOver c = transparent `over` c == c++prop_overTransparent :: RAlphaColour -> Bool+prop_overTransparent c = c `over` transparent == c++prop_opaqueOver :: RColour -> RColour -> Bool+prop_opaqueOver c1 c2 = alphaColour c1 `over` c2 == c1++prop_sRGB24showlength :: DColour -> Bool+prop_sRGB24showlength c = length (sRGB24show c) == 7++prop_readshowSRGB24 :: DColour -> Bool+prop_readshowSRGB24 c =+  sRGB24show (sRGB24read (sRGB24show c)) == sRGB24show c++prop_luminance_white :: Bool+prop_luminance_white = luminance white == 1++tests = [("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)+        ,("transparent-over", test prop_transparentOver)+        ,("over-transparent", test prop_overTransparent)+        ,("opaque-over", test prop_opaqueOver)+        ,("sRGB24-show-length", test prop_sRGB24showlength)+        ,("sRGB24-read-show", test prop_readshowSRGB24)+        ,("luminance-white", check defaultConfig{configMaxTest = 1}+                             prop_luminance_white)+        ]++main  = mapM_ (\(s,a) -> printf "%-25s: " s >> a) tests
+ colour.cabal view
@@ -0,0 +1,29 @@+Name:                colour+Version:             0.0.0+Cabal-Version:       >= 1.2+License:             OtherLicense+License-file:        LICENSE+Author:              Russell O'Connor+Maintainer:          roconnor@theorem.ca+Build-Type:          Simple+Category:            data+Synopsis:            A colour model for human vision+Description:         This package provides a data type for colours.+                     Colours can be blended and composed.+                     Various colour spaces are supported.+                     A module of colour names ("Data.Colour.Names") is provided.+Tested-with:         GHC == 6.8.2+extra-source-files:  Tests.hs README++Library+  Build-Depends:     base+  Exposed-Modules:   Data.Colour+                     Data.Colour.SRGB+                     Data.Colour.CIE+                     Data.Colour.Names+                     Data.Colour.Rec601+                     Data.Colour.Rec709+  Other-Modules:     Data.Colour.Internal+                     Data.Colour.Chan+                     Data.Colour.Luma+                     Data.Colour.Matrix