Mostly working, labels don't go on their paths.
This commit is contained in:
parent
3a1ae81f08
commit
240b76c889
4 changed files with 280 additions and 43 deletions
|
|
@ -1 +1,92 @@
|
|||
(ns rsvggraph.core)
|
||||
(ns rsvggraph.core
|
||||
(:require [clojure.math :refer [cos PI sin]]
|
||||
[clojure.string :refer [join replace]]
|
||||
[clojure.xml :refer [emit]]
|
||||
[fastmath.core :refer [pow]]
|
||||
[hiccup2.core :refer [html]]
|
||||
[rsvggraph.data :refer [normalise]]))
|
||||
|
||||
|
||||
|
||||
(defn polar-to-cartesian
|
||||
"Return, as a map with keys :x. :y, the cartesian coordinates at the point
|
||||
`radius` distance at `theta` (degrees) angle from a point at
|
||||
cartesian coordinates `cx`, `cy`."
|
||||
[cx cy radius theta]
|
||||
(let
|
||||
[in-radians (/ (* (- theta 90) PI) 180.0)]
|
||||
{:x (+ cx (* radius (cos in-radians)))
|
||||
:y (+ cy (* radius (sin in-radians)))}))
|
||||
|
||||
(defn describe-arc
|
||||
"Return as a string an SVG path definition describing an arc centred
|
||||
at `cx`, cy` starting at `start-angle` and ending at `end-angle` (both
|
||||
angles in degrees)."
|
||||
[cx cy radius start-angle end-angle]
|
||||
(let
|
||||
[start (polar-to-cartesian cx cy radius start-angle)
|
||||
end (polar-to-cartesian cx cy radius end-angle)
|
||||
large-arc? (if (<= (- end-angle start-angle) 180) 0 1)
|
||||
sweep (if (> end-angle start-angle) 1 0)]
|
||||
(join " " ["M" (:x start) (:y start) "A" radius radius 0 large-arc? sweep (:x end) (:y end)])))
|
||||
|
||||
(defn draw-segment
|
||||
[datum diameter]
|
||||
(let [r' (/ diameter 2)
|
||||
thickness (/ r' (:ring datum));; (/ 1 (pow 3 (:ring datum)))
|
||||
radius (- r' (/ thickness 2))
|
||||
start-angle (* (:left datum) 360)
|
||||
end-angle (* (:right datum) 360)
|
||||
id (str (:id datum) "-segment")
|
||||
path-data (describe-arc r' r' radius start-angle end-angle)]
|
||||
;; (println (format "Id: %s; radius: %s; start: %s; end: %s; thickness %s" id radius start-angle end-angle thickness))
|
||||
[:g {:id (str id "group")}
|
||||
[:path {:class "rsvggraph-segment"
|
||||
:id id
|
||||
:style {:fill "none"
|
||||
:stroke (:colour datum)
|
||||
:stroke-width thickness}
|
||||
:d path-data}]
|
||||
[:text [:textPath {:href (str "#" id)
|
||||
:path path-data} (:label datum)]]]))
|
||||
|
||||
(defn flatten-data
|
||||
[data]
|
||||
(cond (empty? (:children data)) data
|
||||
:else (flatten (cons (dissoc data :children) (map flatten-data (:children data))))))
|
||||
|
||||
(def ^:dynamic *background* "white")
|
||||
|
||||
(def ^:dynamic *foreground* "black")
|
||||
|
||||
(defn data->svg
|
||||
[data diameter]
|
||||
(let [data' (normalise data)]
|
||||
[:svg {:xmlSpace "preserve"
|
||||
:overflow "visible"
|
||||
:viewBox (join " " [0 0 diameter diameter])
|
||||
:width (str diameter "px")
|
||||
:height (str diameter "px")
|
||||
:y "0px"
|
||||
:x "0px"
|
||||
:version "1.1"
|
||||
:id (:id data')
|
||||
:class (str "rsvggraph-graph")
|
||||
:xmlns "http://www.w3.org/2000/svg"}
|
||||
[:circle {:id (str (:id data') "-background") :cx (/ diameter 2) :cy (/ diameter 2) :r (/ diameter 2) :style {:fill "white"}}]
|
||||
[:text
|
||||
{:text-anchor "middle"
|
||||
:x (/ diameter 2)
|
||||
:y (/ diameter 2)
|
||||
:width (/ diameter 4)
|
||||
:id (str (:id data') "-title")
|
||||
:class "rsvggraph-value"} [:tspan (:label data) ": " (:quantity data)]]
|
||||
(map #(draw-segment % diameter) (flatten-data data))]))
|
||||
|
||||
(defn data->svg-file
|
||||
[data diameter path]
|
||||
(emit (data->svg data diameter)))
|
||||
|
||||
(defn data->html-file
|
||||
[data diameter path]
|
||||
(spit path (join "\n" ["<?xml version='1.0' encoding='UTF-8'?>" (replace (html (data->svg data diameter)) #"\> *\<" ">\n<")])))
|
||||
|
|
@ -1,29 +1,89 @@
|
|||
(ns rsvggraph.data
|
||||
"Normalise data for use in generating radial graphs."
|
||||
(:require [clojure2d.color :refer [gradient]]))
|
||||
"Normalise data for use in generating radial graphs. A lot of the things
|
||||
I want to do here, especially with colour, are not readily portable between
|
||||
clojure and clojurescript, so this is Clojure only for now."
|
||||
(:require [clojure2d.color :refer [format-hex gradient]]
|
||||
[fastmath.core :refer [pow]]))
|
||||
|
||||
|
||||
(def ;; ^:dynamic
|
||||
*gradient*
|
||||
(def ^:dynamic *gradient*
|
||||
"The gradient to use to automatically assign pleasing colours to sectors, if
|
||||
no colours are defined in the data. Suitable gradients are defined
|
||||
[here](https://clojure2d.github.io/clojure2d/docs/static/gradients/)."
|
||||
:rainbow2)
|
||||
|
||||
(def children-fn
|
||||
(def ^:dynamic *children*
|
||||
"Basic (overridable) children function; assumes `data` is a map, and returns
|
||||
the value of the `:children` key within that map."
|
||||
(memoize (fn [data]
|
||||
(:children data))))
|
||||
|
||||
(def quantity-fn
|
||||
(def ^:dynamic *quantity*
|
||||
"Basic (overridable) children function; assumes `data` is a map. If the value
|
||||
of the `:children` key within that map is a sequence, sums the result of
|
||||
mapping itself over that sequence. Otherwise, returns the value of the
|
||||
`:quantity` key, if present and a number, or `1` as a final default."
|
||||
(memoize (fn [data]
|
||||
(let [c (children-fn data)
|
||||
(let [c (*children* data)
|
||||
q (:quantity data)]
|
||||
(cond (coll? c) (reduce + 0 (map quantity-fn c))
|
||||
(number? q) q
|
||||
:else 1)))))
|
||||
(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))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue