-- | Colour related functions
module Data.CG.Minus.Colour where

import Data.Colour {- colour -}
import qualified Data.Colour.SRGB as S {- colour -}
import qualified Data.Colour.Names as N {- colour -}

-- | Opaque colour.
type C = Colour Double

-- | Colour with /alpha/ channel.
type Ca = AlphaColour Double

-- | Grey 'Colour'.
mk_grey :: (Ord a,Floating a) => a -> Colour a
mk_grey x = S.sRGB x x x

-- | Reduce 'Colour' to grey.  Constants are @0.3@, @0.59@ and @0.11@.
to_greyscale :: (Ord a,Floating a) => Colour a -> a
to_greyscale c =
    let (S.RGB r g b) = S.toSRGB c
    in r * 0.3 + g * 0.59 + b * 0.11

-- | 'mk_grey' '.' 'to_greyscale'.
to_greyscale_c :: (Ord a,Floating a) => Colour a -> Colour a
to_greyscale_c = mk_grey . to_greyscale

-- | Discard /alpha/ channel, if possible.
pureColour :: (Ord a, Fractional a) => AlphaColour a -> Colour a
pureColour c =
    let a = alphaChannel c
    in if a > 0
       then darken (recip a) (c `over` black)
       else error "transparent has no pure colour"

-- * Tuples

-- | Tuple to 'C', inverse of 'unC'.
toC :: (Double,Double,Double) -> C
toC (r,g,b) = S.sRGB r g b

-- | 'C' to /(red,green,blue)/ tuple.
unC :: C -> (Double,Double,Double)
unC x =
    let x' = S.toSRGB x
    in (S.channelRed x',S.channelGreen x',S.channelBlue x')

-- | Tuple to 'Ca', inverse of 'unCa'.
toCa :: (Double,Double,Double,Double) -> Ca
toCa (r,g,b,a) = toC (r,g,b) `withOpacity` a

-- | 'Ca' to /(red,green,blue,alpha)/ tuple
unCa :: Ca -> (Double,Double,Double,Double)
unCa x =
    let x' = S.toSRGB (pureColour x)
    in (S.channelRed x'
       ,S.channelGreen x'
       ,S.channelBlue x'
       ,alphaChannel x)

-- * Constants

-- | Venetian red (@#c80815@).
venetianRed :: C
venetianRed = S.sRGB24read "#c80815"

-- | Swedish azure blue (@#005b99@).
swedishAzureBlue :: C
swedishAzureBlue = S.sRGB24read "#005b99"

-- | Safety orange (@#ff6600@).
safetyOrange :: C
safetyOrange = S.sRGB24read "#ff6600"

-- | Dye magenta (@#ca1f7b@).
dyeMagenta :: C
dyeMagenta = S.sRGB24read "#ca1f7b"

-- | Candlelight yellow (@#fcd116@).
candlelightYellow :: C
candlelightYellow = S.sRGB24read "#fcd116"

-- | Subtractive primary cyan (@#00B7EB@).
subtractivePrimaryCyan :: C
subtractivePrimaryCyan = S.sRGB24read "#00B7EB"

-- | Fern green (@#009246@).
fernGreen :: C
fernGreen = S.sRGB24read "#009246"

-- | Sepia brown (@#704214@).
sepiaBrown :: C
sepiaBrown = S.sRGB24read "#704214"

-- | The set of named colours defined in this module.
non_svg_colour_set :: [C]
non_svg_colour_set =
    [venetianRed
    ,swedishAzureBlue
    ,safetyOrange
    ,dyeMagenta
    ,candlelightYellow
    ,subtractivePrimaryCyan
    ,fernGreen
    ,sepiaBrown]

-- * SVG colours

-- | The set of named colours in the @SVG@ specification (in
-- alphabetical order).
svg_colour_set :: [C]
svg_colour_set =
    [N.aliceblue
    ,N.antiquewhite
    ,N.aqua
    ,N.aquamarine
    ,N.azure
    ,N.beige
    ,N.bisque
    ,N.black
    ,N.blanchedalmond
    ,N.blue
    ,N.blueviolet
    ,N.brown
    ,N.burlywood
    ,N.cadetblue
    ,N.chartreuse
    ,N.chocolate
    ,N.coral
    ,N.cornflowerblue
    ,N.cornsilk
    ,N.crimson
    ,N.cyan
    ,N.darkblue
    ,N.darkcyan
    ,N.darkgoldenrod
    ,N.darkgray
    ,N.darkgreen
    ,N.darkgrey
    ,N.darkkhaki
    ,N.darkmagenta
    ,N.darkolivegreen
    ,N.darkorange
    ,N.darkorchid
    ,N.darkred
    ,N.darksalmon
    ,N.darkseagreen
    ,N.darkslateblue
    ,N.darkslategray
    ,N.darkslategrey
    ,N.darkturquoise
    ,N.darkviolet
    ,N.deeppink
    ,N.deepskyblue
    ,N.dimgray
    ,N.dimgrey
    ,N.dodgerblue
    ,N.firebrick
    ,N.floralwhite
    ,N.forestgreen
    ,N.fuchsia
    ,N.gainsboro
    ,N.ghostwhite
    ,N.gold
    ,N.goldenrod
    ,N.gray
    ,N.grey
    ,N.green
    ,N.greenyellow
    ,N.honeydew
    ,N.hotpink
    ,N.indianred
    ,N.indigo
    ,N.ivory
    ,N.khaki
    ,N.lavender
    ,N.lavenderblush
    ,N.lawngreen
    ,N.lemonchiffon
    ,N.lightblue
    ,N.lightcoral
    ,N.lightcyan
    ,N.lightgoldenrodyellow
    ,N.lightgray
    ,N.lightgreen
    ,N.lightgrey
    ,N.lightpink
    ,N.lightsalmon
    ,N.lightseagreen
    ,N.lightskyblue
    ,N.lightslategray
    ,N.lightslategrey
    ,N.lightsteelblue
    ,N.lightyellow
    ,N.lime
    ,N.limegreen
    ,N.linen
    ,N.magenta
    ,N.maroon
    ,N.mediumaquamarine
    ,N.mediumblue
    ,N.mediumorchid
    ,N.mediumpurple
    ,N.mediumseagreen
    ,N.mediumslateblue
    ,N.mediumspringgreen
    ,N.mediumturquoise
    ,N.mediumvioletred
    ,N.midnightblue
    ,N.mintcream
    ,N.mistyrose
    ,N.moccasin
    ,N.navajowhite
    ,N.navy
    ,N.oldlace
    ,N.olive
    ,N.olivedrab
    ,N.orange
    ,N.orangered
    ,N.orchid
    ,N.palegoldenrod
    ,N.palegreen
    ,N.paleturquoise
    ,N.palevioletred
    ,N.papayawhip
    ,N.peachpuff
    ,N.peru
    ,N.pink
    ,N.plum
    ,N.powderblue
    ,N.purple
    ,N.red
    ,N.rosybrown
    ,N.royalblue
    ,N.saddlebrown
    ,N.salmon
    ,N.sandybrown
    ,N.seagreen
    ,N.seashell
    ,N.sienna
    ,N.silver
    ,N.skyblue
    ,N.slateblue
    ,N.slategray
    ,N.slategrey
    ,N.snow
    ,N.springgreen
    ,N.steelblue
    ,N.tan
    ,N.teal
    ,N.thistle
    ,N.tomato
    ,N.turquoise
    ,N.violet
    ,N.wheat
    ,N.white
    ,N.whitesmoke
    ,N.yellow
    ,N.yellowgreen]