~alcinnz/Mondrian

ref: 6a5ce3310a03f501742a9d7cadefa98b12c5d9ff Mondrian/lib/Graphics/Rendering/Rect/CSS.hs -rw-r--r-- 1.2 KiB
6a5ce331 — Adrian Cochrane Constrain textures to limited commonly-supported colourspaces. 1 year, 4 months ago
                                                                                
94547420 Adrian Cochrane
4c875d8e Adrian Cochrane
a3455462 Adrian Cochrane
6236cf8a Adrian Cochrane
94547420 Adrian Cochrane
a3455462 Adrian Cochrane
94547420 Adrian Cochrane
a08fe055 Adrian Cochrane
94547420 Adrian Cochrane
a3455462 Adrian Cochrane
94547420 Adrian Cochrane
4c875d8e Adrian Cochrane
a3455462 Adrian Cochrane
87e471d4 Adrian Cochrane
a3455462 Adrian Cochrane
4c875d8e Adrian Cochrane
a3455462 Adrian Cochrane
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
27
28
29
30
31
{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
module Graphics.Rendering.Rect.CSS(RectStyle(..), colour) where

import Stylist (PropertyParser(..))
import Graphics.Rendering.Rect.CSS.Colour (ColourPallet(foreground))
import Graphics.Rendering.Rect.CSS.Backgrounds (Backgrounds(..))
import Data.Text (Text)

data RectStyle img = RectStyle {
    colours :: ColourPallet,
    backgrounds :: Backgrounds img
} deriving (Eq, Show, Read)
colour = foreground . colours

instance PropertyParser (RectStyle Text) where
    temp = RectStyle { colours = temp, backgrounds = temp }
    inherit RectStyle {..} = RectStyle {
        colours = inherit colours, backgrounds = temp
    }

    shorthand self key value
        | ret@(_:_) <- shorthand (backgrounds self) key value = ret
        | Just _ <- longhand self self key value = [(key, value)]
        | otherwise = []
    longhand parent self key value
        | Just ret <- longhand (backgrounds parent) { pallet = colours parent }
                (backgrounds self) { pallet = colours self } key value =
            Just self { backgrounds = ret }
        | Just ret <- longhand (colours parent) (colours self) key value =
            Just self { colours = ret }
        | otherwise = Nothing