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

Initial commit

Browse source
This commit is contained in:
Simon Brooke 2017-07-12 17:02:29 +01:00
parent ebd09efe30
commit e392369373
15 changed files with 2028 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
.gitignore vendored Normal file
View file

@ -0,0 +1,5 @@
/*.log
/target
/*-init.clj
/resources/public/js/compiled
out

50
project.clj Normal file
View file

@ -0,0 +1,50 @@
(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"]]
:plugins [[lein-cljsbuild "1.1.4"]]
:min-lein-version "2.5.3"
:source-paths ["src/clj"]
:clean-targets ^{:protect false} ["resources/public/js/compiled" "target"]
:figwheel {:css-dirs ["resources/public/css"]}
:profiles
{:dev
{:dependencies [[binaryage/devtools "0.8.2"]]
: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}}
}}
{: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}}
]}
)

1352
resources/public/css/re-com.css Normal file
View file

File diff suppressed because it is too large Load diff

70
resources/public/css/swingometer.css Normal file
View file

@ -0,0 +1,70 @@
/***************************************************************************\
* *
* swinging-needle-meter.css *
* *
* CSS styling for the swinging needle meter itself. *
* *
\***************************************************************************/
.snm-cursor {
stroke:#ff8500;
stroke-width: 3%;
stroke-opacity: 0.5;
}
.snm-frame {
fill: none;
stroke-width: 5%;
stroke-linejoin: round;
stroke: #444444;
}
.snm-gradation path {
stroke: black;
stroke-width: 1;
}
.snm-gradation text {
font-size: 200%;
font-weight: lighter;
}
.snm-hub {
fill: #444444;
}
.snm-meter {
height: 50%;
width: auto;
}
.snm-needle {
stroke: black;
stroke-width: 1;
}
.snm-redzone {
fill:none;
stroke: maroon;
stroke-width: 10%;
}
.snm-scale {
fill: none;
stroke: silver;
stroke-width: 10%;
}
.snm-target .snm-frame {
stroke: green;
}
.snm-value {
font-size: 400%;
font-weight: bold;
text-align: center;
}
.snm-warning .snm-frame {
stroke: maroon;
}

20
resources/public/index.html Normal file
View file

@ -0,0 +1,20 @@
<!doctype html>
<html lang="en">
<head>
<meta charset='utf-8'>
<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 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>
</head>
<body>
<div id="app"></div>
<script src="js/compiled/app.js"></script>
<script>swingometer.core.init();</script>
</body>
</html>

BIN
resources/swingometer.zip Normal file
View file

Binary file not shown.

1
src/clj/swingometer/core.clj Normal file
View file

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

4
src/cljs/swingometer/config.cljs Normal file
View file

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

23
src/cljs/swingometer/core.cljs Normal file
View file

@ -0,0 +1,23 @@
(ns swingometer.core
(:require [reagent.core :as reagent]
[re-frame.core :as re-frame]
[swingometer.events]
[swingometer.subs]
[swingometer.views :as views]
[swingometer.config :as config]))
(defn dev-setup []
(when config/debug?
(enable-console-print!)
(println "dev mode")))
(defn mount-root []
(re-frame/clear-subscription-cache!)
(reagent/render [views/main-panel]
(.getElementById js/document "app")))
(defn ^:export init []
(re-frame/dispatch-sync [:initialize-db])
(dev-setup)
(mount-root))

4
src/cljs/swingometer/db.cljs Normal file
View file

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

8
src/cljs/swingometer/events.cljs Normal file
View file

@ -0,0 +1,8 @@
(ns swingometer.events
(:require [re-frame.core :as re-frame]
[swingometer.db :as db]))
(re-frame/reg-event-db
:initialize-db
(fn [_ _]
db/default-db))

8
src/cljs/swingometer/subs.cljs Normal file
View file

@ -0,0 +1,8 @@
(ns swingometer.subs
(:require-macros [reagent.ratom :refer [reaction]])
(:require [re-frame.core :as re-frame]))
(re-frame/reg-sub
:name
(fn [db]
(:name db)))

231
src/cljs/swingometer/swingometer.cljs Normal file
View file

