Continue working
This commit is contained in:
Daniel Compton
parent
6b8b961d13
commit
9335c3963c
|
|
@ -96,7 +96,7 @@
|
|||
(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")))))
|
||||
(str/includes? (or (get-in trace [:tags :component-path]) "") "day8.re_frame.trace")))))
|
||||
|
||||
(defn init-tracing! []
|
||||
(re-frame.tracing/register-trace-cb ::cb (fn [new-traces]
|
||||
|
|
@ -156,7 +156,7 @@
|
|||
(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)})
|
||||
_ (js/console.log (devtools/header-api-call tags))
|
||||
#_ #_ _ (js/console.log (devtools/header-api-call tags))
|
||||
]
|
||||
(list [:tr {:key id
|
||||
:style {:color (case type
|
||||
|
|
|
|||
|
|
@ -31,8 +31,7 @@
|
|||
:when (every? some? [input-signal reaction])]
|
||||
{:source input-signal :target reaction :value link-val
|
||||
:id (str input-signal "|" reaction)})))
|
||||
(into {} (map (fn [trace] [(:id trace) trace])))
|
||||
(vals)))
|
||||
(distinct-k :id)))
|
||||
|
||||
(defn select-sub-nodes [traces type disposed-ids r]
|
||||
(->> traces
|
||||
|
|
@ -45,24 +44,23 @@
|
|||
:group 2
|
||||
:r r
|
||||
:data trace}))
|
||||
(into {} (map (fn [trace] [(:id trace) trace])))
|
||||
(vals)))
|
||||
(distinct-k :id)))
|
||||
|
||||
(defn select-view-nodes [traces type unmounted-components r]
|
||||
(->> traces
|
||||
(select-type type)
|
||||
(remove #(contains? unmounted-components (:id %)))
|
||||
(remove #(contains? unmounted-components (get-reaction %)))
|
||||
(map (fn [trace]
|
||||
{:id (get-reaction trace)
|
||||
:title (str (get-reaction trace) " " (:operation trace))
|
||||
:title (str (:operation trace))
|
||||
:group 3
|
||||
:r r
|
||||
:data trace
|
||||
:fx 250}))
|
||||
:fx 350}))
|
||||
(remove #(nil? (:id %))) ;; remove reactions that are null (mostly from input fields???)
|
||||
(into {} (map (fn [trace] [(:id trace) trace])))
|
||||
(vals)
|
||||
))
|
||||
(distinct-k :id)))
|
||||
|
||||
;; Use http://bl.ocks.org/GerHobbelt/3683278 to constrain nodes
|
||||
|
||||
(defn trace->sub-graph [traces extra-nodes]
|
||||
(let [disposed-ids (->> (select-type :sub/dispose traces)
|
||||
|
|
@ -71,10 +69,11 @@
|
|||
unmounted-components (->> (select-type :componentWillUnmount traces)
|
||||
(map get-reaction)
|
||||
set)
|
||||
|
||||
sub-nodes (select-sub-nodes traces :sub/create disposed-ids 10)
|
||||
view-nodes (select-view-nodes traces :render unmounted-components 5)
|
||||
view-nodes nil #_ (select-view-nodes traces :render unmounted-components 5)
|
||||
sub-links (select-links traces :sub/run disposed-ids 1)
|
||||
view-links (select-links traces :render unmounted-components 0.5)
|
||||
view-links nil #_ (select-links traces :render unmounted-components 0.5)
|
||||
all-nodes (concat extra-nodes sub-nodes view-nodes)
|
||||
node-ids (set (map :id all-nodes))
|
||||
nodes-links (->> (mapcat (fn [{:keys [source target]}] [source target]) view-links) set)
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@
|
|||
(def width 400)
|
||||
(def height 400)
|
||||
|
||||
(def prev-graph (atom nil))
|
||||
(def mygraph (r/atom {:nodes [{:id 1 :group 1}
|
||||
{:id 2 :group 1}
|
||||
{:id 3 :group 2}]
|
||||
|
|
@ -23,6 +24,8 @@
|
|||
:fx 15
|
||||
:fy (/ height 2)})
|
||||
|
||||
(defn render-node? [d]
|
||||
(= "render" (gob/getValueByKeys d "data" "type")))
|
||||
|
||||
(defn min-max
|
||||
"Returns x if it is within min-val and max-val
|
||||
|
|
@ -34,33 +37,10 @@
|
|||
(assert (<= min-val max-val))
|
||||
(cljs.core/max min-val (cljs.core/min x max-val)))
|
||||
|
||||
|
||||
(defn ticked [selector]
|
||||
(fn []
|
||||
;(println "ticked")
|
||||
(let [link-sel (.. selector
|
||||
(selectAll "g.links > line"))
|
||||
circle-sel (.. selector
|
||||
(selectAll "g.node > circle"))
|
||||
label-sel (.. selector
|
||||
(selectAll "g.node > text"))]
|
||||
(.. 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] (set! (.-x d) (min-max (.. d -r) (.. d -x) (- width (.. d -r))))))
|
||||
(attr "cy" (fn [d] (set! (.-y d) (min-max (.. d -r) (.. d -y) (- height (.. d -r)))))))
|
||||
(.. label-sel
|
||||
(attr "x" (fn [d] (+ 2 (.-x d) (.-r d))))
|
||||
(attr "y" #(+ (.-y %)))))))
|
||||
|
||||
(defn render-subvis [traces-ratom]
|
||||
(let [color-a (atom nil)
|
||||
svg-a (atom nil)
|
||||
simulation-a (atom nil)
|
||||
run? (atom false)]
|
||||
simulation-a (atom nil)]
|
||||
(fn []
|
||||
(println "Render subvis")
|
||||
[:div
|
||||
|
|
@ -70,9 +50,9 @@
|
|||
{:render-component (fn [ratom]
|
||||
[:svg#d3cmp {:width width :height height}])
|
||||
:d3-once (fn [ratom]
|
||||
(let [color (reset! color-a (.scaleOrdinal js/d3 (.-schemeCategory20 js/d3)))
|
||||
svg (reset! svg-a (. js/d3 select "#d3cmp"))
|
||||
simulation (reset! simulation-a
|
||||
(let [svg (reset! svg-a (. js/d3 select "#d3cmp"))]
|
||||
(reset! color-a (.scaleOrdinal js/d3 (.-schemeCategory20 js/d3)))
|
||||
(reset! simulation-a
|
||||
(.. js/d3
|
||||
(forceSimulation)
|
||||
(force "link" (.. js/d3 (forceLink)
|
||||
|
|
@ -81,98 +61,135 @@
|
|||
(force "charge" (.. js/d3 (forceManyBody)
|
||||
(strength (constantly -100))))
|
||||
(force "center" (. js/d3 forceCenter (/ width 2) (/ height 2)))))
|
||||
|
||||
link (.. (. svg append "g")
|
||||
(.. (. svg append "g")
|
||||
(attr "class" "links"))
|
||||
|
||||
node (.. (. svg append "g")
|
||||
(attr "class" "nodes"))]))
|
||||
(.. (. svg append "g")
|
||||
(attr "class" "nodes"))))
|
||||
:d3-update (fn [ratom]
|
||||
(when-not false #_@run?
|
||||
#_(reset! run? true)
|
||||
(let [graph (graph/trace->sub-graph @ratom [app-db-node])
|
||||
(let [old-g @prev-graph ;; TODO: is this working?
|
||||
graph (reset! prev-graph (graph/trace->sub-graph @ratom [app-db-node]))]
|
||||
(js/console.log (clojure.data/diff old-g graph))
|
||||
(when (not= old-g graph)
|
||||
(println "Running")
|
||||
(let [simulation @simulation-a
|
||||
color @color-a
|
||||
svg @svg-a
|
||||
graph (graph/trace->sub-graph @ratom [app-db-node])
|
||||
nodes (clj->js (:nodes graph))
|
||||
links (clj->js (:links graph))
|
||||
svg @svg-a
|
||||
color @color-a
|
||||
simulation @simulation-a
|
||||
dragstarted (fn [d]
|
||||
drag-started (fn [d]
|
||||
(when (zero? (.. js/d3 -event -active))
|
||||
(.. simulation
|
||||
(alphaTarget 0.3)
|
||||
(restart)))
|
||||
|
||||
#_(set! (.-fx d) (.. js/d3 -event -x)) ; (.-x d)
|
||||
#_(set! (.-fy d) (.. js/d3 -event -y)))
|
||||
|
||||
(restart))))
|
||||
dragged (fn [d]
|
||||
(set! (.-fx d) (.. js/d3 -event -x))
|
||||
(set! (.-fy d) (.. js/d3 -event -y)))
|
||||
|
||||
dragended (fn [d]
|
||||
drag-ended (fn [d]
|
||||
(when (zero? (.. js/d3 -event -active))
|
||||
(.. simulation
|
||||
(alphaTarget 0.0)))
|
||||
(set! (.-fx d) nil)
|
||||
(set! (.-fy d) nil))
|
||||
|
||||
;; Links
|
||||
link (.. svg
|
||||
(select ".links")
|
||||
(select "g.links")
|
||||
(selectAll "line")
|
||||
(data links (fn [d] (.-id d))))
|
||||
|
||||
new-link (.. link
|
||||
(data links #(.-id %)))
|
||||
enter-link (.. link
|
||||
(enter)
|
||||
(append "line")
|
||||
(attr "stroke-width" (fn [d] (Math/sqrt (.-value d)))))
|
||||
|
||||
node (.. svg
|
||||
(select ".nodes")
|
||||
(selectAll "circle")
|
||||
(data nodes))
|
||||
|
||||
new-node (.. node
|
||||
(enter)
|
||||
(append "g")
|
||||
(attr "class" "node"))
|
||||
|
||||
circle (.. new-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 (.. new-node
|
||||
(append "text")
|
||||
(attr "dy" ".35em")
|
||||
(text #(gob/get % "title" "")))
|
||||
|
||||
exit-node (.. node
|
||||
(exit)
|
||||
(remove "g"))
|
||||
|
||||
exit-link (.. link
|
||||
merged-link (.. enter-link (merge link))
|
||||
_ (.. link
|
||||
(exit)
|
||||
(remove "line"))
|
||||
|
||||
]
|
||||
(println "Nodes count" (count nodes))
|
||||
(println "Links count" (count links))
|
||||
;; Nodes
|
||||
node (.. svg
|
||||
(select "g.nodes")
|
||||
(selectAll ".node")
|
||||
(data nodes #(.-id %)))
|
||||
enter-node (.. node
|
||||
(enter)
|
||||
(append "g")
|
||||
(attr "class" "node")
|
||||
(call (.. js/d3 (drag)
|
||||
(on "start" drag-started)
|
||||
(on "drag" dragged)
|
||||
(on "end" drag-ended))))
|
||||
circle (.. enter-node
|
||||
(append "circle")
|
||||
(attr "r" (fn [d] (.-r d)))
|
||||
(attr "fill" (fn [d] (color (.-group d)))))
|
||||
text (.. enter-node
|
||||
(append "text")
|
||||
(attr "dx" (fn [d] (if (render-node? d)
|
||||
-12
|
||||
12)))
|
||||
(attr "dy" "0.35em")
|
||||
(attr "text-anchor" (fn [d]
|
||||
(if (render-node? d)
|
||||
"end"
|
||||
"start")))
|
||||
(attr "opacity" 1)
|
||||
(text (fn [d] (.-title d))))
|
||||
|
||||
merged-node (.. enter-node (merge node))
|
||||
|
||||
ticked (fn []
|
||||
(.. merged-node
|
||||
(attr "transform"
|
||||
(fn [d]
|
||||
(let [r (.-r d)
|
||||
x (min-max r (.-x d) (- width r))
|
||||
y (min-max r (.-y d) (- height r))]
|
||||
(set! (.-x d) x)
|
||||
(set! (.-y d) y)
|
||||
(str "translate(" x "," y ")")))))
|
||||
|
||||
(.. merged-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)))))
|
||||
|
||||
node-exit-t (.. node
|
||||
(exit)
|
||||
(transition)
|
||||
(delay (fn [d i] (* i 30)))
|
||||
(duration 500))
|
||||
|
||||
|
||||
_ (.. node-exit-t
|
||||
(select "circle")
|
||||
(attr "transform" "scale(0,0)")
|
||||
(attr "fill" "#000000"))
|
||||
_ (.. node-exit-t
|
||||
(select "text")
|
||||
(attr "opacity" 0))
|
||||
_ (.. node-exit-t
|
||||
(on "end" (fn [] (this-as this
|
||||
(.. js/d3
|
||||
(select this)
|
||||
(remove))))))
|
||||
_ (.. node-exit-t
|
||||
(transition)
|
||||
(call (fn []
|
||||
(.. simulation
|
||||
(nodes nodes)
|
||||
(on "tick" (ticked svg)))
|
||||
(on "tick" ticked))
|
||||
|
||||
(.. simulation
|
||||
(force "link")
|
||||
(links links))
|
||||
(.. simulation
|
||||
(alphaTarget 0.3)
|
||||
(restart))
|
||||
|
||||
)))}
|
||||
(.. simulation
|
||||
(restart)
|
||||
(alpha 0.3)))))
|
||||
]
|
||||
))))}
|
||||
traces-ratom]
|
||||
[:hr]])))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue