-- | Predefined and custom colors.
module Brillo.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 Brillo.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 a. Ord a => [a] -> a
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