-- Copyright (c) 2010-2012 Benjamin Lippmeier
--
--  Permission is hereby granted, free of charge, to any person
--  obtaining a copy of this software and associated documentation
--  files (the "Software"), to deal in the Software without
--  restriction, including without limitation the rights to use,
--  copy, modify, merge, publish, distribute, sublicense, and/or sell
--  copies of the Software, and to permit persons to whom the
--  Software is furnished to do so, subject to the following
--  condition:
--
--  The above copyright notice and this permission notice shall be
--  included in all copies or substantial portions of the Software.

{-# OPTIONS_GHC #-}

-- | Predefined and custom colors.
module Vis.GlossColor
        (
        -- ** Color data type
          Color
        , makeColor
        , makeColor'
        , makeColor8
        , rawColor
        , rgbaOfColor

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

        -- ** Pre-defined colors
        , greyN,  black,  white
        -- *** Primary
        , red,    green,  blue
        -- *** Secondary
        , yellow,     cyan,       magenta

        -- *** Tertiary
        , rose,   violet, azure, aquamarine, chartreuse, orange
        )
where

-- | An abstract color value.
--      We keep the type abstract so we can be sure that the components
--      are in the required range. To make a custom color use 'makeColor'.
data Color
        -- | Holds the color components. All components lie in the range [0..1.
        = RGBA  !Float !Float !Float !Float
        deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq)


instance Num Color where
 {-# INLINE (+) #-}
 + :: Color -> Color -> Color
(+) (RGBA Float
r1 Float
g1 Float
b1 Float
_) (RGBA Float
r2 Float
g2 Float
b2 Float
_)
        = Float -> Float -> Float -> Float -> Color
RGBA (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
1

 {-# INLINE (-) #-}
 (-) (RGBA Float
r1 Float
g1 Float
b1 Float
_) (RGBA Float
r2 Float
g2 Float
b2 Float
_)
        = Float -> Float -> Float -> Float -> Color
RGBA (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
1

 {-# INLINE (*) #-}
 * :: Color -> Color -> Color
(*) (RGBA Float
r1 Float
g1 Float
b1 Float
_) (RGBA Float
r2 Float
g2 Float
b2 Float
_)
        = Float -> Float -> Float -> Float -> Color
RGBA (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
1

 {-# INLINE abs #-}
 abs :: Color -> Color
abs (RGBA Float
r1 Float
g1 Float
b1 Float
_)
        = Float -> Float -> Float -> Float -> Color
RGBA (Float -> Float
forall a. Num a => a -> a
abs Float
r1) (Float -> Float
forall a. Num a => a -> a
abs Float
g1) (Float -> Float
forall a. Num a => a -> a
abs Float
b1) Float
1

 {-# INLINE signum #-}
 signum :: Color -> Color
signum (RGBA Float
r1 Float
g1 Float
b1 Float
_)
        = Float -> Float -> Float -> Float -> Color
RGBA (Float -> Float
forall a. Num a => a -> a
signum Float
r1) (Float -> Float
forall a. Num a => a -> a
signum Float
g1) (Float -> Float
forall a. Num a => a -> a
signum Float
b1) Float
1

 {-# INLINE fromInteger #-}
 fromInteger :: Integer -> Color
fromInteger Integer
i
  = let f :: Float
f = Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
i
    in  Float -> Float -> Float -> Float -> Color
RGBA Float
f Float
f Float
f Float
1


-- | Make a custom color. All components are clamped to the range  [0..1].
makeColor
        :: Float        -- ^ Red component.
        -> Float        -- ^ Green component.
        -> Float        -- ^ Blue component.
        -> Float        -- ^ Alpha component.
        -> Color

makeColor :: Float -> Float -> Float -> Float -> Color
makeColor Float
r Float
g Float
b Float
a
        = Color -> Color
clampColor
        (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Color
RGBA Float
r Float
g Float
b Float
a
{-# INLINE makeColor #-}


-- | Make a custom color.
--   You promise that all components are clamped to the range [0..1]
makeColor' :: Float -> Float -> Float -> Float -> Color
makeColor' :: Float -> Float -> Float -> Float -> Color
makeColor' Float
r Float
g Float
b Float
a
        = Float -> Float -> Float -> Float -> Color
RGBA Float
r Float
g Float
b Float
a
{-# INLINE makeColor' #-}


-- | Make a custom color. All components are clamped to the range [0..255].
makeColor8
        :: Int          -- ^ Red component.
        -> Int          -- ^ Green component.
        -> Int          -- ^ Blue component.
        -> Int          -- ^ Alpha component.
        -> Color

makeColor8 :: Int -> Int -> Int -> Int -> Color
makeColor8 Int
r Int
g Int
b Int
a
        = Color -> Color
clampColor
        (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Color
RGBA  (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
                (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255)
{-# INLINE makeColor8 #-}


-- | Take the RGBA components of a color.
rgbaOfColor :: Color -> (Float, Float, Float, Float)
rgbaOfColor :: Color -> (Float, Float, Float, Float)
rgbaOfColor (RGBA Float
r Float
g Float
b Float
a)      = (Float
r, Float
g, Float
b, Float
a)
{-# INLINE rgbaOfColor #-}


-- | Make a custom color.
--   Components should be in the range [0..1] but this is not checked.
rawColor
        :: Float        -- ^ Red component.
        -> Float        -- ^ Green component.
        -> Float        -- ^ Blue component.
        -> Float        -- ^ Alpha component.
        -> Color

rawColor :: Float -> Float -> Float -> Float -> Color
rawColor = Float -> Float -> Float -> Float -> Color
RGBA
{-# INLINE rawColor #-}


-- Internal

-- | Clamp components of a color into the required range.
clampColor :: Color -> Color
clampColor :: Color -> Color
clampColor Color
cc
 = let  (Float
r, Float
g, Float
b, Float
a)    = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
cc
   in   Float -> Float -> Float -> Float -> Color
RGBA (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 Float
r) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 Float
g) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 Float
b) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 Float
a)

-- | Normalise a color to the value of its largest RGB component.
normaliseColor :: Color -> Color
normaliseColor :: Color -> Color
normaliseColor Color
cc
 = let  (Float
r, Float
g, Float
b, Float
a)    = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
cc
        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
RGBA (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


-- Color functions ------------------------------------------------------------

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

mixColors :: Float -> Float -> Color -> Color -> Color
mixColors Float
ratio1 Float
ratio2 Color
c1 Color
c2
 = let  RGBA Float
r1 Float
g1 Float
b1 Float
a1        = Color
c1
        RGBA Float
r2 Float
g2 Float
b2 Float
a2        = Color
c2

        total :: Float
total   = Float
ratio1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ratio2
        m1 :: Float
m1      = Float
ratio1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
total
        m2 :: Float
m2      = Float
ratio2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
total

   in   Float -> Float -> Float -> Float -> Color
RGBA    (Float
m1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
r2)
                (Float
m1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
g2)
                (Float
m1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
m2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
b2)
                (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)


-- | 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  RGBA Float
r1 Float
g1 Float
b1 Float
a1        = Color
c1
        RGBA Float
r2 Float
g2 Float
b2 Float
a2        = Color
c2

   in   Color -> Color
normaliseColor
         (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Color
RGBA (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 (RGBA Float
r Float
g Float
b Float
a)
        = Float -> Float -> Float -> Float -> Color
RGBA (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 (RGBA Float
r Float
g Float
b Float
a)
        = Color -> Color
clampColor
        (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Color
RGBA (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 (RGBA Float
r Float
g Float
b Float
a)
        = Color -> Color
clampColor
        (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Color
RGBA (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 (RGBA Float
r Float
g Float
b Float
a)
        = Color -> Color
clampColor
        (Color -> Color) -> Color -> Color
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Color
RGBA (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


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

black, white :: Color
black :: Color
black           = Float -> Float -> Float -> Float -> Color
RGBA Float
0.0 Float
0.0 Float
0.0 Float
1.0
white :: Color
white           = Float -> Float -> Float -> Float -> Color
RGBA 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
RGBA Float
1.0 Float
0.0 Float
0.0 Float
1.0
green :: Color
green           = Float -> Float -> Float -> Float -> Color
RGBA Float
0.0 Float
1.0 Float
0.0 Float
1.0
blue :: Color
blue            = Float -> Float -> Float -> Float -> Color
RGBA 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