Apply luma

.github/workflows/haskell.yml

@@ -209,7 +209,7 @@ jobs:
       if: steps.install-doctest.outcome == 'success'
       run: |
         set -ex
-        cabal repl Color --build-depends=QuickCheck --build-depends=JuicyPixels --build-depends=QuickCheck --with-compiler=doctest --repl-options='-w -Wdefault'
+        ./scripts/doctest.sh
 
     - name: Check Cabal Files
       run: |

Color/CHANGELOG.md

@@ -1,5 +1,14 @@
 # Changelog for Color
 
+## 0.4.0
+
+* Addition of `DIN99` color space.
+* Scale `L*a*b*` color space to `[0, 1]` range from the more common `[0, 100]` for
+  consistency.
+* Addition of: `toGrayscale`, `applyGrayscale` and `replaceGrayscale`.
+* Addition of: `ChannelCount`, `channelCount`, `channelNames` and `channelColors`
+* Remove `RealFloat` constraint from `ColorSpace` for `Y'`
+
 ## 0.3.3
 
 Addition of `SVG` colors

Color/Color.cabal

@@ -1,13 +1,13 @@
 name:                Color
-version:             0.3.3
+version:             0.4.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
 license:             BSD3
 license-file:        LICENSE
 author:              Alexey Kuleshevich
 maintainer:          alexey@kuleshevi.ch
-copyright:           2019-2021 Alexey Kuleshevich
+copyright:           2019-2025 Alexey Kuleshevich
 category:            Graphics
 extra-source-files:  README.md
                    , CHANGELOG.md
@@ -182,6 +182,19 @@ benchmark conversion
                      , random
   default-language:    Haskell2010
 
+benchmark ycbcr
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      bench
+  main-is:             YCbCr.hs
+  ghc-options:         -Wall
+                       -threaded
+                       -O2
+  build-depends:       base
+                     , criterion
+                     , Color
+                     , deepseq
+  default-language:    Haskell2010
+
 source-repository head
   type:     git
   location: https://github.com/lehins/Color

Color/LICENSE

@@ -1,4 +1,4 @@
-Copyright Alexey Kuleshevich (c) 2019-2020
+Copyright Alexey Kuleshevich (c) 2019-2025
 
 All rights reserved.
 

Color/README.md

@@ -38,6 +38,7 @@ Currently supported:
   * `Y'` - luma
   * `CIE XYZ`
   * `CIE L*a*b*`
+  * `DIN99`
   * `RGB`:
 
     * `sRGB` - both standardized and derived

Color/bench/YCbCr.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+
+import Criterion.Main
+import Control.DeepSeq
+import qualified Graphics.Color.Model as CM
+import Graphics.Color.Space
+import Graphics.Color.Space.RGB.ITU.Rec601
+import Graphics.Color.Space.RGB.ITU.Rec709
+import Data.Coerce
+
+main :: IO ()
+main = do
+  defaultMain
+    [ bgroup
+        "toYCbCr"
+        [ toYCbCrBench (CM.ColorRGB 0.1 0.2 0.3 :: Color CM.RGB Float) "Float"
+        , toYCbCrBench (CM.ColorRGB 0.1 0.2 0.3 :: Color CM.RGB Double) "Double"
+        ]
+    , bgroup
+        "fromYCbCr"
+        [ fromYCbCrBench (CM.ColorYCbCr 0.1 0.2 0.3 :: Color CM.YCbCr Float) "Float"
+        , fromYCbCrBench (CM.ColorYCbCr 0.1 0.2 0.3 :: Color CM.YCbCr Double) "Double"
+        ]
+    ]
+
+
+toYCbCrBench ::
+     forall e. (Elevator e, NFData e)
+  => Color CM.RGB e
+  -> String
+  -> Benchmark
+toYCbCrBench rgb tyName =
+  bgroup
+    tyName
+    [ bgroup
+        "Standard"
+        [ bench "SRGB" $
+          nf (fromBaseSpace :: Color (SRGB 'NonLinear) e -> Color (Y'CbCr SRGB) e) (mkColorRGB rgb)
+        , bench "Rec601" $
+          nf
+            (fromBaseSpace :: Color (BT601_625 'NonLinear) e -> Color (Y'CbCr BT601_625) e)
+            (mkColorRGB rgb)
+        , bench "Rec709" $
+          nf (fromBaseSpace :: Color (BT709 'NonLinear) e -> Color (Y'CbCr BT709) e) (mkColorRGB rgb)
+        ]
+    ]
+
+fromYCbCrBench ::
+     forall e. (Elevator e, NFData e)
+  => Color CM.YCbCr e
+  -> String
+  -> Benchmark
+fromYCbCrBench ycbcr tyName =
+  bgroup
+    tyName
+    [ bgroup
+        "Standard"
+        [ bench "SRGB" $
+          nf (toBaseSpace :: Color (Y'CbCr SRGB) e -> Color (SRGB 'NonLinear) e) (coerce ycbcr)
+        , bench "Rec601" $
+          nf
+            (toBaseSpace :: Color (Y'CbCr BT601_625) e -> Color (BT601_625 'NonLinear) e)
+            (coerce ycbcr)
+        , bench "Rec709" $
+          nf (toBaseSpace :: Color (Y'CbCr BT709) e -> Color (BT709 'NonLinear) e) (coerce ycbcr)
+        ]
+    ]

Color/src/Graphics/Color/Adaptation.hs

@@ -1,6 +1,6 @@
 -- |
 -- Module      : Graphics.Color.Adaptation
--- Copyright   : (c) Alexey Kuleshevich 2019-2020
+-- Copyright   : (c) Alexey Kuleshevich 2019-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental

Color/src/Graphics/Color/Adaptation/Internal.hs

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

