nano-ui-diagrams (empty) → 0.1.0.0

raw patch · 18 files changed

+2570/−0 lines, 18 filesdep +basedep +colourdep +containers

Dependencies added: base, colour, containers, diagrams-core, diagrams-lib, dlist, effectful-core, hashable, hspec, lens, nano-ui, nano-ui-diagrams, primitive, text, vector

Files

• CHANGELOG.md +10/−0
• LICENSE +20/−0
• README.md +34/−0
• lib/NanoUI/Diagrams.hs +11/−0
• lib/NanoUI/Diagrams/Backend.hs +252/−0
• lib/NanoUI/Diagrams/Tessellation.hs +250/−0
• lib/NanoUI/Diagrams/Widget.hs +327/−0
• lib/NanoUI/Plot.hs +20/−0
• lib/NanoUI/Plot/Builder.hs +45/−0
• lib/NanoUI/Plot/Chrome.hs +399/−0
• lib/NanoUI/Plot/Decimate.hs +108/−0
• lib/NanoUI/Plot/Hit.hs +64/−0
• lib/NanoUI/Plot/Scale.hs +118/−0
• lib/NanoUI/Plot/Series.hs +101/−0
• lib/NanoUI/Plot/Types.hs +91/−0
• lib/NanoUI/Plot/Widget.hs +120/−0
• nano-ui-diagrams.cabal +95/−0
• test/Main.hs +505/−0

@@ -0,0 +1,10 @@+# Changelog++## 0.1.0.0++First release.++- `diagram` places a diagrams-lib `Diagram` in a nano-ui layout, drawn+  through a nano-ui backend for diagrams.+- `NanoUI.Plot` builds line, bar, scatter, area and step charts with axes,+  legends, and hover lookup, and decimates long series before drawing them.

@@ -0,0 +1,20 @@+Copyright (c) 2026 goolord++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,34 @@+# nano-ui-diagrams++Charts and [diagrams](https://diagrams.github.io/) drawings for+[nano-ui](https://github.com/goolord/nano-ui).++`diagram` places a diagrams-lib `Diagram` in a nano-ui layout. `NanoUI.Plot`+builds line, bar, scatter, area, and step charts with axes, legends, and hover+lookup, and thins out long series before drawing them.++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Data.Text qualified as T+import NanoUI+import NanoUI.Plot++temperatures :: Chart+temperatures =+  withTitle "Temperature" . withLegend LegendBottom $+    chart+      [ line "Indoor" [(0, 20), (1, 21.5), (2, 22), (3, 21)]+      , line "Outdoor" [(0, 8), (1, 11), (2, 14), (3, 12)]+      ]++view :: NanoUI ()+view = column $ do+  resp <- plot (minH 240 . fillW) temperatures+  case plotHover resp of+    Just h -> label (T.pack (show (hoverDataX h, hoverDataY h)))+    Nothing -> pure ()+```++The Plots tab of `nano-ui-sdl-demo` in `nano-ui-demo` shows more charts and a+diagram.

@@ -0,0 +1,11 @@+-- | The whole nano-ui-diagrams API: the diagrams-lib backend, the diagram+-- widgets, and "NanoUI.Plot".+module NanoUI.Diagrams+  ( module NanoUI.Diagrams.Backend+  , module NanoUI.Diagrams.Widget+  , module NanoUI.Plot+  ) where++import NanoUI.Diagrams.Backend+import NanoUI.Diagrams.Widget+import NanoUI.Plot

