RGB.hs

{-
	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 <http://www.gnu.org/licenses/>.
-}
{- |
 [@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)