Color/src/Graphics/Color/Adaptation/VonKries.hs

@@ -14,7 +14,7 @@
 #endif
 -- |
 -- Module      : Graphics.Color.Adaptation.VonKries
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental

Color/src/Graphics/Color/Algebra.hs

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

Color/src/Graphics/Color/Algebra/Binary.hs

@@ -8,7 +8,7 @@
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Color.Algebra.Binary
--- Copyright   : (c) Alexey Kuleshevich 2018-2020
+-- Copyright   : (c) Alexey Kuleshevich 2018-2025
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -31,7 +31,7 @@ import qualified Data.Vector.Unboxed as U
 import Foreign.Storable
 import Graphics.Color.Algebra.Elevator
 import Prelude hiding (map)
-
+import Data.Coerce
 
 -- | Under the hood, binary pixels are backed by `Word8`, but can only take
 -- values of @0@ or @1@. Use `zero`\/`one` to construct a bit and `on`\/`off` to
@@ -43,35 +43,32 @@ instance Show Bit where
   show (Bit 0) = "0"
   show _       = "1"
 
+cf :: (Word8 -> Word8) -> Bit -> Bit
+cf = coerce
+
+cf2 :: (Word8 -> Word8 -> Word8) -> Bit -> Bit -> Bit
+cf2 = coerce
 
 instance Bits Bit where
-  (Bit 0) .&. _       = Bit 0
-  (Bit 1) .&. (Bit 1) = Bit 1
-  _       .&. (Bit 0) = Bit 0
-  _       .&. _       = Bit 1
+  (.&.) = cf2 (.&.)
   {-# INLINE (.&.) #-}
-  (Bit 1) .|. _       = Bit 1
-  (Bit 0) .|. (Bit 0) = Bit 0
-  _       .|. _       = Bit 1
+  (.|.) = cf2 (.|.)
   {-# INLINE (.|.) #-}
-  (Bit 0) `xor` (Bit 0) = Bit 0
-  (Bit 1) `xor` (Bit 1) = Bit 0
-  _       `xor` _       = Bit 1
+  xor = cf2 xor
   {-# INLINE xor #-}
-  complement (Bit 0) = Bit 1
-  complement       _ = Bit 0
+  complement = cf complement
   {-# INLINE complement #-}
   shift !b 0 = b
   shift  _ _ = Bit 0
   {-# INLINE shift #-}
   rotate !b _ = b
   {-# INLINE rotate #-}
-  zeroBits = Bit 0
+  zeroBits = zero
   {-# INLINE zeroBits #-}
-  bit 0 = Bit 1
-  bit _ = Bit 0
+  bit 0 = one
+  bit _ = zero
   {-# INLINE bit #-}
-  testBit (Bit 1) 0 = True
+  testBit (Bit b) 0 = b /= 0
   testBit _       _ = False
   {-# INLINE testBit #-}
   bitSizeMaybe _ = Just 1
@@ -119,24 +116,23 @@ fromNum _ = one
 
 
 zero :: Bit
-zero = Bit 0
+zero = coerce (0x00 :: Word8)
 {-# INLINE zero #-}
 
 one :: Bit
-one = Bit 1
+one = coerce (0xff :: Word8)
 {-# INLINE one #-}
 
 
 -- | Values: @0@ and @1@
 instance Elevator Bit where
-  minValue = Bit 0
+  minValue = Bit 0x00
   {-# INLINE minValue #-}
-  maxValue = Bit 1
+  maxValue = Bit 0xff
   {-# INLINE maxValue #-}
   toShowS (Bit 0) = ('0':)
   toShowS _       = ('1':)
-  toWord8 (Bit 0) = 0
-  toWord8 _       = maxBound
+  toWord8 = coerce
   {-# INLINE toWord8 #-}
   toWord16 (Bit 0) = 0
   toWord16 _       = maxBound
@@ -153,10 +149,10 @@ instance Elevator Bit where
   toRealFloat (Bit 0) = 0
   toRealFloat _       = 1
   {-# INLINE toRealFloat #-}
-  fromRealFloat 0 = Bit 0
-  fromRealFloat _ = Bit 1
+  fromRealFloat 0 = zero
+  fromRealFloat _ = one
   {-# INLINE fromRealFloat #-}
-  (//) (Bit x) (Bit y) = Bit (x `div` y)
+  (//) = cf2 div
   {-# INLINE (//) #-}
 
 
@@ -167,18 +163,18 @@ instance Num Bit where
   -- 0 - 1 = 0
   -- 1 - 0 = 1
   -- 1 - 1 = 0
-  (Bit 0) - (Bit 0) = Bit 0
-  _       - (Bit 0) = Bit 1
-  _       - _       = Bit 0
+  (Bit 0) - (Bit 0) = zero
+  _       - (Bit 0) = one
+  _       - _       = zero
   {-# INLINE (-) #-}
   (*) = (.&.)
   {-# INLINE (*) #-}
   abs         = id
   {-# INLINE abs #-}
   signum      = id
   {-# INLINE signum #-}
-  fromInteger 0 = Bit 0
-  fromInteger _ = Bit 1
+  fromInteger 0 = zero
+  fromInteger _ = one
   {-# INLINE fromInteger #-}
 
 -- | Unboxing of a `Bit`.

Color/src/Graphics/Color/Algebra/Elevator.hs

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

Color/src/Graphics/Color/Illuminant/CIE1931.hs

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

Color/src/Graphics/Color/Illuminant/CIE1964.hs

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

Color/src/Graphics/Color/Illuminant/ICC/PCS.hs

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

Color/src/Graphics/Color/Illuminant/ITU/Rec470.hs

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

Color/src/Graphics/Color/Illuminant/ITU/Rec601.hs

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

Color/src/Graphics/Color/Illuminant/Wikipedia.hs

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