~alcinnz/Mondrian

ref: a22a7f055c206193392f8adbb1dcea79eb7d2e20 Mondrian/lib/Graphics/Rendering/Rect/CSS.hs -rw-r--r-- 1.8 KiB
a22a7f05 — Adrian Cochrane Implement groove, ridge, inset, & outset border styles! Fix border-left-color 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