Created
April 29, 2019 05:06
-
-
Save matthewdowney/501ebcca48b987683d076fcbf62b5d43 to your computer and use it in GitHub Desktop.
Clojurescript client for blessed-contrib.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns blessed-cljs.core | |
"Compiles for :node-js. Attempts to connect to a TCP socket at the port | |
given as a command line argument, and receives pure data specifications | |
for a blessed-contrib dashboard which it updates in real time. | |
Expects JSON data following the format: | |
{:type (a string in gauge, table, sparkline, bar, donut, gauge, lcd, log, markdown, map) | |
:meta (a map to pass to grid.set along the the contrib.object) | |
:data (data to display)} | |
Splits on newlines." | |
(:require [cljs.nodejs :as nodejs] | |
[blessed :as blessed] | |
[blessed-contrib :as contrib] | |
[net :as net] | |
[readline :as rl])) | |
(comment | |
"Building with..." | |
(:dependencies [[org.clojure/clojure "1.10.0"] | |
[cljsjs/nodejs-externs "1.0.4-1"] | |
[org.clojure/clojurescript "1.10.520"]] | |
:plugins [[lein-cljsbuild "1.1.7"]] | |
:cljsbuild {:builds [{:id "prod" | |
:source-paths ["src"] | |
:compiler {:main cursed-clj.core | |
:output-to "package/index.js" | |
:target :nodejs | |
:output-dir "target" | |
:optimizations :advanced | |
:pretty-print true | |
:parallel-build true | |
:npm-deps {:blessed "0.1.81" | |
:blessed-contrib "4.8.15" | |
:net "1.0.2"} | |
:install-deps true}}]}) | |
"... and `lein cljsbuild once prod`") | |
(nodejs/enable-util-print!) | |
;;; | |
;;; Compatibility layer for blessed-contrib widgets. We wrap each of the widget | |
;;; objects in a map | |
;;; {:widget <the wrapped widget> | |
;;; :spec <the data we created the widget with> | |
;;; :setter <a function that takes (widget, data) and updates the widget | |
;;; :constructor <the contructor to pass to grid.set to place the widget>} | |
;;; | |
(defn build-widget | |
"Given some data specification, dispatch on its type to find the constructor | |
and method of setting data for a Blessed widget. Response is wrapped in a | |
map for use with the `update-widget!` function." | |
[{:keys [type] :as spec}] | |
(let [;; Each 'data-setter' is a fn (blessed-widget, spec) => side effects | |
sd (fn [f] (fn [widget element-spec] (.setData widget (f element-spec)))) | |
[constructor, data-setter] | |
(case type | |
"table" [contrib/table (sd clj->js)] | |
"sparkline" [contrib/sparkline | |
(fn [w s] | |
(let [s (clj->js (:data s))] | |
(.setData w (first s) (second s))))] | |
"bar" [contrib/bar (sd clj->js)] | |
"donut" [contrib/donut (sd (comp clj->js vector :data))] | |
"gauge" [contrib/gauge (sd (comp clj->js :data))] | |
"lcd" [contrib/lcd | |
(fn [w s] | |
(.setDisplay w (clj->js (:display s))) | |
(.setOptions w (clj->js s)))] | |
"log" [contrib/log (fn [w s] (doseq [l (:data s)] (.log w l)))] | |
"markdown" [contrib/markdown (fn [w s] (.setMarkdown w (clj->js (:data s))))] | |
"map" [contrib/map | |
(fn [w s] | |
(.clearMarkers w) | |
(doseq [m (:data s)] | |
(.addMarker w (clj->js m))))] | |
"line" [contrib/line (sd (comp clj->js :data))])] | |
{:widget nil :spec spec :setter data-setter :constructor constructor})) | |
(defn update-widget! | |
"Given a `this` that's either the result of a `build-widget` invocation _or_ | |
the result of a previous `update-widget!` call, update the contents of the | |
widget / reconstruct it as necessary and return the new or updated `this`." | |
[{:keys [widget spec setter constructor] :as this} grid new-spec] | |
(if (or (not widget) (not= (:meta spec) (:meta new-spec)) (not= (:pos spec) (:pos new-spec))) | |
(let [{:keys [x y width height]} (:pos new-spec) | |
constructed (.set grid y x height width constructor (clj->js (:meta new-spec)))] | |
(setter constructed new-spec) | |
(when (:focus new-spec) (.focus constructed)) | |
{:widget constructed | |
:spec new-spec | |
:setter setter | |
:constructor constructor}) | |
(do | |
(when (not= spec new-spec) | |
(setter widget new-spec) | |
(when (:focus new-spec) | |
(.focus widget))) | |
(assoc this :spec new-spec)))) | |
;;; | |
;;; Logic for the main screen rending loop. Functions are all (state, new-spec) | |
;;; => state', and all potentially have side effects. | |
;;; | |
(defn maybe-update-grid! | |
"If the grid dimensions have changed, return a state with an updated :grid. | |
Otherwise returns the state unchanged." | |
[{:keys [old-spec screen] :as state} new-spec] | |
(if (not= (:grid old-spec) (:grid new-spec)) | |
(let [{:keys [rows cols]} (:grid new-spec) | |
new-grid #js {:screen screen :rows rows :cols cols}] | |
(assoc state :grid (new contrib/grid new-grid))) | |
state)) | |
(defn maybe-clear-screen! | |
"If the screen layout is going to change, clear the screen and return an | |
updated state without the old widgets." | |
[{:keys [old-spec] :as state} new-spec] | |
(let [clear? | |
(or | |
;; Grid changed | |
(not= (:grid old-spec) (:grid new-spec)) | |
;; Added/removed elements | |
(not= (count (:elements old-spec)) (count (:elements new-spec))) | |
;; Element position change | |
(some | |
true? | |
(for [elem-name (keys (:elements old-spec))] | |
(not= | |
(get-in old-spec [:elements elem-name :pos]) | |
(get-in old-spec [:elements elem-name :pos]))))) | |
do-clear! (fn [s] ;; from https://github.com/yaronn/blessed-contrib/issues/64#issuecomment-158683366 | |
(doseq [widget (reverse (.. s -children))] (.detach widget)) | |
s)] | |
(if clear? | |
(-> state (assoc :widgets {}) (update :screen do-clear!)) | |
state))) | |
(defn update-widgets! | |
"Create/update/redraw widgets one by one, returning the modified state." | |
[{:keys [old-spec] :as state} new-spec] | |
(reduce | |
(fn [{:keys [grid] :as state} [element-name element-spec]] | |
;; If some part of the element spec, get-or-create it and then redraw | |
(if (or (not (contains? (:widgets state) element-name)) | |
(not= (get-in old-spec [:elements element-name]) element-spec)) | |
(->> | |
(fn [?widget] | |
(let [widget (or ?widget (build-widget element-spec))] | |
(update-widget! widget grid element-spec))) | |
(update-in state [:widgets element-name])) | |
state)) | |
state | |
(:elements new-spec))) | |
(defn redraw-screen! | |
"Redraw the screen by first updating the grid/layout as necessary, and then | |
updating or creating the widgets." | |
[state new-spec] | |
(-> state | |
(maybe-update-grid! new-spec) | |
(maybe-clear-screen! new-spec) | |
(update-widgets! new-spec) | |
;; For the next invocation, the new-spec becomes the old-spec. | |
(assoc :old-spec new-spec) | |
;; Finally, render all state changes | |
(as-> s (let [screen (:screen s)] (.render screen) s)))) | |
;;; | |
;;; Main loop. Maintain state, await updates, redraw screen. | |
;;; | |
(defn -main [port & args] | |
(let [screen (blessed/screen) | |
state (atom {:screen screen :widgets {} :old-spec nil})] | |
;; Key bindings | |
(.key screen #js ["escape" "q" "C-c"] (fn [_ _] (.exit js/process 0))) | |
(.key screen #js ["l" "right"] (fn [_ _] (.focusNext screen))) | |
(.key screen #js ["h" "left"] (fn [_ _] (.focusPrevious screen))) | |
;; Fixes https://github.com/yaronn/blessed-contrib/issues/10 | |
(.on screen "resize" (fn [] (doall (map #(some-> % :widget (.emit "attach")) (:widgets state))))) | |
;; Loading screen | |
(let [init-screen | |
{:meta {:label "Initializing", :fg "green", :selectedFg "green", :interactive "true"} | |
:type "markdown" | |
:data (str "> Connecting...\n> Connected.\n> Awaiting data from port `" port "`...") | |
:pos {:x 1 :y 1 :width 3 :height 3}}] | |
(swap! state redraw-screen! {:grid {:cols 5 :rows 5} :elements {:loading init-screen}})) | |
(let [port (js/parseInt port) | |
sock (.connect net #js {:port port})] | |
(.on (.createInterface rl sock sock) "line" | |
(fn [l] | |
(try | |
(let [parsed-spec (js->clj (.parse js/JSON l) :keywordize-keys keyword)] | |
(assert (:elements parsed-spec) "The spec has an :elements key") | |
(swap! state redraw-screen! parsed-spec)) | |
(catch js/object e | |
(println "There was an error" e)))))))) | |
(set! *main-cli-fn* -main) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment