diff --git a/collects/future-visualizer/private/pict-canvas.rkt b/collects/future-visualizer/private/pict-canvas.rkt index a26480dffc..21bf71b8dd 100644 --- a/collects/future-visualizer/private/pict-canvas.rkt +++ b/collects/future-visualizer/private/pict-canvas.rkt @@ -42,7 +42,11 @@ (when (or (not cached-base-bitmap) (not only-the-overlay?)) (set! cached-base-bitmap (pict->bitmap (scale (bp vregion) scale-factor)))) (when ob - (set! cached-overlay-bitmap (pict->bitmap (ob vregion scale-factor))))) + (define overlay-pict (ob vregion scale-factor)) + (set! cached-overlay-bitmap + (if overlay-pict + (pict->bitmap overlay-pict) + #f)))) ;Rebuilds the pict and stashes in a bitmap ;to be drawn to the canvas later diff --git a/collects/future-visualizer/private/visualizer-data.rkt b/collects/future-visualizer/private/visualizer-data.rkt index 9a2bec9ccd..1b1faf3b25 100644 --- a/collects/future-visualizer/private/visualizer-data.rkt +++ b/collects/future-visualizer/private/visualizer-data.rkt @@ -148,10 +148,22 @@ [(block sync) #t] [else #f])) +;;runtime-thread-evt? : (or event indexed-future-event future-event) -> bool +(define (runtime-thread-evt? evt) + (= (process-id evt) RT-THREAD-ID)) + ;;runtime-synchronization-event? : (or event indexed-future-event future-event) -> bool (define (runtime-synchronization-event? evt) (and (synchronization-event? evt) (= (process-id evt) RT-THREAD-ID))) +;;runtime-block-evt? : (or event indexed-future-event future-event) -> bool +(define (runtime-block-evt? evt) + (and (runtime-thread-evt? evt) (equal? (what evt) 'block))) + +;;runtime-sync-evt? : (or event indexed-future-event future-event) -> bool +(define (runtime-sync-evt? evt) + (and (runtime-thread-evt? evt) (equal? (what evt) 'sync))) + ;;final-event? : event -> bool (define (final-event? evt) (case (event-timeline-position evt) @@ -311,18 +323,13 @@ (define block-hash (make-hash)) (define sync-hash (make-hash)) (define rt-hash (make-hash)) - (for ([evt (in-list (filter (λ (e) (and (= (event-proc-id e) RT-THREAD-ID) - (or (equal? (event-type e) 'block) - (equal? (event-type e) 'sync)))) - evts))]) - (define isblock (case (event-type evt) - [(block) #t] - [else #f])) + (for ([evt (in-list (filter runtime-synchronization-event? evts))]) + (define isblock (runtime-block-evt? evt)) (define ophash (if isblock block-hash sync-hash)) (hash-update! ophash (event-prim-name evt) - (λ (old) (add1 old)) - 1) + (λ (old) (+ old 1)) + 0) (hash-update! rt-hash (event-future-id evt) (λ (old) @@ -331,19 +338,10 @@ (rtcall-info-sync-hash old))]) (hash-update! h (event-prim-name evt) - (λ (o) (add1 o)) - (λ () 1))) - old) - (λ () - (let* ([ri (rtcall-info (event-future-id evt) (make-hash) (make-hash))] - [h (if isblock - (rtcall-info-block-hash ri) - (rtcall-info-sync-hash ri))]) - (hash-update! h - (event-prim-name evt) - (λ (o) (add1 o)) - (λ () 1)) - ri)))) + (λ (o) (+ o 1)) + 0)) + old) + (rtcall-info (event-future-id evt) (make-hash) (make-hash)))) (values block-hash sync-hash rt-hash)) ;;connect-event-chains! : trace -> void diff --git a/collects/future-visualizer/private/visualizer-drawing.rkt b/collects/future-visualizer/private/visualizer-drawing.rkt index fbcefb8b6c..a285a33cf0 100644 --- a/collects/future-visualizer/private/visualizer-drawing.rkt +++ b/collects/future-visualizer/private/visualizer-drawing.rkt @@ -777,11 +777,16 @@ ;;graph-overlay-pict : drawable-node trace graph-layout -> pict (define (graph-overlay-pict hover-node tr layout vregion scale-factor) - (when hover-node - (unless (equal? (node-data (drawable-node-node hover-node)) 'runtime-thread) - (define fid (event-user-data (node-data (drawable-node-node hover-node)))) - (define ri (hash-ref (trace-future-rtcalls tr) fid (λ () #f))) - (when ri + (define (root-sym-or-first-evt n) (node-data (drawable-node-node n))) + (cond + [(or (not hover-node) (equal? (root-sym-or-first-evt hover-node) 'runtime-thread)) + #f] + [else + (define fid (event-user-data (root-sym-or-first-evt hover-node))) + (define ri (hash-ref (trace-future-rtcalls tr) fid #f)) + (cond + [(not ri) #f] + [else (define block-ops (sort (hash-keys (rtcall-info-block-hash ri)) > #:key (λ (p) @@ -831,5 +836,5 @@ TOOLTIP-MARGIN txtp)) (+ yacc (pict-height txtbg) CREATE-GRAPH-PADDING)))) - pct)))) + pct])])) \ No newline at end of file diff --git a/collects/future-visualizer/private/visualizer-gui.rkt b/collects/future-visualizer/private/visualizer-gui.rkt index a5642883b4..9ece04be8c 100644 --- a/collects/future-visualizer/private/visualizer-gui.rkt +++ b/collects/future-visualizer/private/visualizer-gui.rkt @@ -106,14 +106,12 @@ [parent (send f get-area-container)])) (define left-panel (new panel:horizontal-dragable% [parent main-panel] - [stretchable-width #t] - [min-width 0])) + [stretchable-width #t])) (define hlist-ctl (new hierarchical-list% [parent left-panel] [stretchable-width #t] [stretchable-height #t] - [style '(control-border)] - [min-width 0])) + [style '(control-border)])) ;Build up items in the hierlist (define block-node (send hlist-ctl new-list)) @@ -193,22 +191,30 @@ [pict-builder (λ (vregion) (draw-creategraph-pict vregion creation-tree-layout))] - #;[hover-handler #f (λ (x y vregion) + [hover-handler (λ (x y vregion) + (define hovered (find-node-for-coords x y + (graph-layout-nodes creation-tree-layout))) + (cond + [(eq? hovered hovered-graph-node) #f] + [else (set! hovered-graph-node (find-node-for-coords x y - (graph-layout-nodes creation-tree-layout))))] - [click-handler (λ (x y vregion) + (graph-layout-nodes creation-tree-layout))) + hovered-graph-node]))] + #;[click-handler (λ (x y vregion) (define fid (find-fid-for-coords x y (graph-layout-nodes creation-tree-layout) vregion)) - (when fid - (define seg (first-seg-for-fid fid segments)) - (set! tacked-seg seg) - (send timeline-panel set-redraw-overlay! #t) - (send timeline-panel refresh) - (post-event listener-table 'segment-click timeline-panel seg)))] - #;[overlay-builder (λ (vregion scale-factor) + (cond + [(not fid) #f] + [else + (define seg (first-seg-for-fid fid segments)) + (set! tacked-seg seg) + (send timeline-panel redraw-everything) + (post-event listener-table 'segment-click timeline-panel seg) + #t]))] + [overlay-builder (λ (vregion scale-factor) (graph-overlay-pict hovered-graph-node the-trace creation-tree-layout