{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.Gloss.Internals.Data.Color
( Color (..)
, makeColor
, makeColorI
, makeRawColor
, makeRawColorI
, rgbaOfColor
, clampColor)
where
import Data.Data
data Color
= RGBA !Float !Float !Float !Float
deriving (Show, Eq, Data, Typeable)
instance Num Color where
(+) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)
= RGBA (r1 + r2) (g1 + g2) (b1 + b2) 1
{-# INLINE (+) #-}
(-) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)
= RGBA (r1 - r2) (g1 - g2) (b1 - b2) 1
{-# INLINE (-) #-}
(*) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)
= RGBA (r1 * r2) (g1 * g2) (b1 * b2) 1
{-# INLINE (*) #-}
abs (RGBA r1 g1 b1 _)
= RGBA (abs r1) (abs g1) (abs b1) 1
{-# INLINE abs #-}
signum (RGBA r1 g1 b1 _)
= RGBA (signum r1) (signum g1) (signum b1) 1
{-# INLINE signum #-}
fromInteger i
= let f = fromInteger i
in RGBA f f f 1
{-# INLINE fromInteger #-}
makeColor
:: Float
-> Float
-> Float
-> Float
-> Color
makeColor r g b a
= clampColor
$ RGBA r g b a
{-# INLINE makeColor #-}
makeColorI :: Int -> Int -> Int -> Int -> Color
makeColorI r g b a
= clampColor
$ RGBA (fromIntegral r / 255)
(fromIntegral g / 255)
(fromIntegral b / 255)
(fromIntegral a / 255)
{-# INLINE makeColorI #-}
makeRawColor :: Float -> Float -> Float -> Float -> Color
makeRawColor r g b a
= RGBA r g b a
{-# INLINE makeRawColor #-}
makeRawColorI :: Int -> Int -> Int -> Int -> Color
makeRawColorI r g b a
= RGBA (fromIntegral r / 255)
(fromIntegral g / 255)
(fromIntegral b / 255)
(fromIntegral a / 255)
{-# INLINE makeRawColorI #-}
rgbaOfColor :: Color -> (Float, Float, Float, Float)
rgbaOfColor (RGBA r g b a) = (r, g, b, a)
{-# INLINE rgbaOfColor #-}
clampColor :: Color -> Color
clampColor cc
= let (r, g, b, a) = rgbaOfColor cc
in RGBA (min 1 r) (min 1 g) (min 1 b) (min 1 a)