~alcinnz/Mondrian

ref: 7564554b3527f7e220c09c24cc9f8035d3f196b0 Mondrian/lib/Graphics/Rendering/Rect/CSS.hs -rw-r--r-- 1.8 KiB
7564554b — Adrian Cochrane Commit border renderer, make them trapazoidal. 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