Compare commits

...

6 commits

18 changed files with 570 additions and 123 deletions

4
.gitignore vendored
View file

@ -11,3 +11,7 @@ out
*.tgz
*.zip
.lsp/
.clj-kondo/
*.svg

1
.lein-failures Normal file
View file

@ -0,0 +1 @@
{}

View file

@ -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

View file

@ -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}}]})
)

View file

@ -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;
}

View file

@ -5,16 +5,16 @@
<link rel="stylesheet" href="http://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.3.5/css/bootstrap.min.css">
<link rel="stylesheet" href="vendor/css/material-design-iconic-font.min.css">
<link rel="stylesheet" href="css/re-com.css">
<link rel="stylesheet" href="css/swingometer.css">
<link rel="stylesheet" href="css/rsvggraph.css">
<link href="http://fonts.googleapis.com/css?family=Roboto:300,400,500,700,400italic" rel="stylesheet" type="text/css">
<link href="http://fonts.googleapis.com/css?family=Roboto+Condensed:400,300" rel="stylesheet" type="text/css">
<title>Example swingometer following re-com conventions.</title>
<title>Example rsvggraph following re-com conventions.</title>
</head>
<body>
<div id="app"></div>
<script src="js/compiled/app.js"></script>
<script>swingometer.core.init();</script>
<script>rsvggraph.core.init();</script>
</body>
</html>

View file

@ -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}]}

214
src/clj/rsvggraph/core.clj Normal file
View file

@ -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)))]]]]))
;; <text
;; xml:space="preserve"
;; style="font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;font-size:32px;font-family:sans-serif;-inkscape-font-specification:'sans-serif Bold';fill:#ffcc00;stroke-width:4.9852"
;; id="text562"><textPath
;; xlink:href="#no-show-segment"
;; id="textPath770"><tspan
;; id="tspan560">Did not vote</tspan></textPath></text>
(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"
["<?xml version='1.0' encoding='UTF-8'?>"
(replace (html (data->svg data diameter)) #"\> *\<" ">\n<")])))

View file

@ -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))))

View file

@ -1 +0,0 @@
(ns swingometer.core)

View file

@ -1,4 +1,4 @@
(ns swingometer.config)
(ns rsvggraph.config)
(def debug?
^boolean goog.DEBUG)

View file

@ -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 []

View file

@ -1,4 +1,4 @@
(ns swingometer.db)
(ns rsvggraph.db)
(def default-db
{:name "re-frame"})

View file

@ -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

View file

@ -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

View file

@ -1,4 +1,4 @@
(ns swingometer.subs
(ns rsvggraph.subs
(:require-macros [reagent.ratom :refer [reaction]])
(:require [re-frame.core :as re-frame]))

View file

@ -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;

View file

@ -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]]]))