Skip to content

Commit

Permalink
More spec for alternative RGB color spaces
Browse files Browse the repository at this point in the history
  • Loading branch information
lehins committed Jan 13, 2020
1 parent 0fd5bd0 commit 358115c
Show file tree
Hide file tree
Showing 6 changed files with 93 additions and 1 deletion.
4 changes: 4 additions & 0 deletions Color/Color.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,10 @@ test-suite tests
, Graphics.Color.Space.RGB.ITU.Rec470Spec
, Graphics.Color.Space.RGB.ITU.Rec601Spec
, Graphics.Color.Space.RGB.ITU.Rec709Spec
, Graphics.Color.Space.RGB.Alternative.CMYKSpec
, Graphics.Color.Space.RGB.Alternative.HSISpec
, Graphics.Color.Space.RGB.Alternative.HSLSpec
, Graphics.Color.Space.RGB.Alternative.HSVSpec
, Graphics.Color.Space.RGB.Alternative.YCbCrSpec
, Graphics.Color.Standard.RALSpec
, Spec
Expand Down
1 change: 0 additions & 1 deletion Color/tests/Graphics/Color/Model/CMYKSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,6 @@ spec =
prop "cmyk2rgb - 16bit" $ \(cmyk@(ColorCMYK c m y k) :: Color CMYK Word16) ->
case JuicyPixels.convertPixel (JuicyPixels.PixelCMYK16 c m y k) of
JuicyPixels.PixelRGB16 r g b ->
-- toWord16 <$> cmyk2rgb (toFloat <$> cmyk) `approxIntegralColorExpect1` ColorRGB r g b
approxIntegralColorExpect 2 (toWord16 <$> cmyk2rgb (toFloat <$> cmyk)) (ColorRGB r g b)
prop "rgb2cmyk - 16bit" $ \(rgb@(ColorRGB r g b) :: Color RGB Word16) ->
case JuicyPixels.convertPixel (JuicyPixels.PixelRGB16 r g b) of
Expand Down
26 changes: 26 additions & 0 deletions Color/tests/Graphics/Color/Space/RGB/Alternative/CMYKSpec.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,26 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Graphics.Color.Space.RGB.Alternative.CMYKSpec (spec) where

import Graphics.Color.Space.Common
import Graphics.Color.Space.RGB.SRGB
import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived
import Graphics.Color.Space.RGB.Alternative.CMYK
import Graphics.Color.Space.RGB.Derived.SRGBSpec ()


instance (Elevator e, Random e) => Arbitrary (Color (CMYK cs) e) where
arbitrary =
ColorCMYK <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator <*>
arbitraryElevator

spec :: Spec
spec =
describe "CMYK" $ do
colorModelSpec @(CMYK (Derived.SRGB D65)) @Word "CMYK"
colorSpaceCommonSpec @(CMYK (Derived.SRGB D65)) @_ @Double $ pure ()
-- Arbitrary inverse CMYKtoSRGB is not true.
prop "sRGBtoCMYK" $ \ (srgb :: Color (Derived.SRGB D65) Double) ->
toBaseSpace (fromBaseSpace srgb :: Color (CMYK (Derived.SRGB D65)) Double)
`epsilonEqColor` srgb
21 changes: 21 additions & 0 deletions Color/tests/Graphics/Color/Space/RGB/Alternative/HSISpec.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
module Graphics.Color.Space.RGB.Alternative.HSISpec (spec) where

import Graphics.Color.Space.Common
import Graphics.Color.Space.RGB.SRGB
import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived
import Graphics.Color.Space.RGB.Alternative.HSI
import Graphics.Color.Space.RGB.SRGBSpec ()
import Graphics.Color.Space.RGB.Derived.SRGBSpec ()


instance (Elevator e, Random e) => Arbitrary (Color (HSI cs) e) where
arbitrary = ColorHSI <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator

spec :: Spec
spec =
describe "HSI" $ do
describe "Derived-sRGB" $ do
colorModelSpec @(HSI (Derived.SRGB D65)) @Word "HSI"
colorSpaceSpec @(HSI (Derived.SRGB D65)) @_ @Double
21 changes: 21 additions & 0 deletions Color/tests/Graphics/Color/Space/RGB/Alternative/HSLSpec.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
module Graphics.Color.Space.RGB.Alternative.HSLSpec (spec) where

import Graphics.Color.Space.Common
import Graphics.Color.Space.RGB.SRGB
import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived
import Graphics.Color.Space.RGB.Alternative.HSL
import Graphics.Color.Space.RGB.SRGBSpec ()
import Graphics.Color.Space.RGB.Derived.SRGBSpec ()


instance (Elevator e, Random e) => Arbitrary (Color (HSL cs) e) where
arbitrary = ColorHSL <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator

spec :: Spec
spec =
describe "HSL" $ do
describe "Derived-sRGB" $ do
colorModelSpec @(HSL (Derived.SRGB D65)) @Word "HSL"
colorSpaceSpec @(HSL (Derived.SRGB D65)) @_ @Double
21 changes: 21 additions & 0 deletions Color/tests/Graphics/Color/Space/RGB/Alternative/HSVSpec.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
module Graphics.Color.Space.RGB.Alternative.HSVSpec (spec) where

import Graphics.Color.Space.Common
import Graphics.Color.Space.RGB.SRGB
import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived
import Graphics.Color.Space.RGB.Alternative.HSV
import Graphics.Color.Space.RGB.SRGBSpec ()
import Graphics.Color.Space.RGB.Derived.SRGBSpec ()


instance (Elevator e, Random e) => Arbitrary (Color (HSV cs) e) where
arbitrary = ColorHSV <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator

spec :: Spec
spec =
describe "HSV" $ do
describe "Derived-sRGB" $ do
colorModelSpec @(HSV (Derived.SRGB D65)) @Word "HSV"
colorSpaceSpec @(HSV (Derived.SRGB D65)) @_ @Double

0 comments on commit 358115c

Please sign in to comment.