-- | Predefined and custom colors.
module Graphics.Gloss.Data.Color
        ( -- ** Color data type
          Color
        , makeColor
        , makeColorI
        , rgbaOfColor

          -- ** Color functions
        , mixColors
        , addColors
        , dim,   bright
        , light, dark

        , withRed
        , withGreen
        , withBlue
        , withAlpha

          -- ** Pre-defined colors
        , greyN,  black,  white

          -- *** Primary
        , red,    green,  blue

          -- *** Secondary
        , yellow,     cyan,       magenta

          -- *** Tertiary
        , rose,   violet, azure, aquamarine, chartreuse, orange
        )
where
import Graphics.Gloss.Rendering



-- Color functions ------------------------------------------------------------
-- | Mix two colors with the given ratios.
mixColors
        :: Float        -- ^ Proportion of first color.
        -> Float        -- ^ Proportion of second color.
        -> Color        -- ^ First color.
        -> Color        -- ^ Second color.
        -> Color        -- ^ Resulting color.

mixColors :: Float -> Float -> Color -> Color -> Color
mixColors Float
m1 Float
m2 Color
c1 Color
c2
 = let  (Float
r1, Float
g1, Float
b1, Float
a1) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c1
        (Float
r2, Float
g2, Float
b2, Float
a2) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c2

        -- Normalise mixing proportions to ratios.
        m12 :: Float
m12 = Float
m1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m2
        m1' :: Float
m1' = Float
m1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
m12
        m2' :: Float
m2' = Float
m2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
m12

        -- Colors components should be added via sum of squares,
        -- otherwise the result will be too dark.
        r1s :: Float
r1s = Float
r1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r1;    r2s :: Float
r2s = Float
r2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r2
        g1s :: Float
g1s = Float
g1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g1;    g2s :: Float
g2s = Float
g2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g2
        b1s :: Float
b1s = Float
b1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b1;    b2s :: Float
b2s = Float
b2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b2

   in   Float -> Float -> Float -> Float -> Color
makeColor
                (Float -> Float
forall a. Floating a => a -> a
sqrt (Float
m1' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r1s Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m2' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r2s))
                (Float -> Float
forall a. Floating a => a -> a
sqrt (Float
m1' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g1s Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m2' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g2s))
                (Float -> Float
forall a. Floating a => a -> a
sqrt (Float
m1' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b1s Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m2' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b2s))
                ((Float
m1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a1   Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
a2) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
m12)


-- | Add RGB components of a color component-wise,
--   then normalise them to the highest resulting one.
--   The alpha components are averaged.
addColors :: Color -> Color -> Color
addColors :: Color -> Color -> Color
addColors Color
c1 Color
c2
 = let  (Float
r1, Float
g1, Float
b1, Float
a1) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c1
        (Float
r2, Float
g2, Float
b2, Float
a2) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c2

   in   Float -> Float -> Float -> Float -> Color
normalizeColor
                (Float
r1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
r2)
                (Float
g1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
g2)
                (Float
b1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
b2)
                ((Float
a1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
a2) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)


-- | Make a dimmer version of a color, scaling towards black.
dim :: Color -> Color
dim :: Color -> Color
dim Color
c
 = let  (Float
r, Float
g, Float
b, Float
a)    = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
   in   Float -> Float -> Float -> Float -> Color
makeColor (Float
r Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1.2) (Float
g Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1.2) (Float
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1.2) Float
a


-- | Make a brighter version of a color, scaling towards white.
bright :: Color -> Color
bright :: Color -> Color
bright Color
c
 = let  (Float
r, Float
g, Float
b, Float
a)    = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
   in   Float -> Float -> Float -> Float -> Color
makeColor (Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
1.2) (Float
g Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
1.2) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
1.2) Float
a


-- | Lighten a color, adding white.
light :: Color -> Color
light :: Color -> Color
light Color
c
 = let  (Float
r, Float
g, Float
b, Float
a)    = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
   in   Float -> Float -> Float -> Float -> Color
makeColor (Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.2) (Float
g Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.2) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.2) Float
a


-- | Darken a color, adding black.
dark :: Color -> Color
dark :: Color -> Color
dark Color
c
 = let  (Float
r, Float
g, Float
b, Float
a)    = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
   in   Float -> Float -> Float -> Float -> Color