@@ -0,0 +1,252 @@+-- | A diagrams-lib backend that renders a diagram to nano-ui @DrawOp@ values,+-- scaled into a target size.+module NanoUI.Diagrams.Backend+  ( NanoUIBackend (..)+  , B+  , diagramOps+  , diagramTextOps+  , letterbox+  )+where++import Control.Lens (Lens', (^.), (^?))+import Data.Colour (AlphaColour, alphaChannel, black, over)+import Data.Colour.SRGB (RGB (..), toSRGB)+import Data.DList (DList)+import Data.DList qualified as DL+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Data.Tree (Tree (Node))+import Data.Typeable (Typeable)+import Data.Primitive.SmallArray (SmallArray, emptySmallArray, mapSmallArray', smallArrayFromList)+import Diagrams.Attributes (_lineWidthU)+import Diagrams.Core+  ( Backend (..)+  , N+  , QDiagram+  , Renderable (..)+  , V+  , renderDia+  )+import Diagrams.Core qualified as DiaCore+import Diagrams.Core.Types (Annotation, RNode (..), RTree)+import Diagrams.Located (Located, unLoc)+import Diagrams.Path (Path, pathTrails)+import Diagrams.Prelude+  ( Any+  , P2+  , SizeSpec+  , Trail+  , V2 (..)+  , origin+  , p2+  , papply+  , reflectY+  , reflectionY+  , size+  , unp2+  , (#)+  )+import Diagrams.Segment (FixedSegment (..))+import Diagrams.Trail (fixTrail, isLoop)+import Diagrams.TwoD.Adjust (adjustDia2D)+import Diagrams.TwoD.Attributes (_AC, _fillTexture, _lineTexture)+import Diagrams.TwoD.Size (mkHeight)+import Diagrams.TwoD.Text (Text (..), TextAlignment (..))+import NanoUI+  ( Color+  , DrawOp (..)+  , colorA+  , colorRGBA+  , defaultTheme+  , shiftDrawOp+  , themeMuted+  )+import NanoUI.Diagrams.Tessellation+  ( fillPolygon+  , flattenCubic+  , strokePolyline+  )++data NanoUIBackend = NanoUIBackend+  deriving (Eq, Show)++type B = NanoUIBackend++type instance V NanoUIBackend = V2++type instance N NanoUIBackend = Double++fullSize :: Lens' (Options NanoUIBackend V2 n) (SizeSpec V2 n)+fullSize f (NanoUIOptions sz textOnly) = fmap (\sz' -> NanoUIOptions sz' textOnly) (f sz)++instance (Typeable n, RealFloat n) => Backend NanoUIBackend V2 n where+  newtype Render NanoUIBackend V2 n+    = NRenderFull (Bool -> DiaCore.Style V2 n -> DList DrawOp)+  type Result NanoUIBackend V2 n = SmallArray DrawOp+  data Options NanoUIBackend V2 n = NanoUIOptions (SizeSpec V2 n) Bool+  renderRTree _ (NanoUIOptions _ textOnly) rt = smallArrayFromList (DL.toList (walkFull textOnly mempty rt))+  adjustDia c opts d = (sz, t <> reflectionY, d')+   where+    (sz, t, d') = adjustDia2D fullSize c opts (d # reflectY)++instance Semigroup (Render NanoUIBackend V2 n) where+  NRenderFull f <> NRenderFull g = NRenderFull (\textOnly sty -> f textOnly sty <> g textOnly sty)++instance Monoid (Render NanoUIBackend V2 n) where+  mempty = NRenderFull (\_ _ -> DL.empty)++walkFull ::+  (Typeable n, RealFloat n) =>+  Bool+  -> DiaCore.Style V2 n+  -> RTree NanoUIBackend V2 n Annotation+  -> DList DrawOp+walkFull textOnly sty (Node n cs) =+  case n of+    RPrim prim ->+      let+        NRenderFull f = render NanoUIBackend prim+       in+        f textOnly sty+    RStyle s -> foldMap (walkFull textOnly (sty <> s)) cs+    _ -> foldMap (walkFull textOnly sty) cs++instance (Typeable n, RealFloat n) => Renderable (Path V2 n) NanoUIBackend where+  render _ path = NRenderFull $ \textOnly sty ->+    if textOnly+      then DL.empty+      else foldMap (DL.fromList . trailOps sty) (pathTrails path)++textOps ::+  (Typeable n, RealFloat n) => Text n -> DiaCore.Style V2 n -> DList DrawOp+textOps (Text tr align str) sty+  | null str = DL.empty+  | otherwise =+      let+        p = papply tr origin+        (x, y) = unp2 p+        (ax, ay) =+          case align of+            BaselineText -> (0, -1)+            BoxAlignedText bx by -> (toF bx, toF by)+        col =+          case solidColour (sty ^? (_fillTexture . _AC)) of+            Just c -> c+            Nothing ->+              fromMaybe+                (themeMuted defaultTheme)+                (solidColour (sty ^? (_lineTexture . _AC)))+       in+        DL.singleton (DrawText (toF x) (toF y) ax ay (T.pack str) col)++instance (Typeable n, RealFloat n) => Renderable (Text n) NanoUIBackend where+  render _ t = NRenderFull (const (textOps t))++trailOps ::+  (Typeable n, RealFloat n) =>+  DiaCore.Style V2 n -> Located (Trail V2 n) -> [DrawOp]+trailOps sty lt =+  let+    pts = [(toF x, toF y) | (x, y) <- map unp2 (trailSamples lt)]+    lineW0 = sty ^. _lineWidthU+    lineW =+      case fmap toF lineW0 of+        Nothing -> 1+        Just w+          | w <= 0 -> 0+          | w < 1 -> 1+          | otherwise -> w+    fillC = solidColour (sty ^? (_fillTexture . _AC))+    lineC = solidColour (sty ^? (_lineTexture . _AC))+    closed = isLoop (unLoc lt)+    fills =+      case fillC of+        Just c+          | colorA c > 0 && closed && length pts >= 3 -> fillPolygon c pts+        _ -> []+    strokes =+      case lineC of+        Just c+          | colorA c > 0 && lineW > 0 && length pts >= 2 ->+              strokePolyline c lineW closed pts+        _ -> []+   in+    fills ++ strokes++trailSamples :: RealFloat n => Located (Trail V2 n) -> [P2 n]+trailSamples lt =+  case map sampleSeg (fixTrail lt) of+    [] -> []+    (firstSeg : rest) ->+      let+        pts = firstSeg ++ concatMap (drop 1) rest+       in+        if isLoop (unLoc lt) && not (null pts)+          then pts ++ take 1 pts+          else pts++sampleSeg :: RealFloat n => FixedSegment V2 n -> [P2 n]+sampleSeg (FLinear p0 p1) = [p0, p1]+sampleSeg (FCubic p0 c1 c2 p1) =+  [ p2 (realToFrac x, realToFrac y)+  | (x, y) <- flattenCubic (f p0) (f c1) (f c2) (f p1)+  ]+ where+  f p = let (x, y) = unp2 p in (toF x, toF y)++solidColour :: Maybe (AlphaColour Double) -> Maybe Color+solidColour mc = do+  ac <- mc+  let+    a = alphaChannel ac+  if a <= 0+    then Nothing+    else+      let+        RGB r g b = toSRGB (ac `over` black)+        q x = round (clamp01 x * 255)+       in+        Just (colorRGBA (q r) (q g) (q b) (q a))++clamp01 :: Double -> Double+clamp01 x = max 0 (min 1 x)++toF :: Real n => n -> Float+toF = realToFrac++diagramOps ::+  Double -> Double -> QDiagram NanoUIBackend V2 Double Any -> SmallArray DrawOp+diagramOps = renderFull False++diagramTextOps ::+  Double -> Double -> QDiagram NanoUIBackend V2 Double Any -> SmallArray DrawOp+-- Text uses the same backend and viewport as geometry. In particular, do not+-- coerce a QDiagram between backends: its primitives carry Renderable dictionaries.+diagramTextOps = renderFull True++renderFull ::+  Bool+  -> Double+  -> Double+  -> QDiagram NanoUIBackend V2 Double Any+  -> SmallArray DrawOp+renderFull textOnly w h d+  | w <= 0 || h <= 0 = emptySmallArray+  | otherwise =+      let+        V2 dw dh = size d+        (_, outH, dx, dy) = letterbox dw dh w h+        ops = renderDia NanoUIBackend (NanoUIOptions (mkHeight outH) textOnly) d+       in+        mapSmallArray' (shiftDrawOp (realToFrac dx) (realToFrac dy)) ops++-- | Scale a @dw@ by @dh@ diagram uniformly to fit a @w@ by @h@ box and centre+-- it: the drawn width and height, and the x and y offsets inside the box.+letterbox :: Double -> Double -> Double -> Double -> (Double, Double, Double, Double)+letterbox dw dh w h =+  let+    outH = if dw <= 1e-9 || dh <= 1e-9 then h else min h (w * dh / dw)+    outW = if dh <= 1e-9 then w else outH * dw / dh+   in+    (outW, outH, (w - outW) / 2, (h - outH) / 2)

@@ -0,0 +1,250 @@+-- | Polygon triangulation and filling, polyline stroking, and cubic Bezier+-- flattening for the diagrams backend.+module NanoUI.Diagrams.Tessellation+  ( triangulatePolygon+  , fillPolygon+  , strokePolyline+  , flattenCubic+  ) where++import Control.Monad (forM_)+import Control.Monad.ST (runST)+import Data.Primitive.PrimArray+  ( PrimArray+  , indexPrimArray+  , newPrimArray+  , readPrimArray+  , runPrimArray+  , sizeofPrimArray+  , writePrimArray+  )+import NanoUI (Color, DrawOp (..), Rect (..))++bezierTolerance :: Float+bezierTolerance = 0.5++triangulatePolygon :: [(Float, Float)] -> [((Float, Float), (Float, Float), (Float, Float))]+triangulatePolygon [] = []+triangulatePolygon [_] = []+triangulatePolygon pts0 =+  let pts = stripClosed pts0+    in earClip (pointsArray pts)++stripClosed :: [(Float, Float)] -> [(Float, Float)]+stripClosed [] = []+stripClosed [p] = [p]+stripClosed (p : rest)+  | p == last rest = p : init rest+  | otherwise = p : rest++-- | Points stored as x then y.+pointsArray :: [(Float, Float)] -> PrimArray Float+pointsArray pts = runPrimArray $ do+  out <- newPrimArray (2 * length pts)+  let fill !_ [] = pure out+      fill !i ((x, y) : rest) = do+        writePrimArray out (2 * i) x+        writePrimArray out (2 * i + 1) y+        fill (i + 1) rest+  fill 0 pts++{-# INLINE pointAt #-}+pointAt :: PrimArray Float -> Int -> (Float, Float)+pointAt vs i = (indexPrimArray vs (2 * i), indexPrimArray vs (2 * i + 1))++signedArea :: PrimArray Float -> Float+signedArea vs =+  let n = sizeofPrimArray vs `div` 2+   in foldl' (\acc i -> acc + cross (pointAt vs i) (pointAt vs ((i + 1) `mod` n)) / 2) 0 [0 .. n - 1]++cross :: (Float, Float) -> (Float, Float) -> Float+cross (x0, y0) (x1, y1) = x0 * y1 - x1 * y0++diff :: (Float, Float) -> (Float, Float) -> (Float, Float)+diff (x0, y0) (x1, y1) = (x1 - x0, y1 - y0)++isConvex :: Bool -> (Float, Float) -> (Float, Float) -> (Float, Float) -> Bool+isConvex ccw a b c =+  let ab = diff a b+      bc = diff b c+   in if ccw then cross ab bc >= 0 else cross ab bc <= 0++pointInTri :: (Float, Float) -> (Float, Float) -> (Float, Float) -> (Float, Float) -> Bool+pointInTri p a b c =+  let sign (p1, p2, p3) = cross (diff p1 p3) (diff p2 p3)+      d1 = sign (p, a, b)+      d2 = sign (p, b, c)+      d3 = sign (p, c, a)+   in not ((d1 < 0 || d2 < 0 || d3 < 0) && (d1 > 0 || d2 > 0 || d3 > 0))++earClip :: PrimArray Float -> [((Float, Float), (Float, Float), (Float, Float))]+earClip vs+  | n < 3 = []+  | n == 3 = [(at 0, at 1, at 2)]+  | otherwise = runST $ do+      let !ccw = signedArea vs >= 0+      -- Coordinates never move. Remove an ear by relinking two neighbours,+      -- instead of copying the remaining coordinates at every step.+      prevs <- newPrimArray n+      nexts <- newPrimArray n+      forM_ [0 .. n - 1] $ \i -> do+        writePrimArray prevs i ((i - 1 + n) `mod` n)+        writePrimArray nexts i ((i + 1) `mod` n)+      let triangle i = do+            p <- readPrimArray prevs i+            q <- readPrimArray nexts i+            pure (p, q, (at p, at i, at q))+          isEarAt first count i p q (a, b, c)+            | not (isConvex ccw a b c) = pure False+            | otherwise = outside first count+            where+              outside !_ 0 = pure True+              outside !j !left+                | j /= p && j /= i && j /= q && pointInTri (at j) a b c = pure False+                | otherwise = do+                    next <- readPrimArray nexts j+                    outside next (left - 1)+          convex !_ 0 = pure True+          convex !i !left = do+            (_, q, (a, b, c)) <- triangle i+            if isConvex ccw a b c then convex q (left - 1) else pure False+          fan origin i left+            | left <= 0 = pure []+            | otherwise = do+                q <- readPrimArray nexts i+                rest <- fan origin q (left - 1)+                pure ((at origin, at i, at q) : rest)+          go !first !count !idx !tries tris+            | count == 3 = do+                second <- readPrimArray nexts first+                third <- readPrimArray nexts second+                pure ((at first, at second, at third) : tris)+            | tries >= count = do+                isConvexRing <- convex first count+                if isConvexRing then do+                  second <- readPrimArray nexts first+                  rest <- fan first second (count - 2)+                  pure (tris ++ rest)+                else pure tris+            | otherwise = do+                (p, q, tri) <- triangle idx+                ear <- isEarAt first count idx p q tri+                if ear then do+                  writePrimArray nexts p q+                  writePrimArray prevs q p+                  let !first' = if idx == first then q else first+                  go first' (count - 1) first' 0 (tri : tris)+                else go first count q (tries + 1) tris+      reverse <$> go 0 n 0 0 []+  where+    n = sizeofPrimArray vs `div` 2+    at = pointAt vs++fillPolygon :: Color -> [(Float, Float)] -> [DrawOp]+fillPolygon col pts =+  case axisAlignedRect pts of+    Just r -> [FillRect r col]+    Nothing ->+      [ FillTriangle x0 y0 x1 y1 x2 y2 col+      | ((x0, y0), (x1, y1), (x2, y2)) <- triangulatePolygon pts+      ]++axisAlignedRect :: [(Float, Float)] -> Maybe Rect+axisAlignedRect pts =+  case stripClosed pts of+    [(x0, y0), (x1, y1), (x2, y2), (x3, y3)]+      | near y0 y1 && near x1 x2 && near y2 y3 && near x3 x0 ->+          Just (Rect (min x0 x3) (min y0 y2) (abs (x1 - x0)) (abs (y2 - y0)))+    [(x0, y0), (x1, y1), (x2, y2), (x3, y3)]+      | near x0 x1 && near y1 y2 && near x2 x3 && near y3 y0 ->+          Just (Rect (min x0 x2) (min y0 y1) (abs (x2 - x0)) (abs (y1 - y0)))+    _ -> Nothing+  where+    near a b = abs (a - b) <= 1e-3+++strokePolyline :: Color -> Float -> Bool -> [(Float, Float)] -> [DrawOp]+strokePolyline _ _ _ [] = []+strokePolyline _ _ _ [_] = []+strokePolyline col w closed pts0 =+  let pts = if closed && length pts0 > 2 then stripClosed pts0 else pts0+      hw = w / 2+      !vPts = pointsArray pts+      !n = sizeofPrimArray vPts `div` 2+   in if n < 2+        then []+        else+          let !segCount = if closed then n else n - 1+              -- Each segment's unit normal, x then y.+              !segNormals = runPrimArray $ do+                out <- newPrimArray (2 * segCount)+                forM_ [0 .. segCount - 1] $ \i -> do+                  let !(p0x, p0y) = pointAt vPts i+                      !(p1x, p1y) = pointAt vPts ((i + 1) `mod` n)+                      nx = p0y - p1y+                      ny = p1x - p0x+                      d = sqrt (nx * nx + ny * ny)+                  writePrimArray out (2 * i) (if d <= 1e-9 then 0 else nx / d)+                  writePrimArray out (2 * i + 1) (if d <= 1e-9 then 0 else ny / d)+                pure out+              joinNormal !i+                | not closed && i <= 0 = pointAt segNormals 0+                | not closed && i >= n - 1 = pointAt segNormals (segCount - 1)+                | otherwise =+                    let (ax, ay) = pointAt segNormals ((i - 1 + segCount) `mod` segCount)+                        (bx, by) = pointAt segNormals (i `mod` segCount)+                        sx = ax + bx+                        sy = ay + by+                        d = sqrt (sx * sx + sy * sy)+                     in if d <= 1e-9 then (0, 0) else (sx / d, sy / d)+              -- Adjacent quads share a vertex, so offset each vertex once: the+              -- two sides' points, four numbers a vertex.+              !offsets = runPrimArray $ do+                out <- newPrimArray (4 * n)+                forM_ [0 .. n - 1] $ \i -> do+                  let (!px, !py) = pointAt vPts i+                      (!nx, !ny) = joinNormal i+                  writePrimArray out (4 * i) (px + hw * nx)+                  writePrimArray out (4 * i + 1) (py + hw * ny)+                  writePrimArray out (4 * i + 2) (px - hw * nx)+                  writePrimArray out (4 * i + 3) (py - hw * ny)+                pure out+              offset i k = indexPrimArray offsets (4 * i + k)+              buildQuads !i+                | i >= segCount = []+                | otherwise =+                    let !j = if closed then (i + 1) `mod` n else i + 1+                     in FillTriangle (offset i 0) (offset i 1) (offset j 0) (offset j 1) (offset j 2) (offset j 3) col+                          : FillTriangle (offset i 0) (offset i 1) (offset j 2) (offset j 3) (offset i 2) (offset i 3) col+                          : buildQuads (i + 1)+           in buildQuads 0++flattenCubic ::+  (Float, Float) ->+  (Float, Float) ->+  (Float, Float) ->+  (Float, Float) ->+  [(Float, Float)]+flattenCubic p0 c1 c2 p1 = go p0 c1 c2 p1+  where+    go a b c d =+      let mid (p, q) = ((fst p + fst q) / 2, (snd p + snd q) / 2)+          ab = mid (a, b)+          bc = mid (b, c)+          cd = mid (c, d)+          abbc = mid (ab, bc)+          bccd = mid (bc, cd)+          mid12 = mid (abbc, bccd)+          flat =+            let (dx, dy) = diff d a+                len = sqrt (dx * dx + dy * dy)+                dist =+                  if len <= 1e-9+                    then 0+                    else abs (cross (diff b a) (dx, dy)) / len+             in dist <= bezierTolerance+       in if flat+            then [a, d]+            else+              let rest = go mid12 bccd cd d+               in go a ab abbc mid12 ++ drop 1 rest

@@ -0,0 +1,327 @@+-- | Widgets that place a diagram in a nano-ui layout, and the plot style+-- derived from the current theme.+module NanoUI.Diagrams.Widget+  ( diagram+  , diagramWithEnvelope+  , diagramWithKeyAndEnvelope+  , fitLayout+  , labelFitScale+  , diagramFrame+  , frameInner+  , PlotStyle (..)+  , themePlotStyle+  , defaultPlotStyle+  , uiPlotStyle+  , colourOf+  , themePlotKey+  ) where+++import Data.Colour (Colour)+import Data.Colour.SRGB (sRGB24)+import Data.Hashable (hash, hashWithSalt)+import Data.Primitive.PrimArray (indexPrimArray, newPrimArray, runPrimArray, writePrimArray)+import Data.Primitive.SmallArray (SmallArray, emptySmallArray, indexSmallArray, mapSmallArray', sizeofSmallArray, smallArrayFromList)+import Diagrams.Core (QDiagram)+import Diagrams.Prelude (Any, Diagram, V2 (..), size)+import Effectful (Eff, type (:>))+import NanoUI+  ( Color+  , DrawOp (..)+  , FontMetrics (..)+  , Layout (..)+  , Rect (..)+  , Response+  , Sizing (..)+  , Style (..)+  , Theme (..)+  , Ui+  , colorB+  , colorG+  , colorR+  , colorToWord32+  , defaultLayout+  , defaultTheme+  , drawTextBox+  , drawingCached+  , lerpColor+  , shiftDrawOp+  , styleBg+  , styleBorder+  , themeAccent+  , themeGreen+  , themeMuted+  , themeOrange+  , themePurple+  , themeRed+  , themeSeparator+  , themeWindow+  , themeYellow+  , uiFontMetrics+  , prepareFontMetricsMany+  , uiTheme+  )+import NanoUI.Context (lookupDrawFitEnvelope)+import NanoUI.Monad (askContext, currentId, uiIO)+import NanoUI.Diagrams.Backend+  ( B+  , NanoUIBackend+  , diagramOps+  , diagramTextOps+  )++data PlotStyle = PlotStyle+  { plotInk :: Colour Double+  , plotFill :: Colour Double+  , plotGrid :: Colour Double+  , plotMuted :: Colour Double+  , plotFrameBg :: Color+  , plotFrameBorder :: Color+  }+  deriving (Eq, Show)++colourOf :: Color -> Colour Double+colourOf c = sRGB24 (colorR c) (colorG c) (colorB c)++themePlotStyle :: Theme -> PlotStyle+themePlotStyle t =+  let muted = themeMuted t+      panel = themePanel t+   in PlotStyle+        { plotInk = colourOf (themeRed t)+        , plotFill = colourOf (lerpColor (themeAccent t) muted 0.22)+        , plotGrid = colourOf (lerpColor (themeSeparator t) muted 0.30)+        , plotMuted = colourOf muted+        , plotFrameBg = styleBg (themeInput t)+        , plotFrameBorder = styleBorder panel+        }++defaultPlotStyle :: PlotStyle+defaultPlotStyle = themePlotStyle defaultTheme++themePlotKey :: Theme -> Int+themePlotKey t =+  hash (colorToWord32 (themeAccent t))+    `hashWithSalt` colorToWord32 (themeMuted t)+    `hashWithSalt` colorToWord32 (themeRed t)+    `hashWithSalt` colorToWord32 (themeOrange t)+    `hashWithSalt` colorToWord32 (themeYellow t)+    `hashWithSalt` colorToWord32 (themeGreen t)+    `hashWithSalt` colorToWord32 (themePurple t)+    `hashWithSalt` colorToWord32 (themeSeparator t)+    `hashWithSalt` colorToWord32 (themeWindow t)+    `hashWithSalt` colorToWord32 (styleBg (themePanel t))+    `hashWithSalt` colorToWord32 (styleBorder (themePanel t))+    `hashWithSalt` colorToWord32 (styleBg (themeInput t))++uiPlotStyle :: Ui :> es => Eff es PlotStyle+uiPlotStyle = fmap themePlotStyle uiTheme++labelFitScale :: FontMetrics -> SmallArray DrawOp -> Double+labelFitScale fm ops =+  let -- Six numbers a label: its anchor, and its box's origin and size.+      !n = foldl' (\c op -> case op of DrawText {} -> c + 1; _ -> c) 0 ops+      !ts = runPrimArray $ do+        out <- newPrimArray (n * 6)+        let fill !i !b+              | i >= sizeofSmallArray ops = pure out+              | otherwise = case indexSmallArray ops i of+                  DrawText x y ax ay t _ -> do+                    let Rect px py tw th = drawTextBox fm x y ax ay t+                    writePrimArray out b x+                    writePrimArray out (b + 1) y+                    writePrimArray out (b + 2) px+                    writePrimArray out (b + 3) py+                    writePrimArray out (b + 4) tw+                    writePrimArray out (b + 5) th+                    fill (i + 1) (b + 6)+                  _ -> fill (i + 1) b+        fill 0 0+      at i field = indexPrimArray ts (i * 6 + field)+      !k = outerLoop 0 (1.0 :: Float)+        where+          outerLoop !i !acc+            | i >= n - 1 = acc+            | otherwise  =+                let innerLoop !j !m+                      | j >= n    = m+                      | otherwise =+                          let !pairVal = pairK (at i 0) (at i 1) (at i 2) (at i 3) (at i 4) (at i 5) (at j 0) (at j 1) (at j 2) (at j 3) (at j 4) (at j 5)+                          in innerLoop (j + 1) (max m pairVal)+                in outerLoop (i + 1) (innerLoop (i + 1) acc)+   in min 2 (realToFrac k)+  where++    pairK !x1 !y1 !px1 !py1 !tw1 !th1 !x2 !y2 !px2 !py2 !tw2 !th2 =+      let !overlapX = px1 < px2 + tw2 && px2 < px1 + tw1+          !overlapY = py1 < py2 + th2 && py2 < py1 + th1+       in if overlapX && overlapY+            then+              max+                (axisK x1 x2 (px1 - x1) tw1 (px2 - x2) tw2)+                (axisK y1 y2 (py1 - y1) th1 (py2 - y2) th2)+            else 1.0++    axisK !a1 !a2 !o1 !size1 !o2 !size2 =+      let (!loA, !loO, !loS, !hiA, !hiO) =+            if a1 <= a2+              then (a1, o1, size1, a2, o2)+              else (a2, o2, size2, a1, o1)+          !den  = hiA - loA+          !need = loO + loS + 2 - hiO+       in if den <= 1e-6 then 1.0 else max 1.0 (need / den)++diagramFrame :: PlotStyle -> Float -> Rect -> SmallArray DrawOp+diagramFrame ps bw (Rect x y w h) =+  smallArrayFromList+    [ FillRect (Rect x y w h) (plotFrameBg ps)+    , Stroke x y (x + w) y bw (plotFrameBorder ps)+    , Stroke (x + w) y (x + w) (y + h) bw (plotFrameBorder ps)+    , Stroke (x + w) (y + h) x (y + h) bw (plotFrameBorder ps)+    , Stroke x (y + h) x y bw (plotFrameBorder ps)+    ]++-- Grow plots cap here unless the caller set a tighter layoutMaxH.+growPlotCapH :: Float+growPlotCapH = 260++fitLayout :: FontMetrics -> Layout -> Diagram B -> Layout+fitLayout fm layout d =+  let V2 dw dh = size d+      ar = if dh <= 1e-9 then 1 else dw / dh+      growW =+        case layoutWidth layout of+          Grow _ -> True+          _ -> False+      (baseW, baseH) =+        case (layoutWidth layout, layoutHeight layout) of+          (Fixed bw, Fixed bh)+            | dw > 1e-9 && dh > 1e-9 ->+                let s = min (realToFrac bw / dw) (realToFrac bh / dh)+                 in (dw * s, dh * s)+          (_, Fixed bh) ->+            let h = realToFrac bh :: Double+             in (h * ar, h)+          (Fixed bw, _) ->+            let w = realToFrac bw :: Double+             in (w, w / ar)+          _ ->+            let h =+                  if layoutMinH layout > 0+                    then realToFrac (layoutMinH layout)+                    else 160+             in (h * ar, h)+      clampSize x = realToFrac (max 8 x) :: Float+   in if growW+        then+          let capH = min growPlotCapH (layoutMaxH layout)+              floorH = if layoutMinH layout > 0 then layoutMinH layout else 180+              probeH0 =+                realToFrac+                  ( if layoutMinH layout > 0+                      then layoutMinH layout+                      else 200+                  ) ::+                  Double+              probeH = min probeH0 (realToFrac capH)+              probeW = probeH * ar+              k = labelFitScale fm (diagramTextOps probeW probeH d)+              needW = clampSize (probeW * k)+              needH = min capH (max floorH (clampSize (probeH * k)))+           in layout+                { layoutHeight = Fit+                , layoutMinW = max (layoutMinW layout) needW+                , layoutMinH = needH+                , layoutMaxH = max needH capH+                }+        else+          let k = labelFitScale fm (diagramTextOps baseW baseH d)+              wF = clampSize (baseW * k)+              hF = clampSize (baseH * k)+           in layout+                { layoutWidth = Fixed wF+                , layoutHeight = Fixed hF+                , layoutMinW = wF+                , layoutMaxW = wF+                , layoutMinH = hF+                , layoutMaxH = hF+                }++-- | 'diagramWithEnvelope' whose cached draw ops are also keyed by @userKey@.+-- Change the key when the diagram's content changes.+diagramWithKeyAndEnvelope ::+  Ui :> es =>+  Int ->+  Double ->+  Double ->+  (Layout -> Layout) ->+  QDiagram NanoUIBackend V2 Double Any ->+  Eff es Response+diagramWithKeyAndEnvelope userKey dw dh f =+  framedDiagram (\t -> hash (userKey, themePlotKey t)) dw dh (f defaultLayout)++-- | 'diagram' with an explicit envelope width and height.+diagramWithEnvelope ::+  Ui :> es =>+  Double ->+  Double ->+  (Layout -> Layout) ->+  QDiagram NanoUIBackend V2 Double Any ->+  Eff es Response+diagramWithEnvelope dw dh f = framedDiagram themePlotKey dw dh (f defaultLayout)++-- | Draw a diagram inside the plot frame. Its draw ops are cached under the+-- content key the caller derives from the current theme.+framedDiagram ::+  Ui :> es =>+  (Theme -> Int) ->+  Double ->+  Double ->+  Layout ->+  QDiagram NanoUIBackend V2 Double Any ->+  Eff es Response+framedDiagram contentKey dw dh layout d = do+  fm <- uiFontMetrics+  theme <- uiTheme+  let ps = themePlotStyle theme+  drawingCached dw dh (fmLineHeight fm) (contentKey theme) (const layout) (fitLayoutIO fm layout d) $ \rectBox ->+    let inner = frameInner rectBox+        w = realToFrac (rectW inner) :: Double+        h = realToFrac (rectH inner)+        plot =+          if w <= 0 || h <= 0+            then emptySmallArray+            else mapSmallArray' (shiftDrawOp (rectX inner) (rectY inner)) (diagramOps w h d)+     in diagramFrame ps frameBorder rectBox <> plot++frameBorder :: Float+frameBorder = 1++-- | The box a framed diagram draws into, inside its border.+frameInner :: Rect -> Rect+frameInner (Rect x y w h) =+  Rect (x + frameBorder) (y + frameBorder) (max 0 (w - 2 * frameBorder)) (max 0 (h - 2 * frameBorder))++fitLayoutIO :: FontMetrics -> Layout -> Diagram B -> IO Layout+fitLayoutIO fm layout d = do+  let texts = foldr (\op rest -> case op of+        DrawText _ _ _ _ t _ -> t : rest+        _ -> rest) [] (diagramTextOps 100 100 d)+  prepared <- prepareFontMetricsMany fm texts+  pure (fitLayout prepared layout d)++-- | Draw a diagram inside a framed box sized by the layout modifier. Text in+-- the diagram is measured with the current font so labels fit.+diagram :: Ui :> es => (Layout -> Layout) -> QDiagram NanoUIBackend V2 Double Any -> Eff es Response+diagram f d = do+  ctx <- askContext+  wid <- currentId+  fm <- uiFontMetrics+  theme <- uiTheme+  let content = themePlotKey theme+  mEnv <- uiIO (lookupDrawFitEnvelope ctx wid (fmLineHeight fm) content (f defaultLayout))+  case mEnv of+    Just (dw, dh) -> diagramWithEnvelope dw dh f d+    Nothing ->+      let V2 dw dh = size d+       in diagramWithEnvelope dw dh f d

@@ -0,0 +1,20 @@+-- | Charting and plotting API for nano-ui.+module NanoUI.Plot+  ( module NanoUI.Plot.Types+  , module NanoUI.Plot.Series+  , module NanoUI.Plot.Scale+  , module NanoUI.Plot.Decimate+  , module NanoUI.Plot.Chrome+  , module NanoUI.Plot.Widget+  , module NanoUI.Plot.Builder+  , module NanoUI.Plot.Hit+  ) where++import NanoUI.Plot.Builder+import NanoUI.Plot.Hit+import NanoUI.Plot.Chrome+import NanoUI.Plot.Decimate+import NanoUI.Plot.Scale+import NanoUI.Plot.Series+import NanoUI.Plot.Types+import NanoUI.Plot.Widget

@@ -0,0 +1,45 @@+-- | Functions that build a 'NanoUI.Plot.Types.Chart' from series and set its+-- titles, legend, grid and decimation.+module NanoUI.Plot.Builder+  ( chart+  , withTitle+  , withXAxis+  , withYAxis+  , withLegend+  , withGrid+  , withDecimate+  , addSeries+  ) where++import Data.Text (Text)+import NanoUI.Plot.Types+  ( Chart (..)+  , GridMode+  , LegendPos+  , Series+  , emptyChart+  )++chart :: [Series] -> Chart+chart series = emptyChart {chartSeries = series}++withTitle :: Text -> Chart -> Chart+withTitle t c = c {chartTitle = Just t}++withXAxis :: Text -> Chart -> Chart+withXAxis t c = c {chartXTitle = Just t}++withYAxis :: Text -> Chart -> Chart+withYAxis t c = c {chartYTitle = Just t}++withLegend :: LegendPos -> Chart -> Chart+withLegend p c = c {chartLegend = p}++withGrid :: GridMode -> Chart -> Chart+withGrid g c = c {chartGrid = g}++withDecimate :: Bool -> Chart -> Chart+withDecimate b c = c {chartDecimate = b}++addSeries :: Series -> Chart -> Chart+addSeries s c = c {chartSeries = chartSeries c ++ [s]}

@@ -0,0 +1,399 @@+-- | Chart drawing: axes, ticks, grid, title and legend around the series, as+-- a diagram.+module NanoUI.Plot.Chrome+  ( chartDiagram+  , chartMargins+  , Margins (..)+  , seriesDomains+  , seriesPoints+  ) where++import Data.Colour (Colour)+import Data.Maybe (fromMaybe)+import Data.Text qualified as T+import Data.Primitive.PrimArray (indexPrimArray, sizeofPrimArray)+import Data.Vector.Unboxed qualified as U+import Diagrams.Prelude+  ( Diagram+  , P2+  , alignedText+  , alignBL+  , circle+  , closeTrail+  , fc+  , fontSizeL+  , fromVertices+  , lc+  , lw+  , lwO+  , moveTo+  , none+  , p2+  , phantom+  , rect+  , strokeTrail+  , translate+  , (^&)+  , ( # )+  )+import NanoUI+  ( Color+  , FontMetrics (..)+  , Rect (..)+  , Theme (..)+  , drawTextBox+  , fmLineHeight+  , lerpColor+  , themeSeries+  )+import NanoUI.Diagrams.Backend (B)+import NanoUI.Diagrams.Widget (PlotStyle (..), colourOf)+import NanoUI.Plot.Decimate (lttb)+import NanoUI.Plot.Scale+  ( domainExtentBy+  , domainToPlot+  , formatTick+  , mergeDomains+  , niceTicks+  , padDomain+  )+import NanoUI.Plot.Types+  ( Chart (..)+  , Domain (..)+  , GridMode (..)+  , LegendPos (..)+  , MarkShape (..)+  , Series (..)+  , SeriesData (..)+  , SeriesKind (..)+  )++-- lwO is output pixels. Do not scale into the 0..1 plot box.+plotStroke :: Float -> Double+plotStroke pt = realToFrac (max 1 pt)++-- Marker radius in plot-box units. Sized for ~160-200px charts.+plotMarkerRadius :: Float -> Double+plotMarkerRadius sz = realToFrac sz * 0.006++-- Host glyphs do not scale. Convert px using the intended data-box height.+-- Do not iterate against the full letterbox: that grows pads, shrinks the+-- data box, then grows pads again.+plotGapRef :: FontMetrics -> Double+plotGapRef fm = max 120 (realToFrac (fmLineHeight fm) * 7.5)++data Margins = Margins+  { marginLeft :: !Double+  , marginRight :: !Double+  , marginBottom :: !Double+  , marginTop :: !Double+  }+  deriving (Eq, Show)++data ChartChrome = ChartChrome+  { ccMargins :: !Margins+  , ccTickPad :: !Double+  , ccXTickPad :: !Double+  , ccPx :: Float -> Double+  , ccYTitleX :: !Double+  , ccXTitleY :: !Double+  , ccLegendW :: !Float+  }++chartMargins :: FontMetrics -> Chart -> Margins+chartMargins fm chart = ccMargins (chartChrome fm (snd (seriesDomains chart)) chart)++-- | Chrome for a chart whose y domain the caller has already computed.+chartChrome :: FontMetrics -> Domain -> Chart -> ChartChrome+chartChrome fm yDom chart =+  let yLabels = map formatTick (niceTicks 6 yDom)+      maxYW = maximum (0 : map (textWidth fm) yLabels)+      lh = fmLineHeight fm+      yTitleW =+        case chartYTitle chart of+          Nothing -> 0+          Just t -> textWidth fm t+      legendW =+        case chartLegend chart of+          LegendNone -> 0+          _ ->+            maximum+              ( 0+                  : map (textWidth fm . seriesName) (chartSeries chart)+              )+      s = plotGapRef fm+      px u = realToFrac u / s+      tickPad = px 6+      xTickPad = px 2+      titleGap = px 10+      -- Glyphs grow in plot units when the data box is shorter than+      -- plotGapRef. Pad tick size so titles stay just outside the ticks.+      tickW = px maxYW * 1.35+      tickH = px lh * 1.35+      yTitleX = -tickPad - tickW - titleGap+      xTitleY = -xTickPad - tickH - titleGap+      leftTick = tickPad + tickW + px 4+      botTick = xTickPad + tickH + px 4+      topM =+        if chartTitle chart /= Nothing+          then px lh + px 8+          else px 4+      rightM =+        case chartLegend chart of+          LegendRight -> px legendW + 0.22+          _ -> px 4+      leftTitle =+        if chartYTitle chart /= Nothing then titleGap + px yTitleW else 0+      botTitle =+        if chartXTitle chart /= Nothing then titleGap + tickH else 0+      botLegend =+        case chartLegend chart of+          LegendBottom -> px lh + px 6+          _ -> 0+      leftM = leftTick + leftTitle+      botM = botTick + botTitle + botLegend+   in ChartChrome+        { ccMargins =+            Margins+              { marginLeft = leftM+              , marginRight = rightM+              , marginBottom = botM+              , marginTop = topM+              }+        , ccTickPad = tickPad+        , ccXTickPad = xTickPad+        , ccPx = px+        , ccYTitleX = yTitleX+        , ccXTitleY = xTitleY+        , ccLegendW = legendW+        }++textWidth :: FontMetrics -> T.Text -> Float+textWidth fm s = rectW (drawTextBox fm 0 0 0 (-1) s)++seriesDomains :: Chart -> (Domain, Domain)+seriesDomains chart =+  case map seriesExtent (chartSeries chart) of+    [] -> (Domain 0 1, Domain 0 1)+    d : ds -> foldl' mergePair d ds+  where+    mergePair (dx, dy) (xd, yd) = (mergeDomains dx xd, mergeDomains dy yd)++seriesExtent :: Series -> (Domain, Domain)+seriesExtent s =+  case seriesData s of+    PointsXY pts ->+      (padDomain 0.05 (domainExtentBy fst pts), padDomain 0.05 (domainExtentBy snd pts))+    CategoryY _ values ->+      let n = sizeofPrimArray values+       in (Domain (-0.5) (fromIntegral n - 0.5), padDomain 0.05 (domainExtentBy (indexPrimArray values) (U.enumFromN 0 n)))++-- | Draw a chart from its 'seriesDomains' and each series' 'seriesPoints'.+chartDiagram :: FontMetrics -> Theme -> PlotStyle -> (Domain, Domain) -> [U.Vector (Double, Double)] -> Chart -> Diagram B+chartDiagram fm theme ps (xDom, yDom) points chart =+  let chrome = chartChrome fm yDom chart+      margins = ccMargins chrome+      leftM = marginLeft margins+      rightM = marginRight margins+      botM = marginBottom margins+      topM = marginTop margins+      xTicks = niceTicks 6 xDom+      yTicks = niceTicks 6 yDom+      tickPad = ccTickPad chrome+      xTickPad = ccXTickPad chrome+      toX = domainToPlot xDom+      toY = domainToPlot yDom+      horizontalGrid = mconcat [fromVertices [p2 (0, toY y), p2 (1, toY y)] | y <- yTicks]+      verticalGrid = mconcat [fromVertices [p2 (toX x, 0), p2 (toX x, 1)] | x <- xTicks]+      grid =+        case chartGrid chart of+          GridNone -> mempty+          GridHorizontal -> horizontalGrid+          GridVertical -> verticalGrid+          GridBoth -> horizontalGrid <> verticalGrid+      axes =+        fromVertices [p2 (0, 0), p2 (1, 0)]+          <> fromVertices [p2 (0, 0), p2 (0, 1)]+          <> mconcat [fromVertices [p2 (toX x, 0), p2 (toX x, 0.03)] | x <- xTicks]+          <> mconcat [fromVertices [p2 (0, toY y), p2 (0.03, toY y)] | y <- yTicks]+      xLabs =+        mconcat+          [ plotLbl ps 0.5 1 (T.unpack (formatTick x)) # moveTo (p2 (toX x, -xTickPad))+          | x <- xTicks+          ]+      yLabs =+        mconcat+          [ plotLbl ps 1 0.5 (T.unpack (formatTick y)) # moveTo (p2 (-tickPad, toY y))+          | y <- yTicks+          ]+      title =+        case chartTitle chart of+          Nothing -> mempty+          Just t -> plotLbl ps 0.5 0 (T.unpack t) # moveTo (p2 (0.5, 1.03))+      xt =+        case chartXTitle chart of+          Nothing -> mempty+          Just t ->+            plotLbl ps 0.5 1 (T.unpack t)+              # moveTo (p2 (0.5, ccXTitleY chrome))+      yt =+        case chartYTitle chart of+          Nothing -> mempty+          Just t ->+            plotLbl ps 1 0.5 (T.unpack t)+              # moveTo (p2 (ccYTitleX chrome, 0.5))+      coloredSeries =+        [ (fromMaybe fallback (seriesColor s), s)+        | (fallback, s) <- zip (cycle (themeSeries theme)) (chartSeries chart)+        ]+      seriesDia =+        mconcat+          [ renderSeries ps color xDom yDom s pts+          | ((color, s), pts) <- zip coloredSeries points+          ]+      legend = renderLegend fm ps coloredSeries chart chrome+      marginBox :: Diagram B+      marginBox =+        rect (1 + leftM + rightM) (1 + botM + topM)+          # alignBL+          # moveTo (p2 (-leftM, -botM))+      gridDia = grid # lc (plotGrid ps) # lwO (plotStroke 1)+      axesDia = axes # lc (plotMuted ps) # lwO (plotStroke 1)+      -- Diagrams composes front-to-back: keep the grid behind the data.+   in xLabs <> yLabs <> title <> xt <> yt <> legend <> seriesDia <> axesDia <> gridDia <> phantom marginBox++plotLbl :: PlotStyle -> Double -> Double -> String -> Diagram B+plotLbl ps ax ay s =+  alignedText ax ay s # fontSizeL 0.085 # fc (plotMuted ps) # lc (plotMuted ps) # lw none++renderSeries :: PlotStyle -> Color -> Domain -> Domain -> Series -> U.Vector (Double, Double) -> Diagram B+renderSeries ps c xDom yDom s pts =+  let ink = colourOf c+      fillCol = lerpColor c (plotFrameBg ps) 0.18+      fill = colourOf fillCol+      toP (x, y) = p2 (domainToPlot xDom x, domainToPlot yDom y)+   in case seriesKind s of+        LineSeries w _ ->+          fromVertices (U.foldr (\p acc -> toP p : acc) [] pts) # lc ink # lwO (plotStroke w)+        ScatterSeries w mk ->+          U.foldl' (\acc p -> acc <> markShape mk w ink (toP p)) mempty pts+        BarSeries frac ->+          renderBars ink frac pts+        AreaSeries baseline ->+          areaPath baseline xDom yDom pts # fc fill # lw none+        StepSeries w ->+          fromVertices (stepPoints pts xDom yDom) # lc ink # lwO (plotStroke w)++seriesPoints :: Chart -> Series -> U.Vector (Double, Double)+seriesPoints chart s =+  case seriesData s of+    PointsXY pts ->+      let k = decimateK (U.length pts)+       in if chartDecimate chart && U.length pts > k then lttb k pts else pts+    CategoryY _ values ->+       U.generate (sizeofPrimArray values) (\i -> (fromIntegral i, indexPrimArray values i))++decimateK :: Int -> Int+decimateK n = min n (max 64 (min 2000 (n `div` 2)))++renderBars :: Colour Double -> Float -> U.Vector (Double, Double) -> Diagram B+renderBars fill frac pts+  | U.null pts = mempty+  | otherwise =+      let !len  = U.length pts+          !n    = fromIntegral len :: Double+          !w    = realToFrac frac / n+          !invN = 1.0 / n+          !xOff = 0.5 * invN++          -- Single-pass strict fold for maxY (avoids allocating a list or intermediate vector)+          !maxY = U.foldl' (\ !acc (_, y) -> max acc (abs y)) 1e-9 pts+          !invMaxY = 1.0 / maxY++          drawBar (x, y) =+            let !absY = abs y+                !h    = absY * invMaxY+                !posX = x * invN + xOff+                !posY = signum y * h * 0.5+             in rect w h+                  # fc fill+                  # lw none+                  # translate (posX ^& posY)+       in U.foldl' (\acc p -> acc <> drawBar p) mempty pts++areaPath :: Double -> Domain -> Domain -> U.Vector (Double, Double) -> Diagram B+areaPath baseline xDom yDom pts+  | U.null pts = mempty+  | otherwise =+      let !baseY = domainToPlot yDom baseline+          toTop (!x, !y) = p2 (domainToPlot xDom x, domainToPlot yDom y)+          toBase (!x, !_) = p2 (domainToPlot xDom x, baseY)++          -- Forward traversal builds `top` in order+          top = U.foldr (\p acc -> toTop p : acc) [] pts+          -- Left fold naturally yields reverse order without allocating an intermediate reversed vector+          base = U.foldl' (\acc p -> toBase p : acc) [] pts+       in closedPoly (top ++ base)++closedPoly :: [P2 Double] -> Diagram B+closedPoly pts = fromVertices pts # closeTrail # strokeTrail++stepPoints :: U.Vector (Double, Double) -> Domain -> Domain -> [P2 Double]+stepPoints pts xDom yDom =+  let toP (x, y) = p2 (domainToPlot xDom x, domainToPlot yDom y)+   in U.foldr+        (\((x0, y0), (x1, _)) acc -> toP (x0, y0) : toP (x1, y0) : acc)+        []+        (U.zip pts (U.drop 1 pts))++markShape :: MarkShape -> Float -> Colour Double -> P2 Double -> Diagram B+markShape MarkCircle w c p =+  circle (plotMarkerRadius w) # fc c # lw none # moveTo p+markShape MarkSquare w c p =+  let s = plotMarkerRadius w * 2+   in rect s s # fc c # lw none # moveTo p+markShape MarkDiamond w c p =+  let r = plotMarkerRadius w * 1.4+   in closedPoly [p2 (0, r), p2 (r, 0), p2 (0, -r), p2 (-r, 0)]+        # fc c+        # lw none+        # moveTo p+markShape MarkTriangle w c p =+  let r = plotMarkerRadius w * 1.6+   in closedPoly [p2 (0, r), p2 (-r, -r * 0.6), p2 (r, -r * 0.6)]+        # fc c+        # lw none+        # moveTo p+markShape MarkCross w c p =+  let r = plotMarkerRadius w * 1.4+      sw = plotStroke w+   in ( (fromVertices [p2 (-r, -r), p2 (r, r)] # lc c # lwO sw)+          <> (fromVertices [p2 (-r, r), p2 (r, -r)] # lc c # lwO sw)+      )+        # moveTo p++renderLegend :: FontMetrics -> PlotStyle -> [(Color, Series)] -> Chart -> ChartChrome -> Diagram B+renderLegend _ _ _ Chart {chartLegend = LegendNone} _ = mempty+renderLegend fm ps coloredSeries chart chrome =+  let px = ccPx chrome+      row = px (fmLineHeight fm + 8)+      col = px (ccLegendW chrome) + 0.22+      botLegendY =+        case chartXTitle chart of+          Nothing -> -(ccXTickPad chrome) - px (fmLineHeight fm) - px 6+          Just _ -> ccXTitleY chrome - px (fmLineHeight fm) - px 6+      position i = case chartLegend chart of+        LegendRight -> (1.04, 0.98 - i * row)+        LegendBottom -> (i * col, botLegendY)+        LegendTop -> (i * col, 1.12)+        LegendInside -> (0.02, 0.98 - i * row)+        LegendNone -> (0, 0)+   in mconcat+        [ legendEntry ps color (T.unpack (seriesName s)) # moveTo (p2 (position i))+        | (i, (color, s)) <- zip [0 ..] coloredSeries+        ]++legendEntry :: PlotStyle -> Color -> String -> Diagram B+legendEntry ps col name =+  (fromVertices [p2 (0, 0), p2 (0.12, 0)] # lc (colourOf col) # lwO (plotStroke 1.5))+    <> (plotLbl ps 0 0.5 name # moveTo (p2 (0.16, 0)))

@@ -0,0 +1,108 @@+-- | Point reduction for long series: largest-triangle-three-buckets and+-- per-bucket minimum and maximum.+module NanoUI.Plot.Decimate+  ( lttb+  , minMaxDecimate+  ) where++import Control.Monad.ST (runST)+import Data.Vector.Generic (Vector)+import qualified Data.Vector.Generic as V+import qualified Data.Vector.Generic.Mutable as MV+import qualified Data.Vector.Unboxed as U++-- | Largest-Triangle-Three-Buckets sampling. Returns at most the requested+-- number of points in input order, preserving both endpoints for budgets >= 2.+{-# INLINABLE lttb #-}+{-# SPECIALIZE lttb :: Int -> U.Vector (Double, Double) -> U.Vector (Double, Double) #-}+lttb :: Vector v (Double, Double) => Int -> v (Double, Double) -> v (Double, Double)+lttb k0 pts+  | k0 <= 0 = V.empty+  | n <= k0 = pts+  | k0 == 1 = V.take 1 pts+  | k0 == 2 = V.fromList [V.head pts, V.last pts]+  | otherwise = V.create $ do+      out <- MV.new k0+      let !k = k0+          !bucketSize = fromIntegral (n - 2) / (fromIntegral (k - 2) :: Double)+          !firstPt = pts V.! 0+          !lastPt = pts V.! (n - 1)+          go !i !prevIdx+            | i >= k - 2 = MV.write out (k - 1) lastPt+            | otherwise =+                let !rangeStart = floor (fromIntegral i * bucketSize) + 1+                    !rangeEnd = min (n - 1) (floor (fromIntegral (i + 1) * bucketSize) + 1)+                    !avgStart = rangeEnd+                    !avgEnd = min n (floor (fromIntegral (i + 2) * bucketSize) + 1)+                    (!avgX, !avgY) = bucketAvg pts avgStart avgEnd+                    !prevPt = pts V.! prevIdx+                    findBest !j !bestIdx !bestArea+                      | j >= rangeEnd = bestIdx+                      | otherwise =+                          let !area = triArea prevPt (pts V.! j) (avgX, avgY)+                           in if area > bestArea+                                then findBest (j + 1) j area+                                else findBest (j + 1) bestIdx bestArea+                    -- An empty range keeps rangeStart; areas are never negative.+                    !best = findBest rangeStart rangeStart (-1)+                 in do+                   MV.write out (i + 1) (pts V.! best)+                   go (i + 1) best+      MV.write out 0 firstPt+      go 0 0+      pure out+  where+    !n = V.length pts++{-# INLINE bucketAvg #-}+bucketAvg :: Vector v (Double, Double) => v (Double, Double) -> Int -> Int -> (Double, Double)+bucketAvg pts !start !end+  | start >= end = (0, 0)+  | otherwise =+      let !len = end - start+          !denom = fromIntegral len :: Double+          go !i !sx !sy+            | i >= end = (sx / denom, sy / denom)+            | otherwise =+                let (!x, !y) = pts V.! i+                 in go (i + 1) (sx + x) (sy + y)+       in go start 0 0++triArea :: (Double, Double) -> (Double, Double) -> (Double, Double) -> Double+triArea (!x0, !y0) (!x1, !y1) (!x2, !y2) =+  abs ((x0 - x2) * (y1 - y0) - (x0 - x1) * (y2 - y0)) * 0.5++-- | Split into at most @k@ buckets and retain each bucket's Y extrema in+-- input order. The output has at most @2*k@ points; non-positive budgets+-- return an empty vector. A point selected as both extrema is emitted once.+{-# INLINABLE minMaxDecimate #-}+{-# SPECIALIZE minMaxDecimate :: Int -> U.Vector (Double, Double) -> U.Vector (Double, Double) #-}+minMaxDecimate :: Vector v (Double, Double) => Int -> v (Double, Double) -> v (Double, Double)+minMaxDecimate k pts+  | k <= 0 = V.empty+  | len <= k = pts+  | otherwise = runST $ do+      out <- MV.new (min len (2 * numChunks))+      let chunks !start !written+            | start >= len = V.freeze (MV.slice 0 written out)+            | otherwise = do+                let !end = start + min bucket (len - start)+                    extrema !i !lowIdx !highIdx+                      | i >= end = (lowIdx, highIdx)+                      | otherwise =+                          let !y = snd (pts V.! i)+                              !lo' = if y < snd (pts V.! lowIdx) then i else lowIdx+                              !hi' = if y > snd (pts V.! highIdx) then i else highIdx+                           in extrema (i + 1) lo' hi'+                    (!lo, !hi) = extrema (start + 1) start start+                MV.write out written (pts V.! min lo hi)+                if lo == hi+                  then chunks end (written + 1)+                  else do+                    MV.write out (written + 1) (pts V.! max lo hi)+                    chunks end (written + 2)+      chunks 0 0+  where+    !len = V.length pts+    bucket = (len - 1) `div` k + 1+    numChunks = (len - 1) `div` bucket + 1

@@ -0,0 +1,64 @@+-- | Finding the data point nearest the pointer on a drawn chart.+module NanoUI.Plot.Hit+  ( hitTestChartCached+  , nearestPlotHover+  ) where++import NanoUI (Rect (..), V2, rectContains, v2X, v2Y)+import NanoUI.Diagrams.Backend (letterbox)+import NanoUI.Diagrams.Widget (frameInner)+import NanoUI.Plot.Scale (plotToDomain)+import NanoUI.Plot.Types (Domain, PlotHover (..))+import qualified Data.Vector.Unboxed as U++-- | The hover target under the pointer, for a diagram of envelope @dw@ by+-- @dh@ with extents @(x0, x1)@ and @(y0, y1)@ drawn framed in @widgetRect@.+hitTestChartCached ::+  Double ->+  Double ->+  (Double, Double) ->+  (Double, Double) ->+  (Domain, Domain) ->+  [U.Vector (Double, Double)] ->+  Rect ->+  V2 ->+  Maybe PlotHover+hitTestChartCached dw dh (x0, x1) (y0, y1) domains points widgetRect mouse+  | not (rectContains inner mouse) || w <= 0 || h <= 0 = Nothing+  | lx < offX || ly < offY || lx > offX + outW || ly > offY + outH = Nothing+  | otherwise =+      nearestPlotHover+        domains+        points+        (x0 + (lx - offX) / outW * (x1 - x0))+        (y1 - (ly - offY) / outH * (y1 - y0))+ where+  inner = frameInner widgetRect+  w = realToFrac (rectW inner)+  h = realToFrac (rectH inner)+  (outW, outH, offX, offY) = letterbox dw dh w h+  lx = realToFrac (v2X mouse - rectX inner)+  ly = realToFrac (v2Y mouse - rectY inner)++-- | The data point nearest a position in the unit plot box, given the chart's+-- domains and each series' drawn points.+nearestPlotHover :: (Domain, Domain) -> [U.Vector (Double, Double)] -> Double -> Double -> Maybe PlotHover+nearestPlotHover (xDom, yDom) points gx gy+  | gx < 0 || gx > 1 || gy < 0 || gy > 1 = Nothing+  | otherwise = snd <$> scanSeries 0 Nothing points+ where+  dataX = plotToDomain xDom gx+  dataY = plotToDomain yDom gy+  -- The best hover carries its squared distance, so each point computes only+  -- its own and a point that loses allocates nothing.+  scanSeries !_ !best [] = best+  scanSeries !si !best (pts : rest) =+    let pick current !ptIdx (!x, !y) =+          let !dx = x - dataX+              !dy = y - dataY+              !d = dx * dx + dy * dy+           in case current of+                Just (bestD, _) | bestD <= d -> current+                _ -> Just (d, PlotHover x y si ptIdx)+        !best' = U.ifoldl' pick best pts+     in scanSeries (si + 1) best' rest

@@ -0,0 +1,118 @@+-- | Mapping between data domains and plot coordinates, tick placement and+-- labels, and domain extents.+module NanoUI.Plot.Scale+  ( domainToPlot+  , plotToDomain+  , niceTicks+  , formatTick+  , domainExtent+  , domainExtentBy+  , mergeDomains+  , padDomain+  ) where++import Data.Text (Text)+import Data.Text qualified as T+import NanoUI.Plot.Types (Domain (..))+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB+import qualified Data.Text.Lazy.Builder.RealFloat as TB+import qualified Data.Vector.Generic as GV++-- | Map a domain value into the unit plot box: @lo@ goes to 0, @hi@ to 1.+domainToPlot :: Domain -> Double -> Double+domainToPlot (Domain lo hi) v = (v - lo) / max 1e-9 (hi - lo)++-- | Inverse of 'domainToPlot'.+plotToDomain :: Domain -> Double -> Double+plotToDomain (Domain lo hi) v = lo + v * max 1e-9 (hi - lo)++-- Works with Data.Vector, Data.Vector.Unboxed, or Data.Vector.Storable+domainExtent :: (GV.Vector v Double) => v Double -> Domain+domainExtent = domainExtentBy id+{-# INLINE domainExtent #-}++-- | Project while reducing, without materialising a mapped numeric vector.+domainExtentBy :: GV.Vector v a => (a -> Double) -> v a -> Domain+domainExtentBy project xs+  | lo > hi = Domain 0 1+  | lo == hi = Domain (lo - 0.5) (hi + 0.5)+  | otherwise = extent+  where+    extent@(Domain lo hi) =+      GV.foldl' (\(Domain mn mx) value -> let !x = project value in Domain (min mn x) (max mx x)) (Domain (1 / 0) (-1 / 0)) xs+{-# INLINE domainExtentBy #-}++mergeDomains :: Domain -> Domain -> Domain+mergeDomains (Domain a b) (Domain c d) = Domain (min a c) (max b d)++padDomain :: Double -> Domain -> Domain+padDomain frac (Domain lo hi) =+  let dSpan = max 1e-9 (hi - lo)+      pad = dSpan * frac+   in Domain (lo - pad) (hi + pad)++finite :: Double -> Bool+finite x = not (isNaN x || isInfinite x)++-- Heckbert-style nice tick step.+niceStep :: Double -> Double+niceStep raw =+  let exp10 = floor (logBase 10 raw) :: Int+      f = raw / (10 ** fromIntegral exp10)+      nf+        | f <= 1 = 1+        | f <= 2 = 2+        | f <= 5 = 5+        | otherwise = 10+   in nf * (10 ** fromIntegral exp10)++niceTicks :: Int -> Domain -> [Double]+niceTicks maxTicks (Domain lo hi)+  | maxTicks <= 0 || not (finite lo && finite hi) || hi < lo = []+  | lo == hi = [lo]+  | not (finite dSpan) = []+  | not (finite step) || step <= 0 || not (finite (lo / step)) = []+  | otherwise = go start 0 []+  where+    dSpan = max 1e-9 (hi - lo)+    step = niceStep (dSpan / fromIntegral (max 2 maxTicks))+    start = fromIntegral (ceiling (lo / step - 1e-9) :: Integer) * step+    go !v !count acc+      | not (finite v) || v > hi + step * 0.001 = reverse acc+      | otherwise =+          let !accepted = v >= lo - step * 0.001+              acc' = if accepted then v : acc else acc+              !next = v + step+           in if count >= maxTicks || next <= v+                then reverse acc'+                else go next (count + 1) acc'++formatTick :: Double -> Text+formatTick v+  | not (finite v) = T.empty+  | otherwise =+      let snapped = snapNoise v+       in if abs snapped >= 1e6 || (abs snapped > 0 && abs snapped < 1e-6)+            then render (TB.formatRealFloat TB.Exponent (Just 3) snapped)+            else+              let n = round snapped :: Integer+               in if abs (snapped - fromIntegral n) < 1e-6+                    then render (TB.decimal n)+                    else stripZeros (render (TB.formatRealFloat TB.Fixed (Just 6) snapped))+  where+    render = TL.toStrict . TB.toLazyText++snapNoise :: Double -> Double+snapNoise v =+  let s = 1e10+      scaled = v * s+   in if finite scaled then fromIntegral (round scaled :: Integer) / s else v++stripZeros :: Text -> Text+stripZeros s =+  let t = T.dropWhileEnd (== '0') s+   in case T.unsnoc t of+        Just (rest, '.') -> rest+        _ -> t

@@ -0,0 +1,101 @@+-- | Series constructors (line, scatter, bar, area, step) and their style+-- modifiers.+module NanoUI.Plot.Series+  ( line+  , scatter+  , bar+  , area+  , step+  , withColor+  , withStrokeWidth+  , withMarker+  , withBaseline+  , lineVec+  , scatterVec+  , areaVec+  , stepVec+  , barVec+  ) where++import Data.Text (Text)+import Data.Foldable (toList)+import Data.Primitive.PrimArray (generatePrimArray)+import Data.Primitive.SmallArray (createSmallArray, writeSmallArray)+import Data.Vector (Vector)+import Data.Vector qualified as V+import Data.Vector.Generic qualified as G+import Data.Vector.Unboxed qualified as U+import NanoUI (Color)+import NanoUI.Plot.Types+  ( MarkShape (..)+  , Series (..)+  , SeriesData (..)+  , SeriesKind (..)+  )++line :: Foldable f => Text -> f (Double, Double) -> Series+line name = lineVec name . U.fromList . toList++scatter :: Foldable f => Text -> f (Double, Double) -> Series+scatter name = scatterVec name . U.fromList . toList++bar :: Foldable f => Text -> f (Text, Double) -> Series+bar name = barVec name . V.fromList . toList++area :: Foldable f => Text -> f (Double, Double) -> Series+area name = areaVec name . U.fromList . toList++step :: Foldable f => Text -> f (Double, Double) -> Series+step name = stepVec name . U.fromList . toList++withColor :: Color -> Series -> Series+withColor c s = s {seriesColor = Just c}++withStrokeWidth :: Float -> Series -> Series+withStrokeWidth w s =+  case seriesKind s of+    LineSeries _ m -> s {seriesKind = LineSeries w m}+    ScatterSeries _ mk -> s {seriesKind = ScatterSeries w mk}+    BarSeries _ -> s {seriesKind = BarSeries w}+    StepSeries _ -> s {seriesKind = StepSeries w}+    _ -> s++withMarker :: MarkShape -> Series -> Series+withMarker mk s =+  case seriesKind s of+    LineSeries w _ -> s {seriesKind = LineSeries w (Just mk)}+    ScatterSeries w _ -> s {seriesKind = ScatterSeries w mk}+    _ -> s++withBaseline :: Double -> Series -> Series+withBaseline b s =+  case seriesKind s of+    AreaSeries _ -> s {seriesKind = AreaSeries b}+    _ -> s++-- | Numeric series retain unboxed coordinates. Unboxed inputs are shared;+-- boxed/storable inputs are converted once at the construction boundary.+{-# INLINE lineVec #-}+lineVec :: G.Vector v (Double, Double) => Text -> v (Double, Double) -> Series+lineVec name pts = Series name Nothing (LineSeries 1.5 Nothing) (PointsXY (G.convert pts))++{-# INLINE scatterVec #-}+scatterVec :: G.Vector v (Double, Double) => Text -> v (Double, Double) -> Series+scatterVec name pts = Series name Nothing (ScatterSeries 3 MarkCircle) (PointsXY (G.convert pts))++{-# INLINE areaVec #-}+areaVec :: G.Vector v (Double, Double) => Text -> v (Double, Double) -> Series+areaVec name pts = Series name Nothing (AreaSeries 0) (PointsXY (G.convert pts))++{-# INLINE stepVec #-}+stepVec :: G.Vector v (Double, Double) => Text -> v (Double, Double) -> Series+stepVec name pts = Series name Nothing (StepSeries 1.5) (PointsXY (G.convert pts))++barVec :: Text -> Vector (Text, Double) -> Series+barVec name rows =+  Series name Nothing (BarSeries 0.72) $+    CategoryY+      (createSmallArray n "" (\out -> V.imapM_ (\i (t, _) -> writeSmallArray out i t) rows))+      (generatePrimArray n (snd . V.unsafeIndex rows))+  where+    n = V.length rows

@@ -0,0 +1,91 @@+-- | Chart, series, domain and hover types.+module NanoUI.Plot.Types+  ( Domain (..)+  , SeriesData (..)+  , MarkShape (..)+  , SeriesKind (..)+  , Series (..)+  , LegendPos (..)+  , GridMode (..)+  , Chart (..)+  , PlotHover (..)+  , PlotResponse (..)+  , emptyChart+  ) where++import Data.Primitive.PrimArray (PrimArray)+import Data.Primitive.SmallArray (SmallArray)+import Data.Text (Text)+import Data.Vector.Unboxed qualified as U+import NanoUI (Color, Response)++data Domain = Domain !Double !Double+  deriving (Eq, Show)++data SeriesData+  = PointsXY !(U.Vector (Double, Double))+  | -- | Bar labels and their values, in order.+    CategoryY !(SmallArray Text) !(PrimArray Double)+  deriving (Eq, Show)++data MarkShape = MarkCircle | MarkSquare | MarkDiamond | MarkTriangle | MarkCross+  deriving (Eq, Show)++data SeriesKind+  = LineSeries !Float (Maybe MarkShape)+  | ScatterSeries !Float !MarkShape+  | BarSeries !Float+  | AreaSeries !Double+  | StepSeries !Float+  deriving (Eq, Show)++data Series = Series+  { seriesName :: !Text+  , seriesColor :: !(Maybe Color)+  , seriesKind :: !SeriesKind+  , seriesData :: !SeriesData+  }+  deriving (Eq, Show)++data LegendPos = LegendRight | LegendBottom | LegendTop | LegendInside | LegendNone+  deriving (Eq, Show)++data GridMode = GridBoth | GridHorizontal | GridVertical | GridNone+  deriving (Eq, Show)++data Chart = Chart+  { chartTitle :: !(Maybe Text)+  , chartXTitle :: !(Maybe Text)+  , chartYTitle :: !(Maybe Text)+  , chartSeries :: ![Series]+  , chartLegend :: !LegendPos+  , chartGrid :: !GridMode+  , chartDecimate :: !Bool+  }+  deriving (Eq, Show)++data PlotHover = PlotHover+  { hoverDataX :: !Double+  , hoverDataY :: !Double+  , hoverSeriesIdx :: !Int+  , hoverPointIdx :: !Int+  }+  deriving (Eq, Show)++data PlotResponse = PlotResponse+  { plotResponse :: !Response+  , plotHover :: !(Maybe PlotHover)+  }+  deriving (Eq, Show)++emptyChart :: Chart+emptyChart =+  Chart+    { chartTitle = Nothing+    , chartXTitle = Nothing+    , chartYTitle = Nothing+    , chartSeries = []+    , chartLegend = LegendRight+    , chartGrid = GridBoth+    , chartDecimate = True+    }

@@ -0,0 +1,120 @@+-- | Chart widgets: 'plot' draws a chart and reports the hovered point, and+-- 'lineChart', 'barChart', 'scatterChart' and 'areaChart' draw one series.+module NanoUI.Plot.Widget+  ( plot+  , lineChart+  , barChart+  , scatterChart+  , areaChart+  ) where++import Data.Dynamic (fromDynamic, toDyn)+import Data.IORef (readIORef)+import qualified Data.IntMap.Strict as IM+import Data.Maybe (fromMaybe, catMaybes)+import Data.Text (Text)+import Data.Vector.Unboxed qualified as U+import Diagrams.Prelude (Diagram, V2 (..), extentX, extentY, size)+import Effectful (Eff, type (:>))+import NanoUI+  ( FontMetrics+  , Layout+  , Theme+  , Ui+  , WidgetId+  , uiFontMetrics+  , uiMousePos+  , uiTheme+  , prepareFontMetricsMany+  , respRect+  )+import NanoUI.Context (Context (..), WidgetStore (..), getStore, intKey, setStore)+import NanoUI.Monad (askContext, nextId, uiIO)+import NanoUI.Diagrams.Backend (B)+import NanoUI.Diagrams.Widget (PlotStyle, diagramWithKeyAndEnvelope, uiPlotStyle)+import NanoUI.Plot.Builder qualified as Builder+import NanoUI.Plot.Chrome (chartDiagram, seriesDomains, seriesPoints)+import NanoUI.Plot.Scale (formatTick, niceTicks)+import NanoUI.Plot.Hit (hitTestChartCached)+import NanoUI.Plot.Series (area, bar, line, scatter)+import NanoUI.Plot.Types+  ( Chart (..)+  , Domain+  , Series (..)+  , LegendPos (..)+  , PlotResponse (..)+  )++data CachedChart = CachedChart+  { ccChart :: !Chart+  , ccTheme :: !Theme+  , ccFont :: {-# UNPACK #-} !Int+  , ccStyle :: !PlotStyle+  , ccVersion :: {-# UNPACK #-} !Int+  , ccDiagram :: !(Diagram B)+  , ccWidth :: {-# UNPACK #-} !Double+  , ccHeight :: {-# UNPACK #-} !Double+  , ccExtX :: !(Double, Double)+  , ccExtY :: !(Double, Double)+  , ccDomains :: !(Domain, Domain)+  , ccPoints :: ![U.Vector (Double, Double)]+  }++-- Keep the cache in the owning context's widget store. Versions only need+-- to distinguish successive contents of this widget's draw-op cache.+cachedChartDiagram :: Context -> WidgetId -> FontMetrics -> Theme -> PlotStyle -> Chart -> IO CachedChart+cachedChartDiagram ctx wid fm theme ps chart = do+  let k = intKey wid+  font <- readIORef (ctxMetricGen ctx)+  store <- getStore ctx+  let previous = IM.lookup k (storeDyn store) >>= fromDynamic+  case previous of+    Just cc | ccChart cc == chart && ccTheme cc == theme && ccFont cc == font && ccStyle cc == ps -> pure cc+    _ -> do+      let domains@(xDom, yDom) = seriesDomains chart+          points = map (seriesPoints chart) (chartSeries chart)+          labels = catMaybes [chartTitle chart, chartXTitle chart, chartYTitle chart]+            ++ map seriesName (chartSeries chart)+            ++ map formatTick (niceTicks 6 xDom ++ niceTicks 6 yDom)+      prepared <- prepareFontMetricsMany fm labels+      let !d = chartDiagram prepared theme ps domains points chart+          !(V2 dw dh) = size d+          extX = fromMaybe (0, dw) (extentX d)+          extY = fromMaybe (0, dh) (extentY d)+      let !v = maybe 1 ((+ 1) . ccVersion) previous+          !cc = CachedChart chart theme font ps v d dw dh extX extY domains points+      setStore ctx (store {storeDyn = IM.insert k (toDyn cc) (storeDyn store)})+      pure cc++-- | Draw a chart sized by the layout modifier. The response reports the+-- nearest data point under the pointer.+plot :: Ui :> es => (Layout -> Layout) -> Chart -> Eff es PlotResponse+plot f chart = do+  wid <- nextId+  ctx <- askContext+  fm <- uiFontMetrics+  theme <- uiTheme+  ps <- uiPlotStyle+  cc <- uiIO (cachedChartDiagram ctx wid fm theme ps chart)+  resp <- diagramWithKeyAndEnvelope (ccVersion cc) (ccWidth cc) (ccHeight cc) f (ccDiagram cc)+  mouse <- uiMousePos+  let hover = hitTestChartCached (ccWidth cc) (ccHeight cc) (ccExtX cc) (ccExtY cc) (ccDomains cc) (ccPoints cc) (respRect resp) mouse+  pure PlotResponse {plotResponse = resp, plotHover = hover}++-- | One line series with a grid and no legend.+lineChart :: Ui :> es => (Layout -> Layout) -> [(Double, Double)] -> Eff es PlotResponse+lineChart f pts = plot f (singleSeries True (line "series" pts))++barChart :: Ui :> es => (Layout -> Layout) -> [(Text, Double)] -> Eff es PlotResponse+barChart f pts = plot f (singleSeries False (bar "series" pts))++scatterChart :: Ui :> es => (Layout -> Layout) -> [(Double, Double)] -> Eff es PlotResponse+scatterChart f pts = plot f (singleSeries False (scatter "series" pts))++areaChart :: Ui :> es => (Layout -> Layout) -> [(Double, Double)] -> Eff es PlotResponse+areaChart f pts = plot f (singleSeries True (area "series" pts))++-- | A gridded chart of one series without a legend, optionally decimated.+singleSeries :: Bool -> Series -> Chart+singleSeries decimate s =+  Builder.withDecimate decimate (Builder.withLegend LegendNone (Builder.chart [s]))

@@ -0,0 +1,95 @@+cabal-version:      3.4+name:               nano-ui-diagrams+version:            0.1.0.0+synopsis:           Charts and diagrams-lib drawings for nano-ui+description:+    Places diagrams-lib drawings in nano-ui layouts and builds line, bar,+    scatter, area, and step charts with axes, legends, and hover lookup.+license:            MIT+license-file:       LICENSE+author:             goolord+maintainer:         zacharyachurchill@gmail.com+category:           Graphics+homepage:           https://github.com/goolord/nano-ui+bug-reports:        https://github.com/goolord/nano-ui/issues+build-type:         Simple+tested-with:        GHC ==9.10.3 || ==9.14.1+extra-doc-files:+    CHANGELOG.md+    README.md++source-repository head+    type:     git+    location: https://github.com/goolord/nano-ui.git+    subdir:   packages/nano-ui-diagrams++common extensions+    default-language: GHC2024+    default-extensions:+        DuplicateRecordFields+        OverloadedStrings+        TypeFamilies++common warnings+  ghc-options:+    -Wall+    -Wextra+    -Wcompat+    -Widentities+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wmissing-export-lists+    -Wmissing-home-modules+    -Wpartial-fields+    -Wredundant-constraints+    -Wunused-packages++library+    import:           extensions+    import:           warnings+    exposed-modules:+        NanoUI.Diagrams+        NanoUI.Diagrams.Backend+        NanoUI.Diagrams.Tessellation+        NanoUI.Diagrams.Widget+        NanoUI.Plot+        NanoUI.Plot.Types+        NanoUI.Plot.Scale+        NanoUI.Plot.Decimate+        NanoUI.Plot.Series+        NanoUI.Plot.Chrome+        NanoUI.Plot.Builder+        NanoUI.Plot.Hit+        NanoUI.Plot.Widget+    build-depends:+        base >=4.20 && <4.23,+        colour >=2.3.3 && <2.4,+        containers >=0.6.7 && <0.9,+        diagrams-core >=1.5 && <1.6,+        diagrams-lib >=1.4.6 && <1.7,+        dlist >=1.0 && <1.1,+        effectful-core >=2.5 && <2.8,+        hashable >=1.4 && <1.6,+        lens >=5.0 && <5.4,+        nano-ui ^>=0.1,+        primitive >=0.8 && <0.10,+        text >=2.0 && <2.2,+        vector >=0.13 && <0.14+    hs-source-dirs:   lib++test-suite nano-ui-diagrams-test+    import:           extensions+    import:           warnings+    type:             exitcode-stdio-1.0+    main-is:          Main.hs+    build-depends:+        base >=4.20 && <4.23,+        colour >=2.3.3 && <2.4,+        diagrams-lib >=1.4.6 && <1.7,+        hspec >=2.10 && <2.12,+        nano-ui,+        nano-ui-diagrams,+        primitive >=0.8 && <0.10,+        text >=2.0 && <2.2,+        vector >=0.13 && <0.14+    hs-source-dirs:   test

@@ -0,0 +1,505 @@+module Main (main) where++import Control.Monad (forM_, unless)+import Data.Colour.Names (coral, steelblue)+import Data.Foldable (toList)+import Data.IORef (readIORef)+import Data.List (tails)+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Text qualified as T+import Data.Primitive.SmallArray (SmallArray, emptySmallArray)+import Data.Vector qualified as V+import Diagrams.Prelude+  ( Diagram+  , circle+  , fc+  , lw+  , lwO+  , none+  , (#)+  )+import NanoUI+import NanoUI.Context (Context (..), DrawingCacheState (..), withFontMetrics)+import NanoUI.Context.Types (DrawOpCacheEntry (..))+import NanoUI.Diagrams+  ( B+  , defaultPlotStyle+  , diagram+  , diagramOps+  , fitLayout+  )+import NanoUI.Diagrams.Backend (diagramTextOps)+import NanoUI.Diagrams.Tessellation+  ( strokePolyline+  , triangulatePolygon+  )+import NanoUI.Plot.Chrome+  ( Margins (..)+  , chartDiagram+  , chartMargins+  , seriesDomains+  , seriesPoints+  )+import NanoUI.Plot.Decimate (lttb, minMaxDecimate)+import NanoUI.Plot.Hit (nearestPlotHover)+import NanoUI.Plot.Scale (formatTick, mergeDomains, niceTicks)+import NanoUI.Plot.Series+  ( area+  , bar+  , line+  , scatter+  , withColor+  , withMarker+  )+import NanoUI.Plot.Types+  ( Chart (..)+  , Domain (..)+  , GridMode (..)+  , LegendPos (..)+  , MarkShape (..)+  , PlotHover (..)+  , Series (..)+  )+import NanoUI.Plot.Widget qualified as Plot+import NanoUI.Testing (DrawData (..), drawCmdNull, newPixelContext, runFrame)+import Test.Hspec (describe, hspec, it)++main :: IO ()+main = hspec $ do+  let+    fm = monospaceMetrics 16+  describe "rendering" $ do+    it "draws and redraws a filled diagram" $ do+      ctx <- newPixelContext+      testRendering ctx (emptyInput {inputWindowSize = Size 240 120})+    it "renders chart labels apart from geometry" (testTextOnlyRendering fm)+    it "reuses cached chart content within one context" testChartCache+  describe "tessellation" $ do+    it "triangulates indexed polygons with full coverage" testIndexedTriangulation+    it "covers polyline strokes end to end" testStrokeCoversMidpoint+  describe "scales and domains" $ do+    it "picks and formats nice ticks" testNiceTicks+    it "shares bounds across series" testMultiSeriesDomains+  describe "decimation" $ do+    it "keeps LTTB extrema and endpoints" testLttb+    it "keeps min/max extrema" testMinMaxDecimate+  describe "chart chrome" $ do+    it "keeps labels, titles and legends apart" (testLabelFit fm)+    it "colors legend entries like their series" (testLegendColors fm)+    it "picks the nearest hover point" testPlotHover+    it "fills closed series and markers" (testClosedSeriesFills fm)+    it "caps the height of growing plots" (testGrowPlotHeight fm)++-- | A chart of the given series with no legend, grid or decimation.+bareChart :: [Series] -> Chart+bareChart ss =+  Chart+    { chartTitle = Nothing+    , chartXTitle = Nothing+    , chartYTitle = Nothing+    , chartSeries = ss+    , chartLegend = LegendNone+    , chartGrid = GridNone+    , chartDecimate = False+    }++chartDia :: FontMetrics -> Chart -> Diagram B+chartDia fm c = chartDiagram fm defaultTheme defaultPlotStyle (seriesDomains c) (map (seriesPoints c) (chartSeries c)) c++rectsOverlap :: Rect -> Rect -> Bool+rectsOverlap (Rect x1 y1 w1 h1) (Rect x2 y2 w2 h2) =+  x1 < x2 + w2 && x2 < x1 + w1 && y1 < y2 + h2 && y2 < y1 + h1++testTextOnlyRendering :: FontMetrics -> IO ()+testTextOnlyRendering fm = do+  let+    d = linePlotDiag fm [(0, 0), (1, 2), (2, 1)]+    isText DrawText {} = True+    isText _ = False+  forM_ [(400, 240), (120, 400), (0, 100), (100, -1)] $ \(w, h) -> do+    let+      full = diagramOps w h d+      labels = diagramTextOps w h d+    unless (toList labels == filter isText (toList full)) $+      fail "text-only rendering differs from the full render's text"+    unless+      (w <= 0 || h <= 0 || (not (null labels) && length labels < length full)) $+      fail "text-only rendering did not separate chart labels from geometry"++testChartCache :: IO ()+testChartCache = do+  base <- newPixelContext+  other <- newPixelContext+  let+    inp = emptyInput {inputWindowSize = Size 400 240}+    fm = monospaceMetrics 16+    larger = monospaceMetrics 24+    ctx = withFontMetrics base fm+    render c = do+      _ <-+        runFrame c inp $ Plot.lineChart (fixedWH 360 200) [(0, 0), (1, 1)]+      cache <- readIORef (ctxDrawingCache c)+      pure (map doeContent (toList (dcsDrawOpCache cache)))+  first <- render ctx+  again <- render ctx+  unless (not (null first) && first == again) $+    fail "chart cache did not reuse unchanged content"+  changed <- render (withFontMetrics base larger)+  unless (changed /= first) $+    fail "chart cache ignored changed font metrics"+  independent <- render (withFontMetrics other larger)+  unless (independent == first) $+    fail "chart cache version leaked across contexts"++testRendering :: Context -> Input -> IO ()+testRendering ctx inp = do+  let+    ok d = drawIndexCount d > 0 && not (drawCmdNull d)+  (_, _, filled, _) <-+    runFrame ctx inp $+      diagram (fixedWH 200 80) (circle 1 # fc coral # lw none)+  unless (ok filled) $+    fail "diagram produced no draw commands"+  (_, _, filledAgain, _) <-+    runFrame ctx inp $+      diagram (fixedWH 200 80) (circle 1 # fc coral # lw none)+  unless (ok filledAgain) $+    fail "cached diagram produced no draw commands"++linePlotDiag :: FontMetrics -> [(Double, Double)] -> Diagram B+linePlotDiag fm pts =+  chartDia fm (bareChart [line "s" pts])+    # lwO 2+    # fc steelblue++triArea :: (Float, Float) -> (Float, Float) -> (Float, Float) -> Float+triArea (x0, y0) (x1, y1) (x2, y2) =+  abs ((x0 - x2) * (y1 - y0) - (x0 - x1) * (y2 - y0)) * 0.5++testIndexedTriangulation :: IO ()+testIndexedTriangulation = do+  forM_ [[], [(0, 0)], [(0, 0), (1, 1)], [(0, 0), (1, 1), (0, 0)]] $ \pts ->+    unless (null (triangulatePolygon pts)) $+      fail "undersized polygon emitted triangles"+  -- Alternating radii exercise repeated ear removal and wraparound indices.+  forM_ [3, 16, 127, 256 :: Int] $ \n -> do+    let+      points =+        [ let+            angle = 2 * pi * fromIntegral i / fromIntegral n+            radius = if even i then 10 else 6+           in+            (radius * cos angle, radius * sin angle)+        | i <- [0 .. n - 1]+        ]+      polygonArea =+        abs+          (sum [x * y' - x' * y | ((x, y), (x', y')) <- zip points (drop 1 (cycle points))])+          / 2+    forM_ [points, reverse points, points ++ take 1 points] $ \pts -> do+      let+        triangles = triangulatePolygon pts+        areaSum = sum [triArea a b c | (a, b, c) <- triangles]+      unless (length triangles == n - 2 && abs (areaSum - polygonArea) < 0.01) $+        fail+          ( "indexed triangulation changed polygon coverage: "+              ++ show (n, length triangles, areaSum, polygonArea)+          )++testStrokeCoversMidpoint :: IO ()+testStrokeCoversMidpoint = do+  let+    col = themeRed defaultTheme+    ops = strokePolyline col 2 False [(0, 0), (20, 0), (20, 20)]+    tris =+      [ ((x0, y0), (x1, y1), (x2, y2))+      | FillTriangle x0 y0 x1 y1 x2 y2 _ <- ops+      ]+    covered p = any (inTri p) tris+  unless (covered (10, 0) && covered (1, 0) && covered (20, 10)) $+    fail "stroke polyline left a gap along the segment"++inTri ::+  (Float, Float) -> ((Float, Float), (Float, Float), (Float, Float)) -> Bool+inTri p (a, b, c) =+  let+    s = triArea a b c+    s' = triArea p b c + triArea a p c + triArea a b p+   in+    s > 1e-6 && abs (s' - s) <= 1e-3++testNiceTicks :: IO ()+testNiceTicks = do+  let+    t0 = niceTicks 6 (Domain 0 100)+    t1 = niceTicks 6 (Domain (-5) 5)+  unless+    ( maybe False (<= 0) (listToMaybe t0)+        && maybe False (>= 100) (listToMaybe (reverse t0))+    ) $+    fail "nice ticks failed for [0,100]"+  unless (any (== 0) t1) $+    fail "nice ticks failed for [-5,5]"+  unless (formatTick 6 == "6") $+    fail "formatTick integer"+  unless (formatTick 0.2 == "0.2" && formatTick 0.4 == "0.4") $+    fail "formatTick fractional"+  unless (formatTick (0.2 + 0.2 + 0.2) == "0.6") $+    fail "formatTick binary residue"+  unless (formatTick 0.0008 == "0.0008") $+    fail "formatTick small decimal"+  unless (formatTick 1e308 == "1.000e308" && formatTick (-1e308) == "-1.000e308") $+    fail "formatTick overflowed while snapping a finite value"+  unless+    ( niceTicks 6 (Domain (-1e308) 1e308) == []+        && niceTicks 6 (Domain 1e308 1e308) == [1e308]+        && niceTicks 0 (Domain 0 100) == []+    )+    $ fail "niceTicks failed on overflowing, singleton, or empty-budget domains"++testMultiSeriesDomains :: IO ()+testMultiSeriesDomains = do+  let+    s1 = line "a" (V.fromList [(0, 0), (1, 1)])+    s2 = line "b" [(0, 10), (1, 20)]+    (Domain xLo xHi, Domain yLo yHi) = seriesDomains (bareChart [s1, s2])+  unless (yLo <= 0 && yHi >= 20 && xLo <= 0 && xHi >= 1) $+    fail "multi-series domains do not share bounds"+  unless (mergeDomains (Domain 0 1) (Domain 0 10) == Domain 0 10) $+    fail "mergeDomains broken"+  let+    (Domain fitXLo _, Domain fitYLo _) = seriesDomains (bareChart [scatter "s" [(4, 3), (9, 8)]])+  unless (fitXLo > 2 && fitYLo > 1) $+    fail "seriesDomains seeded with 0..1"++testLttb :: IO ()+testLttb = do+  let+    pts =+      V.fromList+        [(fromIntegral i, sin (fromIntegral i / 10)) | i <- [0 .. 9999 :: Int]]+    out = lttb 500 pts+  unless (V.length out == 500) $+    fail "LTTB did not downsample to target count"+  let+    ys = toList (V.map snd out)+  unless (minimum ys < -0.5 && maximum ys > 0.5) $+    fail "LTTB lost waveform extrema"+  let+    spike = V.fromList [(x, if x == 1 then 10 else 0) | x <- [0 .. 9]]+  unless (lttb 3 spike == V.fromList [(0, 0), (1, 10), (9, 0)]) $+    fail "LTTB skipped the first bucket's spike"+  forM_ [0 .. 60] $ \n -> forM_ [-1 .. n + 1] $ \k -> do+    let+      input = V.generate n (\i -> (fromIntegral i, sin (fromIntegral i)))+      sampled = lttb k input+    unless (V.length sampled == min n (max 0 k) && orderedPoints sampled) $+      fail "LTTB violated its point budget or input order"+    unless (V.null sampled || V.head sampled == V.head input) $+      fail "LTTB lost the first endpoint"+    unless (V.length sampled < 2 || V.last sampled == V.last input) $+      fail "LTTB lost the last endpoint"++testMinMaxDecimate :: IO ()+testMinMaxDecimate = do+  unless+    (minMaxDecimate 1 (V.fromList [(0, 2), (1, 2), (2, 2)]) == V.singleton (0, 2)) $+    fail "min/max decimation changed equal-extrema tie handling"+  let+    descending = V.fromList [(x, 9 - x) | x <- [0 .. 8]]+  unless+    (minMaxDecimate 2 descending == V.fromList [(0, 9), (4, 5), (5, 4), (8, 1)]) $+    fail "min/max decimation lost extrema or reversed their order"+  forM_ [0 .. 60] $ \n -> forM_ [-1 .. n + 1] $ \k -> do+    let+      input = V.generate n (\i -> (fromIntegral i, sin (fromIntegral i)))+      sampled = minMaxDecimate k input+    unless (V.length sampled <= max 0 (2 * k) && orderedPoints sampled) $+      fail "min/max decimation violated its bucket budget or input order"+    unless (V.all (`V.elem` input) sampled) $+      fail "min/max decimation invented a point"+    unless+      ( V.null sampled+          || ( V.minimum (V.map snd input) == V.minimum (V.map snd sampled)+                 && V.maximum (V.map snd input) == V.maximum (V.map snd sampled)+             )+      )+      $ fail "min/max decimation lost a global extremum"++orderedPoints :: V.Vector (Double, Double) -> Bool+orderedPoints points = V.and (V.zipWith (\a b -> fst a < fst b) points (V.drop 1 points))++testLabelFit :: FontMetrics -> IO ()+testLabelFit fm = do+  let+    dump = chartDia fm barChartSample+    fitted = fitLayout fm (fixedH 180 defaultLayout) dump+    ops =+      case (layoutWidth fitted, layoutHeight fitted) of+        (Fixed bw, Fixed bh) -> diagramOps (realToFrac bw) (realToFrac bh) dump+        _ -> emptySmallArray+    texts = [(x, y, ax, ay, t) | DrawText x y ax ay t _ <- toList ops]+    xs = [x | (x, _, _, _, _) <- texts]+    boxes = [drawTextBox fm x y ax ay t | (x, y, ax, ay, t) <- texts]+  unless (length xs >= 3 && maximum xs - minimum xs > 20) $+    fail "axis labels did not spread along x"+  unless (not (or [rectsOverlap a b | (a : rest) <- tails boxes, b <- rest])) $+    fail "axis label boxes overlap"+  let+    sleepChart =+      (bareChart [scatter "focus" [(4, 3), (9, 8)], line "trend" [(4, 3), (9, 8)]])+        { chartLegend = LegendRight+        , chartYTitle = Just "focus"+        , chartXTitle = Just "hours slept"+        }+    legendDump = chartDia fm sleepChart+    legendOps = diagramOps 400 240 legendDump+    tightOps = diagramOps 220 150 legendDump+    barTightOps = diagramOps 220 150 dump+    botChart = sleepChart {chartLegend = LegendBottom}+    botOps = diagramOps 400 240 (chartDia fm botChart)+    tickText t =+      T.all (\c -> c == '-' || c == '.' || c >= '0' && c <= '9') t && not (T.null t)+    overlapTitleTick chart w h drawOps =+      let+        ts =+          [(drawTextBox fm x y ax ay t, t) | DrawText x y ax ay t _ <- toList drawOps]+        titles =+          [ b+          | (b@(Rect bx by _ _), t) <- ts+          , (chartXTitle chart == Just t && by < h * 0.45)+              || (chartYTitle chart == Just t && bx < w * 0.4)+          ]+        ticks = [b | (b, t) <- ts, tickText t]+       in+        or [rectsOverlap a b | a <- titles, b <- ticks]+    overlapLegendTick chart w h drawOps =+      let+        names = map seriesName (chartSeries chart)+        ts =+          [(drawTextBox fm x y ax ay t, t) | DrawText x y ax ay t _ <- toList drawOps]+        legends =+          [ b+          | (b@(Rect bx by _ _), t) <- ts+          , t `elem` names+          , case chartLegend chart of+              LegendRight -> bx > w * 0.55+              LegendBottom -> by < h * 0.45+              _ -> False+          ]+        ticks = [b | (b, t) <- ts, tickText t]+       in+        or [rectsOverlap a b | a <- legends, b <- ticks]+  unless (not (overlapTitleTick sleepChart 400 240 legendOps)) $+    fail "axis titles overlap ticks"+  unless (not (overlapLegendTick sleepChart 400 240 legendOps)) $+    fail "legend overlaps ticks"+  unless (not (overlapTitleTick sleepChart 220 150 tightOps)) $+    fail "axis titles overlap ticks on a small plot"+  unless (not (overlapTitleTick barChartSample 220 150 barTightOps)) $+    fail "bar axis titles overlap ticks on a small plot"+  unless (not (overlapTitleTick botChart 400 240 botOps)) $+    fail "axis titles overlap ticks with bottom legend"+  unless (not (overlapLegendTick botChart 400 240 botOps)) $+    fail "bottom legend overlaps ticks"+  let+    shortTitles =+      (bareChart [line "sin(x)" [(0, 0), (1, 1)]])+        { chartLegend = LegendRight+        , chartYTitle = Just "y"+        , chartXTitle = Just "x"+        }+    shortM = chartMargins fm shortTitles+  unless (marginLeft shortM < 0.85 && marginBottom shortM < 0.65) $+    fail "short axis titles left a huge gutter"++barChartSample :: Chart+barChartSample =+  (bareChart [bar "count" [("Mon", 2), ("Tue", 5), ("Wed", 4), ("Thu", 7), ("Fri", 3)]])+    { chartXTitle = Just "day"+    , chartYTitle = Just "count"+    , chartLegend = LegendRight+    , chartGrid = GridBoth+    }++testPlotHover :: IO ()+testPlotHover = do+  let hoverAt c = nearestPlotHover (seriesDomains c) (map (seriesPoints c) (chartSeries c)) 0.5 0.5+  forM_ [bareChart [], bareChart [line "empty" []]] $ \chart ->+    unless (hoverAt chart == Nothing) $+      fail "empty chart produced a hover target"+  let+    tied = bareChart [line "first" [(0, 0), (0, 0)], line "second" [(0, 0)]]+  unless+    ( fmap (\h -> (hoverSeriesIdx h, hoverPointIdx h)) (hoverAt tied)+        == Just (0, 0)+    ) $+    fail "equidistant hover targets did not prefer the first point"+  case hoverAt (bareChart [line "a" [(0, 0), (1, 1), (2, 4)]]) of+    Nothing -> fail "nearestPlotHover missed center point"+    Just h ->+      unless+        ( hoverSeriesIdx h == 0+            && hoverPointIdx h == 1+            && hoverDataX h == 1+            && hoverDataY h == 1+        ) $+        fail "nearestPlotHover picked wrong point"++-- Empty series isolate the legend strokes from data geometry. Every placement+-- must retain the labels and use the same color overrides as the series.+testLegendColors :: FontMetrics -> IO ()+testLegendColors fm = do+  let+    custom = colorRGBA 17 211 83 255+    chart = bareChart [withColor custom (line "custom" []), line "default" []]+    fallback = themeSeries defaultTheme !! 1+  forM_ [LegendNone, LegendRight, LegendBottom, LegendTop, LegendInside] $ \position -> do+    let+      ops = toList (diagramOps 400 280 (chartDia fm chart {chartLegend = position}))+      labels =+        [text | DrawText _ _ _ _ text _ <- ops, text == "custom" || text == "default"]+      colors = [color | FillTriangle _ _ _ _ _ _ color <- ops]+    if position == LegendNone+      then+        unless (null labels && custom `notElem` colors) $+          fail "hidden legend rendered entries"+      else do+        unless (length labels == 2 && "custom" `elem` labels && "default" `elem` labels) $+          fail "legend lost or duplicated a series label"+        unless (custom `elem` colors && fallback `elem` colors) $+          fail "legend colors differ from series colors"++fillTriCount :: SmallArray DrawOp -> Int+fillTriCount ops = length [() | FillTriangle {} <- toList ops]++testClosedSeriesFills :: FontMetrics -> IO ()+testClosedSeriesFills fm = do+  let+    seriesOps s = diagramOps 200 120 (chartDia fm (bareChart [s]))+    areaOps = seriesOps (area "a" [(0, 1), (1, 2), (2, 0)])+    diamondOps = seriesOps (withMarker MarkDiamond (scatter "d" [(1, 1), (2, 3)]))+    triOps = seriesOps (withMarker MarkTriangle (scatter "t" [(1, 1)]))+    crossOps = seriesOps (withMarker MarkCross (scatter "x" [(8, 8)]))+    ink = fromMaybe (themeRed defaultTheme) (listToMaybe (themeSeries defaultTheme))+    inkXs =+      [ x+      | FillTriangle x0 _ x1 _ x2 _ c <- toList crossOps+      , c == ink+      , x <- [x0, x1, x2]+      ]+  unless (fillTriCount areaOps >= 2) $+    fail "area series produced no fill triangles"+  unless (fillTriCount diamondOps >= 2) $+    fail "diamond marker produced no fill"+  unless (fillTriCount triOps >= 1) $+    fail "triangle marker produced no fill"+  unless (not (null inkXs) && maximum inkXs - minimum inkXs < 40) $+    fail "MarkCross arm left at origin"++testGrowPlotHeight :: FontMetrics -> IO ()+testGrowPlotHeight fm = do+  let+    fitted = fitLayout fm (fillW defaultLayout) (chartDia fm barChartSample)+  unless (layoutMinH fitted <= 260 && layoutMaxH fitted <= 260) $+    fail "plot grow height ballooned"