module WeekDaze.Colour.RGB(
RGB(),
black,
white24Bit,
radix,
absDifference,
toTriple,
mkRGB,
mkRGB24Bit,
fromIntegral',
(>+<),
toRGBUnitInterval,
fromRGBUnitInterval
) where
import qualified Control.Arrow
infixl 6 >+<
infixl 6 >-<
data RGB primaryColour = MkRGB primaryColour primaryColour primaryColour deriving (Eq, Show)
mkRGB
:: a
-> a
-> a
-> RGB a
mkRGB = MkRGB
instance Functor RGB where
f `fmap` MkRGB red green blue = mkRGB (f red) (f green) (f blue)
mkRGBUnitInterval
:: (Fractional a, Ord a, Show a)
=> a
-> a
-> a
-> RGB a
mkRGBUnitInterval red green blue
| any ($ [red, green, blue]) [any (< 0), any (> 1)] = error $ "WeekDaze.Colour.RGB.mkRGBUnitInterval:\teach of the specified fractional component-colours must be in the unit-interval; " ++ show (red, green, blue)
| otherwise = mkRGB red green blue
mkRGB24Bit
:: (Integral a, Show a)
=> a
-> a
-> a
-> RGB a
mkRGB24Bit red green blue
| any ($ [red, green, blue]) [any (< 0), any (> saturated)] = error $ "WeekDaze.Colour.RGB.mkRGB24Bit:\teach of the specified integral component-colours must be in the closed interval [0," ++ show (saturated :: Int) ++ "]; " ++ show (red, green, blue)
| otherwise = mkRGB red green blue
radix :: Integral i => i
radix = 2 ^ (8 :: Int)
fromIntegral' :: (Integral i, Show i) => i -> RGB i
fromIntegral' i
| i < 0 = error $ "WeekDaze.Colour.RGB.fromIntegral':\tthe specified value can't be negative; " ++ show i
| i > radix ^ (3 :: Int) = error $ "WeekDaze.Colour.RGB.fromIntegral':\tthe specified value is too large; " ++ show i
| otherwise = (
\((red, green), blue) -> mkRGB24Bit red green blue
) . Control.Arrow.first (`divMod` radix) $ i `divMod` radix
toTriple :: RGB a -> (a, a, a)
toTriple (MkRGB red green blue) = (red, green, blue)
saturated :: Integral i => i
saturated = pred radix
black :: Num n => RGB n
black = mkRGB 0 0 0
white24Bit :: (Integral n, Show n) => RGB n
white24Bit = mkRGB24Bit saturated saturated saturated
combine
:: (a -> a -> a)
-> RGB a
-> RGB a
-> RGB a
combine f (MkRGB rL gL bL) (MkRGB rR gR bR) = mkRGB (rL `f` rR) (gL `f` gR) (bL `f` bR)
(>+<) :: Num n => RGB n -> RGB n -> RGB n
(>+<) = combine (+)
(>-<) :: Num n => RGB n -> RGB n -> RGB n
(>-<) = combine (-)
absDifference :: Num n => RGB n -> RGB n -> RGB n
absDifference x y = abs `fmap` (x >-< y)
toRGBUnitInterval :: (Integral i, Fractional f) => RGB i -> RGB f
toRGBUnitInterval = fmap $ (/ fromInteger radix) . fromIntegral
fromRGBUnitInterval :: (Integral i, RealFrac f) => RGB f -> RGB i
fromRGBUnitInterval = fmap $ min saturated . floor . (* fromInteger radix)