{- | This module provides 'Colour8', which stores linear RGB (red, green, blue) colour values where each channel is a @Word8@. It also provides arithmetic over such colours, and a few predefined colours. It is the general intention that \"most\" work will be done with "Data.Colour.Double", with values converted to @Colour8@ only as a final step. However, full arithmetic is supported anyway, in case anybody wants to work that way. It is slightly less efficient and flexible, however. Beware that \"most\" RGB data found in external sources is in the (non-linear) sRGB colour space, not the /linear/ RGB colour space used here. See "Data.Colour.Nonlinear" for conversion functions. -} module Data.Colour.Word8 where import Data.Word {- | The integral colour. It stores three channels (red, green and blue) as linear 'Word8' values ranging from 0 to 255. (0 represents minimum intensity, 255 represents maximum. Black is therefore @Colour8 0 0 0@ and white is @Colour8 255 255 255@.) The channel values are stored as strict, unboxed fields, so operating on @Colour8@s should be quite efficient in time and space. The 'Num' and 'Fractional' instances provide arithmetic for @Colour8@s. Note that @(*)@ acts channel-wise; this is usually what is wanted. -} data Colour8 = Colour8 {red8, green8, blue8 :: {-# UNPACK #-} !Word8} deriving (Eq, Ord, Show) {- | Apply a function to every channel of a @Colour8@. (Mostly used internally; exposed here in case it might be useful.) -} c8map :: (Word8 -> Word8) -> Colour8 -> Colour8 c8map f (Colour8 r g b) = Colour8 (f r) (f g) (f b) {- | The colour equivilent of 'Data.List.zipWith'. (Mostly used internally; exposed here in case it might be useful.) -} c8zip :: (Word8 -> Word8 -> Word8) -> Colour8 -> Colour8 -> Colour8 c8zip f (Colour8 r1 g1 b1) (Colour8 r2 g2 b2) = Colour8 (f r1 r2) (f g1 g2) (f b1 b2) {- | Use a function to fold the three values in a @Colour8@ into a single value. No particular order of application is promised. -} c8fold :: (Word8 -> Word8 -> Word8) -> Colour8 -> Word8 c8fold f (Colour8 r g b) = f r (f g b) {- | Convert a @Word8@ into a shade of grey. -} grey8 :: Word8 -> Colour8 grey8 x = Colour8 x x x {- | Scale a @Colour8@ by the specified amount. Recall that 0x00 means zero, and 0xFF means one. This means that it is impossible to make a colour /brighter/, only darker. It also means this operation is modestly inefficient due to the renormalisation steps. -} c8scale :: Word8 -> Colour8 -> Colour8 c8scale x c = grey8 x * c instance Num Colour8 where (+) = c8zip (+) (-) = c8zip (-) (*) = c8zip (\x y -> let (x', y') = (fromIntegral x, fromIntegral y) :: (Word16, Word16) in fromIntegral (x' * y' `div` 0x00FF)) negate = c8map negate abs = c8map abs signum = c8map signum fromInteger = grey8 . fromInteger -- | Convert a 'Colour8' to a tuple. unpack8 :: Colour8 -> (Word8, Word8, Word8) unpack8 (Colour8 r g b) = (r,g,b) -- | Convert a tuple to a 'Colour8'. pack8 :: (Word8, Word8, Word8) -> Colour8 pack8 (r,g,b) = Colour8 r g b -- | Constant: Black. c8Black :: Colour8 c8Black = Colour8 0x00 0x00 0x00 -- | Constant: Red. c8Red :: Colour8 c8Red = Colour8 0xFF 0x00 0x00 -- | Constant: Yellow. c8Yellow :: Colour8 c8Yellow = Colour8 0xFF 0xFF 0x00 -- | Constant: Green. c8Green :: Colour8 c8Green = Colour8 0x00 0xFF 0x00 -- | Constant: Cyan. c8Cyan :: Colour8 c8Cyan = Colour8 0x00 0xFF 0xFF -- | Constant: Blue. c8Blue :: Colour8 c8Blue = Colour8 0x00 0x00 0xFF -- | Constant: Magenta. c8Magenta :: Colour8 c8Magenta = Colour8 0xFF 0x00 0xFF -- | Constant: White. c8White :: Colour8 c8White = Colour8 0xFF 0xFF 0xFF