    {-
    Copyright (c) 2008, 2009
    Russell O'Connor

    Permission is hereby granted, free of charge, to any person obtaining a copy
    of this software and associated documentation files (the "Software"), to deal
    in the Software without restriction, including without limitation the rights
    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
    copies of the Software, and to permit persons to whom the Software is
    furnished to do so, subject to the following conditions:

    The above copyright notice and this permission notice shall be included in
    all copies or substantial portions of the Software.

    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
    IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
    THE SOFTWARE.
    -}
    module Data.Colour.Internal where

    import Data.List
    import qualified Data.Colour.Chan as Chan
    import Data.Colour.Chan (Chan(Chan))
    import Data.Monoid
    import Data.Semigroup

    data Red = Red
    data Green = Green
    data Blue = Blue

    -- |This type represents the human preception of colour.
    -- The @a@ parameter is a numeric type used internally for the
    -- representation.
    --
    -- The 'Monoid' instance allows one to add colours, but beware that adding
    -- colours can take you out of gamut.  Consider using 'blend' whenever
    -- possible.

    -- Internally we store the colour in linear ITU-R BT.709 RGB colour space.
    data Colour a = RGB !(Chan Red a) !(Chan Green a) !(Chan Blue a)
                    deriving (Eq)

    -- |Change the type used to represent the colour coordinates.
    colourConvert :: (Fractional b, Real a) => Colour a -> Colour b
    colourConvert (RGB r g b) =
      RGB (Chan.convert r) (Chan.convert g) (Chan.convert b)

    -- 'black' is the colourless colour.  It is the identity colour in
    -- additive colour spaces.
    black :: (Num a) => Colour a
    black = RGB Chan.empty Chan.empty Chan.empty

    instance (Num a) => Semigroup (Colour a) where
      (<>) = mappend

    instance (Num a) => Monoid (Colour a) where
      mempty = black
      (RGB r1 g1 b1) `mappend` (RGB r2 g2 b2) =
        RGB (r1 `Chan.add` r2) (g1 `Chan.add` g2) (b1 `Chan.add` b2)
      mconcat l = RGB (Chan.sum lr) (Chan.sum lg) (Chan.sum lb)
       where
        (lr,lg,lb) = unzip3 (map toRGB l)
        toRGB (RGB r g b) = (r,g,b)

    data Alpha = Alpha

    -- |This type represents a 'Colour' that may be semi-transparent.
    --
    -- The 'Monoid' instance allows you to composite colours.
    --
    -- >x `mappend` y == x `over` y
    --
    -- To get the (pre-multiplied) colour channel of an 'AlphaColour' @c@,
    -- simply composite @c@ over black.
    --
    -- >c `over` black

    -- Internally we use a premultiplied-alpha representation.
    data AlphaColour a = RGBA !(Colour a) !(Chan Alpha a) deriving (Eq)

    -- |This 'AlphaColour' is entirely transparent and has no associated
    -- colour channel.
    transparent :: (Num a) => AlphaColour a
    transparent = RGBA (RGB Chan.empty Chan.empty Chan.empty) Chan.empty

    -- |Change the type used to represent the colour coordinates.
    alphaColourConvert :: (Fractional b, Real a) =>
      AlphaColour a -> AlphaColour b
    alphaColourConvert (RGBA c a) = RGBA (colourConvert c) (Chan.convert a)

    -- |Creates an opaque 'AlphaColour' from a 'Colour'.
    opaque :: (Num a) => Colour a -> AlphaColour a
    opaque c = RGBA c Chan.full

    -- |Returns an 'AlphaColour' more transparent by a factor of @o@.
    dissolve :: (Num a) => a -> AlphaColour a -> AlphaColour a
    dissolve o (RGBA c a) = RGBA (darken o c) (Chan.scale o a)

    -- |Creates an 'AlphaColour' from a 'Colour' with a given opacity.
    --
    -- >c `withOpacity` o == dissolve o (opaque c)
    withOpacity :: (Num a) => Colour a -> a -> AlphaColour a
    c `withOpacity` o = RGBA (darken o c) (Chan o)

    --------------------------------------------------------------------------
    -- Blending
    --------------------------------------------------------------------------

    class AffineSpace f where
     -- |Compute a affine Combination (weighted-average) of points.
     -- The last parameter will get the remaining weight.
     -- e.g.
     --
     -- >affineCombo [(0.2,a), (0.3,b)] c == 0.2*a + 0.3*b + 0.5*c
     --
     -- Weights can be negative, or greater than 1.0; however, be aware
     -- that non-convex combinations may lead to out of gamut colours.
     affineCombo :: (Num a) => [(a,f a)] -> f a -> f a

    -- |Compute the weighted average of two points.
    -- e.g.
    --
    -- >blend 0.4 a b = 0.4*a + 0.6*b
    --
    -- The weight can be negative, or greater than 1.0; however, be aware
    -- that non-convex combinations may lead to out of gamut colours.
    blend :: (Num a, AffineSpace f) => a -> f a -> f a -> f a
    blend weight c1 c2 = affineCombo [(weight,c1)] c2

    instance AffineSpace Colour where
     affineCombo l z =
       foldl1' mappend [darken w a | (w,a) <- (1-total,z):l]
      where
       total = sum $ map fst l

    instance AffineSpace AlphaColour where
     affineCombo l z =
       foldl1' rgbaAdd [dissolve w a | (w,a) <- (1-total,z):l]
      where
       total = sum $ map fst l

    --------------------------------------------------------------------------
    -- composite
    --------------------------------------------------------------------------

    class ColourOps f where
     -- |@c1 \`over\` c2@ returns the 'Colour' created by compositing the
     -- 'AlphaColour' @c1@ over @c2@, which may be either a 'Colour' or
     -- 'AlphaColour'.
     over :: (Num a) => AlphaColour a -> f a -> f a
     -- |@darken s c@ blends a colour with black without changing it's opacity.
     --
     -- For 'Colour', @darken s c = blend s c mempty@
     darken :: (Num a) => a -> f a -> f a

    instance ColourOps Colour where
     (RGBA (RGB r0 g0 b0) (Chan a0)) `over` (RGB r1 g1 b1) =
       RGB (Chan.over r0 a0 r1)
           (Chan.over g0 a0 g1)
           (Chan.over b0 a0 b1)
     darken s (RGB r g b) = RGB (Chan.scale s r)
                                (Chan.scale s g)
                                (Chan.scale s b)

    instance ColourOps AlphaColour where
     c0@(RGBA _ a0@(Chan a0')) `over` (RGBA c1 a1) =
       RGBA (c0 `over` c1) (Chan.over a0 a0' a1)
     darken s (RGBA c a) = RGBA (darken s c) a

    -- | 'AlphaColour' forms a monoid with 'over' and 'transparent'.
    instance (Num a) => Semigroup (AlphaColour a) where
      (<>) = mappend

    instance (Num a) => Monoid (AlphaColour a) where
      mempty = transparent
      mappend = over

    -- | @c1 \`atop\` c2@ returns the 'AlphaColour' produced by covering
    -- the portion of @c2@ visible by @c1@.
    -- The resulting alpha channel is always the same as the alpha channel
    -- of @c2@.
    --
    -- >c1 `atop` (opaque c2) == c1 `over` (opaque c2)
    -- >AlphaChannel (c1 `atop` c2) == AlphaChannel c2
    atop :: (Fractional a) => AlphaColour a -> AlphaColour a -> AlphaColour a
    atop (RGBA c0 (Chan a0)) (RGBA c1 (Chan a1)) =
      RGBA (darken a1 c0 `mappend` darken (1-a0) c1) (Chan a1)

    -- |'round's and then clamps @x@ between 0 and 'maxBound'.
    quantize :: (RealFrac a1, Integral a, Bounded a) => a1 -> a
    quantize x | x <= fromIntegral l = l
               | fromIntegral h <= x = h
               | otherwise           = round x
     where
      l = minBound
      h = maxBound

    {- Avoid using -}
    -- |Returns the opacity of an 'AlphaColour'.
    alphaChannel :: AlphaColour a -> a
    alphaChannel (RGBA _ (Chan a)) = a

    -- |Returns the colour of an 'AlphaColour'.
    -- @colourChannel transparent@ is undefined and may result in @nan@ or an
    -- error.
    -- Its use is discouraged.
    -- If you are desperate, use
    --
    -- >darken (recip (alphaChannel c)) (c `over` black)
    colourChannel :: (Fractional a) => AlphaColour a -> Colour a
    colourChannel (RGBA c (Chan a)) = darken (recip a) c

    --------------------------------------------------------------------------
    -- not for export
    --------------------------------------------------------------------------

    rgbaAdd (RGBA c1 a1) (RGBA c2 a2) =
      RGBA (c1 `mappend` c2) (a1 `Chan.add` a2)