suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Improvements to mouseover performance in future visualizer

Browse Source 
(cherry picked from commit b6c4bece11)
This commit is contained in:
James Swaine 2012-07-19 16:00:10 -05:00 committed by Ryan Culpepper
parent a79b122f5e
commit 53d0aa1fe4
2 changed files with 48 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/future-visualizer/private/pict-canvas.rkt
View File

@ -33,6 +33,7 @@
(define delaying-redraw #f) (define delaying-redraw #f)
(define cached-bitmap #f) (define cached-bitmap #f)
(define cached-base-pict #f) (define cached-base-pict #f)
(define repainting? #f)
(define/private (get-viewable-region) (define/private (get-viewable-region)
(define-values (x y) (get-view-start)) (define-values (x y) (get-view-start))
@ -80,7 +81,8 @@
(new timer% [notify-callback (λ () (new timer% [notify-callback (λ ()
(set! delaying-redraw #f) (set! delaying-redraw #f)
(set! needs-redraw #t) (set! needs-redraw #t)
(redraw-the-bitmap/maybe-delayed! (get-viewable-region)) (redraw-the-bitmap/maybe-delayed! (get-viewable-region) #:only-the-overlay? only-the-overlay?)
(set! repainting? #t)
(refresh))] (refresh))]
[interval 100] [interval 100]
[just-once? #t]) [just-once? #t])
@ -95,7 +97,9 @@
(define/override (on-paint) (define/override (on-paint)
(define vregion (get-viewable-region)) (define vregion (get-viewable-region))
(redraw-the-bitmap/maybe-delayed! vregion) (unless repainting?
(redraw-the-bitmap/maybe-delayed! vregion))
(set! repainting? #f)
(define dc (get-dc)) (define dc (get-dc))
(when cached-bitmap (when cached-bitmap
(send dc (send dc

92
collects/future-visualizer/private/visualizer-drawing.rkt
View File

@ -527,47 +527,6 @@
#:with-arrow with-arrow #:with-arrow with-arrow
#:style style)))) #:style style))))
;;draw-arrows : pict viewable-region segment -> pict
(define (draw-arrows base-pct vregion seg)
(let ([fst (get-seg-previous-to-vregion vregion seg)])
(let loop ([pct base-pct]
[cur-seg fst])
(if (not cur-seg)
pct
(let ([next (segment-next-future-seg cur-seg)])
(let* ([next-targ (segment-next-targ-future-seg cur-seg)]
[prev-targ (segment-prev-targ-future-seg cur-seg)]
[ftl-arrows (if (not next)
pct
(draw-connection vregion
cur-seg
next
pct
(event-connection-line-color)
#:width 2))]
[prev-targ-arr (if (not prev-targ)
ftl-arrows
(draw-connection vregion
prev-targ
cur-seg
ftl-arrows
(event-target-future-line-color)
#:with-arrow #t
#:style 'dot))]
[next-targ-arr (if (not next-targ)
prev-targ-arr
(draw-connection vregion
cur-seg
next-targ
prev-targ-arr
(event-target-future-line-color)
#:with-arrow #t
#:style 'dot))])
(if (and next
((seg-in-vregion vregion) next))
(loop next-targ-arr next)
next-targ-arr)))))))
;;timeline-pict : (listof indexed-future-event) [viewable-region] [integer] -> pict ;;timeline-pict : (listof indexed-future-event) [viewable-region] [integer] -> pict
(define (timeline-pict logs (define (timeline-pict logs
#:x [x #f] #:x [x #f]
@ -617,6 +576,47 @@
overlay)] overlay)]
[else tp])) [else tp]))
;;draw-arrows : pict viewable-region segment -> pict
(define (draw-arrows base-pct vregion seg)
(let ([fst (get-seg-previous-to-vregion vregion seg)])
(let loop ([pct base-pct]
[cur-seg fst])
(if (not cur-seg)
pct
(let ([next (segment-next-future-seg cur-seg)])
(let* ([next-targ (segment-next-targ-future-seg cur-seg)]
[prev-targ (segment-prev-targ-future-seg cur-seg)]
[ftl-arrows (if (not next)
pct
(draw-connection vregion
cur-seg
next
pct
(event-connection-line-color)
#:width 2))]
[prev-targ-arr (if (not prev-targ)
ftl-arrows
(draw-connection vregion
prev-targ
cur-seg
ftl-arrows
(event-target-future-line-color)
#:with-arrow #t
#:style 'dot))]
[next-targ-arr (if (not next-targ)
prev-targ-arr
(draw-connection vregion
cur-seg
next-targ
prev-targ-arr
(event-target-future-line-color)
#:with-arrow #t
#:style 'dot))])
(if (and next
((seg-in-vregion vregion) next))
(loop next-targ-arr next)
next-targ-arr)))))))
;Draws the pict that is layered on top of the exec. timeline canvas ;Draws the pict that is layered on top of the exec. timeline canvas
;to highlight a specific future's event sequence ;to highlight a specific future's event sequence
;;timeline-overlay : uint uint (or segment #f) (or segment #f) frame-info trace -> pict ;;timeline-overlay : uint uint (or segment #f) (or segment #f) frame-info trace -> pict
@ -629,17 +629,9 @@
(if tacked (values tacked #t) (values hovered #f))) (if tacked (values tacked #t) (values hovered #f)))
(if seg-with-arrows (if seg-with-arrows
(let* ([bg base] (let* ([bg base]
[dots (let loop ([p bg] [cur-seg (get-first-future-seg-in-region vregion seg-with-arrows)])
(if (or (not cur-seg) (not ((seg-in-vregion vregion) cur-seg)))
p
(loop (pin-over p
(- (segment-x cur-seg) (viewable-region-x vregion))
(- (segment-y cur-seg) (viewable-region-y vregion))
(pict-for-segment cur-seg))
(segment-next-future-seg cur-seg))))]
[aseg-rel-x (- (segment-x seg-with-arrows) (viewable-region-x vregion))] [aseg-rel-x (- (segment-x seg-with-arrows) (viewable-region-x vregion))]
[aseg-rel-y (- (segment-y seg-with-arrows) (viewable-region-y vregion))] [aseg-rel-y (- (segment-y seg-with-arrows) (viewable-region-y vregion))]
[line (pin-over dots [line (pin-over bg
(- (+ aseg-rel-x (- (+ aseg-rel-x
(/ (segment-width seg-with-arrows) 2)) (/ (segment-width seg-with-arrows) 2))
2) 2)