status-im
/
re-frame-10x
mirror of https://github.com/status-im/re-frame-10x.git
2
0
Fork 0
Code Issues Projects Releases Wiki Activity

Continue working

This commit is contained in:
Daniel Compton 2016-11-16 11:36:47 +13:00
parent 6b8b961d13
commit 9335c3963c
3 changed files with 146 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/day8/re_frame/trace.cljs
View File

@ -96,7 +96,7 @@
(defn log-trace? [trace] (defn log-trace? [trace]
(let [render-type? (= (:type trace) :render)] (let [render-type? (= (:type trace) :render)]
(not (and render-type? (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! [] (defn init-tracing! []
(re-frame.tracing/register-trace-cb ::cb (fn [new-traces] (re-frame.tracing/register-trace-cb ::cb (fn [new-traces]
@ -156,7 +156,7 @@
(doall (doall
(for [{:keys [type id operation tags duration] :as trace} showing-traces] (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)}) (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 (list [:tr {:key id
:style {:color (case type :style {:color (case type

23
src/day8/re_frame/trace/graph.cljc
View File

@ -31,8 +31,7 @@
:when (every? some? [input-signal reaction])] :when (every? some? [input-signal reaction])]
{:source input-signal :target reaction :value link-val {:source input-signal :target reaction :value link-val
:id (str input-signal "|" reaction)}))) :id (str input-signal "|" reaction)})))
(into {} (map (fn [trace] [(:id trace) trace]))) (distinct-k :id)))
(vals)))
(defn select-sub-nodes [traces type disposed-ids r] (defn select-sub-nodes [traces type disposed-ids r]
(->> traces (->> traces
@ -45,24 +44,23 @@
:group 2 :group 2
:r r :r r
:data trace})) :data trace}))
(into {} (map (fn [trace] [(:id trace) trace]))) (distinct-k :id)))
(vals)))
(defn select-view-nodes [traces type unmounted-components r] (defn select-view-nodes [traces type unmounted-components r]
(->> traces (->> traces
(select-type type) (select-type type)
(remove #(contains? unmounted-components (:id %))) (remove #(contains? unmounted-components (get-reaction %)))
(map (fn [trace] (map (fn [trace]
{:id (get-reaction trace) {:id (get-reaction trace)
:title (str (get-reaction trace) " " (:operation trace)) :title (str (:operation trace))
:group 3 :group 3
:r r :r r
:data trace :data trace
:fx 250})) :fx 350}))
(remove #(nil? (:id %))) ;; remove reactions that are null (mostly from input fields???) (remove #(nil? (:id %))) ;; remove reactions that are null (mostly from input fields???)
(into {} (map (fn [trace] [(:id trace) trace]))) (distinct-k :id)))
(vals)
)) ;; Use http://bl.ocks.org/GerHobbelt/3683278 to constrain nodes
(defn trace->sub-graph [traces extra-nodes] (defn trace->sub-graph [traces extra-nodes]
(let [disposed-ids (->> (select-type :sub/dispose traces) (let [disposed-ids (->> (select-type :sub/dispose traces)
@ -71,10 +69,11 @@
unmounted-components (->> (select-type :componentWillUnmount traces) unmounted-components (->> (select-type :componentWillUnmount traces)
(map get-reaction) (map get-reaction)
set) set)
sub-nodes (select-sub-nodes traces :sub/create disposed-ids 10) 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) 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) all-nodes (concat extra-nodes sub-nodes view-nodes)
node-ids (set (map :id all-nodes)) node-ids (set (map :id all-nodes))
nodes-links (->> (mapcat (fn [{:keys [source target]}] [source target]) view-links) set) nodes-links (->> (mapcat (fn [{:keys [source target]}] [source target]) view-links) set)

193
src/day8/re_frame/trace/subvis.cljs
View File

@ -11,6 +11,7 @@
(def width 400) (def width 400)
(def height 400) (def height 400)
(def prev-graph (atom nil))
(def mygraph (r/atom {:nodes [{:id 1 :group 1} (def mygraph (r/atom {:nodes [{:id 1 :group 1}
{:id 2 :group 1} {:id 2 :group 1}
{:id 3 :group 2}] {:id 3 :group 2}]
@ -23,6 +24,8 @@
:fx 15 :fx 15
:fy (/ height 2)}) :fy (/ height 2)})
(defn render-node? [d]
(= "render" (gob/getValueByKeys d "data" "type")))
(defn min-max (defn min-max
"Returns x if it is within min-val and max-val "Returns x if it is within min-val and max-val
@ -34,33 +37,10 @@
(assert (<= min-val max-val)) (assert (<= min-val max-val))
(cljs.core/max min-val (cljs.core/min x 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] (defn render-subvis [traces-ratom]
(let [color-a (atom nil) (let [color-a (atom nil)
svg-a (atom nil) svg-a (atom nil)
simulation-a (atom nil) simulation-a (atom nil)]
run? (atom false)]
(fn [] (fn []
(println "Render subvis") (println "Render subvis")
[:div [:div
@ -70,9 +50,9 @@
{:render-component (fn [ratom] {:render-component (fn [ratom]
[:svg#d3cmp {:width width :height height}]) [:svg#d3cmp {:width width :height height}])
:d3-once (fn [ratom] :d3-once (fn [ratom]
(let [color (reset! color-a (.scaleOrdinal js/d3 (.-schemeCategory20 js/d3))) (let [svg (reset! svg-a (. js/d3 select "#d3cmp"))]
svg (reset! svg-a (. js/d3 select "#d3cmp")) (reset! color-a (.scaleOrdinal js/d3 (.-schemeCategory20 js/d3)))
simulation (reset! simulation-a (reset! simulation-a
(.. js/d3 (.. js/d3
(forceSimulation) (forceSimulation)
(force "link" (.. js/d3 (forceLink) (force "link" (.. js/d3 (forceLink)
@ -81,98 +61,135 @@
(force "charge" (.. js/d3 (forceManyBody) (force "charge" (.. js/d3 (forceManyBody)
(strength (constantly -100)))) (strength (constantly -100))))
(force "center" (. js/d3 forceCenter (/ width 2) (/ height 2))))) (force "center" (. js/d3 forceCenter (/ width 2) (/ height 2)))))
(.. (. svg append "g")
link (.. (. svg append "g")
(attr "class" "links")) (attr "class" "links"))
(.. (. svg append "g")
node (.. (. svg append "g") (attr "class" "nodes"))))
(attr "class" "nodes"))]))
:d3-update (fn [ratom] :d3-update (fn [ratom]
(when-not false #_@run? (let [old-g @prev-graph ;; TODO: is this working?
#_(reset! run? true) graph (reset! prev-graph (graph/trace->sub-graph @ratom [app-db-node]))]
(let [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)) nodes (clj->js (:nodes graph))
links (clj->js (:links graph)) links (clj->js (:links graph))
svg @svg-a drag-started (fn [d]
color @color-a
simulation @simulation-a
dragstarted (fn [d]
(when (zero? (.. js/d3 -event -active)) (when (zero? (.. js/d3 -event -active))
(.. simulation (.. simulation
(alphaTarget 0.3) (alphaTarget 0.3)
(restart))) (restart))))
#_(set! (.-fx d) (.. js/d3 -event -x)) ; (.-x d)
#_(set! (.-fy d) (.. js/d3 -event -y)))
dragged (fn [d] dragged (fn [d]
(set! (.-fx d) (.. js/d3 -event -x)) (set! (.-fx d) (.. js/d3 -event -x))
(set! (.-fy d) (.. js/d3 -event -y))) (set! (.-fy d) (.. js/d3 -event -y)))
drag-ended (fn [d]
dragended (fn [d]
(when (zero? (.. js/d3 -event -active)) (when (zero? (.. js/d3 -event -active))
(.. simulation (.. simulation
(alphaTarget 0.0))) (alphaTarget 0.0)))
(set! (.-fx d) nil) (set! (.-fx d) nil)
(set! (.-fy d) nil)) (set! (.-fy d) nil))
;; Links
link (.. svg link (.. svg
(select ".links") (select "g.links")
(selectAll "line") (selectAll "line")
(data links (fn [d] (.-id d)))) (data links #(.-id %)))
enter-link (.. link
new-link (.. link
(enter) (enter)
(append "line") (append "line")
(attr "stroke-width" (fn [d] (Math/sqrt (.-value d))))) (attr "stroke-width" (fn [d] (Math/sqrt (.-value d)))))
merged-link (.. enter-link (merge link))
node (.. svg _ (.. link
(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
(exit) (exit)
(remove "line")) (remove "line"))
] ;; Nodes
(println "Nodes count" (count nodes)) node (.. svg
(println "Links count" (count links)) (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 (.. simulation
(nodes nodes) (nodes nodes)
(on "tick" (ticked svg))) (on "tick" ticked))
(.. simulation (.. simulation
(force "link") (force "link")
(links links)) (links links))
(.. simulation
(alphaTarget 0.3)
(restart))
)))} (.. simulation
(restart)
(alpha 0.3)))))
]
))))}
traces-ratom] traces-ratom]
[:hr]]))) [:hr]])))