module SFML.Graphics.Color ( Color(..) , black , white , red , green , blue , yellow , magenta , cyan , transparent ) where import Control.Applicative ((<$>), (<*>)) import Data.Bits ((.&.), shiftR) import Data.Word (Word8, Word32) import Foreign.Storable #include -- | Utility data type for manpulating RGBA colors. data Color = Color { r :: Word8 , g :: Word8 , b :: Word8 , a :: Word8 } deriving (Eq, Show) instance Storable Color where sizeOf _ = 4 * sizeOf (undefined :: Word8) alignment _ = alignment (undefined :: Word8) peek ptr = Color <$> #{peek sfColor, r} ptr <*> #{peek sfColor, g} ptr <*> #{peek sfColor, b} ptr <*> #{peek sfColor, a} ptr poke ptr (Color r g b a) = do #{poke sfColor, r} ptr r #{poke sfColor, g} ptr g #{poke sfColor, b} ptr b #{poke sfColor, a} ptr a black = Color 0 0 0 255 white = Color 255 255 255 255 red = Color 255 0 0 255 green = Color 0 255 0 255 blue = Color 0 0 255 255 yellow = Color 255 255 0 255 magenta = Color 255 0 255 255 cyan = Color 0 255 255 255 transparent = Color 0 0 0 0 instance Num Color where (Color r1 g1 b1 a1) + (Color r2 g2 b2 a2) = Color (r1+r2) (g1+g2) (b1+b2) (a1+a2) (Color r1 g1 b1 a1) - (Color r2 g2 b2 a2) = Color (r1-r2) (g1-g2) (b1-b2) (a1-a2) (Color r1 g1 b1 a1) * (Color r2 g2 b2 a2) = Color (r1*r2) (g1*g2) (b1*b2) (a1*a2) negate (Color r g b a) = Color (-r) (-g) (-b) (-a) abs (Color r g b a) = Color (abs r) (abs g) (abs b) (abs a) signum (Color r g b a) = Color (signum r) (signum g) (signum b) (signum a) fromInteger i' = let i = fromIntegral i' :: Word32 r = fromIntegral $ (i .&. 0xFF000000) `shiftR` 24 g = fromIntegral $ (i .&. 0x00FF0000) `shiftR` 16 b = fromIntegral $ (i .&. 0x0000FF00) `shiftR` 8 a = fromIntegral $ i .&. 0x000000FF in Color r g b a