From fb550246e5a7cc441639a7fb77e8bb7159ef6440 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 7 Nov 2023 13:08:51 +1300 Subject: [PATCH] Draft integration test between HURL, Stylist, CatTrap, & now Typograffiti --- haphaestus.cabal | 7 +- src/Main.hs | 324 ++++++++++++---------- useragent.css | 702 ++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 884 insertions(+), 149 deletions(-) diff --git a/haphaestus.cabal b/haphaestus.cabal index 54b494c..071866e 100644 --- a/haphaestus.cabal +++ b/haphaestus.cabal @@ -20,12 +20,7 @@ executable haphaestus main-is: Main.hs -- other-modules: -- other-extensions: - build-depends: base >=4.12 && <4.16, file-embed >= 0.0.9 && < 0.1, - hurl-xml >=0.2 && <1, network-uri, hurl, directory, - xml-conduit, containers, - stylist >= 2.5, stylist-traits, css-syntax, xml-conduit-stylist >=3, - text >= 2, bytestring, - cattrap >= 0.1 && <0.2, fontconfig-pure, linear, balkon, + build-depends: base >=4.12 && <5, cattrap >=0.4 && < 1, text>=2.0.2, css-syntax, stylist-traits, stylist>=2.7.0.1, hurl-xml, hurl, sdl2 >= 2.5.4, containers, network-uri, xml-conduit, directory, xml-conduit-stylist, bytestring, file-embed, deepseq, fontconfig-pure, harfbuzz-pure, typograffiti >= 0.2.0.1 && < 0.3, freetype2, sdl2 >= 2.5.4, gl, mtl hs-source-dirs: src diff --git a/src/Main.hs b/src/Main.hs index a80c134..63d3f52 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,135 +1,111 @@ -{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings, TemplateHaskell, FlexibleContexts #-} module Main where -import qualified Data.ByteString.Lazy as B -import Data.Text (Text, unpack) +import FreeType.FontConfig (instantiatePattern, bmpAndMetricsForIndex, + FTFC_Subpixel(..)) +import FreeType.Core.Base (ft_With_FreeType, FT_Library) +import Typograffiti (makeDrawGlyphs, allocAtlas, AllocatedRendering(..), + TextTransform(..), Atlas, TypograffitiError) +import SDL hiding (rotate) +import Graphics.GL.Core32 + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Except (runExceptT, MonadError, MonadIO) + +import System.Environment (getArgs) +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Maybe (fromJust, fromMaybe) import qualified Data.Text as Txt +import qualified Data.ByteString as BS import System.Directory (getCurrentDirectory) import qualified System.Directory as Dir -import Data.FileEmbed -import Network.URI.Fetch.XML (fetchDocument, Page(..), loadVisited, applyCSScharset) -import Network.URI.Fetch (newSession, Session, fetchURL) -import Network.URI (URI(..), relativeTo, parseURIReference, nullURI) +import Graphics.Layout.CSS (CSSBox(..), finalizeCSS') +import Graphics.Layout.CSS.Font (placeholderFont, pattern2font, hbUnit, + Font'(scale, pattern, fontSize), + CSSFont(cssFontSize)) +import Graphics.Layout (LayoutItem(..), boxLayout, + glyphsPerFont, glyphs, fragmentFont, + layoutGetBox, layoutGetChilds, layoutGetInner) +import Graphics.Layout.Box (zeroBox) +import qualified Graphics.Layout.Box as B + +import Network.URI.Fetch.XML (Page(..), fetchDocument, applyCSScharset) +import Network.URI.Fetch (newSession, fetchURL) import Network.URI.Charset (charsets) -import Text.XML (Document(..), Prologue(..), Element(..)) +import Network.URI (URI(..), nullURI, parseURIReference) +import Data.FileEmbed (makeRelativeToProject, embedStringFile) +import Data.HTML2CSS (el2stylist) -import qualified Data.CSS.Syntax.StyleSheet as CSS +import Text.XML as X (Document(..), Element(..), Node(..), Prologue(..)) +import Stylist.Tree (StyleTree(..), preorder, treeMap) +import Stylist (PropertyParser(..), cssPriorityAgent, cssPriorityUser) import qualified Data.CSS.Style as Style -import Data.CSS.StyleTree -import qualified Data.CSS.Syntax.Tokens as CSSTok -import qualified Data.CSS.Preprocessor.Conditions as CSSCond -import Data.CSS.Preprocessor.Conditions (conditionalStyles) -import Data.CSS.Preprocessor.Assets -import qualified Data.CSS.Preprocessor.PsuedoClasses as CSSPseudo +import qualified Data.CSS.Syntax.StyleSheet as CSS import qualified Data.CSS.Preprocessor.Text as CSSTxt -import Stylist (cssPriorityAgent, cssPriorityUser, attrTest, elementPath) -import Stylist.Tree (treeFind) -import Data.HTML2CSS (el2stylist) - -import Graphics.Layout.CSS (CSSBox(..), finalizeCSS') -import Graphics.Layout.CSS.Internal (placeholderFont, Font'(..), - pattern2font, hbScale, CSSFont(..)) -import Graphics.Layout.Box as B (zeroBox, PaddedBox(..), Size(..)) -import Graphics.Layout (boxLayout, glyphsPerFont, LayoutItem(..), layoutGetChilds) -import Graphics.Text.Font.Choose (nameParse) +import Data.CSS.Preprocessor.Conditions as CSSCond + (ConditionalStyles, conditionalStyles, loadImports, Datum(..), resolve) +import qualified Data.CSS.Preprocessor.PsuedoClasses as CSSPseudo -import FreeType.FontConfig (instantiatePattern, bmpAndMetricsForIndex, - FTFC_Subpixel(..)) -import FreeType.Core.Base (ft_With_FreeType) -import Typograffiti (makeDrawGlyphs, allocAtlas, AllocatedRendering(..), - TextTransform(..)) -import Linear.V4 (V4(..)) -import Linear.V2 (V2(..)) -import Data.Text.ParagraphLayout (Fragment(..)) +import Control.Concurrent.MVar (putMVar, newEmptyMVar, tryReadMVar) +import Control.Concurrent (forkIO) +import Control.DeepSeq (NFData(..), ($!!)) import SDL hiding (rotate) -import Graphics.GL.Core32 - +import Foreign.C.Types (CInt) import Data.Function (fix) import Control.Monad (unless, forM) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Except (runExceptT) -import qualified Data.IntSet as IS -import qualified Data.Map.Strict as M +import qualified Graphics.Text.Font.Choose as FC -import Data.Maybe (fromMaybe) -import System.Environment (getArgs) +import Data.CSS.Syntax.Tokens (Token(..)) +import qualified Data.IntSet as IS +import Data.Text.Glyphize (GlyphInfo, GlyphPos) type Style = Style.VarParser (CSSTxt.TextStyle (CSSBox VizStyle)) data VizStyle = VizStyle (V4 Float) +instance Eq VizStyle where + VizStyle x == VizStyle y = case compare x y of + EQ -> True + _ -> False instance Style.PropertyParser VizStyle where temp = VizStyle (V4 0 0 0 1) inherit = id - longhand _ self "color" [Ident "black"] = VizStyle (V4 0 0 0 1) - longhand _ self "color" [Ident "white"] = VizStyle (V4 1 1 1 1) - longhand _ self "color" [Ident "red"] = VizStyle (V4 1 0 0 1) - longhand _ self "color" [Ident "green"] = VizStyle (V4 0 1 0 1) - longhand _ self "color" [Ident "blue"] = VizStyle (V4 0 0 1 1) - -inlinePseudos' :: Style.PropertyParser s => StyleTree [(Text, Style.VarParser s)] -> StyleTree s -inlinePseudos' (StyleTree self childs) = StyleTree { - style = fromMaybe Style.temp $ Style.innerParser <$> lookup "" self, - children = pseudo "before" ++ map inlinePseudos' childs ++ pseudo "after" - } where - pseudo n - | Just style <- Style.innerParser <$> lookup n self, - Just style' <- Style.longhand style style "::" [CSSTok.Ident n] = [StyleTree style' []] - | Just style <- Style.innerParser <$> lookup n self = [StyleTree style []] - | otherwise = [] - -loadUserStyles styles = do - dir <- Dir.getXdgDirectory Dir.XdgConfig "haphaestus" - exists <- Dir.doesDirectoryExist dir - loadDirectory dir exists + longhand _ self "color" [Ident "black"] = Just $ VizStyle (V4 0 0 0 1) + longhand _ self "color" [Ident "white"] = Just $ VizStyle (V4 1 1 1 1) + longhand _ self "color" [Ident "red"] = Just $ VizStyle (V4 1 0 0 1) + longhand _ self "color" [Ident "green"] = Just $ VizStyle (V4 0 1 0 1) + longhand _ self "color" [Ident "blue"] = Just $ VizStyle (V4 0 0 1 1) + longhand _ _ _ _ = Nothing + +renderLayout :: (MonadError TypograffitiError m, MonadIO m) => + M.Map (FC.Pattern, Double) Atlas -> + (Atlas -> [(GlyphInfo, GlyphPos)] -> + m (AllocatedRendering [TextTransform])) -> + LayoutItem Double Double ((Double, Double), VizStyle) -> + m () +renderLayout atlases drawText (LayoutSpan self) + | Just atlas <- M.lookup (pattern font, fontSize font) atlases = do + drawText' <- drawText atlas $ glyphs self + liftIO $ arDraw drawText' [TextTransformMultiply color] $ + V2 (fromEnum x) (fromEnum y) where - loadDirectory _ False = return styles - loadDirectory dir True = do - files <- Dir.listDirectory dir - loadFiles (cssPriorityUser styles) files - loadFiles style (file:files) = do - source <- readFile file - CSS.parse style (Txt.pack source) `loadFiles` files - loadFiles style [] = return style - - -retreiveStyles :: Session -> CSSCond.ConditionalStyles (Style) -> - IO (CSSCond.ConditionalStyles Style) -retreiveStyles manager authorStyle = do - let agentStyle = cssPriorityAgent authorStyle `CSS.parse` $(embedStringFile "useragent.css") - userStyle <- loadUserStyles agentStyle - CSSCond.loadImports loadURL lowerVars lowerToks userStyle [] - where - loadURL url = do - response <- fetchURL manager ["text/css"] url - let charsets' = map unpack charsets - return $ case response of - ("text/css", Left text) -> text - ("text/css", Right bytes) -> applyCSScharset charsets' $ B.toStrict bytes - (_, _) -> "" - -resolve' = CSSCond.resolve lowerVars lowerToks -lowerVars "speech" = CSSCond.B True -lowerVars "-rhapsode" = CSSCond.B True -lowerVars _ = CSSCond.B False -lowerToks _ = CSSCond.B False - -renderLayout atlases drawText (LayoutSpan ((x, y), VizStyle color) font self) + (font, _) = fragmentFont self + ((x, y), VizStyle color) = layoutGetInner $ LayoutSpan self +{-renderLayout atlases drawText (LayoutSpan ((x, y), VizStyle color) font self) | Just atlas <- M.lookup (pattern font, fontSize font) atlases = do drawText' <- drawText atlas $ fragmentGlyphs self -- FIXME Switch from temp to inherit for inline caller-properties. liftIO $ arDraw drawText' [TextTransformMultiply color] - (V2 (fromEnum x) (fromEnum y)) + (V2 (fromEnum x) (fromEnum y))-} -- FIXME: New API! renderLayout atlases drawText node = do layoutGetChilds node `forM` renderLayout atlases drawText return () -main :: IO () -main = do - sess <- newSession +initReferer :: IO (Page (CSSCond.ConditionalStyles (CSSBox VizStyle))) +initReferer = do cwd <- getCurrentDirectory - hist <- loadVisited "haphaestus" - let referer = Page { + return $ Page { -- Default to URIs being relative to CWD. pageURL = URI {uriScheme = "file:", uriPath = cwd, uriAuthority = Nothing, uriQuery = "", uriFragment = ""}, @@ -142,47 +118,87 @@ main = do documentEpilogue = [] }, pageTitle = "", pageMIME = "", apps = [], - backStack = [], forwardStack = [], visitedURLs = hist, + backStack = [], forwardStack = [], visitedURLs = S.empty, initCSS = conditionalStyles, - appName = "haphaestus" + appName = "cattrap" } - [arg, scale'] <- getArgs - let uri = nullURI `fromMaybe` parseURIReference arg `relativeTo` pageURL referer - page <- fetchDocument sess referer uri - - let pseudofilter :: CSSPseudo.LowerPsuedoClasses (Style.QueryableStyleSheet Style) - pseudofilter = CSSPseudo.htmlPsuedoFilter Style.queryableStyleSheet - css0 <- retreiveStyles sess $ css page - let css' = CSSPseudo.inner $ resolve' pseudofilter css0 - let style = CSSTxt.resolve $ inlinePseudos' $ stylize css' $ el2stylist $ - documentRoot $ html page - let sysfont = (pattern2font (nameParse "serif") Style.temp { cssFontSize = (12,"pt") } - placeholderFont placeholderFont) { scale = read scale' } - let inf = 1/0 - let infbox = zeroBox { B.min = Size inf inf, B.size = Size inf inf, - B.max = Size inf inf } - let layout0 = boxLayout infbox (finalizeCSS' sysfont style) False +stylize' style = preorder inner + where + inner parent _ el = Style.cascade style el [] $ + Style.inherit $ fromMaybe Style.temp parent + +resolveCSS manager page = do + let agentStyle = cssPriorityAgent (css page) `CSS.parse` + $(makeRelativeToProject "useragent.css" >>= embedStringFile) + userStyle <- loadUserStyles agentStyle + CSSCond.loadImports loadURL lowerVars lowerToks userStyle [] + where + loadURL url = do + response <- fetchURL manager ["text/css"] url + let charsets' = map Txt.unpack charsets + return $ case response of + ("text/css", Left text) -> text + ("text/css", Right bytes) -> applyCSScharset charsets' $ BS.toStrict bytes + (_, _) -> "" + +loadUserStyles styles = do + dir <- Dir.getXdgDirectory Dir.XdgConfig "rhapsode" + exists <- Dir.doesDirectoryExist dir + loadDirectory dir exists + where + loadDirectory _ False = return styles + loadDirectory dir True = do + files <- Dir.listDirectory dir + loadFiles (cssPriorityUser styles) files + loadFiles style (file:files) = do + source <- readFile file + CSS.parse style (Txt.pack source) `loadFiles` files + loadFiles style [] = return style +-- FIXME: Support more media queries! +resolve' = CSSCond.resolve lowerVars lowerToks +lowerVars _ = CSSCond.B False +lowerToks _ = CSSCond.B False +main :: IO () +main = do + FC.init SDL.initializeAll - let openGL = defaultOpenGL { glProfile = Core Debug 3 3 } - wcfg = defaultWindow { - windowInitialSize = V2 640 480, - windowGraphicsContext = OpenGLContext openGL, - windowResizable = True + + let wcfg = defaultWindow { + windowInitialSize = V2 1280 480, + windowGraphicsContext = OpenGLContext defaultOpenGL { + glProfile = Core Debug 3 3 + }, + -- Simplify moving layout/download out-of-thread + windowResizable = False } w <- createWindow "Haphaestus" wcfg _ <- glCreateContext w - ft_With_FreeType $ \ft -> runExceptT $ do - drawGlyphs <- makeDrawGlyphs - atlases <- forM (M.toList $ glyphsPerFont layout0) $ \((pat, size), glyphs) -> do - font <- liftIO $ instantiatePattern ft pat (-1, size) - atlas <- allocAtlas (liftIO . bmpAndMetricsForIndex font SubpixelDefault) - (map toEnum $ IS.toList glyphs) - (realToFrac $ hbScale sysfont, realToFrac $ hbScale sysfont) - return ((pat, size), atlas) - let atlases' = M.fromList atlases + args <- getArgs + let url = case args of + (url:_) -> url + [] -> "https://git.argonaut-constellation.org/~alcinnz/CatTrap" + sess <- newSession + ref <- initReferer + xml <- fetchDocument sess ref $ fromMaybe nullURI $ parseURIReference url + let pseudoFilter = CSSPseudo.htmlPsuedoFilter Style.queryableStyleSheet + css' <- resolveCSS sess xml + let css = CSSPseudo.inner $ resolve' pseudoFilter css' + let styles = CSSTxt.resolve $ treeMap Style.innerParser $ + stylize' css $ el2stylist $ X.documentRoot $ html xml + let layout = finalizeCSS' placeholderFont styles + + ft_With_FreeType $ \ft -> do + V2 x y <- get $ windowSize w + pages' <- forkCompute $ addAtlas ft $ boxLayout zeroBox { + B.size = B.Size (fromIntegral x) (fromIntegral y) + } layout True + drawGlyphs' <- runExceptT makeDrawGlyphs + let drawGlyphs = case drawGlyphs' of + Left err -> error $ show err + Right ret -> ret fix $ \loop -> do events <- fmap eventPayload <$> pollEvents @@ -192,12 +208,44 @@ main = do sz@(V2 dw dh) <- liftIO $ glGetDrawableSize w liftIO $ glViewport 0 0 (fromIntegral dw) (fromIntegral dh) - let size = B.Size (fromIntegral dw) (fromIntegral dh) - let outerbox = zeroBox { B.min = size, B.size = size, B.max = size } - let layout = boxLayout outerbox (finalizeCSS' sysfont style) False - - renderLayout atlases' drawGlyphs layout + layout' <- tryReadMVar pages' + res <- case layout' of + Just (layout:_, atlases') -> runExceptT $ + renderLayout atlases' drawGlyphs layout + _ -> return $ Right () + case res of + Left err -> print err + Right () -> return () liftIO $ glSwapWindow w unless (QuitEvent `elem` events) loop - return () + SDL.quit + -- FC.fini -- FIXME: Need to free all Haskell data before freeing FontConfig's + +c :: (Enum a, Enum b) => a -> b +c = toEnum . fromEnum + +forkCompute dat = do + ret <- liftIO $ newEmptyMVar + liftIO $ forkIO (putMVar ret =<< dat) + return ret + +type Layouts = [LayoutItem Double Double ((Double, Double), VizStyle)] +addAtlas :: FT_Library -> Layouts -> IO (Layouts, M.Map (FC.Pattern, Double) Atlas) +addAtlas ft layout = do + let sysfont = (pattern2font (FC.nameParse "serif") Style.temp { cssFontSize = (12,"pt") } + placeholderFont placeholderFont) { scale = 1 } + + let required = glyphsPerFont $ LayoutFlow ((0, 0), temp) zeroBox layout + atlases <- forM (M.toList required) $ \(key@(pat, size), glyphs) -> do + font <- instantiatePattern ft pat (-1, size) + atlas <- runExceptT $ allocAtlas + (liftIO . bmpAndMetricsForIndex font SubpixelDefault) + (map toEnum $ IS.toList glyphs) + (realToFrac $ hbUnit, realToFrac $ hbUnit) + case atlas of + Left err -> do + print err + return (key, Nothing) + Right atlas' -> return (key, Just atlas') + return (layout, M.fromList [(k, v) | (k, Just v) <- atlases]) diff --git a/useragent.css b/useragent.css index 451cb4a..4594699 100644 --- a/useragent.css +++ b/useragent.css @@ -70,9 +70,701 @@ BDO[DIR="rtl"] { direction: rtl; unicode-bidi: bidi-override } *[DIR="ltr"] { direction: ltr; unicode-bidi: embed } *[DIR="rtl"] { direction: rtl; unicode-bidi: embed } -@media print { - h1 { page-break-before: always } - h1, h2, h3, - h4, h5, h6 { page-break-after: avoid } - ul, ol, dl { page-break-before: avoid } + +h1 { page-break-before: always } +h1, h2, h3, +h4, h5, h6 { page-break-after: avoid } +ul, ol, dl { page-break-before: avoid } + +@document unstyled { + /* From https://github.com/kevquirk/simple.css/blob/main/simple.css */ + /* Global variables. */ + :root, + ::backdrop { + /* Set sans-serif & mono fonts */ + --sans-font: -apple-system, BlinkMacSystemFont, "Avenir Next", Avenir, + "Nimbus Sans L", Roboto, "Noto Sans", "Segoe UI", Arial, Helvetica, + "Helvetica Neue", sans-serif; + --mono-font: Consolas, Menlo, Monaco, "Andale Mono", "Ubuntu Mono", monospace; + --standard-border-radius: 5px; + + /* Default (light) theme */ + --bg: #fff; + --accent-bg: #f5f7ff; + --text: #212121; + --text-light: #585858; + --border: #898EA4; + --accent: #0d47a1; + --code: #d81b60; + --preformatted: #444; + --marked: #ffdd33; + --disabled: #efefef; + } + + /* Dark theme */ + @media (prefers-color-scheme: dark) { + :root, + ::backdrop { + color-scheme: dark; + --bg: #212121; + --accent-bg: #2b2b2b; + --text: #dcdcdc; + --text-light: #ababab; + --accent: #ffb300; + --code: #f06292; + --preformatted: #ccc; + --disabled: #111; + } + /* Add a bit of transparency so light media isn't so glaring in dark mode */ + img, + video { + opacity: 0.8; + } + } + + /* Reset box-sizing */ + *, *::before, *::after { + box-sizing: border-box; + } + + /* Reset default appearance */ + textarea, + select, + input, + progress { + appearance: none; + -webkit-appearance: none; + -moz-appearance: none; + } + + html { + /* Set the font globally */ + font-family: var(--sans-font); + scroll-behavior: smooth; + } + + /* Make the body a nice central block */ + body { + color: var(--text); + background-color: var(--bg); + font-size: 1.15rem; + line-height: 1.5; + display: grid; + grid-template-columns: 1fr min(45rem, 90%) 1fr; + margin: 0; + } + body > * { + grid-column: 2; + } + + /* Make the header bg full width, but the content inline with body */ + body > header { + background-color: var(--accent-bg); + border-bottom: 1px solid var(--border); + text-align: center; + padding: 0 0.5rem 2rem 0.5rem; + grid-column: 1 / -1; + } + + body > header > *:only-child { + margin-block-start: 2rem; + } + + body > header h1 { + max-width: 1200px; + margin: 1rem auto; + } + + body > header p { + max-width: 40rem; + margin: 1rem auto; + } + + /* Add a little padding to ensure spacing is correct between content and header > nav */ + main { + padding-top: 1.5rem; + } + + body > footer { + margin-top: 4rem; + padding: 2rem 1rem 1.5rem 1rem; + color: var(--text-light); + font-size: 0.9rem; + text-align: center; + border-top: 1px solid var(--border); + } + + /* Format headers */ + h1 { + font-size: 3rem; + } + + h2 { + font-size: 2.6rem; + margin-top: 3rem; + } + + h3 { + font-size: 2rem; + margin-top: 3rem; + } + + h4 { + font-size: 1.44rem; + } + + h5 { + font-size: 1.15rem; + } + + h6 { + font-size: 0.96rem; + } + + p { + margin: 1.5rem 0; + } + + /* Prevent long strings from overflowing container */ + p, h1, h2, h3, h4, h5, h6 { + overflow-wrap: break-word; + } + + /* Fix line height when title wraps */ + h1, + h2, + h3 { + line-height: 1.1; + } + + /* Reduce header size on mobile */ + @media only screen and (max-width: 720px) { + h1 { + font-size: 2.5rem; + } + + h2 { + font-size: 2.1rem; + } + + h3 { + font-size: 1.75rem; + } + + h4 { + font-size: 1.25rem; + } + } + + /* Format links & buttons */ + a, + a:visited { + color: var(--accent); + } + + a:hover { + text-decoration: none; + } + + button, + .button, + a.button, /* extra specificity to override a */ + input[type="submit"], + input[type="reset"], + input[type="button"], + label[type="button"] { + border: 1px solid var(--accent); + background-color: var(--accent); + color: var(--bg); + padding: 0.5rem 0.9rem; + text-decoration: none; + line-height: normal; + } + + .button[aria-disabled="true"], + input:disabled, + textarea:disabled, + select:disabled, + button[disabled] { + cursor: not-allowed; + background-color: var(--disabled); + border-color: var(--disabled); + color: var(--text-light); + } + + input[type="range"] { + padding: 0; + } + + /* Set the cursor to '?' on an abbreviation and style the abbreviation to show that there is more information underneath */ + abbr[title] { + cursor: help; + text-decoration-line: underline; + text-decoration-style: dotted; + } + + button:enabled:hover, + .button:not([aria-disabled="true"]):hover, + input[type="submit"]:enabled:hover, + input[type="reset"]:enabled:hover, + input[type="button"]:enabled:hover, + label[type="button"]:hover { + filter: brightness(1.4); + cursor: pointer; + } + + .button:focus-visible, + button:focus-visible:where(:enabled), + input:enabled:focus-visible:where( + [type="submit"], + [type="reset"], + [type="button"] + ) { + outline: 2px solid var(--accent); + outline-offset: 1px; + } + + /* Format navigation */ + header > nav { + font-size: 1rem; + line-height: 2; + padding: 1rem 0 0 0; + } + + /* Use flexbox to allow items to wrap, as needed */ + header > nav ul, + header > nav ol { + align-content: space-around; + align-items: center; + display: flex; + flex-direction: row; + flex-wrap: wrap; + justify-content: center; + list-style-type: none; + margin: 0; + padding: 0; + } + + /* List items are inline elements, make them behave more like blocks */ + header > nav ul li, + header > nav ol li { + display: inline-block; + } + + header > nav a, + header > nav a:visited { + margin: 0 0.5rem 1rem 0.5rem; + border: 1px solid var(--border); + border-radius: var(--standard-border-radius); + color: var(--text); + display: inline-block; + padding: 0.1rem 1rem; + text-decoration: none; + } + + header > nav a:hover, + header > nav a.current, + header > nav a[aria-current="page"] { + border-color: var(--accent); + color: var(--accent); + cursor: pointer; + } + + /* Reduce nav side on mobile */ + @media only screen and (max-width: 720px) { + header > nav a { + border: none; + padding: 0; + text-decoration: underline; + line-height: 1; + } + } + + /* Consolidate box styling */ + aside, details, pre, progress { + background-color: var(--accent-bg); + border: 1px solid var(--border); + border-radius: var(--standard-border-radius); + margin-bottom: 1rem; + } + + aside { + font-size: 1rem; + width: 30%; + padding: 0 15px; + margin-inline-start: 15px; + float: right; + } + *[dir="rtl"] aside { + float: left; + } + + /* Make aside full-width on mobile */ + @media only screen and (max-width: 720px) { + aside { + width: 100%; + float: none; + margin-inline-start: 0; + } + } + + article, fieldset, dialog { + border: 1px solid var(--border); + padding: 1rem; + border-radius: var(--standard-border-radius); + margin-bottom: 1rem; + } + + article h2:first-child, + section h2:first-child { + margin-top: 1rem; + } + + section { + border-top: 1px solid var(--border); + border-bottom: 1px solid var(--border); + padding: 2rem 1rem; + margin: 3rem 0; + } + + /* Don't double separators when chaining sections */ + section + section, + section:first-child { + border-top: 0; + padding-top: 0; + } + + section:last-child { + border-bottom: 0; + padding-bottom: 0; + } + + details { + padding: 0.7rem 1rem; + } + + summary { + cursor: pointer; + font-weight: bold; + padding: 0.7rem 1rem; + margin: -0.7rem -1rem; + word-break: break-all; + } + + details[open] > summary + * { + margin-top: 0; + } + + details[open] > summary { + margin-bottom: 0.5rem; + } + + details[open] > :last-child { + margin-bottom: 0; + } + + /* Format tables */ + table { + border-collapse: collapse; + margin: 1.5rem 0; + } + + td, + th { + border: 1px solid var(--border); + text-align: start; + padding: 0.5rem; + } + + th { + background-color: var(--accent-bg); + font-weight: bold; + } + + tr:nth-child(even) { + /* Set every other cell slightly darker. Improves readability. */ + background-color: var(--accent-bg); + } + + table caption { + font-weight: bold; + margin-bottom: 0.5rem; + } + + /* Format forms */ + textarea, + select, + input, + button, + .button { + font-size: inherit; + font-family: inherit; + padding: 0.5rem; + margin-bottom: 0.5rem; + border-radius: var(--standard-border-radius); + box-shadow: none; + max-width: 100%; + display: inline-block; + } + textarea, + select, + input { + color: var(--text); + background-color: var(--bg); + border: 1px solid var(--border); + } + label { + display: block; + } + textarea:not([cols]) { + width: 100%; + } + + /* Add arrow to drop-down */ + select:not([multiple]) { + background-image: linear-gradient(45deg, transparent 49%, var(--text) 51%), + linear-gradient(135deg, var(--text) 51%, transparent 49%); + background-position: calc(100% - 15px), calc(100% - 10px); + background-size: 5px 5px, 5px 5px; + background-repeat: no-repeat; + padding-inline-end: 25px; + } + *[dir="rtl"] select:not([multiple]) { + background-position: 10px, 15px; + } + + /* checkbox and radio button style */ + input[type="checkbox"], + input[type="radio"] { + vertical-align: middle; + position: relative; + width: min-content; + } + + input[type="checkbox"] + label, + input[type="radio"] + label { + display: inline-block; + } + + input[type="radio"] { + border-radius: 100%; + } + + input[type="checkbox"]:checked, + input[type="radio"]:checked { + background-color: var(--accent); + } + + input[type="checkbox"]:checked::after { + /* Creates a rectangle with colored right and bottom borders which is rotated to look like a check mark */ + content: " "; + width: 0.18em; + height: 0.32em; + border-radius: 0; + position: absolute; + top: 0.05em; + left: 0.17em; + background-color: transparent; + border-right: solid var(--bg) 0.08em; + border-bottom: solid var(--bg) 0.08em; + font-size: 1.8em; + transform: rotate(45deg); + } + input[type="radio"]:checked::after { + /* creates a colored circle for the checked radio button */ + content: " "; + width: 0.25em; + height: 0.25em; + border-radius: 100%; + position: absolute; + top: 0.125em; + background-color: var(--bg); + left: 0.125em; + font-size: 32px; + } + + /* Makes input fields wider on smaller screens */ + @media only screen and (max-width: 720px) { + textarea, + select, + input { + width: 100%; + } + } + + /* Set a height for color input */ + input[type="color"] { + height: 2.5rem; + padding: 0.2rem; + } + + /* do not show border around file selector button */ + input[type="file"] { + border: 0; + } + + /* Misc body elements */ + hr { + border: none; + height: 1px; + background: var(--border); + margin: 1rem auto; + } + + mark { + padding: 2px 5px; + border-radius: var(--standard-border-radius); + background-color: var(--marked); + color: black; + } + + mark a { + color: #0d47a1; + } + + img, + video { + max-width: 100%; + height: auto; + border-radius: var(--standard-border-radius); + } + + figure { + margin: 0; + display: block; + overflow-x: auto; + } + + figcaption { + text-align: center; + font-size: 0.9rem; + color: var(--text-light); + margin-bottom: 1rem; + } + + blockquote { + margin-inline-start: 2rem; + margin-inline-end: 0; + margin-block: 2rem; + padding: 0.4rem 0.8rem; + border-inline-start: 0.35rem solid var(--accent); + color: var(--text-light); + font-style: italic; + } + + cite { + font-size: 0.9rem; + color: var(--text-light); + font-style: normal; + } + + dt { + color: var(--text-light); + } + + /* Use mono font for code elements */ + code, + pre, + pre span, + kbd, + samp { + font-family: var(--mono-font); + color: var(--code); + } + + kbd { + color: var(--preformatted); + border: 1px solid var(--preformatted); + border-bottom: 3px solid var(--preformatted); + border-radius: var(--standard-border-radius); + padding: 0.1rem 0.4rem; + } + + pre { + padding: 1rem 1.4rem; + max-width: 100%; + overflow: auto; + color: var(--preformatted); + } + + /* Fix embedded code within pre */ + pre code { + color: var(--preformatted); + background: none; + margin: 0; + padding: 0; + } + + /* Progress bars */ + /* Declarations are repeated because you */ + /* cannot combine vendor-specific selectors */ + progress { + width: 100%; + } + + progress:indeterminate { + background-color: var(--accent-bg); + } + + progress::-webkit-progress-bar { + border-radius: var(--standard-border-radius); + background-color: var(--accent-bg); + } + + progress::-webkit-progress-value { + border-radius: var(--standard-border-radius); + background-color: var(--accent); + } + + progress::-moz-progress-bar { + border-radius: var(--standard-border-radius); + background-color: var(--accent); + transition-property: width; + transition-duration: 0.3s; + } + + progress:indeterminate::-moz-progress-bar { + background-color: var(--accent-bg); + } + + dialog { + max-width: 40rem; + margin: auto; + } + + dialog::backdrop { + background-color: var(--bg); + opacity: 0.8; + } + + @media only screen and (max-width: 720px) { + dialog { + max-width: 100%; + margin: auto 1em; + } + } + + /* Superscript & Subscript */ + /* Prevent scripts from affecting line-height. */ + sup, sub { + vertical-align: baseline; + position: relative; + } + + sup { + top: -0.4em; + } + + sub { + top: 0.3em; + } + + /* Classes for notices */ + .notice { + background: var(--accent-bg); + border: 2px solid var(--border); + border-radius: 5px; + padding: 1.5rem; + margin: 2rem 0; + } } -- 2.30.2