{- |
  Support for the \"sRGB\" colour space.

  This colour space is the /de facto/ standard colour space for
  computer data, unless some more specific colour space is explicitly
  specified. Unless you know differently, any image data received
  from the outside world is probably sRGB, and and data output is
  probably expected to be sRGB.

  Unfortunately, sRGB is a non-linear colour space, so it is not
  feasible to perform arithmetic in it directly. (The sRGB colour
  space basically standardises the defective non-linear behaviour of
  obsolete CRT display technology.)
-}

module Data.Colour.Nonlinear where

import Data.Word (Word8) -- For Haddock.

import Data.Colour

-- * Types

{- |
  Type for holding sRGB colour values (with 'Double' components).

  The standard 'Colour' type is for /linear/ RGB values. This type
  is for sRGB colours, which are non-linear.
-}
newtype Colour_sRGB = Colour_sRGB Colour deriving (Eq, Ord, Show)

{- |
  Type for holding sRGB colour values (with 'Word8' components).

  The standard 'Colour8' type is for /linear/ RGB values. This type
  is for sRGB colours, which are non-linear.
-}
newtype Colour8_sRGB = Colour8_sRGB Colour8 deriving (Eq, Ord, Show)

-- * Conversions

-- | Convert a linear RGB value into a non-linear sRGB value.
colour_to_sRGB :: Colour -> Colour_sRGB
colour_to_sRGB (Colour r g b) = Colour_sRGB (Colour (f r) (f g) (f b))
  where
    f :: Double -> Double
    f x = if x <= 0.0031308 then 12.92 * x else 1.055 * (x ** (1 / 2.4)) - 0.055

-- | Convert from 'Double' components to 'Word8' components.
cdemote_sRGB :: Colour_sRGB -> Colour8_sRGB
cdemote_sRGB (Colour_sRGB c) = Colour8_sRGB (cdemote c)

-- | Convert from 'Word8' components to 'Double' components.
cpromote_sRGB :: Colour8_sRGB -> Colour_sRGB
cpromote_sRGB (Colour8_sRGB c) = Colour_sRGB (cpromote c)

-- | Convert a non-linear sRGB value into a linear RGB value.
colour_from_sRGB :: Colour_sRGB -> Colour
colour_from_sRGB (Colour_sRGB (Colour r g b)) = Colour (f r) (f g) (f b)
  where
    f :: Double -> Double
    f x = if x <= 0.04045 then x / 12.92 else ((x + 0.055)/1.055) ** 2.4