From cef68caf592c0208b65f332fa4be5a88b47f9fe5 Mon Sep 17 00:00:00 2001 From: hill Date: Thu, 7 May 2026 23:49:13 +0200 Subject: [PATCH 1/5] Add Elm graph scaffold --- quartz-local/elm-graph/component.ts | 0 quartz-local/elm-graph/elm.json | 24 ++++++++++++++++++++++++ quartz-local/elm-graph/index.ts | 0 quartz-local/elm-graph/package.json | 26 ++++++++++++++++++++++++++ quartz-local/elm-graph/src/Main.elm | 0 5 files changed, 50 insertions(+) create mode 100644 quartz-local/elm-graph/component.ts create mode 100644 quartz-local/elm-graph/elm.json create mode 100644 quartz-local/elm-graph/index.ts create mode 100644 quartz-local/elm-graph/package.json create mode 100644 quartz-local/elm-graph/src/Main.elm diff --git a/quartz-local/elm-graph/component.ts b/quartz-local/elm-graph/component.ts new file mode 100644 index 00000000..e69de29b diff --git a/quartz-local/elm-graph/elm.json b/quartz-local/elm-graph/elm.json new file mode 100644 index 00000000..3194cb20 --- /dev/null +++ b/quartz-local/elm-graph/elm.json @@ -0,0 +1,24 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.1" + }, + "indirect": { + "elm/json": "1.1.4", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.5" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/quartz-local/elm-graph/index.ts b/quartz-local/elm-graph/index.ts new file mode 100644 index 00000000..e69de29b diff --git a/quartz-local/elm-graph/package.json b/quartz-local/elm-graph/package.json new file mode 100644 index 00000000..988c4da6 --- /dev/null +++ b/quartz-local/elm-graph/package.json @@ -0,0 +1,26 @@ +{ + "name": "@hill/quartz-elm-graph", + "version": "1.0.0", + "type": "module", + "exports": { + ".": "./index.ts", + "./components": "./components.ts" + }, + "quartz": { + "name": "elm-graph", + "displayName": "Elm Graph", + "description": "Elm-powered Quartz graph component.", + "version": "1.0.0", + "category": [ + "component" + ], + "components": { + "ElmGraph": { + "name": "ElmGraph", + "displayName": "Elm Graph", + "description": "Interactive site graph rendered with Elm.", + "version": "1.0.0" + } + } + } +} \ No newline at end of file diff --git a/quartz-local/elm-graph/src/Main.elm b/quartz-local/elm-graph/src/Main.elm new file mode 100644 index 00000000..e69de29b From c7c100604f4920383429f12d737427a51a696f84 Mon Sep 17 00:00:00 2001 From: hill Date: Thu, 7 May 2026 23:49:13 +0200 Subject: [PATCH 2/5] Add Elm graph scaffold --- quartz-local/elm-graph/component.ts | 0 quartz-local/elm-graph/elm.json | 24 ++++++++++++++++++++++++ quartz-local/elm-graph/index.ts | 0 quartz-local/elm-graph/package.json | 26 ++++++++++++++++++++++++++ quartz-local/elm-graph/src/Main.elm | 0 5 files changed, 50 insertions(+) create mode 100644 quartz-local/elm-graph/component.ts create mode 100644 quartz-local/elm-graph/elm.json create mode 100644 quartz-local/elm-graph/index.ts create mode 100644 quartz-local/elm-graph/package.json create mode 100644 quartz-local/elm-graph/src/Main.elm diff --git a/quartz-local/elm-graph/component.ts b/quartz-local/elm-graph/component.ts new file mode 100644 index 00000000..e69de29b diff --git a/quartz-local/elm-graph/elm.json b/quartz-local/elm-graph/elm.json new file mode 100644 index 00000000..3194cb20 --- /dev/null +++ b/quartz-local/elm-graph/elm.json @@ -0,0 +1,24 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.1" + }, + "indirect": { + "elm/json": "1.1.4", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.5" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/quartz-local/elm-graph/index.ts b/quartz-local/elm-graph/index.ts new file mode 100644 index 00000000..e69de29b diff --git a/quartz-local/elm-graph/package.json b/quartz-local/elm-graph/package.json new file mode 100644 index 00000000..988c4da6 --- /dev/null +++ b/quartz-local/elm-graph/package.json @@ -0,0 +1,26 @@ +{ + "name": "@hill/quartz-elm-graph", + "version": "1.0.0", + "type": "module", + "exports": { + ".": "./index.ts", + "./components": "./components.ts" + }, + "quartz": { + "name": "elm-graph", + "displayName": "Elm Graph", + "description": "Elm-powered Quartz graph component.", + "version": "1.0.0", + "category": [ + "component" + ], + "components": { + "ElmGraph": { + "name": "ElmGraph", + "displayName": "Elm Graph", + "description": "Interactive site graph rendered with Elm.", + "version": "1.0.0" + } + } + } +} \ No newline at end of file diff --git a/quartz-local/elm-graph/src/Main.elm b/quartz-local/elm-graph/src/Main.elm new file mode 100644 index 00000000..e69de29b From 0579b2f878fd15fc09efa1349d6cc9619bd75b06 Mon Sep 17 00:00:00 2001 From: hill Date: Wed, 26 Aug 2026 15:39:59 +0200 Subject: [PATCH 3/5] Draw the site graph in Elm rather than d3 and pixi The scaffold from May had five files in it, two of them empty. This is the graph. What it replaces is github:quartz-community/graph, which draws a good picture and fetches d3 and pixi.js from jsDelivr to do it: about a megabyte and a half of somebody else's JavaScript, from a third party, on every page view, before a single node appears. Its script opens with `@ts-nocheck`, so none of it is checked by anything. The reader's IP reaches a CDN whether or not they ever look at the sidebar. This is 54 KB of compiled Elm, 19 KB over the wire, served from here and fetched only on a page that has a graph on it. It draws SVG, so the browser does the compositing and the stylesheet does the colour -- `is-current`, `is-tag`, `is-visited`, `is-hovered`, `is-dim` -- where the old one read six custom properties out of getComputedStyle at startup and had to be told to rebuild itself when the theme changed. The forces are d3-force's on purpose, so the graph settles into the shape it used to: the same charge, link, centring and collision, the same alpha decay. Two things are not d3's. Nothing is random -- positions come from the phyllotaxis spiral d3 keeps as a fallback, so a page draws the same graph every time it is opened -- and the first layout is run before anything is drawn. A simulation starting from its seed positions spends its first second looking like an explosion, and a graph in a background tab is handed no animation frames at all, so without it the sidebar would sit there as a spiral. That runs against a budget of node pairs rather than a fixed number of steps: a step compares every node with every other, so the whole-site graph's 94 nodes cost 4,000 times what the sidebar's three do. Opening it blocked the page for 376 ms before the budget and 52 ms after it, and the sidebar still settles completely in 4 ms. prefers-reduced-motion gets the layout finished and left still. Elm owns the graph and nothing else; four ports carry what belongs to the page. `follow` hands a clicked node's id back so Quartz's own router does the navigating -- a node is an SVG `` for focus and for the accessibility tree, but the router reads `href` off the anchor a click came from and on an SVG anchor that is an SVGAnimatedString rather than a string, so the anchor carries data-router-ignore and the id goes out through the port instead. `halt` exists because a soft navigation patches the sidebar back to the empty container the incoming page has, taking the drawing with it and leaving the app rendering into nothing; it is stopped and another is started around the page the reader arrived at. Drag and zoom are not ported yet. `scale` is gone for good: it was a pixi camera setting with nothing to configure in an SVG. The build gets `site elm`, which is `elm make` and then esbuild -- Elm's own guide is explicit that --optimize does no minifying and that the output is meant to be handed to a minifier, and the compiler guarantees there is no eval or reflection in it to be broken by one. `site wasm` calls it, since content/js is the directory it empties and fills. The one thing that needed care is that Elm ends its output by calling itself with `this`: fine in a script tag, undefined in a module, and esbuild reads it as a module and folds it to `}(void 0));`, which dies reading Elm of undefined. It is repointed at globalThis, with a test that fails loudly if a future compiler stops emitting that tail rather than skipping it. elm is in the flake's dev shell now, which means CI compiles it and so needs package.elm-lang.org to be reachable the first time. --- .gitignore | 3 + flake.nix | 1 + quartz-local/elm-graph/README.md | 106 +++ quartz-local/elm-graph/component.ts | 0 quartz-local/elm-graph/components.ts | 105 +++ quartz-local/elm-graph/elm.json | 39 +- quartz-local/elm-graph/index.ts | 1 + quartz-local/elm-graph/package.json | 14 +- quartz-local/elm-graph/src/Main.elm | 1010 ++++++++++++++++++++++++++ quartz-local/elm-graph/styles.ts | 136 ++++ quartz.config.yaml | 8 +- quartz/components/renderPage.tsx | 3 + tools/site/src/build.rs | 4 + tools/site/src/elm.rs | 174 +++++ tools/site/src/main.rs | 3 + tools/site/src/process.rs | 2 +- ts/src/graph.ts | 317 ++++++++ ts/webpack.config.ts | 1 + 18 files changed, 1896 insertions(+), 31 deletions(-) create mode 100644 quartz-local/elm-graph/README.md delete mode 100644 quartz-local/elm-graph/component.ts create mode 100644 quartz-local/elm-graph/components.ts create mode 100644 quartz-local/elm-graph/styles.ts create mode 100644 tools/site/src/elm.rs create mode 100644 ts/src/graph.ts diff --git a/.gitignore b/.gitignore index c6833450..6f2eeb31 100644 --- a/.gitignore +++ b/.gitignore @@ -19,5 +19,8 @@ content/.trash/ content/.obsidian/ content/js + +# The Elm compiler's package cache for quartz-local/elm-graph. +elm-stuff/ content/tools/wasm/ content/.stfolder \ No newline at end of file diff --git a/flake.nix b/flake.nix index b0f8d47d..153f669a 100644 --- a/flake.nix +++ b/flake.nix @@ -28,6 +28,7 @@ cargo-edit cargo-hack clang + elmPackages.elm git gcc gnugrep diff --git a/quartz-local/elm-graph/README.md b/quartz-local/elm-graph/README.md new file mode 100644 index 00000000..2b265cba --- /dev/null +++ b/quartz-local/elm-graph/README.md @@ -0,0 +1,106 @@ +# elm-graph + +The site graph, drawn in Elm. + +Quartz's graph is a community plugin, `github:quartz-community/graph`. It draws +a good picture, and to draw it the page fetches **d3 and pixi.js from jsDelivr** +— about a megabyte and a half of somebody else's JavaScript, from a third party, +on every page view — and paints into a WebGL canvas. Its script opens with +`@ts-nocheck`, so none of it is type-checked, and the reader's IP address goes +to a CDN before a single node is drawn. + +This draws the same picture out of SVG, from a compiled Elm program served from +this site. **54 KB, 19 KB over the wire**, fetched only on a page that has a +graph on it. + +## What is where + +| file | what it is | +| ----------------------------- | --------------------------------------------------------------------------------- | +| `src/Main.elm` | the graph: neighbourhood, force simulation, SVG, hover, click | +| `components.ts` | the Quartz component — two empty containers and the button that opens the big one | +| `styles.ts` | what a node, a link and a label look like in each theme | +| `../../ts/src/graph.ts` | the page's side: the content index, the box's size, visited pages, navigation | +| `../../tools/site/src/elm.rs` | `site elm`, which compiles `Main.elm` into `content/js/elm.js` | + +Nothing here is hand-compiled: `site build` and `site wasm` both run `site elm`, +and `content/js` is a build output. + +## The layout + +The forces are d3-force's, deliberately, so the graph settles into the shape the +old one settled into: charge at `-100 × repelForce`, links pulling towards +`linkDistance` with d3's own strength and bias, a centring force that moves +positions rather than velocities, one pass of collision, and the same alpha +decay of 0.0228 per tick down to 0.001. + +Two things are not d3's: + +- **Nothing is random.** d3 seeds positions with `Math.random`; this uses the + phyllotaxis spiral d3 falls back to for a node with no position, so the same + page draws the same graph every time it is opened. +- **The first layout is run before anything is drawn**, against a budget of + about 110,000 node-pair steps. A simulation that starts from its seed + positions spends its first second looking like an explosion, which in a + sidebar is movement for its own sake; and a graph in a background tab gets no + animation frames at all, so without this it would sit there as a spiral of + untouched seed positions. The budget is what keeps that cheap: a step compares + every node with every other, so the whole-site graph — 94 nodes against the + sidebar's three — gets twelve steps where the sidebar gets its full three + hundred and settles completely. + +A reader who has asked for `prefers-reduced-motion` gets the layout settled and +still, rather than performed at them. + +## Colour + +There is none in the Elm. A node is a `circle` with `is-current`, `is-tag`, +`is-visited`, `is-hovered` or `is-dim` on it, and `styles.ts` says what those +mean in `var(--secondary)` and friends. The graph this replaced read six custom +properties out of `getComputedStyle` when it started and painted them into a +WebGL scene, which is why it had to be told to rebuild itself when the theme +changed; this one is repainted by the browser like anything else on the page. + +## The four ports + +Elm owns the graph and nothing else. Everything that is the page's job crosses a +port: + +| port | direction | what it carries | +| --------- | --------- | ----------------------------------------------------------------- | +| `follow` | out | the id of a clicked node, which the page hands to Quartz's router | +| `failed` | out | why flags could not be read, for the console | +| `resized` | in | the container's size, from a `ResizeObserver` | +| `halt` | in | stop: this app's view has been patched out of the page | + +`halt` exists because of how Quartz navigates. It patches the document rather +than replacing it, so after a soft navigation the container is the same element +— with the drawing taken out of it by micromorph, because the incoming page's +HTML has an empty one. The app rendering into it is left holding a view that is +no longer in the page, so `graph.ts` stops it and starts another around the page +the reader has arrived at. + +Clicks are the other place the two sides meet. A node is an SVG ``, so +it can be focused and read as a link — but Quartz's router reads `href` off +whatever anchor a click came from, and on an SVG anchor that is an +`SVGAnimatedString` rather than a string. The anchor carries `data-router-ignore` +to keep the router's hands off it, and Elm sends the id out through `follow` +instead, which the page turns into a URL the router can read. + +## What is not ported + +The old graph could be dragged and zoomed. This cannot, yet — the picture, the +neighbourhood, the highlighting, the whole-site graph and the visited colouring +are all here, and drag and zoom are the two things left. `scale` is gone for +good: it was a pixi camera setting with nothing to configure in an SVG. + +## Building it + +```sh +cargo run --locked --manifest-path tools/site/Cargo.toml -- elm --prod +``` + +`--dev` skips `--optimize` and the esbuild pass, so the JavaScript in the +debugger is the JavaScript on disk. The compiler is `elmPackages.elm` in the +flake's dev shell; `elm-stuff/` beside this file is its package cache and is +ignored. diff --git a/quartz-local/elm-graph/component.ts b/quartz-local/elm-graph/component.ts deleted file mode 100644 index e69de29b..00000000 diff --git a/quartz-local/elm-graph/components.ts b/quartz-local/elm-graph/components.ts new file mode 100644 index 00000000..d05156d0 --- /dev/null +++ b/quartz-local/elm-graph/components.ts @@ -0,0 +1,105 @@ +/** + * The box the Elm graph is drawn in. + * + * Everything here is empty: two containers carrying the settings the graph + * should be built with, and a button that opens the second one. `/js/graph.js` + * reads the content index and starts `/js/elm.js` on them -- see + * `src/Main.elm` for the graph itself, and the README for why it is in Elm. + * + * The containers are empty on purpose rather than by accident of being drawn + * later: with the script blocked there is no half-graph and no empty framed + * box, because the CSS gives the box its border only once something is in it. + */ + +import { h } from "preact" +import type { + QuartzComponent, + QuartzComponentConstructor, + QuartzComponentProps, +} from "../../quartz/components/types" +import { classNames } from "@quartz-community/utils" +import { styles } from "./styles" + +/** + * The knobs the old graph had, kept name for name so that a config written + * against it means the same thing here. Two are gone: `drag` and `zoom`, which + * this does not do yet, and `scale`, which was a pixi camera setting. + */ +export interface GraphConfig { + /** How many links away from this page to draw. Negative draws the site. */ + depth: number + repelForce: number + centerForce: number + linkDistance: number + /** Dim everything that is not the hovered node or a neighbour of it. */ + focusOnHover: boolean + /** Pull the nodes onto a ring, which keeps the site graph from knotting. */ + enableRadial: boolean + showTags: boolean + removeTags: string[] +} + +export interface GraphOptions { + localGraph?: Partial + globalGraph?: Partial +} + +const local: GraphConfig = { + depth: 1, + repelForce: 0.5, + centerForce: 0.3, + linkDistance: 30, + focusOnHover: false, + enableRadial: false, + showTags: true, + removeTags: [], +} + +const global: GraphConfig = { + depth: -1, + repelForce: 0.5, + centerForce: 0.2, + linkDistance: 30, + focusOnHover: true, + enableRadial: true, + showTags: true, + removeTags: [], +} + +/** Three nodes and two links: the picture the button opens, in 16 pixels. */ +const icon = h("svg", { viewBox: "0 0 16 16", width: "16", height: "16", "aria-hidden": "true" }, [ + h("line", { x1: "4", y1: "12", x2: "8", y2: "4", stroke: "currentColor", "stroke-width": "1" }), + h("line", { x1: "8", y1: "4", x2: "12", y2: "11", stroke: "currentColor", "stroke-width": "1" }), + h("circle", { cx: "8", cy: "3.5", r: "2.5", fill: "currentColor" }), + h("circle", { cx: "3.5", cy: "12.5", r: "2.5", fill: "currentColor" }), + h("circle", { cx: "12.5", cy: "11.5", r: "2.5", fill: "currentColor" }), +]) + +export const ElmGraph: QuartzComponentConstructor = (opts) => { + const Component: QuartzComponent = ({ displayClass }: QuartzComponentProps) => { + const near = JSON.stringify({ ...local, ...opts?.localGraph }) + const whole = JSON.stringify({ ...global, ...opts?.globalGraph }) + + return h("div", { class: classNames(displayClass, "elm-graph") }, [ + h("h3", null, "Graph"), + h("div", { class: "elm-graph-outer" }, [ + h("div", { class: "elm-graph-container", "data-cfg": near }), + h( + "button", + { type: "button", class: "elm-graph-expand", "aria-label": "Graph of the whole site" }, + icon, + ), + ]), + h( + "div", + { class: "elm-graph-modal", hidden: true }, + h("div", { class: "elm-graph-container is-global", "data-cfg": whole }), + ), + ]) + } + + Component.css = styles + return Component +} + +export default ElmGraph diff --git a/quartz-local/elm-graph/elm.json b/quartz-local/elm-graph/elm.json index 3194cb20..482f8ff2 100644 --- a/quartz-local/elm-graph/elm.json +++ b/quartz-local/elm-graph/elm.json @@ -1,24 +1,23 @@ { - "type": "application", - "source-directories": [ - "src" - ], - "elm-version": "0.19.1", - "dependencies": { - "direct": { - "elm/browser": "1.0.2", - "elm/core": "1.0.5", - "elm/html": "1.0.1" - }, - "indirect": { - "elm/json": "1.1.4", - "elm/time": "1.0.0", - "elm/url": "1.0.0", - "elm/virtual-dom": "1.0.5" - } + "type": "application", + "source-directories": ["src"], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.1", + "elm/json": "1.1.4", + "elm/svg": "1.0.1" }, - "test-dependencies": { - "direct": {}, - "indirect": {} + "indirect": { + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.5" } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } } diff --git a/quartz-local/elm-graph/index.ts b/quartz-local/elm-graph/index.ts index e69de29b..e39033a2 100644 --- a/quartz-local/elm-graph/index.ts +++ b/quartz-local/elm-graph/index.ts @@ -0,0 +1 @@ +export function init(): void {} diff --git a/quartz-local/elm-graph/package.json b/quartz-local/elm-graph/package.json index 988c4da6..0cb7564d 100644 --- a/quartz-local/elm-graph/package.json +++ b/quartz-local/elm-graph/package.json @@ -9,18 +9,18 @@ "quartz": { "name": "elm-graph", "displayName": "Elm Graph", - "description": "Elm-powered Quartz graph component.", + "description": "The site graph, drawn in Elm: the neighbourhood, the force simulation and the SVG are all compiled from quartz-local/elm-graph/src/Main.elm, with no d3 and no pixi.js fetched from a CDN.", "version": "1.0.0", - "category": [ - "component" - ], + "category": "component", "components": { "ElmGraph": { "name": "ElmGraph", "displayName": "Elm Graph", - "description": "Interactive site graph rendered with Elm.", - "version": "1.0.0" + "description": "Interactive site graph, drawn as SVG by a compiled Elm program.", + "version": "1.0.0", + "defaultPosition": "right", + "defaultPriority": 10 } } } -} \ No newline at end of file +} diff --git a/quartz-local/elm-graph/src/Main.elm b/quartz-local/elm-graph/src/Main.elm index e69de29b..1a09f690 100644 --- a/quartz-local/elm-graph/src/Main.elm +++ b/quartz-local/elm-graph/src/Main.elm @@ -0,0 +1,1010 @@ +port module Main exposing (main) + +{-| The site graph, drawn in Elm. + +Quartz's own graph component fetches d3 and pixi.js from a CDN -- a megabyte +and a half of somebody else's JavaScript, pulled from a third party on every +page view, to draw fifty circles -- and its script opens with `@ts-nocheck` +because none of it type-checks. This draws the same picture as SVG, with the +force simulation written here. + +The layout is d3-force's on purpose: the same charge, link, centring and +collision forces, the same alpha decay, so the graph settles into the shape the +old one settled into. What is different is that nothing is random. d3 seeds +positions with `Math.random`; this uses the phyllotaxis spiral d3 falls back to +when a position is missing, so the same page draws the same graph every time it +is opened. + +Colour is left to the stylesheet. The old script read six custom properties out +of `getComputedStyle` when it started, which is why it had to be told to redraw +when the theme changed. Here a node is a circle with a class on it and the CSS +says what that means in each theme. + +-} + +import Array exposing (Array) +import Browser +import Browser.Events +import Dict exposing (Dict) +import Html exposing (Html) +import Html.Attributes +import Html.Events +import Json.Decode as Decode exposing (Decoder) +import Set exposing (Set) +import Svg exposing (Svg) +import Svg.Attributes as Attr +import Svg.Events + + + +-- PORTS + + +{-| The id of a node the reader clicked. The page turns it into a URL and hands +that to Quartz's router, so that following a node is the same soft navigation +as following a link in the prose. The page is also the side that knows which +pages have been visited, so it is the side that writes this one down. +-} +port follow : String -> Cmd msg + + +{-| Said out loud rather than swallowed: flags this cannot read mean a graph +that cannot be drawn, and the reason belongs in the console where whoever +changed the shape of them will see it. +-} +port failed : String -> Cmd msg + + +{-| The container's size, watched by a `ResizeObserver` on the other side. Elm +can hear the window resize but cannot measure a div, and this one lives in a +sidebar that changes width without the window doing anything. +-} +port resized : (Size -> msg) -> Sub msg + + +{-| Stop. + +A soft navigation patches the sidebar back to the empty container the new page +came with -- the same element, with this app's drawing taken out of it -- and +the page starts another app in its place. Without this the old one would go on +running a simulation against a view nobody can see, for as long as its layout +took to settle. +-} +port halt : (() -> msg) -> Sub msg + + +type alias Size = + { width : Float, height : Float } + + + +-- FLAGS + + +type alias Flags = + { slug : String + , base : String + , size : Size + , depth : Int + , showTags : Bool + , removeTags : List String + , repelForce : Float + , centerForce : Float + , linkDistance : Float + , focusOnHover : Bool + , enableRadial : Bool + , reducedMotion : Bool + , visited : List String + , pages : List Page + } + + +type alias Page = + { id : String + , title : String + , links : List String + , tags : List String + } + + +{-| Everything but the page list has a default, because these come from a +config file a reader of this repository is meant to be able to edit. +-} +flagsDecoder : Decoder Flags +flagsDecoder = + let + number name fallback = + Decode.oneOf [ Decode.field name Decode.float, Decode.succeed fallback ] + + yesNo name fallback = + Decode.oneOf [ Decode.field name Decode.bool, Decode.succeed fallback ] + in + Decode.map8 + (\slug base size depth showTags removeTags visited pages -> + { slug = slug + , base = base + , size = size + , depth = depth + , showTags = showTags + , removeTags = removeTags + , visited = visited + , pages = pages + , repelForce = 0.5 + , centerForce = 0.3 + , linkDistance = 30 + , focusOnHover = False + , enableRadial = False + , reducedMotion = False + } + ) + (Decode.field "slug" Decode.string) + (Decode.oneOf [ Decode.field "base" Decode.string, Decode.succeed "" ]) + sizeDecoder + (Decode.oneOf [ Decode.field "depth" Decode.int, Decode.succeed 1 ]) + (yesNo "showTags" True) + (Decode.oneOf [ Decode.field "removeTags" (Decode.list Decode.string), Decode.succeed [] ]) + (Decode.oneOf [ Decode.field "visited" (Decode.list Decode.string), Decode.succeed [] ]) + (Decode.field "pages" (Decode.list pageDecoder)) + |> Decode.andThen + (\partial -> + Decode.map6 + (\repel center distance focus onRing still -> + { partial + | repelForce = repel + , centerForce = center + , linkDistance = distance + , focusOnHover = focus + , enableRadial = onRing + , reducedMotion = still + } + ) + (number "repelForce" 0.5) + (number "centerForce" 0.3) + (number "linkDistance" 30) + (yesNo "focusOnHover" False) + (yesNo "enableRadial" False) + (yesNo "reducedMotion" False) + ) + + +sizeDecoder : Decoder Size +sizeDecoder = + Decode.map2 Size + (Decode.oneOf [ Decode.field "width" Decode.float, Decode.succeed 250 ]) + (Decode.oneOf [ Decode.field "height" Decode.float, Decode.succeed 250 ]) + + +pageDecoder : Decoder Page +pageDecoder = + Decode.map4 Page + (Decode.field "id" Decode.string) + (Decode.oneOf [ Decode.field "title" Decode.string, Decode.succeed "" ]) + (Decode.oneOf [ Decode.field "links" (Decode.list Decode.string), Decode.succeed [] ]) + (Decode.oneOf [ Decode.field "tags" (Decode.list Decode.string), Decode.succeed [] ]) + + + +-- MODEL + + +type Kind + = PageNode + | TagNode + + +type alias Node = + { id : String + , label : String + , kind : Kind + , degree : Int + , x : Float + , y : Float + , vx : Float + , vy : Float + } + + +{-| A link by node index, carrying the two numbers d3 works out for it once: +how hard it pulls, and how that pull is shared between its ends. A page with +one link is moved much further by it than a hub with twenty. +-} +type alias Link = + { source : Int + , target : Int + , strength : Float + , bias : Float + } + + +{-| The flags are kept whole rather than unpacked: the simulation reads its +settings out of them every frame, and a resize writes a new size back into +them. +-} +type alias Model = + { flags : Flags + , nodes : Array Node + , links : List Link + , neighbours : Dict String (Set String) + , alpha : Float + , hovered : Maybe String + , visited : Set String + } + + +type Msg + = Tick + | Hover (Maybe String) + | Follow String + | Resized Size + | Halted + + + +-- THE GRAPH ITSELF + + +{-| Every link on the site, page to page and page to tag, before the +neighbourhood is cut out of it. A link to a page that is not there is dropped, +which is what stops a typo in a wikilink from drawing a node. +-} +allEdges : Flags -> List ( String, String ) +allEdges flags = + let + known = + flags.pages |> List.map .id |> Set.fromList + + removed = + Set.fromList flags.removeTags + + outgoing page = + page.links + |> List.filter (\to -> Set.member to known) + |> List.map (\to -> ( page.id, to )) + + tagged page = + if flags.showTags then + page.tags + |> List.filter (\tag -> not (Set.member tag removed)) + |> List.map (\tag -> ( page.id, "tags/" ++ tag )) + + else + [] + in + flags.pages |> List.concatMap (\page -> outgoing page ++ tagged page) + + +{-| The ids within `depth` steps of the page being read, in either direction +along a link. A negative depth is the whole site, which is what the global +graph asks for. +-} +neighbourhood : Int -> String -> List ( String, String ) -> Set String +neighbourhood depth start edges = + let + adjacency = + List.foldl + (\( from, to ) acc -> acc |> insertNeighbour from to |> insertNeighbour to from) + Dict.empty + edges + + walk remaining frontier seen = + if remaining <= 0 || Set.isEmpty frontier then + seen + + else + let + next = + frontier + |> Set.toList + |> List.concatMap + (\id -> + Dict.get id adjacency + |> Maybe.withDefault Set.empty + |> Set.toList + ) + |> Set.fromList + |> (\found -> Set.diff found seen) + in + walk (remaining - 1) next (Set.union seen next) + in + if depth < 0 then + edges + |> List.concatMap (\( from, to ) -> [ from, to ]) + |> Set.fromList + |> Set.insert start + + else + walk depth (Set.singleton start) (Set.singleton start) + + +insertNeighbour : String -> String -> Dict String (Set String) -> Dict String (Set String) +insertNeighbour from to acc = + Dict.update from + (\existing -> Just (Set.insert to (Maybe.withDefault Set.empty existing))) + acc + + +{-| d3 scatters its starting positions with `Math.random`, and falls back to a +phyllotaxis spiral -- the sunflower-seed arrangement -- for any node whose +position is not a number. That fallback is used here for all of them: it +spreads nodes evenly with no two on top of each other, and it is the same +spiral every time the page opens. +-} +phyllotaxis : Int -> ( Float, Float ) +phyllotaxis index = + let + i = + toFloat index + + distance = + 10 * sqrt (0.5 + i) + + angle = + i * pi * (3 - sqrt 5) + in + ( distance * cos angle, distance * sin angle ) + + +build : Flags -> Model +build flags = + let + edges = + allEdges flags + + inside = + neighbourhood flags.depth flags.slug edges + + kept = + edges |> List.filter (\( from, to ) -> Set.member from inside && Set.member to inside) + + titles = + flags.pages |> List.map (\page -> ( page.id, page.title )) |> Dict.fromList + + degrees = + List.foldl (\( from, to ) acc -> acc |> bump from |> bump to) Dict.empty kept + + ids = + Set.toList inside + + index = + ids |> List.indexedMap (\i id -> ( id, i )) |> Dict.fromList + + node i id = + let + ( x, y ) = + phyllotaxis i + in + { id = id + , label = label titles id + , kind = + if String.startsWith "tags/" id then + TagNode + + else + PageNode + , degree = Dict.get id degrees |> Maybe.withDefault 0 + , x = x + , y = y + , vx = 0 + , vy = 0 + } + + link ( from, to ) = + Maybe.map2 + (\source target -> + let + fromDegree = + Dict.get from degrees |> Maybe.withDefault 1 |> toFloat + + toDegree = + Dict.get to degrees |> Maybe.withDefault 1 |> toFloat + in + { source = source + , target = target + , strength = 1 / max 1 (min fromDegree toDegree) + , bias = fromDegree / max 1 (fromDegree + toDegree) + } + ) + (Dict.get from index) + (Dict.get to index) + in + { flags = flags + , nodes = ids |> List.indexedMap node |> Array.fromList + , links = kept |> List.filterMap link + , neighbours = + List.foldl + (\( from, to ) acc -> acc |> insertNeighbour from to |> insertNeighbour to from) + Dict.empty + kept + , alpha = 1 + , hovered = Nothing + , visited = Set.fromList flags.visited + } + + +bump : String -> Dict String Int -> Dict String Int +bump id acc = + Dict.update id (\existing -> Just (1 + Maybe.withDefault 0 existing)) acc + + +label : Dict String String -> String -> String +label titles id = + if String.startsWith "tags/" id then + "#" ++ String.dropLeft 5 id + + else + case Dict.get id titles of + Just title -> + if String.isEmpty title then + id + + else + title + + Nothing -> + id + + + +-- THE SIMULATION +-- +-- d3-force's numbers in d3-force's order: alpha eases towards zero, each force +-- writes into the velocities, and the positions are integrated last. + + +alphaDecay : Float +alphaDecay = + 0.0228 + + +alphaMin : Float +alphaMin = + 0.001 + + +velocityDecay : Float +velocityDecay = + 0.6 + + +radius : Node -> Float +radius node = + 2 + sqrt (toFloat node.degree) + + +{-| The work the first layout is allowed, counted in node pairs. + +A force simulation that starts from its seed positions spends its first second +looking like an explosion, which in a sidebar is movement for its own sake. d3 +says as much about layouts nobody is going to watch settle: run the ticks +yourself and draw the result. So some of them are run before anything is drawn, +and the animation eases the rest of the way in -- which also means the picture +does not depend on animation frames arriving at all. A graph in a background +tab is drawn laid out rather than as a spiral of untouched seed positions. + +A step compares every node with every other, so a graph twice the size costs +four times as much per step. Fixing the number of steps rather than the work is +what made opening the whole-site graph -- 94 nodes against the sidebar's three +-- block the page for 376 ms; against a budget it is nearer forty, and the +sidebar still settles completely before it is drawn. +-} +layoutBudget : Int +layoutBudget = + 110000 + + +{-| A bound on how long the settling can run, whatever the budget allows, so +that a strange graph cannot spin here forever. +-} +restingSteps : Int +restingSteps = + 600 + + +{-| The layout as it is first drawn: settled as far as the budget goes, or +settled and left still for a reader who has asked for less movement. +-} +lay : Model -> Model +lay model = + let + pairs = + max 1 (Array.length model.nodes ^ 2) + + steps allowance = + clamp 1 restingSteps (allowance // pairs) + in + if model.flags.reducedMotion then + let + rested = + settle (steps (4 * layoutBudget)) model + in + { rested | alpha = 0 } + + else + settle (steps layoutBudget) model + + +{-| Steps until the count runs out, or until the layout has stopped moving. -} +settle : Int -> Model -> Model +settle count model = + if count <= 0 || model.alpha <= alphaMin then + model + + else + settle (count - 1) (step model) + + +step : Model -> Model +step model = + let + alpha = + model.alpha - model.alpha * alphaDecay + + nodes = + model.nodes + |> charge (-100 * model.flags.repelForce) alpha + |> pull alpha model.flags.linkDistance model.links + |> ring model alpha + |> centre model.flags.centerForce + |> collide + |> Array.map integrate + in + { model | nodes = nodes, alpha = alpha } + + +{-| Every node pushes every other away. Fifty nodes is 2,500 pairs a frame, +which is nothing; d3 builds a quadtree because it is written for graphs a +hundred times the size of this one. +-} +charge : Float -> Float -> Array Node -> Array Node +charge strength alpha nodes = + let + every = + Array.toIndexedList nodes + + push index node = + List.foldl + (\( other, that ) acc -> + if other == index then + acc + + else + let + dx = + that.x - acc.x + + dy = + that.y - acc.y + + squared = + max 1.0e-6 (dx * dx + dy * dy) + + weight = + strength * alpha / squared + in + { acc | vx = acc.vx + dx * weight, vy = acc.vy + dy * weight } + ) + node + every + in + Array.indexedMap push nodes + + +{-| Each link pulls its ends towards `distance` apart, sharing the correction +between them by the bias: the end with fewer links of its own gives way. +-} +pull : Float -> Float -> List Link -> Array Node -> Array Node +pull alpha distance links nodes = + List.foldl (pullOne alpha distance) nodes links + + +pullOne : Float -> Float -> Link -> Array Node -> Array Node +pullOne alpha distance link nodes = + case ( Array.get link.source nodes, Array.get link.target nodes ) of + ( Just source, Just target ) -> + let + dx = + target.x + target.vx - source.x - source.vx + + dy = + target.y + target.vy - source.y - source.vy + + length = + max 1.0e-6 (sqrt (dx * dx + dy * dy)) + + weight = + (length - distance) / length * alpha * link.strength + + mx = + dx * weight + + my = + dy * weight + in + nodes + |> Array.set link.target + { target | vx = target.vx - mx * link.bias, vy = target.vy - my * link.bias } + |> Array.set link.source + { source | vx = source.vx + mx * (1 - link.bias), vy = source.vy + my * (1 - link.bias) } + + _ -> + nodes + + +{-| The global graph pulls everything onto a circle, which is what keeps a +whole-site graph from collapsing into a knot in the middle. +-} +ring : Model -> Float -> Array Node -> Array Node +ring model alpha nodes = + if not model.flags.enableRadial then + nodes + + else + let + wanted = + min model.flags.size.width model.flags.size.height / 2 * 0.8 + + apply node = + let + dx = + if node.x == 0 then + 1.0e-6 + + else + node.x + + dy = + if node.y == 0 then + 1.0e-6 + + else + node.y + + distance = + max 1.0e-6 (sqrt (dx * dx + dy * dy)) + + weight = + (wanted - distance) * 0.2 * alpha / distance + in + { node | vx = node.vx + dx * weight, vy = node.vy + dy * weight } + in + Array.map apply nodes + + +{-| Holds the drawing in the middle of its box. This one moves positions rather +than velocities and is not scaled by alpha, which d3 does too -- it is why the +graph stays centred long after it has stopped moving. +-} +centre : Float -> Array Node -> Array Node +centre strength nodes = + let + count = + toFloat (Array.length nodes) + in + if count == 0 then + nodes + + else + let + ( sumX, sumY ) = + Array.foldl (\node ( x, y ) -> ( x + node.x, y + node.y )) ( 0, 0 ) nodes + + shiftX = + sumX / count * strength + + shiftY = + sumY / count * strength + in + Array.map (\node -> { node | x = node.x - shiftX, y = node.y - shiftY }) nodes + + +{-| Keeps two circles off each other. One pass where d3 runs three: the circles +here are three to six pixels across, and a pixel of leftover overlap is gone by +the next frame anyway. +-} +collide : Array Node -> Array Node +collide nodes = + let + every = + Array.toIndexedList nodes + + resolve index node = + List.foldl + (\( other, that ) acc -> + if other == index then + acc + + else + let + dx = + acc.x + acc.vx - that.x - that.vx + + dy = + acc.y + acc.vy - that.y - that.vy + + wanted = + radius acc + radius that + + distance = + max 1.0e-6 (sqrt (dx * dx + dy * dy)) + in + if distance >= wanted then + acc + + else + let + weight = + (wanted - distance) / distance * 0.5 + in + { acc | vx = acc.vx + dx * weight, vy = acc.vy + dy * weight } + ) + node + every + in + Array.indexedMap resolve nodes + + +integrate : Node -> Node +integrate node = + let + vx = + node.vx * velocityDecay + + vy = + node.vy * velocityDecay + in + { node | x = node.x + vx, y = node.y + vy, vx = vx, vy = vy } + + + +-- UPDATE + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Tick -> + ( step model, Cmd.none ) + + Hover id -> + ( { model | hovered = id }, Cmd.none ) + + Follow id -> + ( model, follow id ) + + Resized size -> + -- A box of a different size is a different drawing, so the layout + -- is given some of its energy back rather than left where it was. + ( { model | flags = withSize size model.flags, alpha = max model.alpha 0.3 } + , Cmd.none + ) + + Halted -> + -- Nothing more to do, and nothing more to draw: with the alpha at + -- rest there is no animation frame to ask for, and the app sits + -- there costing nothing until it is collected. + ( { model | alpha = 0 }, Cmd.none ) + + +withSize : Size -> Flags -> Flags +withSize size flags = + { flags | size = size } + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ if model.alpha > alphaMin then + Browser.Events.onAnimationFrame (\_ -> Tick) + + else + Sub.none + , resized Resized + , halt (\() -> Halted) + ] + + + +-- VIEW + + +href : Model -> String -> String +href model id = + model.flags.base ++ "/" ++ id + + +view : Model -> Html Msg +view model = + let + box = + [ -(model.flags.size.width / 2) + , -(model.flags.size.height / 2) + , model.flags.size.width + , model.flags.size.height + ] + |> List.map String.fromFloat + |> String.join " " + in + Svg.svg + [ Attr.class "elm-graph-svg" + , Attr.viewBox box + , Attr.preserveAspectRatio "xMidYMid meet" + ] + [ Svg.g [ Attr.class "elm-graph-links" ] (List.map (viewLink model) model.links) + , Svg.g [ Attr.class "elm-graph-nodes" ] + (model.nodes |> Array.toList |> List.map (viewNode model)) + ] + + +{-| Which ids the pointer is on or next to. Hovering nothing lights everything, +which is the resting state. +-} +lit : Model -> Maybe (Set String) +lit model = + model.hovered + |> Maybe.map + (\id -> + Dict.get id model.neighbours + |> Maybe.withDefault Set.empty + |> Set.insert id + ) + + +viewLink : Model -> Link -> Svg Msg +viewLink model link = + case ( Array.get link.source model.nodes, Array.get link.target model.nodes ) of + ( Just source, Just target ) -> + let + -- Nothing hovered is the resting state, and gets no class of + -- its own: the stylesheet's plain `.elm-graph-link` is what a + -- graph nobody is pointing at looks like. + state = + case model.hovered of + Nothing -> + "" + + Just id -> + if source.id == id || target.id == id then + " is-lit" + + else + " is-dim" + in + Svg.line + [ Attr.class ("elm-graph-link" ++ state) + , Attr.x1 (String.fromFloat source.x) + , Attr.y1 (String.fromFloat source.y) + , Attr.x2 (String.fromFloat target.x) + , Attr.y2 (String.fromFloat target.y) + ] + [] + + _ -> + Svg.text "" + + +viewNode : Model -> Node -> Svg Msg +viewNode model node = + let + hovered = + model.hovered == Just node.id + + active = + case lit model of + Nothing -> + True + + Just ids -> + Set.member node.id ids + + classes = + [ Just "elm-graph-node" + , if node.id == model.flags.slug then + Just "is-current" + + else if node.kind == TagNode then + Just "is-tag" + + else if Set.member node.id model.visited then + Just "is-visited" + + else + Nothing + , if hovered then + Just "is-hovered" + + else + Nothing + , if active || not model.flags.focusOnHover then + Nothing + + else + Just "is-dim" + ] + |> List.filterMap identity + |> String.join " " + in + Svg.a + [ Attr.class classes + + -- `href` rather than `xlink:href`: the old form is deprecated, and it + -- is also invisible to the accessibility tree, so a graph written that + -- way is a page of circles nothing but a mouse can reach. + , Html.Attributes.attribute "href" (href model node.id) + + -- Quartz's router reads `href` off whatever anchor a click came from, + -- and on an SVG anchor that is an SVGAnimatedString rather than a + -- string. This asks it to leave the click alone; the port below does + -- the navigating, through that same router, with a URL it can read. + , Html.Attributes.attribute "data-router-ignore" "" + , Svg.Events.onMouseOver (Hover (Just node.id)) + , Svg.Events.onMouseOut (Hover Nothing) + , Html.Events.custom "click" + (Decode.succeed + { message = Follow node.id + , stopPropagation = True + , preventDefault = True + } + ) + ] + [ Svg.circle + [ Attr.cx (String.fromFloat node.x) + , Attr.cy (String.fromFloat node.y) + , Attr.r (String.fromFloat (radius node)) + ] + [] + , Svg.text_ + [ Attr.class "elm-graph-label" + , Attr.x (String.fromFloat node.x) + , Attr.y (String.fromFloat (node.y - radius node - 3)) + , Attr.textAnchor "middle" + ] + [ Svg.text node.label ] + ] + + + +-- MAIN + + +main : Program Decode.Value Model Msg +main = + Browser.element + { init = init + , update = update + , view = view + , subscriptions = subscriptions + } + + +init : Decode.Value -> ( Model, Cmd Msg ) +init raw = + case Decode.decodeValue flagsDecoder raw of + Ok flags -> + ( lay (build flags), Cmd.none ) + + Err error -> + -- An empty graph rather than a broken page: the sidebar simply has + -- nothing in it, which is what it looked like before it had a + -- graph, and the console gets told why. + ( build flags0, failed (Decode.errorToString error) ) + + +{-| Flags for a graph with nothing in it. +-} +flags0 : Flags +flags0 = + { slug = "" + , base = "" + , size = { width = 250, height = 250 } + , depth = 1 + , showTags = False + , removeTags = [] + , repelForce = 0.5 + , centerForce = 0.3 + , linkDistance = 30 + , focusOnHover = False + , enableRadial = False + , reducedMotion = False + , visited = [] + , pages = [] + } diff --git a/quartz-local/elm-graph/styles.ts b/quartz-local/elm-graph/styles.ts new file mode 100644 index 00000000..d3e15782 --- /dev/null +++ b/quartz-local/elm-graph/styles.ts @@ -0,0 +1,136 @@ +/** + * What the graph looks like, in each theme. + * + * The Elm side draws circles and lines with classes on them and says nothing + * about colour. That is the point of the port: the graph this replaced read + * six custom properties out of `getComputedStyle` when it started and painted + * them into a WebGL scene, so it had to be told to rebuild itself whenever the + * theme changed. These are `var(--secondary)` and friends, resolved by the + * browser, on nodes that are already in the document. + */ + +export const styles = ` +.elm-graph h3 { + font-size: 1rem; + margin: 0 0 0.5rem; +} + +.elm-graph-outer { + position: relative; + border: 1px solid var(--lightgray); + border-radius: 5px; + height: 250px; + overflow: hidden; +} + +.elm-graph-container { + width: 100%; + height: 100%; +} + +.elm-graph-svg { + display: block; + width: 100%; + height: 100%; +} + +.elm-graph-link { + stroke: var(--lightgray); + stroke-width: 1px; + transition: + stroke 0.2s ease, + opacity 0.2s ease; +} + +.elm-graph-link.is-lit { + stroke: var(--gray); +} + +.elm-graph-link.is-dim { + opacity: 0.2; +} + +.elm-graph-node { + cursor: pointer; + transition: opacity 0.2s ease; +} + +.elm-graph-node circle { + fill: var(--gray); + transition: fill 0.2s ease; +} + +.elm-graph-node.is-visited circle { + fill: var(--tertiary); +} + +/* A tag is drawn as an outline rather than a disc, so that a page and the tag + it carries are told apart at a glance without reading either label. */ +.elm-graph-node.is-tag circle { + fill: var(--light); + stroke: var(--tertiary); + stroke-width: 1.5px; +} + +.elm-graph-node.is-current circle { + fill: var(--secondary); +} + +.elm-graph-node.is-dim { + opacity: 0.25; +} + +.elm-graph-label { + fill: var(--dark); + font-family: var(--bodyFont); + font-size: 8px; + opacity: 0; + pointer-events: none; + transition: opacity 0.2s ease; +} + +.elm-graph-node.is-hovered .elm-graph-label { + opacity: 1; +} + +.elm-graph-expand { + position: absolute; + right: 0.4rem; + bottom: 0.4rem; + display: flex; + padding: 0.2rem; + border: none; + border-radius: 4px; + background: none; + color: var(--gray); + cursor: pointer; + opacity: 0; + transition: opacity 0.2s ease; +} + +.elm-graph-outer:hover .elm-graph-expand, +.elm-graph-expand:focus-visible { + opacity: 1; +} + +.elm-graph-modal { + position: fixed; + inset: 0; + z-index: 100; + display: flex; + align-items: center; + justify-content: center; + background: rgba(0, 0, 0, 0.55); +} + +.elm-graph-modal[hidden] { + display: none; +} + +.elm-graph-modal .elm-graph-container { + width: min(85vw, 60rem); + height: min(85vh, 45rem); + border-radius: 5px; + background: var(--light); +} +` diff --git a/quartz.config.yaml b/quartz.config.yaml index e94e2c38..bf33921f 100644 --- a/quartz.config.yaml +++ b/quartz.config.yaml @@ -170,7 +170,9 @@ plugins: layout: position: left priority: 80 - - source: github:quartz-community/graph + # The graph is the local one, in Elm: quartz-local/elm-graph. The community + # plugin it replaces fetched d3 and pixi.js from jsDelivr on every page view. + - source: ./quartz-local/elm-graph enabled: true options: localGraph: @@ -280,7 +282,7 @@ layout: content: {} folder: exclude: - - graph + - elm-graph - backlinks - table-of-contents - tag-list @@ -288,7 +290,7 @@ layout: right: [] tag: exclude: - - graph + - elm-graph - backlinks - table-of-contents - tag-list diff --git a/quartz/components/renderPage.tsx b/quartz/components/renderPage.tsx index 622ed97d..1d917dcd 100644 --- a/quartz/components/renderPage.tsx +++ b/quartz/components/renderPage.tsx @@ -318,6 +318,9 @@ export function renderPage( {/* Comment threads. Loaded everywhere and inert on pages without one, which is cheaper than teaching the emitter which pages have comments. */} + {/* Starts the Elm graph on the containers the sidebar leaves for it, and + fetches the compiled Elm only on a page that has one. */} + ) diff --git a/tools/site/src/build.rs b/tools/site/src/build.rs index b02ec0e5..a3d8a339 100644 --- a/tools/site/src/build.rs +++ b/tools/site/src/build.rs @@ -166,6 +166,10 @@ impl Site { ]), )?; + // The Elm graph is the third thing that lands in content/js, and it + // has to be built after the emptying above rather than before it. + self.elm(mode)?; + remove_license_files(&content_js) } diff --git a/tools/site/src/elm.rs b/tools/site/src/elm.rs new file mode 100644 index 00000000..cdd9d795 --- /dev/null +++ b/tools/site/src/elm.rs @@ -0,0 +1,174 @@ +//! Compiling the Elm graph. +//! +//! `quartz-local/elm-graph` holds an Elm application -- the site graph: its +//! neighbourhood, its force simulation and its SVG -- and this turns it into +//! the `content/js/elm.js` that `ts/src/graph.ts` loads. +//! +//! It is two commands rather than one. `elm make --optimize` does Elm's own +//! optimising but no minifying, which the Elm guide is explicit about: the +//! output is meant to be handed to a minifier afterwards, and the compiler +//! makes that safe by guaranteeing there is no `eval` and no reflection in +//! what it emits. esbuild is already a dependency of the site, and it takes +//! the compiled graph from 163 KB to 54 KB, which is 19 KB over the wire. + +use crate::process::command_succeeds; +use crate::{Mode, Result, Site, SiteError, os_args, remove_file_if_exists}; +use std::ffi::OsString; +use std::fs; +use std::path::Path; + +/// Where the compiled program lands, under the directory `site wasm` owns. +const OUTPUT: &str = "content/js/elm.js"; + +/// The compiler's own output, before esbuild. It sits beside the finished file +/// rather than in a temporary directory so that a failed build leaves it where +/// it can be read. +const RAW: &str = "content/js/elm.raw.js"; + +impl Site { + pub(crate) fn elm(&self, mode: Mode) -> Result<()> { + let source = self.root.join("quartz-local/elm-graph"); + if !source.join("elm.json").is_file() { + return Err(Box::new(SiteError::new( + "no elm.json in quartz-local/elm-graph", + ))); + } + + let output = self.root.join(OUTPUT); + if let Some(parent) = output.parent() { + fs::create_dir_all(parent)?; + } + + match mode { + Mode::Prod => { + let raw = self.root.join(RAW); + self.compile(&source, &raw, mode)?; + self.minify(&raw, &output)?; + remove_file_if_exists(&raw) + } + Mode::Dev => { + // Unoptimised and unminified: the compile is quicker, and the + // JavaScript in the debugger is the JavaScript on disk. + self.compile(&source, &output, mode) + } + } + } + + fn compile(&self, source: &Path, output: &Path, mode: Mode) -> Result<()> { + let program = elm_program().ok_or_else(|| { + SiteError::new( + "could not find elm; it is in the flake's dev shell, or see elm-lang.org/install", + ) + })?; + + let mut args = os_args(&["make", "src/Main.elm"]); + if mode == Mode::Prod { + args.push("--optimize".into()); + } else { + self.warn("building the elm graph in development mode"); + } + args.push(format!("--output={}", output.display()).into()); + + self.run(source, program, &args)?; + + let compiled = fs::read_to_string(output)?; + fs::write(output, anchor_to_global(&compiled)?)?; + Ok(()) + } + + /// esbuild, through bun, because that is how everything else in `ts/` is + /// run and it is the same esbuild Quartz builds itself with. + fn minify(&self, input: &Path, output: &Path) -> Result<()> { + let args = os_args(&[ + "x", + "esbuild", + &input.display().to_string(), + "--minify", + // Elm emits ES5; there is nothing to gain from downlevelling it + // further, and plenty to lose from letting a minifier try. + "--target=es2020", + &format!("--outfile={}", output.display()), + ]); + + self.run_bun(&self.root, &args) + } +} + +/// The compiler, if it is installed. It is in the flake's dev shell, which is +/// what CI builds inside; asking it for its version is how `bun` is looked for +/// a few lines away in `process.rs`, and it answers the same question. +fn elm_program() -> Option { + command_succeeds("elm", &["--version"]).then(|| "elm".into()) +} + +/// What the compiled program hands itself as its global object, and what it is +/// changed to. +const TAIL: &str = "}(this));"; +const ANCHORED: &str = "}(globalThis));"; + +/// Points the compiled program at `globalThis` instead of `this`. +/// +/// Elm wraps its output in `(function (scope) { ... }(this))` and hangs `Elm` +/// off whatever it is handed. In a plain script tag `this` is the window and +/// that works -- but only there. esbuild reads the file as a module, where +/// top-level `this` is undefined, and folds the constant: the last line comes +/// out as `}(void 0));` and the program dies reading `Elm` of undefined before +/// the graph ever draws. Anything else that ever reads this file -- a bundler, +/// a `type="module"` tag, a future minifier -- has the same opinion. +/// +/// `globalThis` is that same object under a name nobody can reinterpret. It is +/// an error rather than a fallback when the tail is not found: a compiler that +/// stops emitting it needs this looked at, not skipped quietly. +fn anchor_to_global(compiled: &str) -> Result { + let at = compiled.rfind(TAIL).ok_or_else(|| { + SiteError::new(format!( + "the compiled Elm does not end with {TAIL:?}; the fixup in tools/site/src/elm.rs needs revisiting" + )) + })?; + + let mut anchored = String::with_capacity(compiled.len() + ANCHORED.len()); + anchored.push_str(&compiled[..at]); + anchored.push_str(ANCHORED); + anchored.push_str(&compiled[at + TAIL.len()..]); + Ok(anchored) +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn the_program_is_handed_a_global_it_will_still_have_after_a_minifier() { + let compiled = "(function (scope) {\n scope['Elm'] = {};\n}(this));\n"; + let anchored = anchor_to_global(compiled).expect("the tail is there"); + + assert!(anchored.ends_with("}(globalThis));\n")); + assert!(!anchored.contains("}(this));")); + } + + #[test] + fn only_the_last_call_is_touched() { + // `this` appears all over a compiled program; only the one call that + // starts it is the one being repointed. + let compiled = "var f = function () { return this.x }(this);\n}(this));"; + let anchored = anchor_to_global(compiled).expect("the tail is there"); + + assert!(anchored.starts_with("var f = function () { return this.x }(this);")); + assert!(anchored.ends_with("}(globalThis));")); + } + + #[test] + fn a_compiler_that_stops_emitting_it_is_an_error_rather_than_a_shrug() { + assert!(anchor_to_global("console.log('not elm')").is_err()); + } + + #[test] + fn the_output_lives_where_the_bundle_does() { + // `site wasm` empties content/js and fills it; the compiled Elm is one + // of the things it fills it with, so it has to be written after that + // and named as part of the same directory. + assert!(OUTPUT.starts_with("content/js/")); + assert!(RAW.starts_with("content/js/")); + assert_ne!(OUTPUT, RAW); + } +} diff --git a/tools/site/src/main.rs b/tools/site/src/main.rs index c8049b7f..87b95f4e 100644 --- a/tools/site/src/main.rs +++ b/tools/site/src/main.rs @@ -3,6 +3,7 @@ mod build; mod comments; mod content; mod duplicates; +mod elm; mod fsutil; mod gallery; mod maintenance; @@ -110,6 +111,7 @@ fn run_main() -> Result<()> { match args[0].as_str() { "build" => site.build(parse_mode(&args[1..], Mode::default_for(site.ci))?), "wasm" => site.wasm(parse_mode(&args[1..], Mode::default_for(site.ci))?), + "elm" => site.elm(parse_mode(&args[1..], Mode::default_for(site.ci))?), "generate" => site.generate(), "links" | "collect-links" => site.links(), "indices" => site.indices(), @@ -184,6 +186,7 @@ Commands: build [--dev|--prod] build wasm assets and the Quartz site --dev also watches TypeScript bundles wasm [--dev|--prod] build only the wasm and TypeScript bundle + elm [--dev|--prod] build only the Elm graph generate regenerate link lists, indices, and chords links regenerate plaintext link lists indices regenerate misc indices diff --git a/tools/site/src/process.rs b/tools/site/src/process.rs index fee82e64..8cdc1170 100644 --- a/tools/site/src/process.rs +++ b/tools/site/src/process.rs @@ -279,7 +279,7 @@ pub(crate) fn os_args(args: &[&str]) -> Vec { args.iter().map(OsString::from).collect() } -fn command_succeeds

