(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]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; 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 ;;;; modify it under the terms of the GNU General Public License ;;;; as published by the Free Software Foundation; either version 2 ;;;; of the License, or (at your option) any later version. ;;;; ;;;; This program is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; GNU General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU General Public License ;;;; along with this program; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Copyright (C) 2017 Simon Brooke ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ------------------------------------------------------------------------------------ ;; 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 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" :validate-fn integer? :description "a CSS width"} {:name :height :required false :type "integer" :default "200" :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 "rsvggraph-frame" :validate-fn string? :description "CSS class names, space separated, for the frame"} {: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 "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" :validate-fn css-style? :description "CSS styles to add or override"} {:name :attr :required false :type "HTML attr map" :validate-fn html-attr? :description [:span "HTML attributes, like " [:code ":on-mouse-move"] [:br] "No " [:code ":class"] " or " [:code ":style"] "allowed"]}]) (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 "Return the linear deflection of a needle given this `value` on the range `min-value`...`total-votes`." [value min-value max-value] (let [range (- max-value min-value) zero-offset (/ (- 0 min-value) range) limited (min (max (+ zero-offset (/ value range)) 0) 1)] (* (- limited 0.5) full-scale-deflection))) (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) (aget js/Math "PI")) 180.0)] {:x (+ cx (* radius (.cos js/Math in-radians))) :y (+ cy (* radius (.sin js/Math 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)] (string/join " " ["M" (:x start) (:y start) "A" radius radius 0 large-arc? sweep (:x end) (:y end)]))) (defn as-label "If this arg is a floating point number, format it to a reasonable width; else return it." [arg] (if (and (number? arg) (not (integer? arg))) (.toFixed arg 1) arg)) (defn gradation "Return as a string an SVG path definition describing a radial stroke from a center 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 "rsvggraph-gradation" :transform (string/join " " ["rotate(" angle cx cy ")"])} [:path {:d (string/join " " ["M" cx (- cy (+ min-radius (* (- max-radius min-radius) 0.333))) "L" cx (- cy max-radius)])}] [:text {:text-anchor "start" :x cx :y (- cy min-radius)} (as-label label)]]) (defn biggest-to-the-middle-sort "Sort this list of `maps` representing parties so that those with the most votes are in the middle." [maps] (let [first-sort (sort-by :votes maps) evens (take-nth 2 first-sort) odds (take-nth 2 (rest first-sort))] (concat evens (reverse odds)))) (defn recursively-draw-segments "Walk down a list of parties, returning a labelled SVG arc segment for each one. `still-to-do` is the (remainder of the) list of parties being scanned, should initially be the whole list; `done` is the parties which have been scanned, and should initially be `nil`. `total-votes` is the total number of votes for all parties. `cx` and `cy` are the cartesian coordinates of the centre of arc. `radius` is the radius of the arc." [still-to-do done total-votes cx cy radius] (if (empty? still-to-do) nil (let [votes-done (reduce + (map :votes done)) start-angle (deflection votes-done 0 total-votes) party (first still-to-do) end-angle (deflection (+ (:votes party) votes-done) 0 total-votes) 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 "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 (when (> vote-share 5) (name (:id party)) "") (when (> vote-share 10) (str " " (as-label vote-share) "%"))))] others) others)))) (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 300 scale-class "rsvggraph-scale" frame-class "rsvggraph-frame" id "graph"} :as args}] {:pre [(validate-args-macro rsvggraph-args-desc args "rsvggraph")]} (let [model (deref-or-value model) mid-point-deflection (/ full-scale-deflection 2) 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 "rsvggraph " class) :style (merge (flex-child-style "none") {:width dimension :height dimension} style)} attr) [:svg {:xmlSpace "preserve" :overflow "visible" :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 "rsvggraph-graph " class)} [:text {:text-anchor "middle" :x (/ dimension 2) :y (/ dimension 2) :width (/ dimension 4) :id (str id "-total-votes") :class "rsvggraph-value"}[:tspan (reduce + (map :votes (vals model)))]] [:path {:class scale-class :id (str id "-scale") :d (describe-arc cx cy scale-radius (- 0 mid-point-deflection) mid-point-deflection)}] (apply vector (cons :g (recursively-draw-segments (biggest-to-the-middle-sort (vals model)) nil total-votes cx cy scale-radius))) [:rect {:class frame-class :id (str id "-frame") :x (* width 0.05) :y (* height .05) :height cy :width (* width 0.9)}]]]]))