{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK hide #-}

-- | Data type for representing colors.
module Graphics.Gloss.Internals.Data.Color
        ( Color (..)
        , makeColor
        , makeColorI
        , makeRawColor
        , makeRawColorI
        , rgbaOfColor
        , clampColor)

where
import Data.Data

-- | 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, Typeable Color
Typeable Color =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Color -> c Color)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Color)
-> (Color -> Constr)
-> (Color -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Color))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color))
-> ((forall b. Data b => b -> b) -> Color -> Color)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r)
-> (forall u. (forall d. Data d => d -> u) -> Color -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Color -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> Data Color
Color -> Constr
Color -> DataType
(forall b. Data b => b -> b) -> Color -> Color
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
forall u. (forall d. Data d => d -> u) -> Color -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
$ctoConstr :: Color -> Constr
toConstr :: Color -> Constr
$cdataTypeOf :: Color -> DataType
dataTypeOf :: Color -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
$cgmapT :: (forall b. Data b => b -> b) -> Color -> Color
gmapT :: (forall b. Data b => b -> b) -> Color -> Color
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Color -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Color -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
Data, Typeable)


instance Num Color where
 + :: 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 :: 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 abs #-}

 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 signum #-}

 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
 {-# INLINE fromInteger #-}


-- | 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. All components are clamped to the range [0..255].
makeColorI :: Int -> Int -> Int -> Int -> Color
makeColorI :: Int -> Int -> Int -> Int -> Color
makeColorI 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 makeColorI #-}


-- | Make a custom color.
--
--   Using this function over `makeColor` avoids clamping the components,
--   which saves time. However, if the components are out of range then
--   this will result in integer overflow at rendering time, and the actual
--   picture you get will be implementation dependent.
--
--   You'll only need to use this function when using the @gloss-raster@
--   package that builds a new color for every pixel. If you're just working
--   with the Picture data type then it there is no need for raw colors.
--
makeRawColor :: Float -> Float -> Float -> Float -> Color
makeRawColor :: Float -> Float -> Float -> Float -> Color
makeRawColor Float
r Float
g Float
b Float
a
        = Float -> Float -> Float -> Float -> Color
RGBA Float
r Float
g Float
b Float
a
{-# INLINE makeRawColor #-}


-- | Make a custom color, taking pre-clamped components.
makeRawColorI :: Int -> Int -> Int -> Int -> Color
makeRawColorI :: Int -> Int -> Int -> Int -> Color
makeRawColorI Int
r Int
g Int
b Int
a
        = 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 makeRawColorI #-}


-- | 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 #-}


-- | Clamp components of a raw 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
        clamp :: a -> a
clamp a
x         = (a -> a -> a
forall a. Ord a => a -> a -> a
min (a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
0.0) a
1.0)
   in   Float -> Float -> Float -> Float -> Color
RGBA (Float -> Float
forall {a}. (Ord a, Fractional a) => a -> a
clamp Float
r) (Float -> Float
forall {a}. (Ord a, Fractional a) => a -> a
clamp Float
g) (Float -> Float
forall {a}. (Ord a, Fractional a) => a -> a
clamp Float
b) (Float -> Float
forall {a}. (Ord a, Fractional a) => a -> a
clamp Float
a)