Color 0.1.4 → 0.2.0

raw patch · 67 files changed

+1089/−504 lines, 67 filesdep −template-haskelldep ~doctestsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: template-haskell

Dependency ranges changed: doctest

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−1
• Color.cabal +11/−15
• README.md +18/−12
• Setup.hs +0/−30
• bench/Conversion.hs +3/−3
• src/Graphics/Color/Adaptation/Internal.hs +2/−2
• src/Graphics/Color/Adaptation/VonKries.hs +31/−42
• src/Graphics/Color/Algebra.hs +1/−1
• src/Graphics/Color/Algebra/Binary.hs +3/−2
• src/Graphics/Color/Algebra/Elevator.hs +39/−6
• src/Graphics/Color/Illuminant/CIE1931.hs +1/−1
• src/Graphics/Color/Illuminant/CIE1964.hs +1/−1
• src/Graphics/Color/Illuminant/ICC/PCS.hs +3/−3
• src/Graphics/Color/Illuminant/ITU/Rec470.hs +5/−5
• src/Graphics/Color/Illuminant/ITU/Rec601.hs +3/−3
• src/Graphics/Color/Illuminant/Wikipedia.hs +1/−1
• src/Graphics/Color/Model.hs +2/−2
• src/Graphics/Color/Model/CMYK.hs +1/−1
• src/Graphics/Color/Model/HSI.hs +1/−1
• src/Graphics/Color/Model/HSL.hs +1/−1
• src/Graphics/Color/Model/HSV.hs +1/−1
• src/Graphics/Color/Model/Internal.hs +1/−1
• src/Graphics/Color/Model/RGB.hs +1/−1
• src/Graphics/Color/Model/Y.hs +1/−1
• src/Graphics/Color/Model/YCbCr.hs +1/−1
• src/Graphics/Color/Space.hs +1/−1
• src/Graphics/Color/Space/CIE1931/RGB.hs +107/−0
• src/Graphics/Color/Space/CIE1976/LAB.hs +1/−1
• src/Graphics/Color/Space/Internal.hs +8/−6
• src/Graphics/Color/Space/RGB.hs +0/−1
• src/Graphics/Color/Space/RGB/AdobeRGB.hs +55/−40
• src/Graphics/Color/Space/RGB/Alternative.hs +1/−1
• src/Graphics/Color/Space/RGB/Alternative/CMYK.hs +90/−4
• src/Graphics/Color/Space/RGB/Alternative/HSI.hs +4/−5
• src/Graphics/Color/Space/RGB/Alternative/HSL.hs +4/−5
• src/Graphics/Color/Space/RGB/Alternative/HSV.hs +4/−4
• src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs +25/−23
• src/Graphics/Color/Space/RGB/CIERGB.hs +13/−0
• src/Graphics/Color/Space/RGB/Derived/AdobeRGB.hs +33/−17
• src/Graphics/Color/Space/RGB/Derived/CIERGB.hs +97/−0
• src/Graphics/Color/Space/RGB/Derived/SRGB.hs +34/−17
• src/Graphics/Color/Space/RGB/ITU/Rec470.hs +63/−33
• src/Graphics/Color/Space/RGB/ITU/Rec601.hs +66/−35
• src/Graphics/Color/Space/RGB/ITU/Rec709.hs +33/−17
• src/Graphics/Color/Space/RGB/Internal.hs +86/−41
• src/Graphics/Color/Space/RGB/Luma.hs +5/−3
• src/Graphics/Color/Space/RGB/SRGB.hs +54/−37
• src/Graphics/Pixel/ColorSpace.hs +28/−8
• src/Graphics/Pixel/Internal.hs +2/−0
• tests/Graphics/Color/Space/CIE1931/RGBSpec.hs +20/−0
• tests/Graphics/Color/Space/CIE1976/LABSpec.hs +2/−2
• tests/Graphics/Color/Space/RGB/AdobeRGBSpec.hs +5/−3
• tests/Graphics/Color/Space/RGB/Alternative/CMYKSpec.hs +5/−4
• tests/Graphics/Color/Space/RGB/Alternative/HSISpec.hs +3/−2
• tests/Graphics/Color/Space/RGB/Alternative/HSLSpec.hs +3/−2
• tests/Graphics/Color/Space/RGB/Alternative/HSVSpec.hs +5/−2
• tests/Graphics/Color/Space/RGB/Alternative/YCbCrSpec.hs +14/−13
• tests/Graphics/Color/Space/RGB/Derived/AdobeRGBSpec.hs +5/−3
• tests/Graphics/Color/Space/RGB/Derived/CIERGBSpec.hs +21/−0
• tests/Graphics/Color/Space/RGB/Derived/SRGBSpec.hs +12/−8
• tests/Graphics/Color/Space/RGB/ITU/Rec470Spec.hs +10/−6
• tests/Graphics/Color/Space/RGB/ITU/Rec601Spec.hs +8/−6
• tests/Graphics/Color/Space/RGB/ITU/Rec709Spec.hs +4/−3
• tests/Graphics/Color/Space/RGB/SRGBSpec.hs +6/−3
• tests/Graphics/Color/Standard/RALSpec.hs +5/−2
• tests/Main.hs +2/−1
• tests/doctests.hs +1/−7

@@ -1,4 +1,15 @@-# Changelog for color+# Changelog for Color++## 0.2.0++* Add `Linearity` kind to `RedGreenBlue` color spaces.+* Add `Default` instance for `Pixel`+* Addition of universal division `(//)` to `Elevator`+* Addition of CIE1931 RGB color space.+* Fix show instance for floating point colors: adjust formatting in Elevator for `Float` and `Double`+* Add record accessor functions: `chromaticityCIExyY`, `whitePointChromaticity`+* Fix show instance for `Gamut`+* Remove deprecated: `CIECAM02` and `ciecam02Adaptation`  ## 0.1.4 

@@ -1,5 +1,5 @@ name:                Color-version:             0.1.4+version:             0.2.0 synopsis:            Color spaces and conversions between them description:         Please see the README on GitHub at <https://github.com/lehins/Color#readme> homepage:            https://github.com/lehins/Color@@ -13,20 +13,13 @@                    , CHANGELOG.md extra-doc-files:     files/*.svg cabal-version:       >=1.18-build-type:          Custom+build-type:          Simple tested-with:          GHC == 8.4.3                     , GHC == 8.4.4                     , GHC == 8.6.3                     , GHC == 8.6.4                     , GHC == 8.6.5-                    , GHC == 8.8.1-                    , GHC == 8.8.2--custom-setup-  setup-depends:-      base-    , Cabal-    , cabal-doctest >=1.0.6+                    , GHC == 8.8.3  library   hs-source-dirs:      src@@ -45,23 +38,25 @@                      , Graphics.Color.Illuminant.Wikipedia                      , Graphics.Color.Model                      , Graphics.Color.Space-                     -- , Graphics.Color.Space.CIE1931.RGB+                     , Graphics.Color.Space.CIE1931.RGB                      , Graphics.Color.Space.CIE1931.XYZ                      , Graphics.Color.Space.CIE1976.LAB                      -- , Graphics.Color.Space.CIE1976.LAB.LCH                      -- , Graphics.Color.Space.CIE1976.LAB.HLC                      -- , Graphics.Color.Space.CIE1976.LUV                      , Graphics.Color.Space.RGB-                     , Graphics.Color.Space.RGB.SRGB+                     , Graphics.Color.Space.RGB.CIERGB                      , Graphics.Color.Space.RGB.AdobeRGB+                     , Graphics.Color.Space.RGB.SRGB                      , Graphics.Color.Space.RGB.Alternative                      , Graphics.Color.Space.RGB.Alternative.CMYK                      , Graphics.Color.Space.RGB.Alternative.HSI                      , Graphics.Color.Space.RGB.Alternative.HSV                      , Graphics.Color.Space.RGB.Alternative.HSL                      , Graphics.Color.Space.RGB.Alternative.YCbCr-                     , Graphics.Color.Space.RGB.Derived.SRGB                      , Graphics.Color.Space.RGB.Derived.AdobeRGB+                     , Graphics.Color.Space.RGB.Derived.CIERGB+                     , Graphics.Color.Space.RGB.Derived.SRGB                      , Graphics.Color.Space.RGB.ITU.Rec470                      , Graphics.Color.Space.RGB.ITU.Rec601                      , Graphics.Color.Space.RGB.ITU.Rec709@@ -116,10 +111,12 @@                     , Graphics.Color.Model.RGBSpec                     , Graphics.Color.Model.YCbCrSpec                     , Graphics.Color.Space.Common+                    , Graphics.Color.Space.CIE1931.RGBSpec                     , Graphics.Color.Space.CIE1976.LABSpec                     , Graphics.Color.Space.RGB.AdobeRGBSpec                     , Graphics.Color.Space.RGB.SRGBSpec                     , Graphics.Color.Space.RGB.Derived.AdobeRGBSpec+                    , Graphics.Color.Space.RGB.Derived.CIERGBSpec                     , Graphics.Color.Space.RGB.Derived.SRGBSpec                     , Graphics.Color.Space.RGB.ITU.Rec470Spec                     , Graphics.Color.Space.RGB.ITU.Rec601Spec@@ -158,10 +155,9 @@   hs-source-dirs:   tests   main-is:          doctests.hs   build-depends: base-               , doctest >=0.15+               , doctest >=0.16                , QuickCheck                , Color-               , template-haskell   default-language:    Haskell2010   ghc-options:        -Wall                       -Wincomplete-record-updates

@@ -1,15 +1,19 @@ # Color -| Language | Travis | Coveralls |Gitter.im |-|:--------:|:------:|:---------:|:--------:|-| ![GitHub top language](https://img.shields.io/github/languages/top/lehins/Color.svg) | [![Travis](https://img.shields.io/travis/lehins/Color/master.svg?label=Linux%20%26%20OS%20X)](https://travis-ci.org/lehins/Color) | [![Coverage Status](https://coveralls.io/repos/github/lehins/Color/badge.svg?branch=master)](https://coveralls.io/github/lehins/Color?branch=master) | [![Join the chat at https://gitter.im/haskell-massiv/Lobby](https://badges.gitter.im/haskell-massiv/Lobby.svg)](https://gitter.im/haskell-massiv/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)+A library for dealing with Colors and pixels. It implements arbitrary color space+conversion, chromatic adaptation and other color manipulations. +## Status++| Language | Travis | Azure | Coveralls |Gitter.im |+|:--------:|:------:|:--------:|:---------:|:--------:|+| ![GitHub top language](https://img.shields.io/github/languages/top/lehins/Color.svg) | [![Travis](https://img.shields.io/travis/lehins/Color/master.svg?label=Linux%20%26%20OS%20X)](https://travis-ci.org/lehins/Color) | [![Build Status](https://dev.azure.com/kuleshevich/Color/_apis/build/status/lehins.Color?branchName=master)](https://dev.azure.com/kuleshevich/Color/_build/latest?definitionId=1?branchName=master) | [![Coverage Status](https://coveralls.io/repos/github/lehins/Color/badge.svg?branch=master)](https://coveralls.io/github/lehins/Color?branch=master) | [![Join the chat at https://gitter.im/haskell-massiv/Lobby](https://badges.gitter.im/haskell-massiv/Lobby.svg)](https://gitter.im/haskell-massiv/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)+ |      Package       | Hackage | Nightly | LTS | |:-------------------|:-------:|:-------:|:---:| |  [`Color`](https://github.com/lehins/Color/tree/master/Color)|                                       [![Hackage](https://img.shields.io/hackage/v/Color.svg)](https://hackage.haskell.org/package/Color)|                                                                                                        [![Nightly](https://www.stackage.org/package/Color/badge/nightly)](https://www.stackage.org/nightly/package/Color)|                                                                                         [![Nightly](https://www.stackage.org/package/Color/badge/lts)](https://www.stackage.org/lts/package/Color)| -A library for dealing with Colors and pixels. It implements arbitrary color space-conversion, chromatic adaptation and other color manipulations.+## Description  There is a clear separation between color models, color spaces and alternative representations of color spaces. All are distinct at the type level. The goal is to@@ -31,12 +35,13 @@ * Color spaces and arbitrary conversions between them:    * `Y` - luminance+  * `Y'` - luma   * `CIE XYZ`   * `CIE L*a*b*`   * `RGB`: -    * `sRGB`-    * `AdobeRGB`+    * `sRGB` - both standardized and derived+    * `AdobeRGB` - both standardized and derived     * ITU: `Rec470`, `Rec601` and `Rec709`     * Alternative representations: @@ -56,17 +61,18 @@    * VonKries adaptation with transformations: -      * VonKries-      * Bradford (default)-      * Fairchild-      * CIECAM02+      * `VonKries`+      * `Bradford` (default)+      * `Fairchild`+      * `CIECAM02`+      * `CMCCAT2000`  * Color Standards:    * RAL  -# External resources+## External resources  * `Color` is on a list of curated [Awesome Colour](https://awesome-colour.org/#haskell)   resources.

@@ -1,34 +1,4 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wall #-}-module Main (main) where--#ifndef MIN_VERSION_cabal_doctest-#define MIN_VERSION_cabal_doctest(x,y,z) 0-#endif--#if MIN_VERSION_cabal_doctest(1,0,0)--import Distribution.Extra.Doctest ( defaultMainWithDoctests )-main :: IO ()-main = defaultMainWithDoctests "doctests"--#else--#ifdef MIN_VERSION_Cabal--- If the macro is defined, we have new cabal-install,--- but for some reason we don't have cabal-doctest in package-db------ Probably we are running cabal sdist, when otherwise using new-build--- workflow-#warning You are configuring this package without cabal-doctest installed. \-         The doctests test-suite will not work as a result. \-         To fix this, install cabal-doctest before configuring.-#endif- import Distribution.Simple  main :: IO () main = defaultMain--#endif-

@@ -47,7 +47,7 @@   makeRandomRGB ::-     (RedGreenBlue cs (i :: k), RandomGen g, Random a, Elevator a) => g -> (Color cs a, g)+     (RedGreenBlue cs (i :: k), RandomGen g, Random a, Elevator a) => g -> (Color (cs 'NonLinear) a, g) makeRandomRGB gen =   case randomV3 gen of     (V3 r g b, gen') -> (mkColorRGB (CM.ColorRGB r g b), gen')@@ -69,8 +69,8 @@   -> g   -> (Benchmark, g) mkBenchmarks _ tyName g0 =-  let !(srgb :: Color SRGB f, g1) = makeRandomRGB g0-      !(srgbDerived :: Color (Derived.SRGB 'D65) f, g2) = makeRandomRGB g1+  let !(srgb :: Color (SRGB 'NonLinear) f, g1) = makeRandomRGB g0+      !(srgbDerived :: Color (Derived.SRGB 'D65 'NonLinear) f, g2) = makeRandomRGB g1       !(xyz :: Color (XYZ D65) f) = toColorXYZ srgb       !(xyzDerived :: Color (XYZ 'D65) f) = toColorXYZ srgbDerived       !(srgbColour :: Colour.Colour f, g3) = makeRandomColour g2

@@ -52,8 +52,8 @@ chromaticAdaptation ::      ChromaticAdaptation t it ir e   => Adaptation t it ir e-  -> Gamut cst it e-  -> Gamut csr ir e+  -> Gamut cs it e+  -> Gamut cs ir e chromaticAdaptation adaptation g = Gamut redPrimary greenPrimary bluePrimary   where     applyMatrix primary =

