Color.hs

-- | 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 m1 m2 c1 c2 =
  let (r1, g1, b1, a1) = rgbaOfColor c1
      (r2, g2, b2, a2) = rgbaOfColor c2

      -- Normalise mixing proportions to ratios.
      m12 = m1 + m2
      m1' = m1 / m12
      m2' = m2 / m12

      -- Colors components should be added via sum of squares,
      -- otherwise the result will be too dark.
      r1s = r1 * r1
      r2s = r2 * r2
      g1s = g1 * g1
      g2s = g2 * g2
      b1s = b1 * b1
      b2s = b2 * b2
  in  makeColor
        (sqrt (m1' * r1s + m2' * r2s))
        (sqrt (m1' * g1s + m2' * g2s))
        (sqrt (m1' * b1s + m2' * b2s))
        ((m1 * a1 + m2 * a2) / 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 c1 c2 =
  let (r1, g1, b1, a1) = rgbaOfColor c1
      (r2, g2, b2, a2) = rgbaOfColor c2
  in  normalizeColor
        (r1 + r2)
        (g1 + g2)
        (b1 + b2)
        ((a1 + a2) / 2)


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


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


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


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


-------------------------------------------------------------------------------

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


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


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


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


-- Pre-defined Colors ---------------------------------------------------------

{-| A greyness of a given order.

  Range is 0 = black, to 1 = white.
-}
greyN :: Float -> Color
greyN n = makeRawColor n n n 1.0


black, white :: Color
black = makeRawColor 0.0 0.0 0.0 1.0
white = makeRawColor 1.0 1.0 1.0 1.0


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


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


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


-------------------------------------------------------------------------------

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