module Blucontrol.Value.Brightness (
  Brightness
, WithBrightness (..)
, applyBrightnessToRGB
) where

import Control.DeepSeq
import Data.Default
import GHC.Generics

import Blucontrol.Value
import Blucontrol.Value.RGB

-- | Arbitrary precision brightness between 0 and 1
newtype Brightness = Brightness Rational
  deriving (Int -> Brightness
Brightness -> Int
Brightness -> [Brightness]
Brightness -> Brightness
Brightness -> Brightness -> [Brightness]
Brightness -> Brightness -> Brightness -> [Brightness]
(Brightness -> Brightness)
-> (Brightness -> Brightness)
-> (Int -> Brightness)
-> (Brightness -> Int)
-> (Brightness -> [Brightness])
-> (Brightness -> Brightness -> [Brightness])
-> (Brightness -> Brightness -> [Brightness])
-> (Brightness -> Brightness -> Brightness -> [Brightness])
-> Enum Brightness
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Brightness -> Brightness -> Brightness -> [Brightness]
$cenumFromThenTo :: Brightness -> Brightness -> Brightness -> [Brightness]
enumFromTo :: Brightness -> Brightness -> [Brightness]
$cenumFromTo :: Brightness -> Brightness -> [Brightness]
enumFromThen :: Brightness -> Brightness -> [Brightness]
$cenumFromThen :: Brightness -> Brightness -> [Brightness]
enumFrom :: Brightness -> [Brightness]
$cenumFrom :: Brightness -> [Brightness]
fromEnum :: Brightness -> Int
$cfromEnum :: Brightness -> Int
toEnum :: Int -> Brightness
$ctoEnum :: Int -> Brightness
pred :: Brightness -> Brightness
$cpred :: Brightness -> Brightness
succ :: Brightness -> Brightness
$csucc :: Brightness -> Brightness
Enum, Brightness -> Brightness -> Bool
(Brightness -> Brightness -> Bool)
-> (Brightness -> Brightness -> Bool) -> Eq Brightness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Brightness -> Brightness -> Bool
$c/= :: Brightness -> Brightness -> Bool
== :: Brightness -> Brightness -> Bool
$c== :: Brightness -> Brightness -> Bool
Eq, Num Brightness
Num Brightness
-> (Brightness -> Brightness -> Brightness)
-> (Brightness -> Brightness)
-> (Rational -> Brightness)
-> Fractional Brightness
Rational -> Brightness
Brightness -> Brightness
Brightness -> Brightness -> Brightness
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Brightness
$cfromRational :: Rational -> Brightness
recip :: Brightness -> Brightness
$crecip :: Brightness -> Brightness
/ :: Brightness -> Brightness -> Brightness
$c/ :: Brightness -> Brightness -> Brightness
$cp1Fractional :: Num Brightness
Fractional, (forall x. Brightness -> Rep Brightness x)
-> (forall x. Rep Brightness x -> Brightness) -> Generic Brightness
forall x. Rep Brightness x -> Brightness
forall x. Brightness -> Rep Brightness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Brightness x -> Brightness
$cfrom :: forall x. Brightness -> Rep Brightness x
Generic, Integer -> Brightness
Brightness -> Brightness
Brightness -> Brightness -> Brightness
(Brightness -> Brightness -> Brightness)
-> (Brightness -> Brightness -> Brightness)
-> (Brightness -> Brightness -> Brightness)
-> (Brightness -> Brightness)
-> (Brightness -> Brightness)
-> (Brightness -> Brightness)
-> (Integer -> Brightness)
-> Num Brightness
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Brightness
$cfromInteger :: Integer -> Brightness
signum :: Brightness -> Brightness
$csignum :: Brightness -> Brightness
abs :: Brightness -> Brightness
$cabs :: Brightness -> Brightness
negate :: Brightness -> Brightness
$cnegate :: Brightness -> Brightness
* :: Brightness -> Brightness -> Brightness
$c* :: Brightness -> Brightness -> Brightness
- :: Brightness -> Brightness -> Brightness
$c- :: Brightness -> Brightness -> Brightness
+ :: Brightness -> Brightness -> Brightness
$c+ :: Brightness -> Brightness -> Brightness
Num, Eq Brightness
Eq Brightness
-> (Brightness -> Brightness -> Ordering)
-> (Brightness -> Brightness -> Bool)
-> (Brightness -> Brightness -> Bool)
-> (Brightness -> Brightness -> Bool)
-> (Brightness -> Brightness -> Bool)
-> (Brightness -> Brightness -> Brightness)
-> (Brightness -> Brightness -> Brightness)
-> Ord Brightness
Brightness -> Brightness -> Bool
Brightness -> Brightness -> Ordering
Brightness -> Brightness -> Brightness
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Brightness -> Brightness -> Brightness
$cmin :: Brightness -> Brightness -> Brightness
max :: Brightness -> Brightness -> Brightness
$cmax :: Brightness -> Brightness -> Brightness
>= :: Brightness -> Brightness -> Bool
$c>= :: Brightness -> Brightness -> Bool
> :: Brightness -> Brightness -> Bool
$c> :: Brightness -> Brightness -> Bool
<= :: Brightness -> Brightness -> Bool
$c<= :: Brightness -> Brightness -> Bool
< :: Brightness -> Brightness -> Bool
$c< :: Brightness -> Brightness -> Bool
compare :: Brightness -> Brightness -> Ordering
$ccompare :: Brightness -> Brightness -> Ordering
$cp1Ord :: Eq Brightness
Ord, ReadPrec [Brightness]
ReadPrec Brightness
Int -> ReadS Brightness
ReadS [Brightness]
(Int -> ReadS Brightness)
-> ReadS [Brightness]
-> ReadPrec Brightness
-> ReadPrec [Brightness]
-> Read Brightness
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Brightness]
$creadListPrec :: ReadPrec [Brightness]
readPrec :: ReadPrec Brightness
$creadPrec :: ReadPrec Brightness
readList :: ReadS [Brightness]
$creadList :: ReadS [Brightness]
readsPrec :: Int -> ReadS Brightness
$creadsPrec :: Int -> ReadS Brightness
Read, Num Brightness
Ord Brightness
Num Brightness
-> Ord Brightness -> (Brightness -> Rational) -> Real Brightness
Brightness -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Brightness -> Rational
$ctoRational :: Brightness -> Rational
$cp2Real :: Ord Brightness
$cp1Real :: Num Brightness
Real, Fractional Brightness
Real Brightness
Real Brightness
-> Fractional Brightness
-> (forall b. Integral b => Brightness -> (b, Brightness))
-> (forall b. Integral b => Brightness -> b)
-> (forall b. Integral b => Brightness -> b)
-> (forall b. Integral b => Brightness -> b)
-> (forall b. Integral b => Brightness -> b)
-> RealFrac Brightness
Brightness -> b
Brightness -> b
Brightness -> b
Brightness -> b
Brightness -> (b, Brightness)
forall b. Integral b => Brightness -> b
forall b. Integral b => Brightness -> (b, Brightness)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Brightness -> b
$cfloor :: forall b. Integral b => Brightness -> b
ceiling :: Brightness -> b
$cceiling :: forall b. Integral b => Brightness -> b
round :: Brightness -> b
$cround :: forall b. Integral b => Brightness -> b
truncate :: Brightness -> b
$ctruncate :: forall b. Integral b => Brightness -> b
properFraction :: Brightness -> (b, Brightness)
$cproperFraction :: forall b. Integral b => Brightness -> (b, Brightness)
$cp2RealFrac :: Fractional Brightness
$cp1RealFrac :: Real Brightness
RealFrac, Int -> Brightness -> ShowS
[Brightness] -> ShowS
Brightness -> String
(Int -> Brightness -> ShowS)
-> (Brightness -> String)
-> ([Brightness] -> ShowS)
-> Show Brightness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Brightness] -> ShowS
$cshowList :: [Brightness] -> ShowS
show :: Brightness -> String
$cshow :: Brightness -> String
showsPrec :: Int -> Brightness -> ShowS
$cshowsPrec :: Int -> Brightness -> ShowS
Show)