@@ -11,7 +11,7 @@ {-# LANGUAGE TypeInType #-} -- | -- Module      : Graphics.Color.Adaptation.VonKries--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -33,9 +33,6 @@   , ciecat02Adaptation   , cmccat2000Adaptation   , adaptationMatrix-  -- * Deprecated-  , CIECAM02-  , ciecam02Adaptation   ) where  import Data.Coerce@@ -52,14 +49,14 @@   --   -- >>> cat :: CAT 'VonKries Float   -- CAT VonKries 'VonKries Float-  -- [ [ 0.400240, 0.707600,-0.080810 ]-  -- , [-0.226300, 1.165320, 0.045700 ]-  -- , [ 0.000000, 0.000000, 0.918220 ] ]+  -- [ [ 0.40024000, 0.70760000,-0.08081000 ]+  -- , [-0.22630000, 1.16532000, 0.04570000 ]+  -- , [ 0.00000000, 0.00000000, 0.91822000 ] ]   -- >>> icat :: ICAT 'VonKries Float   -- ICAT VonKries 'VonKries Float-  -- [ [ 1.859936,-1.129382, 0.219897 ]-  -- , [ 0.361191, 0.638812,-0.000006 ]-  -- , [-0.000000,-0.000000, 1.089064 ] ]+  -- [ [ 1.85993650,-1.12938170, 0.21989742 ]+  -- , [ 0.36119142, 0.63881250,-0.00000637 ]+  -- , [-0.00000000,-0.00000000, 1.08906360 ] ]   --   -- @since 0.1.0   | Bradford@@ -67,14 +64,14 @@   --   -- >>> cat :: CAT 'Bradford Float   -- CAT VonKries 'Bradford Float-  -- [ [ 0.895100, 0.266400,-0.161400 ]-  -- , [-0.750200, 1.713500, 0.036700 ]-  -- , [ 0.038900,-0.068500, 1.029600 ] ]+  -- [ [ 0.89510000, 0.26640000,-0.16140000 ]+  -- , [-0.75020000, 1.71350000, 0.03670000 ]+  -- , [ 0.03890000,-0.06850000, 1.02960000 ] ]   -- >>> icat :: ICAT 'Bradford Float   -- ICAT VonKries 'Bradford Float-  -- [ [ 0.986993,-0.147054, 0.159963 ]-  -- , [ 0.432305, 0.518360, 0.049291 ]-  -- , [-0.008529, 0.040043, 0.968487 ] ]+  -- [ [ 0.98699290,-0.14705427, 0.15996265 ]+  -- , [ 0.43230528, 0.51836026, 0.04929122 ]+  -- , [-0.00852867, 0.04004282, 0.96848667 ] ]   --   -- @since 0.1.0   | Fairchild@@ -82,14 +79,14 @@   --   -- >>> cat :: CAT 'Fairchild Float   -- CAT VonKries 'Fairchild Float-  -- [ [ 0.856200, 0.337200,-0.193400 ]-  -- , [-0.836000, 1.832700, 0.003300 ]-  -- , [ 0.035700,-0.046900, 1.011200 ] ]+  -- [ [ 0.85620000, 0.33720000,-0.19340000 ]+  -- , [-0.83600000, 1.83270000, 0.00330000 ]+  -- , [ 0.03570000,-0.04690000, 1.01120000 ] ]   -- >>> icat :: ICAT 'Fairchild Float   -- ICAT VonKries 'Fairchild Float-  -- [ [ 0.987400,-0.176825, 0.189425 ]-  -- , [ 0.450435, 0.464933, 0.084632 ]-  -- , [-0.013968, 0.027807, 0.986162 ] ]+  -- [ [ 0.98739994,-0.17682500, 0.18942511 ]+  -- , [ 0.45043513, 0.46493286, 0.08463200 ]+  -- , [-0.01396833, 0.02780657, 0.98616177 ] ]   --   -- @since 0.1.0   | CIECAT02@@ -97,14 +94,14 @@   --   -- >>> cat :: CAT 'CIECAT02 Float   -- CAT VonKries 'CIECAT02 Float-  -- [ [ 0.732800, 0.429600,-0.162400 ]-  -- , [-0.703600, 1.697500, 0.006100 ]-  -- , [ 0.003000, 0.013600, 0.983400 ] ]+  -- [ [ 0.73280000, 0.42960000,-0.16240000 ]+  -- , [-0.70360000, 1.69750000, 0.00610000 ]+  -- , [ 0.00300000, 0.01360000, 0.98340000 ] ]   -- >>> icat :: ICAT 'CIECAT02 Float   -- ICAT VonKries 'CIECAT02 Float-  -- [ [ 1.096124,-0.278869, 0.182745 ]-  -- , [ 0.454369, 0.473533, 0.072098 ]-  -- , [-0.009628,-0.005698, 1.015326 ] ]+  -- [ [ 1.09612380,-0.27886900, 0.18274519 ]+  -- , [ 0.45436904, 0.47353318, 0.07209781 ]+  -- , [-0.00962761,-0.00569803, 1.01532570 ] ]   --   -- @since 0.1.3   | CMCCAT2000@@ -112,14 +109,14 @@   --   -- >>> cat :: CAT 'CMCCAT2000 Float   -- CAT VonKries 'CMCCAT2000 Float-  -- [ [ 0.798200, 0.338900,-0.137100 ]-  -- , [-0.591800, 1.551200, 0.040600 ]-  -- , [ 0.000800, 0.023900, 0.975300 ] ]+  -- [ [ 0.79820000, 0.33890000,-0.13710000 ]+  -- , [-0.59180000, 1.55120000, 0.04060000 ]+  -- , [ 0.00080000, 0.02390000, 0.97530000 ] ]   -- >>> icat :: ICAT 'CMCCAT2000 Float   -- ICAT VonKries 'CMCCAT2000 Float-  -- [ [ 1.076450,-0.237662, 0.161212 ]-  -- , [ 0.410964, 0.554342, 0.034694 ]-  -- , [-0.010954,-0.013389, 1.024343 ] ]+  -- [ [ 1.07645010,-0.23766239, 0.16121234 ]+  -- , [ 0.41096430, 0.55434180, 0.03469386 ]+  -- , [-0.01095376,-0.01338936, 1.02434310 ] ]   --   -- @since 0.1.3 @@ -238,14 +235,6 @@ cmccat2000Adaptation :: ChromaticAdaptation 'CMCCAT2000 it ir e => Adaptation 'CIECAT02 it ir e cmccat2000Adaptation = adaptationMatrix {-# INLINE cmccat2000Adaptation #-}--type CIECAM02 = 'CIECAT02-{-# DEPRECATED CIECAM02 "In favor of a proper name 'CIECAT02'" #-}--ciecam02Adaptation :: ChromaticAdaptation CIECAM02 it ir e => Adaptation CIECAM02 it ir e-ciecam02Adaptation = adaptationMatrix-{-# INLINE ciecam02Adaptation #-}-{-# DEPRECATED ciecam02Adaptation "In favor of a proper name 'ciecat02Adaptation'" #-}  -- | This function allows conversion of a color between any two color spaces. It uses a -- very common `VonKries` chromatic adaptation transform with `Bradford` matrix. One of

@@ -4,7 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module      : Graphics.Color.Algebra--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -8,7 +8,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Algebra.Binary--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -29,7 +29,6 @@ import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Unboxed as U-import Data.Word (Word8) import Foreign.Storable import Graphics.Color.Algebra.Elevator import Prelude hiding (map)@@ -158,6 +157,8 @@   fromRealFloat 0 = Bit 0   fromRealFloat _ = Bit 1   {-# INLINE fromRealFloat #-}+  (//) (Bit x) (Bit y) = Bit (x `div` y)+  {-# INLINE (//) #-}   instance Num Bit where

@@ -5,7 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module      : Graphics.Color.Algebra.Elevator--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -26,6 +26,8 @@ import GHC.Float import Text.Printf +infixl 7 //+ defFieldFormat :: FieldFormat defFieldFormat = FieldFormat Nothing Nothing Nothing Nothing False "" 'v' @@ -74,7 +76,10 @@   fromDouble :: Double -> e   fromDouble = fromRealFloat +  -- | Division that works for integral types as well as floating points. May throw an exception.+  (//) :: e -> e -> e + -- | Lower the precision dropDown :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b dropDown !e = fromIntegral $ fromIntegral e `div` ((maxBound :: a) `div`@@ -112,8 +117,9 @@ {-# INLINE float2Word32 #-}  -- | Same as:--- λ> fromIntegral (maxBound :: Word32) :: Float+-- >>> fromIntegral (maxBound :: Word32) :: Float -- 4.2949673e9+-- maxWord32 :: Float maxWord32 = F# 4.2949673e9# {-# INLINE maxWord32 #-}@@ -127,10 +133,11 @@     d = maxWord64 * d' {-# INLINE double2Word64 #-} --- | Differs from `fromIntegral` due to: https://gitlab.haskell.org/ghc/ghc/issues/17782+-- | Differs from `fromIntegral` due to: [GHC #17782](https://gitlab.haskell.org/ghc/ghc/issues/17782) ----- λ> fromIntegral (maxBound :: Word64) :: Double+-- >>> fromIntegral (maxBound :: Word64) :: Double -- 1.844674407370955e19+-- maxWord64 :: Double maxWord64 = D# 1.8446744073709552e19## {-# INLINE maxWord64 #-}@@ -165,6 +172,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = toWord8   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}   -- | Values between @[0, 65535]]@@@ -190,6 +199,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = toWord16   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}   -- | Values between @[0, 4294967295]@@@ -215,6 +226,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = toWord32   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}   -- | Values between @[0, 18446744073709551615]@@@ -240,6 +253,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = toWord64   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}  -- | Values between @[0, 18446744073709551615]@ on 64bit instance Elevator Word where@@ -272,6 +287,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = stretch   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}  -- | Values between @[0, 127]@ instance Elevator Int8 where@@ -292,6 +309,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = stretch   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}   -- | Values between @[0, 32767]@@@ -313,6 +332,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = stretch   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}   -- | Values between @[0, 2147483647]@@@ -334,6 +355,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = stretch   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}   -- | Values between @[0, 9223372036854775807]@@@ -355,6 +378,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = stretch   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}   -- | Values between @[0, 9223372036854775807]@ on 64bit@@ -382,13 +407,15 @@   {-# INLINE toRealFloat #-}   fromRealFloat = stretch   {-# INLINE fromRealFloat #-}+  (//) = div+  {-# INLINE (//) #-}   -- | Values between @[0.0, 1.0]@ instance Elevator Float where   maxValue = 1   minValue = 0-  fieldFormat _ = defFieldFormat { fmtWidth = Just 9, fmtPrecision = Just 6, fmtChar = 'f'}+  fieldFormat _ = defFieldFormat { fmtWidth = Just 11, fmtPrecision = Just 8, fmtChar = 'f'}   toWord8 = stretch   {-# INLINE toWord8 #-}   toWord16 = stretch@@ -407,13 +434,15 @@   {-# INLINE toRealFloat #-}   fromRealFloat = uncurry encodeFloat . decodeFloat   {-# INLINE fromRealFloat #-}+  (//) = (/)+  {-# INLINE (//) #-}   -- | Values between @[0.0, 1.0]@ instance Elevator Double where   maxValue = 1   minValue = 0-  fieldFormat _ = defFieldFormat { fmtWidth = Just 15, fmtPrecision = Just 12, fmtChar = 'f' }+  fieldFormat _ = defFieldFormat { fmtWidth = Just 19, fmtPrecision = Just 16, fmtChar = 'f' }   toWord8 = stretch   {-# INLINE toWord8 #-}   toWord16 = stretch@@ -432,6 +461,8 @@   {-# INLINE toRealFloat #-}   fromRealFloat = uncurry encodeFloat . decodeFloat   {-# INLINE fromRealFloat #-}+  (//) = (/)+  {-# INLINE (//) #-}  {-# RULES "toRealFloat   :: Double -> Double / Float -> Float" toRealFloat = id@@ -467,3 +498,5 @@   {-# INLINE toRealFloat #-}   fromRealFloat = (:+ 0) . fromRealFloat   {-# INLINE fromRealFloat #-}+  (//) = (/)+  {-# INLINE (//) #-}

@@ -89,7 +89,7 @@   whitePoint = WhitePoint 0.29903 0.31488   colorTemperature = rectifyColorTemperature 7500 1.4380 --- | @[x=1/3, y=1/3]@ - CIE 1931 2° Observer -+-- | @[x=1\/3, y=1\/3]@ - CIE 1931 2° Observer - -- /https://www.colour-science.org/ instance Illuminant 'E   where   type Temperature 'E = 5454

@@ -71,7 +71,7 @@   whitePoint = WhitePoint 0.29968 0.31740   colorTemperature = I2.rectifyColorTemperature 7500 1.4380 --- | @[x=1/3, y=1/3]@ - CIE 1964 10° Observer -+-- | @[x=1\/3, y=1\/3]@ - CIE 1964 10° Observer - -- /https://www.colour-science.org/ instance Illuminant 'E   where   type Temperature 'E = 5454

@@ -4,7 +4,7 @@ {-# LANGUAGE DataKinds #-} -- | -- Module      : Graphics.Color.Illuminant.ICC.PCS--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -20,9 +20,9 @@ -- white point defined in ICC PCS. Useful for chromatic adaptation. -- -- >>> whitePoint :: WhitePoint D50 Double--- WhitePoint (Chromaticity <CIExyY * D50:( 0.345702914919, 0.358538596680)>)+-- WhitePoint (Chromaticity {chromaticityCIExyY = <CIExyY * D50:( 0.3457029149190000, 0.3585385966800000)>}) -- >>> whitePointTristimulus :: Color (XYZ D50) Float--- <XYZ * D50:( 0.964200, 1.000000, 0.824900)>+-- <XYZ * D50:( 0.96420000, 1.00000000, 0.82490010)> -- >>> colorTemperature :: CCT D50 -- CCT {unCCT = 5003.0} --

@@ -4,7 +4,7 @@ {-# LANGUAGE DataKinds #-} -- | -- Module      : Graphics.Color.Illuminant.ITU.Rec470--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -24,9 +24,9 @@ -- declaration in here. -- -- >>> whitePoint :: WhitePoint C Float--- WhitePoint (Chromaticity <CIExyY * C:( 0.310000, 0.316000)>)+-- WhitePoint (Chromaticity {chromaticityCIExyY = <CIExyY * C:( 0.31000000, 0.31600000)>}) -- >>> whitePointTristimulus :: Color (XYZ C) Float--- <XYZ * C:( 0.981013, 1.000000, 1.183544)>+-- <XYZ * C:( 0.98101264, 1.00000000, 1.18354420)> -- >>> colorTemperature :: CCT C -- CCT {unCCT = 6774.0} --@@ -47,9 +47,9 @@ -- declaration in here. -- -- >>> whitePoint :: WhitePoint D65 Float--- WhitePoint (Chromaticity <CIExyY * D65:( 0.313000, 0.329000)>)+-- WhitePoint (Chromaticity {chromaticityCIExyY = <CIExyY * D65:( 0.31300000, 0.32900000)>}) -- >>> whitePointTristimulus :: Color (XYZ D65) Float--- <XYZ * D65:( 0.951368, 1.000000, 1.088146)>+-- <XYZ * D65:( 0.95136780, 1.00000000, 1.08814610)> -- >>> colorTemperature :: CCT D65 -- CCT {unCCT = 6504.0} --

@@ -4,7 +4,7 @@ {-# LANGUAGE DataKinds #-} -- | -- Module      : Graphics.Color.Illuminant.ITU.Rec601--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -22,9 +22,9 @@ -- `Graphics.Color.Illuminant.ITU.Rec470.D65` specified in Rec.470. -- -- >>> whitePoint :: WhitePoint D65 Float--- WhitePoint (Chromaticity <CIExyY * D65:( 0.312700, 0.329000)>)+-- WhitePoint (Chromaticity {chromaticityCIExyY = <CIExyY * D65:( 0.31270000, 0.32900000)>}) -- >>> whitePointTristimulus :: Color (XYZ D65) Float--- <XYZ * D65:( 0.950456, 1.000000, 1.089058)>+-- <XYZ * D65:( 0.95045596, 1.00000000, 1.08905770)> -- >>> colorTemperature :: CCT D65 -- CCT {unCCT = 6504.0} --

@@ -51,7 +51,7 @@   type Temperature 'D75 = 7504   whitePoint = WhitePoint 0.29902 0.31485 --- | @[x=1/3, y=1/3]@ - 2° Observer - Wikipedia+-- | @[x=1\/3, y=1\/3]@ - 2° Observer - Wikipedia instance Illuminant 'E   where   type Temperature 'E = 5454   whitePoint = WhitePoint (1 / 3) (1 / 3)

@@ -1,6 +1,6 @@ -- | -- Module      : Graphics.Color.Model--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -40,7 +40,7 @@ import Graphics.Color.Model.HSI import Graphics.Color.Model.HSL import Graphics.Color.Model.HSV-import Graphics.Color.Model.Internal+import Graphics.Color.Model.Internal hiding (MVector, Vector) import Graphics.Color.Model.RGB import Graphics.Color.Model.Y import Graphics.Color.Model.YCbCr

@@ -8,7 +8,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Model.CMYK--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -11,7 +11,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module      : Graphics.Color.Model.HSI--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -11,7 +11,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module      : Graphics.Color.Model.HSL--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -11,7 +11,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module      : Graphics.Color.Model.HSV--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -8,7 +8,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module      : Graphics.Color.Model.Internal--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -11,7 +11,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Model.RGB--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -9,7 +9,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Model.Y--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -13,7 +13,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module      : Graphics.Color.Model.YCbCr--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -2,7 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module      : Graphics.Color.Space--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -0,0 +1,107 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module      : Graphics.Color.Space.CIE1931.RGB+-- Copyright   : (c) Alexey Kuleshevich 2018-2020+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Color.Space.CIE1931.RGB+  ( CIERGB+  , primaries+  , castLinearity+  , module Graphics.Color.Space+  ) where++import Data.Coerce+import Data.Typeable+import Foreign.Storable+import Graphics.Color.Model.Internal+import qualified Graphics.Color.Model.RGB as CM+import Graphics.Color.Space+import Graphics.Color.Illuminant.CIE1931+++-- | The original @CIE1931 RGB@ color space with an arbitrary illuminant+data CIERGB (l :: Linearity)++-- | `CIERGB` color space+newtype instance Color (CIERGB l) e = CIERGB (Color CM.RGB e)++-- | `CIERGB` color space+deriving instance Eq e => Eq (Color (CIERGB l) e)+-- | `CIERGB` color space+deriving instance Ord e => Ord (Color (CIERGB l) e)+-- | `CIERGB` color space+deriving instance Functor (Color (CIERGB l))+-- | `CIERGB` color space+deriving instance Applicative (Color (CIERGB l))+-- | `CIERGB` color space+deriving instance Foldable (Color (CIERGB l))+-- | `CIERGB` color space+deriving instance Traversable (Color (CIERGB l))+-- | `CIERGB` color space+deriving instance Storable e => Storable (Color (CIERGB l) e)++-- | `CIERGB` color space+instance (Typeable l, Elevator e) => Show (Color (CIERGB l) e) where+  showsPrec _ = showsColorModel++-- | `CIERGB` color space+instance (Typeable l, Elevator e) => ColorModel (CIERGB l) e where+  type Components (CIERGB l) e = (e, e, e)+  toComponents = toComponents . unColorRGB+  {-# INLINE toComponents #-}+  fromComponents = mkColorRGB . fromComponents+  {-# INLINE fromComponents #-}++-- | `CIERGB` linear color space+instance (Typeable l, Elevator e) => ColorSpace (CIERGB l) 'E e where+  type BaseModel (CIERGB l) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . castLinearity . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat . castLinearity+  {-# INLINE toColorXYZ #-}+  fromColorXYZ xyz = castLinearity (fromRealFloat <$> (xyz2rgbLinear @CIERGB xyz))+  {-# INLINE fromColorXYZ #-}++-- | `CIERGB` color space+instance RedGreenBlue CIERGB 'E where+  gamut = primaries+  ecctf = coerce+  {-# INLINE ecctf #-}+  dcctf = coerce+  {-# INLINE dcctf #-}++-- | CIE RGB does not utilize any gamma function, therefore it is safe to cast the+-- `Linearity` kind.+--+-- @since 0.2.0+castLinearity :: Color (CIERGB l') e -> Color (CIERGB l) e+castLinearity = coerce+++-- | Primaries for CIERGB+--+-- @since 0.2.0+primaries :: RealFloat e => Gamut rgb i e+primaries = Gamut (Primary 0.734742840005998 0.265257159994002)+                  (Primary 0.273779033824958 0.717477700256116)+                  (Primary 0.166555629580280 0.008910726182545)+-- Source ^: https://github.com/colour-science/colour/blob/60679360c3990bc549b5f947bfeb621383e18b5e/colour/models/rgb/datasets/cie_rgb.py#L44-L48

@@ -11,7 +11,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.CIE1976.LAB--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -16,7 +16,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module      : Graphics.Color.Space.Internal--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2018-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -106,7 +106,6 @@  instance ( ColorSpace cs i e          , ColorSpace (BaseSpace cs) i e-         , ColorSpace (Alpha (BaseSpace cs)) i e          , cs ~ Opaque (Alpha cs)          , BaseModel cs ~ Opaque (Alpha (BaseModel cs))          ) =>@@ -130,7 +129,7 @@  -- | This is a data type that encodes a data point on the chromaticity diagram newtype Chromaticity i e =-  Chromaticity (Color (CIExyY i) e)+  Chromaticity { chromaticityCIExyY :: Color (CIExyY i) e }   deriving (Eq, Show)  @@ -152,7 +151,7 @@   newtype WhitePoint (i :: k) e =-  WhitePointChromaticity (Chromaticity i e)+  WhitePointChromaticity { whitePointChromaticity :: Chromaticity i e }   deriving (Eq)  instance (Illuminant i, Elevator e) => Show (WhitePoint (i :: k) e) where@@ -217,8 +216,11 @@ -- Primary -- ------------- -newtype Primary (i :: k) e = PrimaryChromaticity (Chromaticity i e)- deriving (Eq, Show)+newtype Primary (i :: k) e =+  PrimaryChromaticity+    { primaryChromaticity :: Chromaticity i e+    }+  deriving (Eq, Show)   -- | Constructor for the most common @XYZ@ color space

@@ -7,7 +7,6 @@ -- Stability   : experimental -- Portability : non-portable --- module Graphics.Color.Space.RGB   ( -- * Default sRGB color space     pattern ColorSRGB

@@ -11,7 +11,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.AdobeRGB--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -32,6 +32,8 @@   , module Graphics.Color.Space   ) where +import Data.Typeable+import Data.Coerce import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM@@ -43,59 +45,73 @@ -- color space with the default `D65` illuminant -- -- @since 0.1.0-data AdobeRGB+data AdobeRGB (l :: Linearity) -newtype instance Color AdobeRGB e = AdobeRGB (Color CM.RGB e)+newtype instance Color (AdobeRGB l) e = AdobeRGB (Color CM.RGB e)  -- | Constructor for a color in @AdobeRGB@ color space -- -- @since 0.1.0-pattern ColorAdobeRGB :: e -> e -> e -> Color AdobeRGB e+pattern ColorAdobeRGB :: e -> e -> e -> Color (AdobeRGB l) e pattern ColorAdobeRGB r g b = AdobeRGB (CM.ColorRGB r g b) {-# COMPLETE ColorAdobeRGB #-}  -- | Constructor for a color in @AdobeRGB@ color space with alpha channel -- -- @since 0.1.0-pattern ColorAdobeRGBA :: e -> e -> e -> e -> Color (Alpha AdobeRGB) e+pattern ColorAdobeRGBA :: e -> e -> e -> e -> Color (Alpha (AdobeRGB l)) e pattern ColorAdobeRGBA r g b a = Alpha (AdobeRGB (CM.ColorRGB r g b)) a {-# COMPLETE ColorAdobeRGBA #-}  --- | Adobe`RGB` color space-deriving instance Eq e => Eq (Color AdobeRGB e)--- | Adobe`RGB` color space-deriving instance Ord e => Ord (Color AdobeRGB e)--- | Adobe`RGB` color space-deriving instance Functor (Color AdobeRGB)--- | Adobe`RGB` color space-deriving instance Applicative (Color AdobeRGB)--- | Adobe`RGB` color space-deriving instance Foldable (Color AdobeRGB)--- | Adobe`RGB` color space-deriving instance Traversable (Color AdobeRGB)--- | Adobe`RGB` color space-deriving instance Storable e => Storable (Color AdobeRGB e)+-- | `AdobeRGB` color space+deriving instance Eq e => Eq (Color (AdobeRGB l) e)+-- | `AdobeRGB` color space+deriving instance Ord e => Ord (Color (AdobeRGB l) e)+-- | `AdobeRGB` color space+deriving instance Functor (Color (AdobeRGB l))+-- | `AdobeRGB` color space+deriving instance Applicative (Color (AdobeRGB l))+-- | `AdobeRGB` color space+deriving instance Foldable (Color (AdobeRGB l))+-- | `AdobeRGB` color space+deriving instance Traversable (Color (AdobeRGB l))+-- | `AdobeRGB` color space+deriving instance Storable e => Storable (Color (AdobeRGB l) e) --- | Adobe`RGB` color space-instance Elevator e => Show (Color AdobeRGB e) where+-- | `AdobeRGB` color space+instance (Typeable l, Elevator e) => Show (Color (AdobeRGB l) e) where   showsPrec _ = showsColorModel --- | Adobe`RGB` color space-instance Elevator e => ColorModel AdobeRGB e where-  type Components AdobeRGB e = (e, e, e)+-- | `AdobeRGB` color space+instance (Typeable l, Elevator e) => ColorModel (AdobeRGB l) e where+  type Components (AdobeRGB l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-} --- | Adobe`RGB` color space-instance Elevator e => ColorSpace AdobeRGB D65 e where-  type BaseModel AdobeRGB = CM.RGB+-- | `AdobeRGB` linear color space+instance Elevator e => ColorSpace (AdobeRGB 'Linear) D65 e where+  type BaseModel (AdobeRGB 'Linear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id   {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}++-- | `AdobeRGB` color space+instance Elevator e => ColorSpace (AdobeRGB 'NonLinear) D65 e where+  type BaseModel (AdobeRGB 'NonLinear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}   luminance = rgbLuminance . fmap toRealFloat   {-# INLINE luminance #-}   toColorXYZ = rgb2xyz . fmap toRealFloat@@ -103,25 +119,24 @@   fromColorXYZ = fmap fromRealFloat . xyz2rgb   {-# INLINE fromColorXYZ #-} ---- | Adobe`RGB` color space+-- | `AdobeRGB` color space instance RedGreenBlue AdobeRGB D65 where   gamut = primaries   npm = npmStandard   inpm = inpmStandard-  ecctf = fmap transfer+  ecctf = AdobeRGB . fmap transfer . coerce   {-# INLINE ecctf #-}-  dcctf = fmap itransfer+  dcctf = AdobeRGB . fmap itransfer . coerce   {-# INLINE dcctf #-} --- | sRGB normalized primary matrix. This is a helper definition, use `npm` instead.+-- | AdobeRGB normalized primary matrix. This is a helper definition, use `npm` instead. -- -- >>> :set -XDataKinds -- >>> import Graphics.Color.Space.RGB.AdobeRGB -- >>> npmStandard :: NPM AdobeRGB Float--- [ [ 0.576670, 0.185560, 0.188230 ]--- , [ 0.297340, 0.627360, 0.075290 ]--- , [ 0.027030, 0.070690, 0.991340 ] ]+-- [ [ 0.57667000, 0.18556000, 0.18823000 ]+-- , [ 0.29734000, 0.62736000, 0.07529000 ]+-- , [ 0.02703000, 0.07069000, 0.99134000 ] ] -- -- @since 0.1.0 npmStandard :: RealFloat e => NPM AdobeRGB e@@ -130,14 +145,14 @@                          (V3 0.02703 0.07069 0.99134)  --- | sRGB inverse normalized primary matrix. This is a helper definition, use `inpm` instead.+-- | AdobeRGB inverse normalized primary matrix. This is a helper definition, use `inpm` instead. -- -- >>> :set -XDataKinds -- >>> import Graphics.Color.Space.RGB.AdobeRGB -- >>> inpmStandard :: INPM AdobeRGB Float--- [ [ 2.041590,-0.565010,-0.344730 ]--- , [-0.969240, 1.875970, 0.041560 ]--- , [ 0.013440,-0.118360, 1.015170 ] ]+-- [ [ 2.04159000,-0.56501000,-0.34473000 ]+-- , [-0.96924000, 1.87597000, 0.04156000 ]+-- , [ 0.01344000,-0.11836000, 1.01517000 ] ] -- -- @since 0.1.0 inpmStandard :: RealFloat e => INPM AdobeRGB e@@ -170,7 +185,7 @@ itransfer u = u ** 2.19921875 -- in rational form 563/256 {-# INLINE itransfer #-} --- | @sRGB@ primaries+-- | @AdobeRGB@ primaries -- -- @since 0.1.0 primaries :: RealFloat e => Gamut rgb i e

@@ -1,7 +1,7 @@ {-# LANGUAGE PatternSynonyms #-} -- | -- Module      : Graphics.Color.Space.RGB.Alternative--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental

@@ -12,7 +12,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module      : Graphics.Color.Space.RGB.Alternative.CMYK--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -33,7 +33,13 @@ import qualified Graphics.Color.Model.CMYK as CM import Graphics.Color.Model.Internal import Graphics.Color.Space+import Graphics.Color.Space.RGB.AdobeRGB as AdobeRGB+import qualified Graphics.Color.Space.RGB.ITU.Rec470 as Rec470+import Graphics.Color.Space.RGB.ITU.Rec601+import Graphics.Color.Space.RGB.ITU.Rec709+import Graphics.Color.Space.RGB.SRGB + -- | `CMYK` representation for some (@`RedGreenBlue` cs i@) color space data CMYK cs @@ -80,9 +86,89 @@   -- | `CMYK` representation for some (@`RedGreenBlue` cs i@) color space-instance (Typeable cs, ColorSpace cs i e, RedGreenBlue cs i) => ColorSpace (CMYK cs) i e where-  type BaseModel (CMYK cs) = CM.CMYK-  type BaseSpace (CMYK cs) = cs+instance (Typeable cs, ColorSpace (cs i l) i e, RedGreenBlue (cs i) i) =>+         ColorSpace (CMYK (cs i l)) i e where+  type BaseModel (CMYK (cs i l)) = CM.CMYK+  type BaseSpace (CMYK (cs i l)) = cs i l+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.cmyk2rgb . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2cmyk . fmap toDouble . unColorRGB+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}++++-- | `CMYK` representation for `SRGB` color space+instance ColorSpace (SRGB l) D65 e => ColorSpace (CMYK (SRGB l)) D65 e where+  type BaseModel (CMYK (SRGB l)) = CM.CMYK+  type BaseSpace (CMYK (SRGB l)) = SRGB l+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.cmyk2rgb . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2cmyk . fmap toDouble . unColorRGB+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}++-- | `CMYK` representation for `AdobeRGB` color space+instance ColorSpace (AdobeRGB l) D65 e => ColorSpace (CMYK (AdobeRGB l)) D65 e where+  type BaseModel (CMYK (AdobeRGB l)) = CM.CMYK+  type BaseSpace (CMYK (AdobeRGB l)) = AdobeRGB l+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.cmyk2rgb . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2cmyk . fmap toDouble . unColorRGB+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}++-- | `CMYK` representation for `Rec470.BT470_525` color space+instance ColorSpace (Rec470.BT470_525 l) D65 e => ColorSpace (CMYK (Rec470.BT470_525 l)) D65 e where+  type BaseModel (CMYK (Rec470.BT470_525 l)) = CM.CMYK+  type BaseSpace (CMYK (Rec470.BT470_525 l)) = Rec470.BT470_525 l+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.cmyk2rgb . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2cmyk . fmap toDouble . unColorRGB+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}++-- | `CMYK` representation for `Rec470.BT470_625` color space+instance ColorSpace (Rec470.BT470_625 l) D65 e => ColorSpace (CMYK (Rec470.BT470_625 l)) D65 e where+  type BaseModel (CMYK (Rec470.BT470_625 l)) = CM.CMYK+  type BaseSpace (CMYK (Rec470.BT470_625 l)) = Rec470.BT470_625 l+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.cmyk2rgb . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2cmyk . fmap toDouble . unColorRGB+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}++-- | `CMYK` representation for `BT601_525` color space+instance ColorSpace (BT601_525 l) D65 e => ColorSpace (CMYK (BT601_525 l)) D65 e where+  type BaseModel (CMYK (BT601_525 l)) = CM.CMYK+  type BaseSpace (CMYK (BT601_525 l)) = BT601_525 l+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.cmyk2rgb . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2cmyk . fmap toDouble . unColorRGB+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}++-- | `CMYK` representation for `BT601_625` color space+instance ColorSpace (BT601_625 l) D65 e => ColorSpace (CMYK (BT601_625 l)) D65 e where+  type BaseModel (CMYK (BT601_625 l)) = CM.CMYK+  type BaseSpace (CMYK (BT601_625 l)) = BT601_625 l+  toBaseSpace = mkColorRGB . fmap fromDouble . CM.cmyk2rgb . fmap toDouble . coerce+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = coerce . fmap fromDouble . CM.rgb2cmyk . fmap toDouble . unColorRGB+  {-# INLINE fromBaseSpace #-}+  luminance = luminance . toBaseSpace+  {-# INLINE luminance #-}++-- | `CMYK` representation for `BT709` color space+instance ColorSpace (BT709 l) D65 e => ColorSpace (CMYK (BT709 l)) D65 e where+  type BaseModel (CMYK (BT709 l)) = CM.CMYK+  type BaseSpace (CMYK (BT709 l)) = BT709 l   toBaseSpace = mkColorRGB . fmap fromDouble . CM.cmyk2rgb . fmap toDouble . coerce   {-# INLINE toBaseSpace #-}   fromBaseSpace = coerce . fmap fromDouble . CM.rgb2cmyk . fmap toDouble . unColorRGB

@@ -13,7 +13,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module      : Graphics.Color.Space.RGB.Alternative.HSI--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -30,7 +30,6 @@  import Data.Coerce import Data.Proxy-import Data.Typeable import Foreign.Storable import qualified Graphics.Color.Model.HSI as CM import Graphics.Color.Model.Internal@@ -92,9 +91,9 @@   -- | `HSI` representation for some (@`RedGreenBlue` cs i@) color space-instance (Typeable cs, ColorSpace cs i e, RedGreenBlue cs i) => ColorSpace (HSI cs) i e where-  type BaseModel (HSI cs) = CM.HSI-  type BaseSpace (HSI cs) = cs+instance (ColorSpace (cs l) i e, RedGreenBlue cs i) => ColorSpace (HSI (cs l)) i e where+  type BaseModel (HSI (cs l)) = CM.HSI+  type BaseSpace (HSI (cs l)) = cs l   toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsi2rgb . fmap toDouble . coerce   {-# INLINE toBaseSpace #-}   fromBaseSpace = coerce . fmap fromDouble . CM.rgb2hsi . fmap toDouble . unColorRGB

@@ -13,7 +13,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module      : Graphics.Color.Space.RGB.Alternative.HSL--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -30,7 +30,6 @@  import Data.Coerce import Data.Proxy-import Data.Typeable import Foreign.Storable import qualified Graphics.Color.Model.HSL as CM import Graphics.Color.Model.Internal@@ -91,9 +90,9 @@   -- | `HSL` representation for some (@`RedGreenBlue` cs i@) color space-instance (Typeable cs, ColorSpace cs i e, RedGreenBlue cs i) => ColorSpace (HSL cs) i e where-  type BaseModel (HSL cs) = CM.HSL-  type BaseSpace (HSL cs) = cs+instance (ColorSpace (cs l) i e, RedGreenBlue cs i) => ColorSpace (HSL (cs l)) i e where+  type BaseModel (HSL (cs l)) = CM.HSL+  type BaseSpace (HSL (cs l)) = cs l   toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsl2rgb . fmap toDouble . coerce   {-# INLINE toBaseSpace #-}   fromBaseSpace = coerce . fmap fromDouble . CM.rgb2hsl . fmap toDouble . unColorRGB

@@ -13,7 +13,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module      : Graphics.Color.Space.RGB.Alternative.HSV--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -90,9 +90,9 @@   -- | `HSV` representation for some (@`RedGreenBlue` cs i@) color space-instance (ColorSpace cs i e, RedGreenBlue cs i) => ColorSpace (HSV cs) i e where-  type BaseModel (HSV cs) = CM.HSV-  type BaseSpace (HSV cs) = cs+instance (ColorSpace (cs l) i e, RedGreenBlue cs i) => ColorSpace (HSV (cs l)) i e where+  type BaseModel (HSV (cs l)) = CM.HSV+  type BaseSpace (HSV (cs l)) = cs l   toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsv2rgb . fmap toDouble . coerce   {-# INLINE toBaseSpace #-}   fromBaseSpace = coerce . fmap fromDouble . CM.rgb2hsv . fmap toDouble . unColorRGB

@@ -13,7 +13,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module      : Graphics.Color.Space.RGB.Alternative.YCbCr--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -88,9 +88,9 @@   showsColorModelName _ = ("YCbCr-" ++) . showsColorModelName (Proxy :: Proxy (Color cs e))  -- | `YCbCr` representation for `SRGB` color space-instance Elevator e => ColorSpace (YCbCr SRGB) D65 e where-  type BaseModel (YCbCr SRGB) = CM.YCbCr-  type BaseSpace (YCbCr SRGB) = SRGB+instance Elevator e => ColorSpace (YCbCr (SRGB 'NonLinear)) D65 e where+  type BaseModel (YCbCr (SRGB 'NonLinear)) = CM.YCbCr+  type BaseSpace (YCbCr (SRGB 'NonLinear)) = SRGB 'NonLinear   toBaseSpace = fmap fromRealFloat . ycbcr2srgb . fmap toFloat   {-# INLINE toBaseSpace #-}   fromBaseSpace = fmap fromRealFloat . srgb2ycbcr . fmap toFloat@@ -99,9 +99,9 @@   {-# INLINE luminance #-}  -- | `YCbCr` representation for `BT601_525` color space-instance Elevator e => ColorSpace (YCbCr BT601_525) D65 e where-  type BaseModel (YCbCr BT601_525) = CM.YCbCr-  type BaseSpace (YCbCr BT601_525) = BT601_525+instance Elevator e => ColorSpace (YCbCr (BT601_525 'NonLinear)) D65 e where+  type BaseModel (YCbCr (BT601_525 'NonLinear)) = CM.YCbCr+  type BaseSpace (YCbCr (BT601_525 'NonLinear)) = BT601_525 'NonLinear   toBaseSpace = fmap fromDouble . fromColorYCbCr   {-# INLINE toBaseSpace #-}   fromBaseSpace = fmap fromDouble . toColorYCbCr@@ -110,9 +110,9 @@   {-# INLINE luminance #-}  -- | `YCbCr` representation for `BT601_625` color space-instance Elevator e => ColorSpace (YCbCr BT601_625) D65 e where-  type BaseModel (YCbCr BT601_625) = CM.YCbCr-  type BaseSpace (YCbCr BT601_625) = BT601_625+instance Elevator e => ColorSpace (YCbCr (BT601_625 'NonLinear)) D65 e where+  type BaseModel (YCbCr (BT601_625 'NonLinear)) = CM.YCbCr+  type BaseSpace (YCbCr (BT601_625 'NonLinear)) = BT601_625 'NonLinear   toBaseSpace = fmap fromDouble . fromColorYCbCr   {-# INLINE toBaseSpace #-}   fromBaseSpace = fmap fromDouble . toColorYCbCr@@ -121,9 +121,9 @@   {-# INLINE luminance #-}  -- | `YCbCr` representation for `BT709` color space-instance Elevator e => ColorSpace (YCbCr BT709) D65 e where-  type BaseModel (YCbCr BT709) = CM.YCbCr-  type BaseSpace (YCbCr BT709) = BT709+instance Elevator e => ColorSpace (YCbCr (BT709 'NonLinear)) D65 e where+  type BaseModel (YCbCr (BT709 'NonLinear)) = CM.YCbCr+  type BaseSpace (YCbCr (BT709 'NonLinear)) = BT709 'NonLinear   toBaseSpace = fmap fromDouble . fromColorYCbCr   {-# INLINE toBaseSpace #-}   fromBaseSpace = fmap fromDouble . toColorYCbCr@@ -132,10 +132,10 @@   {-# INLINE luminance #-}  -- | `YCbCr` representation for some (@`RedGreenBlue` cs i@) color space-instance (Luma (cs i), ColorSpace (cs i) i e, RedGreenBlue (cs i) i) =>-         ColorSpace (YCbCr (cs i)) i e where-  type BaseModel (YCbCr (cs i)) = CM.YCbCr-  type BaseSpace (YCbCr (cs i)) = cs i+instance (Luma (cs i), ColorSpace (cs i 'NonLinear) i e, RedGreenBlue (cs i) i) =>+         ColorSpace (YCbCr (cs i 'NonLinear)) i e where+  type BaseModel (YCbCr (cs i 'NonLinear)) = CM.YCbCr+  type BaseSpace (YCbCr (cs i 'NonLinear)) = cs i 'NonLinear   toBaseSpace = fmap fromDouble . fromColorYCbCr   {-# INLINE toBaseSpace #-}   fromBaseSpace = fmap fromDouble . toColorYCbCr@@ -147,7 +147,8 @@ -- | This conversion is only correct for sRGB and Rec601. Source: ITU-T Rec. T.871 -- -- @since 0.1.3-ycbcr2srgb :: (RedGreenBlue cs i, RealFloat e) => Color (YCbCr cs) e -> Color cs e+ycbcr2srgb ::+     (RedGreenBlue cs i, RealFloat e) => Color (YCbCr (cs 'NonLinear)) e -> Color (cs 'NonLinear) e ycbcr2srgb (ColorYCbCr y' cb cr) = ColorRGB r' g' b'   where     !cb05 = cb - 0.5@@ -160,7 +161,8 @@ -- | This conversion is only correct for sRGB and Rec601. Source: ITU-T Rec. T.871 -- -- @since 0.1.3-srgb2ycbcr :: (RedGreenBlue cs i, RealFloat e) => Color cs e -> Color (YCbCr cs) e+srgb2ycbcr ::+     (RedGreenBlue cs i, RealFloat e) => Color (cs 'NonLinear) e -> Color (YCbCr (cs 'NonLinear)) e srgb2ycbcr (ColorRGB r' g' b') = ColorYCbCr y' cb cr   where     !y' =          0.299 * r' +    0.587 * g' +    0.114 * b'@@ -173,8 +175,8 @@ -- @since 0.1.3 toColorYCbCr ::      forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)-  => Color cs e'-  -> Color (YCbCr cs) e+  => Color (cs 'NonLinear) e'+  -> Color (YCbCr (cs 'NonLinear)) e toColorYCbCr rgb = YCbCr (CM.rgb2ycbcr (unColorRGB rgb) weights)   where     !weights = rgbLumaWeights rgb@@ -185,8 +187,8 @@ -- @since 0.1.3 fromColorYCbCr ::      forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)-  => Color (YCbCr cs) e'-  -> Color cs e+  => Color (YCbCr (cs 'NonLinear)) e'+  -> Color (cs 'NonLinear) e fromColorYCbCr ycbcr = rgb   where     !rgb = mkColorRGB (CM.ycbcr2rgb (coerce ycbcr :: Color CM.YCbCr e') weights)

@@ -0,0 +1,13 @@+-- |+-- Module      : Graphics.Color.Space.RGB.Derived.CIERGB+-- Copyright   : (c) Alexey Kuleshevich 2020+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Color.Space.RGB.CIERGB+  ( module Graphics.Color.Space.CIE1931.RGB+  ) where++import Graphics.Color.Space.CIE1931.RGB

@@ -11,7 +11,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.Derived.AdobeRGB--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -25,6 +25,8 @@   , module Graphics.Color.Space   ) where +import Data.Coerce+import Data.Typeable import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM@@ -33,41 +35,55 @@   -- | The most common @AdobeRGB@ color space with an arbitrary illuminant-data AdobeRGB (i :: k)+data AdobeRGB (i :: k) (l :: Linearity)  -- | `AdobeRGB` color space (derived)-newtype instance Color (AdobeRGB i) e = AdobeRGB (Color CM.RGB e)+newtype instance Color (AdobeRGB i l) e = AdobeRGB (Color CM.RGB e)  -- | `AdobeRGB` color space (derived)-deriving instance Eq e => Eq (Color (AdobeRGB i) e)+deriving instance Eq e => Eq (Color (AdobeRGB i l) e) -- | `AdobeRGB` color space (derived)-deriving instance Ord e => Ord (Color (AdobeRGB i) e)+deriving instance Ord e => Ord (Color (AdobeRGB i l) e) -- | `AdobeRGB` color space (derived)-deriving instance Functor (Color (AdobeRGB i))+deriving instance Functor (Color (AdobeRGB i l)) -- | `AdobeRGB` color space (derived)-deriving instance Applicative (Color (AdobeRGB i))+deriving instance Applicative (Color (AdobeRGB i l)) -- | `AdobeRGB` color space (derived)-deriving instance Foldable (Color (AdobeRGB i))+deriving instance Foldable (Color (AdobeRGB i l)) -- | `AdobeRGB` color space (derived)-deriving instance Traversable (Color (AdobeRGB i))+deriving instance Traversable (Color (AdobeRGB i l)) -- | `AdobeRGB` color space (derived)-deriving instance Storable e => Storable (Color (AdobeRGB i) e)+deriving instance Storable e => Storable (Color (AdobeRGB i l) e)  -- | `AdobeRGB` color space (derived)-instance (Illuminant i, Elevator e) => Show (Color (AdobeRGB (i :: k)) e) where+instance (Typeable l, Illuminant i, Elevator e) => Show (Color (AdobeRGB (i :: k) l) e) where   showsPrec _ = showsColorModel  -- | `AdobeRGB` color space (derived)-instance (Illuminant i, Elevator e) => ColorModel (AdobeRGB (i :: k)) e where-  type Components (AdobeRGB i) e = (e, e, e)+instance (Typeable l, Illuminant i, Elevator e) => ColorModel (AdobeRGB (i :: k) l) e where+  type Components (AdobeRGB i l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-} +-- | `AdobeRGB` linear color space (derived)+instance (Illuminant i, Elevator e) => ColorSpace (AdobeRGB i 'Linear) i e where+  type BaseModel (AdobeRGB i 'Linear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}+ -- | `AdobeRGB` color space (derived)-instance (Illuminant i, Elevator e) => ColorSpace (AdobeRGB i) i e where-  type BaseModel (AdobeRGB i) = CM.RGB+instance (Illuminant i, Elevator e) => ColorSpace (AdobeRGB i 'NonLinear) i e where+  type BaseModel (AdobeRGB i 'NonLinear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id@@ -82,7 +98,7 @@ -- | `AdobeRGB` color space (derived) instance Illuminant i => RedGreenBlue (AdobeRGB i) i where   gamut = AdobeRGB.primaries-  ecctf = fmap AdobeRGB.transfer+  ecctf = AdobeRGB . fmap AdobeRGB.transfer . coerce   {-# INLINE ecctf #-}-  dcctf = fmap AdobeRGB.itransfer+  dcctf = AdobeRGB . fmap AdobeRGB.itransfer . coerce   {-# INLINE dcctf #-}

@@ -0,0 +1,97 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module      : Graphics.Color.Space.RGB.Derived.CIERGB+-- Copyright   : (c) Alexey Kuleshevich 2018-2020+-- License     : BSD3+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>+-- Stability   : experimental+-- Portability : non-portable+--+module Graphics.Color.Space.RGB.Derived.CIERGB+  ( CIERGB+  , CIERGB.primaries+  , castLinearity+  , module Graphics.Color.Space+  ) where++import Data.Coerce+import Data.Typeable+import Foreign.Storable+import Graphics.Color.Model.Internal+import qualified Graphics.Color.Model.RGB as CM+import Graphics.Color.Space+import qualified Graphics.Color.Space.CIE1931.RGB as CIERGB+++-- | The original @CIE1931 RGB@ color space with an arbitrary illuminant+data CIERGB (i :: k) (l :: Linearity)++-- | `CIERGB` color space (derived)+newtype instance Color (CIERGB i l) e = CIERGB (Color CM.RGB e)++-- | `CIERGB` color space (derived)+deriving instance Eq e => Eq (Color (CIERGB i l) e)+-- | `CIERGB` color space (derived)+deriving instance Ord e => Ord (Color (CIERGB i l) e)+-- | `CIERGB` color space (derived)+deriving instance Functor (Color (CIERGB i l))+-- | `CIERGB` color space (derived)+deriving instance Applicative (Color (CIERGB i l))+-- | `CIERGB` color space (derived)+deriving instance Foldable (Color (CIERGB i l))+-- | `CIERGB` color space (derived)+deriving instance Traversable (Color (CIERGB i l))+-- | `CIERGB` color space (derived)+deriving instance Storable e => Storable (Color (CIERGB i l) e)++-- | `CIERGB` color space (derived)+instance (Typeable l, Illuminant i, Elevator e) => Show (Color (CIERGB (i :: k) l) e) where+  showsPrec _ = showsColorModel++-- | `CIERGB` color space (derived)+instance (Typeable l, Illuminant i, Elevator e) => ColorModel (CIERGB (i :: k) l) e where+  type Components (CIERGB i l) e = (e, e, e)+  toComponents = toComponents . unColorRGB+  {-# INLINE toComponents #-}+  fromComponents = mkColorRGB . fromComponents+  {-# INLINE fromComponents #-}++-- | `CIERGB` linear color space (derived)+instance (Illuminant i, Typeable l, Elevator e) => ColorSpace (CIERGB i l) i e where+  type BaseModel (CIERGB i l) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . castLinearity . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat . castLinearity+  {-# INLINE toColorXYZ #-}+  fromColorXYZ xyz = castLinearity (fromRealFloat <$> (xyz2rgbLinear @(CIERGB i) xyz))+  {-# INLINE fromColorXYZ #-}++-- | `CIERGB` color space (derived)+instance Illuminant i => RedGreenBlue (CIERGB i) i where+  gamut = CIERGB.primaries+  ecctf = coerce+  {-# INLINE ecctf #-}+  dcctf = coerce+  {-# INLINE dcctf #-}++-- | CIE RGB does not utilize any gamma function, therefore it is safe to cast the+-- `Linearity` kind.+--+-- @since 0.2.0+castLinearity :: Color (CIERGB i l') e -> Color (CIERGB i l) e+castLinearity = coerce

@@ -11,7 +11,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.Derived.SRGB--- Copyright   : (c) Alexey Kuleshevich 2018-2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -25,6 +25,8 @@   , module Graphics.Color.Space   ) where +import Data.Coerce+import Data.Typeable import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM@@ -34,41 +36,56 @@   -- | The most common @sRGB@ color space with an arbitrary illuminant-data SRGB (i :: k)+data SRGB (i :: k) (l :: Linearity)  -- | `SRGB` color space (derived)-newtype instance Color (SRGB i) e = SRGB (Color CM.RGB e)+newtype instance Color (SRGB i l) e = SRGB (Color CM.RGB e)  -- | `SRGB` color space (derived)-deriving instance Eq e => Eq (Color (SRGB i) e)+deriving instance Eq e => Eq (Color (SRGB i l) e) -- | `SRGB` color space (derived)-deriving instance Ord e => Ord (Color (SRGB i) e)+deriving instance Ord e => Ord (Color (SRGB i l) e) -- | `SRGB` color space (derived)-deriving instance Functor (Color (SRGB i))+deriving instance Functor (Color (SRGB i l)) -- | `SRGB` color space (derived)-deriving instance Applicative (Color (SRGB i))+deriving instance Applicative (Color (SRGB i l)) -- | `SRGB` color space (derived)-deriving instance Foldable (Color (SRGB i))+deriving instance Foldable (Color (SRGB i l)) -- | `SRGB` color space (derived)-deriving instance Traversable (Color (SRGB i))+deriving instance Traversable (Color (SRGB i l)) -- | `SRGB` color space (derived)-deriving instance Storable e => Storable (Color (SRGB i) e)+deriving instance Storable e => Storable (Color (SRGB i l) e)  -- | `SRGB` color space (derived)-instance (Illuminant i, Elevator e) => Show (Color (SRGB (i :: k)) e) where+instance (Typeable l, Illuminant i, Elevator e) => Show (Color (SRGB (i :: k) l) e) where   showsPrec _ = showsColorModel  -- | `SRGB` color space (derived)-instance (Illuminant i, Elevator e) => ColorModel (SRGB (i :: k)) e where-  type Components (SRGB i) e = (e, e, e)+instance (Typeable l, Illuminant i, Elevator e) => ColorModel (SRGB (i :: k) l) e where+  type Components (SRGB i l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-} +-- | `SRGB` linear color space (derived)+instance (Illuminant i, Elevator e) => ColorSpace (SRGB i 'Linear) i e where+  type BaseModel (SRGB i 'Linear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}++ -- | `SRGB` color space (derived)-instance (Illuminant i, Elevator e) => ColorSpace (SRGB i) i e where-  type BaseModel (SRGB i) = CM.RGB+instance (Illuminant i, Elevator e) => ColorSpace (SRGB i 'NonLinear) i e where+  type BaseModel (SRGB i 'NonLinear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id@@ -83,9 +100,9 @@ -- | `SRGB` color space (derived) instance Illuminant i => RedGreenBlue (SRGB i) i where   gamut = SRGB.primaries-  ecctf = fmap SRGB.transfer+  ecctf = SRGB . fmap SRGB.transfer . coerce   {-# INLINE ecctf #-}-  dcctf = fmap SRGB.itransfer+  dcctf = SRGB . fmap SRGB.itransfer . coerce   {-# INLINE dcctf #-}  

@@ -11,7 +11,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.ITU.Rec470--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -29,6 +29,8 @@   , module Graphics.Color.Space   ) where +import Data.Coerce+import Data.Typeable import Foreign.Storable import qualified Graphics.Color.Model.RGB as CM import Graphics.Color.Space@@ -39,44 +41,58 @@ ------------------------------------  -- | [ITU-R BT.470](https://www.itu.int/rec/R-REC-BT.470) (525) color space. Used in NTSC-data BT470_525+data BT470_525 (l :: Linearity) -newtype instance Color BT470_525 e = BT470_525 (Color CM.RGB e)+newtype instance Color (BT470_525 l) e = BT470_525 (Color CM.RGB e)  -- | ITU-R BT.470 (525) color space-deriving instance Eq e => Eq (Color BT470_525 e)+deriving instance Eq e => Eq (Color (BT470_525 l) e) -- | ITU-R BT.470 (525) color space-deriving instance Ord e => Ord (Color BT470_525 e)+deriving instance Ord e => Ord (Color (BT470_525 l) e) -- | ITU-R BT.470 (525) color space-deriving instance Functor (Color BT470_525)+deriving instance Functor (Color (BT470_525 l)) -- | ITU-R BT.470 (525) color space-deriving instance Applicative (Color BT470_525)+deriving instance Applicative (Color (BT470_525 l)) -- | ITU-R BT.470 (525) color space-deriving instance Foldable (Color BT470_525)+deriving instance Foldable (Color (BT470_525 l)) -- | ITU-R BT.470 (525) color space-deriving instance Traversable (Color BT470_525)+deriving instance Traversable (Color (BT470_525 l)) -- | ITU-R BT.470 (525) color space-deriving instance Storable e => Storable (Color BT470_525 e)+deriving instance Storable e => Storable (Color (BT470_525 l) e)  -- | ITU-R BT.470 (525) color space-instance Elevator e => Show (Color BT470_525 e) where+instance (Typeable l, Elevator e) => Show (Color (BT470_525 l) e) where   showsPrec _ = showsColorModel  -- | ITU-R BT.470 (525) color space-instance Elevator e => ColorModel BT470_525 e where-  type Components BT470_525 e = (e, e, e)+instance (Typeable l, Elevator e) => ColorModel (BT470_525 l) e where+  type Components (BT470_525 l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-}  -- | ITU-R BT.470 (525) color space-instance Elevator e => ColorSpace BT470_525 C e where-  type BaseModel BT470_525 = CM.RGB+instance Elevator e => ColorSpace (BT470_525 'Linear) C e where+  type BaseModel (BT470_525 'Linear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id   {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}++-- | ITU-R BT.470 (525) color space+instance Elevator e => ColorSpace (BT470_525 'NonLinear) C e where+  type BaseModel (BT470_525 'NonLinear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}   luminance = rgbLuminance . fmap toRealFloat   {-# INLINE luminance #-}   toColorXYZ = rgb2xyz . fmap toRealFloat@@ -87,9 +103,9 @@ -- | ITU-R BT.470 (525) color space instance RedGreenBlue BT470_525 C where   gamut = primaries525-  ecctf = fmap (gamma 2.2)+  ecctf c = BT470_525 (fmap (gamma 2.2) (coerce c))   {-# INLINE ecctf #-}-  dcctf = fmap (igamma 2.2)+  dcctf c = BT470_525 (fmap (igamma 2.2) (coerce c))   {-# INLINE dcctf #-}  ------------------------------------@@ -97,44 +113,58 @@ ------------------------------------  -- | [ITU-R BT.470](https://www.itu.int/rec/R-REC-BT.470) (625) color space. Used in PAL/SECAM-data BT470_625+data BT470_625 (l :: Linearity) -newtype instance Color BT470_625 e = BT470_625 (Color CM.RGB e)+newtype instance Color (BT470_625 l) e = BT470_625 (Color CM.RGB e)  -- | ITU-R BT.470 (625) color space-deriving instance Eq e => Eq (Color BT470_625 e)+deriving instance Eq e => Eq (Color (BT470_625 l) e) -- | ITU-R BT.470 (625) color space-deriving instance Ord e => Ord (Color BT470_625 e)+deriving instance Ord e => Ord (Color (BT470_625 l) e) -- | ITU-R BT.470 (625) color space-deriving instance Functor (Color BT470_625)+deriving instance Functor (Color (BT470_625 l)) -- | ITU-R BT.470 (625) color space-deriving instance Applicative (Color BT470_625)+deriving instance Applicative (Color (BT470_625 l)) -- | ITU-R BT.470 (625) color space-deriving instance Foldable (Color BT470_625)+deriving instance Foldable (Color (BT470_625 l)) -- | ITU-R BT.470 (625) color space-deriving instance Traversable (Color BT470_625)+deriving instance Traversable (Color (BT470_625 l)) -- | ITU-R BT.470 (625) color space-deriving instance Storable e => Storable (Color BT470_625 e)+deriving instance Storable e => Storable (Color (BT470_625 l) e)  -- | ITU-R BT.470 (625) color space-instance Elevator e => Show (Color BT470_625 e) where+instance (Typeable l, Elevator e) => Show (Color (BT470_625 l) e) where   showsPrec _ = showsColorModel  -- | ITU-R BT.470 (625) color space-instance Elevator e => ColorModel BT470_625 e where-  type Components BT470_625 e = (e, e, e)+instance (Typeable l, Elevator e) => ColorModel (BT470_625 l) e where+  type Components (BT470_625 l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-}  -- | ITU-R BT.470 (625) color space-instance Elevator e => ColorSpace BT470_625 D65 e where-  type BaseModel BT470_625 = CM.RGB+instance Elevator e => ColorSpace (BT470_625 'Linear) D65 e where+  type BaseModel (BT470_625 'Linear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id   {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}++-- | ITU-R BT.470 (625) color space+instance Elevator e => ColorSpace (BT470_625 'NonLinear) D65 e where+  type BaseModel (BT470_625 'NonLinear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}   luminance = rgbLuminance . fmap toRealFloat   {-# INLINE luminance #-}   toColorXYZ = rgb2xyz . fmap toRealFloat@@ -145,9 +175,9 @@ -- | ITU-R BT.470 (625) color space instance RedGreenBlue BT470_625 D65 where   gamut = primaries625-  ecctf = fmap (gamma 2.8)+  ecctf c = BT470_625 (fmap (gamma 2.8) (coerce c))   {-# INLINE ecctf #-}-  dcctf = fmap (igamma 2.8)+  dcctf c = BT470_625 (fmap (igamma 2.8) (coerce c))   {-# INLINE dcctf #-}  gamma :: Floating a => a -> a -> a

@@ -12,7 +12,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.ITU.Rec601--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -31,13 +31,15 @@   , module Graphics.Color.Space   ) where +import Data.Coerce+import Data.Typeable import Foreign.Storable+import Graphics.Color.Illuminant.ITU.Rec601 import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM import Graphics.Color.Space import Graphics.Color.Space.RGB.ITU.Rec470 (primaries625) import Graphics.Color.Space.RGB.Luma-import Graphics.Color.Illuminant.ITU.Rec601   @@ -46,44 +48,59 @@ ------------------------------------  -- | [ITU-R BT.601](https://en.wikipedia.org/wiki/Rec._601) (525) color space-data BT601_525+data BT601_525 (l :: Linearity) -newtype instance Color BT601_525 e = BT601_525 (Color CM.RGB e)+newtype instance Color (BT601_525 l) e = BT601_525 (Color CM.RGB e)  -- | ITU-R BT.601 (525) color space-deriving instance Eq e => Eq (Color BT601_525 e)+deriving instance Eq e => Eq (Color (BT601_525 l) e) -- | ITU-R BT.601 (525) color space-deriving instance Ord e => Ord (Color BT601_525 e)+deriving instance Ord e => Ord (Color (BT601_525 l) e) -- | ITU-R BT.601 (525) color space-deriving instance Functor (Color BT601_525)+deriving instance Functor (Color (BT601_525 l)) -- | ITU-R BT.601 (525) color space-deriving instance Applicative (Color BT601_525)+deriving instance Applicative (Color (BT601_525 l)) -- | ITU-R BT.601 (525) color space-deriving instance Foldable (Color BT601_525)+deriving instance Foldable (Color (BT601_525 l)) -- | ITU-R BT.601 (525) color space-deriving instance Traversable (Color BT601_525)+deriving instance Traversable (Color (BT601_525 l)) -- | ITU-R BT.601 (525) color space-deriving instance Storable e => Storable (Color BT601_525 e)+deriving instance Storable e => Storable (Color (BT601_525 l) e)  -- | ITU-R BT.601 (525) color space-instance Elevator e => Show (Color BT601_525 e) where+instance  (Typeable l, Elevator e) => Show (Color (BT601_525 l) e) where   showsPrec _ = showsColorModel  -- | ITU-R BT.601 (525) color space-instance Elevator e => ColorModel BT601_525 e where-  type Components BT601_525 e = (e, e, e)+instance  (Typeable l, Elevator e) => ColorModel (BT601_525 l) e where+  type Components (BT601_525 l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-} --- | ITU-R BT.601 (525) color space-instance Elevator e => ColorSpace BT601_525 D65 e where-  type BaseModel BT601_525 = CM.RGB+-- | ITU-R BT.601 (525) linear color space+instance Elevator e => ColorSpace (BT601_525 'Linear) D65 e where+  type BaseModel (BT601_525 'Linear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id   {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}+++-- | ITU-R BT.601 (525) linear color space+instance Elevator e => ColorSpace (BT601_525 'NonLinear) D65 e where+  type BaseModel (BT601_525 'NonLinear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}   luminance = rgbLuminance . fmap toRealFloat   {-# INLINE luminance #-}   toColorXYZ = rgb2xyz . fmap toRealFloat@@ -94,9 +111,9 @@ -- | ITU-R BT.601 (525) color space instance RedGreenBlue BT601_525 D65 where   gamut = primaries525-  ecctf = fmap transfer+  ecctf = BT601_525 . fmap transfer . coerce   {-# INLINE ecctf #-}-  dcctf = fmap itransfer+  dcctf = BT601_525 . fmap itransfer . coerce   {-# INLINE dcctf #-}  ------------------------------------@@ -104,40 +121,54 @@ ------------------------------------  -- | [ITU-R BT.601](https://en.wikipedia.org/wiki/Rec._601) (625) color space-data BT601_625+data BT601_625 (l :: Linearity) -newtype instance Color BT601_625 e = BT601_625 (Color CM.RGB e)+newtype instance Color (BT601_625 l) e = BT601_625 (Color CM.RGB e)  -- | ITU-R BT.601 (625) color space-deriving instance Eq e => Eq (Color BT601_625 e)+deriving instance Eq e => Eq (Color (BT601_625 l) e) -- | ITU-R BT.601 (625) color space-deriving instance Ord e => Ord (Color BT601_625 e)+deriving instance Ord e => Ord (Color (BT601_625 l) e) -- | ITU-R BT.601 (625) color space-deriving instance Functor (Color BT601_625)+deriving instance Functor (Color (BT601_625 l)) -- | ITU-R BT.601 (625) color space-deriving instance Applicative (Color BT601_625)+deriving instance Applicative (Color (BT601_625 l)) -- | ITU-R BT.601 (625) color space-deriving instance Foldable (Color BT601_625)+deriving instance Foldable (Color (BT601_625 l)) -- | ITU-R BT.601 (625) color space-deriving instance Traversable (Color BT601_625)+deriving instance Traversable (Color (BT601_625 l)) -- | ITU-R BT.601 (625) color space-deriving instance Storable e => Storable (Color BT601_625 e)+deriving instance Storable e => Storable (Color (BT601_625 l) e)  -- | ITU-R BT.601 (625) color space-instance Elevator e => Show (Color BT601_625 e) where+instance (Typeable l, Elevator e) => Show (Color (BT601_625 l) e) where   showsPrec _ = showsColorModel  -- | ITU-R BT.601 (625) color space-instance Elevator e => ColorModel BT601_625 e where-  type Components BT601_625 e = (e, e, e)+instance (Typeable l, Elevator e) => ColorModel (BT601_625 l) e where+  type Components (BT601_625 l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-} +-- | ITU-R BT.601 (625) linear color space+instance Elevator e => ColorSpace (BT601_625 'Linear) D65 e where+  type BaseModel (BT601_625 'Linear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}+ -- | ITU-R BT.601 (625) color space-instance Elevator e => ColorSpace BT601_625 D65 e where-  type BaseModel BT601_625 = CM.RGB+instance Elevator e => ColorSpace (BT601_625 'NonLinear) D65 e where+  type BaseModel (BT601_625 'NonLinear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id@@ -152,9 +183,9 @@ -- | ITU-R BT.601 (625) color space instance RedGreenBlue BT601_625 D65 where   gamut = primaries625-  ecctf = fmap transfer+  ecctf = BT601_625 . fmap transfer . coerce   {-# INLINE ecctf #-}-  dcctf = fmap itransfer+  dcctf = BT601_625 . fmap itransfer . coerce   {-# INLINE dcctf #-}  instance Luma BT601_525 where

@@ -11,7 +11,7 @@ {-# LANGUAGE TypeFamilies #-} -- | -- Module      : Graphics.Color.Space.RGB.ITU.Rec709--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -27,6 +27,8 @@   , module Graphics.Color.Space   ) where +import Data.Coerce+import Data.Typeable import Foreign.Storable import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM@@ -35,40 +37,54 @@ import Graphics.Color.Space.RGB.Luma  -- | [ITU-R BT.709](https://en.wikipedia.org/wiki/Rec._709) color space-data BT709+data BT709 (l :: Linearity) -newtype instance Color BT709 e = BT709 (Color CM.RGB e)+newtype instance Color (BT709 l) e = BT709 (Color CM.RGB e)  -- | ITU-R BT.709 color space-deriving instance Eq e => Eq (Color BT709 e)+deriving instance Eq e => Eq (Color (BT709 l) e) -- | ITU-R BT.709 color space-deriving instance Ord e => Ord (Color BT709 e)+deriving instance Ord e => Ord (Color (BT709 l) e) -- | ITU-R BT.709 color space-deriving instance Functor (Color BT709)+deriving instance Functor (Color (BT709 l)) -- | ITU-R BT.709 color space-deriving instance Applicative (Color BT709)+deriving instance Applicative (Color (BT709 l)) -- | ITU-R BT.709 color space-deriving instance Foldable (Color BT709)+deriving instance Foldable (Color (BT709 l)) -- | ITU-R BT.709 color space-deriving instance Traversable (Color BT709)+deriving instance Traversable (Color (BT709 l)) -- | ITU-R BT.709 color space-deriving instance Storable e => Storable (Color BT709 e)+deriving instance Storable e => Storable (Color (BT709 l) e)  -- | ITU-R BT.709 color space-instance Elevator e => Show (Color BT709 e) where+instance (Typeable l, Elevator e) => Show (Color (BT709 l) e) where   showsPrec _ = showsColorModel  -- | ITU-R BT.709 color space-instance Elevator e => ColorModel BT709 e where-  type Components BT709 e = (e, e, e)+instance (Typeable l, Elevator e) => ColorModel (BT709 l) e where+  type Components (BT709 l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-} +-- | ITU-R BT.709 linear color space+instance Elevator e => ColorSpace (BT709 'Linear) D65 e where+  type BaseModel (BT709 'Linear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}+ -- | ITU-R BT.709 color space-instance Elevator e => ColorSpace BT709 D65 e where-  type BaseModel BT709 = CM.RGB+instance Elevator e => ColorSpace (BT709 'NonLinear) D65 e where+  type BaseModel (BT709 'NonLinear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id@@ -83,9 +99,9 @@ -- | ITU-R BT.709 color space instance RedGreenBlue BT709 D65 where   gamut = primaries-  ecctf = fmap Rec601.transfer+  ecctf = BT709 . fmap Rec601.transfer . coerce   {-# INLINE ecctf #-}-  dcctf = fmap Rec601.itransfer+  dcctf = BT709 . fmap Rec601.itransfer . coerce   {-# INLINE dcctf #-}  

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-}@@ -8,6 +9,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-}@@ -15,7 +17,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module      : Graphics.Color.Space.RGB.Internal--- Copyright   : (c) Alexey Kuleshevich 2019+-- Copyright   : (c) Alexey Kuleshevich 2019-2020 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -25,10 +27,14 @@   ( pattern ColorRGB   , pattern ColorRGBA   , RedGreenBlue(..)+  , Linearity(..)   , Gamut(..)   , rgb2xyz+  , rgbLinear2xyz   , xyz2rgb+  , xyz2rgbLinear   , rgbLuminance+  , rgbLinearLuminance   , NPM(..)   , npmApply   , npmDerive@@ -45,42 +51,44 @@ import Graphics.Color.Algebra import qualified Graphics.Color.Model.RGB as CM import Graphics.Color.Space.Internal+import Data.Kind +data Linearity = Linear | NonLinear -class Illuminant i => RedGreenBlue cs (i :: k) | cs -> i where+class Illuminant i => RedGreenBlue (cs :: Linearity -> Type) (i :: k) | cs -> i where   -- | RGB primaries that are defined for the RGB color space, while point is defined by   -- the __@i@__ type parameter   gamut :: RealFloat e => Gamut cs i e    -- | Encoding color component transfer function (inverse). Also known as opto-electronic   -- transfer function (OETF / OECF) or gamma function.-  ecctf :: (RealFloat a, Elevator a) => Color cs a -> Color cs a+  ecctf :: (RealFloat a, Elevator a) => Color (cs 'Linear) a -> Color (cs 'NonLinear) a    -- | Decoding color component transfer function (forward)-  dcctf :: (RealFloat a, Elevator a) => Color cs a -> Color cs a+  dcctf :: (RealFloat a, Elevator a) => Color (cs 'NonLinear) a -> Color (cs 'Linear) a    -- | Normalized primary matrix for this RGB color space. Default implementation derives   -- it from `chromaticity`-  npm :: (ColorSpace cs i a, RealFloat a) => NPM cs a+  npm :: (ColorSpace (cs 'Linear) i a, RealFloat a) => NPM cs a   npm = npmDerive gamut   {-# INLINE npm #-}    -- | Inverse normalized primary matrix for this RGB color space. Default implementation   -- derives it from `chromaticity`-  inpm :: (ColorSpace cs i a, RealFloat a) => INPM cs a+  inpm :: (ColorSpace (cs 'Linear) i a, RealFloat a) => INPM cs a   inpm = inpmDerive gamut   {-# INLINE inpm #-}    -- | Lift RGB color model into a RGB color space-  mkColorRGB :: Color CM.RGB e -> Color cs e+  mkColorRGB :: Color CM.RGB e -> Color (cs l) e   default mkColorRGB ::-    Coercible (Color CM.RGB e) (Color cs e) => Color CM.RGB e -> Color cs e+    Coercible (Color CM.RGB e) (Color (cs l) e) => Color CM.RGB e -> Color (cs l) e   mkColorRGB = coerce    -- | Drop RGB color space down to the RGB color model-  unColorRGB :: Color cs e -> Color CM.RGB e+  unColorRGB :: Color (cs l) e -> Color CM.RGB e   default unColorRGB ::-    Coercible (Color cs e) (Color CM.RGB e) => Color cs e -> Color CM.RGB e+    Coercible (Color (cs l) e) (Color CM.RGB e) => Color (cs l) e -> Color CM.RGB e   unColorRGB = coerce  @@ -90,8 +98,16 @@   , gamutBluePrimary  :: !(Primary i e)   } deriving instance Eq e => Eq (Gamut cs i e)-deriving instance ColorSpace cs i e => Show (Gamut cs i e) -- TODO: better show with whitepoint +instance (RealFloat e, Elevator e, Illuminant i) => Show (Gamut cs i e) where+  show Gamut {..} =+    unlines+      [ "Gamut:"+      , "  Red:   " <> show (primaryChromaticity gamutRedPrimary)+      , "  Green: " <> show (primaryChromaticity gamutGreenPrimary)+      , "  Blue:  " <> show (primaryChromaticity gamutBluePrimary)+      ]+ -- | Get the `WhitePoint` of chromaticity. `Chromaticity` itself isn't actually evaluated, -- its type carries enough information for this operation. --@@ -113,30 +129,35 @@ -- >>> import Graphics.Color.Illuminant.CIE1931 -- >>> import Graphics.Color.Space.RGB.Derived.SRGB -- >>> :{--- srgbFromLinear :: Color (SRGB 'D65) Float -> Color (XYZ 'D65) Float+-- srgbFromLinear :: Color (SRGB 'D65 'Linear) Float -> Color (XYZ 'D65) Float -- srgbFromLinear = npmApply npm' --   where npm' = trace "Evaluated only once!!!" npm :: NPM (SRGB 'D65) Float -- :} -- -- >>> srgbFromLinear $ ColorRGB 0.1 0.2 0.3 -- <XYZ CIE1931 'D65:(Evaluated only once!!!---  0.166888, 0.185953, 0.310856)>+--  0.16688849, 0.18595251, 0.31085595)> -- >>> srgbFromLinear $ ColorRGB 0.1 0.2 0.3--- <XYZ CIE1931 'D65:( 0.166888, 0.185953, 0.310856)>--- >>> rgb = ColorRGB 0.1 0.2 0.3 :: Color (SRGB 'D65) Float+-- <XYZ CIE1931 'D65:( 0.16688849, 0.18595251, 0.31085595)>+-- >>> rgb = ColorRGB 0.1 0.2 0.3 :: Color (SRGB 'D65 'Linear) Float -- >>> npmApply npm rgb :: Color (XYZ 'D65) Float--- <XYZ CIE1931 'D65:( 0.166888, 0.185953, 0.310856)>+-- <XYZ CIE1931 'D65:( 0.16688849, 0.18595251, 0.31085595)> -- -- Here is a comparison with a non-liner sRGB conversion: --+-- >>> rgb = ColorRGB 0.1 0.2 0.3 :: Color (SRGB 'D65 'NonLinear) Float -- >>> npmApply npm (dcctf rgb) :: Color (XYZ 'D65) Float {- non-linear transformation -}--- <XYZ CIE1931 'D65:( 0.029186, 0.031093, 0.073737)>+-- <XYZ CIE1931 'D65:( 0.02918611, 0.03109305, 0.07373714)> -- >>> toColorXYZ rgb :: Color (XYZ 'D65) Float           {- non-linear transformation -}--- <XYZ CIE1931 'D65:( 0.029186, 0.031093, 0.073737)>+-- <XYZ CIE1931 'D65:( 0.02918611, 0.03109305, 0.07373714)> -- -- -- @since 0.1.0-npmApply :: (RedGreenBlue cs i, Elevator e) => NPM cs e -> Color cs e -> Color (XYZ i) e+npmApply ::+     (RedGreenBlue cs i, Elevator e)+  => NPM cs e+  -> Color (cs 'Linear) e+  -> Color (XYZ i) e npmApply (NPM npm') = coerce . multM3x3byV3 npm' . coerce . unColorRGB {-# INLINE npmApply #-} @@ -144,43 +165,69 @@ -- -- @since 0.1.0 inpmApply ::-     (RedGreenBlue cs i, Elevator e) => INPM cs e -> Color (XYZ i) e -> Color cs e+     (RedGreenBlue cs i, Elevator e)+  => INPM cs e+  -> Color (XYZ i) e+  -> Color (cs 'Linear) e inpmApply (INPM inpm') = mkColorRGB . coerce . multM3x3byV3 inpm' . coerce {-# INLINE inpmApply #-}  -- | Linear transformation of a color into a linear luminance, i.e. the Y component of -- XYZ color space-npmApplyLuminance ::-     forall cs i e. (RedGreenBlue cs i, ColorSpace cs i e, RealFloat e)-  => Color cs e+rgbLinearLuminance ::+     forall cs i e. (RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e)+  => Color (cs 'Linear) e   -> Color (Y i) e-npmApplyLuminance px = Y (m3x3row1 (unNPM (npm :: NPM cs e)) `dotProduct` coerce (unColorRGB px))-{-# INLINE npmApplyLuminance #-}+rgbLinearLuminance px =+  Y (m3x3row1 (unNPM (npm :: NPM cs e)) `dotProduct` coerce (unColorRGB px))+{-# INLINE rgbLinearLuminance #-}  -rgbLuminance :: (RedGreenBlue cs i, ColorSpace cs i e, RealFloat e) => Color cs e -> Color (Y i) e-rgbLuminance = npmApplyLuminance . dcctf+rgbLuminance ::+     (RedGreenBlue cs i, ColorSpace (cs 'Linear) i e, RealFloat e)+  => Color (cs 'NonLinear) e+  -> Color (Y i) e+rgbLuminance = rgbLinearLuminance . dcctf {-# INLINE rgbLuminance #-} -rgb2xyz :: (RedGreenBlue cs i, ColorSpace cs i e, RealFloat e) => Color cs e -> Color (XYZ i) e+rgb2xyz ::+     (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e, ColorSpace (cs 'Linear) i e, RealFloat e)+  => Color (cs 'NonLinear) e+  -> Color (XYZ i) e rgb2xyz = npmApply npm . dcctf {-# INLINE rgb2xyz #-}  xyz2rgb ::-     (RedGreenBlue cs i, ColorSpace cs i e, RealFloat e)+     (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e, ColorSpace (cs 'Linear) i e, RealFloat e)   => Color (XYZ i) e-  -> Color cs e+  -> Color (cs 'NonLinear) e xyz2rgb = ecctf . inpmApply inpm {-# INLINE xyz2rgb #-} ++rgbLinear2xyz ::+     (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e, ColorSpace (cs 'Linear) i e, RealFloat e)+  => Color (cs 'Linear) e+  -> Color (XYZ i) e+rgbLinear2xyz = npmApply npm+{-# INLINE rgbLinear2xyz #-}++xyz2rgbLinear ::+     forall cs i e.+     (RedGreenBlue cs i, ColorSpace (cs 'NonLinear) i e, ColorSpace (cs 'Linear) i e, RealFloat e)+  => Color (XYZ i) e+  -> Color (cs 'Linear) e+xyz2rgbLinear = inpmApply inpm+{-# INLINE xyz2rgbLinear #-}+ -- | Constructor for an RGB color space.-pattern ColorRGB :: RedGreenBlue cs i => e -> e -> e -> Color cs e+pattern ColorRGB :: RedGreenBlue cs i => e -> e -> e -> Color (cs l) e pattern ColorRGB r g b <- (unColorRGB -> CM.ColorRGB r g b) where         ColorRGB r g b = mkColorRGB (CM.ColorRGB r g b) {-# COMPLETE ColorRGB #-}  -- | Constructor for an RGB color space with Alpha channel-pattern ColorRGBA :: RedGreenBlue cs i => e -> e -> e -> e -> Color (Alpha cs) e+pattern ColorRGBA :: RedGreenBlue cs i => e -> e -> e -> e -> Color (Alpha (cs l)) e pattern ColorRGBA r g b a <- Alpha (unColorRGB -> CM.ColorRGB r g b) a where         ColorRGBA r g b a = Alpha (mkColorRGB (CM.ColorRGB r g b)) a {-# COMPLETE ColorRGBA #-}@@ -219,7 +266,7 @@   { unNPM :: M3x3 e   } deriving (Eq, Functor, Applicative, Foldable, Traversable) -instance ColorSpace cs i e => Show (NPM cs e) where+instance Elevator e => Show (NPM cs e) where   show = show . unNPM  -- | Inverse normalized primary matrix (iNPM), which is used to tranform linear@@ -239,7 +286,7 @@ -- -- @since 0.1.0 npmDerive ::-     forall cs i e. (ColorSpace cs i e, RealFloat e)+     forall cs i e. (ColorSpace (cs 'Linear) i e, RealFloat e)   => Gamut cs i e   -> NPM cs e npmDerive (Gamut r g b) = NPM (primaries' * M3x3 coeff coeff coeff)@@ -258,7 +305,7 @@ -- -- @since 0.1.0 inpmDerive ::-     forall cs i e. (ColorSpace cs i e, RealFloat e)+     forall cs i e. (ColorSpace (cs 'Linear) i e, RealFloat e)   => Gamut cs i e   -> INPM cs e inpmDerive = INPM . invertM3x3 . unNPM . npmDerive@@ -270,7 +317,7 @@ -- evaluated, its type carries enough information for this operation. -- -- @since 0.1.0-rgbColorGamut :: (RedGreenBlue cs i, RealFloat e) => Color cs a -> Gamut cs i e+rgbColorGamut :: (RedGreenBlue cs i, RealFloat e) => Color (cs l) a -> Gamut cs i e rgbColorGamut _ = gamut {-# INLINE rgbColorGamut #-} @@ -281,14 +328,12 @@ -- >>> import Graphics.Color.Space.RGB -- >>> :set -XTypeApplications -- >>> pixelWhitePoint @Float (ColorSRGB @Word8 1 2 3)--- WhitePoint (Chromaticity <CIExyY * D65:( 0.312700, 0.329000)>)--- >>> Just (pixelWhitePoint @Float (ColorSRGB @Word8 1 2 3))--- Just (WhitePoint (Chromaticity <CIExyY * D65:( 0.312700, 0.329000)>))+-- WhitePoint (Chromaticity {chromaticityCIExyY = <CIExyY * D65:( 0.31270000, 0.32900000)>}) -- -- @since 0.1.0 pixelWhitePoint ::-     forall e cs a i. (RedGreenBlue cs i, RealFloat e)-  => Color cs a+     forall e cs a i l. (RedGreenBlue cs i, RealFloat e)+  => Color (cs l) a   -> WhitePoint i e pixelWhitePoint _ = whitePoint {-# INLINE pixelWhitePoint #-}

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-}@@ -31,6 +32,7 @@   , rgbLumaWeights   ) where +import Data.Kind import Data.Coerce import Foreign.Storable import Graphics.Color.Model.RGB as CM@@ -96,7 +98,7 @@ -- Luma Weights -- ------------------ -class Luma cs where+class Luma (cs :: Linearity -> Type) where   {-# MINIMAL (rWeight, gWeight)|(rWeight, bWeight)|(gWeight, bWeight) #-}   rWeight :: RealFloat e => Weight cs e   rWeight = 1 - bWeight - gWeight@@ -119,7 +121,7 @@ -- @since 0.1.4 rgbLumaWeights ::      forall cs e' e. (Luma cs, RealFloat e)-  => Color cs e'+  => Color (cs 'NonLinear) e'   -> Weights e rgbLumaWeights _ =   Weights (V3 (coerce (rWeight :: Weight cs e) :: e)@@ -132,7 +134,7 @@ -- @since 0.1.0 rgbLuma ::      forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)-  => Color cs e'+  => Color (cs 'NonLinear) e'   -> Color Y' e rgbLuma rgb' = Y' (coerce (fmap toRealFloat rgb :: Color CM.RGB e) `dotProduct` coerce weights)   where

@@ -32,71 +32,88 @@   , itransfer   ) where +import Data.Coerce+import Data.Typeable import Foreign.Storable+import Graphics.Color.Illuminant.ICC.PCS (D50) import Graphics.Color.Model.Internal import qualified Graphics.Color.Model.RGB as CM import Graphics.Color.Space.Internal import Graphics.Color.Space.RGB.Internal-import Graphics.Color.Space.RGB.Luma-import Graphics.Color.Illuminant.ICC.PCS (D50) import Graphics.Color.Space.RGB.ITU.Rec709 (D65, primaries)+import Graphics.Color.Space.RGB.Luma  -- | The most common [sRGB](https://en.wikipedia.org/wiki/SRGB) color space with the -- default `D65` illuminant-data SRGB+data SRGB (l :: Linearity)  -newtype instance Color SRGB e = SRGB (Color CM.RGB e)+newtype instance Color (SRGB l) e = SRGB (Color CM.RGB e)  -- | Constructor for a color in @sRGB@ color space -- -- @since 0.1.0-pattern ColorSRGB :: e -> e -> e -> Color SRGB e+pattern ColorSRGB :: e -> e -> e -> Color (SRGB l) e pattern ColorSRGB r g b = SRGB (CM.ColorRGB r g b) {-# COMPLETE ColorSRGB #-}  -- | Constructor for a color in @sRGB@ color space with alphs channel -- -- @since 0.1.0-pattern ColorSRGBA :: e -> e -> e -> e -> Color (Alpha SRGB) e+pattern ColorSRGBA :: e -> e -> e -> e -> Color (Alpha (SRGB l)) e pattern ColorSRGBA r g b a = Alpha (SRGB (CM.ColorRGB r g b)) a {-# COMPLETE ColorSRGBA #-}  --- | s`RGB` color space-deriving instance Eq e => Eq (Color SRGB e)--- | s`RGB` color space-deriving instance Ord e => Ord (Color SRGB e)--- | s`RGB` color space-deriving instance Functor (Color SRGB)--- | s`RGB` color space-deriving instance Applicative (Color SRGB)--- | s`RGB` color space-deriving instance Foldable (Color SRGB)--- | s`RGB` color space-deriving instance Traversable (Color SRGB)--- | s`RGB` color space-deriving instance Storable e => Storable (Color SRGB e)+-- | `SRGB` color space+deriving instance Eq e => Eq (Color (SRGB l) e)+-- | `SRGB` color space+deriving instance Ord e => Ord (Color (SRGB l) e)+-- | `SRGB` color space+deriving instance Functor (Color (SRGB l))+-- | `SRGB` color space+deriving instance Applicative (Color (SRGB l))+-- | `SRGB` color space+deriving instance Foldable (Color (SRGB l))+-- | `SRGB` color space+deriving instance Traversable (Color (SRGB l))+-- | `SRGB` color space+deriving instance Storable e => Storable (Color (SRGB l) e) --- | s`RGB` color space-instance Elevator e => Show (Color SRGB e) where+-- | `SRGB` color space+instance (Typeable l, Elevator e) => Show (Color (SRGB l) e) where   showsPrec _ = showsColorModel --- | s`RGB` color space-instance Elevator e => ColorModel SRGB e where-  type Components SRGB e = (e, e, e)+-- | `SRGB` color space+instance (Typeable l, Elevator e) => ColorModel (SRGB l) e where+  type Components (SRGB l) e = (e, e, e)   toComponents = toComponents . unColorRGB   {-# INLINE toComponents #-}   fromComponents = mkColorRGB . fromComponents   {-# INLINE fromComponents #-} --- | s`RGB` color space-instance Elevator e => ColorSpace SRGB D65 e where-  type BaseModel SRGB = CM.RGB+-- | `SRGB` linear color space+instance Elevator e => ColorSpace (SRGB 'Linear) D65 e where+  type BaseModel (SRGB 'Linear) = CM.RGB   toBaseSpace = id   {-# INLINE toBaseSpace #-}   fromBaseSpace = id   {-# INLINE fromBaseSpace #-}+  luminance = rgbLinearLuminance . fmap toRealFloat+  {-# INLINE luminance #-}+  toColorXYZ = rgbLinear2xyz . fmap toRealFloat+  {-# INLINE toColorXYZ #-}+  fromColorXYZ = fmap fromRealFloat . xyz2rgbLinear+  {-# INLINE fromColorXYZ #-}+++-- | `SRGB` linear color space+instance Elevator e => ColorSpace (SRGB 'NonLinear) D65 e where+  type BaseModel (SRGB 'NonLinear) = CM.RGB+  toBaseSpace = id+  {-# INLINE toBaseSpace #-}+  fromBaseSpace = id+  {-# INLINE fromBaseSpace #-}   luminance = rgbLuminance . fmap toRealFloat   {-# INLINE luminance #-}   toColorXYZ = rgb2xyz . fmap toRealFloat@@ -104,14 +121,14 @@   fromColorXYZ = fmap fromRealFloat . xyz2rgb   {-# INLINE fromColorXYZ #-} --- | s`RGB` color space+-- | `SRGB` color space instance RedGreenBlue SRGB D65 where   gamut = primaries   npm = npmStandard   inpm = inpmStandard-  ecctf = fmap transfer+  ecctf = SRGB . fmap transfer . coerce   {-# INLINE ecctf #-}-  dcctf = fmap itransfer+  dcctf = SRGB . fmap itransfer . coerce   {-# INLINE dcctf #-}  instance Luma SRGB where@@ -125,9 +142,9 @@ -- >>> :set -XDataKinds -- >>> import Graphics.Color.Space.RGB -- >>> npmStandard :: NPM SRGB Float--- [ [ 0.412400, 0.357600, 0.180500 ]--- , [ 0.212600, 0.715200, 0.072200 ]--- , [ 0.019300, 0.119200, 0.950500 ] ]+-- [ [ 0.41240000, 0.35760000, 0.18050000 ]+-- , [ 0.21260000, 0.71520000, 0.07220000 ]+-- , [ 0.01930000, 0.11920000, 0.95050000 ] ] -- -- @since 0.1.0 npmStandard :: RealFloat a => NPM SRGB a@@ -141,9 +158,9 @@ -- >>> :set -XDataKinds -- >>> import Graphics.Color.Space.RGB -- >>> inpmStandard :: INPM SRGB Float--- [ [ 3.240600,-1.537200,-0.498600 ]--- , [-0.968900, 1.875800, 0.041500 ]--- , [ 0.055700,-0.204000, 1.057000 ] ]+-- [ [ 3.24060000,-1.53720000,-0.49860000 ]+-- , [-0.96890000, 1.87580000, 0.04150000 ]+-- , [ 0.05570000,-0.20400000, 1.05700000 ] ] -- -- @since 0.1.0 inpmStandard :: RealFloat a => INPM SRGB a

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}@@ -39,6 +40,8 @@   , toPixelF   , toPixelD   -- * RGB+  , toPixelLinearRGB+  , fromPixelLinearRGB   -- ** sRGB color space   , pattern PixelSRGB   , pattern PixelSRGBA@@ -69,12 +72,13 @@  -- | Convert a pixel from one color space to any other. --+-- >>> :set -XDataKinds -- >>> :set -XTypeApplications -- >>> px = PixelSRGB @Float 0.0 0.5 1.0 -- >>> px--- <SRGB:( 0.000000, 0.500000, 1.000000)>--- >>> convertPixel @AdobeRGB @_ @Word8 px--- <AdobeRGB:( 71,127,251)>+-- <SRGB 'NonLinear:( 0.00000000, 0.50000000, 1.00000000)>+-- >>> convertPixel @(AdobeRGB 'NonLinear) @_ @Word8 px+-- <AdobeRGB 'NonLinear:( 71,127,251)> -- -- @since 0.1.0 convertPixel ::@@ -87,14 +91,14 @@ -- | Constructor for a pixel in @sRGB@ color space -- -- @since 0.1.0-pattern PixelSRGB :: e -> e -> e -> Pixel SRGB e+pattern PixelSRGB :: e -> e -> e -> Pixel (SRGB 'NonLinear) e pattern PixelSRGB r g b = Pixel (SRGB (CM.ColorRGB r g b)) {-# COMPLETE PixelSRGB #-}  -- | Constructor for a pixel in @sRGB@ color space with Alpha channel -- -- @since 0.1.0-pattern PixelSRGBA :: e -> e -> e -> e -> Pixel (Alpha SRGB) e+pattern PixelSRGBA :: e -> e -> e -> e -> Pixel (Alpha (SRGB 'NonLinear)) e pattern PixelSRGBA r g b a = Pixel (Alpha (SRGB (CM.ColorRGB r g b)) a) {-# COMPLETE PixelSRGBA #-} @@ -130,7 +134,7 @@ -- | Constructor for a pixel in RGB color space. -- -- @since 0.1.0-pattern PixelRGB :: RedGreenBlue cs (i :: k) => e -> e -> e -> Pixel cs e+pattern PixelRGB :: RedGreenBlue cs (i :: k) => e -> e -> e -> Pixel (cs l) e pattern PixelRGB r g b <- (coerce . unColorRGB . coerce -> V3 r g b) where         PixelRGB r g b = coerce (mkColorRGB (coerce (V3 r g b))) {-# COMPLETE PixelRGB #-}@@ -191,7 +195,7 @@ -- | Constructor for a pixel in RGB color space with Alpha channel -- -- @since 0.1.0-pattern PixelRGBA :: RedGreenBlue cs i => e -> e -> e -> e -> Pixel (Alpha cs) e+pattern PixelRGBA :: RedGreenBlue cs i => e -> e -> e -> e -> Pixel (Alpha (cs l)) e pattern PixelRGBA r g b a <- (pixelColor -> Alpha (unColorRGB -> CM.ColorRGB r g b) a) where         PixelRGBA r g b a = Pixel (Alpha (mkColorRGB (CM.ColorRGB r g b)) a) {-# COMPLETE PixelRGBA #-}@@ -235,12 +239,28 @@ pattern PixelYCbCrA y cb cr a = Pixel (ColorYCbCrA y cb cr a) {-# COMPLETE PixelYCbCrA #-} +-- | Convert non-linear RGB color space into linear one+--+-- @since 0.2.0+toPixelLinearRGB ::+     (RedGreenBlue cs i, Elevator e, RealFloat e) => Pixel (cs 'NonLinear) e -> Pixel (cs 'Linear) e+toPixelLinearRGB = liftPixel dcctf+{-# INLINE toPixelLinearRGB #-}++-- | Convert linear RGB color space into a non-linear one+--+-- @since 0.2.0+fromPixelLinearRGB ::+     (RedGreenBlue cs i, Elevator e, RealFloat e) => Pixel (cs 'Linear) e -> Pixel (cs 'NonLinear) e+fromPixelLinearRGB = liftPixel ecctf+{-# INLINE fromPixelLinearRGB #-}+ -- | Convert an RGB pixel to `Y'` if it has the weights specified with `Luma`. -- -- @since 0.1.4 rgbPixelLuma ::      forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e)-  => Pixel cs e'+  => Pixel (cs 'NonLinear) e'   -> Pixel Y' e rgbPixelLuma = liftPixel rgbLuma 

@@ -33,6 +33,7 @@ import qualified Data.Vector.Generic as V import qualified Data.Vector.Generic.Mutable as VM import qualified Data.Vector.Unboxed as VU+import Data.Default.Class (Default)  -- | Digital imaging is one of the most common places for a color to be used in. The -- smallest element in any image is a pixel, which is defined by its color.@@ -57,6 +58,7 @@ deriving instance Foldable (Color cs) => Foldable (Pixel cs) deriving instance Traversable (Color cs) => Traversable (Pixel cs) deriving instance Storable (Color cs e) => Storable (Pixel cs e)+deriving instance Default (Color cs e) => Default (Pixel cs e) instance Show (Color cs e) => Show (Pixel cs e) where   show = show . pixelColor 

@@ -0,0 +1,20 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Graphics.Color.Space.CIE1931.RGBSpec (spec) where++import Graphics.Color.Space.CIE1931.RGB+import Graphics.Color.Space.Common++instance (Elevator e, Random e) => Arbitrary (Color (CIERGB l) e) where+  arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator++spec :: Spec+spec = describe "RGB" $ do+  colorModelSpec @(CIERGB 'NonLinear) @Word "CIERGB 'NonLinear"+  colorSpaceSpec @(CIERGB 'NonLinear) @Float+  colorModelSpec @(CIERGB 'Linear) @Int "CIERGB 'Linear"+  colorSpaceSpec @(CIERGB 'Linear) @Double

@@ -28,9 +28,9 @@     prop "lab2srgb" $ \lab@(ColorLAB l' a' b' :: Color (LAB 'W.D65) Double) ->       case Colour.toSRGB (Colour.cieLAB Colour.d65 l' a' b') of         Colour.RGB r g b ->-          (convertColor lab :: Color (SRGB 'W.D65) Double)+          (convertColor lab :: Color (SRGB 'W.D65 'NonLinear) Double)           `epsilonEqColorDouble` ColorRGB r g b-    prop "srgb2xlab" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65) Double) ->+    prop "srgb2xlab" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65 'NonLinear) Double) ->       case Colour.cieLABView Colour.d65 (Colour.sRGB r g b) of         (l', a', b') ->           convertColor rgb `epsilonEqColorDouble` (ColorLAB l' a' b' :: Color (LAB 'W.D65) Double)

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-} module Graphics.Color.Space.RGB.AdobeRGBSpec (spec, arbitraryElevator) where@@ -5,11 +6,12 @@ import Graphics.Color.Space.Common import Graphics.Color.Space.RGB.AdobeRGB -instance (Elevator e, Random e) => Arbitrary (Color AdobeRGB e) where+instance (Elevator e, Random e) => Arbitrary (Color (AdobeRGB l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = describe "AdobeRGB" $ do-  colorModelSpec @AdobeRGB @Word "AdobeRGB"-  colorSpaceLenientSpec @AdobeRGB @Float 0.00001+  colorModelSpec @(AdobeRGB 'NonLinear) @Word "AdobeRGB 'NonLinear"+  colorSpaceLenientSpec @(AdobeRGB 'NonLinear) @Float 0.00001+  colorSpaceLenientSpec @(AdobeRGB 'Linear) @Double 0.00001

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -18,9 +19,9 @@ spec :: Spec spec =   describe "CMYK" $ do-    colorModelSpec @(CMYK (Derived.SRGB D65)) @Word "CMYK"-    colorSpaceCommonSpec @(CMYK (Derived.SRGB D65)) @Double $ pure ()+    colorModelSpec @(CMYK (Derived.SRGB D65 'NonLinear)) @Word "CMYK"+    colorSpaceCommonSpec @(CMYK (Derived.SRGB D65 'NonLinear)) @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)+    prop "sRGBtoCMYK" $ \ (srgb :: Color (Derived.SRGB D65 'NonLinear) Double) ->+      toBaseSpace (fromBaseSpace srgb :: Color (CMYK (Derived.SRGB D65 'NonLinear)) Double)       `epsilonEqColor` srgb

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-} module Graphics.Color.Space.RGB.Alternative.HSISpec (spec) where@@ -17,5 +18,5 @@ spec =   describe "HSI" $ do     describe "Derived-sRGB" $ do-      colorModelSpec @(HSI (Derived.SRGB D65)) @Word "HSI"-      colorSpaceSpec @(HSI (Derived.SRGB D65)) @Double+      colorModelSpec @(HSI (Derived.SRGB D65 'NonLinear)) @Word "HSI"+      colorSpaceSpec @(HSI (Derived.SRGB D65 'NonLinear)) @Double

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-} module Graphics.Color.Space.RGB.Alternative.HSLSpec (spec) where@@ -17,5 +18,5 @@ spec =   describe "HSL" $ do     describe "Derived-sRGB" $ do-      colorModelSpec @(HSL (Derived.SRGB D65)) @Word "HSL"-      colorSpaceSpec @(HSL (Derived.SRGB D65)) @Double+      colorModelSpec @(HSL (Derived.SRGB D65 'NonLinear)) @Word "HSL"+      colorSpaceSpec @(HSL (Derived.SRGB D65 'NonLinear)) @Double

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-} module Graphics.Color.Space.RGB.Alternative.HSVSpec (spec) where@@ -17,5 +18,7 @@ spec =   describe "HSV" $ do     describe "Derived-sRGB" $ do-      colorModelSpec @(HSV (Derived.SRGB D65)) @Word "HSV"-      colorSpaceSpec @(HSV (Derived.SRGB D65)) @Double+      colorModelSpec @(HSV (Derived.SRGB D65 'NonLinear)) @Word "HSV"+      colorSpaceSpec @(HSV (Derived.SRGB D65 'NonLinear)) @Double+      colorModelSpec @(HSV (Derived.SRGB D65 'Linear)) @Int "HSV"+      colorSpaceSpec @(HSV (Derived.SRGB D65 'Linear)) @Float

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -23,26 +24,26 @@ spec =   describe "YCbCr" $ do     describe "sRGB" $ do-      colorModelSpec @(YCbCr SRGB) @Word "YCbCr"-      colorSpaceCommonSpec @(YCbCr SRGB) @Double $ pure ()+      colorModelSpec @(YCbCr (SRGB 'NonLinear)) @Word "YCbCr"+      colorSpaceCommonSpec @(YCbCr (SRGB 'NonLinear)) @Double $ pure ()     describe "Derived-sRGB" $ do-      colorModelSpec @(YCbCr (Derived.SRGB D65)) @Word "YCbCr"-      colorSpaceCommonSpec @(YCbCr (Derived.SRGB D65)) @Double $ pure ()-    prop "toColorYCbCr . toColorYCbCr" $ \(rgb :: Color (Derived.SRGB D65) Double) ->+      colorModelSpec @(YCbCr (Derived.SRGB D65 'NonLinear)) @Word "YCbCr"+      colorSpaceCommonSpec @(YCbCr (Derived.SRGB D65 'NonLinear)) @Double $ pure ()+    prop "toColorYCbCr . toColorYCbCr" $ \(rgb :: Color (Derived.SRGB D65 'NonLinear) Double) ->       rgb `epsilonEqColor`-      fromColorYCbCr (toColorYCbCr rgb :: Color (YCbCr (Derived.SRGB D65)) Double)-    prop "toColorYCbCr == srgb2ycbcr" $ \(rgb :: Color SRGB Double) ->+      fromColorYCbCr (toColorYCbCr rgb :: Color (YCbCr (Derived.SRGB D65 'NonLinear)) Double)+    prop "toColorYCbCr == srgb2ycbcr" $ \(rgb :: Color (SRGB 'NonLinear) Double) ->       srgb2ycbcr rgb `epsilonEqColor`-      (toColorYCbCr rgb :: Color (YCbCr SRGB) Double)-    prop "fromColorYCbCr == ycbcr2srgb" $ \(ycbcr :: Color (YCbCr SRGB) Double) ->-      ycbcr2srgb ycbcr `epsilonEqColor` (fromColorYCbCr ycbcr :: Color SRGB Double)+      (toColorYCbCr rgb :: Color (YCbCr (SRGB 'NonLinear)) Double)+    prop "fromColorYCbCr == ycbcr2srgb" $ \(ycbcr :: Color (YCbCr (SRGB 'NonLinear)) Double) ->+      ycbcr2srgb ycbcr `epsilonEqColor` (fromColorYCbCr ycbcr :: Color (SRGB 'NonLinear) Double)     describe "Match JuicyPixels" $ do-      prop "rgb2ycbcr" $ \(rgb@(ColorRGB r g b) :: Color SRGB Word8) ->+      prop "rgb2ycbcr" $ \(rgb@(ColorRGB r g b) :: Color (SRGB 'NonLinear) Word8) ->         case JuicyPixels.convertPixel (JuicyPixels.PixelRGB8 r g b) of           JuicyPixels.PixelYCbCr8 y cb cr ->-            (fromBaseSpace rgb :: Color (YCbCr SRGB) Word8)+            (fromBaseSpace rgb :: Color (YCbCr (SRGB 'NonLinear)) Word8)             `approxIntegralColorExpect1` ColorYCbCr y cb cr-      prop "ycbcr2rgb" $ \(ycbcr@(ColorYCbCr y cb cr) :: Color (YCbCr SRGB) Word8) ->+      prop "ycbcr2rgb" $ \(ycbcr@(ColorYCbCr y cb cr) :: Color (YCbCr (SRGB 'NonLinear)) Word8) ->         case JuicyPixels.convertPixel (JuicyPixels.PixelYCbCr8 y cb cr) of           JuicyPixels.PixelRGB8 r g b ->             (toBaseSpace ycbcr) `approxIntegralColorExpect1` ColorRGB r g b

@@ -10,11 +10,13 @@ import Graphics.Color.Space.Common import Graphics.Color.Space.RGB.Derived.AdobeRGB -instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (AdobeRGB (i :: k)) e) where+instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (AdobeRGB (i :: k) l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = describe "AdobeRGB" $ do-  colorModelSpec @(AdobeRGB 'D65) @Word "AdobeRGB"-  colorSpaceSpec @(AdobeRGB 'D65) @Float+  colorModelSpec @(AdobeRGB 'D65 'NonLinear) @Word "AdobeRGB CIE1931 'D65 'NonLinear"+  colorSpaceSpec @(AdobeRGB 'D65 'NonLinear) @Float+  colorModelSpec @(AdobeRGB 'D50 'Linear) @Int "AdobeRGB CIE1931 'D50 'Linear"+  colorSpaceSpec @(AdobeRGB 'D50 'Linear) @Double

@@ -0,0 +1,21 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Graphics.Color.Space.RGB.Derived.CIERGBSpec (spec) where++import Graphics.Color.Illuminant.CIE1931+import Graphics.Color.Space.RGB.Derived.CIERGB+import Graphics.Color.Space.Common++instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (CIERGB (i :: k) l) e) where+  arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator++spec :: Spec+spec = describe "RGB" $ do+  colorModelSpec @(CIERGB 'E 'NonLinear) @Word "CIERGB CIE1931 'E 'NonLinear"+  colorSpaceSpec @(CIERGB 'E 'NonLinear) @Float+  colorModelSpec @(CIERGB 'D75 'Linear) @Int "CIERGB CIE1931 'D75 'Linear"+  colorSpaceSpec @(CIERGB 'D75 'Linear) @Double

@@ -14,29 +14,33 @@ import Graphics.Color.Space.Common import Graphics.Color.Space.RGB.Derived.SRGB -instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (SRGB (i :: k)) e) where+instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (SRGB (i :: k) l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = describe "SRGB" $ do-  colorModelSpec @(SRGB 'D65) @Word "SRGB"-  colorSpaceSpec @(SRGB 'D65) @Float+  colorModelSpec @(SRGB 'D65 'NonLinear) @Word "SRGB CIE1931 'D65 'NonLinear"+  colorSpaceSpec @(SRGB 'D65 'NonLinear) @Float+  colorModelSpec @(SRGB 'D55 'Linear) @Int "SRGB CIE1931 'D55 'Linear"+  colorSpaceSpec @(SRGB 'D55 'Linear) @Double   describe "Same as colour package" $ do     prop "xyz2srgb" $ \xyz@(ColorXYZ x y z :: Color (XYZ 'W.D65) Double) ->       case Colour.toSRGB (Colour.cieXYZ x y z) of         Colour.RGB r g b ->-          (fromColorXYZ xyz :: Color (SRGB 'W.D65) Double) `epsilonEqColorDouble` ColorRGB r g b-    prop "xyz2linearsrgb" $ \xyz@(ColorXYZ x y z :: Color (XYZ 'W.D65) Double) ->+          (fromColorXYZ xyz :: Color (SRGB 'W.D65 'NonLinear) Double)+          `epsilonEqColorDouble`+          ColorRGB r g b+    prop "xyz2linearsrgb" $ \xyz@(ColorXYZ x y z :: Color (XYZ 'W.D65 ) Double) ->       case Colour.toRGB (Colour.cieXYZ x y z) of         Colour.RGB r g b ->-          dcctf (fromColorXYZ xyz :: Color (SRGB 'W.D65) Double) `epsilonEqColorDouble`+          dcctf (fromColorXYZ xyz :: Color (SRGB 'W.D65 'NonLinear) Double) `epsilonEqColorDouble`           ColorRGB r g b-    prop "srgb2xyz" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65) Double) ->+    prop "srgb2xyz" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65 'NonLinear) Double) ->       case Colour.cieXYZView (Colour.sRGB r g b) of         (x, y, z) ->           toColorXYZ rgb `epsilonEqColorDouble` ColorXYZ x y z-    prop "linersrgb2xyz" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65) Double) ->+    prop "linersrgb2xyz" $ \rgb@(ColorRGB r g b :: Color (SRGB 'W.D65 'Linear) Double) ->       case Colour.cieXYZView (Colour.rgb r g b) of         (x, y, z) ->           toColorXYZ (ecctf rgb) `epsilonEqColorDouble` ColorXYZ x y z

