From 17c324d5bd6a1b764f1a2522adcb5e42653872b2 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Sat, 4 Mar 2023 17:15:42 +1300 Subject: [PATCH] Parse CSS Box model CSS properties, dispatch others to FontConfig & injected dependency. --- Graphics/Layout/CSS.hs | 113 +++++++++++++++++++++++++++++++++++++---- cattrap.cabal | 2 +- 2 files changed, 105 insertions(+), 10 deletions(-) diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs index aa6bc6f..fe390be 100644 --- a/Graphics/Layout/CSS.hs +++ b/Graphics/Layout/CSS.hs @@ -1,18 +1,113 @@ +{-# LANGUAGE OverloadedStrings #-} module Graphics.Layout.CSS where -import Graphics.Layout.Box +import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..)) +import qualified Data.Text as Txt +import Stylist (PropertyParser(..), TrivialPropertyParser) +import Data.Scientific (toRealFloat) + +import Graphics.Layout.Box as B import Graphics.Layout +import Graphics.Text.Font.Choose (Pattern(..)) -data CSSBox = CSSBox { +data CSSBox a = CSSBox { boxSizing :: BoxSizing, - cssBox :: PaddedBox Unitted Unitted -- Some units need to be resolved per font. calc()? - -- Other layout-mode specific properties? - -- Resolve font here so we can resolve those units? + cssBox :: PaddedBox Unitted Unitted, -- Some units need to be resolved per font. calc()? + font :: Pattern, + inner :: a } data BoxSizing = BorderBox | ContentBox -type Unitted = (Double, String) +type Unitted = (Double, Txt.Text) +auto = (0,"auto") +noborder = Border (0,"px") (0,"px") (0,"px") (0,"px") + +instance PropertyParser a => PropertyParser (CSSBox a) where + temp = CSSBox { + boxSizing = ContentBox, + cssBox = PaddedBox { + B.min = Size auto auto, + size = Size auto auto, + B.max = Size auto auto, + padding = noborder, + border = noborder, + margin = noborder + }, + font = temp, + inner = temp + } + inherit parent = CSSBox { + boxSizing = boxSizing parent, + cssBox = cssBox (temp :: CSSBox TrivialPropertyParser), + font = inherit $ font parent, + inner = inherit $ inner parent + } + + longhand _ self "box-sizing" [Ident "content-box"] = Just self {boxSizing = ContentBox} + longhand _ self "box-sizing" [Ident "border-box"] = Just self {boxSizing = BorderBox} + longhand _ self "box-sizing" [Ident "initial"] = Just self {boxSizing = ContentBox} + + longhand _ self@CSSBox {cssBox = box} "padding-top" toks | Just x <- parseLength toks = + Just self { cssBox = box { padding = (padding box) { top = x } } } + longhand _ self@CSSBox {cssBox = box} "padding-bottom" toks | Just x <- parseLength toks = + Just self { cssBox = box { padding = (padding box) { bottom = x } } } + longhand _ self@CSSBox {cssBox = box} "padding-left" toks | Just x <- parseLength toks = + Just self { cssBox = box { padding = (padding box) { left = x } } } + longhand _ self@CSSBox {cssBox = box} "padding-right" toks | Just x <- parseLength toks = + Just self { cssBox = box { padding = (padding box) { right = x } } } + longhand _ self@CSSBox {cssBox = box} "border-top-width" toks | Just x <- parseLength toks = + Just self { cssBox = box { border = (border box) { top = x } } } + longhand _ self@CSSBox {cssBox = box} "border-bottom-width" toks | Just x <- parseLength toks = + Just self { cssBox = box { border = (border box) { bottom = x } } } + longhand _ self@CSSBox {cssBox = box} "border-left-width" toks | Just x <- parseLength toks = + Just self { cssBox = box { border = (border box) { left = x } } } + longhand _ self@CSSBox {cssBox = box} "border-right-width" toks | Just x <- parseLength toks = + Just self { cssBox = box { border = (border box) { right = x } } } + longhand _ self@CSSBox {cssBox = box} "margin-top" toks | Just x <- parseLength toks = + Just self { cssBox = box { margin = (margin box) { top = x } } } + longhand _ self@CSSBox {cssBox = box} "margin-bottom" toks | Just x <- parseLength toks = + Just self { cssBox = box { margin = (margin box) { bottom = x } } } + longhand _ self@CSSBox {cssBox = box} "margin-left" toks | Just x <- parseLength toks = + Just self { cssBox = box { margin = (margin box) { left = x } } } + longhand _ self@CSSBox {cssBox = box} "margin-right" toks | Just x <- parseLength toks = + Just self { cssBox = box { margin = (margin box) { right = x } } } + + longhand _ self@CSSBox {cssBox = box} "width" toks | Just x <- parseLength' toks = + Just self { cssBox = box { size = (size box) { inline = x } } } + longhand _ self@CSSBox {cssBox = box} "height" toks | Just x <- parseLength' toks = + Just self { cssBox = box { size = (size box) { block = x } } } + longhand _ self@CSSBox {cssBox = box} "max-width" toks | Just x <- parseLength' toks = + Just self { cssBox = box { B.max = (B.max box) { inline = x } } } + longhand _ self@CSSBox {cssBox = box} "min-width" toks | Just x <- parseLength' toks = + Just self { cssBox = box { B.min = (B.min box) { inline = x } } } + longhand _ self@CSSBox {cssBox = box} "max-height" toks | Just x <- parseLength' toks = + Just self { cssBox = box { B.max = (B.max box) { block = x } } } + longhand _ self@CSSBox {cssBox = box} "min-height" toks | Just x <- parseLength' toks = + Just self { cssBox = box { B.min = (B.min box) { block = x } } } + + longhand a b c d | Just font' <- longhand (font a) (font b) c d = Just b { + font = font' + } + longhand a b c d | Just inner' <- longhand (inner a) (inner b) c d = Just b { + inner = inner' + } + longhand _ _ _ _ = Nothing + +parseLength :: [Token] -> Maybe Unitted +parseLength [Percentage _ x] = Just (n2f x,"%") +parseLength [Dimension _ x unit] + | n2f x == 0 && unit == "" = Just (0,"px") + | unit `elem` units = Just (n2f x,unit) +parseLength [Ident "auto"] = Just (0,"auto") +parseLength [Ident "initial"] = Just (0,"px") +parseLength _ = Nothing +parseLength' [Ident "min-content"] = Just (0,"min-content") +parseLength' [Ident "max-content"] = Just (0,"max-content") +parseLength' [Ident "auto"] = Just (0,"auto") +parseLength' toks = parseLength toks + +units = Txt.words "cap ch em ex ic lh rem rlh vh vw vmax vmin vb vi px cm mm Q in pc pt %" -{-instance PropertyParser CSSBox where - ... +n2f (NVInteger x) = realToFrac x +n2f (NVNumber x) = toRealFloat x -finalizeCSS :: CSSBox -> LayoutItem Length-} +{-finalizeCSS :: CSSBox -> LayoutItem Length-} diff --git a/cattrap.cabal b/cattrap.cabal index 7648f61..a30f842 100644 --- a/cattrap.cabal +++ b/cattrap.cabal @@ -21,7 +21,7 @@ library Graphics.Layout.Grid, Graphics.Layout.Box, Graphics.Layout.Arithmetic -- other-modules: -- other-extensions: - build-depends: base >=4.12 && <4.16, css-syntax, scientific, text, stylist-traits + build-depends: base >=4.12 && <4.16, css-syntax, scientific, text, stylist-traits, fontconfig-pure -- hs-source-dirs: default-language: Haskell2010 ghc-options: -Wincomplete-patterns -- 2.30.2