{-# 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