prizm 0.1.0.3 → 0.1.0.4

raw patch · 4 files changed

+59/−4 lines, 4 filesdep +text

Dependencies added: text

Files

• prizm.cabal +3/−2
• src/Data/Prizm/Color/SRGB.hs +49/−1
• src/Data/Prizm/Types.hs +2/−0
• tests/QC/SRGB.hs +5/−1

@@ -1,5 +1,5 @@ Name:                prizm-Version:             0.1.0.3+Version:             0.1.0.4 Synopsis:            A haskell library for computing with colors  Description:         Prizm can convert between many different color@@ -43,7 +43,8 @@      ghc-options: -Wall   -  build-depends: base ==4.5.*+  build-depends: base ==4.5.*,+                 text >= 0.11.2.3  test-suite tests   type:           exitcode-stdio-1.0

@@ -2,12 +2,21 @@ (   toXYZ , toXYZMatrix+, toHex+, fromHex ) where +import Numeric (showHex)++import Data.Monoid import Data.Prizm.Types import Data.Prizm.Color.Transform import Data.Prizm.Color.Matrices.RGB +import Data.String+import qualified Data.Text as T+import Data.Text.Read as R+ import Control.Applicative  -- | @rgbTransform@ transform an RGB integer to be computed against@@ -18,12 +27,51 @@     where dv = fromIntegral v / 255           ap = 1.0 + 0.055 +-- | @toHex@ convert an sRGB value to hexadecimal.+toHex :: RGB Integer -> Hex+toHex = showRGB++fromHex :: Hex -> RGB Integer+fromHex = parse . fromString++parse :: T.Text -> RGB Integer+parse t =+  case T.uncons t of+    Just ('#', cs) | T.all isHex cs ->+      case T.unpack cs of+        [a, b, c, d, e, f, _g, _h] -> RGB (hex a b) (hex c d) (hex e f)+        [a, b, c, d, e, f      ]   -> RGB (hex a b) (hex c d) (hex e f)+        [a, b, c, _d            ]  -> RGB (hex a a) (hex b b) (hex c c)+        [a, b, c               ]   -> RGB (hex a a) (hex b b) (hex c c)+        _                          -> err+    _                              -> err++  where+    hex a b = either err fst (R.hexadecimal (T.singleton a <> T.singleton b))+    isHex a = (a >= 'a' && a <= 'f') || (a >= 'A' && a <= 'F') || (a >= '0' && a <= '9')+    err     = error "Invalid color string"+ -- | @toXYZ@ convert an sRGB value to a CIE XYZ value. toXYZ :: RGB Integer -> CIEXYZ Double toXYZ = (toXYZMatrix d65SRGB)  toXYZMatrix :: RGBtoXYZ -> RGB Integer -> CIEXYZ Double toXYZMatrix m (RGB r g b) =-    let t = ZipList (transform <$> [r,g,b])+    let t = ZipList (transform <$> (clamp <$> [r,g,b]))         [x,y,z] = (roundN 3) <$> ((zipTransform t) <$> m)     in CIEXYZ x y z++clamp :: Integer -> Integer+clamp i = max (min i 255) 0++{- All credit for the below three functions go to the HSColour+   module-}++-- |Show a colour in hexadecimal form, e.g. \"#00aaff\"+showRGB :: RGB Integer -> Hex+showRGB c =+  (("#"++) . showHex2 r' . showHex2 g' . showHex2 b') ""+ where+  RGB r' g' b' = c+  showHex2 x | x <= 0xf = ("0"++) . showHex x+             | otherwise = showHex x

@@ -5,6 +5,8 @@ type RGBtoXYZ = [[Double]] type XYZtoRGB = [[Double]] +type Hex = String+ data RGB a = RGB !a !a !a     deriving (Eq, Ord, Show) 

@@ -5,6 +5,8 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck +import Numeric+ import Control.Monad  import Data.Prizm.Color.SRGB as S@@ -15,7 +17,9 @@     arbitrary = liftM3 RGB (choose (0, 255)) (choose (0, 255)) (choose (0, 255))  rgb2XYZ v = C.toRGB(S.toXYZ v) == v+rgb2HEX v = S.fromHex(S.toHex v) == v  tests = [-    testProperty "SRGB <-> CIE XYZ" rgb2XYZ+    testProperty "SRGB <-> CIE XYZ" rgb2XYZ,+    testProperty "HEX <-> SRGB" rgb2HEX       ]