module WeekDaze.Colour.HTMLColour(
unitIntervalToHTMLColourCode,
unitIntervalToRGB,
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
htmlColourCodeToRGB :: (Integral i, Show i) => Colour.HTMLColourCode.HTMLColourCode -> Colour.RGB.RGB i
htmlColourCodeToRGB = Colour.RGB.fromIntegral' . Colour.HTMLColourCode.readHex . tail
rgbUnitIntervalToHTMLColourCode
:: RealFrac unitInterval
=> Colour.RGB.RGB unitInterval
-> 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)
unitIntervalToRGB :: (
Fractional alpha,
Fractional unitInterval,
Real alpha,
Real unitInterval,
Show alpha,
Show unitInterval
)
=> alpha
-> alpha
-> unitInterval
-> unitInterval
-> 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
in (
realToFrac . (* realToFrac saturation) . (/ 2) . (+ 1)
) `fmap` Colour.RGB.mkRGB (
cos $ alpha + 5 * pi' / 6
) (
sin alpha
) (
cos $ alpha + pi' / 6
)
where
pi' :: Double
pi' = pi
unitIntervalToHTMLColourCode :: (
RealFrac unitInterval,
Show unitInterval
) => unitInterval -> Colour.HTMLColourCode.HTMLColourCode
unitIntervalToHTMLColourCode = rgbUnitIntervalToHTMLColourCode . unitIntervalToRGB (4 * pi / 3 :: Double) (negate pi / 6) (3 / 4)