~alcinnz/Mondrian

ref: b81c9e69d221df1bada189ac34d2bb8e95fa49d7 Mondrian/lib/Graphics/Rendering/Rect/CSS.hs -rw-r--r-- 1.8 KiB
b81c9e69 — Adrian Cochrane Add dashed, dotted, & double border styles! 1 year, 5 months ago
                                                                                
94547420 Adrian Cochrane
350eab76 Adrian Cochrane
a3455462 Adrian Cochrane
6236cf8a Adrian Cochrane
c5cdc91e Adrian Cochrane
94547420 Adrian Cochrane
745d80f2 Adrian Cochrane
a3455462 Adrian Cochrane
94547420 Adrian Cochrane
a08fe055 Adrian Cochrane
c5cdc91e Adrian Cochrane
94547420 Adrian Cochrane
745d80f2 Adrian Cochrane
a3455462 Adrian Cochrane
c5cdc91e Adrian Cochrane
a3455462 Adrian Cochrane
94547420 Adrian Cochrane
c5cdc91e Adrian Cochrane
4c875d8e Adrian Cochrane
c5cdc91e Adrian Cochrane
4c875d8e Adrian Cochrane
c5cdc91e Adrian Cochrane
a3455462 Adrian Cochrane
87e471d4 Adrian Cochrane
c5cdc91e Adrian Cochrane
a3455462 Adrian Cochrane
c5cdc91e Adrian Cochrane
4c875d8e Adrian Cochrane
a3455462 Adrian Cochrane
c5cdc91e 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
32
33
34
35
36
37
38
39
40
41
42
{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
module Graphics.Rendering.Rect.CSS(RectStyle(..), colour, border) where

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

data RectStyle img = RectStyle {
    colours :: ColourPallet,
    backgrounds :: Backgrounds img,
    border' :: Border
} deriving (Eq, Show, Read)
colour :: RectStyle img -> AlphaColour Float
colour = foreground . colours
border :: RectStyle img -> Border
border self = (border' self) { borderPallet = colours self }

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

    shorthand self key value
        | ret@(_:_) <- shorthand (backgrounds self) key value = ret
        | ret@(_:_) <- shorthand (border 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 self }
                (backgrounds self) { pallet = colours self } key value =
            Just self { backgrounds = ret }
        | Just ret <- longhand (colours parent) (colours self) key value =
            Just self { colours = ret }
        | Just ret <- longhand (border parent) (border self) key value =
            Just self { border' = ret }
        | otherwise = Nothing