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

Future visualizer performance improvements

Browse Source
This commit is contained in:
James Swaine 2012-07-22 00:53:27 -05:00
parent 5042b73fc8
commit 0b5d574aae
3 changed files with 54 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -29,9 +29,10 @@
(define/public (set-scale-factor! s) (define/public (set-scale-factor! s)
(set! scale-factor s)) (set! scale-factor s))
(define needs-redraw #f) (define need-redraw? #f)
(define delaying-redraw #f) (define delaying-redraw #f)
(define cached-bitmap #f) (define cached-bitmap #f)
(define cached-overlay-bitmap #f)
(define cached-base-pict #f) (define cached-base-pict #f)
(define repainting? #f) (define repainting? #f)
@ -46,45 +47,36 @@
;Rebuild both the bottom (base) and overlay (top) ;Rebuild both the bottom (base) and overlay (top)
;pict layers for the canvas ;pict layers for the canvas
;;rebuild-the-pict : viewable-region -> void ;;rebuild-the-pict : viewable-region -> void
(define/private (rebuild-the-pict vregion #:only-the-overlay? [only-the-overlay? #f]) (define/private (rebuild-the-pict! vregion #:only-the-overlay? [only-the-overlay? #f])
(define p (cond (when (or (not cached-base-pict) (not only-the-overlay?))
[(or (not cached-base-pict) (not only-the-overlay?)) (define base (scale (bp vregion) scale-factor))
(define base (scale (bp vregion) scale-factor)) ;(set! cached-base-pict base)
(set! cached-base-pict base) (set! cached-bitmap (pict->bitmap base)))
(if ob (when ob
(pin-over base (set! cached-overlay-bitmap (pict->bitmap (ob vregion scale-factor)))))
0
0
(ob vregion scale-factor))
base)]
[else (if ob
(pin-over cached-base-pict
0
0
(ob vregion scale-factor))
cached-base-pict)]))
(pict->bitmap p))
;Rebuilds the pict and stashes in a bitmap ;Rebuilds the pict and stashes in a bitmap
;to be drawn to the canvas later ;to be drawn to the canvas later
;;redraw-the-bitmap : viewable-region -> void ;;redraw-the-bitmap : viewable-region -> void
(define/private (redraw-the-bitmap! vregion #:only-the-overlay? [only-the-overlay? #f]) (define/private (redraw-the-bitmap! vregion #:only-the-overlay? [only-the-overlay? #f])
(set! cached-bitmap (rebuild-the-pict vregion #:only-the-overlay? only-the-overlay?)) (rebuild-the-pict! vregion #:only-the-overlay? only-the-overlay?)
(set! needs-redraw #f)) (set! need-redraw? #f))
;;redraw-the-bitmap/maybe-delayed! : viewable-region -> void ;;redraw-the-bitmap/maybe-delayed! : viewable-region -> void
(define/private (redraw-the-bitmap/maybe-delayed! vregion (define/private (redraw-the-bitmap/maybe-delayed! vregion
#:delay [delay 100]
#:only-the-overlay? [only-the-overlay? #f]) #:only-the-overlay? [only-the-overlay? #f])
(cond (cond
[needs-redraw (redraw-the-bitmap! vregion #:only-the-overlay? only-the-overlay?)] [need-redraw?
(redraw-the-bitmap! vregion #:only-the-overlay? only-the-overlay?)
(set! need-redraw? #f)]
[(not delaying-redraw) [(not delaying-redraw)
(new timer% [notify-callback (λ () (new timer% [notify-callback (λ ()
(set! delaying-redraw #f) (set! delaying-redraw #f)
(set! needs-redraw #t) (set! need-redraw? #t)
(redraw-the-bitmap/maybe-delayed! (get-viewable-region) #:only-the-overlay? only-the-overlay?) (redraw-the-bitmap/maybe-delayed! (get-viewable-region) #:only-the-overlay? only-the-overlay?)
(set! repainting? #t)
(refresh))] (refresh))]
[interval 100] [interval delay]
[just-once? #t]) [just-once? #t])
(set! delaying-redraw #t)])) (set! delaying-redraw #t)]))
@ -95,17 +87,25 @@
(when redraw-on-size (when redraw-on-size
(redraw-the-bitmap/maybe-delayed! (get-viewable-region)))) (redraw-the-bitmap/maybe-delayed! (get-viewable-region))))
(define last-vregion #f)
(define/override (on-paint) (define/override (on-paint)
(define vregion (get-viewable-region)) (define vregion (get-viewable-region))
(unless repainting? (when (and (not delaying-redraw) (not (equal? vregion last-vregion)))
(redraw-the-bitmap/maybe-delayed! vregion)) (redraw-the-bitmap/maybe-delayed! vregion))
(set! repainting? #f) (set! last-vregion vregion)
(define dc (get-dc)) (define dc (get-dc))
(when cached-bitmap (when cached-bitmap
(send dc (send dc
draw-bitmap draw-bitmap
cached-bitmap cached-bitmap
(viewable-region-x vregion) (viewable-region-x vregion)
(viewable-region-y vregion)))
(when cached-overlay-bitmap
(send dc
draw-bitmap
cached-overlay-bitmap
(viewable-region-x vregion)
(viewable-region-y vregion)))) (viewable-region-y vregion))))
(define/override (on-event event) (define/override (on-event event)
@ -116,10 +116,7 @@
[(motion) [(motion)
(when mh (when mh
(when (mh x y vregion) ;Mouse handler returns non-false if a state change requiring redraw occurred (when (mh x y vregion) ;Mouse handler returns non-false if a state change requiring redraw occurred
#;(redraw-the-bitmap/maybe-delayed! vregion #:only-the-overlay? #t) (redraw-the-bitmap/maybe-delayed! vregion #:delay 0 #:only-the-overlay? #t)))]
(set! repainting? #f)
(redraw-the-bitmap! vregion #:only-the-overlay? #t)
(refresh)))]
[(left-up) [(left-up)
(when ch (ch x y vregion)) ;Ditto for click handler (when ch (ch x y vregion)) ;Ditto for click handler
(redraw-the-bitmap/maybe-delayed! vregion #:only-the-overlay? #t)])) (redraw-the-bitmap/maybe-delayed! vregion #:only-the-overlay? #t)]))

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

@ -437,8 +437,20 @@
#:forecolor (header-forecolor) #:forecolor (header-forecolor)
#:padding HEADER-PADDING #:padding HEADER-PADDING
#:opacity opacity #:opacity opacity
#:width (viewable-region-width vregion))]) #:width (viewable-region-width vregion))]
[row-mid (- (- (* index (frame-info-row-height finfo))
(pict-height proc-title))
(viewable-region-y vregion))])
(draw-stack-onto pct (draw-stack-onto pct
(at 0
(- (* (add1 index) (frame-info-row-height finfo)) (frame-info-row-height finfo))
(colorize (filled-rectangle (viewable-region-width vregion) (/ (frame-info-row-height finfo) 2))
(make-object color% 212 210 214 0.3)))
(at 0
row-mid
(colorize (filled-rectangle (viewable-region-width vregion) (/ (frame-info-row-height finfo) 2))
(make-object color% 230 229 231 0.3)))
(at 0 (at 0
(- (* (add1 index) (frame-info-row-height finfo)) (viewable-region-y vregion)) (- (* (add1 index) (frame-info-row-height finfo)) (viewable-region-y vregion))
(colorize (hline (viewable-region-width vregion) 1) (timeline-baseline-color))) (colorize (hline (viewable-region-width vregion) 1) (timeline-baseline-color)))
@ -574,8 +586,15 @@
#:with-arrow with-arrow #:with-arrow with-arrow
#:style style)))) #:style style))))
(define (get-seg-left-of-vregion vregion seg)
(define prev-in-time (segment-prev-future-seg seg))
(cond
[(or (not prev-in-time) (not (in-viewable-region-horiz vregion (segment-edge seg))))
seg]
[else (get-seg-left-of-vregion vregion prev-in-time)]))
(define (draw-arrows base-pct vregion seg) (define (draw-arrows base-pct vregion seg)
(define fst (get-seg-previous-to-vregion vregion seg)) (define fst (get-seg-left-of-vregion vregion seg))
(let loop ([p base-pct] (let loop ([p base-pct]
[cur-seg fst]) [cur-seg fst])
(define next-seg (segment-next-future-seg cur-seg)) (define next-seg (segment-next-future-seg cur-seg))
@ -588,7 +607,9 @@
p p
(event-connection-line-color) (event-connection-line-color)
#:width 2)) #:width 2))
(loop new-p next-seg)]))) (if (not (in-viewable-region-horiz vregion (segment-x next-seg)))
new-p
(loop new-p next-seg))])))
;;draw-arrows : pict viewable-region segment -> pict ;;draw-arrows : pict viewable-region segment -> pict

3
collects/future-visualizer/private/visualizer-gui.rkt
View File

@ -159,7 +159,7 @@
[else [else
(set! hover-seg seg) (set! hover-seg seg)
(post-event listener-table 'segment-hover timeline-panel seg) (post-event listener-table 'segment-hover timeline-panel seg)
#t])))] seg])))]
[click-handler (λ (x y vregion) [click-handler (λ (x y vregion)
(let ([seg (find-seg-for-coords x y timeline-mouse-index)]) (let ([seg (find-seg-for-coords x y timeline-mouse-index)])
(set! tacked-seg seg) (set! tacked-seg seg)
@ -356,5 +356,6 @@
(set! showing-create-graph (not showing-create-graph)))]) (set! showing-create-graph (not showing-create-graph)))])
(send main-panel set-percentages '(1/5 4/5)) (send main-panel set-percentages '(1/5 4/5))
(send right-panel set-percentages '(3/4 1/4))
(send f show #t)) (send f show #t))