@ -0,0 +1,231 @@
(ns swingometer.swingometer
(: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]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; swingometer: 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) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ------------------------------------------------------------------------------------
;; Component: swingometer
;; ------------------------------------------------------------------------------------
;;; 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
[{: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 "snm-frame"
:validate-fn string? :description "CSS class names, space separated, for the frame"}
{:name :hub-class :required false :type "string" :default "snm-hub"
:validate-fn string? :description "CSS class names, space separated, for the hub"}
{:name :scale-class :required false :type "string" :default "snm-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 :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 log (.-log js/console))
(defn abs
"Return the absolute value of the (numeric) argument."
[n] (max n (- n)))
;; 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)
(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 2)
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`."
[cx cy min-radius max-radius angle label]
[:g {:class "snm-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 recursively-draw-segments
[still-to-do done total-votes cx cy radius]
(log (string/join " " ["\nstill-to-do" still-to-do "\ndone" done "\ntotal-votes" total-votes "cx" cx "cy" cy "radius" 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)]
(cons [:g [:path {:class "snm-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
(let [vote-share (* (/ (:votes party) total-votes) 100)]
(str
(if (> vote-share 5) (name (:id party)) "")
(if (> vote-share 10) (str " " (int vote-share) "%")))))]
(recursively-draw-segments (rest still-to-do) (cons party done) total-votes cx cy radius)))))
(defn swingometer
"Render an SVG swinging needle meter"
[& {: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"}
:as args}]
{:pre [(validate-args-macro swingometer-args-desc args "swingometer")]}
(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
total-votes (reduce + (map #(:votes %) (vals model)))]
[box
:align :start
:child [:div
(merge
{:class (str "swingometer " class)
:style (merge (flex-child-style "none")
{:width width :height height}
style)}
attr)
[:svg {:xmlSpace "preserve"
:overflow "visible"
:viewBox (string/join " " [0 0 width height])
:width (str width "px")
:height (str height "px")
:y "0px"
:x "0px"
:version "1.1"
:id id
:class (str "snm-meter " class)}
[:text
{:text-anchor "middle"
:x (/ width 2)
:y (/ height 2)
:width "100"
:id (str id "-total-votes")
:class "snm-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)}]
;; (if (and (> gradations 0) (> total-votes 0))
;; (apply vector (cons :g (map #(let
;; [value (*
;; (/
;; total-votes
;; gradations) %)]
;; (gradation cx cy gradation-inner needle-length
;; (deflection value 0 total-votes)
;; value))
;; (range 0 (+ gradations 1))))))
(apply vector
(cons :g (recursively-draw-segments (map model (sort (keys 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)}]
;; [:circle {:class hub-class
;; :id (str id "-hub")
;; :r (/ height 10) :cx cx :cy cy}]
]
]]))

115
src/cljs/swingometer/utils.cljs Normal file
View file

@ -0,0 +1,115 @@
(ns swingometer.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;
;;;; I claim no credit for it.
(defn github-hyperlink
"given a label and a relative path, return a component which hyperlinks to the GitHub URL in a new tab"
[label src-path]
(let [base-url (str "https://github.com/Day8/re-com/tree/master/")]
[hyperlink-href
:label label
;:style {:font-size "13px"}
:href (str base-url src-path)
:target "_blank"]))
(defn panel-title
"Shown across the top of each page"
[panel-name src1 src2]
[v-box
:children [[h-box
:margin "0px 0px 9px 0px"
:height "54px"
:align :end
:children [[title
:label panel-name
:level :level1
:margin-bottom "0px"
:margin-top "2px"]
[gap :size "25px"]
(when src1 [h-box
:class "all-small-caps"
:gap "7px"
:align :center
:children [
[label :label "source:" ]
[github-hyperlink "component" src1]
[label :label "|" :style {:font-size "12px"}]
;[line]
[github-hyperlink "page" src2]]])]]
[line]]])
(defn title2
"2nd level title"
[text style]
[title
:label text
:level :level2
:style style])
(defn status-text
"given some status text, return a component that displays that status"
[status style]
[:span
[:span.bold "Status: "]
[:span {:style style} status]])
(defn material-design-hyperlink
[text]
[hyperlink-href
:label text
:href "http://zavoloklom.github.io/material-design-iconic-font/icons.html"
:target "_blank"])
(defn arg-row
"I show one argument in an args table."
[name-width arg odd-row?]
(let [required (:required arg)
default (:default arg)
arg-type (:type arg)
needed-vec (if (not required)
(if (nil? default)
[[:span.semibold.all-small-caps "optional"]]
[[:span.semibold.all-small-caps "default:"] [:span.semibold (str default)]])
[[:span.semibold.all-small-caps "required"]])]
[h-box
:style {:background (if odd-row? "#F4F4F4" "#FCFCFC")}
:children [[:span {:class "semibold"
:style (merge (align-style :align-self :center)
{:width name-width
:padding-left "15px"})}
(str (:name arg))]
[line :size "1px" :color "white"]
[v-box
:style {:padding "7px 15px 2px 15px"}
:gap "4px"
:width "310px"
:children [[h-box
:gap "4px"
:children (concat [[:span.semibold arg-type]
[gap :size "10px"]]
needed-vec)]
[:p
{:font-size "smaller" :color "red"}
(:description arg)]]]]]))
(defn args-table
"I display a component arguements in an easy to read format"
[args]
(let [name-width "130px"]
(fn
[]
[v-box
:children (concat
[[title2 "Parameters"]
[gap :size "10px"]]
(map (partial arg-row name-width) args (cycle [true false])))])))
(defn scroll-to-top
[element]
(set! (.-scrollTop element) 0))

137
src/cljs/swingometer/views.cljs Normal file
View file

@ -0,0 +1,137 @@
(ns swingometer.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]]
[reagent.core :as reagent]))
(defn swingometer-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}
:con {:id :con :name "Conservative Party" :colour "blue" :votes 10}
:ld {:id :ld :name "Liberal Democrats" :colour "GoldenRod" :votes 10}
:grn {:id :grn :name "Scottish Green Party" :colour "green" :votes 10}
:ukp {:id :ukp :name "United Kingdom Independence Party" :colour "DarkViolet" :votes 10}})]
(fn
[]
[v-box
:size "auto"
:gap "10px"
:children [[panel-title "Swingometer"]
[h-box
:gap "100px"
:children [[v-box
:gap "10px"
:width "450px"
:children [[title2 "Notes"]
[status-text "Wildly experimental"]
[p "An SVG swingometer intended to be useful in elections."]
[title2 "Behaviour"]
[args-table swingometer-args-desc]]]
[v-box
:gap "10px"
:children [[title2 "Demo"]
[v-box
:gap "20px"
:children [[swingometer
:model model
:height 600
:width 1000]
[title :level :level3 :label "Parameters"]
[h-box
:gap "10px"
:children [[box :align :start :child [:label (:name (:con (deref-or-value model)))]]
[slider
:model (:votes (:con (deref-or-value model)))
:min 0
:max 1000
:width "200px"
:on-change #(reset! model
(merge (deref-or-value model)
{:con (merge (:con (deref-or-value model))
{:votes %})}))]
[label :label (:votes (:con (deref-or-value model)))]]]
[h-box
:gap "10px"
:children [[box :align :start :child [:label (:name (:grn (deref-or-value model)))]]
[slider
:model (:votes (:grn (deref-or-value model)))
:min 0
:max 1000
:width "200px"
:on-change #(reset! model
(merge (deref-or-value model)
{:grn (merge (:grn (deref-or-value model))
{:votes %})}))]
[label :label (:votes (:grn (deref-or-value model)))]]]
[h-box
:gap "10px"
:children [[box :align :start :child [:label (:name (:lab (deref-or-value model)))]]
[slider
:model (:votes (:lab (deref-or-value model)))
:min 0
:max 1000
:width "200px"
:on-change #(reset! model
(merge (deref-or-value model)
{:lab (merge (:lab (deref-or-value model))
{:votes %})}))]
[label :label (:votes (:lab (deref-or-value model)))]]]
[h-box
:gap "10px"
:children [[box :align :start :child [:label (:name (:ld (deref-or-value model)))]]
[slider
:model (:votes (:ld (deref-or-value model)))
:min 0
:max 1000
:width "200px"
:on-change #(reset! model
(merge (deref-or-value model)
{:ld (merge (:ld (deref-or-value model))
{:votes %})}))]
[label :label (:votes (:ld (deref-or-value model)))]]]
[h-box
:gap "10px"
:children [[box :align :start :child [:label (:name (:snp (deref-or-value model)))]]
[slider
:model (:votes (:snp (deref-or-value model)))
:min 0
:max 1000
:width "200px"
:on-change #(reset! model
(merge (deref-or-value model)
{:snp (merge (:snp (deref-or-value model))
{:votes %})}))]
[label :label (:votes (:snp (deref-or-value model)))]]]
[h-box
:gap "10px"
:children [[box :align :start :child [:label (:name (:ukp (deref-or-value model)))]]
[slider
:model (:votes (:ukp (deref-or-value model)))
:min 0
:max 1000
:width "200px"
:on-change #(reset! model
(merge (deref-or-value model)
{:ukp (merge (:ukp (deref-or-value model))
{:votes %})}))]
[label :label (:votes (:ukp (deref-or-value model)))]]]
]]]]]]]])))
;; core holds a reference to panel, so need one level of indirection to get figwheel updates
(defn panel
[]
[swingometer-demo])
(defn main-panel []
(fn []
[v-box
:height "100%"
:children [[swingometer-demo]]]))