module FRP.UISF.Graphics.Color (
Color(..), RGB, colorToRGB, rgb, rgbE, extractRGB,
) where
import Data.Ix (Ix)
import Control.DeepSeq
data Color = Black
| Blue
| Green
| Cyan
| Red
| Magenta
| Yellow
| White
| Gray
| VLightBeige
| LightBeige
| MediumBeige
| DarkBeige
deriving (Eq, Ord, Bounded, Enum, Ix, Show, Read)
instance NFData Color where
rnf (!_) = ()
newtype RGB = RGB (Int, Int, Int)
deriving (Eq)
instance Show RGB where
show (RGB (r, g, b)) = "{R="++show r++",G="++show g++",B="++show b++"}"
instance NFData RGB where
rnf (RGB rgb) = rnf rgb
colorToRGB :: Color -> RGB
colorToRGB Black = RGB (0, 0, 0)
colorToRGB Blue = RGB (0, 0, 255)
colorToRGB Green = RGB (0, 255, 0)
colorToRGB Cyan = RGB (0, 255, 255)
colorToRGB Red = RGB (255, 0, 0)
colorToRGB Magenta = RGB (255, 0, 255)
colorToRGB Yellow = RGB (255, 255, 0)
colorToRGB White = RGB (255, 255, 255)
colorToRGB Gray = RGB (128, 128, 128)
colorToRGB VLightBeige = rgbE 0xf1 0xef 0xe2
colorToRGB LightBeige = rgbE 0xec 0xe9 0xd8
colorToRGB MediumBeige = rgbE 0xac 0xa8 0x99
colorToRGB DarkBeige = rgbE 0x71 0x6f 0x64
rgb :: (Integral r, Integral g, Integral b) => r -> g -> b -> Maybe RGB
rgb r g b = do
r' <- bound r
g' <- bound g
b' <- bound b
return $ RGB (r',g',b')
where
bound :: (Integral i, Integral o) => i -> Maybe o
bound i = if i > 255 || i < 0 then Nothing else Just (fromIntegral i)
rgbE :: (Integral r, Integral g, Integral b,
Show r, Show g, Show b) => r -> g -> b -> RGB
rgbE r g b = case rgb r g b of
Just x -> x
Nothing -> error $ "Invalid values given to rgbE: " ++ show (r,g,b)
extractRGB :: (Integral r, Integral g, Integral b) => RGB -> (r,g,b)
extractRGB (RGB (r, g, b)) = (fromIntegral r, fromIntegral g, fromIntegral b)