~alcinnz/Mondrian

ref: 7a7ce8ffa2aadc1747f9333e9096f6f55beb5f6f Mondrian/lib/Graphics/Rendering/Rect/CSS/Background.hs -rw-r--r-- 933 bytes
7a7ce8ff — Adrian Cochrane Implement background-colour rendering! 1 year, 4 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Rendering.Rect.CSS.Background (Backgrounds(..)) where

import Stylist (PropertyParser(..), parseUnorderedShorthand)
import Graphics.Rendering.Rect.CSS.Colour (ColourPallet, parseColour)
import Data.Colour (AlphaColour, transparent)

data Backgrounds = Backgrounds {
    pallet :: ColourPallet,
    background :: AlphaColour Float
}

instance PropertyParser Backgrounds where
    temp = Backgrounds { pallet = temp, background = transparent }
    inherit _ = temp
    priority _ = []

    longhand _ self@Backgrounds{ pallet = c } "background-color" toks
        | Just ([], val) <- parseColour c toks = Just self { background = val }
    longhand _ _ _ _ = Nothing

    shorthand self "background" toks = parseUnorderedShorthand self [
        "background-color"
      ] toks
    shorthand self key val | Just _ <- longhand self self key val = [(key, val)]
        | otherwise = []