instance NFData Brightness

instance Bounded Brightness where
  minBound :: Brightness
minBound = Brightness
0
  maxBound :: Brightness
maxBound = Brightness
1

instance Default Brightness where
  def :: Brightness
def = Brightness
1

-- | Combination of a color value and a 'Brightness'
data WithBrightness a = WithBrightness { WithBrightness a -> Brightness
brightness :: Brightness
                                       , WithBrightness a -> a
color :: a
                                       }
  deriving (WithBrightness a -> WithBrightness a -> Bool
(WithBrightness a -> WithBrightness a -> Bool)
-> (WithBrightness a -> WithBrightness a -> Bool)
-> Eq (WithBrightness a)
forall a. Eq a => WithBrightness a -> WithBrightness a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithBrightness a -> WithBrightness a -> Bool
$c/= :: forall a. Eq a => WithBrightness a -> WithBrightness a -> Bool
== :: WithBrightness a -> WithBrightness a -> Bool
$c== :: forall a. Eq a => WithBrightness a -> WithBrightness a -> Bool
Eq, (forall x. WithBrightness a -> Rep (WithBrightness a) x)
-> (forall x. Rep (WithBrightness a) x -> WithBrightness a)
-> Generic (WithBrightness a)
forall x. Rep (WithBrightness a) x -> WithBrightness a
forall x. WithBrightness a -> Rep (WithBrightness a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (WithBrightness a) x -> WithBrightness a
forall a x. WithBrightness a -> Rep (WithBrightness a) x
$cto :: forall a x. Rep (WithBrightness a) x -> WithBrightness a
$cfrom :: forall a x. WithBrightness a -> Rep (WithBrightness a) x
Generic, Eq (WithBrightness a)
Eq (WithBrightness a)
-> (WithBrightness a -> WithBrightness a -> Ordering)
-> (WithBrightness a -> WithBrightness a -> Bool)
-> (WithBrightness a -> WithBrightness a -> Bool)
-> (WithBrightness a -> WithBrightness a -> Bool)
-> (WithBrightness a -> WithBrightness a -> Bool)
-> (WithBrightness a -> WithBrightness a -> WithBrightness a)
-> (WithBrightness a -> WithBrightness a -> WithBrightness a)
-> Ord (WithBrightness a)
WithBrightness a -> WithBrightness a -> Bool
WithBrightness a -> WithBrightness a -> Ordering
WithBrightness a -> WithBrightness a -> WithBrightness a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (WithBrightness a)
forall a. Ord a => WithBrightness a -> WithBrightness a -> Bool
forall a. Ord a => WithBrightness a -> WithBrightness a -> Ordering
forall a.
Ord a =>
WithBrightness a -> WithBrightness a -> WithBrightness a
min :: WithBrightness a -> WithBrightness a -> WithBrightness a
$cmin :: forall a.
Ord a =>
WithBrightness a -> WithBrightness a -> WithBrightness a
max :: WithBrightness a -> WithBrightness a -> WithBrightness a
$cmax :: forall a.
Ord a =>
WithBrightness a -> WithBrightness a -> WithBrightness a
>= :: WithBrightness a -> WithBrightness a -> Bool
$c>= :: forall a. Ord a => WithBrightness a -> WithBrightness a -> Bool
> :: WithBrightness a -> WithBrightness a -> Bool
$c> :: forall a. Ord a => WithBrightness a -> WithBrightness a -> Bool
<= :: WithBrightness a -> WithBrightness a -> Bool
$c<= :: forall a. Ord a => WithBrightness a -> WithBrightness a -> Bool
< :: WithBrightness a -> WithBrightness a -> Bool
$c< :: forall a. Ord a => WithBrightness a -> WithBrightness a -> Bool
compare :: WithBrightness a -> WithBrightness a -> Ordering
$ccompare :: forall a. Ord a => WithBrightness a -> WithBrightness a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (WithBrightness a)
Ord, ReadPrec [WithBrightness a]
ReadPrec (WithBrightness a)
Int -> ReadS (WithBrightness a)
ReadS [WithBrightness a]
(Int -> ReadS (WithBrightness a))
-> ReadS [WithBrightness a]
-> ReadPrec (WithBrightness a)
-> ReadPrec [WithBrightness a]
-> Read (WithBrightness a)
forall a. Read a => ReadPrec [WithBrightness a]
forall a. Read a => ReadPrec (WithBrightness a)
forall a. Read a => Int -> ReadS (WithBrightness a)
forall a. Read a => ReadS [WithBrightness a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WithBrightness a]
$creadListPrec :: forall a. Read a => ReadPrec [WithBrightness a]
readPrec :: ReadPrec (WithBrightness a)
$creadPrec :: forall a. Read a => ReadPrec (WithBrightness a)
readList :: ReadS [WithBrightness a]
$creadList :: forall a. Read a => ReadS [WithBrightness a]
readsPrec :: Int -> ReadS (WithBrightness a)
$creadsPrec :: forall a. Read a => Int -> ReadS (WithBrightness a)
Read, Int -> WithBrightness a -> ShowS
[WithBrightness a] -> ShowS
WithBrightness a -> String
(Int -> WithBrightness a -> ShowS)
-> (WithBrightness a -> String)
-> ([WithBrightness a] -> ShowS)
-> Show (WithBrightness a)
forall a. Show a => Int -> WithBrightness a -> ShowS
forall a. Show a => [WithBrightness a] -> ShowS
forall a. Show a => WithBrightness a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithBrightness a] -> ShowS
$cshowList :: forall a. Show a => [WithBrightness a] -> ShowS
show :: WithBrightness a -> String
$cshow :: forall a. Show a => WithBrightness a -> String
showsPrec :: Int -> WithBrightness a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithBrightness a -> ShowS
Show)

