{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# OPTIONS_HADDOCK hide #-}

{-# HLINT ignore "Eta reduce" #-}

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

import Data.Data (Data, Typeable)


{-| 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
  + :: 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 (+) #-}


  (-) :: 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 (-) #-}


  (*) :: Color -> Color -> Color
  * :: 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 :: 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 :: 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 -> 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 @brillo-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 = do
  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

  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)