From 3a1ae81f08e773ad029ede9eea2b035abdd1f1c8 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 8 Jul 2024 22:08:10 +0100 Subject: [PATCH 1/6] Not so much of a branch, more a whole new project --- .gitignore | 2 + .lein-failures | 1 + README.md | 4 +- project.clj | 76 +++++++++-------- .../css/{swingometer.css => rsvggraph.css} | 37 ++++---- resources/public/index.html | 6 +- resources/public/sample-data.edn | 40 +++++++++ src/clj/rsvggraph/core.clj | 1 + src/clj/rsvggraph/data.clj | 29 +++++++ src/clj/swingometer/core.clj | 1 - .../{swingometer => rsvggraph}/config.cljs | 2 +- src/cljs/{swingometer => rsvggraph}/core.cljs | 10 +-- src/cljs/{swingometer => rsvggraph}/db.cljs | 2 +- .../{swingometer => rsvggraph}/events.cljs | 4 +- .../rsvggraph.cljs} | 84 ++++++++++--------- src/cljs/{swingometer => rsvggraph}/subs.cljs | 2 +- .../{swingometer => rsvggraph}/utils.cljs | 2 +- .../{swingometer => rsvggraph}/views.cljs | 24 +++--- 18 files changed, 204 insertions(+), 123 deletions(-) create mode 100644 .lein-failures rename resources/public/css/{swingometer.css => rsvggraph.css} (64%) create mode 100644 resources/public/sample-data.edn create mode 100644 src/clj/rsvggraph/core.clj create mode 100644 src/clj/rsvggraph/data.clj delete mode 100644 src/clj/swingometer/core.clj rename src/cljs/{swingometer => rsvggraph}/config.cljs (60%) rename src/cljs/{swingometer => rsvggraph}/core.cljs (71%) rename src/cljs/{swingometer => rsvggraph}/db.cljs (66%) rename src/cljs/{swingometer => rsvggraph}/events.cljs (64%) rename src/cljs/{swingometer/swingometer.cljs => rsvggraph/rsvggraph.cljs} (81%) rename src/cljs/{swingometer => rsvggraph}/subs.cljs (87%) rename src/cljs/{swingometer => rsvggraph}/utils.cljs (99%) rename src/cljs/{swingometer => rsvggraph}/views.cljs (94%) diff --git a/.gitignore b/.gitignore index 713f40a..94ac55c 100644 --- a/.gitignore +++ b/.gitignore @@ -11,3 +11,5 @@ out *.tgz *.zip +.lsp/ +.clj-kondo/ diff --git a/.lein-failures b/.lein-failures new file mode 100644 index 0000000..9e26dfe --- /dev/null +++ b/.lein-failures @@ -0,0 +1 @@ +{} \ No newline at end of file diff --git a/README.md b/README.md index 41864ea..a757805 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ -# swingometer +# radial-svg-graph -A [re-frame](https://github.com/Day8/re-frame) application designed to show votes in an election. +A [re-frame](https://github.com/Day8/re-frame) application designed to show a radial SVG graph, possibly with several rings. ## Development Mode diff --git a/project.clj b/project.clj index 5f25843..82d098d 100644 --- a/project.clj +++ b/project.clj @@ -1,11 +1,17 @@ -(defproject swingometer "0.1.0-SNAPSHOT" - :dependencies [[org.clojure/clojure "1.8.0"] - [org.clojure/clojurescript "1.9.229"] - [reagent "0.6.0"] - [re-frame "0.9.4"] - [re-com "2.0.0"]] +(defproject rsvggraph "0.1.0-SNAPSHOT" + :dependencies [[clojure2d "1.4.5"] ;; (mainly) for colours + [generateme/fastmath "2.4.0"] + [hiccup "2.0.0-RC3"] + [javax.xml.bind/jaxb-api "2.4.0-b180830.0359"] + [org.clojure/clojure "1.8.0"] + ;; [org.clojure/clojurescript "1.9.229"] + ;; [org.omcljs/om "1.0.0-beta1"] + ;; [reagent "0.6.0"] + ;; [re-frame "0.9.4"] + ;; [re-com "2.0.0"] + ] - :plugins [[lein-cljsbuild "1.1.4"]] + ;; :plugins [[lein-cljsbuild "1.1.4"]] :min-lein-version "2.5.3" @@ -15,36 +21,32 @@ :figwheel {:css-dirs ["resources/public/css"]} - :profiles - {:dev - {:dependencies [[binaryage/devtools "0.8.2"]] + ;; :profiles + ;; {:dev + ;; {:dependencies [[binaryage/devtools "0.8.2"]] - :plugins [[lein-figwheel "0.5.9"]] - }} + ;; :plugins [[lein-figwheel "0.5.9"]] + ;; }} - :cljsbuild - {:builds - [{:id "dev" - :source-paths ["src/cljs"] - :figwheel {:on-jsload "swingometer.core/mount-root"} - :compiler {:main swingometer.core - :output-to "resources/public/js/compiled/app.js" - :output-dir "resources/public/js/compiled/out" - :asset-path "js/compiled/out" - :source-map-timestamp true - :preloads [devtools.preload] - :external-config {:devtools/config {:features-to-install :all}} - }} + ;; :cljsbuild + ;; {:builds + ;; [{:id "dev" + ;; :source-paths ["src/cljs"] + ;; :figwheel {:on-jsload "rsvggraph.core/mount-root"} + ;; :compiler {:main rsvggraph.core + ;; :output-to "resources/public/js/compiled/app.js" + ;; :output-dir "resources/public/js/compiled/out" + ;; :asset-path "js/compiled/out" + ;; :source-map-timestamp true + ;; :preloads [devtools.preload] + ;; :external-config {:devtools/config {:features-to-install :all}} + ;; }} - {:id "min" - :source-paths ["src/cljs"] - :compiler {:main swingometer.core - :output-to "resources/public/js/compiled/app.js" - :optimizations :advanced - :closure-defines {goog.DEBUG false} - :pretty-print false}} - - - ]} - - ) + ;; {:id "min" + ;; :source-paths ["src/cljs"] + ;; :compiler {:main rsvggraph.core + ;; :output-to "resources/public/js/compiled/app.js" + ;; :optimizations :advanced + ;; :closure-defines {goog.DEBUG false} + ;; :pretty-print false}}]}) +) diff --git a/resources/public/css/swingometer.css b/resources/public/css/rsvggraph.css similarity index 64% rename from resources/public/css/swingometer.css rename to resources/public/css/rsvggraph.css index fe3fe55..fc64d5b 100644 --- a/resources/public/css/swingometer.css +++ b/resources/public/css/rsvggraph.css @@ -1,70 +1,73 @@ /***************************************************************************\ * * - * swinging-needle-meter.css * + * rsvggraph.css * * * - * CSS styling for the swinging needle meter itself. * + * CSS styling for the radial svg graph itself. * * * \***************************************************************************/ -.snm-cursor { +svg { + border: thin solid gray; + object-fit: contain; +} + +.rsvggraph-cursor { stroke:#ff8500; stroke-width: 3%; stroke-opacity: 0.5; } -.snm-frame { +.rsvggraph-frame { fill: none; - stroke-width: 5%; - stroke-linejoin: round; - stroke: #444444; + stroke: none; } -.snm-gradation path { +.rsvggraph-gradation path { stroke: black; stroke-width: 1; } -.snm-gradation text { +.rsvggraph-gradation text { font-size: 200%; font-weight: lighter; } -.snm-hub { +.rsvggraph-hub { fill: #444444; } -.snm-meter { +.rsvggraph-graph { height: 50%; width: auto; } -.snm-needle { +.rsvggraph-needle { stroke: black; stroke-width: 1; } -.snm-redzone { +.rsvggraph-redzone { fill:none; stroke: maroon; stroke-width: 10%; } -.snm-scale { +.rsvggraph-scale { fill: none; stroke: silver; stroke-width: 10%; } -.snm-target .snm-frame { +.rsvggraph-target .rsvggraph-frame { stroke: green; } -.snm-value { +.rsvggraph-value { font-size: 400%; font-weight: bold; text-align: center; } -.snm-warning .snm-frame { +.rsvggraph-warning .rsvggraph-frame { stroke: maroon; } diff --git a/resources/public/index.html b/resources/public/index.html index f4b2849..70e6e2a 100644 --- a/resources/public/index.html +++ b/resources/public/index.html @@ -5,16 +5,16 @@ - + - Example swingometer following re-com conventions. + Example rsvggraph following re-com conventions.
- + diff --git a/resources/public/sample-data.edn b/resources/public/sample-data.edn new file mode 100644 index 0000000..fe1ca2b --- /dev/null +++ b/resources/public/sample-data.edn @@ -0,0 +1,40 @@ +{:id "ge2024" + :label "UK General Election 2024" + :children [{:id "no-show" + :label "Did not vote" + :magnitude 18365357} + {:id "voted" + :label "Voted" + :children [{:id "reform" + :label "Reform UK Ltd." + :magnitude 4091549} + {:id "greenew" + :label "Green Party of England and Wales" + :magnitude 1939502} + {:id "pc" + :label "Plaid Cymru" + :magnitude 194811} + {:id "sf" + :label "Sinn Féin" + :magnitude 210891} + {:id "ld" + :label "Liberal Democrats" + :magnitude 3499933} + {:id "labour" + :label "Labour" + :magnitude 9712011} + {:id "apni" + :label "Alliance Party" + :magnitude 117191} + {:id "sdlp" + :label "Social Democratic and Labour Party" + :magnitude 86861} + {:id "dup" + :label "Democratic Unionist Party" + :magnitude 172058} + {:id "snp" + :label "Scottish National Party" + :magnitude 708759} + {:id "con" + :label "Conservative" + :magnitude 6814469}]}]} \ No newline at end of file diff --git a/src/clj/rsvggraph/core.clj b/src/clj/rsvggraph/core.clj new file mode 100644 index 0000000..b08bdd2 --- /dev/null +++ b/src/clj/rsvggraph/core.clj @@ -0,0 +1 @@ +(ns rsvggraph.core) diff --git a/src/clj/rsvggraph/data.clj b/src/clj/rsvggraph/data.clj new file mode 100644 index 0000000..090e1df --- /dev/null +++ b/src/clj/rsvggraph/data.clj @@ -0,0 +1,29 @@ +(ns rsvggraph.data + "Normalise data for use in generating radial graphs." + (:require [clojure2d.color :refer [gradient]])) + + +(def ;; ^:dynamic + *gradient* + "The gradient to use to automatically assign pleasing colours to sectors, if + no colours are defined in the data. Suitable gradients are defined + [here](https://clojure2d.github.io/clojure2d/docs/static/gradients/)." + :rainbow2) + +(def children-fn + "Basic (overridable) children function; assumes `data` is a map, and returns + the value of the `:children` key within that map." + (memoize (fn [data] + (:children data)))) + +(def quantity-fn + "Basic (overridable) children function; assumes `data` is a map. If the value + of the `:children` key within that map is a sequence, sums the result of + mapping itself over that sequence. Otherwise, returns the value of the + `:quantity` key, if present and a number, or `1` as a final default." + (memoize (fn [data] + (let [c (children-fn data) + q (:quantity data)] + (cond (coll? c) (reduce + 0 (map quantity-fn c)) + (number? q) q + :else 1))))) \ No newline at end of file diff --git a/src/clj/swingometer/core.clj b/src/clj/swingometer/core.clj deleted file mode 100644 index 074ad0f..0000000 --- a/src/clj/swingometer/core.clj +++ /dev/null @@ -1 +0,0 @@ -(ns swingometer.core) diff --git a/src/cljs/swingometer/config.cljs b/src/cljs/rsvggraph/config.cljs similarity index 60% rename from src/cljs/swingometer/config.cljs rename to src/cljs/rsvggraph/config.cljs index 28207bf..e8ee763 100644 --- a/src/cljs/swingometer/config.cljs +++ b/src/cljs/rsvggraph/config.cljs @@ -1,4 +1,4 @@ -(ns swingometer.config) +(ns rsvggraph.config) (def debug? ^boolean goog.DEBUG) diff --git a/src/cljs/swingometer/core.cljs b/src/cljs/rsvggraph/core.cljs similarity index 71% rename from src/cljs/swingometer/core.cljs rename to src/cljs/rsvggraph/core.cljs index c3ff728..a2c11de 100644 --- a/src/cljs/swingometer/core.cljs +++ b/src/cljs/rsvggraph/core.cljs @@ -1,10 +1,10 @@ -(ns swingometer.core +(ns rsvggraph.core (:require [reagent.core :as reagent] [re-frame.core :as re-frame] - [swingometer.events] - [swingometer.subs] - [swingometer.views :as views] - [swingometer.config :as config])) + [rsvggraph.events] + [rsvggraph.subs] + [rsvggraph.views :as views] + [rsvggraph.config :as config])) (defn dev-setup [] diff --git a/src/cljs/swingometer/db.cljs b/src/cljs/rsvggraph/db.cljs similarity index 66% rename from src/cljs/swingometer/db.cljs rename to src/cljs/rsvggraph/db.cljs index 01662fd..bc6b00e 100644 --- a/src/cljs/swingometer/db.cljs +++ b/src/cljs/rsvggraph/db.cljs @@ -1,4 +1,4 @@ -(ns swingometer.db) +(ns rsvggraph.db) (def default-db {:name "re-frame"}) diff --git a/src/cljs/swingometer/events.cljs b/src/cljs/rsvggraph/events.cljs similarity index 64% rename from src/cljs/swingometer/events.cljs rename to src/cljs/rsvggraph/events.cljs index 36613fd..9a733d8 100644 --- a/src/cljs/swingometer/events.cljs +++ b/src/cljs/rsvggraph/events.cljs @@ -1,6 +1,6 @@ -(ns swingometer.events +(ns rsvggraph.events (:require [re-frame.core :as re-frame] - [swingometer.db :as db])) + [rsvggraph.db :as db])) (re-frame/reg-event-db :initialize-db diff --git a/src/cljs/swingometer/swingometer.cljs b/src/cljs/rsvggraph/rsvggraph.cljs similarity index 81% rename from src/cljs/swingometer/swingometer.cljs rename to src/cljs/rsvggraph/rsvggraph.cljs index d096e85..521488b 100644 --- a/src/cljs/swingometer/swingometer.cljs +++ b/src/cljs/rsvggraph/rsvggraph.cljs @@ -1,14 +1,13 @@ -(ns swingometer.swingometer +(ns rsvggraph.rsvggraph (:require [clojure.string :as string] [re-com.core :refer [h-box v-box box gap line label title slider checkbox p]] [re-com.box :refer [flex-child-style]] [re-com.util :refer [deref-or-value]] - [re-com.validate :refer [number-or-string? css-style? html-attr? validate-args-macro]] - [reagent.core :as reagent])) + [re-com.validate :refer [number-or-string? css-style? html-attr? validate-args-macro]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; -;;;; swingometer: an experiment in animating SVG from re-frame. +;;;; rsvggraph: an experiment in animating SVG from re-frame. ;;;; Draws heavily on re-com.. ;;;; ;;;; This program is free software; you can redistribute it and/or @@ -31,12 +30,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ------------------------------------------------------------------------------------ -;; Component: swingometer +;; Component: rsvggraph ;; ------------------------------------------------------------------------------------ ;;; It seems the defaults given here are just documentation; the defaults ;;; that are actually used are those given in the :or clause of the argument map. -(def swingometer-args-desc +(def rsvggraph-args-desc [{:name :model :required true :type "map | atom" :validate-fn map? :description "A map mapping keys to maps of the following structure: {:id :snp :name \"Scottish National Party\" :colour \"yellow\" :votes 1234}"} {:name :width :required false :type "integer" :default "300" @@ -45,12 +44,12 @@ :validate-fn integer? :description "a CSS height"} {:name :class :required false :type "string" :validate-fn string? :description "CSS class names, space separated, for the top-level SVG element"} - {:name :frame-class :required false :type "string" :default "snm-frame" + {:name :frame-class :required false :type "string" :default "rsvggraph-frame" :validate-fn string? :description "CSS class names, space separated, for the frame"} - {:name :scale-class :required false :type "string" :default "snm-scale" + {:name :scale-class :required false :type "string" :default "rsvggraph-scale" :validate-fn string? :description "CSS class names, space separated, for the scale"} - {:name :id :required false :type "string" :default "meter" - :validate-fn string? :description "Element id for this instance of the meter"} + {:name :id :required false :type "string" :default "graph" + :validate-fn string? :description "Element id for this instance of the graph"} {:name :gradations :reduired false :type "integer" :default 5 :validate-fn integer? :description "Number of gradations to show on the scale, not counting the point."} {:name :style :required false :type "CSS style map" @@ -59,9 +58,9 @@ :validate-fn html-attr? :description [:span "HTML attributes, like " [:code ":on-mouse-move"] [:br] "No " [:code ":class"] " or " [:code ":style"] "allowed"]}]) -;; the constant 140 represents the full sweep of the needle -;; from the left end of the scale to right end, in degrees. -(def full-scale-deflection 140) +(def full-scale-deflection + "the full sweep of the needle from the left end of the scale to right end, in degrees." + 360) (defn deflection @@ -112,7 +111,7 @@ at `cx`, cy` starting at `min-radius` and extending to `max-radius`, with the specified `label`." [cx cy min-radius max-radius angle label] - [:g {:class "snm-gradation" + [:g {:class "rsvggraph-gradation" :transform (string/join " " ["rotate(" angle cx cy ")"])} [:path {:d (string/join " " @@ -157,63 +156,68 @@ others (recursively-draw-segments (rest still-to-do) (cons party done) total-votes cx cy radius) vote-share (* (/ (:votes party) total-votes) 100)] (if (> vote-share 1) - (cons [:g [:path {:class "snm-scale" + (cons [:g [:path {:class "rsvggraph-scale" :id (str (:id party) "-segment") :style {:stroke (:colour party)} :d (describe-arc cx cy radius start-angle end-angle)}] (gradation cx cy (* radius 0.8) (* radius 1.1) start-angle (str - (if (> vote-share 5) (name (:id party)) "") - (if (> vote-share 10) (str " " (as-label vote-share) "%"))))] + (when (> vote-share 5) (name (:id party)) "") + (when (> vote-share 10) (str " " (as-label vote-share) "%"))))] others) others)))) -(defn swingometer - "Render an SVG swinging needle meter" +(defn rsvggraph + "Render an SVG radial graph. The idea here is there is a stack of rings, + each with zero or more segments. Each ring has an inner diameter and an + outer diameter, each of which is expressed as a number in the range 0...1, + representing a fraction of the overall dimension of the graph. + + The rings are drawn in ascending order of inner diameter. + + Each segment has a label and a magnitude" [& {:keys [model width height class scale-class frame-class id style attr] :or {width 300 - height 200 - scale-class "snm-scale" - frame-class "snm-frame" - id "meter"} + height 300 + scale-class "rsvggraph-scale" + frame-class "rsvggraph-frame" + id "graph"} :as args}] - {:pre [(validate-args-macro swingometer-args-desc args "swingometer")]} + {:pre [(validate-args-macro rsvggraph-args-desc args "rsvggraph")]} (let [model (deref-or-value model) mid-point-deflection (/ full-scale-deflection 2) - cx (/ width 2) - cy (* height 0.90) - needle-length (* height 0.75) - scale-radius (* height 0.7) - gradation-inner (* height 0.55) - gradations 5 + dimension (min width height) + cx (/ dimension 2) + cy (* dimension 0.50) + scale-radius (* dimension 0.45) total-votes (reduce + (map #(:votes %) (vals model)))] [box :align :start :child [:div (merge - {:class (str "swingometer " class) + {:class (str "rsvggraph " class) :style (merge (flex-child-style "none") - {:width width :height height} + {:width dimension :height dimension} style)} attr) [:svg {:xmlSpace "preserve" :overflow "visible" - :viewBox (string/join " " [0 0 width height]) - :width (str width "px") - :height (str height "px") + :viewBox (string/join " " [0 0 dimension dimension]) + :width (str dimension "px") + :height (str dimension "px") :y "0px" :x "0px" :version "1.1" :id id - :class (str "snm-meter " class)} + :class (str "rsvggraph-graph " class)} [:text {:text-anchor "middle" - :x (/ width 2) - :y (/ height 2) - :width "100" + :x (/ dimension 2) + :y (/ dimension 2) + :width (/ dimension 4) :id (str id "-total-votes") - :class "snm-value"}[:tspan (reduce + (map :votes (vals model)))]] + :class "rsvggraph-value"}[:tspan (reduce + (map :votes (vals model)))]] [:path {:class scale-class :id (str id "-scale") :d (describe-arc cx cy scale-radius diff --git a/src/cljs/swingometer/subs.cljs b/src/cljs/rsvggraph/subs.cljs similarity index 87% rename from src/cljs/swingometer/subs.cljs rename to src/cljs/rsvggraph/subs.cljs index 97d24be..bee62c1 100644 --- a/src/cljs/swingometer/subs.cljs +++ b/src/cljs/rsvggraph/subs.cljs @@ -1,4 +1,4 @@ -(ns swingometer.subs +(ns rsvggraph.subs (:require-macros [reagent.ratom :refer [reaction]]) (:require [re-frame.core :as re-frame])) diff --git a/src/cljs/swingometer/utils.cljs b/src/cljs/rsvggraph/utils.cljs similarity index 99% rename from src/cljs/swingometer/utils.cljs rename to src/cljs/rsvggraph/utils.cljs index e6b8dde..09184df 100644 --- a/src/cljs/swingometer/utils.cljs +++ b/src/cljs/rsvggraph/utils.cljs @@ -1,4 +1,4 @@ -(ns swingometer.utils +(ns rsvggraph.utils (:require [re-com.core :refer [h-box v-box box gap title line label hyperlink-href align-style]])) ;;;; This file is just stolen wholesale from re-demo in the re-com package; diff --git a/src/cljs/swingometer/views.cljs b/src/cljs/rsvggraph/views.cljs similarity index 94% rename from src/cljs/swingometer/views.cljs rename to src/cljs/rsvggraph/views.cljs index 44914f4..6cb080f 100644 --- a/src/cljs/swingometer/views.cljs +++ b/src/cljs/rsvggraph/views.cljs @@ -1,12 +1,12 @@ -(ns swingometer.views +(ns rsvggraph.views (:require [re-frame.core :as re-frame] [re-com.core :refer [h-box v-box box gap line label title progress-bar slider checkbox p single-dropdown]] [re-com.util :refer [deref-or-value]] - [swingometer.swingometer :refer [swingometer swingometer-args-desc]] - [swingometer.utils :refer [panel-title title2 args-table github-hyperlink status-text]] + [rsvggraph.rsvggraph :refer [rsvggraph rsvggraph-args-desc]] + [rsvggraph.utils :refer [panel-title title2 args-table github-hyperlink status-text]] [reagent.core :as reagent])) -(defn swingometer-demo +(defn rsvggraph-demo [] (let [model (reagent/atom {:snp {:id :snp :name "Scottish National Party" :colour "yellow" :votes 10} :lab {:id :lab :name "Labour Party" :colour "red" :votes 10} @@ -19,7 +19,7 @@ [v-box :size "auto" :gap "10px" - :children [[panel-title "Swingometer"] + :children [[panel-title "rsvggraph"] [h-box :gap "100px" :children [[v-box @@ -27,21 +27,21 @@ :width "450px" :children [[title2 "Notes"] [status-text "Wildly experimental"] - [p "An SVG swingometer intended to be useful in elections."] + [p "An SVG rsvggraph intended to be useful in elections."] [title2 "Behaviour"] - [args-table swingometer-args-desc]]] + [args-table rsvggraph-args-desc]]] [v-box :gap "10px" :children [[title2 "Demo"] [v-box :gap "20px" - :children [[swingometer + :children [[rsvggraph :model model - :height 600 - :width 1000] + :height 500 + :width 500] [title :level :level3 :label "Parameters"] [h-box :gap "10px" @@ -127,11 +127,11 @@ ;; core holds a reference to panel, so need one level of indirection to get figwheel updates (defn panel [] - [swingometer-demo]) + [rsvggraph-demo]) (defn main-panel [] (fn [] [v-box :height "100%" - :children [[swingometer-demo]]])) + :children [[rsvggraph-demo]]])) From 240b76c889886fef6070383e4810c1b41cfb1adc Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 9 Jul 2024 21:18:03 +0100 Subject: [PATCH 2/6] Mostly working, labels don't go on their paths. --- project.clj | 3 +- resources/public/sample-data.edn | 147 ++++++++++++++++++++++++------- src/clj/rsvggraph/core.clj | 93 ++++++++++++++++++- src/clj/rsvggraph/data.clj | 80 ++++++++++++++--- 4 files changed, 280 insertions(+), 43 deletions(-) diff --git a/project.clj b/project.clj index 82d098d..6ce8170 100644 --- a/project.clj +++ b/project.clj @@ -3,7 +3,8 @@ [generateme/fastmath "2.4.0"] [hiccup "2.0.0-RC3"] [javax.xml.bind/jaxb-api "2.4.0-b180830.0359"] - [org.clojure/clojure "1.8.0"] + [org.clojure/clojure "1.11.3"] + [org.clojure/data.xml "0.0.8"] ;; [org.clojure/clojurescript "1.9.229"] ;; [org.omcljs/om "1.0.0-beta1"] ;; [reagent "0.6.0"] diff --git a/resources/public/sample-data.edn b/resources/public/sample-data.edn index fe1ca2b..51d121e 100644 --- a/resources/public/sample-data.edn +++ b/resources/public/sample-data.edn @@ -1,40 +1,125 @@ {:id "ge2024" :label "UK General Election 2024" + :colour "white" :children [{:id "no-show" :label "Did not vote" - :magnitude 18365357} + :quantity 18365357} {:id "voted" :label "Voted" - :children [{:id "reform" - :label "Reform UK Ltd." - :magnitude 4091549} - {:id "greenew" - :label "Green Party of England and Wales" - :magnitude 1939502} - {:id "pc" - :label "Plaid Cymru" - :magnitude 194811} - {:id "sf" - :label "Sinn Féin" - :magnitude 210891} - {:id "ld" - :label "Liberal Democrats" - :magnitude 3499933} - {:id "labour" + :children [{:id "labour" :label "Labour" - :magnitude 9712011} - {:id "apni" - :label "Alliance Party" - :magnitude 117191} - {:id "sdlp" - :label "Social Democratic and Labour Party" - :magnitude 86861} - {:id "dup" - :label "Democratic Unionist Party" - :magnitude 172058} - {:id "snp" - :label "Scottish National Party" - :magnitude 708759} + :colour "red" + :quantity 9712011 + :children [{:id "negative" + :colour "gray" + :children [{:id "anti-tory" + :label "To get the Tories out" + :colour "#424242" + :quantity 4658234} + {:id "change" + :label "The country needs a change" + :colour "#424242" + :quantity 1261605} + {:id "nhs" + :label "To support the NHS" + :colour "#424242" + :quantity 388186} + {:id "alternative" + :label "The best alternative" + :quantity 388186} + {:id "anti-sunak" + :label "Rishi Sunak" + :colour "#424242" + :quantity 97047} + {:id "anti-snp" + :label "To oust the SNP" + :colour "#424242" + :quantity 97047}]} + {:id "other" + :colour "maroon" + :quantity 291140} + {:id "positive" + :colour "red" + :children [{:id "policies" + :label "I agree with their policies" + :colour "#d32f2f" + :quantity 485233} + {:id "mp" + :label "Like my MP" + :colour "#d32f2f" + :quantity 194093} + {:id "fairer" + :label "For a fairer society" + :colour "#d32f2f" + :quantity 194093} + {:id "habit" + :label "I always vote Labour" + :colour "#d32f2f" + :quantity 194093} + {:id "honesty" + :quantity 194093} + {:id "caop" + :label "Care about ordinary people" + :colour "#d32f2f" + :quantity 97047} + {:id "fwc" + :label "For the working class" + :colour "#d32f2f" + :quantity 97047} + {:id "cl" + :label "Address the cost of living" + :colour "#d32f2f" + :quantity 97047} + {:id "stability" + :label "Economic stability" + :colour "#d32f2f" + :quantity 97047} + {:id "pro-starmer" + :label "Keir Starmer" + :colour "#d32f2f" + :quantity 97047} + {:id "services" + :label "For better public services" + :colour "#d32f2f" + :quantity 97047}]}]} {:id "con" :label "Conservative" - :magnitude 6814469}]}]} \ No newline at end of file + :colour "blue" + :quantity 6814469} + {:id "ld" + :label "Liberal Democrats" + :colour "gold" + :quantity 3499933} + {:id "snp" + :label "Scottish National Party" + :colour "yellow" + :quantity 708759} + {:id "sf" + :label "Sinn Féin" + :quantity 210891} + {:id "independents" + :label "independents" + :colour "silver" + :quantity 564243} + {:id "reform" + :label "Reform UK Ltd." + :colour "cyan" + :quantity 4091549} + {:id "dup" + :label "Democratic Unionist Party" + :quantity 172058} + {:id "greenew" + :label "Green Party of England and Wales" + :colour "green" + :quantity 1939502} + {:id "pc" + :label "Plaid Cymru" + :colour "#005b54" + :quantity 194811} + {:id "apni" + :label "Alliance Party" + :colour "#f6cb2f" + :quantity 117191} + {:id "sdlp" + :label "Social Democratic and Labour Party" + :quantity 86861}]}]} \ No newline at end of file diff --git a/src/clj/rsvggraph/core.clj b/src/clj/rsvggraph/core.clj index b08bdd2..27be4f6 100644 --- a/src/clj/rsvggraph/core.clj +++ b/src/clj/rsvggraph/core.clj @@ -1 +1,92 @@ -(ns rsvggraph.core) +(ns rsvggraph.core + (:require [clojure.math :refer [cos PI sin]] + [clojure.string :refer [join replace]] + [clojure.xml :refer [emit]] + [fastmath.core :refer [pow]] + [hiccup2.core :refer [html]] + [rsvggraph.data :refer [normalise]])) + + + +(defn polar-to-cartesian + "Return, as a map with keys :x. :y, the cartesian coordinates at the point + `radius` distance at `theta` (degrees) angle from a point at + cartesian coordinates `cx`, `cy`." + [cx cy radius theta] + (let + [in-radians (/ (* (- theta 90) PI) 180.0)] + {:x (+ cx (* radius (cos in-radians))) + :y (+ cy (* radius (sin in-radians)))})) + +(defn describe-arc + "Return as a string an SVG path definition describing an arc centred + at `cx`, cy` starting at `start-angle` and ending at `end-angle` (both + angles in degrees)." + [cx cy radius start-angle end-angle] + (let + [start (polar-to-cartesian cx cy radius start-angle) + end (polar-to-cartesian cx cy radius end-angle) + large-arc? (if (<= (- end-angle start-angle) 180) 0 1) + sweep (if (> end-angle start-angle) 1 0)] + (join " " ["M" (:x start) (:y start) "A" radius radius 0 large-arc? sweep (:x end) (:y end)]))) + +(defn draw-segment + [datum diameter] + (let [r' (/ diameter 2) + thickness (/ r' (:ring datum));; (/ 1 (pow 3 (:ring datum))) + radius (- r' (/ thickness 2)) + start-angle (* (:left datum) 360) + end-angle (* (:right datum) 360) + id (str (:id datum) "-segment") + path-data (describe-arc r' r' radius start-angle end-angle)] +;; (println (format "Id: %s; radius: %s; start: %s; end: %s; thickness %s" id radius start-angle end-angle thickness)) + [:g {:id (str id "group")} + [:path {:class "rsvggraph-segment" + :id id + :style {:fill "none" + :stroke (:colour datum) + :stroke-width thickness} + :d path-data}] + [:text [:textPath {:href (str "#" id) + :path path-data} (:label datum)]]])) + +(defn flatten-data + [data] + (cond (empty? (:children data)) data + :else (flatten (cons (dissoc data :children) (map flatten-data (:children data)))))) + +(def ^:dynamic *background* "white") + +(def ^:dynamic *foreground* "black") + +(defn data->svg + [data diameter] + (let [data' (normalise data)] + [:svg {:xmlSpace "preserve" + :overflow "visible" + :viewBox (join " " [0 0 diameter diameter]) + :width (str diameter "px") + :height (str diameter "px") + :y "0px" + :x "0px" + :version "1.1" + :id (:id data') + :class (str "rsvggraph-graph") + :xmlns "http://www.w3.org/2000/svg"} + [:circle {:id (str (:id data') "-background") :cx (/ diameter 2) :cy (/ diameter 2) :r (/ diameter 2) :style {:fill "white"}}] + [:text + {:text-anchor "middle" + :x (/ diameter 2) + :y (/ diameter 2) + :width (/ diameter 4) + :id (str (:id data') "-title") + :class "rsvggraph-value"} [:tspan (:label data) ": " (:quantity data)]] + (map #(draw-segment % diameter) (flatten-data data))])) + +(defn data->svg-file + [data diameter path] + (emit (data->svg data diameter))) + +(defn data->html-file + [data diameter path] + (spit path (join "\n" ["" (replace (html (data->svg data diameter)) #"\> *\<" ">\n<")]))) \ No newline at end of file diff --git a/src/clj/rsvggraph/data.clj b/src/clj/rsvggraph/data.clj index 090e1df..5d3f93b 100644 --- a/src/clj/rsvggraph/data.clj +++ b/src/clj/rsvggraph/data.clj @@ -1,29 +1,89 @@ (ns rsvggraph.data - "Normalise data for use in generating radial graphs." - (:require [clojure2d.color :refer [gradient]])) + "Normalise data for use in generating radial graphs. A lot of the things + I want to do here, especially with colour, are not readily portable between + clojure and clojurescript, so this is Clojure only for now." + (:require [clojure2d.color :refer [format-hex gradient]] + [fastmath.core :refer [pow]])) -(def ;; ^:dynamic - *gradient* +(def ^:dynamic *gradient* "The gradient to use to automatically assign pleasing colours to sectors, if no colours are defined in the data. Suitable gradients are defined [here](https://clojure2d.github.io/clojure2d/docs/static/gradients/)." :rainbow2) -(def children-fn +(def ^:dynamic *children* "Basic (overridable) children function; assumes `data` is a map, and returns the value of the `:children` key within that map." (memoize (fn [data] (:children data)))) -(def quantity-fn +(def ^:dynamic *quantity* "Basic (overridable) children function; assumes `data` is a map. If the value of the `:children` key within that map is a sequence, sums the result of mapping itself over that sequence. Otherwise, returns the value of the `:quantity` key, if present and a number, or `1` as a final default." (memoize (fn [data] - (let [c (children-fn data) + (let [c (*children* data) q (:quantity data)] - (cond (coll? c) (reduce + 0 (map quantity-fn c)) - (number? q) q - :else 1))))) \ No newline at end of file + (cond (number? q) q + (coll? c) (reduce + 0 (map *quantity* c)) + :else 1))))) + +(def ^:dynamic *colour* + "Return, as a hex string acceptable to HTML and CSS, the appropriate colour + for this `datum` having this `central-quantity-fraction` as the centre of + its position in the arc." + (fn [data central-quantity-fraction] + (let [col (:colour data) + grad (gradient *gradient*)] + (cond + col col + (number? data) (format-hex (grad data)) + (number? central-quantity-fraction) (format-hex (grad central-quantity-fraction)) + :else "gray")))) + +(def proportion + (memoize + (fn [data total] + (double (/ (*quantity* data) total))))) + +(defn normalise + ([data] + (normalise data 1 (*quantity* data) 0)) + ([data ring total left] + (let [id (or (:id data) + (keyword (gensym (or (:title data) "datum")))) + q (*quantity* data) + p (proportion data total) + color (*colour* data (+ left (/ p 2)))] + (assoc data + :children + (when (:children data) + (loop [c (first (:children data)) + l left + y (rest (:children data)) + v nil] + (let [r (+ l (proportion c total)) + c' (assoc + (normalise c (inc ring) total l) + :left l + :right r) + v' (cons c' v)] + ;; (println (format "Label: %s: ring: %d; left: %f; right: %f; colour %s." + ;; (:label c') ring (double l) r color)) + (cond (empty? y) (vec v') + :else + (recur (first y) + r + (rest y) + v'))))) + :colour color + :id id + :inner-diameter (/ 1 (pow 3 ring)) + :label (or (:label data) id) + :left 0 + :proportion p + :quantity q + :right 1 + :ring ring)))) \ No newline at end of file From 2b6388de9d85b7ada1ea69d9e9411221c7eae1df Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 9 Jul 2024 23:21:26 +0100 Subject: [PATCH 3/6] By Jove! I think he's got it! --- .gitignore | 2 + resources/public/sample-data.edn | 29 +++++++------- src/clj/rsvggraph/core.clj | 65 +++++++++++++++++++++++--------- 3 files changed, 66 insertions(+), 30 deletions(-) diff --git a/.gitignore b/.gitignore index 94ac55c..e560088 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,5 @@ out *.zip .lsp/ .clj-kondo/ + +*.svg diff --git a/resources/public/sample-data.edn b/resources/public/sample-data.edn index 51d121e..98516b8 100644 --- a/resources/public/sample-data.edn +++ b/resources/public/sample-data.edn @@ -10,8 +10,13 @@ :label "Labour" :colour "red" :quantity 9712011 - :children [{:id "negative" - :colour "gray" + :children [{:id "other" + :label "Other" + :colour "#C0C0C0" + :quantity 291140} + {:id "negative" + :label "Negative" + :colour "#C0C0C0" :children [{:id "anti-tory" :label "To get the Tories out" :colour "#424242" @@ -35,13 +40,11 @@ :label "To oust the SNP" :colour "#424242" :quantity 97047}]} - {:id "other" - :colour "maroon" - :quantity 291140} {:id "positive" + :label "Positive" :colour "red" :children [{:id "policies" - :label "I agree with their policies" + :label "Agree with policies" :colour "#d32f2f" :quantity 485233} {:id "mp" @@ -63,11 +66,11 @@ :colour "#d32f2f" :quantity 97047} {:id "fwc" - :label "For the working class" + :label "For working class" :colour "#d32f2f" :quantity 97047} {:id "cl" - :label "Address the cost of living" + :label "Address cost of living" :colour "#d32f2f" :quantity 97047} {:id "stability" @@ -79,7 +82,7 @@ :colour "#d32f2f" :quantity 97047} {:id "services" - :label "For better public services" + :label "Better public services" :colour "#d32f2f" :quantity 97047}]}]} {:id "con" @@ -98,7 +101,7 @@ :label "Sinn Féin" :quantity 210891} {:id "independents" - :label "independents" + :label "Independents" :colour "silver" :quantity 564243} {:id "reform" @@ -106,10 +109,10 @@ :colour "cyan" :quantity 4091549} {:id "dup" - :label "Democratic Unionist Party" + :label "DUP" :quantity 172058} {:id "greenew" - :label "Green Party of England and Wales" + :label "Green Party" :colour "green" :quantity 1939502} {:id "pc" @@ -121,5 +124,5 @@ :colour "#f6cb2f" :quantity 117191} {:id "sdlp" - :label "Social Democratic and Labour Party" + :label "SDLP" :quantity 86861}]}]} \ No newline at end of file diff --git a/src/clj/rsvggraph/core.clj b/src/clj/rsvggraph/core.clj index 27be4f6..c0c5689 100644 --- a/src/clj/rsvggraph/core.clj +++ b/src/clj/rsvggraph/core.clj @@ -1,12 +1,15 @@ (ns rsvggraph.core - (:require [clojure.math :refer [cos PI sin]] + (:require [clojure.math :refer [cos floor PI sin]] [clojure.string :refer [join replace]] [clojure.xml :refer [emit]] - [fastmath.core :refer [pow]] [hiccup2.core :refer [html]] [rsvggraph.data :refer [normalise]])) +(def ^:dynamic *background* "white") + +(def ^:dynamic *foreground* "black") + (defn polar-to-cartesian "Return, as a map with keys :x. :y, the cartesian coordinates at the point @@ -30,6 +33,21 @@ sweep (if (> end-angle start-angle) 1 0)] (join " " ["M" (:x start) (:y start) "A" radius radius 0 large-arc? sweep (:x end) (:y end)]))) +(defn- text-path [datum tp-id diameter thickness start-angle end-angle] + [:path {:class "rsvggraph-text-path" + :id tp-id + :style {:fill "none" + :stroke "none"} + :d (let [angle (/ (+ start-angle end-angle) 2) + radius (/ diameter 2) + start (polar-to-cartesian diameter diameter radius angle) + end (polar-to-cartesian diameter diameter diameter angle)] + (if (< (- (:right datum) (:left datum)) 0.08) + + (format "M %d %d L %d %d" (int (:x start)) (int (:y start)) + (int (:x end)) (int (:y end))) + (describe-arc diameter diameter (- radius (* 0.9 thickness)) start-angle end-angle)))}]) + (defn draw-segment [datum diameter] (let [r' (/ diameter 2) @@ -38,7 +56,8 @@ start-angle (* (:left datum) 360) end-angle (* (:right datum) 360) id (str (:id datum) "-segment") - path-data (describe-arc r' r' radius start-angle end-angle)] + tp-id (str "tp-" id) + path-data (describe-arc diameter diameter radius start-angle end-angle)] ;; (println (format "Id: %s; radius: %s; start: %s; end: %s; thickness %s" id radius start-angle end-angle thickness)) [:g {:id (str id "group")} [:path {:class "rsvggraph-segment" @@ -47,39 +66,51 @@ :stroke (:colour datum) :stroke-width thickness} :d path-data}] - [:text [:textPath {:href (str "#" id) - :path path-data} (:label datum)]]])) + (text-path datum tp-id diameter thickness start-angle end-angle) + [:text {:style {:fill *foreground* + :font-family "sans-serif" + :font-weight "bold" + :font-size (str (floor (* 0.2 thickness)))}} + [:textPath {:xlink:href (str "#" tp-id)} [:tspan (:label datum)]]]])) + +;; Did not vote (defn flatten-data [data] (cond (empty? (:children data)) data :else (flatten (cons (dissoc data :children) (map flatten-data (:children data)))))) -(def ^:dynamic *background* "white") - -(def ^:dynamic *foreground* "black") - (defn data->svg [data diameter] - (let [data' (normalise data)] + (let [data' (normalise data) + dimension (* 2 diameter)] [:svg {:xmlSpace "preserve" :overflow "visible" - :viewBox (join " " [0 0 diameter diameter]) - :width (str diameter "px") - :height (str diameter "px") + :viewBox (join " " [0 0 dimension dimension]) + :width (str dimension "px") + :height (str dimension "px") :y "0px" :x "0px" :version "1.1" :id (:id data') :class (str "rsvggraph-graph") - :xmlns "http://www.w3.org/2000/svg"} - [:circle {:id (str (:id data') "-background") :cx (/ diameter 2) :cy (/ diameter 2) :r (/ diameter 2) :style {:fill "white"}}] + :xmlns "http://www.w3.org/2000/svg" + :xmlns:xlink "http://www.w3.org/1999/xlink"} + [:circle {:id (str (:id data') "-background") :cx diameter :cy diameter :r (/ diameter 2) :style {:fill "white"}}] [:text {:text-anchor "middle" - :x (/ diameter 2) - :y (/ diameter 2) + :x diameter + :y diameter :width (/ diameter 4) :id (str (:id data') "-title") + :style {:font-family "sans-serif" + :font-weight "bold"} :class "rsvggraph-value"} [:tspan (:label data) ": " (:quantity data)]] (map #(draw-segment % diameter) (flatten-data data))])) From 72038b34b4213bb4b5dc50f2c47c9d76d6e8be4e Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 10 Jul 2024 09:16:00 +0100 Subject: [PATCH 4/6] Better layout of minor labels. --- resources/public/sample-data.edn | 22 ++--- src/clj/rsvggraph/core.clj | 136 +++++++++++++++++++++---------- 2 files changed, 106 insertions(+), 52 deletions(-) diff --git a/resources/public/sample-data.edn b/resources/public/sample-data.edn index 98516b8..d4373a2 100644 --- a/resources/public/sample-data.edn +++ b/resources/public/sample-data.edn @@ -1,22 +1,20 @@ {:id "ge2024" :label "UK General Election 2024" :colour "white" - :children [{:id "no-show" - :label "Did not vote" - :quantity 18365357} - {:id "voted" + :children [{:id "voted" :label "Voted" + :color "chartreuse" :children [{:id "labour" :label "Labour" :colour "red" :quantity 9712011 :children [{:id "other" :label "Other" - :colour "#C0C0C0" + :colour "silver" :quantity 291140} {:id "negative" :label "Negative" - :colour "#C0C0C0" + :colour "silver" :children [{:id "anti-tory" :label "To get the Tories out" :colour "#424242" @@ -108,9 +106,6 @@ :label "Reform UK Ltd." :colour "cyan" :quantity 4091549} - {:id "dup" - :label "DUP" - :quantity 172058} {:id "greenew" :label "Green Party" :colour "green" @@ -119,10 +114,17 @@ :label "Plaid Cymru" :colour "#005b54" :quantity 194811} + {:id "dup" + :label "DUP" + :quantity 172058} {:id "apni" :label "Alliance Party" :colour "#f6cb2f" :quantity 117191} {:id "sdlp" :label "SDLP" - :quantity 86861}]}]} \ No newline at end of file + :quantity 86861}]} + {:id "no-show" + :label "Did not vote" + :colour "silver" + :quantity 18365357}]} \ No newline at end of file diff --git a/src/clj/rsvggraph/core.clj b/src/clj/rsvggraph/core.clj index c0c5689..b8ca343 100644 --- a/src/clj/rsvggraph/core.clj +++ b/src/clj/rsvggraph/core.clj @@ -15,50 +15,74 @@ "Return, as a map with keys :x. :y, the cartesian coordinates at the point `radius` distance at `theta` (degrees) angle from a point at cartesian coordinates `cx`, `cy`." - [cx cy radius theta] + [geometry] (let - [in-radians (/ (* (- theta 90) PI) 180.0)] - {:x (+ cx (* radius (cos in-radians))) - :y (+ cy (* radius (sin in-radians)))})) + [in-radians (/ (* (- (:angle geometry) 90) PI) 180.0)] + {:x (+ (:cx geometry) (* (:radius geometry) (cos in-radians))) + :y (+ (:cy geometry) (* (:radius geometry) (sin in-radians)))})) (defn describe-arc "Return as a string an SVG path definition describing an arc centred at `cx`, cy` starting at `start-angle` and ending at `end-angle` (both angles in degrees)." - [cx cy radius start-angle end-angle] + [geometry start-angle end-angle] (let - [start (polar-to-cartesian cx cy radius start-angle) - end (polar-to-cartesian cx cy radius end-angle) + [start (polar-to-cartesian (assoc geometry :angle start-angle)) + end (polar-to-cartesian (assoc geometry :angle end-angle)) large-arc? (if (<= (- end-angle start-angle) 180) 0 1) + radius (:radius geometry) sweep (if (> end-angle start-angle) 1 0)] - (join " " ["M" (:x start) (:y start) "A" radius radius 0 large-arc? sweep (:x end) (:y end)]))) + (join " " + ["M" (:x start) (:y start) "A" radius radius 0 large-arc? sweep + (:x end) (:y end)]))) -(defn- text-path [datum tp-id diameter thickness start-angle end-angle] +(def ^:dynamic *minor-segment-threshold* 0.07) + +(defn- minor-segment? [datum] + (< (- (:right datum) (:left datum)) *minor-segment-threshold*)) + +(defn- font-size [thickness] + (int (* 0.15 thickness))) + +(defn- text-path [datum tp-id geometry thickness start-angle end-angle] [:path {:class "rsvggraph-text-path" :id tp-id :style {:fill "none" :stroke "none"} - :d (let [angle (/ (+ start-angle end-angle) 2) - radius (/ diameter 2) - start (polar-to-cartesian diameter diameter radius angle) - end (polar-to-cartesian diameter diameter diameter angle)] - (if (< (- (:right datum) (:left datum)) 0.08) + :d (let [angle (if (> (+ start-angle end-angle) 360) start-angle end-angle) + radius (:radius geometry) + end (polar-to-cartesian (assoc geometry :radius (* 1.2 (:radius geometry)) :angle angle)) + height (int (:y end))] + (if (minor-segment? datum) + (if (> angle 180) + (format "M %d %d L %d %d" (- (int (:x end)) (* (count (:label datum)) (font-size thickness))) height + (int (:x end)) height) + (format "M %d %d L %d %d" (int (:x end)) height (:width geometry) height)) + (describe-arc (assoc geometry :radius (- radius (* 0.9 thickness))) + start-angle end-angle)))}]) - (format "M %d %d L %d %d" (int (:x start)) (int (:y start)) - (int (:x end)) (int (:y end))) - (describe-arc diameter diameter (- radius (* 0.9 thickness)) start-angle end-angle)))}]) +(defn- label-indicator-path [geometry angle] + (let [start (polar-to-cartesian (assoc geometry :angle angle)) + end (polar-to-cartesian + (assoc geometry :radius (* 1.2 (:radius geometry)) :angle angle))] + (format "M %d %d L %d %d" (int (:x start)) (int (:y start)) + (int (:x end)) (int (:y end))))) + +(defn- label-indicator [datum geometry start-angle end-angle] + (when (minor-segment? datum)[:path {:class "rsvggraph-minor-label-indicator" :style {:fill "none" :stroke *foreground* :stroke-width "thin"} + :d (label-indicator-path geometry (if (> (+ start-angle end-angle) 360) start-angle end-angle))}])) (defn draw-segment - [datum diameter] - (let [r' (/ diameter 2) - thickness (/ r' (:ring datum));; (/ 1 (pow 3 (:ring datum))) - radius (- r' (/ thickness 2)) + [datum geometry] + (println (format "Radius: %s; ring: %s." (:radius geometry) (:ring datum))) + (let [thickness (/ (:radius geometry) (:ring datum));; (/ 1 (pow 3 (:ring datum))) + radius (- (:radius geometry) (/ thickness 2)) start-angle (* (:left datum) 360) end-angle (* (:right datum) 360) id (str (:id datum) "-segment") tp-id (str "tp-" id) - path-data (describe-arc diameter diameter radius start-angle end-angle)] -;; (println (format "Id: %s; radius: %s; start: %s; end: %s; thickness %s" id radius start-angle end-angle thickness)) + path-data (describe-arc (assoc geometry :radius radius) + start-angle end-angle)] [:g {:id (str id "group")} [:path {:class "rsvggraph-segment" :id id @@ -66,12 +90,14 @@ :stroke (:colour datum) :stroke-width thickness} :d path-data}] - (text-path datum tp-id diameter thickness start-angle end-angle) + (text-path datum tp-id geometry thickness start-angle end-angle) + (label-indicator datum geometry start-angle end-angle) [:text {:style {:fill *foreground* :font-family "sans-serif" :font-weight "bold" - :font-size (str (floor (* 0.2 thickness)))}} - [:textPath {:xlink:href (str "#" tp-id)} [:tspan (:label datum)]]]])) + :font-size (str (font-size thickness))}} + [:textPath {:xlink:href (str "#" tp-id) + :startOffset "2%"} [:tspan (:label datum)]]]])) ;; svg [data diameter] (let [data' (normalise data) - dimension (* 2 diameter)] + height (* 2 diameter) + width (* 3 diameter) + geometry (base-geometry diameter)] [:svg {:xmlSpace "preserve" :overflow "visible" - :viewBox (join " " [0 0 dimension dimension]) - :width (str dimension "px") - :height (str dimension "px") + :viewBox (join " " [0 0 height height]) + :width (str width "px") + :height (str height "px") :y "0px" :x "0px" :version "1.1" @@ -102,17 +160,9 @@ :class (str "rsvggraph-graph") :xmlns "http://www.w3.org/2000/svg" :xmlns:xlink "http://www.w3.org/1999/xlink"} - [:circle {:id (str (:id data') "-background") :cx diameter :cy diameter :r (/ diameter 2) :style {:fill "white"}}] - [:text - {:text-anchor "middle" - :x diameter - :y diameter - :width (/ diameter 4) - :id (str (:id data') "-title") - :style {:font-family "sans-serif" - :font-weight "bold"} - :class "rsvggraph-value"} [:tspan (:label data) ": " (:quantity data)]] - (map #(draw-segment % diameter) (flatten-data data))])) + (circle data' geometry) + (cantre-label data' geometry) + (map #(draw-segment % geometry) (flatten-data data'))])) (defn data->svg-file [data diameter path] @@ -120,4 +170,6 @@ (defn data->html-file [data diameter path] - (spit path (join "\n" ["" (replace (html (data->svg data diameter)) #"\> *\<" ">\n<")]))) \ No newline at end of file + (spit path (join "\n" + ["" + (replace (html (data->svg data diameter)) #"\> *\<" ">\n<")]))) \ No newline at end of file From b75d7f883908a1e228271b483ed9d71627575d9a Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 10 Jul 2024 09:26:56 +0100 Subject: [PATCH 5/6] Added percentages to labels --- resources/public/sample-data.edn | 2 +- src/clj/rsvggraph/core.clj | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/resources/public/sample-data.edn b/resources/public/sample-data.edn index d4373a2..0f5a9aa 100644 --- a/resources/public/sample-data.edn +++ b/resources/public/sample-data.edn @@ -103,7 +103,7 @@ :colour "silver" :quantity 564243} {:id "reform" - :label "Reform UK Ltd." + :label "Reform UK" :colour "cyan" :quantity 4091549} {:id "greenew" diff --git a/src/clj/rsvggraph/core.clj b/src/clj/rsvggraph/core.clj index b8ca343..3a74901 100644 --- a/src/clj/rsvggraph/core.clj +++ b/src/clj/rsvggraph/core.clj @@ -36,7 +36,7 @@ ["M" (:x start) (:y start) "A" radius radius 0 large-arc? sweep (:x end) (:y end)]))) -(def ^:dynamic *minor-segment-threshold* 0.07) +(def ^:dynamic *minor-segment-threshold* 0.08) (defn- minor-segment? [datum] (< (- (:right datum) (:left datum)) *minor-segment-threshold*)) @@ -97,7 +97,7 @@ :font-weight "bold" :font-size (str (font-size thickness))}} [:textPath {:xlink:href (str "#" tp-id) - :startOffset "2%"} [:tspan (:label datum)]]]])) + :startOffset "2%"} [:tspan (format "%s: %.2f%%" (:label datum) (* 100 (:proportion datum)))]]]])) ;; Date: Wed, 10 Jul 2024 20:07:33 +0100 Subject: [PATCH 6/6] Started work on pre-computing geometry, to allow shuffling labels. --- src/clj/rsvggraph/core.clj | 53 +++++++++++++++++++++++++++++++++----- 1 file changed, 46 insertions(+), 7 deletions(-) diff --git a/src/clj/rsvggraph/core.clj b/src/clj/rsvggraph/core.clj index 3a74901..fddd2b6 100644 --- a/src/clj/rsvggraph/core.clj +++ b/src/clj/rsvggraph/core.clj @@ -10,6 +10,13 @@ (def ^:dynamic *foreground* "black") +;; TODO: Right, so most of this is good. But I need to adjust the positions +;; of minor segment labels -- by sliding some of them sideways -- before +;; rendering. So probably what I need to do is one pass through the data +;; structure, tagging each node with geometry information (especially for +;; minor segment labels); then a second pass to sort out spacial collisions; +;; and don't try to generate the SVG until that has been done. But I need +;; *all* the geometry to be complete. (defn polar-to-cartesian "Return, as a map with keys :x. :y, the cartesian coordinates at the point @@ -44,33 +51,65 @@ (defn- font-size [thickness] (int (* 0.15 thickness))) +(defn left-half? + [datum] + (> (+ (:left datum) (:right datum)) 1)) + +(defn- label-width + "Return the anticipated width of the label associated with this `datum`." + [datum thickness] + (* (count (:label datum)) (font-size thickness))) + (defn- text-path [datum tp-id geometry thickness start-angle end-angle] [:path {:class "rsvggraph-text-path" :id tp-id :style {:fill "none" :stroke "none"} - :d (let [angle (if (> (+ start-angle end-angle) 360) start-angle end-angle) + :d (let [angle (if (left-half? datum) start-angle end-angle) radius (:radius geometry) end (polar-to-cartesian (assoc geometry :radius (* 1.2 (:radius geometry)) :angle angle)) height (int (:y end))] (if (minor-segment? datum) - (if (> angle 180) - (format "M %d %d L %d %d" (- (int (:x end)) (* (count (:label datum)) (font-size thickness))) height - (int (:x end)) height) + (if (left-half? datum) + (format "M %d %d L %d %d" (- (int (:x end)) (label-width datum thickness)) height + (int (:x end)) height) (format "M %d %d L %d %d" (int (:x end)) height (:width geometry) height)) (describe-arc (assoc geometry :radius (- radius (* 0.9 thickness))) start-angle end-angle)))}]) (defn- label-indicator-path [geometry angle] (let [start (polar-to-cartesian (assoc geometry :angle angle)) - end (polar-to-cartesian + end (polar-to-cartesian (assoc geometry :radius (* 1.2 (:radius geometry)) :angle angle))] (format "M %d %d L %d %d" (int (:x start)) (int (:y start)) (int (:x end)) (int (:y end))))) (defn- label-indicator [datum geometry start-angle end-angle] - (when (minor-segment? datum)[:path {:class "rsvggraph-minor-label-indicator" :style {:fill "none" :stroke *foreground* :stroke-width "thin"} - :d (label-indicator-path geometry (if (> (+ start-angle end-angle) 360) start-angle end-angle))}])) + (when (minor-segment? datum) [:path {:class "rsvggraph-minor-label-indicator" :style {:fill "none" :stroke *foreground* :stroke-width "thin"} + :d (label-indicator-path geometry (if (left-half? datum) start-angle end-angle))}])) + +(defn segment-geometry + [datum geometry] + (let [thickness (/ (:radius geometry) (:ring datum)) + left? (left-half? datum) + start-angle (* (:left datum) 360) + end-angle (* (:right datum) 360) + angle (if left? start-angle end-angle) + kink (polar-to-cartesian + (assoc geometry :radius (* 1.2 (:radius geometry)) :angle angle)) + label-bottom (int (:y kink))] + (merge geometry + {:thickness thickness + :radius (- (:radius geometry) (/ thickness 2)) + :start-angle start-angle + :end-angle end-angle + :text-box (when (minor-segment? datum) + {:left (if left? (- (int (:x kink)) (label-width datum thickness)) + (int (:x kink))) + :right (if left? (int (:x kink)) + (+ (int (:x kink)) (label-width datum thickness))) + :bottom label-bottom + :top (+ label-bottom (font-size datum))})}))) (defn draw-segment [datum geometry]