M Graphics/Layout/Box.hs => Graphics/Layout/Box.hs +2 -0
@@ 164,6 164,8 @@ instance (Zero m, Zero n) => Zero (PaddedBox m n) where
border = Border zero zero zero zero,
margin = Border zero zero zero zero
}
+instance (Zero m, Zero n) => Zero (Border m n) where
+ zero = Border zero zero zero zero
class CastDouble a where
-- | Convert a double to a double or length.
M Graphics/Layout/CSS.hs => Graphics/Layout/CSS.hs +41 -20
@@ 46,17 46,24 @@ finalizeCSS root parent self@StyleTree {
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' font_ self') (finalizeBox self' font_)
+ style = self'@CSSBox {
+ display = Table, tableOptions = opts@TableOptions {captionBelow=False}
+ },
+ children = childs
+ } = LayoutFlow (inner' font_ self')
+ (finalizeBox (collapseTBorders' self') font_)
([finalizeCSS root font_ child { style = child' { display = Block } }
| child@StyleTree { style = child'@CSSBox { display = TableCaption } } <- childs] ++
- [finalizeTable root font_ (inner self') childs])
+ [finalizeTable root font_ (inner self') opts 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' font_ self') (finalizeBox self' font_)
- (finalizeTable root font_ temp childs:
+ style = self'@CSSBox {
+ display = Table, tableOptions = opts@TableOptions {captionBelow=True}
+ }, children = childs
+ } = LayoutFlow (inner' font_ self')
+ (finalizeBox (collapseTBorders' self') font_)
+ (finalizeTable root font_ temp opts childs:
[finalizeCSS root font_ child { style = child' { display = Block } }
| child@StyleTree { style = child'@CSSBox { display = TableCaption } } <- childs])
where
@@ 103,7 110,7 @@ finalizeChilds root parent style' childs@(child:_)
$ flip applyFontInline parent $ txtOpts style'
| otherwise = RootBox $ Box (map (flattenTree parent) $ enumerate childs)
$ flip applyFontInline parent $ txtOpts style'
- flattenTree p (i, StyleTree { children = child@(_:_), style = self }) =
+ flattenTree p (i, StyleTree self child@(_:_)) =
buildInline f i self $ map (flattenTree f) $ enumerate child
where f = pattern2font (font self) (font' self) p root
flattenTree f (i,StyleTree {style=self@CSSBox {inlineStyles=CSSInline txt _ _}})
@@ 112,15 119,15 @@ finalizeChilds root parent style' childs@(child:_)
buildInline f i self childs =
InlineBox ((f, i), finalizeBox self f, inner' parent self)
(Box childs' $ flip applyFontInline f $ txtOpts self)
- defaultBoxOptions -- Fill in during layout.
+ $ resolveBoxOpts f (tableOptions self)
where childs' = applyBidi (inlineStyles self) childs
finalizeParagraph (RootBox (Box [TextSequence _ txt] _))
| Txt.all isSpace txt = Nothing -- Discard isolated whitespace.
finalizeParagraph tree =
Just $ constructParagraph "" tree "" $ paragraphOptions style'
enumerate = zip $ enumFrom 0
-finalizeChilds root parent style' childs
- | (_:_) <- table = finalizeTable root parent temp table:
+finalizeChilds root parent style'@CSSBox { tableOptions = tOpts } childs
+ | (_:_) <- table = finalizeTable root parent temp tOpts table:
finalizeChilds root parent style' rest
| (child:childs') <- childs = finalizeCSS root parent child:
finalizeChilds root parent style' childs'
@@ 141,19 148,20 @@ finalizeChilds root parent style' childs
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 = LayoutGrid val grid cells' childs'
+-- | Desugar a styletree of table elements to a grid layout.
+finalizeTable root parent val opts childs = LayoutGrid val grid cells' childs'
where
grid = Track {
cells = replicate width $ Left Auto,
- gap = Pixels 0, -- Allow styling this!
+ gap = hGap,
trackMins = [], trackNats = []
} `Size` Track {
cells = replicate height $ Left Auto,
- gap = Pixels 0, -- Allow styling this!
+ gap = yGap,
trackMins = [], trackNats = []
}
(cells', childs') = unzip (decor ++ cells)
+ (hGap, yGap) = finalizeGap opts parent
(cells, width, height) = lowerCells childs 0 emptyRow
decor = decorateRow childs width 0 ++ decorateCol childs height 0
@@ 183,24 191,30 @@ finalizeTable root parent val childs = LayoutGrid val grid cells' childs'
(row, rowwidth, x') = lowerRow cells 0 h x
(rows, width', height') = lowerCells rest (succ h) $ commitRow x'
- lowerRow (StyleTree self'@CSSBox {display=TableCell} childs:rest) ix row x =
+ lowerRow (StyleTree self@CSSBox {
+ display = TableCell, tableOptions = self' } childs:rest) ix row x =
(cell:cells, width, x')
where
(cells, width, x') = lowerRow rest end row $
insertCell start (colspan self') (rowspan self') x
start = allocCol ix x
end = start + colspan self'
- -- TODO: Add alignment support!
cell = (GridItem start end Start 0 0
- `Size` GridItem row (row + rowspan self') Start 0 0,
- finalizeCSS root parent $ StyleTree self' { display = Block } childs)
+ `Size` GridItem row (row + rowspan self') valign 0 0,
+ finalizeCSS root parent $ StyleTree self { display = Block } childs)
+ valign = finalizeVAlign self'
+ halign = finalizeHAlign (paragraphOptions self) (direction self)
lowerRow (self:rest) ix row x = (cell:cells, width, x')
where
ix' = allocCol ix x
(cells, width, x') = lowerRow rest (succ ix') row $ insertCell ix' 1 1 x
cell = (GridItem ix' (succ ix') Start 0 0
`Size` GridItem row (succ row) Start 0 0,
- finalizeCSS root parent self)
+ finalizeCSS root parent self {
+ style = (style self) {
+ cssBox = collapseBorders opts $ cssBox $ style self
+ }
+ })
lowerRow [] ix _ x = ([], ix, x)
decorateRow (StyleTree self@CSSBox { display = TableRow } _:rest) w row =
@@ 239,7 253,9 @@ finalizeTable root parent val childs = LayoutGrid val grid cells' childs'
buildDecor self col colspan row rowspan =
(GridItem col (col + colspan) Start 0 0 `Size`
GridItem row (row + rowspan) Start 0 0,
- finalizeCSS root parent $ StyleTree self { display = Block } [])
+ finalizeCSS root parent $ StyleTree self {
+ display = Block, cssBox = collapseBorders opts $ cssBox self
+ } [])
isRowGroup (StyleTree CSSBox { display = TableRow } _) = True
isRowGroup (StyleTree CSSBox { display = TableHeaderGroup } _) = True
@@ 249,3 265,8 @@ finalizeTable root parent val childs = LayoutGrid val grid cells' childs'
isRowGroup (StyleTree CSSBox { display = TableColumn } _) = True
isRowGroup (StyleTree CSSBox { display = TableColumnGroup } _) = True
isRowGroup _ = False
+
+collapseTBorders' :: CSSBox x -> CSSBox x
+collapseTBorders' self = self {
+ cssBox = collapseTBorders (tableOptions self) (cssBox self)
+ }
M Graphics/Layout/CSS/Length.hs => Graphics/Layout/CSS/Length.hs +4 -3
@@ 1,4 1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
-- | Infrastructure for parsing & desugaring length units & keywords,
-- in reference to the selected font.
module Graphics.Layout.CSS.Length(Unitted, auto, parseLength, parseLength', units,
@@ 17,6 17,7 @@ import Graphics.Layout.Box
-- The unit may alternately represent a keyword, in which case the number is
-- ignored & typically set to 0.
type Unitted = (Double, Txt.Text)
+instance Zero Unitted where zero = (0,"px")
-- | The CSS `auto` keyword.
auto :: Unitted
auto = (0,"auto")
@@ 59,8 60,8 @@ finalizeLength (x,"vh") f = Pixels $ x*vh f
finalizeLength (x,"vb") f = Pixels $ x*vh f -- TODO: Support vertical text
finalizeLength (x,"vw") f = Pixels $ x*vw f
finalizeLength (x,"vi") f = Pixels $ x*vw f -- TODO: Support vertical text
-finalizeLength (x,"vmax") f = Percent $ x*vmax f
-finalizeLength (x,"vmin") f = Percent $ x*vmin f
+finalizeLength (x,"vmax") f = Pixels $ x*vmax f
+finalizeLength (x,"vmin") f = Pixels $ x*vmin f
finalizeLength (x,"px") f = Pixels $ x*scale f
finalizeLength (x,"cm") f = Pixels $ x*scale f*96/2.54
finalizeLength (x,"in") f = Pixels $ x*96*scale f
M Graphics/Layout/CSS/Parse.hs => Graphics/Layout/CSS/Parse.hs +31 -47
@@ 14,6 14,7 @@ import Graphics.Text.Font.Choose (Pattern, unset)
import Graphics.Layout.CSS.Length (Unitted, parseLength', parseLength, auto, units)
import Graphics.Layout.CSS.Font (CSSFont)
import Graphics.Layout.Grid.CSS (CSSGrid(..), CSSCell(..), Placement(..))
+import Graphics.Layout.Grid.Table (TableOptions)
import Graphics.Layout.Inline.CSS (CSSInline(..))
import Data.Maybe (isJust, fromMaybe)
@@ 47,16 48,13 @@ data CSSBox a = CSSBox {
cellStyles :: CSSCell,
-- | inline-related CSS properties.
inlineStyles :: CSSInline,
- -- | Parsed CSS caption-side.
- captionBelow :: Bool,
-- | Parsed widows & orphans controlling pagination.
pageOptions :: PageOptions,
-- | Parsed text-alignment & other options which applies per-paragraph.
paragraphOptions :: ParagraphOptions,
- -- | HTML rowspan attribute
- rowspan :: Int,
- -- | HTML colspan attribute
- colspan :: Int
+ -- | (Semi-)parsed CSS properties & HTML attributes relating to laying out
+ -- HTML table elements.
+ tableOptions :: TableOptions
}
-- | Accessor for inlineStyle's `textDirection` attribute.
direction CSSBox { inlineStyles = CSSInline _ opts _ } = textDirection opts
@@ 97,12 95,11 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
gridStyles = temp,
cellStyles = temp,
inlineStyles = temp,
- captionBelow = False,
pageOptions = PageOptions 0 0 2 2,
paragraphOptions = defaultParagraphOptions {
paragraphAlignment = AlignStart
},
- rowspan = 1, colspan = 1
+ tableOptions = temp
}
inherit parent = CSSBox {
boxSizing = boxSizing parent,
@@ 116,10 113,9 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
gridStyles = inherit $ gridStyles parent,
cellStyles = inherit $ cellStyles parent,
inlineStyles = inherit $ inlineStyles parent,
- captionBelow = captionBelow parent,
pageOptions = pageOptions parent,
paragraphOptions = paragraphOptions parent,
- rowspan = 1, colspan = 1
+ tableOptions = inherit $ tableOptions parent
}
priority self = concat [x font, x font', x gridStyles, x cellStyles, x inner]
where x getter = priority $ getter self
@@ 260,26 256,33 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
longhand _ self "display" [Ident "inline"] = Just self { display = Inline }
longhand _ self "display" [Ident "initial"] = Just self { display = Inline }
- longhand _ self "-argo-rowspan" [Ident "initial"] = Just self { rowspan = 1 }
- longhand _ self "-argo-rowspan" [String x]
- | Just y <- readMaybe $ unpack x, y >= 1 = Just self { rowspan = y }
- longhand _ self "-argo-rowspan" [Number _ (NVInteger x)]
- | x >= 1 = Just self { rowspan = fromEnum x }
- longhand _ self "-argo-colspan" [Ident "initial"] = Just self { colspan = 1 }
- longhand _ self "-argo-colspan" [String x]
- | Just y <- readMaybe $ unpack x, y >= 1 = Just self { colspan = y }
- longhand _ self "-argo-colspan" [Number _ (NVInteger x)]
- | x >= 1 = Just self { colspan = fromEnum x }
-
- longhand _ self "caption-side" [Ident "top"] = Just self { captionBelow = False }
- longhand _ self "caption-side" [Ident "bottom"] = Just self { captionBelow = True }
- longhand _ self "caption-side" [Ident "initial"] = Just self {captionBelow = False}
-
longhand _ self "orphans" [Number _ (NVInteger x)] =
Just self { pageOptions = (pageOptions self) { pageOrphans = fromInteger x } }
longhand _ self "widows" [Number _ (NVInteger x)] =
Just self { pageOptions = (pageOptions self) { pageWidows = fromInteger x } }
+ longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "initial"] =
+ Just self { paragraphOptions = o { paragraphAlignment = AlignStart } }
+ longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "start"] =
+ Just self { paragraphOptions = o { paragraphAlignment = AlignStart } }
+ longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "end"] =
+ Just self { paragraphOptions = o { paragraphAlignment = AlignEnd } }
+ longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "left"] =
+ Just self { paragraphOptions = o { paragraphAlignment = AlignLeft } }
+ longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "right"] =
+ Just self { paragraphOptions = o { paragraphAlignment = AlignRight } }
+ longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "center"] =
+ Just self { paragraphOptions = o { paragraphAlignment = AlignCentreH } }
+ -- text-align: justify is unimplemented.
+ longhand p self@CSSBox { paragraphOptions = o } "text-align"
+ [Ident "match-parent"] = case paragraphAlignment$paragraphOptions p of
+ AlignStart | DirLTR <- direction p -> ret AlignLeft
+ AlignStart | DirRTL <- direction p -> ret AlignRight
+ AlignEnd | DirLTR <- direction p -> ret AlignRight
+ AlignEnd | DirRTL <- direction p -> ret AlignLeft
+ x -> ret x
+ where ret x = Just self { paragraphOptions = o { paragraphAlignment = x } }
+
longhand a b c d | Just x <- longhand (font a) (font b) c d,
Just y <- longhand (font' a) (font' b) c d =
Just b { font = x, font' = y } -- Those properties can overlap!
@@ 295,6 298,8 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
Just b { gridStyles = grid' }
longhand a b c d | Just cell' <- longhand (cellStyles a) (cellStyles b) c d =
Just b { cellStyles = cell' }
+ longhand a b c d | Just table'<-longhand (tableOptions a) (tableOptions b) c d
+ = Just b { tableOptions = table' }
longhand a b c d
| (d', _:_)<-testLengthProp d, Just _<-longhand (inner a) (inner b) c d' =
Just b {
@@ 316,28 321,6 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
}}
where p x = Numbered x Nothing
- longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "initial"] =
- Just self { paragraphOptions = o { paragraphAlignment = AlignStart } }
- longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "start"] =
- Just self { paragraphOptions = o { paragraphAlignment = AlignStart } }
- longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "end"] =
- Just self { paragraphOptions = o { paragraphAlignment = AlignEnd } }
- longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "left"] =
- Just self { paragraphOptions = o { paragraphAlignment = AlignLeft } }
- longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "right"] =
- Just self { paragraphOptions = o { paragraphAlignment = AlignRight } }
- longhand _ self@CSSBox {paragraphOptions=o} "text-align" [Ident "center"] =
- Just self { paragraphOptions = o { paragraphAlignment = AlignCentreH } }
- -- text-align: justify is unimplemented.
- longhand p self@CSSBox { paragraphOptions = o } "text-align"
- [Ident "match-parent"] = case paragraphAlignment$paragraphOptions p of
- AlignStart | DirLTR <- direction p -> ret AlignLeft
- AlignStart | DirRTL <- direction p -> ret AlignRight
- AlignEnd | DirLTR <- direction p -> ret AlignRight
- AlignEnd | DirRTL <- direction p -> ret AlignLeft
- x -> ret x
- where ret x = Just self { paragraphOptions = o { paragraphAlignment = x } }
-
longhand _ _ _ _ = Nothing
shorthand self "font" toks = case parseOperands toks of
@@ 387,6 370,7 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
shorthand self k v | ret@(_:_) <- shorthand (inlineStyles self) k v = ret
shorthand self k v | ret@(_:_) <- shorthand (gridStyles self) k v = ret
shorthand self k v | ret@(_:_) <- shorthand (cellStyles self) k v = ret
+ shorthand self k v | ret@(_:_) <- shorthand (tableOptions self) k v = ret
shorthand self k v | ret@(_:_) <- shorthand (inner self) k v = ret
shorthand self k v
| (v', ls)<-testLengthProp v, ret@(_:_)<-shorthand (inner self) k v' =
M Graphics/Layout/Grid/Table.hs => Graphics/Layout/Grid/Table.hs +115 -1
@@ 1,12 1,25 @@
+{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
module Graphics.Layout.Grid.Table where
+import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
+import Stylist (PropertyParser(..))
+import Graphics.Layout.CSS.Length (Unitted, parseLength, Font', finalizeLength)
+import Graphics.Layout.Box (Length(..), PaddedBox(..), zero, mapX, mapY)
+import Graphics.Layout.Grid (Alignment(..))
+import Data.Text.Glyphize (Direction(..))
+import Data.Text.ParagraphLayout.Rich (
+ ParagraphOptions(..), ParagraphAlignment(..))
+
+import Text.Read (readMaybe)
+import Data.Text (unpack)
+
type Overflowed = [Int]
emptyRow :: Overflowed
emptyRow = []
commitRow :: Overflowed -> Overflowed
-commitRow = map $ max 0 . pred
+commitRow = map $ Prelude.max 0 . pred
allocCol :: Int -> Overflowed -> Int
allocCol ix cols = ix + length (span (> 0) $ drop ix cols)
@@ 15,3 28,104 @@ insertCell :: Int -> Int -> Int -> Overflowed -> Overflowed
insertCell ix colspan rowspan cols =
before ++ replicate colspan rowspan ++ drop colspan after
where (before, after) = splitAt ix cols
+
+data TableOptions = TableOptions {
+ -- | HTML rowspan attribute
+ rowspan :: Int,
+ -- | HTML colspan attribute
+ colspan :: Int,
+ -- | Parsed CSS caption-side.
+ captionBelow :: Bool,
+ -- | Parsed CSS border-collapse
+ borderCollapse :: Bool,
+ -- | Semi-parsed border-spacing, horizontal axis
+ borderHSpacing :: Unitted,
+ -- | Semi-parsed border-spacing, vertical axis
+ borderVSpacing :: Unitted,
+ -- TODO: Implement `table-layout: fixed`, that needs its own layout formula...
+ -- | Parsed CSS vertical-align
+ verticalAlign :: Unitted
+}
+
+instance PropertyParser TableOptions where
+ temp = TableOptions {
+ rowspan = 1, colspan = 1,
+ captionBelow = False, borderCollapse = False,
+ borderHSpacing = (0,"px"), borderVSpacing = (0,"px"),
+ verticalAlign = (0,"baseline")
+ }
+ inherit = id
+
+ longhand _ self "-argo-rowspan" [Ident "initial"] = Just self { rowspan = 1 }
+ longhand _ self "-argo-rowspan" [String x]
+ | Just y <- readMaybe $ unpack x, y >= 1 = Just self { rowspan = y }
+ longhand _ self "-argo-rowspan" [Number _ (NVInteger x)]
+ | x >= 1 = Just self { rowspan = fromEnum x }
+ longhand _ self "-argo-colspan" [Ident "initial"] = Just self { colspan = 1 }
+ longhand _ self "-argo-colspan" [String x]
+ | Just y <- readMaybe $ unpack x, y >= 1 = Just self { colspan = y }
+ longhand _ self "-argo-colspan" [Number _ (NVInteger x)]
+ | x >= 1 = Just self { colspan = fromEnum x }
+
+ longhand _ self "caption-side" [Ident "top"] = Just self { captionBelow = False }
+ longhand _ self "caption-side" [Ident "bottom"] = Just self { captionBelow = True }
+ longhand _ self "caption-side" [Ident "initial"] = Just self {captionBelow = False}
+
+ longhand _ self "border-collapse" [Ident "collapse"] =
+ Just self { borderCollapse = True }
+ longhand _ self "border-collapse" [Ident "separate"] =
+ Just self { borderCollapse = False }
+ longhand _ self "border-collapse" [Ident "initial"] =
+ Just self { borderCollapse = False }
+
+ longhand _ self "border-spacing" v@[Dimension _ _ _] | Just x <- parseLength v =
+ Just self { borderHSpacing = x, borderVSpacing = x }
+ longhand _ self "border-spacing" [x@(Dimension _ _ _), y@(Dimension _ _ _)]
+ | Just x' <- parseLength [x], Just y' <- parseLength [y] =
+ Just self { borderHSpacing = x', borderVSpacing = y' }
+ longhand _ self "border-spacing" [Ident "initial"] =
+ Just self { borderHSpacing = (0,"px"), borderVSpacing = (0,"px") }
+
+ longhand _ self "vertical-align" [Ident x]
+ | x `elem` ["baseline", "sub", "super", "text-top", "text-bottom",
+ "middle", "top", "bottom"] = Just self { verticalAlign = (0,x) }
+ | x == "initial" = Just self { verticalAlign = (0,"baseline") }
+ | otherwise = Nothing
+ longhand _ self "vertical-align" v | Just x <- parseLength v =
+ Just self { verticalAlign = x }
+
+ longhand _ _ _ _ = Nothing
+
+finalizeGap :: TableOptions -> Font' -> (Length, Length)
+finalizeGap TableOptions { borderCollapse = True } _ = (Pixels 0, Pixels 0)
+finalizeGap TableOptions { borderHSpacing = x, borderVSpacing = y } font =
+ (finalizeLength x font, finalizeLength y font)
+
+type UPaddedBox = PaddedBox Unitted Unitted
+collapseBorders :: TableOptions -> UPaddedBox -> UPaddedBox
+collapseBorders TableOptions { borderCollapse = False } ret = ret
+collapseBorders _ box = box {
+ margin = zero,
+ border = mapX half $ mapY half $ border box
+ }
+collapseTBorders :: TableOptions -> UPaddedBox -> UPaddedBox
+collapseTBorders TableOptions { borderCollapse = False } ret = ret
+collapseTBorders _ box = box {
+ padding = zero,
+ border = mapX half $ mapY half $ border box
+ }
+half (x,u) = (x/2,u)
+
+finalizeVAlign :: TableOptions -> Alignment
+finalizeVAlign TableOptions { verticalAlign = (_,"top") } = Start
+finalizeVAlign TableOptions { verticalAlign = (_,"middle") } = Mid
+finalizeVAlign TableOptions { verticalAlign = (_,"bottom") } = End
+finalizeVAlign _ = Start -- FIXME: Support baseline alignment!
+finalizeHAlign :: ParagraphOptions -> Direction -> Alignment
+finalizeHAlign (paragraphAlignment -> AlignStart) _ = Start
+finalizeHAlign (paragraphAlignment -> AlignEnd) _ = End
+finalizeHAlign (paragraphAlignment -> AlignLeft) DirLTR = Start
+finalizeHAlign (paragraphAlignment -> AlignLeft) _ = End
+finalizeHAlign (paragraphAlignment -> AlignRight) DirLTR = End
+finalizeHAlign (paragraphAlignment -> AlignRight) _ = Start
+finalizeHAlign (paragraphAlignment -> AlignCentreH) _ = Mid
M Graphics/Layout/Inline/CSS.hs => Graphics/Layout/Inline/CSS.hs +26 -2
@@ 1,7 1,8 @@
{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
-- | Infrastructure for parsing & desugaring text related CSS properties.
module Graphics.Layout.Inline.CSS(
- CSSInline(..), Default(..), UnicodeBidi(..), applyFontInline, applyBidi) where
+ CSSInline(..), Default(..), UnicodeBidi(..), applyFontInline, applyBidi,
+ resolveVAlign, resolveBoxOpts) where
import Data.CSS.Syntax.Tokens (Token(..))
import Stylist (PropertyParser(..))
@@ 11,7 12,11 @@ import Data.Text.ParagraphLayout.Rich
import Data.Text.Glyphize (Direction(..))
import Graphics.Layout.CSS.Font (Font'(..), hbUnit)
+import Graphics.Layout.CSS.Length (finalizeLength, Unitted)
+import Graphics.Layout.Box (Length(..))
+import Graphics.Layout.Grid.Table (TableOptions(..)) -- for VAlign
import Data.Char (isSpace)
+import Data.Int (Int32)
import Debug.Trace (trace) -- To report unexpected cases.
-- | Document text with Balkón styling options, CSS stylable.
@@ 65,7 70,7 @@ instance PropertyParser CSSInline where
applyFontInline :: TextOptions -> Font' -> TextOptions
applyFontInline opts font = opts {
textFont = hbFont font,
- textLineHeight = Absolute $ toEnum $ fromEnum $ lineheight font * hbUnit
+ textLineHeight = Absolute $ toHB $ lineheight font
}
-- | Apply Bidi chars around the inline text. FIXME: Handle the tree!
applyBidi :: Default d => CSSInline -> [InnerNode Text d] -> [InnerNode Text d]
@@ 110,3 115,22 @@ leaf ch = TextSequence def $ Txt.singleton ch
class Default a where
def :: a
+
+resolveVAlign :: Font' -> Unitted -> VerticalAlignment
+resolveVAlign _ (_,"top") = AlignLineTop
+resolveVAlign _ (_,"super") = AlignLineTop -- FIXME: Is there a better translation?
+resolveVAlign _ (_,"text-top") = AlignLineTop -- FIXME: Better translation?
+resolveVAlign _ (_,"bottom") = AlignLineBottom
+resolveVAlign _ (_,"sub") = AlignLineBottom -- FIXME: Better translation?
+resolveVAlign _ (_,"text-bottom") = AlignLineBottom
+resolveVAlign _ (_,"baseline") = AlignBaseline 0
+resolveVAlign f (_,"middle") = AlignBaseline $ toHB $ fontHeight f 'x' / 2
+resolveVAlign f x | Pixels y <- finalizeLength x f = AlignBaseline $ toHB y
+ | Percent y <- finalizeLength x f = AlignBaseline $ toHB $ y * lineheight f
+ | otherwise = trace ("Invalid length! " ++ show x) $ AlignBaseline 0
+resolveBoxOpts f grid = defaultBoxOptions {
+ boxVerticalAlignment = resolveVAlign f $ verticalAlign grid
+ }
+
+toHB :: Double -> Int32
+toHB = toEnum . fromEnum . (*) hbUnit