M Graphics/Layout.hs => Graphics/Layout.hs +7 -5
@@ 116,11 116,12 @@ boxWidth parent (LayoutGrid val self childs) = (size', LayoutGrid val self' chil
containerMin = mapSizeX (lowerLength outerwidth) $ containerMin self,
containerMax = mapSizeX (lowerLength outerwidth) $ containerMax self,
gap = mapSizeX (lowerLength outerwidth) $ gap self,
- columns = [("", Left width) | width <- widths],
+ columns = map Left widths,
rows = rows self,
rowBounds = rowBounds self,
- colBounds = colBounds self
+ colBounds = colBounds self,
+ subgridRows = subgridRows self, subgridColumns = subgridColumns self
}
outerwidth = inline $ size parent
(size', widths) = gridWidths parent self $ colBounds self
@@ 226,11 227,12 @@ boxHeight parent (LayoutGrid val self childs) = (size', LayoutGrid val self' chi
gap = mapSizeY (lowerLength width) $ gap self,
rows = map lowerSize $ rows self, rowBounds = rowBounds self,
- columns = columns self, colBounds = colBounds self
+ columns = columns self, colBounds = colBounds self,
+ subgridRows = subgridRows self, subgridColumns = subgridColumns self
}
(size', heights) = gridHeights parent self $ rowBounds self
- lowerSize (n, Left x) = (n, Left $ lowerLength width x)
- lowerSize (n, Right x) = (n, Right x)
+ lowerSize (Left x) = Left $ lowerLength width x
+ lowerSize (Right x) = Right x
width = inline $ size parent
boxPosition :: (Double, Double) -> LayoutItem Double Double x ->
M Graphics/Layout/CSS/Internal.hs => Graphics/Layout/CSS/Internal.hs +44 -0
@@ 4,6 4,9 @@ module Graphics.Layout.CSS.Internal where
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import qualified Data.Text as Txt
import Data.Scientific (toRealFloat)
+import Debug.Trace (trace) -- For warnings.
+
+import Graphics.Layout.Box hiding (lowerLength)
type Unitted = (Double, Txt.Text)
auto :: Unitted
@@ 25,3 28,44 @@ units = Txt.words "cap ch em ex ic lh rem rlh vh vw vmax vmin vb vi px cm mm Q i
n2f (NVInteger x) = realToFrac x
n2f (NVNumber x) = toRealFloat x
+
+lowerLength :: Unitted -> Font' -> Length
+lowerLength (x,"cap") f = Pixels $ x*fontHeight f 'A'
+lowerLength (x,"ch") f = Pixels $ x*fontAdvance f '0'
+lowerLength (x,"em") f = Pixels $ x*fontSize f
+lowerLength (x,"ex") f = Pixels $ x*fontHeight f 'x'
+lowerLength (x,"ic") f = Pixels $ x*fontHeight f '水' -- CJK water ideograph
+lowerLength (x,"lh") f = Pixels $ x*lineheight f -- Store conversion factors in `f`...
+lowerLength (x,"rem") f = Pixels $ x*rootEm f
+lowerLength (x,"rlh") f = Pixels $ x*rlh f
+lowerLength (x,"vh") f = Pixels $ x*vh f
+lowerLength (x,"vw") f = Pixels $ x*vw f
+lowerLength (x,"vmax") f = Percent $ x*vmax f
+lowerLength (x,"vmin") f = Percent $ x*vmin f
+lowerLength (x,"vb") f = Percent $ x*vb f -- This'll be trickier to populate
+lowerLength (x,"vi") f = Percent $ x*vi f -- This'll be trickier to populate
+lowerLength (x,"px") f = Pixels $ x*scale f
+lowerLength (x,"cm") f = Pixels $ x*scale f*96/2.54
+lowerLength (x,"mm") f | Pixels x' <- lowerLength (x,"cm") f = Pixels $ x'/10
+lowerLength (x,"Q") f | Pixels x' <- lowerLength (x,"cm") f = Pixels $ x'/40
+lowerLength (x,"pc") f | Pixels x' <- lowerLength (x,"in") f = Pixels $ x'/6
+lowerLength (x,"pt") f | Pixels x' <- lowerLength (x,"in") f = Pixels $ x'/72
+lowerLength (x,"%") _ = Percent $ x/100
+lowerLength (_,"auto") _ = Auto
+lowerLength (_,unit) _ = trace ("Invalid unit " ++ Txt.unpack unit) $ Pixels 0
+
+data Font' = Font' {
+ fontHeight :: Char -> Double,
+ fontAdvance :: Char -> Double,
+ fontSize :: Double,
+ rootEm :: Double,
+ lineheight :: Double,
+ rlh :: Double,
+ vh :: Double,
+ vw :: Double,
+ vmax :: Double,
+ vmin :: Double,
+ vb :: Double,
+ vi :: Double,
+ scale :: Double
+}
M Graphics/Layout/Grid.hs => Graphics/Layout/Grid.hs +29 -24
@@ 8,11 8,14 @@ import Graphics.Layout.Box as B
import Debug.Trace (trace)
+-- TODO implement subgrid support...
data Grid m n = Grid {
- rows :: [(Name, Either m Double)],
+ rows :: [Either m Double],
rowBounds :: [(Double, Double)],
- columns :: [(Name, Either n Double)],
+ subgridRows :: Int,
+ columns :: [Either n Double],
colBounds :: [(Double, Double)],
+ subgridColumns :: Int,
gap :: Size m n,
containerSize :: Size m n, -- wrap in a Flow box to get padding, etc.
containerMin :: Size m n,
@@ 28,10 31,12 @@ data Alignment = Start | Mid | End
type Name = Text
buildGrid rows columns = Grid {
- rows = zip (repeat "") rows,
+ rows = rows,
rowBounds = [],
- columns = zip (repeat "") columns,
+ subgridRows = 0, -- disables
+ columns = columns,
colBounds = [],
+ subgridColumns = 0, -- disables
gap = Size (Pixels 0) (Pixels 0),
containerSize = Size Auto Auto,
containerMin = Size Auto Auto,
@@ 65,7 70,7 @@ gridMinWidths :: Double -> Grid b Length -> [GridItem y Double] -> (Double, [Dou
gridMinWidths parent self childs =
(sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
where
- ret = map colMinWidth $ enumerate $ map snd $ columns self
+ ret = map colMinWidth $ enumerate $ columns self
colMinWidth (_, Left (Pixels x)) = x
colMinWidth (_, Left (Percent x)) = x * parent
colMinWidth arg@(ix, Left Preferred) =
@@ 76,7 81,7 @@ gridNatWidths :: Double -> Grid b Length -> [GridItem y Double] -> (Double, [Dou
gridNatWidths parent self childs =
(sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
where
- ret = map colNatWidth $ enumerate $ map snd $ columns self
+ ret = map colNatWidth $ enumerate $ columns self
colNatWidth (_, Left (Pixels x)) = x
colNatWidth (_, Left (Percent x)) = x * parent
colNatWidth arg@(ix, Left Min) =
@@ 87,12 92,12 @@ gridMaxWidths :: PaddedBox b Double -> Grid y Length -> [(Double, Double)] -> (D
gridMaxWidths parent self subwidths =
(sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
where
- ret = map (colMaxWidth fr) $ zip subwidths $ map snd $ columns self
+ ret = map (colMaxWidth fr) $ zip subwidths $ columns self
fr = Prelude.max 0 fr'
- fr' = (outerwidth - estimate)/(countFRs $ map snd $ columns self)
+ fr' = (outerwidth - estimate)/(countFRs $ columns self)
outerwidth = inline $ size parent
estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
- map (colMaxWidth 0) $ zip subwidths $ map snd $ columns self
+ map (colMaxWidth 0) $ zip subwidths $ columns self
colMaxWidth _ (_, Left (Pixels x)) = x
colMaxWidth _ (_, Left (Percent x)) = x*(inline $ size parent)
colMaxWidth _ ((_, nat), Left Preferred) = nat
@@ 103,11 108,11 @@ gridWidths :: PaddedBox b Double -> Grid y Length -> [(Double, Double)] -> (Doub
gridWidths parent self subwidths =
(sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
where
- ret = map (colWidth fr) $ zip subwidths $ map snd $ columns self
- fr = (outerwidth - estimate)/(countFRs $ map snd $ columns self)
+ ret = map (colWidth fr) $ zip subwidths $ columns self
+ fr = (outerwidth - estimate)/(countFRs $ columns self)
outerwidth = inline $ size parent
estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
- map (colWidth 0) $ zip subwidths $ map snd $ columns self
+ map (colWidth 0) $ zip subwidths $ columns self
colWidth fr ((min, nat), size) = Prelude.max min $ colWidth' fr ((min, nat), size)
colWidth' _ (_, Left (Pixels x)) = x
colWidth' _ (_, Left (Percent x)) = x*(inline $ size parent)
@@ 120,7 125,7 @@ gridNatHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (D
gridNatHeights parent self childs =
(sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
where
- ret = map rowNatHeight $ enumerate $ map snd $ rows self
+ ret = map rowNatHeight $ enumerate $ rows self
rowNatHeight (_, Left (Pixels x)) = x
rowNatHeight (_, Left (Percent x)) = x * parent
rowNatHeight arg@(ix, Left Min) =
@@ 131,7 136,7 @@ gridMinHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (D
gridMinHeights parent self childs =
(sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
where
- ret = map rowMinHeight $ enumerate $ map snd $ rows self
+ ret = map rowMinHeight $ enumerate $ rows self
rowMinHeight (_, Left (Pixels x)) = x
rowMinHeight (_, Left (Percent x)) = x * parent
rowMinHeight arg@(ix, Left Preferred) =
@@ 142,12 147,12 @@ gridMaxHeights :: PaddedBox Double Double -> Grid Length Double ->
[(Double, Double)] -> (Double, [Double])
gridMaxHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
where
- ret = map (colMaxHeight fr) $ zip subheights $ map snd $ rows self
- fr = (outerheight - estimate)/(countFRs $ map snd $ rows self)
+ ret = map (colMaxHeight fr) $ zip subheights $ rows self
+ fr = (outerheight - estimate)/(countFRs $ rows self)
outerwidth = inline $ size parent
outerheight = block $ size parent
estimate = sum $ intersperse (inline $ gap self) $
- map (colMaxHeight 0) $ zip subheights $ map snd $ rows self
+ map (colMaxHeight 0) $ zip subheights $ rows self
colMaxHeight _ (_, Left (Pixels x)) = x
colMaxHeight _ (_, Left (Percent x)) = x*outerwidth
colMaxHeight _ ((_, nat), Left Preferred) = nat
@@ 158,12 163,12 @@ gridHeights :: PaddedBox Double Double -> Grid Length Double ->
[(Double, Double)] -> (Double, [Double])
gridHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
where
- ret = map (colHeight fr) $ zip subheights $ map snd $ rows self
- fr = (outerheight - estimate)/(countFRs $ map snd $ rows self)
+ ret = map (colHeight fr) $ zip subheights $ rows self
+ fr = (outerheight - estimate)/(countFRs $ rows self)
outerwidth = inline $ size parent
outerheight = block $ size parent
estimate = sum $ intersperse (inline $ gap self) $
- map (colHeight 0) $ zip subheights $ map snd $ rows self
+ map (colHeight 0) $ zip subheights $ rows self
colHeight fr ((min, nat), size) = Prelude.max min $ colHeight' fr ((min, nat), size)
colHeight' _ (_, Left (Pixels x)) = x
colHeight' _ (_, Left (Percent x)) = x*outerwidth
@@ 186,7 191,7 @@ gridPosition self childs = map gridCellPosition childs
extraHeight = height - block (size $ gridItemBox child)
gridCellPosition' child =
Size (startCol child `track` columns self) (startRow child `track` rows self)
- track ix (size:sizes) = fromRight 0 (snd size) + track (pred ix) sizes
+ track ix (size:sizes) = fromRight 0 size + track (pred ix) sizes
track 0 _ = 0
track ix [] = trace "WARNING! Malformed input table!" 0
align _ Start = 0
@@ 199,9 204,9 @@ gridLayout parent self childs paginate = (self', zip positions childs)
where
positions = gridPosition self' childs
self' = self {
- rows = zip (map fst $ rows self) $ map Left rows',
+ rows = map Left rows',
rowBounds = rowBounds',
- columns = zip (map fst $ rows self) $ map Left cols',
+ columns = map Left cols',
colBounds = colBounds',
gap = Size (lowerLength width' gapX) (lowerLength width' gapY),
containerSize = Size width' height',
@@ 216,7 221,7 @@ gridLayout parent self childs paginate = (self', zip positions childs)
(_, rowNats) = gridNatHeights width' self0 childs
self0 = self {
- columns = zip (map fst $ columns self) $ map Left cols',
+ columns = map Left cols',
colBounds = colBounds',
gap = Size (lowerLength width' gapX) gapY,
containerSize = let Size _ y = containerSize self in Size width' y,
M Graphics/Layout/Grid/CSS.hs => Graphics/Layout/Grid/CSS.hs +213 -10
@@ 1,12 1,17 @@
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Layout.Grid.CSS where
-import Graphics.Layout.CSS.Internal
import Stylist (PropertyParser(..))
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Text (Text)
import qualified Data.Text as Txt
import Data.Char (isAlphaNum)
+import Data.Maybe (fromMaybe)
+
+import Graphics.Layout.CSS.Internal
+import Graphics.Layout.Box hiding (lowerLength)
+import Graphics.Layout.Grid
+import Graphics.Layout
data CSSGrid = CSSGrid {
autoColumns :: Unitted,
@@ 14,15 19,18 @@ data CSSGrid = CSSGrid {
autoFlowDense :: Bool,
autoRows :: Unitted,
templateAreas :: [[Text]],
- templateColumns :: Either [([Text], Unitted)] [Text],
- templateRows :: Either [([Text], Unitted)] [Text]
+ templateColumns :: Either [([Text], Unitted)] [[Text]],
+ templateRows :: Either [([Text], Unitted)] [[Text]],
+ cssGap :: Size Unitted Unitted,
+ alignItems :: Size Alignment Alignment
}
-data Axis = Row | Col
+data Axis = Row | Col deriving Eq
data CSSCell = CSSCell {
columnStart :: Placement,
columnEnd :: Placement,
rowStart :: Placement,
- rowEnd :: Placement
+ rowEnd :: Placement,
+ alignSelf :: Size (Maybe Alignment) (Maybe Alignment)
}
data Placement = Autoplace | Named Text | Numbered Int (Maybe Text) |
Span Int (Maybe Text)
@@ 35,7 43,9 @@ instance PropertyParser CSSGrid where
autoRows = auto,
templateAreas = [],
templateColumns = Left [],
- templateRows = Left []
+ templateRows = Left [],
+ cssGap = Size (0,"px") (0,"px"),
+ alignItems = Size Start Start -- FIXME: Should be stretch, unsupported.
}
inherit _ = temp
@@ 72,6 82,58 @@ instance PropertyParser CSSGrid where
Just self { templateColumns = x }
longhand _ self "grid-template-rows" toks | Just x <- parseTemplate toks =
Just self { templateRows = x}
+
+ longhand _ self "row-gap" toks | Just x <- parseLength toks =
+ Just self { cssGap = (cssGap self) { inline = x } }
+ longhand _ self "column-gap" toks | Just x <- parseLength toks =
+ Just self { cssGap = (cssGap self) { block = x } }
+
+ longhand _ self "justify-items" [Ident "start"] =
+ Just self { alignItems = (alignItems self) { inline = Start } }
+ longhand _ self "justify-items" [Ident "flex-start"] =
+ Just self { alignItems = (alignItems self) { inline = Start } }
+ longhand _ self "justify-items" [Ident "self-start"] =
+ Just self { alignItems = (alignItems self) { inline = Start } }
+ longhand _ self "justify-items" [Ident "left"] =
+ Just self { alignItems = (alignItems self) { inline = Start } }
+ longhand _ self "justify-items" [Ident "center"] =
+ Just self { alignItems = (alignItems self) { inline = Mid } }
+ longhand _ self "justify-items" [Ident "end"] =
+ Just self { alignItems = (alignItems self) { inline = End } }
+ longhand _ self "justify-items" [Ident "flex-end"] =
+ Just self { alignItems = (alignItems self) { inline = End } }
+ longhand _ self "justify-items" [Ident "self-end"] =
+ Just self { alignItems = (alignItems self) { inline = End } }
+ longhand _ self "justify-items" [Ident "right"] =
+ Just self { alignItems = (alignItems self) { inline = End } }
+ longhand parent self "justify-items" (Ident "unsafe":toks) =
+ longhand parent self "justify-items" toks
+ longhand _ self "justify-items" [Ident "normal"] = -- FIXME Should be stretch, unsupported.
+ Just self { alignItems = (alignItems self) { inline = Start } }
+ longhand _ self "justify-items" [Ident "initial"] = -- FIXME Should be stretch, unsupported.
+ Just self { alignItems = (alignItems self) { inline = Start } }
+
+ longhand _ self "align-items" [Ident "start"] =
+ Just self { alignItems = (alignItems self) { block = Start } }
+ longhand _ self "align-items" [Ident "flex-start"] =
+ Just self { alignItems = (alignItems self) { block = Start } }
+ longhand _ self "align-items" [Ident "self-start"] =
+ Just self { alignItems = (alignItems self) { block = Start } }
+ longhand _ self "align-items" [Ident "center"] =
+ Just self { alignItems = (alignItems self) { block = Mid } }
+ longhand _ self "align-items" [Ident "end"] =
+ Just self { alignItems = (alignItems self) { block = End } }
+ longhand _ self "align-items" [Ident "flex-end"] =
+ Just self { alignItems = (alignItems self) { block = End } }
+ longhand _ self "align-items" [Ident "self-end"] =
+ Just self { alignItems = (alignItems self) { block = End } }
+ longhand parent self "align-items" (Ident "unsafe":toks) =
+ longhand parent self "align-items" toks
+ longhand _ self "align-items" [Ident "normal"] = -- FIXME Should be stretch, unsupported.
+ Just self { alignItems = (alignItems self) { block = Start } }
+ longhand _ self "align-items" [Ident "initial"] = -- FIXME Should be stretch, unsupported.
+ Just self { alignItems = (alignItems self) { block = Start } }
+
longhand _ _ _ _ = Nothing
instance PropertyParser CSSCell where
@@ 79,7 141,8 @@ instance PropertyParser CSSCell where
columnStart = Autoplace,
columnEnd = Autoplace,
rowStart = Autoplace,
- rowEnd = Autoplace
+ rowEnd = Autoplace,
+ alignSelf = Size Nothing Nothing
}
inherit _ = temp
@@ 88,9 151,58 @@ instance PropertyParser CSSCell where
longhand _ s "grid-column-end" toks | Just x <- placement toks = Just s {columnEnd=x}
longhand _ s "grid-row-start" toks | Just x <- placement toks = Just s {rowStart = x}
longhand _ s "grid-row-end" toks | Just x <- placement toks = Just s { rowEnd = x }
- longhand _ _ _ _ = Nothing
-{-finalizeGrid :: CSSBox -> LayoutItem Length-}
+ longhand _ self "align-self" [Ident "start"] =
+ Just self { alignSelf = (alignSelf self) { block = Just Start } }
+ longhand _ self "align-self" [Ident "self-start"] =
+ Just self { alignSelf = (alignSelf self) { block = Just Start } }
+ longhand _ self "align-self" [Ident "flex-start"] =
+ Just self { alignSelf = (alignSelf self) { block = Just Start } }
+ longhand _ self "align-self" [Ident "center"] =
+ Just self { alignSelf = (alignSelf self) { block = Just Mid } }
+ longhand _ self "align-self" [Ident "end"] =
+ Just self { alignSelf = (alignSelf self) { block = Just End } }
+ longhand _ self "align-self" [Ident "self-end"] =
+ Just self { alignSelf = (alignSelf self) { block = Just End } }
+ longhand _ self "align-self" [Ident "flex-end"] =
+ Just self { alignSelf = (alignSelf self) { block = Just End } }
+ longhand _ self "align-self" [Ident "normal"] = -- FIXME should be stretch, unsupported
+ Just self { alignSelf = (alignSelf self) { block = Just Start } }
+ longhand parent self "align-self" (Ident "unsafe":toks) =
+ longhand parent self "align-self" toks
+ longhand _ self "align-self" [Ident "auto"] =
+ Just self { alignSelf = (alignSelf self) { block = Nothing } }
+ longhand _ self "align-self" [Ident "initial"] =
+ Just self { alignSelf = (alignSelf self) { block = Nothing } }
+
+ longhand _ self "justify-self" [Ident "start"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just Start } }
+ longhand _ self "justify-self" [Ident "self-start"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just Start } }
+ longhand _ self "justify-self" [Ident "flex-start"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just Start } }
+ longhand _ self "justify-self" [Ident "left"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just Start } }
+ longhand _ self "justify-self" [Ident "center"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just Mid } }
+ longhand _ self "justify-self" [Ident "end"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just End } }
+ longhand _ self "justify-self" [Ident "self-end"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just End } }
+ longhand _ self "justify-self" [Ident "flex-end"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just End } }
+ longhand _ self "justify-self" [Ident "right"] =
+ Just self { alignSelf = (alignSelf self) { inline = Just End } }
+ longhand _ self "justify-self" [Ident "normal"] = -- FIXME should be stretch, unsupported
+ Just self { alignSelf = (alignSelf self) { inline = Just Start } }
+ longhand parent self "justify-self" (Ident "unsafe":toks) =
+ longhand parent self "justify-self" toks
+ longhand _ self "justify-self" [Ident "auto"] =
+ Just self { alignSelf = (alignSelf self) { inline = Nothing } }
+ longhand _ self "justify-self" [Ident "initial"] =
+ Just self { alignSelf = (alignSelf self) { inline = Nothing } }
+
+ longhand _ _ _ _ = Nothing
parseFR [Dimension _ x "fr"] = Just (n2f x,"fr")
parseFR toks = parseLength toks
@@ 128,7 240,7 @@ parseTrack (Function "repeat":Number _ (NVInteger x):Comma:toks)
parseTrack toks = ([], toks)
parseSubgrid (LeftSquareBracket:toks)
| Just (names', toks') <- parseNames toks, (names,toks'') <- parseSubgrid toks' =
- (names' ++ names, toks')
+ (names' : names, toks')
parseSubgrid (Function "repeat":Number _ (NVInteger x):Comma:toks)
| x > 0, (names@(_:_), RightParen:toks') <- parseSubgrid toks =
(concat $ replicate (fromEnum x) names, toks')
@@ 137,3 249,94 @@ parseNames (Ident x:toks)
| Just (names,toks') <- parseNames toks = Just (x:names,toks')
parseNames (RightSquareBracket:toks) = Just ([], toks)
parseNames _ = Nothing
+
+finalizeGrid :: PropertyParser x => CSSGrid -> Font' ->
+ [CSSCell] -> [LayoutItem Length Length x] -> LayoutItem Length Length x
+finalizeGrid self@CSSGrid {
+ templateColumns = Left cols', templateRows = Left rows'
+ } font cells childs = LayoutGrid temp self' $ zip cells' childs
+ where
+ self' = Grid {
+ rows = map lowerFR $ map snd rows0,
+ rowBounds = [],
+ subgridRows = 0, -- disable
+ columns = map lowerFR $ map snd cols0,
+ colBounds = [],
+ subgridColumns = 0, -- disable
+ gap = Size (lowerLength (inline $ cssGap self) font)
+ (lowerLength (block $ cssGap self) font),
+ containerSize = Size Auto Auto, -- Proper size is set on parent.
+ containerMin = Size Auto Auto,
+ containerMax = Size Auto Auto
+ }
+
+ (cells', rows0, cols0) = finalizeCells cells rows' cols'
+ finalizeCells :: [CSSCell] -> [([Text], Unitted)] -> [([Text], Unitted)] ->
+ ([GridItem Length Length], [([Text], Unitted)], [([Text], Unitted)])
+ finalizeCells (cell:cells) rows cols = (cell':cells', rows_, cols_)
+ where
+ (cell', rows0, cols0) = finalizeCell cell rows cols
+ (cells', rows_, cols_) = finalizeCells cells rows0 cols0
+ finalizeCells [] rows cols = ([], rows, cols)
+ finalizeCell :: CSSCell -> [([Text], Unitted)] -> [([Text], Unitted)] ->
+ (GridItem Length Length, [([Text], Unitted)], [([Text], Unitted)])
+ finalizeCell cell rows cols = (GridItem {
+ startRow = startRow', endRow = endRow',
+ startCol = startCol', endCol = endCol',
+ gridItemBox = lengthBox,
+ alignment = Size
+ (fromMaybe (inline $ alignItems self) (inline $ alignSelf cell))
+ (fromMaybe (inline $ alignItems self) (inline $ alignSelf cell))
+ }, rows', cols')
+ where
+ (startRow', endRow', rows') = lowerTrack2 rows ([], autoRows self)
+ (rowStart cell) (rowEnd cell)
+ (startCol', endCol', cols') = lowerTrack2 cols ([], autoColumns self)
+ (columnStart cell) (columnEnd cell)
+
+ lowerTrack2 tracks auto start@(Span _ _) end@(Span _ _) =
+ lowerTrack2 tracks auto start $ Numbered (pred $ length tracks) Nothing
+ lowerTrack2 tracks auto start@(Span _ _) end = (start', end', tracks')
+ where
+ (end', tracks0) = lowerTrack tracks auto 0 end -- Already checked for spans.
+ (start', tracks') = lowerTrack tracks auto (negate end') start
+ lowerTrack2 tracks auto start end = (start', end', tracks')
+ where
+ (start', tracks0) = lowerTrack tracks auto 0 start -- already checked for spans.
+ (end', tracks') = lowerTrack tracks auto start' end
+ lowerTrack tracks auto _ (Named name)
+ | ix:_ <- [ix | (ix, (names, _)) <- enumerate tracks, name `elem` names] = (ix, tracks)
+ | otherwise = (length tracks, tracks ++ [auto])
+
+ -- TODO Take into account placement strategy.
+ lowerTrack tracks auto _ Autoplace = (length tracks, tracks ++ [auto])
+ lowerTrack tracks _ _ (Numbered ix Nothing) = (ix, tracks)
+ lowerTrack tracks auto _ (Numbered ix (Just name))
+ | ix < length tracks' = (tracks' !! ix, tracks)
+ | otherwise = (length tracks, tracks ++ [auto])
+ where tracks' = [ix | (ix, (names, _)) <- enumerate tracks, name `elem` names]
+ lowerTrack tracks _ start (Span x Nothing)
+ | start > 0 = (start + x,tracks)
+ | otherwise = (-start - x,tracks)
+ lowerTrack tracks (_, auto) start (Span x (Just name)) = (tracks' !! x,tracks)
+ where
+ tracks0 | start < 0 = reverse tracks
+ | otherwise = tracks
+ tracks' = [ix | (ix, (names, _)) <-
+ drop (abs start) $ enumerate (tracks0 ++ repeat ([name],auto)),
+ name `elem` names]
+
+ lowerFR (x,"fr") = Right x
+ lowerFR x = Left $ lowerLength x font
+finalizeGrid self@CSSGrid { templateColumns = Right colnames } font cells childs =
+ LayoutGrid val' self' { subgridColumns = length colnames } childs'
+ where
+ LayoutGrid val' self' childs' = finalizeGrid self {
+ templateColumns = Left $ zip colnames $ repeat (1,"fr")
+ } font cells childs
+finalizeGrid self@CSSGrid { templateRows = Right rownames } font cells childs =
+ LayoutGrid val' self' { subgridRows = length rownames } childs'
+ where
+ LayoutGrid val' self' childs' = finalizeGrid self {
+ templateRows = Left $ zip rownames $ repeat (1,"fr")
+ } font cells childs
M cattrap.cabal => cattrap.cabal +1 -1
@@ 22,7 22,7 @@ library
Graphics.Layout.CSS.Internal, Graphics.Layout.Grid.CSS
-- other-modules:
-- other-extensions:
- build-depends: base >=4.12 && <4.16, css-syntax, scientific, text, stylist-traits, fontconfig-pure
+ build-depends: base >=4.12 && <4.16, css-syntax, scientific, text, stylist-traits, fontconfig-pure, harfbuzz-pure
-- hs-source-dirs:
default-language: Haskell2010
ghc-options: -Wincomplete-patterns