diff --git a/.gitignore b/.gitignore index 713f40a..e560088 100644 --- a/.gitignore +++ b/.gitignore @@ -11,3 +11,7 @@ out *.tgz *.zip +.lsp/ +.clj-kondo/ + +*.svg 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..6ce8170 100644 --- a/project.clj +++ b/project.clj @@ -1,11 +1,18 @@ -(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.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"] + ;; [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 +22,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..0f5a9aa --- /dev/null +++ b/resources/public/sample-data.edn @@ -0,0 +1,130 @@ +{:id "ge2024" + :label "UK General Election 2024" + :colour "white" + :children [{:id "voted" + :label "Voted" + :color "chartreuse" + :children [{:id "labour" + :label "Labour" + :colour "red" + :quantity 9712011 + :children [{:id "other" + :label "Other" + :colour "silver" + :quantity 291140} + {:id "negative" + :label "Negative" + :colour "silver" + :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 "positive" + :label "Positive" + :colour "red" + :children [{:id "policies" + :label "Agree with 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 working class" + :colour "#d32f2f" + :quantity 97047} + {:id "cl" + :label "Address 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 "Better public services" + :colour "#d32f2f" + :quantity 97047}]}]} + {:id "con" + :label "Conservative" + :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" + :colour "cyan" + :quantity 4091549} + {:id "greenew" + :label "Green Party" + :colour "green" + :quantity 1939502} + {:id "pc" + :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}]} + {: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 new file mode 100644 index 0000000..fddd2b6 --- /dev/null +++ b/src/clj/rsvggraph/core.clj @@ -0,0 +1,214 @@ +(ns rsvggraph.core + (:require [clojure.math :refer [cos floor PI sin]] + [clojure.string :refer [join replace]] + [clojure.xml :refer [emit]] + [hiccup2.core :refer [html]] + [rsvggraph.data :refer [normalise]])) + + +(def ^:dynamic *background* "white") + +(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 + `radius` distance at `theta` (degrees) angle from a point at + cartesian coordinates `cx`, `cy`." + [geometry] + (let + [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)." + [geometry start-angle end-angle] + (let + [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)]))) + +(def ^:dynamic *minor-segment-threshold* 0.08) + +(defn- minor-segment? [datum] + (< (- (:right datum) (:left datum)) *minor-segment-threshold*)) + +(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 (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 (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 + (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 (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] + (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 (assoc geometry :radius radius) + start-angle end-angle)] + [:g {:id (str id "group")} + [:path {:class "rsvggraph-segment" + :id id + :style {:fill "none" + :stroke (:colour datum) + :stroke-width thickness} + :d path-data}] + (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 (font-size thickness))}} + [:textPath {:xlink:href (str "#" tp-id) + :startOffset "2%"} [:tspan (format "%s: %.2f%%" (:label datum) (* 100 (:proportion datum)))]]]])) + +;; Did not vote + +(defn flatten-data + [data] + (cond (empty? (:children data)) data + :else (flatten (cons (dissoc data :children) (map flatten-data (:children data)))))) + +(defn- circle + [data geometry] + [:circle {:id (str (:id data) "-background") + :cx (:cx geometry) + :cy (:cy geometry) + :r (:radius geometry) + :style {:fill "white"}}]) + +(defn- cantre-label [data geometry] + [:text + {:text-anchor "middle" + :x (:cx geometry) + :y (:cy geometry) + :width (/ (:diameter geometry) 4) + :id (str (:id data) "-title") + :style {:font-family "sans-serif" + :font-weight "bold"} + :class "rsvggraph-value"} [:tspan (:label data) ": " (:quantity data)]]) + +(defn base-geometry + [diameter] + (let [height (* 1.5 diameter) + width (* 2 diameter)] + {:cx (/ width 2) + :cy (/ height 2) + :diameter diameter + :height height + :radius (/ diameter 2) + :width width})) + +(defn data->svg + [data diameter] + (let [data' (normalise data) + height (* 2 diameter) + width (* 3 diameter) + geometry (base-geometry diameter)] + [:svg {:xmlSpace "preserve" + :overflow "visible" + :viewBox (join " " [0 0 height height]) + :width (str width "px") + :height (str height "px") + :y "0px" + :x "0px" + :version "1.1" + :id (:id data') + :class (str "rsvggraph-graph") + :xmlns "http://www.w3.org/2000/svg" + :xmlns:xlink "http://www.w3.org/1999/xlink"} + (circle data' geometry) + (cantre-label data' geometry) + (map #(draw-segment % geometry) (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 new file mode 100644 index 0000000..5d3f93b --- /dev/null +++ b/src/clj/rsvggraph/data.clj @@ -0,0 +1,89 @@ +(ns rsvggraph.data + "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* + "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 ^: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 ^: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* data) + q (:quantity data)] + (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 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]]]))