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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
{-# LANGUAGE OverloadedStrings #-}
-- | Parses & desugars CSS properties to general CatTrap datastructures.
module Graphics.Layout.CSS(CSSBox(..), BoxSizing(..), Display(..),
finalizeCSS, finalizeCSS') where
import qualified Data.Text as Txt
import Stylist (PropertyParser(..))
import Stylist.Tree (StyleTree(..))
import Data.Text.ParagraphLayout.Rich (paragraphLineHeight, constructParagraph,
defaultParagraphOptions, defaultBoxOptions,
LineHeight(..), InnerNode(..), Box(..), RootNode(..))
import Graphics.Layout.Box as B
import Graphics.Layout
import Graphics.Layout.CSS.Length
import Graphics.Layout.CSS.Font
import Graphics.Layout.Grid.CSS
import Graphics.Layout.Inline.CSS
import Data.Char (isSpace)
import Graphics.Layout.CSS.Parse
-- | Desugar parsed CSS into more generic layout parameters.
finalizeCSS :: PropertyParser x => Font' -> Font' -> StyleTree (CSSBox x) ->
LayoutItem Length Length x
finalizeCSS root parent StyleTree { style = self'@CSSBox { display = None } } =
LayoutFlow (inner self') lengthBox []
finalizeCSS root parent self@StyleTree {
style = self'@CSSBox { display = Grid, inner = val }, children = childs
} = LayoutFlow val (finalizeBox self' font_) [
finalizeGrid (gridStyles self') font_ (map cellStyles $ map style childs)
(finalizeChilds root font_ self' childs)]
where
font_ = pattern2font (font self') (font' self') parent root
finalizeCSS root parent self@StyleTree {
style = self'@CSSBox { display = Table, captionBelow = False }, children = childs
} = LayoutFlow (inner self') (finalizeBox self' font_)
([finalizeCSS root font_ child { style = child' { display = Block } }
| child@StyleTree { style = child'@CSSBox { display = TableCaption } } <- childs] ++
[finalizeTable root font_ (inner self') childs])
where
font_ = pattern2font (font self') (font' self') parent root
finalizeCSS root parent self@StyleTree {
style = self'@CSSBox { display = Table, captionBelow = True }, children = childs
} = LayoutFlow (inner self') (finalizeBox self' font_)
(finalizeTable root font_ temp childs:
[finalizeCSS root font_ child { style = child' { display = Block } }
| child@StyleTree { style = child'@CSSBox { display = TableCaption } } <- childs])
where
font_ = pattern2font (font self') (font' self') parent root
finalizeCSS root parent self@StyleTree {
style = self'@CSSBox { inner = val }, children = childs
} = LayoutFlow val (finalizeBox self' font_) (finalizeChilds root font_ self' childs)
where
font_ = pattern2font (font self') (font' self') parent root
finalizeCSS' sysfont self@StyleTree { style = self' } =
finalizeCSS (pattern2font (font self') (font' self') sysfont sysfont) sysfont self
-- | Desugar a sequence of child nodes, taking care to capture runs of inlines.
finalizeChilds :: PropertyParser x => Font' -> Font' -> CSSBox x ->
[StyleTree (CSSBox x)] -> [LayoutItem Length Length x]
finalizeChilds root parent style' (StyleTree { style = CSSBox { display = None } }:childs) =
finalizeChilds root parent style' childs
finalizeChilds root parent style' childs@(child:childs')
| isInlineTree childs, Just self <- finalizeParagraph (flattenTree0 childs) =
[LayoutInline (inherit $ inner style') self paging]
| (inlines@(_:_), blocks) <- spanInlines childs,
Just self <- finalizeParagraph (flattenTree0 inlines) =
LayoutInline (inherit $ inner style') self paging :
finalizeChilds root parent style' blocks
| (StyleTree { style = CSSBox { display = Inline } }:childs') <- childs =
finalizeChilds root parent style' childs' -- Inline's all whitespace...
| otherwise = finalizeCSS root parent child : finalizeChilds root parent style' childs'
where
paging = pageOptions $ style child
isInlineTree = all isInlineTree0
isInlineTree0 StyleTree { style = CSSBox { display = Inline }, children = childs } =
isInlineTree childs
isInlineTree0 _ = False
spanInlines childs = case span isInlineTree0 childs of
(inlines, (StyleTree {
style = CSSBox { display = Inline }, children = tail
}:blocks)) -> let (inlines', blocks') = spanInlines tail
in (inlines ++ inlines', blocks' ++ blocks)
ret -> ret
flattenTree0 childs = RootBox $ Box (map (flattenTree parent) $
enumerate childs) $ flip applyFontInline parent $ txtOpts style'
flattenTree p (i, StyleTree { children = child@(_:_), style = self }) =
InlineBox ((f, i), finalizeBox self f, inner self)
(Box (map (flattenTree f) $ enumerate child)
$ flip applyFontInline f $ txtOpts self)
defaultBoxOptions -- Fill in during layout.
where f = pattern2font (font self) (font' self) p root
flattenTree f (i,StyleTree {style=self@CSSBox {inlineStyles=CSSInline txt _ _}})
= InlineBox ((f, i), finalizeBox self f, inner self)
(Box [TextSequence ((f, 0), zero, inherit $ inner self) txt] $
flip applyFontInline f $ txtOpts self)
defaultBoxOptions -- Fill in during layout.
finalizeParagraph (RootBox (Box [TextSequence _ txt] _))
| Txt.all isSpace txt = Nothing -- Discard isolated whitespace.
finalizeParagraph tree =
Just $ constructParagraph "" tree "" defaultParagraphOptions {
paragraphLineHeight = Absolute $ toEnum $ fromEnum
(lineheight parent * hbUnit)
}
enumerate = zip $ enumFrom 0
finalizeChilds _ _ _ [] = []
-- | Desugar most units, possibly in reference to given font.
finalizeBox self@CSSBox { cssBox = box } font_ =
mapY' (flip finalizeLength font_) $ mapX' (flip finalizeLength font_) box
-- | (Unused, incomplete) Desugar a styletree of table elements to a grid layout.
finalizeTable root parent val childs = LayoutFlow val lengthBox [] -- Placeholder!
{- finalizeTable root parent val childs = LayoutGrid val grid $ zip cells' childs'
where -- FIXME? How to handle non-table items in <table>?
grid = Grid {
rows = take width $ repeat ("", (0,"auto")),
rowBounds = [],
subgridRows = 0,
columns = take height $ repeat ("", (0,"auto")),
colBounds = [],
subgridCols = 0,
gap = Size (0,"px") (0,"px"), -- FIXME where to get this from?
containerSize = Size Auto Auto, -- Proper size is set on parent.
containerMin = Size Auto Auto,
containerMax = Size Auto Auto
}
cells' = adjustWidths cells
(cells, width, height) = lowerCells childs
lowerCells (StyleTree self@CSSBox { display = TableRow } cells:rest) =
(row:rows, max rowwidth width', succ height)
where
(row, rowwidth) = lowerRow cells 0 -- FIXME: How to dodge colspans?
(rows, width', height') = lowerCells rest
lowerCells (StyleTree self@CSSBox { display = TableHeaderGroup } childs ) =
-}