{- Copyright (C) 2015 Dr. Alistair Ward This file is part of WeekDaze. WeekDaze is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. WeekDaze is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with WeekDaze. If not, see . -} {- | [@AUTHOR@] Dr. Alistair Ward [@DESCRIPTION@] Exports a representation of a colour as primary components. -} module WeekDaze.Colour.RGB( -- * Types -- ** Data-types RGB(), -- * Constants black, white24Bit, radix, -- saturated, -- * Functions absDifference, -- combine, toTriple, -- ** Constructors mkRGB, -- mkRGBUnitInterval, mkRGB24Bit, fromIntegral', -- ** Operators -- (>-<), (>+<), -- ** Translation toRGBUnitInterval, fromRGBUnitInterval ) where import qualified Control.Arrow infixl 6 >+< -- Like (+). infixl 6 >-< -- Like (-). -- | The representation of a colour as three primary components. data RGB primaryColour = MkRGB primaryColour primaryColour primaryColour deriving (Eq, Show) -- | Constructor. mkRGB :: a -- ^ Red. -> a -- ^ Green. -> a -- ^ Blue. -> RGB a mkRGB = MkRGB instance Functor RGB where f `fmap` MkRGB red green blue = mkRGB (f red) (f green) (f blue) -- CAVEAT: the bounds are neither checked nor even known. -- | Smart-constructor. mkRGBUnitInterval :: (Fractional a, Ord a, Show a) => a -- ^ Red. -> a -- ^ Green. -> a -- ^ Blue. -> 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 -- | Smart-constructor. mkRGB24Bit :: (Integral a, Show a) => a -- ^ Red. -> a -- ^ Green. -> a -- ^ Blue. -> 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 -- | Constant base of number-system used to represent 24-bit colours in HTML. radix :: Integral i => i radix = 2 ^ (8 :: Int) -- | Represents the specified positive integral value as RGB 24-bit. 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 -- | Deconstructor. toTriple :: RGB a -> (a, a, a) toTriple (MkRGB red green blue) = (red, green, blue) -- | The constant base of number-system used to represent colours in HTML. saturated :: Integral i => i saturated = pred radix -- | The constant representation of /black/ in RGB. black :: Num n => RGB n black = mkRGB 0 0 0 -- | The constant representation of /white/ in RGB. white24Bit :: (Integral n, Show n) => RGB n white24Bit = mkRGB24Bit saturated saturated saturated -- | Combine two RGB-representations using the specified function to combine each primary colour. 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) {- | * Add the matching component colours. * CAVEAT: this may result in overflow. -} (>+<) :: Num n => RGB n -> RGB n -> RGB n (>+<) = combine (+) {- | * Find the difference between the matching component colours. * CAVEAT: negative values may result. -} (>-<) :: Num n => RGB n -> RGB n -> RGB n (>-<) = combine (-) -- | Find the absolute difference between the matching component colours. absDifference :: Num n => RGB n -> RGB n -> RGB n absDifference x y = abs `fmap` (x >-< y) -- | Convert RGB 24-bit to RGB UnitInterval, i.e. map from the closed interval [0,255] to the semi-closed interval [0,1). toRGBUnitInterval :: (Integral i, Fractional f) => RGB i -> RGB f toRGBUnitInterval = fmap $ (/ fromInteger radix) . fromIntegral -- | Convert RGB UnitInterval to RGB 24-bit, i.e. map from the semi-closed interval [0,1) to the closed interval [0,255]. fromRGBUnitInterval :: (Integral i, RealFrac f) => RGB f -> RGB i fromRGBUnitInterval = fmap $ min saturated {-CAVEAT: regrettably, we actually have to work with the closed interval [0,1] and 1 must still map to 255 not 256 (i.e. 0 in modulo-256 arithmetic-} . floor . (* fromInteger radix)