makeColor (Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.2) (Float
g Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.2) (Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.2) Float
a


-------------------------------------------------------------------------------
-- | Set the red value of a `Color`.
withRed :: Float -> Color -> Color
withRed :: Float -> Color -> Color
withRed Float
r Color
c
 = let  (Float
_, Float
g, Float
b, Float
a) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
   in   Float -> Float -> Float -> Float -> Color
makeColor Float
r Float
g Float
b Float
a


-- | Set the green value of a `Color`.
withGreen :: Float -> Color -> Color
withGreen :: Float -> Color -> Color
withGreen Float
g Color
c
 = let  (Float
r, Float
_, Float
b, Float
a) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
   in   Float -> Float -> Float -> Float -> Color
makeColor Float
r Float
g Float
b Float
a


-- | Set the blue value of a `Color`.
withBlue :: Float -> Color -> Color
withBlue :: Float -> Color -> Color
withBlue Float
b Color
c
 = let  (Float
r, Float
g, Float
_, Float
a) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
   in   Float -> Float -> Float -> Float -> Color
makeColor Float
r Float
g Float
b Float
a


-- | Set the alpha value of a `Color`.
withAlpha :: Float -> Color -> Color
withAlpha :: Float -> Color -> Color
withAlpha Float
a Color
c
 = let  (Float
r, Float
g, Float
b, Float
_) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
   in   Float -> Float -> Float -> Float -> Color
makeColor Float
r Float
g Float
b Float
a


-- Pre-defined Colors ---------------------------------------------------------
-- | A greyness of a given order.
--
--   Range is 0 = black, to 1 = white.
greyN   :: Float -> Color
greyN :: Float -> Color
greyN Float
n         = Float -> Float -> Float -> Float -> Color
makeRawColor Float
n   Float
n   Float
n   Float
1.0

black, white :: Color
black :: Color
black           = Float -> Float -> Float -> Float -> Color
makeRawColor Float
0.0 Float
0.0 Float
0.0 Float
1.0
white :: Color
white           = Float -> Float -> Float -> Float -> Color
makeRawColor Float
1.0 Float
1.0 Float
1.0 Float
1.0

-- Colors from the additive color wheel.
red, green, blue :: Color
red :: Color
red             = Float -> Float -> Float -> Float -> Color
makeRawColor Float
1.0 Float
0.0 Float
0.0 Float
1.0
green :: Color
green           = Float -> Float -> Float -> Float -> Color
makeRawColor Float
0.0 Float
1.0 Float
0.0 Float
1.0
blue :: Color
blue            = Float -> Float -> Float -> Float -> Color
makeRawColor Float
0.0 Float
0.0 Float
1.0 Float
1.0

-- secondary
yellow, cyan, magenta :: Color
yellow :: Color
yellow          = Color -> Color -> Color
addColors Color
red   Color
green
cyan :: Color
cyan            = Color -> Color -> Color
addColors Color
green Color
blue
magenta :: Color
magenta         = Color -> Color -> Color
addColors Color
red   Color
blue

-- tertiary
rose, violet, azure, aquamarine, chartreuse, orange :: Color
rose :: Color
rose            = Color -> Color -> Color
addColors Color
red     Color
magenta
violet :: Color
violet          = Color -> Color -> Color
addColors Color
magenta Color
blue
azure :: Color
azure           = Color -> Color -> Color
addColors Color
blue    Color
cyan
aquamarine :: Color
aquamarine      = Color -> Color -> Color
addColors Color
cyan    Color
green
chartreuse :: Color
chartreuse      = Color -> Color -> Color
addColors Color
green   Color
yellow
orange :: Color
orange          = Color -> Color -> Color
addColors Color
yellow  Color
red


-------------------------------------------------------------------------------
-- | Normalise a color to the value of its largest RGB component.
normalizeColor :: Float -> Float -> Float -> Float -> Color
normalizeColor :: Float -> Float -> Float -> Float -> Color
normalizeColor Float
r Float
g Float
b Float
a
 = let  m :: Float
m               = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float
r, Float
g, Float
b]
   in   Float -> Float -> Float -> Float -> Color
makeColor (Float
r Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
m) (Float
g Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
m) (Float
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
m) Float
a