diff --git a/granite.cabal b/granite.cabal --- a/granite.cabal +++ b/granite.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: granite -version: 0.7.1.1 +version: 0.7.2.0 synopsis: Easy terminal plotting. description: A terminal plotting library for quick and easy visualisation. license: MIT diff --git a/src/Granite/Internal/Util.hs b/src/Granite/Internal/Util.hs --- a/src/Granite/Internal/Util.hs +++ b/src/Granite/Internal/Util.hs @@ -24,6 +24,9 @@ gridWidth, wcswidth, ellipsisize, + estLabelWidthPx, + estMaxGlyphs, + truncatePx, justifyRight, showD, escXml, @@ -128,6 +131,34 @@ | maxWidth <= 0 = "" | wcswidth lbl > maxWidth = Text.take (maxWidth - 1) lbl <> "…" | otherwise = lbl + +-- | Average glyph advance as a fraction of the em, for proportional fonts. +glyphAspectEm :: Double +glyphAspectEm = 0.6 + +{- | Rough rendered pixel width of a label at a given font size: visible +glyph count times 'glyphAspectEm'. Good enough to decide when axis labels +would collide. +-} +estLabelWidthPx :: Double -> Text -> Double +estLabelWidthPx fontSize t = fromIntegral (wcswidth t) * fontSize * glyphAspectEm + +{- | Inverse of 'estLabelWidthPx': the most glyphs that fit within @limitPx@ +at the given font size. Pair with 'ellipsisize' to truncate to a pixel budget. +-} +estMaxGlyphs :: Double -> Double -> Int +estMaxGlyphs fontSize limitPx = floor (limitPx / (fontSize * glyphAspectEm)) + +{- | Fit @full@ within @limitPx@ at the given font size: returns the +(possibly ellipsised) label and, when it was shortened, the full text for a +tooltip. Used wherever a label must not overrun its slot (axis ticks, facet +strips). +-} +truncatePx :: Double -> Double -> Text -> (Text, Maybe Text) +truncatePx fontSize limitPx full + | estLabelWidthPx fontSize full <= limitPx = (full, Nothing) + | otherwise = + (ellipsisize (max 1 (estMaxGlyphs fontSize limitPx)) full, Just full) justifyRight :: Int -> Text -> Text justifyRight n s = Text.replicate (max 0 (n - wcswidth s)) " " <> s diff --git a/src/Granite/Render/Chrome.hs b/src/Granite/Render/Chrome.hs --- a/src/Granite/Render/Chrome.hs +++ b/src/Granite/Render/Chrome.hs @@ -11,15 +11,25 @@ -} module Granite.Render.Chrome ( PlotBox (..), + Margins (..), computePlotBox, + AxisLayout (..), + XLabelMode, + xModeNoRotate, + axisLayout, + domainLabels, axesMarks, titleMarks, legendMarks, ) where import Data.Char (isDigit) +import Data.List (nub) +import Data.Maybe (isJust) import Data.Text (Text) import Data.Text qualified as Text +import Granite.Internal.Util (estLabelWidthPx, truncatePx) +import Text.Read (readMaybe) import Granite.Color (Color (..)) import Granite.Render.Scene ( @@ -55,28 +65,134 @@ } deriving (Eq, Show) -computePlotBox :: Size -> Theme -> Bool -> Bool -> Bool -> PlotBox -computePlotBox sz theme hasTitle hasRightLegend hasBottomLegend = - let (sceneW, sceneH) = case sz of - SizeChars w h -> - (fromIntegral w * themePxPerChar theme, fromIntegral h * themePxPerLine theme) - SizePixels w h -> (fromIntegral w, fromIntegral h) - SizeResponsive ar -> - let h = 320 - in (h * ar, h) - topMargin = if hasTitle then themeTitleSize theme + 20 else 10 - bottomMargin = (if hasBottomLegend then 30 else 0) + themeFontSize theme * 1.8 + 8 - leftMargin = themeFontSize theme * 5 - rightMargin = if hasRightLegend then 120 else 20 +-- | Scene pixel dimensions for a 'Size'. +sceneDims :: Size -> Theme -> (Double, Double) +sceneDims sz theme = case sz of + SizeChars w h -> + (fromIntegral w * themePxPerChar theme, fromIntegral h * themePxPerLine theme) + SizePixels w h -> (fromIntegral w, fromIntegral h) + SizeResponsive ar -> let h = 320 in (h * ar, h) + +{- | Inputs that grow the plot margins beyond the theme defaults. @marExtraBottom@ +enlarges the bottom margin (for rotated x-labels) and @marLeftWanted@ requests a +left margin (to fit long y-labels / the rotated labels' leftward reach); both +fall back to the defaults when 0\/small. +-} +data Margins = Margins + { marHasTitle :: !Bool + , marHasRightLegend :: !Bool + , marHasBottomLegend :: !Bool + , marExtraBottom :: !Double + , marLeftWanted :: !Double + } + deriving (Eq, Show) + +computePlotBox :: Size -> Theme -> Margins -> PlotBox +computePlotBox sz theme m = + let (sceneW, sceneH) = sceneDims sz theme + topMargin = if marHasTitle m then themeTitleSize theme + 20 else 10 + bottomMargin = + (if marHasBottomLegend m then 30 else 0) + + max (themeFontSize theme * 1.8 + 8) (marExtraBottom m) + leftMargin = max (themeFontSize theme * 5) (marLeftWanted m) + rightMargin = rightMarginPx (marHasRightLegend m) plotW = max 1 (sceneW - leftMargin - rightMargin) plotH = max 1 (sceneH - topMargin - bottomMargin) in PlotBox sceneW sceneH leftMargin topMargin plotW plotH -axesMarks :: Theme -> PlotBox -> Coord -> TrainedScale -> TrainedScale -> [Mark] -axesMarks theme box coord xs ys = case coord of - CoordCartesian -> cartesianAxes theme box False xs ys +rightMarginPx :: Bool -> Double +rightMarginPx hasRightLegend = if hasRightLegend then 120 else 20 + +-- | The automatic policy for bottom-axis labels given their per-tick budget. +data XPolicy = XUpright | XThin | XRotate + deriving (Eq, Show) + +xLabelPolicy :: Double -> Double -> [Text] -> XPolicy +xLabelPolicy fontSize budget labels + | maxLabelWidth fontSize labels <= budget = XUpright + | not (null labels) && all isNumericLabel labels = XThin + | otherwise = XRotate + +maxLabelWidth :: Double -> [Text] -> Double +maxLabelWidth fontSize = maximum . (0 :) . map (estLabelWidthPx fontSize) + +-- | Rotated x-labels wider than this (px) are truncated with a hover @\@. +rotatedLabelLimitPx :: Double +rotatedLabelLimitPx = 130 + +-- | @sin 45°@ — a rotated label's horizontal/vertical reach as a fraction of its width. +sin45 :: Double +sin45 = sqrt 2 / 2 + +{- | How the bottom (x) axis labels are laid out, plus the extra margins that +choice needs. Decided exactly once per chart so margin sizing and the actual +label rendering can never disagree (the bug when each recomputed the policy +from a slightly different plot width). 'XLabelMode' is threaded to 'axesMarks'; +'alExtraBottom'\/'alLeftWanted' feed 'computePlotBox'. +-} +data AxisLayout = AxisLayout + { alMode :: !XLabelMode + , alExtraBottom :: !Double + , alLeftWanted :: !Double + } + +{- | What a panel's x-axis renderer should do. 'XFixed' carries the +chart-global decision verbatim (single panel). 'XLocalNoRotate' lets a faceted +panel pick upright\/thin from its own width, but never rotate — rotation needs a +per-cell margin reservation the facet layout doesn't make. +-} +data XLabelMode = XFixed !XPolicy | XLocalNoRotate + +-- | The mode for axes that never rotate their labels (polar; also the faceted default). +xModeNoRotate :: XLabelMode +xModeNoRotate = XLocalNoRotate + +{- | Decide the bottom-axis label policy and the margins it needs, in one pass. +A wide left label grows the left margin (up to ~42% of the scene); rotated +bottom labels also reach down (bottom margin) and left (left margin) by +@sin 45°@ of their width. Faceted charts never rotate, so they reserve no extra +bottom margin. +-} +axisLayout :: Theme -> Size -> Bool -> Bool -> [Text] -> [Text] -> AxisLayout +axisLayout theme sz hasRightLegend faceted bottomLbls leftLbls = + AxisLayout + { alMode = mode + , alExtraBottom = bottomExtra + , alLeftWanted = leftWanted + } + where + (sceneW, _) = sceneDims sz theme + fontSize = themeFontSize theme + cap = 0.42 * sceneW + -- Left margin from y-labels alone, used to set the plot width that decides + -- x rotation. Rotation can grow it further (its leftward reach), but the + -- rotate/thin decision itself is fixed here and threaded, so it never drifts. + provLeft = min cap (max (fontSize * 5) (maxLabelWidth fontSize leftLbls + 12)) + provPlotW = max 1 (sceneW - provLeft - rightMarginPx hasRightLegend) + n = length bottomLbls + budget = if n <= 1 then provPlotW else provPlotW / fromIntegral n + policy = xLabelPolicy fontSize budget bottomLbls + rotates = not faceted && policy == XRotate + rotatedExtent = sin45 * min (maxLabelWidth fontSize bottomLbls) rotatedLabelLimitPx + mode = if faceted then XLocalNoRotate else XFixed policy + -- A rotated label's baseline sits @fontSize + 4@ below the axis and reaches + -- down a further @rotatedExtent@; +8 keeps a descender's clearance above the + -- scene edge. + bottomExtra = if rotates then fontSize + 4 + rotatedExtent + 8 else 0 + leftWanted = min cap (max provLeft (if rotates then rotatedExtent else 0)) + +axesMarks :: + Theme -> + PlotBox -> + Coord -> + XLabelMode -> + TrainedScale -> + TrainedScale -> + [Mark] +axesMarks theme box coord xmode xs ys = case coord of + CoordCartesian -> cartesianAxes theme box False xmode xs ys -- CoordFlip rotates 90° CW so the Y axis grows top-down. - CoordFlip -> cartesianAxes theme box True ys xs + CoordFlip -> cartesianAxes theme box True xmode ys xs CoordPolar aes a0 dir -> polarAxes theme box aes a0 dir xs ys {- | Axes are 'MAxisLine' spines (clean box-drawing chars in terminal, @@ -85,8 +201,8 @@ break. @flipY@ inverts Y for 'CoordFlip'. -} cartesianAxes :: - Theme -> PlotBox -> Bool -> TrainedScale -> TrainedScale -> [Mark] -cartesianAxes theme box flipY xs ys = + Theme -> PlotBox -> Bool -> XLabelMode -> TrainedScale -> TrainedScale -> [Mark] +cartesianAxes theme box flipY xmode xs ys = let axisColor = colorOfSpec (themeAxisColor theme) textColor = colorOfSpec (themeTextColor theme) @@ -100,38 +216,120 @@ xAxis = MAxisLine (Point px (py + ph)) (Point (px + pw) (py + ph)) spineStyle yAxis = MAxisLine (Point px py) (Point px (py + ph)) spineStyle - xLabels = - [ MText - (Point xPos (py + ph + themeFontSize theme + 4)) - lbl - defaultTextStyle - { textFill = textColor - , textSize = themeFontSize theme - , textAnchor = AnchorMiddle - } - | (v, lbl) <- zip (tsBreaks xs) (tsLabels xs) - , inDomain (tsDomain xs) v - , let xPos = px + tsProject xs v * pw - ] - - yLabels = - [ MText - (Point (px - 6) (yPos + themeFontSize theme / 3)) - lbl - defaultTextStyle - { textFill = textColor - , textSize = themeFontSize theme - , textAnchor = AnchorEnd - } - | (v, lbl) <- zip (tsBreaks ys) (tsLabels ys) - , inDomain (tsDomain ys) v - , let yPos = - if flipY - then py + tsProject ys v * ph - else py + ph - tsProject ys v * ph - ] + xLabels = xAxisLabels theme px py pw ph textColor xmode xs + yLabels = yAxisLabels theme px py ph flipY textColor ys in [xAxis, yAxis] <> xLabels <> yLabels +{- | X-axis tick labels that automatically adapt to long words, following the +chart-global 'XLabelMode' so margin sizing and rendering agree. If the labels +fit their per-tick slot they render upright (unchanged). Otherwise, keyed on the +data: numeric labels are thinned to a subset that fits (dropping ticks on a +continuum is fine, and the first\/last are always kept so the axis bounds stay +labelled), while categorical labels are rotated −45° and, past +'rotatedLabelLimitPx', truncated with a hover @\@ — a category name is +never silently dropped. Rotation and the @\@ tooltip are SVG-only; the +terminal backend draws the (truncated) text upright. +-} +xAxisLabels :: + Theme -> + Double -> + Double -> + Double -> + Double -> + Color -> + XLabelMode -> + TrainedScale -> + [Mark] +xAxisLabels theme px py pw ph textColor xmode xs = case resolvedPolicy of + XUpright -> map (upright budget) raw + XThin -> + let keep = thinIndices n maxW pw + slot = pw / fromIntegral (max 1 (length keep)) + in [upright slot (raw !! i) | i <- keep] + XRotate -> map rotated raw + where + fontSize = themeFontSize theme + baseY = py + ph + fontSize + 4 + raw = + [ (px + tsProject xs v * pw, lbl) + | (v, lbl) <- zip (tsBreaks xs) (tsLabels xs) + , inDomain (tsDomain xs) v + ] + n = length raw + maxW = maxLabelWidth fontSize (map snd raw) + budget = if n <= 1 then pw else pw / fromIntegral n + resolvedPolicy = case xmode of + XFixed p -> p + -- Faceted: pick from this panel's own width but never rotate. + XLocalNoRotate -> case xLabelPolicy fontSize budget (map snd raw) of + XRotate -> XUpright + p -> p + sty anchor rot title = + defaultTextStyle + { textFill = textColor + , textSize = fontSize + , textAnchor = anchor + , textRotate = rot + , textTitle = title + } + -- Upright labels are truncated to their per-tick slot so they never overrun + -- it — the only path that bites is the faceted fallback, where rotation is + -- forbidden and a long category would otherwise overflow its cell. + upright slot (xp, full) = + let (lbl, title) = truncatePx fontSize slot full + in MText (Point xp baseY) lbl (sty AnchorMiddle 0 title) + rotated (xp, full) = + let (lbl, title) = truncatePx fontSize rotatedLabelLimitPx full + in MText (Point xp baseY) lbl (sty AnchorEnd (-45) title) + +{- | Indices of a thinned label subset: the most evenly-spaced labels that fit +@plotW@ at width @maxW@, always including the first and last so the axis bounds +stay labelled. (Even-index thinning could drop the max tick on an even count.) +-} +thinIndices :: Int -> Double -> Double -> [Int] +thinIndices n maxW plotW + | n <= 2 = [0 .. n - 1] + | otherwise = + let fit = max 2 (min n (floor (plotW / max 1 maxW))) + pick j = round (fromIntegral (j * (n - 1)) / fromIntegral (fit - 1) :: Double) + in nub (map pick [0 .. fit - 1]) + +{- | Y-axis (left) tick labels, one per break. Truncated with a hover +@\@ to fit the left margin (the margin itself is grown to hold long +labels up to a cap; this only bites past that cap). +-} +yAxisLabels :: + Theme -> Double -> Double -> Double -> Bool -> Color -> TrainedScale -> [Mark] +yAxisLabels theme px py ph flipY textColor ys = + [ MText (Point (px - 6) (yPos + fontSize / 3)) lbl (sty title) + | (v, full) <- zip (tsBreaks ys) (tsLabels ys) + , inDomain (tsDomain ys) v + , let yPos = + if flipY then py + tsProject ys v * ph else py + ph - tsProject ys v * ph + (lbl, title) = truncatePx fontSize (px - 10) full + ] + where + fontSize = themeFontSize theme + sty title = + defaultTextStyle + { textFill = textColor + , textSize = fontSize + , textAnchor = AnchorEnd + , textTitle = title + } + +{- | A label produced by a numeric axis — only decimal\/scientific digits, +so categorical values like @\"NaN\"@, @\"Infinity\"@ or @\"0x10\"@ (which +'readMaybe' would otherwise accept) are correctly treated as categories. +-} +isNumericLabel :: Text -> Bool +isNumericLabel t = + not (Text.null s) + && Text.all (`elem` ("0123456789.eE+-" :: String)) s + && isJust (readMaybe (Text.unpack s) :: Maybe Double) + where + s = Text.strip t + {- | Concentric rings (radial breaks) + radial spokes (angular breaks) + tick labels. Centred in the plot box with radius = half its shortest side. @@ -232,6 +430,10 @@ inDomain :: (Double, Double) -> Double -> Bool inDomain (lo, hi) v = v >= lo - 1e-9 && v <= hi + 1e-9 + +-- | A trained scale's in-domain tick labels, in break order. +domainLabels :: TrainedScale -> [Text] +domainLabels s = [lbl | (v, lbl) <- zip (tsBreaks s) (tsLabels s), inDomain (tsDomain s) v] titleMarks :: Theme -> PlotBox -> Maybe Text -> [Mark] titleMarks _ _ Nothing = [] diff --git a/src/Granite/Render/Pipeline.hs b/src/Granite/Render/Pipeline.hs --- a/src/Granite/Render/Pipeline.hs +++ b/src/Granite/Render/Pipeline.hs @@ -32,13 +32,20 @@ filterByRows, lookupColumn, ) +import Granite.Internal.Util (truncatePx) import Granite.Position (applyPosition) import Granite.Render.Chrome ( + AxisLayout (..), + Margins (..), PlotBox (..), + XLabelMode, axesMarks, + axisLayout, computePlotBox, + domainLabels, legendMarks, titleMarks, + xModeNoRotate, ) import Granite.Render.Scene ( Mark (..), @@ -153,10 +160,34 @@ _ -> Nothing legendEntries = collectLegend (chartLayers chart) palette colorMaps hasRightLegend = not (null legendEntries) - box = computePlotBox (chartSize chart) theme hasTitle hasRightLegend False + -- Size margins to the actual labels so long words never clip, and decide + -- the bottom-axis label policy once (threaded as 'XLabelMode') so margin + -- sizing and rendering agree. The on-screen bottom\/left axes swap under + -- CoordFlip; polar has no rectangular axes; faceting forbids rotation. + (xLbls, yLbls) = globalAxisLabels chart + (bottomLbls, leftLbls) = case coord of + CoordFlip -> (yLbls, xLbls) + _ -> (xLbls, yLbls) + faceted = case chartFacet chart of FacetNull -> False; _ -> True + layout = case coord of + CoordPolar{} -> AxisLayout xModeNoRotate 0 0 + _ -> + axisLayout theme (chartSize chart) hasRightLegend faceted bottomLbls leftLbls + box = + computePlotBox (chartSize chart) theme $ + Margins + { marHasTitle = hasTitle + , marHasRightLegend = hasRightLegend + , marHasBottomLegend = False + , marExtraBottom = alExtraBottom layout + , marLeftWanted = alLeftWanted layout + } panels = layoutPanels theme box chart - panelMarks = concatMap (renderPanel theme palette coord colorMaps fillCols) panels + panelMarks = + concatMap + (renderPanel theme palette coord (alMode layout) colorMaps fillCols) + panels legend = legendMarks theme box legendEntries title = titleMarks theme box (chartTitle chart) @@ -177,11 +208,12 @@ Theme -> [ColorSpec] -> Coord -> + XLabelMode -> [Maybe [(Text, ColorSpec)]] -> Maybe [ColorSpec] -> PanelSpec -> [Mark] -renderPanel theme palette coord colorMaps fillCols ps = +renderPanel theme palette coord xmode colorMaps fillCols ps = let proj = buildProjector coord (panelBox ps) (panelXScale ps) (panelYScale ps) cmap i = if i < length colorMaps then colorMaps !! i else Nothing layerMarks = @@ -198,7 +230,7 @@ layer | (i, layer) <- zip [0 :: Int ..] (panelLayers ps) ] - axes = axesMarks theme (panelBox ps) coord (panelXScale ps) (panelYScale ps) + axes = axesMarks theme (panelBox ps) coord xmode (panelXScale ps) (panelYScale ps) strip = stripMark theme (panelBox ps) (panelLabel ps) in axes <> layerMarks <> strip @@ -206,15 +238,17 @@ stripMark theme box label | Text.null label = [] | otherwise = - [ MText - (Point (boxX box + boxW box / 2) (boxY box - 4)) - label - defaultTextStyle - { textFill = colorOfSpec (themeTextColor theme) - , textSize = themeFontSize theme - , textAnchor = AnchorMiddle - } - ] + let (lbl, title) = truncatePx (themeFontSize theme) (boxW box) label + in [ MText + (Point (boxX box + boxW box / 2) (boxY box - 4)) + lbl + defaultTextStyle + { textFill = colorOfSpec (themeTextColor theme) + , textSize = themeFontSize theme + , textAnchor = AnchorMiddle + , textTitle = title + } + ] where colorOfSpec spec = case spec of NamedColor c -> c @@ -248,14 +282,39 @@ , let cellBox = cells !! (rowIx * ncol + colIx) ] -singlePanel :: Chart -> PlotBox -> Text -> PanelSpec -singlePanel chart box label = +{- | The whole-chart x and y trained scales (no faceting/filtering). Shared by +'singlePanel' and 'globalAxisLabels' so the labels that size the margins match +the scales the single panel renders. +-} +trainGlobalScales :: Chart -> (TrainedScale, TrainedScale) +trainGlobalScales chart = let xRange = paddedRange (chartLayers chart) (chartData chart) xRangeRefs True yRange = paddedRange (chartLayers chart) (chartData chart) yRangeRefs False - xs0 = train (scaleX (chartScales chart)) xRange - ys0 = train (scaleY (chartScales chart)) yRange - xs = applyCategorical aesX (chartLayers chart) (chartData chart) xs0 - ys = applyCategorical aesY (chartLayers chart) (chartData chart) ys0 + xs = + applyCategorical + aesX + (chartLayers chart) + (chartData chart) + (train (scaleX (chartScales chart)) xRange) + ys = + applyCategorical + aesY + (chartLayers chart) + (chartData chart) + (train (scaleY (chartScales chart)) yRange) + in (xs, ys) + +{- | The on-render x and y tick labels (domain-filtered), independent of the +plot box, so margins can be sized to fit them before the box is computed. +-} +globalAxisLabels :: Chart -> ([Text], [Text]) +globalAxisLabels chart = + let (xs, ys) = trainGlobalScales chart + in (domainLabels xs, domainLabels ys) + +singlePanel :: Chart -> PlotBox -> Text -> PanelSpec +singlePanel chart box label = + let (xs, ys) = trainGlobalScales chart in PanelSpec { panelBox = box , panelLabel = label diff --git a/src/Granite/Render/Scene.hs b/src/Granite/Render/Scene.hs --- a/src/Granite/Render/Scene.hs +++ b/src/Granite/Render/Scene.hs @@ -58,11 +58,15 @@ { textFill :: !Color , textSize :: !Double , textAnchor :: !TextAnchor + , textRotate :: !Double + -- ^ Rotation in degrees about the anchor point; 0 = upright. + , textTitle :: !(Maybe Text) + -- ^ A @\@ tooltip (the untruncated label); 'Nothing' = none. } deriving (Eq, Show) defaultTextStyle :: TextStyle -defaultTextStyle = TextStyle Default 11 AnchorStart +defaultTextStyle = TextStyle Default 11 AnchorStart 0 Nothing {- | Primitive drawable marks. 'MArc' takes (center, radius, a0, a1) in radians CCW from +x. 'MPolygon' is a closed filled polyline. diff --git a/src/Granite/Render/Svg.hs b/src/Granite/Render/Svg.hs --- a/src/Granite/Render/Svg.hs +++ b/src/Granite/Render/Svg.hs @@ -105,17 +105,46 @@ <> attr "stroke-linecap" "round" <> "/>\n" +-- | Simple text element (legacy callers); no rotation or tooltip. svgText :: Double -> Double -> Text -> Text -> Double -> Text -> Text -svgText x y anchor fill size content = +svgText x y anchor fill size = svgTextRT x y anchor fill size 0 Nothing + +{- | Text element with optional rotation (degrees about @(x,y)@) and an +optional @\@ tooltip (the untruncated label). @rot = 0@ and +@title = Nothing@ produce byte-identical output to 'svgText'. +-} +svgTextRT :: + Double -> + Double -> + Text -> + Text -> + Double -> + Double -> + Maybe Text -> + Text -> + Text +svgTextRT x y anchor fill size rot mTitle content = " attr "x" (showD x) <> attr "y" (showD y) <> attr "text-anchor" anchor <> attr "fill" fill <> attr "font-size" (showD size) + <> rotAttr <> ">" + <> titleEl <> escXml content <> "\n" + where + rotAttr + | rot == 0 = "" + | otherwise = + attr + "transform" + ("rotate(" <> showD rot <> " " <> showD x <> " " <> showD y <> ")") + titleEl = case mTitle of + Nothing -> "" + Just t -> "" <> escXml t <> "" svgPath :: Text -> Text -> Text -> Text svgPath d fill extra = @@ -154,12 +183,14 @@ <> opacityAttr sty <> "/>\n" MText (Point x y) txt ts -> - svgText + svgTextRT x y (anchorText (textAnchor ts)) (colorHex (textFill ts)) (textSize ts) + (textRotate ts) + (textTitle ts) txt MPolyline pts sty -> let stroke = maybe "#000000" colorHex (styleStroke sty) diff --git a/test/GoldenSpec.hs b/test/GoldenSpec.hs --- a/test/GoldenSpec.hs +++ b/test/GoldenSpec.hs @@ -193,6 +193,68 @@ , chartSize = SizeChars 40 14 } +-- Categorical bars whose names are far too wide for their slots: the axis +-- label policy must auto-rotate them, and truncate the longest with a hover +-- . Exercises the long-word path of 'xAxisLabels'. +barLongNames :: Chart +barLongNames = + let names = + [ "GHC.Core.Opt.Simplify.Iteration.Inline.Worker" + , "mkFastStringBytes" + , "GHC.Tc.Solver.Monad" + , "GHC.CmmToAsm.X86.Ppr" + , "GHC.Stg.Unarise" + , "GHC.HsToCore.Match.Constructor" + ] + ys = [29.0, 18.5, 12.3, 9.1, 6.4, 4.2] :: [Double] + df = fromColumns [("fn", ColCat names), ("mb", ColNum ys)] + layer = + (defLayer GeomBar) + { layerMapping = + emptyMapping + { aesX = Just (ColumnRef "fn") + , aesY = Just (ColumnRef "mb") + } + , layerStat = StatIdentity + } + in emptyChart + { chartData = df + , chartLayers = [layer] + , chartTitle = Just "Allocation by function" + , chartSize = SizeChars 44 16 + } + +-- The same long names under CoordFlip: now they fall on the (left) y-axis, so +-- the policy must grow the left margin and truncate names past the ~42% cap +-- with a hover <title> rather than rotate. Exercises the y-label cap + the +-- CoordFlip bottom/left label swap. +barLongNamesFlip :: Chart +barLongNamesFlip = + barLongNames{chartCoord = CoordFlip, chartTitle = Just "Allocation (flipped)"} + +-- A numeric x-axis whose wide tick labels (millions) overflow their slots in a +-- narrow chart: the policy must thin them to an evenly-spaced subset that keeps +-- the first and last tick, never rotate. Exercises the XThin path + isNumericLabel. +numericThinX :: Chart +numericThinX = + ( lineChart + [("alloc", [(x, x / 1.0e5) | x <- [0, 1.5e6 .. 6.0e6]])] + (Just "Bytes allocated") + ) + { chartSize = SizeChars 30 14 + } + +-- Long category names under FacetWrap: rotation reserves no per-cell margin, so +-- faceted panels must fall back to upright (never rotate/clip). Guards the +-- facet branch of the x-label policy. +facetedLongNames :: Chart +facetedLongNames = + barLongNames + { chartFacet = FacetWrap (ColumnRef "fn") (Just 2) Nothing ScalesFixed + , chartTitle = Just "Faceted long names" + , chartSize = SizeChars 60 20 + } + -- Histogram of 50 numeric values bucketed into 8 bins. Exercises -- StatBin + GeomHistogram. aesY points to the @count@ column that -- StatBin emits, so the bar heights track the bin counts. @@ -403,6 +465,18 @@ goldenText "bar-basic.txt" (renderChartTerminal barBasic) it "bar chart renders to expected SVG output" $ goldenText "bar-basic.svg" (renderChartSvg barBasic) + + it "long categorical bar labels auto-rotate and truncate (SVG)" $ + goldenText "bar-long-names.svg" (renderChartSvg barLongNames) + + it "flipped long labels grow the left margin and truncate at the cap (SVG)" $ + goldenText "bar-long-names-flip.svg" (renderChartSvg barLongNamesFlip) + + it "wide numeric x labels thin to a fitting subset keeping the ends (SVG)" $ + goldenText "thin-numeric-x.svg" (renderChartSvg numericThinX) + + it "faceted long labels stay upright (no rotation) (SVG)" $ + goldenText "facet-long-names.svg" (renderChartSvg facetedLongNames) it "histogram renders to expected terminal output" $ goldenText "hist-basic.txt" (renderChartTerminal histBasic) diff --git a/test/golden/bar-long-names-flip.svg b/test/golden/bar-long-names-flip.svg new file mode 100644 --- /dev/null +++ b/test/golden/bar-long-names-flip.svg @@ -0,0 +1,24 @@ +<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 440 256" width="440" height="256" font-family="system-ui, -apple-system, sans-serif"> +<rect width="100%" height="100%" fill="white"/> +<line x1="184.80" y1="228.20" x2="320" y2="228.20" stroke="#ecf0f1" stroke-width="1"/> +<line x1="184.80" y1="34" x2="184.80" y2="228.20" stroke="#ecf0f1" stroke-width="1"/> +<text x="190.95" y="243.20" text-anchor="middle" fill="#7f8c8d" font-size="11">0.0</text> +<text x="233.33" y="243.20" text-anchor="middle" fill="#7f8c8d" font-size="11">10.0</text> +<text x="275.71" y="243.20" text-anchor="middle" fill="#7f8c8d" font-size="11">20.0</text> +<text x="318.09" y="243.20" text-anchor="middle" fill="#7f8c8d" font-size="11">30.0</text> +<text x="178.80" y="58.67" text-anchor="end" fill="#7f8c8d" font-size="11"><title>GHC.Core.Opt.Simplify.Iteration.Inline.WorkerGHC.Core.Opt.Simplify.Ite… +mkFastStringBytes +GHC.Tc.Solver.Monad +GHC.CmmToAsm.X86.Ppr +GHC.Stg.Unarise +GHC.HsToCore.Match.ConstructorGHC.HsToCore.Match.Constr… + + + + + + +Allocation (flipped) + +series 0 + diff --git a/test/golden/bar-long-names.svg b/test/golden/bar-long-names.svg new file mode 100644 --- /dev/null +++ b/test/golden/bar-long-names.svg @@ -0,0 +1,24 @@ + + + + +GHC.Core.Opt.Simplify.Iteration.Inline.WorkerGHC.Core.Opt.Simpl… +mkFastStringBytes +GHC.Tc.Solver.Monad +GHC.CmmToAsm.X86.PprGHC.CmmToAsm.X86.P… +GHC.Stg.Unarise +GHC.HsToCore.Match.ConstructorGHC.HsToCore.Match… +0.0 +10.0 +20.0 +30.0 + + + + + + +Allocation by function + +series 0 + diff --git a/test/golden/facet-long-names.svg b/test/golden/facet-long-names.svg new file mode 100644 --- /dev/null +++ b/test/golden/facet-long-names.svg @@ -0,0 +1,60 @@ + + + + +GHC.Core.Opt.Simplify.Iteration.Inline.WorkerGHC.Core.Opt.Simplify.Iterati… +0.0 +10.0 +20.0 +30.0 + +GHC.Core.Opt.Simplify.Iteration.Inline.WorkerGHC.Core.Opt.Simplify.Iterati… + + +mkFastStringBytes +0.0 +10.0 +20.0 +30.0 + +mkFastStringBytes + + +GHC.Tc.Solver.Monad +0.0 +10.0 +20.0 +30.0 + +GHC.Tc.Solver.Monad + + +GHC.CmmToAsm.X86.Ppr +0.0 +10.0 +20.0 +30.0 + +GHC.CmmToAsm.X86.Ppr + + +GHC.Stg.Unarise +0.0 +10.0 +20.0 +30.0 + +GHC.Stg.Unarise + + +GHC.HsToCore.Match.Constructor +0.0 +10.0 +20.0 +30.0 + +GHC.HsToCore.Match.Constructor +Faceted long names + +series 0 + diff --git a/test/golden/thin-numeric-x.svg b/test/golden/thin-numeric-x.svg new file mode 100644 --- /dev/null +++ b/test/golden/thin-numeric-x.svg @@ -0,0 +1,16 @@ + + + + +0.0 +4.0e6 +6.0e6 +0.0 +20.0 +40.0 +60.0 + +Bytes allocated + +alloc +