Compare commits
6 commits
master
...
radial-svg
Author | SHA1 | Date | |
---|---|---|---|
|
b9d98957eb | ||
|
b75d7f8839 | ||
|
72038b34b4 | ||
|
2b6388de9d | ||
|
240b76c889 | ||
|
3a1ae81f08 |
4
.gitignore
vendored
4
.gitignore
vendored
|
@ -11,3 +11,7 @@ out
|
|||
*.tgz
|
||||
|
||||
*.zip
|
||||
.lsp/
|
||||
.clj-kondo/
|
||||
|
||||
*.svg
|
||||
|
|
1
.lein-failures
Normal file
1
.lein-failures
Normal file
|
@ -0,0 +1 @@
|
|||
{}
|
|
@ -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
|
||||
|
||||
|
|
77
project.clj
77
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}}]})
|
||||
)
|
||||
|
|
|
@ -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;
|
||||
}
|
|
@ -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>
|
||||
|
|
130
resources/public/sample-data.edn
Normal file
130
resources/public/sample-data.edn
Normal 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
214
src/clj/rsvggraph/core.clj
Normal 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<")])))
|
89
src/clj/rsvggraph/data.clj
Normal file
89
src/clj/rsvggraph/data.clj
Normal 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))))
|
|
@ -1 +0,0 @@
|
|||
(ns swingometer.core)
|
|
@ -1,4 +1,4 @@
|
|||
(ns swingometer.config)
|
||||
(ns rsvggraph.config)
|
||||
|
||||
(def debug?
|
||||
^boolean goog.DEBUG)
|
|
@ -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 []
|
|
@ -1,4 +1,4 @@
|
|||
(ns swingometer.db)
|
||||
(ns rsvggraph.db)
|
||||
|
||||
(def default-db
|
||||
{:name "re-frame"})
|
|
@ -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
|
|
@ -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
|
|
@ -1,4 +1,4 @@
|
|||
(ns swingometer.subs
|
||||
(ns rsvggraph.subs
|
||||
(:require-macros [reagent.ratom :refer [reaction]])
|
||||
(:require [re-frame.core :as re-frame]))
|
||||
|
|
@ -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;
|
|
@ -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]]]))
|
Loading…
Reference in a new issue