colour 2.1.0 → 2.2.0

raw patch · 6 files changed

+234/−5 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Colour/RGB.hs +30/−1
• Data/Colour/RGBSpace/HSL.hs +73/−0
• Data/Colour/RGBSpace/HSV.hs +73/−0
• Data/Colour/SRGB.hs +7/−1
• Tests.hs +46/−1
• colour.cabal +5/−2

@@ -1,5 +1,5 @@ {--Copyright (c) 2008+Copyright (c) 2008,2009 Russell O'Connor  Permission is hereby granted, free of charge, to any person obtaining a copy@@ -94,3 +94,32 @@  xyz2rgb :: RGBGamut -> [[Rational]] xyz2rgb = inverse . rgb2xyz++hslsv :: (Fractional a, Ord a) => RGB a -> (a,a,a,a,a)+hslsv (RGB r g b) | mx == mn  = (0,0,mx,0 ,mx)+                  | otherwise = (h,s,l ,s0,mx)+ where+  mx = maximum [r,g,b]+  mn = minimum [r,g,b]+  l = (mx+mn)/2+  s | l <= 0.5 = (mx-mn)/(mx+mn)+    | otherwise = (mx-mn)/(2-(mx+mn))+  s0 = (mx-mn)/mx+  -- hue calcuation+  [x,y,z] = take 3 $ dropWhile (/=mx) [r,g,b,r,g]+  Just o = elemIndex mx [r,g,b]+  h0 = 60*(y-z)/(mx-mn) + 120*(fromIntegral o)+  h | h0 < 0 = h0 + 360+    | otherwise = h0++-- |The 'hue' coordinate of an 'RGB' value is in degrees. Its value is+-- always in the range 0-360.+hue :: (Fractional a, Ord a) => RGB a -> a+hue rgb = h+ where+  (h,_,_,_,_) = hslsv rgb++mod1 x | pf < 0 = pf+1+       | otherwise = pf+ where+  (_,pf) = properFraction x

@@ -0,0 +1,73 @@+{-+Copyright (c) 2008,2009+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.HSL + (RGB+ ,hslView+ ,hue, saturation, lightness+ ,hsl+ )+where++import Data.Colour.RGB++-- |Returns the HSL (hue-saturation-lightness) coordinates of an 'RGB' triple.+-- See 'hue', 'saturation', and 'lightness'.+hslView :: (Fractional a, Ord a) => RGB a -> (a,a,a)+hslView rgb = (h,s,l)+ where+  (h,s,l,_,_) = hslsv rgb++-- |Returns the saturation coordinate of an 'RGB' triple for the HSL+-- (hue-saturation-lightness) system.+-- Note: This is different from 'Data.Colour.RGBSpace.HSV.saturation' for+-- the "Data.Colour.RGBSpace.HSV"+saturation :: (Fractional a, Ord a) => RGB a -> a+saturation rgb = s+ where+  (_,s,_,_,_) = hslsv rgb++-- |Returns the lightness coordinate of an 'RGB' triple for the HSL+-- (hue-saturation-lightness) system.+lightness :: (Fractional a, Ord a) => RGB a -> a+lightness rgb = l+ where+  (_,_,l,_,_) = hslsv rgb++-- |Convert HSL (hue-saturation-lightness) coordinates to an 'RGB' value.+-- Hue is expected to be measured in degrees.+hsl :: (RealFrac a, Ord a) => a -> a -> a -> RGB a+hsl h s l = fmap component t+ where+  hk = h/360+  tr = mod1 (hk + 1/3)+  tg = mod1 hk+  tb = mod1 (hk - 1/3)+  t = RGB tr tg tb+  q | l < 0.5 = l*(1+s)+    | otherwise = l + s - l*s+  p = 2*l - q+  component t | t < 1/6 = p + ((q-p)*6*t)+              | t < 1/2 = q+              | t < 2/3 = p + ((q-p)*6*(2/3-t))+              | otherwise = p

@@ -0,0 +1,73 @@+{-+Copyright (c) 2008,2009+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.HSV + (RGB+ ,hsvView+ ,hue, saturation, value+ ,hsv+ )+where++import Data.Colour.RGB++-- |Returns the HSV (hue-saturation-value) coordinates of an 'RGB' triple.+-- See 'hue', 'saturation', and 'value'.+hsvView :: (Fractional a, Ord a) => RGB a -> (a,a,a)+hsvView rgb = (h,s,v)+ where+  (h,_,_,s,v) = hslsv rgb++-- |Returns the saturation coordinate of an 'RGB' triple for the HSV+-- (hue-saturation-value) system.+-- Note: This is different from 'Data.Colour.RGBSpace.HSL.saturation' for+-- the "Data.Colour.RGBSpace.HSL"+saturation :: (Fractional a, Ord a) => RGB a -> a+saturation rgb = s+ where+  (_,_,_,s,_) = hslsv rgb++-- |Returns the value coordinate of an 'RGB' triple for the HSV+-- (hue-saturation-value) system.+value :: (Fractional a, Ord a) => RGB a -> a+value rgb = v+ where+  (_,_,_,_,v) = hslsv rgb++-- |Convert HSV (hue-saturation-value) coordinates to an 'RGB' value.+-- Hue is expected to be measured in degrees.++hsv :: (RealFrac a, Ord a) => a -> a -> a -> RGB a+hsv h s v = case hi of+    0 -> RGB v t p+    1 -> RGB q v p+    2 -> RGB p v t+    3 -> RGB p q v+    4 -> RGB t p v+    5 -> RGB v p q+ where+  hi = floor (h/60) `mod` 6+  f = mod1 (h/60)+  p = v*(1-s)+  q = v*(1-f*s)+  t = v*(1-(1-f)*s)

@@ -1,5 +1,5 @@ {--Copyright (c) 2008+Copyright (c) 2008,2009 Russell O'Connor  Permission is hereby granted, free of charge, to any person obtaining a copy@@ -38,6 +38,12 @@ import Data.Colour.Internal (quantize) import Data.Colour.SRGB.Linear import Data.Colour.RGBSpace hiding (transferFunction)++{- a rewrite rule to think about adding.+   Should I have some instance restrictions (like Word8/Word16 Float/Double)?+# RULES "sRGBBounded" +  forall r g b. toSRGBBounded (sRGBBounded r g b) = RGB r g b #+-}  {- Non-linear colour space -} {- the sRGB transfer function approximates a gamma of about 1/2.2 -}

@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -XTypeSynonymInstances #-} {--Copyright (c) 2008+Copyright (c) 2008, 2009 Russell O'Connor  Permission is hereby granted, free of charge, to any person obtaining a copy@@ -23,6 +23,7 @@ -} module Main where +import System.Random import Data.Word import Control.Monad import Test.QuickCheck@@ -39,6 +40,8 @@ --import qualified Data.Colour.SDTV as SDTV import Data.Colour.RGB import Data.Colour.RGBSpace+import Data.Colour.RGBSpace.HSL+import Data.Colour.RGBSpace.HSV  default (Rational, Double, Float) @@ -94,6 +97,12 @@   arbitrary = liftM2 RGBGamut arbitrary arbitrary   coarbitrary (RGBGamut p w) = coarbitrary p . coarbitrary w +-- generate RGB values with channels between 0 and 1.+rgbGen :: Gen (RGB Rational)+rgbGen = fmap (\(r,g,b) -> fmap toRational (RGB r g b)) (three zeroOne)++zeroOne = choose (0,1::Double)+ good (RGBGamut p w) = p1 && p2  where   p1 = 0 /= determinant (primaryMatrix p)@@ -229,7 +238,38 @@ prop_toSRGB c =   toRGBUsingSpace sRGBSpace c == toSRGB c +prop_hueRange :: RGB Rational -> Bool+prop_hueRange rgb = 0 <= h && h < 360+ where+  h = hue rgb +prop_toFromHSL :: Property+prop_toFromHSL = forAll rgbGen (\rgb -> hsl' (hslView rgb) == rgb)+ where+  hsl' (h,s,l) = hsl h s l++prop_fromToHSL :: Rational -> Property+prop_fromToHSL h = forAll (two (fmap toRational zeroOne))+  (\(s,l) -> checkHSL (hslView (hsl h s l)) (h,s,l))+ where+  checkHSL (h0,s0,l0) (h1,s1,l1) =  +    snd (properFraction ((h0-h1)/360)::(Integer,Rational)) == 0+    && s0 == s1 && l0 == l1++prop_toFromHSV :: Property+prop_toFromHSV = forAll rgbGen (\rgb -> hsv' (hsvView rgb) == rgb)+ where+  hsv' (h,s,v) = hsv h s v++prop_fromToHSV :: Rational -> Property+prop_fromToHSV h = forAll (two (fmap toRational zeroOne))+  (\(s,v) -> checkHSV (hsvView (hsv h s v)) (h,s,v))+ where+  checkHSV (h0,s0,v0) (h1,s1,v1) =  +    snd (properFraction ((h0-h1)/360)::(Integer,Rational)) == 0+    && s0 == s1 && v0 == v1++ tests = [("matrix-mult", test prop_matrixMult)         ,("RGB-to-from", test prop_toFromRGB)         ,("RGB-from-to", test prop_fromToRGB)@@ -264,6 +304,11 @@         ,("toRGB", test prop_toRGB)         ,("sRGB", test prop_sRGB)         ,("toSRGB", test prop_toSRGB)+        ,("hueRange", test prop_hueRange)+        ,("toFromHSL", test prop_toFromHSL)+        ,("fromToHSL", test prop_fromToHSL)+        ,("toFromHSV", test prop_toFromHSV)+        ,("fromToHSV", test prop_fromToHSV)         ]  main  = mapM_ (\(s,a) -> printf "%-25s: " s >> a) tests

@@ -1,5 +1,5 @@ Name:                colour-Version:             2.1.0+Version:             2.2.0 Cabal-Version:       >= 1.2 License:             OtherLicense License-file:        LICENSE@@ -13,7 +13,8 @@                      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+extra-source-files:  Tests.hs+data-files:          README  Library   Build-Depends:     base@@ -23,6 +24,8 @@                      Data.Colour.CIE                      Data.Colour.CIE.Illuminant                      Data.Colour.RGBSpace+                     Data.Colour.RGBSpace.HSL+                     Data.Colour.RGBSpace.HSV                      Data.Colour.Names   Other-Modules:     Data.Colour.Internal                      Data.Colour.Chan