@@ -7,18 +7,22 @@ import Graphics.Color.Space.Common import Graphics.Color.Space.RGB.ITU.Rec470 -instance (Elevator e, Random e) => Arbitrary (Color BT470_525 e) where+instance (Elevator e, Random e) => Arbitrary (Color (BT470_525 l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator -instance (Elevator e, Random e) => Arbitrary (Color BT470_625 e) where+instance (Elevator e, Random e) => Arbitrary (Color (BT470_625 l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = do   describe "Rec470 (525)" $ do-    colorModelSpec @BT470_525 @Word "BT470_525"-    colorSpaceSpec @BT470_525 @Float+    colorModelSpec @(BT470_525 'NonLinear) @Word "BT470_525 'NonLinear"+    colorSpaceSpec @(BT470_525 'NonLinear) @Float+    colorModelSpec @(BT470_525 'Linear) @Word8 "BT470_525 'Linear"+    colorSpaceSpec @(BT470_525 'Linear) @Double   describe "Rec470 (625)" $ do-    colorModelSpec @BT470_625 @Word "BT470_625"-    colorSpaceSpec @BT470_625 @Float+    colorModelSpec @(BT470_625 'NonLinear) @Word "BT470_625 'NonLinear"+    colorSpaceSpec @(BT470_625 'NonLinear) @Float+    colorModelSpec @(BT470_625 'Linear) @Word16 "BT470_625 'Linear"+    colorSpaceSpec @(BT470_625 'Linear) @Double

@@ -7,18 +7,20 @@ import Graphics.Color.Space.Common import Graphics.Color.Space.RGB.ITU.Rec601 -instance (Elevator e, Random e) => Arbitrary (Color BT601_525 e) where+instance (Elevator e, Random e) => Arbitrary (Color (BT601_525 l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator -instance (Elevator e, Random e) => Arbitrary (Color BT601_625 e) where+instance (Elevator e, Random e) => Arbitrary (Color (BT601_625 l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = do   describe "Rec601 (525)" $ do-    colorModelSpec @BT601_525 @Word "BT601_525"-    colorSpaceSpec @BT601_525 @Float+    colorModelSpec @(BT601_525 'NonLinear) @Word "BT601_525"+    colorSpaceSpec @(BT601_525 'NonLinear) @Float+    colorSpaceSpec @(BT601_525 'Linear) @Double   describe "Rec601 (625)" $ do-    colorModelSpec @BT601_625 @Word "BT601_625"-    colorSpaceSpec @BT601_625 @Float+    colorModelSpec @(BT601_625 'NonLinear) @Word "BT601_625"+    colorSpaceSpec @(BT601_625 'NonLinear) @Float+    colorSpaceSpec @(BT601_625 'Linear) @Double

@@ -7,12 +7,13 @@ import Graphics.Color.Space.Common import Graphics.Color.Space.RGB.ITU.Rec709 -instance (Elevator e, Random e) => Arbitrary (Color BT709 e) where+instance (Elevator e, Random e) => Arbitrary (Color (BT709 l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = describe "Rec709" $ do-  colorModelSpec @BT709 @Word "BT709"+  colorModelSpec @(BT709 'NonLinear) @Word "BT709"   -- Roundrtrip is not always very accurate, eg: 8.115324539550295e-2 /= 8.140132075907752e-2-  colorSpaceLenientSpec @BT709 @Float 5e-4+  colorSpaceLenientSpec @(BT709 'NonLinear) @Float 5e-4+  colorSpaceLenientSpec @(BT709 'Linear) @Double 5e-4

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-} module Graphics.Color.Space.RGB.SRGBSpec (spec, arbitraryElevator) where@@ -5,11 +6,13 @@ import Graphics.Color.Space.Common import Graphics.Color.Space.RGB.SRGB -instance (Elevator e, Random e) => Arbitrary (Color SRGB e) where+instance (Elevator e, Random e) => Arbitrary (Color (SRGB l) e) where   arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator   spec :: Spec spec = describe "SRGB" $ do-  colorModelSpec @SRGB @Word "SRGB"-  colorSpaceLenientSpec @SRGB @Float 0.001+  colorModelSpec @(SRGB 'NonLinear) @Word "SRGB 'NonLinear"+  colorSpaceLenientSpec @(SRGB 'NonLinear) @Float 0.001+  colorModelSpec @(SRGB 'Linear) @Word "SRGB 'Linear"+  colorSpaceLenientSpec @(SRGB 'Linear) @Double 0.001

@@ -1178,7 +1178,10 @@   ]  -ralAlternatives :: [(Color SRGB Word8, Color (HSL SRGB) Float, Color (CMYK SRGB) Word8)]+ralAlternatives ::+     [( Color (SRGB 'NonLinear) Word8+      , Color (HSL (SRGB 'NonLinear)) Float+      , Color (CMYK (SRGB 'NonLinear)) Word8)] ralAlternatives =   [ (ColorRGB r g b, ColorH360SL h (s / 100) (l / 100), ColorCMYK c m y k)   | (_y', r, g, b, h, s, l, c, m, y, k) <- ralAlternativeRaw@@ -1402,7 +1405,7 @@       , (122.57, 121, 123, 123, 0.50, 0.82, 47.84, 2, 0, 0, 52)       ] -_hexes :: [Color SRGB Word8]+_hexes :: [Color (SRGB 'NonLinear) Word8] _hexes =   [ fromIntegral <$>   fromComponents (shiftR (x .&. 0xFF0000) 16, shiftR (x .&. 0xFF00) 8, x .&. 0xFF)

@@ -1,10 +1,11 @@ module Main where  import Spec-import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)+import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8) import Test.Hspec  main :: IO () main = do   hSetBuffering stdout LineBuffering+  hSetEncoding stdout utf8   hspec spec

@@ -1,12 +1,6 @@ module Main where -import Build_doctests (flags, pkgs, module_sources)-import Data.Foldable (traverse_) import Test.DocTest (doctest)  main :: IO ()-main = do-    traverse_ putStrLn args-    doctest args-  where-    args = flags ++ pkgs ++ module_sources+main = doctest ["src"]