{-
	Copyright (C) 2014-2015 Dr. Alistair Ward

	This file is part of WeekDaze.

	WeekDaze is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	WeekDaze is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with WeekDaze.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@] Exports some colour-composition functions for HTML.
-}

module WeekDaze.Colour.HTMLColour(
-- * Functions
        unitIntervalToHTMLColourCode,
        unitIntervalToRGB,
-- ** Translation
        htmlColourCodeToRGB,
        rgbUnitIntervalToHTMLColourCode
) where

import qualified        Text.Printf
import qualified        ToolShed.Data.Triple
import qualified        WeekDaze.Colour.HTMLColourCode  as Colour.HTMLColourCode
import qualified        WeekDaze.Colour.RGB             as Colour.RGB

-- | Represents the specified HTML colour-code as RGB 24-bit.
htmlColourCodeToRGB :: (Integral i, Show i) => Colour.HTMLColourCode.HTMLColourCode -> Colour.RGB.RGB i
htmlColourCodeToRGB     = Colour.RGB.fromIntegral' . Colour.HTMLColourCode.readHex . tail

-- | Represents the specified RGB as an HTML colour-code.
rgbUnitIntervalToHTMLColourCode
        :: RealFrac unitInterval
        => Colour.RGB.RGB unitInterval  -- ^ Red, green & blue component-colours, each in the unit-interval.
        -> Colour.HTMLColourCode.HTMLColourCode
rgbUnitIntervalToHTMLColourCode rgb     = ToolShed.Data.Triple.uncurry3 (Text.Printf.printf $ Colour.HTMLColourCode.htmlColourCodePrefix : "%02x%02x%02x") $ Colour.RGB.toTriple (Colour.RGB.fromRGBUnitInterval rgb :: Colour.RGB.RGB Int)

{- |
	* Maps the specified value from the unit-interval to the corresponding spectral colour represented as RGB.

	* The mapping from the spectrum to RGB is performed by modeling the spectrum as a circular arc drawn on the colour triangle,
	of radius equal to the specified saturation, & centered on green.
	CAVEAT: this algorithm has no solid basis.

	* One may specify the angular span & angular offset of this arc, to define the values to which /0/ & /1/ map.
-}
unitIntervalToRGB :: (
        Fractional      alpha,
        Fractional      unitInterval,
        Real            alpha,
        Real            unitInterval,
        Show            alpha,
        Show            unitInterval
 )
        => alpha        -- ^ The angular span in the range [0 .. 2 * pi radians], to which the unit-interval is mapped.
        -> alpha        -- ^ The angular offset in radians.
        -> unitInterval -- ^ The saturation in the unit-interval; /0/ will always result in black.
        -> unitInterval -- ^ The value in the unit-interval which is to be represented by a colour.
        -> Colour.RGB.RGB unitInterval
unitIntervalToRGB _ _ 0 _       = Colour.RGB.black
unitIntervalToRGB angularSpan angularOffset saturation x
        | angularSpan < 0 || realToFrac angularSpan > 2 * pi'   = error $ "WeekDaze.Colour.HTMLColour.unitIntervalToRGB:\tthe specified angular span must be in the range [0 .. 2 * Pi]; " ++ show angularSpan
        | saturation < 0 || saturation > 1                      = error $ "WeekDaze.Colour.HTMLColour.unitIntervalToRGB:\tthe specified saturation must be in the unit-interval; " ++ show saturation
        | x < 0 || x > 1                                        = error $ "WeekDaze.Colour.HTMLColour.unitIntervalToRGB:\tthe specified value must be in the unit-interval; " ++ show x
        | otherwise                                             = let
                alpha   = realToFrac $ angularSpan * realToFrac x + angularOffset       -- Map the specified value onto a circular arc spanning the specified range of angles, offset by the specified angle.
        in (
                realToFrac . (* realToFrac saturation) . (/ 2) . (+ 1)  -- Translate & scale the result from [-1 .. 1] to [0 .. saturation].
        ) `fmap` Colour.RGB.mkRGB (
                cos $ alpha + 5 * pi' / 6
        ) (
                sin alpha
        ) (
                cos $ alpha + pi' / 6
        )
        where
                pi' :: Double   -- Choose a working floating-point type.
                pi'     = pi

{- |
	* Calls 'unitIntervalToRGB', with default parameters to make /0/ map to /blue/ & /1/ to /red/, & with a moderately high saturation.

	* Calls 'rgbUnitIntervalToHTMLColourCode' to convert to an HTML colour-code.
-}
unitIntervalToHTMLColourCode :: (
        RealFrac        unitInterval,
        Show            unitInterval
 ) => unitInterval -> Colour.HTMLColourCode.HTMLColourCode
unitIntervalToHTMLColourCode    = rgbUnitIntervalToHTMLColourCode . unitIntervalToRGB (4 * pi / 3 :: Double) (negate pi / 6) (3 / 4) {-rather arbitrary-}