{-# LANGUAGE OverloadedStrings #-}
module Graphics.Rendering.Rect.CSS.Colour(parseColour) where
import Data.Colour (AlphaColour, withOpacity, opaque)
import Data.Colour.SRGB (sRGB, sRGB24)
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Scientific (toRealFloat)
import Data.Word (Word8)
import Data.Bits (toIntegralSized)
parseColour :: [Token] -> Maybe ([Token], AlphaColour Float)
parseColour (Function "rgb":Percentage _ r:Comma:
Percentage _ g:Comma:Percentage _ b:RightParen:toks) =
Just (toks, opaque $ sRGB (pc r) (pc g) (pc b))
parseColour (Function "rgba":Percentage _ r:Comma:
Percentage _ g:Comma:Percentage _ b:Comma:a':RightParen:toks)
| Just a <- f' a' = Just (toks, sRGB (pc r) (pc g) (pc b) `withOpacity` a)
parseColour (Function "rgb":Number _ (NVInteger r):Comma:
Number _ (NVInteger g):Comma:Number _ (NVInteger b):RightParen:toks) =
Just (toks, opaque $ sRGB24 (w r) (w g) (w b))
parseColour (Function "rgba":Number _ (NVInteger r):Comma:
Number _ (NVInteger g):Comma:Number _ (NVInteger b):Comma:
a':RightParen:toks) | Just a <- f' a' =
Just (toks, sRGB24 (w r) (w g) (w b) `withOpacity` a)
parseColour (Function "rgb":r':g':b':RightParen:toks)
| Just r <- w' r', Just g <- w' g', Just b <- w' b' =
Just (toks, opaque $ sRGB24 r g b)
parseColour (Function "rgb":r':g':b':Delim '/':a':RightParen:toks)
| Just r <- w' r', Just g <- w' g', Just b <- w' b', Just a <- f' a' =
Just (toks, sRGB24 r g b `withOpacity` a)
parseColour _ = Nothing
pc :: NumericValue -> Float
pc x = f x / 100
pc' :: Token -> Maybe Float
pc' (Ident "none") = Just 0
pc' (Percentage _ x) = Just $ pc x
pc' _ = Nothing
f :: NumericValue -> Float
f (NVInteger x) = fromIntegral x
f (NVNumber x) = toRealFloat x
f' :: Token -> Maybe Float
f' (Ident "none") = Just 0
f' (Percentage _ x) = Just $ pc x
f' (Number _ x) = Just $ f x
f' _ = Nothing
w :: Integer -> Word8
w = fromInteger
w' :: Token -> Maybe Word8
w' (Ident "none") = Just 0
w' (Number _ (NVInteger x)) | x >= 0 && x <= 255 = Just $ fromIntegral $ w x
w' (Percentage _ x) = Just $ toEnum $ fromEnum (pc x * 255)
w' _ = Nothing