instance NFData a => NFData (WithBrightness a)

instance Default a => Default (WithBrightness a) where
  def :: WithBrightness a
def = WithBrightness :: forall a. Brightness -> a -> WithBrightness a
WithBrightness { brightness :: Brightness
brightness = Brightness
forall a. Default a => a
def
                       , color :: a
color = a
forall a. Default a => a
def
                       }

instance CompatibleValues a b => CompatibleValues a (WithBrightness b) where
  convertValue :: a -> WithBrightness b
convertValue a
a = WithBrightness :: forall a. Brightness -> a -> WithBrightness a
WithBrightness { brightness :: Brightness
brightness = Brightness
forall a. Default a => a
def
                                  , color :: b
color = a -> b
forall a b. CompatibleValues a b => a -> b
convertValue a
a
                                  }

applyBrightnessToRGB :: (Integral a, Real a) => WithBrightness (RGB a) -> RGB a
applyBrightnessToRGB :: WithBrightness (RGB a) -> RGB a
applyBrightnessToRGB WithBrightness (RGB a)
x = RGB :: forall a. a -> a -> a -> RGB a
RGB { red :: a
red = a -> a
applyBrightness a
red'
                             , green :: a
green = a -> a
applyBrightness a
green'
                             , blue :: a
blue = a -> a
applyBrightness a
blue'
                             }
  where applyBrightness :: a -> a
applyBrightness = Rational -> a
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational -> a) -> (a -> Rational) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Brightness -> Rational
forall a. Real a => a -> Rational
toRational (WithBrightness (RGB a) -> Brightness
forall a. WithBrightness a -> Brightness
brightness WithBrightness (RGB a)
x) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*) (Rational -> Rational) -> (a -> Rational) -> a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rational
forall a. Real a => a -> Rational
toRational
        RGB { red :: forall a. RGB a -> a
red = a
red', green :: forall a. RGB a -> a
green = a
green', blue :: forall a. RGB a -> a
blue = a
blue' } = WithBrightness (RGB a) -> RGB a
forall a. WithBrightness a -> a
color WithBrightness (RGB a)
x