Temp working point
This commit is contained in:
Daniel Compton
parent
6bf1648187
commit
b3d64dd7a8
|
|
@ -4,5 +4,7 @@
|
|||
:license {:name "MIT"}
|
||||
:dependencies [[org.clojure/clojure "1.8.0"]
|
||||
[org.clojure/clojurescript "1.9.227"]
|
||||
[reagent "0.6.0"]]
|
||||
)
|
||||
[reagent "0.6.0"]
|
||||
[re-frame "0.8.1-SNAPSHOT"]
|
||||
[cljsjs/d3 "4.2.2-0"]]
|
||||
:profiles {:dev {:dependencies [[binaryage/dirac "RELEASE"]]}})
|
||||
|
|
|
|||
|
|
@ -0,0 +1,234 @@
|
|||
(ns day8.re-frame.trace
|
||||
(:require [day8.re-frame.trace.subvis :as subvis]
|
||||
[re-frame.tracing :as trace :include-macros true]
|
||||
[cljs.pprint :as pprint]
|
||||
[clojure.string :as str]
|
||||
[reagent.core :as r]
|
||||
[reagent.interop :refer-macros [$ $!]]
|
||||
[reagent.impl.util :as util]
|
||||
[reagent.impl.component :as component]
|
||||
[reagent.impl.batching :as batch]
|
||||
[reagent.ratom :as ratom]
|
||||
[re-frame.utils :as rutils]
|
||||
[goog.object :as gob]
|
||||
[re-frame.interop :as interop]))
|
||||
|
||||
(defn comp-name [c]
|
||||
(let [n (or (component/component-path c)
|
||||
(some-> c .-constructor util/fun-name))]
|
||||
(if-not (empty? n)
|
||||
n
|
||||
"")))
|
||||
|
||||
|
||||
|
||||
(def static-fns
|
||||
{:render
|
||||
(fn render []
|
||||
(this-as c
|
||||
(trace/with-trace {:op-type :render
|
||||
:tags {:component-path (reagent.impl.component/component-path c)}
|
||||
:operation (last (str/split (reagent.impl.component/component-path c) #" > "))}
|
||||
(if util/*non-reactive*
|
||||
(reagent.impl.component/do-render c)
|
||||
(let [rat ($ c :cljsRatom)
|
||||
_ (batch/mark-rendered c)
|
||||
res (if (nil? rat)
|
||||
(ratom/run-in-reaction #(reagent.impl.component/do-render c) c "cljsRatom"
|
||||
batch/queue-render reagent.impl.component/rat-opts)
|
||||
(._run rat false))
|
||||
cljs-ratom ($ c :cljsRatom)] ;; actually a reaction
|
||||
(trace/merge-trace!
|
||||
{:tags {:reaction (rutils/reagent-id cljs-ratom)
|
||||
:input-signals (when cljs-ratom
|
||||
(map rutils/reagent-id (gob/get cljs-ratom "watching" :none)))}})
|
||||
res)))))})
|
||||
|
||||
|
||||
(defn monkey-patch-reagent []
|
||||
(let [#_#_real-renderer reagent.impl.component/do-render
|
||||
real-custom-wrapper reagent.impl.component/custom-wrapper
|
||||
real-next-tick reagent.impl.batching/next-tick
|
||||
real-schedule reagent.impl.batching/schedule]
|
||||
|
||||
|
||||
#_(set! reagent.impl.component/do-render
|
||||
(fn [c]
|
||||
(let [name (comp-name c)]
|
||||
(js/console.log c)
|
||||
(trace/with-trace {:op-type :render
|
||||
:tags {:component-path (reagent.impl.component/component-path c)}
|
||||
:operation (last (str/split name #" > "))}
|
||||
(real-renderer c)
|
||||
|
||||
))))
|
||||
|
||||
(set! reagent.impl.component/static-fns static-fns)
|
||||
|
||||
(set! reagent.impl.component/custom-wrapper
|
||||
(fn [key f]
|
||||
(case key
|
||||
:componentWillUnmount
|
||||
(fn [] (this-as c
|
||||
(trace/with-trace {:op-type key
|
||||
:operation (last (str/split (comp-name c) #" > "))
|
||||
:tags {:component-path (reagent.impl.component/component-path c)}})
|
||||
(.call (real-custom-wrapper key f) c c)))
|
||||
|
||||
(real-custom-wrapper key f))))
|
||||
|
||||
#_(set! reagent.impl.batching/next-tick (fn [f]
|
||||
(real-next-tick (fn []
|
||||
(trace/with-trace {:op-type :raf}
|
||||
(f))))))
|
||||
|
||||
#_(set! reagent.impl.batching/schedule schedule
|
||||
#_(fn []
|
||||
(reagent.impl.batching/do-after-render (fn [] (trace/with-trace {:op-type :raf-end})))
|
||||
(real-schedule)))
|
||||
))
|
||||
|
||||
(def traces (interop/ratom []))
|
||||
(defn log-trace? [trace]
|
||||
(let [render-type? (= (:type trace) :render)]
|
||||
(not (and render-type?
|
||||
(str/includes? (or (get-in trace [:tags :component-path]) "") "day8.re_frame.trace.devtools")))))
|
||||
|
||||
(defn init-tracing! []
|
||||
(re-frame.tracing/register-trace-cb ::cb (fn [new-traces]
|
||||
(let [new-traces (filter log-trace? new-traces)]
|
||||
(swap! traces #(reduce conj % new-traces)))))
|
||||
(monkey-patch-reagent)
|
||||
)
|
||||
|
||||
(defn search-input [{:keys [title on-save on-stop]}]
|
||||
(let [val (r/atom title)
|
||||
save #(let [v (-> @val str clojure.string/trim)]
|
||||
(on-save v))]
|
||||
(fn [props]
|
||||
[:input (merge props
|
||||
{:type "text"
|
||||
:value @val
|
||||
:auto-focus true
|
||||
:on-blur save
|
||||
:on-change #(reset! val (-> % .-target .-value))
|
||||
:on-key-down #(case (.-which %)
|
||||
13 (save)
|
||||
nil)})])))
|
||||
|
||||
|
||||
(defn render-traces []
|
||||
(let [search (r/atom "")
|
||||
slower-than-ms (r/atom "")
|
||||
slower-than-bold (r/atom "")]
|
||||
(fn []
|
||||
(let [slower-than-ms-int (js/parseInt @slower-than-ms)
|
||||
slower-than-bold-int (js/parseInt @slower-than-bold)
|
||||
op-filter (when-not (str/blank? @search)
|
||||
(filter #(str/includes? (str (:operation %) " " (:type %)) @search)))
|
||||
ms-filter (when-not (str/blank? @slower-than-ms)
|
||||
(filter #(< slower-than-ms-int (:duration %))))
|
||||
transducers (apply comp (remove nil? [ms-filter op-filter]))
|
||||
showing-traces (sequence transducers @traces)
|
||||
|
||||
filter-msg (if (and (str/blank? @search) (str/blank? @slower-than-ms))
|
||||
(str "Filter " (count @traces) " events: ")
|
||||
(str "Filtering " (count showing-traces) " of " (count @traces) " events:"))
|
||||
padding {:padding "0px 5px 0px 5px"}]
|
||||
[:div
|
||||
{:style {:padding "10px"}}
|
||||
[:h1 "TRACES"]
|
||||
[:span filter-msg [:button {:on-click #(do (trace/reset-tracing!) (reset! traces []))} " Clear traces"]] [:br]
|
||||
[:span "Filter events " [search-input {:on-save #(reset! search %)}]] [:br]
|
||||
[:span "Filter slower than " [search-input {:on-save #(reset! slower-than-ms %)}] "ms "] [:br]
|
||||
[:span "Bold slower than " [search-input {:on-save #(reset! slower-than-bold %)}] "ms "]
|
||||
[:table
|
||||
{:cell-spacing "0" :width "100%"}
|
||||
[:thead>tr
|
||||
[:th "op"]
|
||||
[:th "event"]
|
||||
[:th "meta"]]
|
||||
[:tbody
|
||||
(doall
|
||||
(for [{:keys [type id operation tags duration] :as trace} showing-traces]
|
||||
(let [row-style (merge padding {:border-top (case type :event "1px solid lightgrey" nil)})]
|
||||
(list [:tr {:key id
|
||||
:style {:color (case type
|
||||
:sub/create "green"
|
||||
:sub/run "red"
|
||||
:event "blue"
|
||||
:render "purple"
|
||||
:re-frame.router/fsm-trigger "red"
|
||||
nil)}}
|
||||
[:td {:style row-style} (str type)]
|
||||
[:td {:style row-style} operation]
|
||||
[:td
|
||||
{:style (merge row-style {:font-weight (if (< slower-than-bold-int duration)
|
||||
"bold"
|
||||
"")})}
|
||||
(.toFixed duration 1) " ms"]]
|
||||
(when true
|
||||
[:tr {:key (str id "-details")}
|
||||
[:td {:col-span 3} (with-out-str (pprint/pprint (dissoc tags :query-v :event :duration)))]])))))]]]))))
|
||||
|
||||
(defn resizer-style [draggable-area]
|
||||
{:position "absolute" :z-index 2 :opacity 0
|
||||
:left (str (- (/ draggable-area 2)) "px") :width "10px" :top "0px" :height "100%" :cursor "col-resize"})
|
||||
|
||||
(def ease-transition "left 0.2s ease-out, top 0.2s ease-out, width 0.2s ease-out, height 0.2s ease-out")
|
||||
|
||||
(defn devtools []
|
||||
;; Add clear button
|
||||
;; Filter out different trace types
|
||||
(let [position (r/atom :right)
|
||||
size (r/atom 0.5)
|
||||
showing? (r/atom true)
|
||||
dragging? (r/atom false)
|
||||
pin-to-bottom? (r/atom true)
|
||||
selected-tab (r/atom :subvis)
|
||||
_ (js/console.log "Rendering devtools")
|
||||
handle-keys (fn [e]
|
||||
(let [combo-key? (or (.-ctrlKey e) (.-metaKey e) (.-altKey e))
|
||||
tag-name (.-tagName (.-target e))
|
||||
key (.-key e)
|
||||
entering-input? (contains? #{"INPUT" "SELECT" "TEXTAREA"} tag-name)]
|
||||
(when (and (not entering-input?) combo-key?)
|
||||
(cond
|
||||
(and (= key "h") (.-ctrlKey e))
|
||||
(do (swap! showing? not)
|
||||
(.preventDefault e))))))]
|
||||
(r/create-class
|
||||
{:component-will-mount #(js/window.addEventListener "keydown" handle-keys)
|
||||
:component-will-unmount #(js/window.removeEventListener "keydown" handle-keys)
|
||||
:display-name "devtools outer"
|
||||
:reagent-render (fn []
|
||||
(let [draggable-area 10
|
||||
full-width js/window.innerWidth
|
||||
full-height js/window.innerHeight
|
||||
left (if @showing? (str (* 100 (- 1 @size)) "%")
|
||||
(str full-width "px"))
|
||||
transition (if @showing?
|
||||
ease-transition
|
||||
(str ease-transition ", opacity 0.01s linear 0.2s"))]
|
||||
[:div {:style {:position "fixed" :width "0px" :height "0px" :top "0px" :left "0px" :z-index 99999999}}
|
||||
[:div {:style {:position "fixed" :z-index 1 :box-shadow "rgba(0, 0, 0, 0.298039) 0px 0px 4px" :background "white"
|
||||
:left left :top "0px" :width (str (* 100 @size) "%") :height "100%"
|
||||
:transition transition}}
|
||||
[:div.resizer {:style (resizer-style draggable-area)
|
||||
:on-mouse-down #(reset! dragging? true)
|
||||
:on-mouse-up #(reset! dragging? false)
|
||||
:on-mouse-move (fn [e]
|
||||
(when @dragging?
|
||||
(let [x (.-clientX e)
|
||||
y (.-clientY e)]
|
||||
(.preventDefault e)
|
||||
(reset! size (/ (- full-width x)
|
||||
full-width)))))}]
|
||||
[:div {:style {:width "100%" :height "100%" :overflow "auto"}}
|
||||
[:button {:on-click #(reset! selected-tab :traces)} "Traces"]
|
||||
[:button {:on-click #(reset! selected-tab :subvis)} "SubVis"]
|
||||
(case @selected-tab
|
||||
:traces [render-traces]
|
||||
:subvis [subvis/render-subvis traces]
|
||||
[render-traces])]]]))})))
|
||||
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
(ns day8.re-frame.trace.d3
|
||||
(:require [reagent.core :as r]))
|
||||
|
||||
(defn component-did-update [{:keys [d3-enter d3-update d3-exit]} ratoms]
|
||||
(apply d3-enter ratoms)
|
||||
(apply d3-update ratoms)
|
||||
(apply d3-exit ratoms))
|
||||
|
||||
(defn component-did-mount [{:keys [d3-did-mount] :as lifecycle-fns} ratoms]
|
||||
(apply d3-did-mount ratoms)
|
||||
(component-did-update lifecycle-fns ratoms))
|
||||
|
||||
(defn no-op [desc]
|
||||
(fn [& args]
|
||||
(println "No-op" desc)))
|
||||
|
||||
(defn create-d3
|
||||
"Creates a bridging component from Reagent to D3. Takes a map of
|
||||
lifecycle functions, and reactive data sources.
|
||||
|
||||
:render-component - Render the outer Reagent component, and a place for your D3 component to mount to (probably an SVG element)
|
||||
:d3-did-mount - Function called after the component has been rendered, for you to setup anything you need in D3 (e.g. adding <g> or classes)
|
||||
:d3-enter, :d3-update, :d3-exit - correspond to functions in the D3 general update pattern: https://bl.ocks.org/mbostock/3808218
|
||||
"
|
||||
[{:keys [render-component d3-did-mount d3-enter d3-update d3-exit]
|
||||
:or {render-component no-op
|
||||
d3-did-mount (no-op :d3-did-mount)
|
||||
d3-enter (no-op :d3-enter)
|
||||
d3-update (no-op :d3-update)
|
||||
d3-exit (no-op :d3-exit)}}
|
||||
& ratoms]
|
||||
(let [lifecycle-fns {:render-component render-component
|
||||
:d3-did-mount d3-did-mount
|
||||
:d3-enter d3-enter
|
||||
:d3-update d3-update
|
||||
:d3-exit d3-exit}]
|
||||
(r/create-class
|
||||
{:reagent-render (fn []
|
||||
(doseq [r ratoms] (deref r))
|
||||
(apply render-component ratoms))
|
||||
:component-did-mount (fn [this] (component-did-mount lifecycle-fns ratoms))
|
||||
:component-did-update (fn [this old-argv] (component-did-update lifecycle-fns ratoms))}))
|
||||
)
|
||||
|
||||
|
||||
;;;;
|
||||
;;;;
|
||||
;;; app
|
||||
;
|
||||
;
|
||||
;(def data (r/atom {}))
|
||||
;
|
||||
;(defn my-render [ratom]
|
||||
; (let [width 100
|
||||
; height 100]
|
||||
; [:div
|
||||
; {:id "barchart"}
|
||||
; [:svg
|
||||
; {:width width
|
||||
; :height height}]]))
|
||||
;
|
||||
;(defn bars-did-mount [ratom]
|
||||
; (-> (js/d3.select "#barchart svg")
|
||||
; (.append "g")
|
||||
; (.attr "class" "container")
|
||||
; (.append "g")
|
||||
; (.attr "class" "bars")))
|
||||
;
|
||||
;(defn bars-enter [ratom]
|
||||
; (let [data (get-data ratom)]
|
||||
; (-> (js/d3.select "#barchart svg .container .bars")
|
||||
; (.selectAll "rect")
|
||||
; (.data (clj->js data))
|
||||
; .enter
|
||||
; (.append "rect"))))
|
||||
;
|
||||
;(defn bars-update [ratom]
|
||||
; (let [width (get-width ratom)
|
||||
; height (get-height ratom)
|
||||
; data (get-data ratom)
|
||||
; data-n (count data)
|
||||
; rect-height (/ height data-n)
|
||||
; x-scale (-> js/d3
|
||||
; .scaleLinear
|
||||
; (.domain #js [0 5])
|
||||
; (.range #js [0 width]))]
|
||||
; (-> (js/d3.select "#barchart svg .container .bars")
|
||||
; (.selectAll "rect")
|
||||
; (.data (clj->js data))
|
||||
; (.attr "fill" "green")
|
||||
; (.attr "x" (x-scale 0))
|
||||
; (.attr "y" (fn [_ i]
|
||||
; (* i rect-height)))
|
||||
; (.attr "height" (- rect-height 1))
|
||||
; (.attr "width" (fn [d]
|
||||
; (x-scale (aget d "x")))))))
|
||||
;
|
||||
;(defn bars-exit [ratom]
|
||||
; (let [data (get-data ratom)]
|
||||
; (-> (js/d3.select "#barchart svg .container .bars")
|
||||
; (.selectAll "rect")
|
||||
; (.data (clj->js data))
|
||||
; .exit
|
||||
; .remove)))
|
||||
;
|
||||
;(create-d3 data {:reagent-render my-render
|
||||
; :d3-did-mount bars-did-mount
|
||||
; :d3-enter bars-enter
|
||||
; :d3-update bars-update
|
||||
; :d3-exit bars-exit})
|
||||
|
|
@ -0,0 +1 @@
|
|||
(ns day8.re-frame.trace.log)
|
||||
|
|
@ -0,0 +1,559 @@
|
|||
(ns day8.re-frame.trace.subvis
|
||||
(:require cljsjs.d3
|
||||
[day8.re-frame.trace.d3 :as d3t]
|
||||
[reagent.core :as r]
|
||||
[re-frame.utils :as rutils]
|
||||
[re-frame.db :as db]
|
||||
[goog.object :as gob]
|
||||
[clojure.set :as set]))
|
||||
|
||||
(def width 400)
|
||||
(def height 200)
|
||||
|
||||
(def mygraph (r/atom {:nodes [{:id 1 :group 1}
|
||||
{:id 2 :group 1}
|
||||
{:id 3 :group 2}]
|
||||
:links [{:source 1 :target 2 :value 1}]}))
|
||||
|
||||
(defn trace->sub-graph [traces]
|
||||
(let [disposed (->> traces
|
||||
(filter #(#{:sub/dispose} (:type %)))
|
||||
(map #(get-in % [:tags :reaction]))
|
||||
set)
|
||||
sub-nodes (->> traces
|
||||
(filter #(#{:sub/create} (:type %)))
|
||||
(remove #(contains? disposed (get-in % [:tags :reaction])))
|
||||
(remove #(get-in % [:tags :cached?]))
|
||||
(map (fn [trace]
|
||||
{:id (get-in trace [:tags :reaction])
|
||||
:title (str (:operation trace))
|
||||
:group (mod (:id trace) 20)
|
||||
:r 10
|
||||
:data trace})))
|
||||
|
||||
unmounted-components #{}
|
||||
view-nodes (->> traces
|
||||
(filter #(#{:render} (:type %)))
|
||||
(remove #(contains? unmounted-components (:id %))) ;; todo
|
||||
(map (fn [trace]
|
||||
{:id (get-in trace [:tags :reaction])
|
||||
:title (:operation trace)
|
||||
:group (mod (:id trace) 20)
|
||||
:r 5
|
||||
:data trace}))
|
||||
|
||||
)
|
||||
|
||||
sub-links (->> traces
|
||||
(filter #(#{:sub/run} (:type %)))
|
||||
(remove #(contains? disposed (get-in % [:tags :reaction])))
|
||||
(mapcat (fn [trace]
|
||||
(for [input-signal (get-in trace [:tags :input-signals])
|
||||
:let [reaction (get-in trace [:tags :reaction])]
|
||||
:when (every? some? [input-signal reaction])]
|
||||
{:source input-signal :target reaction :value 1}))))
|
||||
|
||||
view-links (->> traces
|
||||
(filter #(#{:render} (:type %)))
|
||||
(remove #(contains? unmounted-components (get-in % [:tags :reaction])))
|
||||
(mapcat (fn [trace]
|
||||
(for [input-signal (get-in trace [:tags :input-signals])
|
||||
:let [reaction (get-in trace [:tags :reaction])]
|
||||
:when (every? some? [input-signal reaction])]
|
||||
{:source input-signal :target reaction :value 0.5}))))
|
||||
|
||||
app-db {:id (rutils/reagent-id db/app-db)
|
||||
:title "app-db"
|
||||
:group 1
|
||||
:r 20
|
||||
:fx (/ width 2)
|
||||
:fy 30}
|
||||
|
||||
|
||||
all-nodes (concat sub-nodes [app-db] view-nodes)
|
||||
node-ids (set (map :id all-nodes))
|
||||
nodes-links (->> (mapcat (fn [{:keys [source target]}] [source target]) view-links)
|
||||
set)
|
||||
missing-nodes (set/difference nodes-links node-ids) ;; These are local ratoms
|
||||
|
||||
view-links (->> view-links
|
||||
(remove #(get missing-nodes (:source %))))
|
||||
]
|
||||
|
||||
{:nodes all-nodes
|
||||
:links (concat sub-links view-links)}))
|
||||
|
||||
(defn min-max
|
||||
"Returns x if it is within min-val and max-val
|
||||
otherwise returns min-val if x is less than min-val
|
||||
and max-val if x is greater than max-val.
|
||||
|
||||
Essentially this provides a bounding box/clamp around x."
|
||||
[min-val x max-val]
|
||||
(assert (<= min-val max-val))
|
||||
(cljs.core/max min-val (cljs.core/min x max-val)))
|
||||
|
||||
(defn force-inner [graph]
|
||||
(r/create-class
|
||||
{:reagent-render (fn [] [:div [:svg {:width width :height height}]])
|
||||
|
||||
:component-did-mount (fn []
|
||||
(let [nodes (clj->js (:nodes graph))
|
||||
links (clj->js (:links graph))
|
||||
color (.scaleOrdinal js/d3 (.-schemeCategory20 js/d3))
|
||||
svg (. js/d3 select "svg")
|
||||
simulation (.. js/d3
|
||||
(forceSimulation)
|
||||
(force "link" (.. js/d3 (forceLink)
|
||||
(id #(.-id %))
|
||||
(distance (constantly 100))))
|
||||
(force "charge" (.. js/d3 (forceManyBody)
|
||||
(strength (constantly -100))))
|
||||
(force "center" (. js/d3 forceCenter (/ width 2) (/ height 2))))
|
||||
|
||||
dragstarted (fn [d]
|
||||
(when (zero? (.. js/d3 -event -active))
|
||||
(.. simulation
|
||||
(alphaTarget 0.3)
|
||||
(restart)))
|
||||
|
||||
(set! (.-fx d) (.-x d))
|
||||
(set! (.-fy d) (.-y d)))
|
||||
|
||||
dragged (fn [d]
|
||||
(set! (.-fx d) (.. js/d3 -event -x))
|
||||
(set! (.-fy d) (.. js/d3 -event -y)))
|
||||
|
||||
dragended (fn [d]
|
||||
(when (zero? (.. js/d3 -event -active))
|
||||
(.. simulation
|
||||
(alphaTarget 0.0)))
|
||||
(set! (.-fx d) nil)
|
||||
(set! (.-fy d) nil))
|
||||
|
||||
link (.. (. svg append "g")
|
||||
(attr "class" "links")
|
||||
(selectAll "line")
|
||||
(data links)
|
||||
(enter)
|
||||
(append "line")
|
||||
(attr "stroke-width" (fn [d] (Math/sqrt (.-value d)))))
|
||||
|
||||
node (.. (. svg append "g")
|
||||
(attr "class" "nodes")
|
||||
(selectAll "circle")
|
||||
(data nodes)
|
||||
(enter)
|
||||
(append "g")
|
||||
(attr "class" "node"))
|
||||
|
||||
circle (.. node
|
||||
(append "circle")
|
||||
(attr "r" #(or (gob/get % "r" 10)))
|
||||
(attr "fill" (fn [d] (color (.-group d))))
|
||||
(call (.. (. js/d3 drag)
|
||||
(on "start" dragstarted)
|
||||
(on "drag" dragged)
|
||||
(on "end" dragended))))
|
||||
|
||||
label (.. node
|
||||
(append "text")
|
||||
(attr "dy" ".35em")
|
||||
(text #(gob/get % "title" "")))
|
||||
|
||||
ticked (fn []
|
||||
(.. link
|
||||
(attr "x1" (fn [d] (.. d -source -x)))
|
||||
(attr "y1" (fn [d] (.. d -source -y)))
|
||||
(attr "x2" (fn [d] (.. d -target -x)))
|
||||
(attr "y2" (fn [d] (.. d -target -y))))
|
||||
(.. circle
|
||||
(attr "cx" (fn [d] (min-max (.. d -r) (.. d -x) (- width (.. d -r)))))
|
||||
(attr "cy" (fn [d] (min-max (.. d -r) (.. d -y) (- height (.. d -r))))))
|
||||
(.. label
|
||||
(attr "x" #(+ (.-x %) 2 (.-r %)))
|
||||
(attr "y" #(+ (.-y %))))
|
||||
nil)
|
||||
]
|
||||
|
||||
(.. simulation
|
||||
(nodes nodes)
|
||||
(on "tick" ticked))
|
||||
|
||||
(.. simulation
|
||||
(force "link")
|
||||
(links links))))
|
||||
|
||||
:component-did-update (fn [this]
|
||||
#_(let [[_ data] (r/argv this)
|
||||
d3data (clj->js data)
|
||||
circles (.. js/d3
|
||||
(select "svg")
|
||||
(selectAll "circle")
|
||||
(data d3data (fn [d i] (when d (.-name d)))))]
|
||||
(.. circles
|
||||
;(attr "cx" (fn [d] (.-x d)))
|
||||
;(attr "cy" (fn [d] (.-y d)))
|
||||
;(attr "r" (fn [d] (.-r d)))
|
||||
enter
|
||||
(append "circle")
|
||||
(attr "cx" 200)
|
||||
(attr "cy" 200)
|
||||
(attr "r" 500)
|
||||
(transition)
|
||||
(attr "cx" (fn [d] (.-x d)))
|
||||
(attr "cy" (fn [d] (.-y d)))
|
||||
(attr "r" (fn [d] (.-r d)))
|
||||
(attr "fill" (fn [d] (.-color d))))
|
||||
(.. circles
|
||||
exit
|
||||
remove)))}))
|
||||
|
||||
|
||||
(defn force-outer [traces-ratom]
|
||||
(fn []
|
||||
(let [trace-graph (trace->sub-graph @traces-ratom)]
|
||||
[force-inner trace-graph])))
|
||||
|
||||
(defonce desc (r/atom 1))
|
||||
|
||||
(defn render-subvis [traces-ratom]
|
||||
(let [color-a (atom nil)
|
||||
svg-a (atom nil)
|
||||
simulation-a (atom nil)]
|
||||
(fn []
|
||||
[:div
|
||||
{:style {:padding "10px"}}
|
||||
[:h1 "SUBVIS"]
|
||||
[force-outer traces-ratom]
|
||||
[:hr]
|
||||
[:h2 {:on-click #(swap! desc inc)} "Click"]
|
||||
[(d3t/create-d3 {:render-component (fn [ratom]
|
||||
[:div
|
||||
[:h1 (str "SVG")]
|
||||
[:svg#d3cmp {:width width :height height}]])
|
||||
:d3-did-mount (fn [ratom]
|
||||
(let [graph (trace->sub-graph @ratom)
|
||||
nodes (clj->js (:nodes graph))
|
||||
links (clj->js (:links graph))
|
||||
color (reset! color-a (.scaleOrdinal js/d3 (.-schemeCategory20 js/d3)))
|
||||
svg (reset! svg-a (. js/d3 select "#d3cmp"))
|
||||
simulation (reset! simulation-a
|
||||
(.. js/d3
|
||||
(forceSimulation)
|
||||
(force "link" (.. js/d3 (forceLink)
|
||||
(id #(.-id %))
|
||||
(distance (constantly 100))))
|
||||
(force "charge" (.. js/d3 (forceManyBody)
|
||||
(strength (constantly -100))))
|
||||
(force "center" (. js/d3 forceCenter (/ width 2) (/ height 2)))))
|
||||
|
||||
dragstarted (fn [d]
|
||||
(when (zero? (.. js/d3 -event -active))
|
||||
(.. simulation
|
||||
(alphaTarget 0.3)
|
||||
(restart)))
|
||||
|
||||
(set! (.-fx d) (.-x d))
|
||||
(set! (.-fy d) (.-y d)))
|
||||
|
||||
dragged (fn [d]
|
||||
(set! (.-fx d) (.. js/d3 -event -x))
|
||||
(set! (.-fy d) (.. js/d3 -event -y)))
|
||||
|
||||
dragended (fn [d]
|
||||
(when (zero? (.. js/d3 -event -active))
|
||||
(.. simulation
|
||||
(alphaTarget 0.0)))
|
||||
(set! (.-fx d) nil)
|
||||
(set! (.-fy d) nil))
|
||||
|
||||
link (.. (. svg append "g")
|
||||
(attr "class" "links")
|
||||
(selectAll "line")
|
||||
(data links)
|
||||
(enter)
|
||||
(append "line")
|
||||
(attr "stroke-width" (fn [d] (Math/sqrt (.-value d))))
|
||||
)
|
||||
|
||||
link-sel (.. svg
|
||||
(selectAll ".links > line"))
|
||||
|
||||
node (.. (. svg append "g")
|
||||
(attr "class" "nodes")
|
||||
(selectAll "circle")
|
||||
(data nodes)
|
||||
(enter)
|
||||
(append "g")
|
||||
(attr "class" "node"))
|
||||
|
||||
circle (.. node
|
||||
(append "circle")
|
||||
(attr "r" #(or (gob/get % "r" 10)))
|
||||
(attr "fill" (fn [d] (color (.-group d))))
|
||||
(call (.. (. js/d3 drag)
|
||||
(on "start" dragstarted)
|
||||
(on "drag" dragged)
|
||||
(on "end" dragended))))
|
||||
|
||||
circle-sel (.. svg
|
||||
(selectAll ".node > circle"))
|
||||
|
||||
label (.. node
|
||||
(append "text")
|
||||
(attr "dy" ".35em")
|
||||
(text #(gob/get % "title" "")))
|
||||
|
||||
label-sel (.. svg
|
||||
(selectAll ".node > text"))
|
||||
|
||||
ticked (fn []
|
||||
(.. link-sel
|
||||
(attr "x1" (fn [d] (.. d -source -x)))
|
||||
(attr "y1" (fn [d] (.. d -source -y)))
|
||||
(attr "x2" (fn [d] (.. d -target -x)))
|
||||
(attr "y2" (fn [d] (.. d -target -y))))
|
||||
(.. circle-sel
|
||||
(attr "cx" (fn [d] (min-max (.. d -r) (.. d -x) (- width (.. d -r)))))
|
||||
(attr "cy" (fn [d] (min-max (.. d -r) (.. d -y) (- height (.. d -r))))))
|
||||
(.. label-sel
|
||||
(attr "x" #(+ (.-x %) 2 (.-r %)))
|
||||
(attr "y" #(+ (.-y %))))
|
||||
nil)
|
||||
]
|
||||
|
||||
(.. simulation
|
||||
(nodes nodes)
|
||||
(on "tick" ticked))
|
||||
|
||||
(.. simulation
|
||||
(force "link")
|
||||
(links links))))
|
||||
:d3-enter (fn [ratom]
|
||||
(let [graph (trace->sub-graph @ratom)
|
||||
nodes (clj->js (:nodes graph))
|
||||
links (clj->js (:links graph))
|
||||
|
||||
svg @svg-a
|
||||
color @color-a
|
||||
simulation @simulation-a
|
||||
|
||||
dragstarted (fn [d]
|
||||
(when (zero? (.. js/d3 -event -active))
|
||||
(.. simulation
|
||||
(alphaTarget 0.3)
|
||||
(restart)))
|
||||
|
||||
(set! (.-fx d) (.-x d))
|
||||
(set! (.-fy d) (.-y d)))
|
||||
|
||||
dragged (fn [d]
|
||||
(set! (.-fx d) (.. js/d3 -event -x))
|
||||
(set! (.-fy d) (.. js/d3 -event -y)))
|
||||
|
||||
dragended (fn [d]
|
||||
(when (zero? (.. js/d3 -event -active))
|
||||
(.. simulation
|
||||
(alphaTarget 0.0)))
|
||||
(set! (.-fx d) nil)
|
||||
(set! (.-fy d) nil))
|
||||
|
||||
link (.. (. svg append "g")
|
||||
(attr "class" "links")
|
||||
(selectAll "line")
|
||||
(data links)
|
||||
(enter)
|
||||
(append "line")
|
||||
(attr "stroke-width" (fn [d] (Math/sqrt (.-value d)))))
|
||||
|
||||
node (.. (. svg append "g")
|
||||
(attr "class" "nodes")
|
||||
(selectAll "circle")
|
||||
(data nodes)
|
||||
(enter)
|
||||
(append "g")
|
||||
(attr "class" "node"))
|
||||
|
||||
circle (.. node
|
||||
(append "circle")
|
||||
(attr "r" #(or (gob/get % "r" 10)))
|
||||
(attr "fill" (fn [d] (color (.-group d))))
|
||||
(call (.. (. js/d3 drag)
|
||||
(on "start" dragstarted)
|
||||
(on "drag" dragged)
|
||||
(on "end" dragended))))
|
||||
|
||||
|
||||
label (.. node
|
||||
(append "text")
|
||||
(attr "dy" ".35em")
|
||||
(text #(gob/get % "title" "")))
|
||||
|
||||
]
|
||||
|
||||
(.. simulation
|
||||
(force "link")
|
||||
(links links))
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(println "D3 did enter"))}
|
||||
traces-ratom)]
|
||||
[:hr]])))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;(ns todomvc.subvis2
|
||||
; (:require [reagent.core :as r]))
|
||||
;
|
||||
;(defn prep-parent [parent]
|
||||
; (-> parent
|
||||
; (.selectAll "*")
|
||||
; .remove)
|
||||
; (.append parent "g"))
|
||||
;
|
||||
;(defn draw-circle [parent]
|
||||
; (let [OUTER_WIDTH 208
|
||||
; OUTER_HEIGHT 208
|
||||
; parent (-> (js/d3.select parent)
|
||||
; (.select "svg")
|
||||
; (.attr "width" OUTER_WIDTH)
|
||||
; (.attr "height" OUTER_HEIGHT))]
|
||||
;
|
||||
; ; Clear everything under the parent node so we can re-render it.
|
||||
; (prep-parent parent)
|
||||
;
|
||||
; (let [top-node (.select parent "g")
|
||||
; COLOR_CIRCLE "#fdb74a"]
|
||||
; (.attr top-node
|
||||
; "transform"
|
||||
; (str "translate("
|
||||
; (/ OUTER_WIDTH 2.0)
|
||||
; ","
|
||||
; (/ OUTER_HEIGHT 2.0)
|
||||
; ")"))
|
||||
;
|
||||
; (-> top-node
|
||||
; (.append "circle")
|
||||
; (.attr "cx" 0)
|
||||
; (.attr "cy" 0)
|
||||
; (.attr "r" 100)
|
||||
; (.style "stroke" COLOR_CIRCLE)))))
|
||||
;
|
||||
;(defn d3-gauge [args]
|
||||
; (let [dom-node (r/atom nil)]
|
||||
; (r/create-class
|
||||
; {:component-did-update
|
||||
; (fn [this old-argv]
|
||||
; (let [[_ args] (r/argv this)]
|
||||
; ;; This is where we get to actually draw the D3 gauge.
|
||||
; (draw-circle @dom-node)))
|
||||
;
|
||||
; :component-did-mount
|
||||
; (fn [this]
|
||||
; (let [node (r/dom-node this)]
|
||||
; ;; This will trigger a re-render of the component.
|
||||
; (reset! dom-node node)))
|
||||
;
|
||||
; :reagent-render
|
||||
; (fn [args]
|
||||
; ;; Necessary for Reagent to see that we depend on the dom-node r/atom.
|
||||
; ;; Note: we don't actually use any of the args here. This is because
|
||||
; ;; we cannot render D3 at this point. We have to wait for the update.
|
||||
; @dom-node
|
||||
; [:div.gauge [:svg]])})))
|
||||
;
|
||||
;
|
||||
;(def circles (r/atom [{:name "circle 1"
|
||||
; :x 10
|
||||
; :y 10
|
||||
; :r 20
|
||||
; :color "black"}
|
||||
; {:name "circle 2"
|
||||
; :x 35
|
||||
; :y 35
|
||||
; :r 15
|
||||
; :color "red"}
|
||||
; {:name "circle 3"
|
||||
; :x 100
|
||||
; :y 100
|
||||
; :r 30
|
||||
; :color "blue"}
|
||||
; {:name "circle 4" :x 55 :y 55 :r 10 :color "red"}]))
|
||||
;
|
||||
;(defn new-circle []
|
||||
; {:name (str (gensym "circle"))
|
||||
; :x (rand-int 400)
|
||||
; :y (rand-int 400)
|
||||
; :r (+ 10 (rand-int 20))
|
||||
; :color (str "hsl(" (rand-int 360) ", 100%, 50%)")})
|
||||
;
|
||||
;(defn add-new [n]
|
||||
; (swap! circles conj (new-circle)))
|
||||
;
|
||||
;(defn d3-inner [data]
|
||||
; (r/create-class
|
||||
; {:reagent-render (fn [] [:div [:svg {:width 400 :height 800}]])
|
||||
;
|
||||
; :component-did-mount (fn []
|
||||
; (let [d3data (clj->js data)]
|
||||
; (.interval js/d3 add-new 1000)
|
||||
; (.. js/d3
|
||||
; (select "svg")
|
||||
; (selectAll "circle")
|
||||
; (data d3data (fn [d i] (.-name d)))
|
||||
; enter
|
||||
; (append "circle")
|
||||
; (attr "cx" (fn [d] (.-x d)))
|
||||
; (attr "cy" (fn [d] (.-y d)))
|
||||
; (attr "r" (fn [d] (.-r d)))
|
||||
; (attr "fill" (fn [d] (.-color d))))))
|
||||
;
|
||||
; :component-did-update (fn [this]
|
||||
; (let [[_ data] (r/argv this)
|
||||
; d3data (clj->js data)
|
||||
; circles (.. js/d3
|
||||
; (select "svg")
|
||||
; (selectAll "circle")
|
||||
; (data d3data (fn [d i] (when d (.-name d)))))]
|
||||
; (.. circles
|
||||
; ;(attr "cx" (fn [d] (.-x d)))
|
||||
; ;(attr "cy" (fn [d] (.-y d)))
|
||||
; ;(attr "r" (fn [d] (.-r d)))
|
||||
; enter
|
||||
; (append "circle")
|
||||
; (attr "cx" 200)
|
||||
; (attr "cy" 200)
|
||||
; (attr "r" 500)
|
||||
; (transition)
|
||||
; (attr "cx" (fn [d] (.-x d)))
|
||||
; (attr "cy" (fn [d] (.-y d)))
|
||||
; (attr "r" (fn [d] (.-r d)))
|
||||
; (attr "fill" (fn [d] (.-color d))))
|
||||
; (.. circles
|
||||
; exit
|
||||
; remove)))}))
|
||||
;
|
||||
;(defn outer []
|
||||
; (let [data circles #_(subscribe [:circles])]
|
||||
; (fn []
|
||||
; [d3-inner @data])))
|
||||
;
|
||||
;
|
||||
Loading…
Reference in New Issue