From 7beb48286350645043875941093f076bca84e81b Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 8 Mar 2023 19:16:50 +1300 Subject: [PATCH] Draft grid preprocessor which sucessfully compiles. --- Graphics/Layout.hs | 12 +- Graphics/Layout/CSS/Internal.hs | 44 +++++++ Graphics/Layout/Grid.hs | 53 ++++---- Graphics/Layout/Grid/CSS.hs | 223 ++++++++++++++++++++++++++++++-- cattrap.cabal | 2 +- 5 files changed, 294 insertions(+), 40 deletions(-) diff --git a/Graphics/Layout.hs b/Graphics/Layout.hs index 89cfefc..7e5609a 100644 --- a/Graphics/Layout.hs +++ b/Graphics/Layout.hs @@ -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 -> diff --git a/Graphics/Layout/CSS/Internal.hs b/Graphics/Layout/CSS/Internal.hs index c545e5b..cfaab20 100644 --- a/Graphics/Layout/CSS/Internal.hs +++ b/Graphics/Layout/CSS/Internal.hs @@ -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 +} diff --git a/Graphics/Layout/Grid.hs b/Graphics/Layout/Grid.hs index 6bb3ad2..4cc4e1d 100644 --- a/Graphics/Layout/Grid.hs +++ b/Graphics/Layout/Grid.hs @@ -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, diff --git a/Graphics/Layout/Grid/CSS.hs b/Graphics/Layout/Grid/CSS.hs index 8d3bb55..713c033 100644 --- a/Graphics/Layout/Grid/CSS.hs +++ b/Graphics/Layout/Grid/CSS.hs @@ -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 diff --git a/cattrap.cabal b/cattrap.cabal index 704e6a8..030e948 100644 --- a/cattrap.cabal +++ b/cattrap.cabal @@ -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 -- 2.30.2