(program: P, args: &[&str]) -> bool +pub(crate) fn command_succeeds

(program: P, args: &[&str]) -> bool where P: AsRef, { diff --git a/ts/src/graph.ts b/ts/src/graph.ts new file mode 100644 index 00000000..8a396b59 --- /dev/null +++ b/ts/src/graph.ts @@ -0,0 +1,317 @@ +/** + * Starting the Elm graph, and being the parts of the page it cannot be. + * + * The graph itself -- the neighbourhood, the force simulation, the drawing -- + * is `quartz-local/elm-graph/src/Main.elm`, compiled to `/js/elm.js`. What is + * left here is what belongs to the browser rather than to the graph: reading + * the content index, measuring the box, remembering which pages have been + * visited, opening the whole-site graph, and handing a click back to Quartz's + * router. + * + * The compiled Elm is fetched only where a graph is actually drawn. It is 54 + * KB, the sidebar it lives in is desktop-only, and the page this replaced + * pulled d3 and pixi.js off a CDN on every page view whether it drew anything + * or not. + */ + +interface ElmPort { + send(value: T): void +} + +interface ElmSubscription { + subscribe(handler: (value: T) => void): void +} + +interface Size { + width: number + height: number +} + +interface ElmApp { + ports: { + follow: ElmSubscription + failed: ElmSubscription + resized: ElmPort + halt: ElmPort + } +} + +/** One graph: the app, and the observer that keeps it the size of its box. */ +interface Mount { + app: ElmApp + observer: ResizeObserver +} + +interface ElmRuntime { + Main: { init(config: { node: HTMLElement; flags: unknown }): ElmApp } +} + +declare global { + interface Window { + Elm?: ElmRuntime + spaNavigate?: (url: URL) => void + } +} + +/** What the graph needs out of one page of the content index. */ +interface Entry { + title?: string + links?: string[] + tags?: string[] +} + +interface Page { + id: string + title: string + links: string[] + tags: string[] +} + +/** The key Quartz's graph has always kept its visited pages under. */ +const VISITED = "graph-visited" + +const mounts = new WeakMap() + +/** + * Containers with a graph on them or on the way to one. + * + * Marked here rather than in `mounts` because starting one takes two fetches, + * and Quartz announces the first page with a `nav` event of its own on top of + * `DOMContentLoaded`: without a mark taken synchronously, both calls get past + * the check and two apps end up drawing into the same box. + */ +const taken = new WeakSet() + +/** + * A slug as the graph names it: no slashes on either end and no `index` at the + * end, so `blog/index` and `blog/` are the one node a reader takes them for. + * The front page comes out as the empty string. + */ +function simplify(slug: string): string { + const trimmed = slug.replace(/^\/+|\/+$/g, "") + if (trimmed === "index") return "" + return trimmed.replace(/\/index$/, "") +} + +function basePath(): string { + return document.body.dataset.basepath ?? "" +} + +function currentSlug(): string { + return simplify(document.body.dataset.slug ?? "") +} + +function visited(): string[] { + try { + const stored: unknown = JSON.parse(localStorage.getItem(VISITED) ?? "[]") + return Array.isArray(stored) ? stored.filter((slug) => typeof slug === "string") : [] + } catch { + // Storage can be turned off, and then it throws rather than returning + // nothing. A graph that does not remember where the reader has been is + // still a graph. + return [] + } +} + +function remember(slug: string): void { + try { + const all = new Set(visited()) + all.add(slug) + localStorage.setItem(VISITED, JSON.stringify([...all])) + } catch { + /* see above */ + } +} + +let runtime: Promise | null = null + +/** The compiled Elm, loaded once and only where there is a graph to draw. */ +function elm(): Promise { + runtime ??= new Promise((resolve, reject) => { + const script = document.createElement("script") + script.src = `${basePath()}/js/elm.js` + script.onload = () => { + const loaded = window.Elm + if (loaded === undefined) reject(new Error("/js/elm.js defined no Elm")) + else resolve(loaded) + } + script.onerror = () => reject(new Error("/js/elm.js did not load")) + document.head.append(script) + }) + + return runtime +} + +let index: Promise | null = null + +/** + * The content index, which the search loads too, read once per page load and + * cut down to what a graph is drawn from. Every page's full text is in there, + * and handing that to Elm would mean copying a megabyte of prose across the + * boundary in order to count links with it. + */ +function pages(): Promise { + index ??= fetch(`${basePath()}/static/contentIndex.json`) + .then((response) => { + if (!response.ok) throw new Error(`contentIndex.json: ${response.status}`) + return response.json() as Promise> + }) + .then((data) => + Object.entries(data).map(([slug, entry]) => ({ + id: simplify(slug), + title: entry.title ?? "", + links: (entry.links ?? []).map(simplify), + tags: entry.tags ?? [], + })), + ) + + return index +} + +function size(container: HTMLElement): Size { + return { + width: Math.max(container.clientWidth, 100), + // A container that has not been laid out yet -- the whole-site graph, + // before its dialog is opened -- measures zero, and a graph in a box of no + // height is a graph nobody can see. + height: Math.max(container.clientHeight, 250), + } +} + +function start(container: HTMLElement): void { + taken.add(container) + + void Promise.all([elm(), pages()]) + .then(([loaded, sitePages]) => { + let config: unknown = {} + try { + config = JSON.parse(container.dataset.cfg ?? "{}") + } catch (error: unknown) { + console.error("[graph] unreadable data-cfg", error) + } + + // Elm replaces the node it is given rather than filling it, so it is + // given one of its own. The container itself has to survive: it carries + // the settings, and it is the box whose size is being watched. + const root = document.createElement("div") + container.replaceChildren(root) + + const app = loaded.Main.init({ + node: root, + flags: { + ...(config as Record), + slug: currentSlug(), + base: basePath(), + ...size(container), + visited: visited(), + pages: sitePages, + // A reader who has asked for less movement gets the graph laid out + // rather than the layout being performed at them. + reducedMotion: window.matchMedia("(prefers-reduced-motion: reduce)").matches, + }, + }) + + app.ports.failed.subscribe((reason) => { + console.error("[graph]", reason) + }) + + app.ports.follow.subscribe((id) => { + remember(id) + const url = new URL(`${basePath()}/${id}`, window.location.href) + // Quartz's own router, so that a node behaves like a link in the + // prose: no reload, and the back button still works. + if (window.spaNavigate !== undefined) window.spaNavigate(url) + else window.location.assign(url) + }) + + const observer = new ResizeObserver(() => { + app.ports.resized.send(size(container)) + }) + observer.observe(container) + + mounts.set(container, { app, observer }) + }) + .catch((error: unknown) => { + taken.delete(container) + console.error("[graph]", error) + }) +} + +/** + * Mount the graph, and mount it again after a soft navigation. + * + * Quartz patches the document rather than replacing it, so the container is + * the same element after a navigation as it was before -- but micromorph + * patches it back into the empty div the new page's HTML has, taking the + * drawing with it. The app that was rendering there is left holding a view + * that is no longer in the page, so it is stopped and another one started + * around the page the reader has arrived at. + * + * A container that still has its drawing has been through none of that, and is + * left alone. + */ +function initialise(): void { + for (const container of document.querySelectorAll(".elm-graph-container")) { + const mount = mounts.get(container) + + if (mount !== undefined) { + if (container.firstElementChild !== null) continue + mount.app.ports.halt.send(null) + mount.observer.disconnect() + mounts.delete(container) + taken.delete(container) + } + + // The whole-site graph waits until someone opens it. + if (!taken.has(container) && container.closest(".elm-graph-modal") === null) start(container) + } +} + +let listening = false + +/** + * The whole-site graph, drawn only when it is asked for: it is the same + * simulation over every page rather than a dozen, and there is no reason to + * run it behind a closed dialog. + */ +function expandable(): void { + const button = document.querySelector(".elm-graph-expand") + const modal = document.querySelector(".elm-graph-modal") + if (button === null || modal === null) return + + // Assigned rather than added: a soft navigation can hand back the same + // elements, and adding would stack a second handler on each of them. + button.onclick = () => { + modal.hidden = false + const container = modal.querySelector(".elm-graph-container") + if (container !== null && !taken.has(container)) start(container) + } + + modal.onclick = (event) => { + if (event.target === modal) modal.hidden = true + } + + // The document outlives every navigation, so this one is added once and left + // alone -- and added rather than assigned, because `onkeydown` is a single + // slot and the search box wants keys too. + if (!listening) { + listening = true + document.addEventListener("keydown", (event) => { + const open = document.querySelector(".elm-graph-modal") + if (event.key === "Escape" && open !== null && !open.hidden) open.hidden = true + }) + } +} + +function boot(): void { + initialise() + expandable() +} + +if (document.readyState === "loading") { + document.addEventListener("DOMContentLoaded", boot, { once: true }) +} else { + boot() +} + +document.addEventListener("nav", boot) diff --git a/ts/webpack.config.ts b/ts/webpack.config.ts index 10ed7d11..637c9ea4 100644 --- a/ts/webpack.config.ts +++ b/ts/webpack.config.ts @@ -43,6 +43,7 @@ const config: Configuration = { you: "./dist/you.js", audiolink: "./dist/audiolink.js", insurance: "./dist/insurance.js", + graph: "./dist/graph.js", comments: "./dist/comments.js", }, output: { From 3983fcb5e1edf736ba01d3519a15def6b280db64 Mon Sep 17 00:00:00 2001 From: hill Date: Wed, 26 Aug 2026 17:59:03 +0200 Subject: [PATCH 4/5] Let the graph be dragged, panned and zoomed, and test all of it The port had the picture and none of the handling. This is the rest of what the old graph did with a mouse, and the tests that say it is right. Dragging a node pins it -- the forces keep pushing at it, it does not move, and the rest of the graph rearranges itself around where it has been put. d3 throws a pinned node's velocity away every tick and so does this, so letting go of one after hauling it across the box leaves it there rather than firing it off with everything the forces wanted to do to it in the meantime. A node is also a link, and the click that ends a drag is the same click that follows one, so a drag remembers whether the mouse travelled more than three pixels and the click after one that did is swallowed. Dragging the background pans, and the wheel zooms about the pointer, between a quarter and four times, on d3's own two-to-the-delta-over-500. Both are the viewBox and nothing else: no transform on the nodes, no second coordinate system to keep in step, and a stylesheet still measuring strokes and font sizes in the units it was written in. Labels fade in above life size, which is the old graph's arithmetic -- fifty labels at once is not reading. Two things had to cross the boundary for any of it. A mouse event says where it happened in the window, and an Elm event decoder can read properties but cannot call getBoundingClientRect, so `resized` now carries the box's corner as well as its size and the page re-sends it while the reader scrolls; without that, zooming a graph somebody had scrolled to would zoom about the wrong point. And the background needed something to catch a drag that misses a node, which is a rect the size of the view, painted in transparent because fill:none is not hit-tested. The tests are the point of the commit as much as the features are. Forty nine of them, run by `site elm-test` and by `site check`: that a link settles at about the length it asked for, that the neighbourhood walks a link in both directions, that a tag is drawn as a tag, that a drag carries a node by exactly the distance the mouse moved and half that at twice the zoom, that the wheel keeps what is under the pointer under it, that the zoom stops at both ends, that the click ending a drag is not a link being followed -- and that it is swallowed once rather than for ever. Inverting one sign in the zoom fails four of them, which is the check that they bite. None of this could be seen from here: an Elm view redraws on an animation frame, and a browser pane that is not displayed never gets one. The tests are what stands in for the eye, and Main is exposed wholesale so they can read it -- an application is built from `main` outwards whatever the module line says, so nothing extra is compiled into the page for it. elm-test comes from the flake in CI and from `bun x` at a pinned 0.19.1-revision12 elsewhere, because plain `latest` is 0.19.2-1, written for a compiler that is not released: it emits an elm.json asking for Elm 0.19.2 and then refuses the 0.19.1 that answers. --- flake.nix | 1 + quartz-local/elm-graph/README.md | 70 ++- quartz-local/elm-graph/elm.json | 9 +- quartz-local/elm-graph/src/Main.elm | 457 ++++++++++++++++-- quartz-local/elm-graph/styles.ts | 18 + .../elm-graph/tests/InteractionTest.elm | 320 ++++++++++++ quartz-local/elm-graph/tests/LayoutTest.elm | 209 ++++++++ tools/site/src/build.rs | 1 + tools/site/src/elm.rs | 31 ++ tools/site/src/main.rs | 2 + ts/src/graph.ts | 57 ++- 11 files changed, 1119 insertions(+), 56 deletions(-) create mode 100644 quartz-local/elm-graph/tests/InteractionTest.elm create mode 100644 quartz-local/elm-graph/tests/LayoutTest.elm diff --git a/flake.nix b/flake.nix index 153f669a..e400a6f7 100644 --- a/flake.nix +++ b/flake.nix @@ -29,6 +29,7 @@ cargo-hack clang elmPackages.elm + elmPackages.elm-test git gcc gnugrep diff --git a/quartz-local/elm-graph/README.md b/quartz-local/elm-graph/README.md index 2b265cba..4c3aed56 100644 --- a/quartz-local/elm-graph/README.md +++ b/quartz-local/elm-graph/README.md @@ -10,7 +10,7 @@ on every page view — and paints into a WebGL canvas. Its script opens with to a CDN before a single node is drawn. This draws the same picture out of SVG, from a compiled Elm program served from -this site. **54 KB, 19 KB over the wire**, fetched only on a page that has a +this site. **59 KB, 20 KB over the wire**, fetched only on a page that has a graph on it. ## What is where @@ -66,12 +66,20 @@ changed; this one is repainted by the browser like anything else on the page. Elm owns the graph and nothing else. Everything that is the page's job crosses a port: -| port | direction | what it carries | -| --------- | --------- | ----------------------------------------------------------------- | -| `follow` | out | the id of a clicked node, which the page hands to Quartz's router | -| `failed` | out | why flags could not be read, for the console | -| `resized` | in | the container's size, from a `ResizeObserver` | -| `halt` | in | stop: this app's view has been patched out of the page | +| port | direction | what it carries | +| --------- | --------- | ---------------------------------------------------------------------- | +| `follow` | out | the id of a clicked node, which the page hands to Quartz's router | +| `failed` | out | why flags could not be read, for the console | +| `resized` | in | where the container is and how big, from a `ResizeObserver` and scroll | +| `halt` | in | stop: this app's view has been patched out of the page | + +`resized` carries the corner as well as the size because a mouse event says +where it happened in the window, and the graph works in the units of its own +drawing. An Elm event decoder can read properties off an event but cannot call +`getBoundingClientRect`, so the page measures and sends. Scrolling moves the +corner without changing the size, which is why the page watches for that too: +without it, zooming a graph the reader had scrolled to would zoom about the +wrong point. `halt` exists because of how Quartz navigates. It patches the document rather than replacing it, so after a soft navigation the container is the same element @@ -87,12 +95,44 @@ whatever anchor a click came from, and on an SVG anchor that is an to keep the router's hands off it, and Elm sends the id out through `follow` instead, which the page turns into a URL the router can read. +## The mouse + +Dragging a node pins it: the forces go on pushing at it, it does not move, and +everything else rearranges itself around where it has been put. Letting go +unpins it. A node is also a link, so the click that ends a drag would otherwise +follow it — the drag remembers whether the mouse travelled more than three +pixels, and the click after one that did is swallowed. + +Dragging the background pans, and the wheel zooms about the pointer, between a +quarter and four times, on d3's own curve of two to the power of the delta over +five hundred. Both are the `viewBox` and nothing else: no transform on the +nodes, no second coordinate system, and a stylesheet that goes on measuring +strokes and font sizes in the units it was written in. Labels fade in above +life size, which is the old graph's arithmetic, so that zooming into a corner +is what makes it readable rather than fifty labels at once. + ## What is not ported -The old graph could be dragged and zoomed. This cannot, yet — the picture, the -neighbourhood, the highlighting, the whole-site graph and the visited colouring -are all here, and drag and zoom are the two things left. `scale` is gone for -good: it was a pixi camera setting with nothing to configure in an SVG. +Touch. The sidebar graph is desktop-only and the whole-site one is opened from +it, so this listens for mouse events rather than pointer events, and there is +no pinch. `scale` is gone for good: it was a pixi camera setting with nothing +to configure in an SVG. + +## Tests + +```sh +cargo run --locked --manifest-path tools/site/Cargo.toml -- elm-test +``` + +Forty-nine of them, and `site check` runs them. They cover the half of this +that a screenshot cannot show: that a link settles at about the length it asked +for, that the neighbourhood walks a link in both directions, that a drag +carries a node by exactly the distance the mouse moved and half that at twice +the zoom, that the wheel keeps whatever is under the pointer under the pointer, +and that the click ending a drag is not a link being followed. + +Elm will not let a test look inside a `Cmd`, so where a message's only job is to +send one, what is checked is the state that decides whether it is sent. ## Building it @@ -101,6 +141,8 @@ cargo run --locked --manifest-path tools/site/Cargo.toml -- elm --prod ``` `--dev` skips `--optimize` and the esbuild pass, so the JavaScript in the -debugger is the JavaScript on disk. The compiler is `elmPackages.elm` in the -flake's dev shell; `elm-stuff/` beside this file is its package cache and is -ignored. +debugger is the JavaScript on disk. The compiler and the test runner are +`elmPackages.elm` and `elmPackages.elm-test` in the flake's dev shell; on a +machine without nix, `site` reaches for elm-test through `bun x` at the pinned +`0.19.1-revision12`, because plain `latest` is built for a compiler that is not +out yet. `elm-stuff/` beside this file is the package cache and is ignored. diff --git a/quartz-local/elm-graph/elm.json b/quartz-local/elm-graph/elm.json index 482f8ff2..ad47cf93 100644 --- a/quartz-local/elm-graph/elm.json +++ b/quartz-local/elm-graph/elm.json @@ -17,7 +17,12 @@ } }, "test-dependencies": { - "direct": {}, - "indirect": {} + "direct": { + "elm-explorations/test": "2.2.1" + }, + "indirect": { + "elm/bytes": "1.0.8", + "elm/random": "1.0.0" + } } } diff --git a/quartz-local/elm-graph/src/Main.elm b/quartz-local/elm-graph/src/Main.elm index 1a09f690..d300a920 100644 --- a/quartz-local/elm-graph/src/Main.elm +++ b/quartz-local/elm-graph/src/Main.elm @@ -1,4 +1,4 @@ -port module Main exposing (main) +port module Main exposing (..) {-| The site graph, drawn in Elm. @@ -20,6 +20,12 @@ of `getComputedStyle` when it started, which is why it had to be told to redraw when the theme changed. Here a node is a circle with a class on it and the CSS says what that means in each theme. +Everything is exposed for one reason: the tests in `../tests` read it. Elm +builds an application from `main` outwards whatever the module line says, so +nothing extra is compiled into the page for it, and the alternative was a +twenty-name export list that would go stale the first time a test wanted one +more. + -} import Array exposing (Array) @@ -55,11 +61,16 @@ changed the shape of them will see it. port failed : String -> Cmd msg -{-| The container's size, watched by a `ResizeObserver` on the other side. Elm -can hear the window resize but cannot measure a div, and this one lives in a -sidebar that changes width without the window doing anything. +{-| Where the container is and how big, watched by a `ResizeObserver` and the +page's scrolling on the other side. + +Elm can hear the window resize but cannot measure a div, and this one lives in +a sidebar that changes width without the window doing anything. The corner +comes with it because a mouse event says where it is in the window and the +graph needs to know where that is in the box -- `getBoundingClientRect` is a +method, and an event decoder can only read properties. -} -port resized : (Size -> msg) -> Sub msg +port resized : (Box -> msg) -> Sub msg {-| Stop. @@ -73,8 +84,58 @@ took to settle. port halt : (() -> msg) -> Sub msg -type alias Size = - { width : Float, height : Float } +{-| The container, in CSS pixels: how big it is, and where its top left corner +sits in the window. +-} +type alias Box = + { width : Float, height : Float, left : Float, top : Float } + + +{-| A place, in whichever space the name around it says. -} +type alias Point = + { x : Float, y : Float } + + +{-| What part of the drawing the box is showing. + +`zoom` is how many pixels a unit of the layout takes up, and the rest is where +the middle of the box is over it. All three are read straight into the +`viewBox`, so panning and zooming move the picture without touching a single +node. +-} +type alias Camera = + { zoom : Float, x : Float, y : Float } + + +{-| Looking at the middle of the layout, one pixel to the unit. -} +resting : Camera +resting = + { zoom = 1, x = 0, y = 0 } + + +{-| d3's own limits, and for the same reason: further out than a quarter and +the graph is a smudge, closer in than four and it is one node. +-} +closest : Float +closest = + 4 + + +furthest : Float +furthest = + 0.25 + + +{-| What the mouse is doing, if anything. + +`moved` is what tells a drag from a click. A node is a link, so letting go of +one after hauling it across the box would otherwise navigate, which is not what +the hand that hauled it meant. +-} +type Drag + = Still + | Holding { id : String, grab : Point, moved : Bool } + | Panning { from : Point, moved : Bool } @@ -84,7 +145,7 @@ type alias Size = type alias Flags = { slug : String , base : String - , size : Size + , box : Box , depth : Int , showTags : Bool , removeTags : List String @@ -120,10 +181,10 @@ flagsDecoder = Decode.oneOf [ Decode.field name Decode.bool, Decode.succeed fallback ] in Decode.map8 - (\slug base size depth showTags removeTags visited pages -> + (\slug base box depth showTags removeTags visited pages -> { slug = slug , base = base - , size = size + , box = box , depth = depth , showTags = showTags , removeTags = removeTags @@ -139,7 +200,7 @@ flagsDecoder = ) (Decode.field "slug" Decode.string) (Decode.oneOf [ Decode.field "base" Decode.string, Decode.succeed "" ]) - sizeDecoder + boxDecoder (Decode.oneOf [ Decode.field "depth" Decode.int, Decode.succeed 1 ]) (yesNo "showTags" True) (Decode.oneOf [ Decode.field "removeTags" (Decode.list Decode.string), Decode.succeed [] ]) @@ -167,11 +228,13 @@ flagsDecoder = ) -sizeDecoder : Decoder Size -sizeDecoder = - Decode.map2 Size +boxDecoder : Decoder Box +boxDecoder = + Decode.map4 Box (Decode.oneOf [ Decode.field "width" Decode.float, Decode.succeed 250 ]) (Decode.oneOf [ Decode.field "height" Decode.float, Decode.succeed 250 ]) + (Decode.oneOf [ Decode.field "left" Decode.float, Decode.succeed 0 ]) + (Decode.oneOf [ Decode.field "top" Decode.float, Decode.succeed 0 ]) pageDecoder : Decoder Page @@ -201,6 +264,10 @@ type alias Node = , y : Float , vx : Float , vy : Float + + -- Held by the mouse: the forces still push against it and it does not + -- move, which is what makes dragging one node rearrange the rest. + , pinned : Bool } @@ -228,6 +295,12 @@ type alias Model = , alpha : Float , hovered : Maybe String , visited : Set String + , camera : Camera + , drag : Drag + + -- A click arrives after the mouse is let go, and a node is a link. This is + -- how the one that ends a drag is told from the one that follows it. + , dragged : Bool } @@ -235,8 +308,15 @@ type Msg = Tick | Hover (Maybe String) | Follow String - | Resized Size + | Resized Box | Halted + -- The mouse, in window coordinates: where it went down, where it has got + -- to, and where it was when the wheel turned. + | Grabbed String Point + | Panned Point + | Moved Point + | Released + | Wheeled Float Point @@ -386,6 +466,7 @@ build flags = , y = y , vx = 0 , vy = 0 + , pinned = False } link ( from, to ) = @@ -418,6 +499,9 @@ build flags = , alpha = 1 , hovered = Nothing , visited = Set.fromList flags.visited + , camera = resting + , drag = Still + , dragged = False } @@ -641,7 +725,7 @@ ring model alpha nodes = else let wanted = - min model.flags.size.width model.flags.size.height / 2 * 0.8 + min model.flags.box.width model.flags.box.height / 2 * 0.8 apply node = let @@ -745,6 +829,14 @@ collide nodes = integrate : Node -> Node integrate node = + if node.pinned then + -- A node under the mouse stays where the mouse put it, and its + -- velocity is thrown away rather than saved up: d3 does the same, so + -- that a node let go after a long drag does not shoot off with + -- everything the forces wanted to do to it in the meantime. + { node | vx = 0, vy = 0 } + + else let vx = node.vx * velocityDecay @@ -769,12 +861,18 @@ update msg model = ( { model | hovered = id }, Cmd.none ) Follow id -> - ( model, follow id ) + -- The click that ends a drag is the same click that follows a + -- link, and only the mouse knows which it was. + if model.dragged then + ( { model | dragged = False }, Cmd.none ) + + else + ( model, follow id ) - Resized size -> + Resized box -> -- A box of a different size is a different drawing, so the layout -- is given some of its energy back rather than left where it was. - ( { model | flags = withSize size model.flags, alpha = max model.alpha 0.3 } + ( { model | flags = withBox box model.flags, alpha = max model.alpha 0.3 } , Cmd.none ) @@ -784,10 +882,176 @@ update msg model = -- there costing nothing until it is collected. ( { model | alpha = 0 }, Cmd.none ) + Grabbed id at -> + let + held = + where_ model at + in + ( { model + | drag = + Holding + { id = id + , grab = grabbed model id held + , moved = False + } + , nodes = pin id model.nodes + + -- The rest of the graph should get out of the way while a node + -- is being moved, which it only does with some energy left. + , alpha = max model.alpha 0.3 + , hovered = Just id + } + , Cmd.none + ) + + Panned at -> + ( { model | drag = Panning { from = at, moved = False } }, Cmd.none ) + + Moved at -> + ( moved at model, Cmd.none ) + + Released -> + ( { model + | drag = Still + , dragged = wasMoved model.drag + , nodes = Array.map (\node -> { node | pinned = False }) model.nodes + } + , Cmd.none + ) + + Wheeled delta at -> + ( { model | camera = zoomed model delta at }, Cmd.none ) + + +{-| Where a point in the window is over the layout. + +The `viewBox` is the box's own size divided by the zoom, centred on the camera, +and the aspect ratios match by construction -- so there is no letterboxing to +account for and the mapping is this one line each way. +-} +where_ : Model -> Point -> Point +where_ model at = + { x = model.camera.x + (at.x - model.flags.box.left - model.flags.box.width / 2) / model.camera.zoom + , y = model.camera.y + (at.y - model.flags.box.top - model.flags.box.height / 2) / model.camera.zoom + } + + +{-| How far the node is from the pointer when it is picked up, so that it does +not jump to sit under the cursor. +-} +grabbed : Model -> String -> Point -> Point +grabbed model id at = + case model.nodes |> Array.filter (\node -> node.id == id) |> Array.get 0 of + Just node -> + { x = at.x - node.x, y = at.y - node.y } + + Nothing -> + { x = 0, y = 0 } + + +pin : String -> Array Node -> Array Node +pin id nodes = + Array.map (\node -> { node | pinned = node.id == id }) nodes + + +wasMoved : Drag -> Bool +wasMoved drag = + case drag of + Still -> + False + + Holding held -> + held.moved + + Panning pan -> + pan.moved + + +{-| A pixel or two of travel is a click with a shaky hand; more than that is a +drag, and is not a link being followed. +-} +slop : Float +slop = + 3 + + +moved : Point -> Model -> Model +moved at model = + case model.drag of + Still -> + model + + Holding held -> + let + to = + where_ model at + in + { model + | nodes = + Array.map + (\node -> + if node.id == held.id then + { node | x = to.x - held.grab.x, y = to.y - held.grab.y } + + else + node + ) + model.nodes + , drag = Holding { held | moved = True } + , alpha = max model.alpha 0.3 + } + + Panning pan -> + let + dx = + at.x - pan.from.x + + dy = + at.y - pan.from.y + in + { model + | camera = + { zoom = model.camera.zoom + , x = model.camera.x - dx / model.camera.zoom + , y = model.camera.y - dy / model.camera.zoom + } + , drag = + Panning + { from = at + , moved = pan.moved || abs dx + abs dy > slop + } + } + + +{-| Zoom about the pointer: whatever was under it stays under it. + +d3 scales by two to the power of the wheel's delta over 500, and so does this, +so a notch of a wheel moves the picture by as much as it used to. +-} +zoomed : Model -> Float -> Point -> Camera +zoomed model delta at = + let + before = + where_ model at + + camera = + { zoom = clamp furthest closest (model.camera.zoom * (2 ^ (-delta / 500))) + , x = model.camera.x + , y = model.camera.y + } + + after = + where_ { model | camera = camera } at + in + { camera + | x = camera.x + before.x - after.x + , y = camera.y + before.y - after.y + } -withSize : Size -> Flags -> Flags -withSize size flags = - { flags | size = size } + +withBox : Box -> Flags -> Flags +withBox box flags = + { flags | box = box } subscriptions : Model -> Sub Msg @@ -800,9 +1064,30 @@ subscriptions model = Sub.none , resized Resized , halt (\() -> Halted) + + -- On the document rather than the node, because a hand that drags + -- quickly leaves the box behind, and letting go out there still has to + -- count as letting go. + , case model.drag of + Still -> + Sub.none + + _ -> + Sub.batch + [ Browser.Events.onMouseMove (Decode.map Moved point) + , Browser.Events.onMouseUp (Decode.succeed Released) + ] ] +{-| Where a mouse event happened, in the window. -} +point : Decoder Point +point = + Decode.map2 Point + (Decode.field "clientX" Decode.float) + (Decode.field "clientY" Decode.float) + + -- VIEW @@ -812,29 +1097,112 @@ href model id = model.flags.base ++ "/" ++ id -view : Model -> Html Msg -view model = +{-| What the camera is looking at, as the four numbers of a `viewBox`. + +Zooming and panning are this and nothing else: no transform on the nodes, no +second coordinate system to keep in step, and a stylesheet that goes on +measuring strokes and font sizes in the units it was written in. +-} +viewBox : Model -> String +viewBox model = let - box = - [ -(model.flags.size.width / 2) - , -(model.flags.size.height / 2) - , model.flags.size.width - , model.flags.size.height - ] - |> List.map String.fromFloat - |> String.join " " + width = + model.flags.box.width / model.camera.zoom + + height = + model.flags.box.height / model.camera.zoom in + [ model.camera.x - width / 2 + , model.camera.y - height / 2 + , width + , height + ] + |> List.map String.fromFloat + |> String.join " " + + +view : Model -> Html Msg +view model = Svg.svg [ Attr.class "elm-graph-svg" - , Attr.viewBox box + , Attr.viewBox (viewBox model) , Attr.preserveAspectRatio "xMidYMid meet" + + -- The page does not scroll while the graph is being zoomed, which is + -- what a reader reaching for the wheel over a graph means by it. + , Html.Events.custom "wheel" + (Decode.map2 + (\delta at -> + { message = Wheeled delta at + , stopPropagation = False + , preventDefault = True + } + ) + wheelDelta + point + ) ] - [ Svg.g [ Attr.class "elm-graph-links" ] (List.map (viewLink model) model.links) + [ -- Something to catch a drag that starts on the background, filling + -- whatever the camera is looking at. `pointer-events` in the + -- stylesheet keeps it from swallowing anything else. + Svg.rect + [ Attr.class "elm-graph-field" + , Attr.x (String.fromFloat (model.camera.x - model.flags.box.width / model.camera.zoom / 2)) + , Attr.y (String.fromFloat (model.camera.y - model.flags.box.height / model.camera.zoom / 2)) + , Attr.width (String.fromFloat (model.flags.box.width / model.camera.zoom)) + , Attr.height (String.fromFloat (model.flags.box.height / model.camera.zoom)) + , Html.Events.custom "mousedown" + (Decode.map + (\at -> + { message = Panned at, stopPropagation = False, preventDefault = True } + ) + point + ) + ] + [] + , Svg.g [ Attr.class "elm-graph-links" ] (List.map (viewLink model) model.links) , Svg.g [ Attr.class "elm-graph-nodes" ] (model.nodes |> Array.toList |> List.map (viewNode model)) ] +{-| How far the wheel turned, in pixels. + +A wheel reports its delta in pixels, lines or pages depending on the device and +the browser, and the numbers are not comparable: a line is worth about 16 +pixels and a page about a boxful. Without this a mouse wheel in Firefox, which +reports lines, would zoom a fortieth as far as the same wheel in Chrome. +-} +wheelDelta : Decoder Float +wheelDelta = + Decode.map2 + (\delta mode -> + case mode of + 1 -> + delta * 16 + + 2 -> + delta * 400 + + _ -> + delta + ) + (Decode.field "deltaY" Decode.float) + (Decode.oneOf [ Decode.field "deltaMode" Decode.int, Decode.succeed 0 ]) + + +{-| How much of a label is showing before anyone hovers anything. + +The old graph faded labels in as the reader zoomed, and the arithmetic is its: +nothing at all until the picture is bigger than life size, then up towards +opaque as it grows. Reading fifty labels at once is not reading; reading the +half dozen you have zoomed into is. +-} +labelOpacity : Camera -> Float +labelOpacity camera = + clamp 0 1 ((camera.zoom - 1) / 3.75) + + {-| Which ids the pointer is on or next to. Hovering nothing lights everything, which is the resting state. -} @@ -938,6 +1306,20 @@ viewNode model node = , Html.Attributes.attribute "data-router-ignore" "" , Svg.Events.onMouseOver (Hover (Just node.id)) , Svg.Events.onMouseOut (Hover Nothing) + + -- Picking a node up. The default is prevented because the browser + -- would otherwise start dragging the link itself, ghost image and all, + -- and it is stopped from reaching the background, which would pan. + , Html.Events.custom "mousedown" + (Decode.map + (\at -> + { message = Grabbed node.id at + , stopPropagation = True + , preventDefault = True + } + ) + point + ) , Html.Events.custom "click" (Decode.succeed { message = Follow node.id @@ -957,6 +1339,11 @@ viewNode model node = , Attr.x (String.fromFloat node.x) , Attr.y (String.fromFloat (node.y - radius node - 3)) , Attr.textAnchor "middle" + + -- A presentation attribute, which the stylesheet's `opacity` beats + -- -- that is what lets hovering a node show its label whatever the + -- zoom is doing. + , Attr.opacity (String.fromFloat (labelOpacity model.camera)) ] [ Svg.text node.label ] ] @@ -995,7 +1382,7 @@ flags0 : Flags flags0 = { slug = "" , base = "" - , size = { width = 250, height = 250 } + , box = { width = 250, height = 250, left = 0, top = 0 } , depth = 1 , showTags = False , removeTags = [] diff --git a/quartz-local/elm-graph/styles.ts b/quartz-local/elm-graph/styles.ts index d3e15782..1cd1fd4a 100644 --- a/quartz-local/elm-graph/styles.ts +++ b/quartz-local/elm-graph/styles.ts @@ -34,6 +34,18 @@ export const styles = ` height: 100%; } +/* The background, which is what a drag that misses a node lands on. It has to + be painted to be hit at all, since fill:none is not hit-tested, so it is + painted in nothing. */ +.elm-graph-field { + fill: transparent; + cursor: grab; +} + +.elm-graph-svg:active .elm-graph-field { + cursor: grabbing; +} + .elm-graph-link { stroke: var(--lightgray); stroke-width: 1px; @@ -55,6 +67,12 @@ export const styles = ` transition: opacity 0.2s ease; } +/* A node being dragged should not also be a piece of text being selected. */ +.elm-graph-svg { + user-select: none; + touch-action: none; +} + .elm-graph-node circle { fill: var(--gray); transition: fill 0.2s ease; diff --git a/quartz-local/elm-graph/tests/InteractionTest.elm b/quartz-local/elm-graph/tests/InteractionTest.elm new file mode 100644 index 00000000..7f9dc826 --- /dev/null +++ b/quartz-local/elm-graph/tests/InteractionTest.elm @@ -0,0 +1,320 @@ +module InteractionTest exposing (suite) + +{-| The mouse: dragging a node, panning the picture, zooming it, and the one +click that is not a click. + +This is the half of the graph a screenshot cannot show and a hidden tab cannot +be made to perform, so it is the half that is worth writing down. Elm will not +let a test look inside a `Cmd`, so where a message's whole job is to send one +-- following a node, say -- what is checked is the state that decides whether +it is sent at all. + +-} + +import Array +import Expect exposing (FloatingPointTolerance(..)) +import Main +import Test exposing (Test, describe, test) + + +page : String -> List String -> Main.Page +page id links = + { id = id, title = id, links = links, tags = [] } + + +{-| Two pages, one link, in a box 200 by 100 whose corner is at (50, 20). +-} +model : Main.Model +model = + Main.build + { flags + | pages = [ page "one" [ "two" ], page "two" [] ] + , slug = "one" + , box = { width = 200, height = 100, left = 50, top = 20 } + } + + +flags : Main.Flags +flags = + Main.flags0 + + +at : String -> Main.Model -> Main.Node +at id graph = + graph.nodes + |> Array.toList + |> List.filter (\node -> node.id == id) + |> List.head + |> Maybe.withDefault + { id = "", label = "", kind = Main.PageNode, degree = 0, x = 0, y = 0, vx = 0, vy = 0, pinned = False } + + +run : List Main.Msg -> Main.Model -> Main.Model +run messages graph = + List.foldl (\message current -> Tuple.first (Main.update message current)) graph messages + + +{-| The middle of the box, in window coordinates: its corner plus half of it. +-} +middle : Main.Point +middle = + { x = 50 + 100, y = 20 + 50 } + + +suite : Test +suite = + describe "the mouse" + [ describe "reading where it is" + [ test "puts the middle of the box at the middle of the drawing" <| + \_ -> + Main.where_ model middle + |> Expect.equal { x = 0, y = 0 } + , test "measures from the box's corner, not the window's" <| + \_ -> + Main.where_ model { x = 50, y = 20 } + |> Expect.equal { x = -100, y = -50 } + , test "counts a unit as a pixel divided by the zoom" <| + \_ -> + let + closer = + { model | camera = { zoom = 2, x = 0, y = 0 } } + in + Main.where_ closer { x = middle.x + 50, y = middle.y } + |> Expect.equal { x = 25, y = 0 } + ] + , describe "dragging a node" + [ test "picks it up without moving it" <| + \_ -> + let + before = + at "one" model + + after = + at "one" (run [ Main.Grabbed "one" middle ] model) + in + ( after.x, after.y ) |> Expect.equal ( before.x, before.y ) + , test "pins the one it picked up and nothing else" <| + \_ -> + let + held = + run [ Main.Grabbed "one" middle ] model + in + ( (at "one" held).pinned, (at "two" held).pinned ) + |> Expect.equal ( True, False ) + , test "carries it by the distance the mouse travelled" <| + \_ -> + let + before = + at "one" model + + after = + at "one" + (run + [ Main.Grabbed "one" middle + , Main.Moved { x = middle.x + 30, y = middle.y - 10 } + ] + model + ) + in + ( after.x - before.x, after.y - before.y ) + |> Expect.equal ( 30, -10 ) + , test "carries it half as far when the picture is twice as close" <| + \_ -> + let + closer = + { model | camera = { zoom = 2, x = 0, y = 0 } } + + before = + at "one" closer + + after = + at "one" + (run + [ Main.Grabbed "one" middle + , Main.Moved { x = middle.x + 30, y = middle.y } + ] + closer + ) + in + after.x - before.x |> Expect.within (Absolute 1.0e-9) 15 + , test "leaves the others to the forces" <| + \_ -> + let + dragged = + run + [ Main.Grabbed "one" middle + , Main.Moved { x = middle.x + 30, y = middle.y } + ] + model + in + (at "two" dragged).pinned |> Expect.equal False + , test "gives the layout its energy back, so the rest gets out of the way" <| + \_ -> + (run [ Main.Grabbed "one" middle ] { model | alpha = 0 }).alpha + |> Expect.within (Absolute 1.0e-9) 0.3 + , test "lets go of it when the mouse does" <| + \_ -> + let + after = + run + [ Main.Grabbed "one" middle + , Main.Moved { x = middle.x + 30, y = middle.y } + , Main.Released + ] + model + in + ( (at "one" after).pinned, after.drag == Main.Still ) + |> Expect.equal ( False, True ) + , test "does not let a node that was dragged wander off the screen with its own speed" <| + \_ -> + -- A pinned node's velocity is thrown away every tick, so + -- letting go of one leaves it where it was put. + let + held = + run + [ Main.Grabbed "one" middle + , Main.Moved { x = middle.x + 30, y = middle.y } + , Main.Tick + ] + model + in + ( (at "one" held).vx, (at "one" held).vy ) |> Expect.equal ( 0, 0 ) + ] + , describe "the click at the end of a drag" + [ test "is not a link being followed" <| + \_ -> + let + after = + run + [ Main.Grabbed "one" middle + , Main.Moved { x = middle.x + 30, y = middle.y } + , Main.Released + ] + model + in + after.dragged |> Expect.equal True + , test "is a link being followed when the mouse never moved" <| + \_ -> + let + after = + run [ Main.Grabbed "one" middle, Main.Released ] model + in + after.dragged |> Expect.equal False + , test "is swallowed once and only once" <| + \_ -> + let + after = + run + [ Main.Grabbed "one" middle + , Main.Moved { x = middle.x + 30, y = middle.y } + , Main.Released + , Main.Follow "one" + ] + model + in + after.dragged |> Expect.equal False + ] + , describe "panning" + [ test "moves the picture with the hand" <| + \_ -> + let + after = + run + [ Main.Panned middle + , Main.Moved { x = middle.x + 40, y = middle.y + 10 } + ] + model + in + ( after.camera.x, after.camera.y ) |> Expect.equal ( -40, -10 ) + , test "moves it half as far when the picture is twice as close" <| + \_ -> + let + closer = + { model | camera = { zoom = 2, x = 0, y = 0 } } + + after = + run + [ Main.Panned middle + , Main.Moved { x = middle.x + 40, y = middle.y } + ] + closer + in + after.camera.x |> Expect.within (Absolute 1.0e-9) -20 + , test "leaves the nodes exactly where they were" <| + \_ -> + let + after = + run + [ Main.Panned middle + , Main.Moved { x = middle.x + 40, y = middle.y } + ] + model + in + ( (at "one" after).x, (at "one" after).y ) + |> Expect.equal ( (at "one" model).x, (at "one" model).y ) + ] + , describe "zooming" + [ test "keeps whatever is under the pointer under the pointer" <| + \_ -> + let + pointer = + { x = middle.x + 60, y = middle.y - 20 } + + before = + Main.where_ model pointer + + after = + run [ Main.Wheeled -250 pointer ] model + in + Main.where_ after pointer + |> Expect.all + [ .x >> Expect.within (Absolute 1.0e-9) before.x + , .y >> Expect.within (Absolute 1.0e-9) before.y + ] + , test "goes in when the wheel goes up" <| + \_ -> + (run [ Main.Wheeled -500 middle ] model).camera.zoom + |> Expect.within (Absolute 1.0e-9) 2 + , test "goes out when the wheel goes down" <| + \_ -> + (run [ Main.Wheeled 500 middle ] model).camera.zoom + |> Expect.within (Absolute 1.0e-9) 0.5 + , test "stops at four times in" <| + \_ -> + (run (List.repeat 10 (Main.Wheeled -500 middle)) model).camera.zoom + |> Expect.within (Absolute 1.0e-9) 4 + , test "stops at a quarter out" <| + \_ -> + (run (List.repeat 10 (Main.Wheeled 500 middle)) model).camera.zoom + |> Expect.within (Absolute 1.0e-9) 0.25 + ] + , describe "the labels" + [ test "are hidden while the whole graph is in view" <| + \_ -> + Main.labelOpacity { zoom = 1, x = 0, y = 0 } + |> Expect.within (Absolute 1.0e-9) 0 + , test "fade in as the reader zooms into a handful of nodes" <| + \_ -> + Main.labelOpacity { zoom = 2.875, x = 0, y = 0 } + |> Expect.within (Absolute 1.0e-9) 0.5 + , test "never go past opaque, however far in the reader goes" <| + \_ -> + Main.labelOpacity { zoom = 100, x = 0, y = 0 } + |> Expect.within (Absolute 1.0e-9) 1 + ] + , describe "what the box is showing" + [ test "is the whole drawing at rest" <| + \_ -> + Main.viewBox model |> Expect.equal "-100 -50 200 100" + , test "is half of it, around the camera, twice as close" <| + \_ -> + Main.viewBox { model | camera = { zoom = 2, x = 10, y = 5 } } + |> Expect.equal "-40 -20 100 50" + ] + , describe "being told to stop" + [ test "spends the alpha, which is what asks for the next frame" <| + \_ -> + (run [ Main.Halted ] { model | alpha = 1 }).alpha + |> Expect.equal 0 + ] + ] diff --git a/quartz-local/elm-graph/tests/LayoutTest.elm b/quartz-local/elm-graph/tests/LayoutTest.elm new file mode 100644 index 00000000..dd2e7f5d --- /dev/null +++ b/quartz-local/elm-graph/tests/LayoutTest.elm @@ -0,0 +1,209 @@ +module LayoutTest exposing (suite) + +{-| The graph, before anybody has touched it: which nodes are drawn, what they +are called, and where the forces put them. + +These are the parts that were read off d3 and rewritten, so they are the parts +worth pinning down. A browser can show that the picture appears; only this can +say that a link pulls its ends to the distance it was asked for. + +-} + +import Array +import Expect exposing (FloatingPointTolerance(..)) +import Main +import Set +import Test exposing (Test, describe, test) + + + +-- A SMALL SITE +-- +-- index -> blog/one -> blog/two +-- index -> missing (a link to a page that is not there) +-- blog/one is tagged #things + + +page : String -> List String -> List String -> Main.Page +page id links tags = + { id = id, title = String.toUpper id, links = links, tags = tags } + + +pages : List Main.Page +pages = + [ page "index" [ "blog/one", "missing" ] [] + , page "blog/one" [ "blog/two" ] [ "things" ] + , page "blog/two" [] [] + ] + + +{-| The flags a graph with nothing in it is built from, which is where every +fixture here starts. +-} +empty : Main.Flags +empty = + Main.flags0 + + +site : Main.Flags +site = + { empty | pages = pages, slug = "index", showTags = True } + + +at : String -> Main.Model -> Maybe Main.Node +at id model = + model.nodes |> Array.toList |> List.filter (\node -> node.id == id) |> List.head + + +distance : Main.Node -> Main.Node -> Float +distance one other = + sqrt (((one.x - other.x) ^ 2) + ((one.y - other.y) ^ 2)) + + +suite : Test +suite = + describe "the graph" + [ describe "its links" + [ test "run from a page to the pages it links to" <| + \_ -> + Main.allEdges site + |> List.member ( "index", "blog/one" ) + |> Expect.equal True + , test "leave out a link to a page that is not there" <| + \_ -> + Main.allEdges site + |> List.member ( "index", "missing" ) + |> Expect.equal False + , test "include the tags a page carries" <| + \_ -> + Main.allEdges site + |> List.member ( "blog/one", "tags/things" ) + |> Expect.equal True + , test "leave the tags out when the tags are turned off" <| + \_ -> + Main.allEdges { site | showTags = False } + |> List.member ( "blog/one", "tags/things" ) + |> Expect.equal False + , test "leave out a tag that was asked to be left out" <| + \_ -> + Main.allEdges { site | removeTags = [ "things" ] } + |> List.member ( "blog/one", "tags/things" ) + |> Expect.equal False + ] + , describe "its neighbourhood" + [ test "at no depth at all is the page and nothing else" <| + \_ -> + Main.neighbourhood 0 "index" (Main.allEdges site) + |> Expect.equal (Set.fromList [ "index" ]) + , test "at one step is what the page touches" <| + \_ -> + Main.neighbourhood 1 "index" (Main.allEdges site) + |> Expect.equal (Set.fromList [ "index", "blog/one" ]) + , test "at two steps is what those touch, in either direction" <| + \_ -> + Main.neighbourhood 2 "index" (Main.allEdges site) + |> Expect.equal + (Set.fromList [ "index", "blog/one", "blog/two", "tags/things" ]) + , test "walks a link backwards as readily as forwards" <| + \_ -> + Main.neighbourhood 1 "blog/two" (Main.allEdges site) + |> Expect.equal (Set.fromList [ "blog/two", "blog/one" ]) + , test "at a negative depth is the whole site" <| + \_ -> + Main.neighbourhood -1 "index" (Main.allEdges site) + |> Set.size + |> Expect.equal 4 + ] + , describe "its nodes" + [ test "are the neighbourhood, one apiece" <| + \_ -> + Main.build { site | depth = -1 } + |> .nodes + |> Array.length + |> Expect.equal 4 + , test "carry the page's title" <| + \_ -> + Main.build { site | depth = 1 } + |> at "blog/one" + |> Maybe.map .label + |> Expect.equal (Just "BLOG/ONE") + , test "fall back to the slug when a page has no title" <| + \_ -> + Main.build { site | pages = [ page "index" [] [], { id = "blog/one", title = "", links = [ "index" ], tags = [] } ] } + |> at "blog/one" + |> Maybe.map .label + |> Expect.equal (Just "blog/one") + , test "write a tag as a tag" <| + \_ -> + Main.build { site | depth = -1 } + |> at "tags/things" + |> Maybe.map (\node -> ( node.label, node.kind )) + |> Expect.equal (Just ( "#things", Main.TagNode )) + , test "have a radius of two plus the root of their links" <| + \_ -> + Main.build { site | depth = -1 } + |> at "blog/one" + |> Maybe.map Main.radius + |> Maybe.withDefault 0 + |> Expect.within (Absolute 1.0e-9) (2 + sqrt 3) + ] + , describe "where they start" + [ test "is never two nodes in the same place" <| + \_ -> + let + seeds = + List.range 0 99 |> List.map Main.phyllotaxis + in + seeds + |> Set.fromList + |> Set.size + |> Expect.equal (List.length seeds) + , test "is the same spiral every time the page is opened" <| + \_ -> + Main.phyllotaxis 7 + |> Expect.equal (Main.phyllotaxis 7) + ] + , describe "where the forces put them" + [ test "puts two linked pages about a link's length apart" <| + \_ -> + let + laid = + Main.lay (Main.build { site | depth = 1, showTags = False }) + + apart = + Maybe.map2 distance (at "index" laid) (at "blog/one" laid) + |> Maybe.withDefault 0 + in + Expect.all + [ \value -> Expect.greaterThan 20 value + , \value -> Expect.lessThan 45 value + ] + apart + , test "is centred on the middle of the box" <| + \_ -> + let + laid = + Main.lay (Main.build { site | depth = -1 }) + + middle = + laid.nodes + |> Array.toList + |> List.foldl (\node total -> total + node.x) 0 + in + Expect.within (Absolute 1) 0 middle + , test "leaves nothing at a number that is not one" <| + \_ -> + Main.lay (Main.build { site | depth = -1 }) + |> .nodes + |> Array.toList + |> List.all (\node -> not (isNaN node.x) && not (isNaN node.y)) + |> Expect.equal True + , test "stops moving once the alpha is spent" <| + \_ -> + let + laid = + Main.lay (Main.build { site | depth = -1, reducedMotion = True }) + in + Expect.within (Absolute 1.0e-12) 0 laid.alpha + ] + ] diff --git a/tools/site/src/build.rs b/tools/site/src/build.rs index a3d8a339..8845178d 100644 --- a/tools/site/src/build.rs +++ b/tools/site/src/build.rs @@ -403,6 +403,7 @@ impl Site { self.run(&self.root, "cargo", &check_args)?; self.run(&self.root, "cargo", &test_args)?; self.wasm(Mode::Dev)?; + self.elm_test()?; self.check_typescript() } diff --git a/tools/site/src/elm.rs b/tools/site/src/elm.rs index cdd9d795..2cfff381 100644 --- a/tools/site/src/elm.rs +++ b/tools/site/src/elm.rs @@ -25,6 +25,13 @@ const OUTPUT: &str = "content/js/elm.js"; /// it can be read. const RAW: &str = "content/js/elm.raw.js"; +/// The runner, when it has to come from npm. +/// +/// elm-test's versions are named for the compiler they drive, and the plain +/// `latest` is `0.19.2-1`, for a compiler that is not out: it writes an +/// elm.json asking for Elm 0.19.2 and then refuses the 0.19.1 that answers. +const ELM_TEST: &str = "elm-test@0.19.1-revision12"; + impl Site { pub(crate) fn elm(&self, mode: Mode) -> Result<()> { let source = self.root.join("quartz-local/elm-graph"); @@ -54,6 +61,30 @@ impl Site { } } + /// Runs the graph's own tests. + /// + /// They are the half of it a browser cannot be made to show: the forces + /// settling a link to the length it was asked for, a drag carrying a node + /// by exactly the distance the mouse moved, a wheel keeping whatever is + /// under the pointer under the pointer. The compiler cannot check any of + /// that, and neither can a screenshot. + pub(crate) fn elm_test(&self) -> Result<()> { + let source = self.root.join("quartz-local/elm-graph"); + if !source.join("tests").is_dir() { + return Err(Box::new(SiteError::new( + "no tests directory in quartz-local/elm-graph", + ))); + } + + // The dev shell has it; a machine without nix gets it from npm, which + // is where the pinned version above earns its keep. + if command_succeeds("elm-test", &["--version"]) { + return self.run(&source, "elm-test", &[]); + } + + self.run_bun(&source, &os_args(&["x", ELM_TEST])) + } + fn compile(&self, source: &Path, output: &Path, mode: Mode) -> Result<()> { let program = elm_program().ok_or_else(|| { SiteError::new( diff --git a/tools/site/src/main.rs b/tools/site/src/main.rs index 87b95f4e..21b566b4 100644 --- a/tools/site/src/main.rs +++ b/tools/site/src/main.rs @@ -112,6 +112,7 @@ fn run_main() -> Result<()> { "build" => site.build(parse_mode(&args[1..], Mode::default_for(site.ci))?), "wasm" => site.wasm(parse_mode(&args[1..], Mode::default_for(site.ci))?), "elm" => site.elm(parse_mode(&args[1..], Mode::default_for(site.ci))?), + "elm-test" => site.elm_test(), "generate" => site.generate(), "links" | "collect-links" => site.links(), "indices" => site.indices(), @@ -187,6 +188,7 @@ Commands: --dev also watches TypeScript bundles wasm [--dev|--prod] build only the wasm and TypeScript bundle elm [--dev|--prod] build only the Elm graph + elm-test run the Elm graph's tests generate regenerate link lists, indices, and chords links regenerate plaintext link lists indices regenerate misc indices diff --git a/ts/src/graph.ts b/ts/src/graph.ts index 8a396b59..a85a0d3a 100644 --- a/ts/src/graph.ts +++ b/ts/src/graph.ts @@ -22,16 +22,26 @@ interface ElmSubscription { subscribe(handler: (value: T) => void): void } -interface Size { +/** + * The container, as Elm needs it: how big, and where in the window. + * + * The corner is there because a mouse event says where it happened in the + * window and the graph works in the units of its own drawing. Elm can read + * properties off an event but cannot call `getBoundingClientRect`, so the + * measuring happens here. + */ +interface Box { width: number height: number + left: number + top: number } interface ElmApp { ports: { follow: ElmSubscription failed: ElmSubscription - resized: ElmPort + resized: ElmPort halt: ElmPort } } @@ -168,13 +178,17 @@ function pages(): Promise { return index } -function size(container: HTMLElement): Size { +function size(container: HTMLElement): Box { + const box = container.getBoundingClientRect() + return { - width: Math.max(container.clientWidth, 100), + width: Math.max(box.width, 100), // A container that has not been laid out yet -- the whole-site graph, // before its dialog is opened -- measures zero, and a graph in a box of no // height is a graph nobody can see. - height: Math.max(container.clientHeight, 250), + height: Math.max(box.height, 250), + left: box.left, + top: box.top, } } @@ -303,9 +317,42 @@ function expandable(): void { } } +/** + * The corner moves when the page scrolls, and nothing tells the graph that: a + * `ResizeObserver` watches the size and says nothing about where the box has + * got to. Without this, zooming a graph the reader has scrolled to would zoom + * about the wrong point. + * + * Once a frame at most, and only while there is a graph on the page. + */ +function watchScrolling(): void { + if (scrolling) return + scrolling = true + + let waiting = false + addEventListener( + "scroll", + () => { + if (waiting) return + waiting = true + + requestAnimationFrame(() => { + waiting = false + for (const container of document.querySelectorAll(".elm-graph-container")) { + mounts.get(container)?.app.ports.resized.send(size(container)) + } + }) + }, + { passive: true, capture: true }, + ) +} + +let scrolling = false + function boot(): void { initialise() expandable() + watchScrolling() } if (document.readyState === "loading") { From add9326d2ec0adb7a4ee75ce64cfcff720c9de0b Mon Sep 17 00:00:00 2001 From: hill Date: Wed, 26 Aug 2026 21:28:21 +0200 Subject: [PATCH 5/5] Open the graph by clicking it, and let the page show through Two things from watching it in use. The whole-site graph was behind a button in the corner of the box, which is easy to miss and easy to mis-click. A click on the graph's own background opens it now -- down and up in the same place, since dragging the background is how the picture is panned and that must not open anything. Elm says only that a click happened, through a port; the page decides what it means, which is how the big graph's own background can click without asking to be opened again. And the big graph had a background of its own, so it hid the page it is a graph of. It has none now: the dimming behind it is the whole effect, the article goes on showing through it the way the sidebars already did, and the thing reads as this site's graph rather than a window laid over the top of it. The drag threshold now covers a held node too, not just a panned background. Pressing a trackpad moves the pointer a pixel or two on the way down, and every one of those was a drag rather than a click, so a node would refuse to follow its own link about half the time. Three pixels of travel is the same allowance panning already had. Fifty three tests now, including that a two-pixel twitch still follows the link and that a click on the background asks to expand while the end of a pan does not. --- quartz-local/elm-graph/README.md | 17 ++++--- quartz-local/elm-graph/src/Main.elm | 51 ++++++++++++++++--- quartz-local/elm-graph/styles.ts | 5 +- .../elm-graph/tests/InteractionTest.elm | 31 +++++++++++ ts/src/graph.ts | 29 ++++++++--- 5 files changed, 109 insertions(+), 24 deletions(-) diff --git a/quartz-local/elm-graph/README.md b/quartz-local/elm-graph/README.md index 4c3aed56..1d877e18 100644 --- a/quartz-local/elm-graph/README.md +++ b/quartz-local/elm-graph/README.md @@ -69,6 +69,7 @@ port: | port | direction | what it carries | | --------- | --------- | ---------------------------------------------------------------------- | | `follow` | out | the id of a clicked node, which the page hands to Quartz's router | +| `expand` | out | a click on the background, which the page turns into the big graph | | `failed` | out | why flags could not be read, for the console | | `resized` | in | where the container is and how big, from a `ResizeObserver` and scroll | | `halt` | in | stop: this app's view has been patched out of the page | @@ -100,12 +101,16 @@ instead, which the page turns into a URL the router can read. Dragging a node pins it: the forces go on pushing at it, it does not move, and everything else rearranges itself around where it has been put. Letting go unpins it. A node is also a link, so the click that ends a drag would otherwise -follow it — the drag remembers whether the mouse travelled more than three -pixels, and the click after one that did is swallowed. - -Dragging the background pans, and the wheel zooms about the pointer, between a -quarter and four times, on d3's own curve of two to the power of the delta over -five hundred. Both are the `viewBox` and nothing else: no transform on the +follow it — every drag remembers whether the mouse travelled more than three +pixels, and the click after one that did is swallowed. Three rather than one +because pressing a trackpad moves the pointer a little on the way down, and +that is a click. + +A click on the background — down and up in the same place — opens the +whole-site graph, because the button in the corner is easy to miss and a graph +that small is mostly an invitation to see a bigger one. Dragging the background +pans instead, and the wheel zooms about the pointer, between a quarter and four +times, on d3's own curve of two to the power of the delta over five hundred. Both are the `viewBox` and nothing else: no transform on the nodes, no second coordinate system, and a stylesheet that goes on measuring strokes and font sizes in the units it was written in. Labels fade in above life size, which is the old graph's arithmetic, so that zooming into a corner diff --git a/quartz-local/elm-graph/src/Main.elm b/quartz-local/elm-graph/src/Main.elm index d300a920..60314eb9 100644 --- a/quartz-local/elm-graph/src/Main.elm +++ b/quartz-local/elm-graph/src/Main.elm @@ -54,6 +54,16 @@ pages have been visited, so it is the side that writes this one down. port follow : String -> Cmd msg +{-| A click on the background, asking for the whole-site graph. + +The button in the corner of the box is easy to miss, and a graph that small is +mostly an invitation to see a bigger one. What to do about it is the page's to +decide -- the big graph's own background is not a request to open the big +graph. +-} +port expand : () -> Cmd msg + + {-| Said out loud rather than swallowed: flags this cannot read mean a graph that cannot be drawn, and the reason belongs in the console where whoever changed the shape of them will see it. @@ -134,7 +144,7 @@ the hand that hauled it meant. -} type Drag = Still - | Holding { id : String, grab : Point, moved : Bool } + | Holding { id : String, grab : Point, from : Point, moved : Bool } | Panning { from : Point, moved : Bool } @@ -892,6 +902,7 @@ update msg model = Holding { id = id , grab = grabbed model id held + , from = at , moved = False } , nodes = pin id model.nodes @@ -916,7 +927,11 @@ update msg model = , dragged = wasMoved model.drag , nodes = Array.map (\node -> { node | pinned = False }) model.nodes } - , Cmd.none + , if expands model.drag then + expand () + + else + Cmd.none ) Wheeled delta at -> @@ -954,6 +969,20 @@ pin id nodes = Array.map (\node -> { node | pinned = node.id == id }) nodes +{-| A click on the background rather than a drag of it: down and up in the same +place, with nothing in between. Letting go of a node is not it, and neither is +the end of a pan, which is a hand that meant to move the picture. +-} +expands : Drag -> Bool +expands drag = + case drag of + Panning pan -> + not pan.moved + + _ -> + False + + wasMoved : Drag -> Bool wasMoved drag = case drag of @@ -969,12 +998,21 @@ wasMoved drag = {-| A pixel or two of travel is a click with a shaky hand; more than that is a drag, and is not a link being followed. + +A trackpad is what this is for. Pressing one moves the pointer a pixel or two +on the way down more often than not, and without this every click on a node +would be a drag of it and would never follow the link. -} slop : Float slop = 3 +travelled : Point -> Point -> Bool +travelled from to = + abs (to.x - from.x) + abs (to.y - from.y) > slop + + moved : Point -> Model -> Model moved at model = case model.drag of @@ -997,7 +1035,8 @@ moved at model = node ) model.nodes - , drag = Holding { held | moved = True } + , drag = + Holding { held | moved = held.moved || travelled held.from at } , alpha = max model.alpha 0.3 } @@ -1015,11 +1054,7 @@ moved at model = , x = model.camera.x - dx / model.camera.zoom , y = model.camera.y - dy / model.camera.zoom } - , drag = - Panning - { from = at - , moved = pan.moved || abs dx + abs dy > slop - } + , drag = Panning { from = at, moved = pan.moved || travelled pan.from at } } diff --git a/quartz-local/elm-graph/styles.ts b/quartz-local/elm-graph/styles.ts index 1cd1fd4a..dea34aea 100644 --- a/quartz-local/elm-graph/styles.ts +++ b/quartz-local/elm-graph/styles.ts @@ -145,10 +145,11 @@ export const styles = ` display: none; } +/* No background of its own: the page's own words go on showing through the + dimming behind it, which is what makes this the site's graph rather than a + window laid over the top of it. */ .elm-graph-modal .elm-graph-container { width: min(85vw, 60rem); height: min(85vh, 45rem); - border-radius: 5px; - background: var(--light); } ` diff --git a/quartz-local/elm-graph/tests/InteractionTest.elm b/quartz-local/elm-graph/tests/InteractionTest.elm index 7f9dc826..145d84fb 100644 --- a/quartz-local/elm-graph/tests/InteractionTest.elm +++ b/quartz-local/elm-graph/tests/InteractionTest.elm @@ -193,6 +193,20 @@ suite = model in after.dragged |> Expect.equal True + , test "is a link being followed when the hand only twitched" <| + \_ -> + -- Pressing a trackpad moves the pointer a pixel or two on + -- the way down, and that is a click, not a drag. + let + after = + run + [ Main.Grabbed "one" middle + , Main.Moved { x = middle.x + 2, y = middle.y + 1 } + , Main.Released + ] + model + in + after.dragged |> Expect.equal False , test "is a link being followed when the mouse never moved" <| \_ -> let @@ -214,6 +228,23 @@ suite = in after.dragged |> Expect.equal False ] + , describe "a click on the background" + [ test "asks for the whole-site graph" <| + \_ -> + Main.expands (Main.Panning { from = middle, moved = False }) + |> Expect.equal True + , test "does not, when the hand was panning" <| + \_ -> + Main.expands (Main.Panning { from = middle, moved = True }) + |> Expect.equal False + , test "is not what letting go of a node is" <| + \_ -> + Main.expands + (Main.Holding + { id = "one", grab = { x = 0, y = 0 }, from = middle, moved = False } + ) + |> Expect.equal False + ] , describe "panning" [ test "moves the picture with the hand" <| \_ -> diff --git a/ts/src/graph.ts b/ts/src/graph.ts index a85a0d3a..8e7ca8d3 100644 --- a/ts/src/graph.ts +++ b/ts/src/graph.ts @@ -40,6 +40,7 @@ interface Box { interface ElmApp { ports: { follow: ElmSubscription + expand: ElmSubscription failed: ElmSubscription resized: ElmPort halt: ElmPort @@ -229,6 +230,12 @@ function start(container: HTMLElement): void { console.error("[graph]", reason) }) + app.ports.expand.subscribe(() => { + // Only the small one opens the big one. A click on the big one's own + // background is a click on the graph the reader is already looking at. + if (container.closest(".elm-graph-modal") === null) open() + }) + app.ports.follow.subscribe((id) => { remember(id) const url = new URL(`${basePath()}/${id}`, window.location.href) @@ -284,10 +291,20 @@ function initialise(): void { let listening = false /** - * The whole-site graph, drawn only when it is asked for: it is the same - * simulation over every page rather than a dozen, and there is no reason to - * run it behind a closed dialog. + * Show the whole-site graph, drawing it if this is the first time anyone has + * asked: it is the same simulation over every page rather than a dozen, and + * there is no reason to run it behind a closed dialog. */ +function open(): void { + const modal = document.querySelector(".elm-graph-modal") + if (modal === null) return + + modal.hidden = false + + const container = modal.querySelector(".elm-graph-container") + if (container !== null && !taken.has(container)) start(container) +} + function expandable(): void { const button = document.querySelector(".elm-graph-expand") const modal = document.querySelector(".elm-graph-modal") @@ -295,11 +312,7 @@ function expandable(): void { // Assigned rather than added: a soft navigation can hand back the same // elements, and adding would stack a second handler on each of them. - button.onclick = () => { - modal.hidden = false - const container = modal.querySelector(".elm-graph-container") - if (container !== null && !taken.has(container)) start(container) - } + button.onclick = open modal.onclick = (event) => { if (event.target === modal) modal.hidden = true