simon/swingometer
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Better layout of minor labels.

Browse source
This commit is contained in:
Simon Brooke 2024-07-10 09:16:00 +01:00
parent 2b6388de9d
commit 72038b34b4
2 changed files with 106 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
resources/public/sample-data.edn
View file

@ -1,22 +1,20 @@
{:id "ge2024" {:id "ge2024"
:label "UK General Election 2024" :label "UK General Election 2024"
:colour "white" :colour "white"
:children [{:id "no-show" :children [{:id "voted"
:label "Did not vote"
:quantity 18365357}
{:id "voted"
:label "Voted" :label "Voted"
:color "chartreuse"
:children [{:id "labour" :children [{:id "labour"
:label "Labour" :label "Labour"
:colour "red" :colour "red"
:quantity 9712011 :quantity 9712011
:children [{:id "other" :children [{:id "other"
:label "Other" :label "Other"
:colour "#C0C0C0" :colour "silver"
:quantity 291140} :quantity 291140}
{:id "negative" {:id "negative"
:label "Negative" :label "Negative"
:colour "#C0C0C0" :colour "silver"
:children [{:id "anti-tory" :children [{:id "anti-tory"
:label "To get the Tories out" :label "To get the Tories out"
:colour "#424242" :colour "#424242"
@ -108,9 +106,6 @@
:label "Reform UK Ltd." :label "Reform UK Ltd."
:colour "cyan" :colour "cyan"
:quantity 4091549} :quantity 4091549}
{:id "dup"
:label "DUP"
:quantity 172058}
{:id "greenew" {:id "greenew"
:label "Green Party" :label "Green Party"
:colour "green" :colour "green"
@ -119,10 +114,17 @@
:label "Plaid Cymru" :label "Plaid Cymru"
:colour "#005b54" :colour "#005b54"
:quantity 194811} :quantity 194811}
{:id "dup"
:label "DUP"
:quantity 172058}
{:id "apni" {:id "apni"
:label "Alliance Party" :label "Alliance Party"
:colour "#f6cb2f" :colour "#f6cb2f"
:quantity 117191} :quantity 117191}
{:id "sdlp" {:id "sdlp"
:label "SDLP" :label "SDLP"
:quantity 86861}]}]} :quantity 86861}]}
{:id "no-show"
:label "Did not vote"
:colour "silver"
:quantity 18365357}]}

136
src/clj/rsvggraph/core.clj
View file

@ -15,50 +15,74 @@
"Return, as a map with keys :x. :y, the cartesian coordinates at the point "Return, as a map with keys :x. :y, the cartesian coordinates at the point
`radius` distance at `theta` (degrees) angle from a point at `radius` distance at `theta` (degrees) angle from a point at
cartesian coordinates `cx`, `cy`." cartesian coordinates `cx`, `cy`."
[cx cy radius theta] [geometry]
(let (let
[in-radians (/ (* (- theta 90) PI) 180.0)] [in-radians (/ (* (- (:angle geometry) 90) PI) 180.0)]
{:x (+ cx (* radius (cos in-radians))) {:x (+ (:cx geometry) (* (:radius geometry) (cos in-radians)))
:y (+ cy (* radius (sin in-radians)))})) :y (+ (:cy geometry) (* (:radius geometry) (sin in-radians)))}))
(defn describe-arc (defn describe-arc
"Return as a string an SVG path definition describing an arc centred "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 at `cx`, cy` starting at `start-angle` and ending at `end-angle` (both
angles in degrees)." angles in degrees)."
[cx cy radius start-angle end-angle] [geometry start-angle end-angle]
(let (let
[start (polar-to-cartesian cx cy radius start-angle) [start (polar-to-cartesian (assoc geometry :angle start-angle))
end (polar-to-cartesian cx cy radius end-angle) end (polar-to-cartesian (assoc geometry :angle end-angle))
large-arc? (if (<= (- end-angle start-angle) 180) 0 1) large-arc? (if (<= (- end-angle start-angle) 180) 0 1)
radius (:radius geometry)
sweep (if (> end-angle start-angle) 1 0)] 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" [:path {:class "rsvggraph-text-path"
:id tp-id :id tp-id
:style {:fill "none" :style {:fill "none"
:stroke "none"} :stroke "none"}
:d (let [angle (/ (+ start-angle end-angle) 2) :d (let [angle (if (> (+ start-angle end-angle) 360) start-angle end-angle)
radius (/ diameter 2) radius (:radius geometry)
start (polar-to-cartesian diameter diameter radius angle) end (polar-to-cartesian (assoc geometry :radius (* 1.2 (:radius geometry)) :angle angle))
end (polar-to-cartesian diameter diameter diameter angle)] height (int (:y end))]
(if (< (- (:right datum) (:left datum)) 0.08) (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)) (defn- label-indicator-path [geometry angle]
(int (:x end)) (int (:y end))) (let [start (polar-to-cartesian (assoc geometry :angle angle))
(describe-arc diameter diameter (- radius (* 0.9 thickness)) start-angle end-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 (defn draw-segment
[datum diameter] [datum geometry]
(let [r' (/ diameter 2) (println (format "Radius: %s; ring: %s." (:radius geometry) (:ring datum)))
thickness (/ r' (:ring datum));; (/ 1 (pow 3 (:ring datum))) (let [thickness (/ (:radius geometry) (:ring datum));; (/ 1 (pow 3 (:ring datum)))
radius (- r' (/ thickness 2)) radius (- (:radius geometry) (/ thickness 2))
start-angle (* (:left datum) 360) start-angle (* (:left datum) 360)
end-angle (* (:right datum) 360) end-angle (* (:right datum) 360)
id (str (:id datum) "-segment") id (str (:id datum) "-segment")
tp-id (str "tp-" id) tp-id (str "tp-" id)
path-data (describe-arc diameter diameter radius start-angle end-angle)] path-data (describe-arc (assoc geometry :radius radius)
;; (println (format "Id: %s; radius: %s; start: %s; end: %s; thickness %s" id radius start-angle end-angle thickness)) start-angle end-angle)]
[:g {:id (str id "group")} [:g {:id (str id "group")}
[:path {:class "rsvggraph-segment" [:path {:class "rsvggraph-segment"
:id id :id id
@ -66,12 +90,14 @@
:stroke (:colour datum) :stroke (:colour datum)
:stroke-width thickness} :stroke-width thickness}
:d path-data}] :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* [:text {:style {:fill *foreground*
:font-family "sans-serif" :font-family "sans-serif"
:font-weight "bold" :font-weight "bold"
:font-size (str (floor (* 0.2 thickness)))}} :font-size (str (font-size thickness))}}
[:textPath {:xlink:href (str "#" tp-id)} [:tspan (:label datum)]]]])) [:textPath {:xlink:href (str "#" tp-id)
:startOffset "2%"} [:tspan (:label datum)]]]]))
;; <text ;; <text
;; xml:space="preserve" ;; xml:space="preserve"
@ -86,15 +112,47 @@
(cond (empty? (:children data)) data (cond (empty? (:children data)) data
:else (flatten (cons (dissoc data :children) (map flatten-data (:children 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 (defn data->svg
[data diameter] [data diameter]
(let [data' (normalise data) (let [data' (normalise data)
dimension (* 2 diameter)] height (* 2 diameter)
width (* 3 diameter)
geometry (base-geometry diameter)]
[:svg {:xmlSpace "preserve" [:svg {:xmlSpace "preserve"
:overflow "visible" :overflow "visible"
:viewBox (join " " [0 0 dimension dimension]) :viewBox (join " " [0 0 height height])
:width (str dimension "px") :width (str width "px")
:height (str dimension "px") :height (str height "px")
:y "0px" :y "0px"
:x "0px" :x "0px"
:version "1.1" :version "1.1"
@ -102,17 +160,9 @@
:class (str "rsvggraph-graph") :class (str "rsvggraph-graph")
:xmlns "http://www.w3.org/2000/svg" :xmlns "http://www.w3.org/2000/svg"
:xmlns:xlink "http://www.w3.org/1999/xlink"} :xmlns:xlink "http://www.w3.org/1999/xlink"}
[:circle {:id (str (:id data') "-background") :cx diameter :cy diameter :r (/ diameter 2) :style {:fill "white"}}] (circle data' geometry)
[:text (cantre-label data' geometry)
{:text-anchor "middle" (map #(draw-segment % geometry) (flatten-data data'))]))
: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))]))
(defn data->svg-file (defn data->svg-file
[data diameter path] [data diameter path]
@ -120,4 +170,6 @@
(defn data->html-file (defn data->html-file
[data diameter path] [data diameter path]
(spit path (join "\n" ["<?xml version='1.0' encoding='UTF-8'?>" (replace (html (data->svg data diameter)) #"\> *\<" ">\n<")]))) (spit path (join "\n"
["<?xml version='1.0' encoding='UTF-8'?>"
(replace (html (data->svg data diameter)) #"\> *\<" ">\n<")])))