From 06358fa19d5d8b93c9878f07cb8a7e726839955e Mon Sep 17 00:00:00 2001 From: James Swaine Date: Thu, 19 Jul 2012 13:38:07 -0500 Subject: [PATCH] Performance improvements in future visualizer GUI (dragging, scrolling, sizing) --- .../future-visualizer/private/gui-helpers.rkt | 121 +--------------- .../future-visualizer/private/pict-canvas.rkt | 131 ++++++++++++++++++ .../private/visualizer-gui.rkt | 42 +++--- 3 files changed, 154 insertions(+), 140 deletions(-) create mode 100644 collects/future-visualizer/private/pict-canvas.rkt diff --git a/collects/future-visualizer/private/gui-helpers.rkt b/collects/future-visualizer/private/gui-helpers.rkt index d8a0e2736a..60af714779 100644 --- a/collects/future-visualizer/private/gui-helpers.rkt +++ b/collects/future-visualizer/private/gui-helpers.rkt @@ -2,9 +2,9 @@ (require framework slideshow/pict "display.rkt" - "constants.rkt") -(provide pict-canvas% - label + "constants.rkt" + "pict-canvas.rkt") +(provide label mt-label bold-label mt-bold-label @@ -14,115 +14,6 @@ add-receiver post-event) -(define pict-canvas% - (class canvas% - (init redraw-on-resize pict-builder hover-handler click-handler overlay-builder) - (inherit get-dc get-client-size refresh get-view-start) - (define bp pict-builder) ;Builds the main pict for the canvas - (define mh hover-handler) ;Mouse hover handler - (define ob overlay-builder) ;Hover overlay pict builder - (define ch click-handler) ;Mouse click handler - (define draw-on-resize redraw-on-resize) - (define do-logging #f) - (define redraw-overlay #f) ;Whether we should redraw the overlay pict in the canvas - (define redo-bitmap-on-paint #t) ;Redraw the base bitmap on paint? #f for mouse events - (define scale-factor 1) - - (define/public (set-redo-bitmap-on-paint! v) - (set! redo-bitmap-on-paint v)) - - (define/public (set-do-logging! v) - (set! do-logging v)) - - ;;set-build-pict! : (viewable-region -> pict) -> void - (define/public (set-build-pict! f) - (set! bp f)) - - ;;set-mouse-handler! : (uint uint -> segment) -> void - (define/public (set-mouse-handler! f) - (set! mh f)) - - ;;set-overlay-builder! : (viewable-region -> pict) -> void - (define/public (set-overlay-builder! f) - (set! ob f)) - - ;;set-click-handler! : (uint uint -> segment) -> void - (define/public (set-click-handler! f) - (set! ch f)) - - ;;set-redraw-overlay! : bool -> void - (define/public (set-redraw-overlay! b) - (set! redraw-overlay b)) - - (define/public (set-scale-factor! s) - (set! scale-factor s)) - - (define the-drawer #f) - (define img-width 0) - (define bm #f) - (define overlay-pict #f) - - (define/private (get-viewable-region) - (define-values (x y) (get-view-start)) - (define-values (w h) (get-client-size)) - (scale-viewable-region (viewable-region x y w h) (/ 1 scale-factor))) - - (define/private (overlay-drawer dc vregion) - (when ob - (define p (ob vregion scale-factor)) - (unless (or (not p) (void? p)) - (draw-pict p - dc - (viewable-region-x vregion) - (viewable-region-y vregion))))) - - (define/private (redo-bitmap vregion) - (when bp - (define p (scale (bp vregion) scale-factor)) - (set! bm (pict->bitmap p)))) - - (define/public (redraw-everything) - (redo-bitmap (get-viewable-region)) - (refresh)) - - (define/override (on-size width height) - (when (or draw-on-resize - (not bm)) - (set! bm #f) - (refresh)) - (set! redraw-overlay #t)) - - (define/override (on-paint) - (define vregion (get-viewable-region)) - (when (or redo-bitmap-on-paint (not bm)) - (redo-bitmap vregion)) - (unless redo-bitmap-on-paint - (set! redo-bitmap-on-paint #t)) - (when bm - (let ([dc (get-dc)]) - (send dc draw-bitmap - bm - (viewable-region-x vregion) - (viewable-region-y vregion)) - (overlay-drawer dc vregion)))) - - (define/override (on-event event) - (define vregion (get-viewable-region)) - (define x (+ (viewable-region-x vregion) (/ (send event get-x) scale-factor))) - (define y (+ (viewable-region-y vregion) (/ (send event get-y) scale-factor))) - (case (send event get-event-type) - [(motion) - (set! redo-bitmap-on-paint #f) - (when mh (mh x y vregion))] - [(left-up) - (set! redo-bitmap-on-paint #f) - (when ch (ch x y vregion))]) - (when redraw-overlay - (refresh))) - - (super-new) - (send (get-dc) set-smoothing 'aligned))) - (define bold-system-font (send the-font-list find-or-create-font (send normal-control-font get-point-size) @@ -165,9 +56,6 @@ HEADER-HEIGHT) (header-backcolor)) text-container))] - [hover-handler #f] - [click-handler #f] - [overlay-builder #f] [min-height HEADER-HEIGHT] [stretchable-width #t] [stretchable-height #f])]) @@ -182,9 +70,6 @@ (header-backcolor)) text-container) -1.57079633))] - [hover-handler #f] - [click-handler #f] - [overlay-builder #f] [min-width HEADER-HEIGHT] [stretchable-width #f] [stretchable-height #t])]) diff --git a/collects/future-visualizer/private/pict-canvas.rkt b/collects/future-visualizer/private/pict-canvas.rkt new file mode 100644 index 0000000000..ded6627c98 --- /dev/null +++ b/collects/future-visualizer/private/pict-canvas.rkt @@ -0,0 +1,131 @@ +#lang racket/gui +(require framework + slideshow/pict + "display.rkt") +(provide pict-canvas%) + + +(define pict-canvas% + (class canvas% + (init pict-builder [hover-handler #f] + [click-handler #f] + [overlay-builder #f] + [redraw-on-resize #f]) + (inherit get-dc get-client-size refresh get-view-start) + (define bp pict-builder) ;Builds the main pict for the canvas + (define mh hover-handler) ;Mouse hover handler + (define ob overlay-builder) ;Hover overlay pict builder + (define ch click-handler) ;Mouse click handler + (define redraw-on-size redraw-on-resize) ;Whether we should rebuild the pict for on-size events + + (define redraw-overlay #f) ;Whether we should redraw the overlay pict in the canvas + (define redo-bitmap-on-paint #t) ;Redraw the base bitmap on paint? #f for mouse events + (define scale-factor 1) + + ;;set-redraw-overlay! : bool -> void + (define/public (set-redraw-overlay! b) + (set! redraw-overlay b)) + + (define/public (set-scale-factor! s) + (set! scale-factor s)) + + (define needs-redraw #f) + (define delaying-redraw #f) + (define cached-bitmap #f) + (define cached-base-pict #f) + + (define/private (get-viewable-region) + (define-values (x y) (get-view-start)) + (define-values (w h) (get-client-size)) + (scale-viewable-region (viewable-region x y w h) (/ 1 scale-factor))) + + (define/public (redraw-everything) + (redraw-the-bitmap/maybe-delayed! (get-viewable-region))) + + ;Rebuild both the bottom (base) and overlay (top) + ;pict layers for the canvas + ;;rebuild-the-pict : viewable-region -> void + (define/private (rebuild-the-pict vregion #:only-the-overlay? [only-the-overlay? #f]) + (define p (cond + [(or (not cached-base-pict) (not only-the-overlay?)) + (define base (scale (bp vregion) scale-factor)) + (set! cached-base-pict base) + (if ob + (pin-over base + 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 + ;to be drawn to the canvas later + ;;redraw-the-bitmap : viewable-region -> void + (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?)) + (set! needs-redraw #f)) + + ;;redraw-the-bitmap/maybe-delayed! : viewable-region -> void + (define/private (redraw-the-bitmap/maybe-delayed! vregion + #:only-the-overlay? [only-the-overlay? #f]) + (cond + [needs-redraw (redraw-the-bitmap! vregion #:only-the-overlay? only-the-overlay?)] + [(not delaying-redraw) + (new timer% [notify-callback (λ () + (set! delaying-redraw #f) + (set! needs-redraw #t) + (redraw-the-bitmap/maybe-delayed! (get-viewable-region)) + (refresh))] + [interval 100] + [just-once? #t]) + (set! delaying-redraw #t)])) + + ;If we haven't already introduced a 100ms delay, + ;add one. If the delay's expired, rebuild the pict + ;;on-size : uint uint -> void + (define/override (on-size width height) + (when redraw-on-size + (redraw-the-bitmap/maybe-delayed! (get-viewable-region)))) + + (define/override (on-paint) + (define vregion (get-viewable-region)) + (redraw-the-bitmap/maybe-delayed! vregion) + (define dc (get-dc)) + (when cached-bitmap + (send dc + draw-bitmap + cached-bitmap + (viewable-region-x vregion) + (viewable-region-y vregion)))) + + (define/override (on-event event) + (define vregion (get-viewable-region)) + (define x (+ (viewable-region-x vregion) (/ (send event get-x) scale-factor))) + (define y (+ (viewable-region-y vregion) (/ (send event get-y) scale-factor))) + (case (send event get-event-type) + [(motion) + (when mh + (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)))] + [(left-up) + (when ch (ch x y vregion)) ;Ditto for click handler + (redraw-the-bitmap/maybe-delayed! vregion #:only-the-overlay? #t)])) + + (super-new) + (send (get-dc) set-smoothing 'aligned))) + + + + + + + + + + diff --git a/collects/future-visualizer/private/visualizer-gui.rkt b/collects/future-visualizer/private/visualizer-gui.rkt index d5a5b37bbd..3244cb303d 100644 --- a/collects/future-visualizer/private/visualizer-gui.rkt +++ b/collects/future-visualizer/private/visualizer-gui.rkt @@ -7,7 +7,8 @@ "gui-helpers.rkt" "graph-drawing.rkt" "display.rkt" - "constants.rkt") + "constants.rkt" + "pict-canvas.rkt") (provide show-visualizer) @@ -102,13 +103,16 @@ [height winh])) (define main-panel (new panel:horizontal-dragable% [parent (send f get-area-container)])) + (define left-panel (new panel:horizontal-dragable% [parent main-panel] - [stretchable-width #t])) + [stretchable-width #t] + [min-width 0])) (define hlist-ctl (new hierarchical-list% [parent left-panel] [stretchable-width #t] [stretchable-height #t] - [style '(control-border)])) + [style '(control-border)] + [min-width 0])) ;Build up items in the hierlist (define block-node (send hlist-ctl new-list)) @@ -128,8 +132,7 @@ [stretchable-width #t])) (define graphic-panel (new panel:horizontal-dragable% [parent right-panel] - [stretchable-height #t] - [min-width (inexact->exact (round (* winw .8)))])) + [stretchable-height #t])) (define timeline-container (new vertical-panel% [parent graphic-panel] [stretchable-width #t] @@ -145,8 +148,7 @@ (define-values (frameinfo segments) (calc-segments the-trace)) (define timeline-mouse-index (rebuild-mouse-index frameinfo the-trace segments)) (define timeline-panel (new pict-canvas% - [parent timeline-container] - [redraw-on-resize #f] + [parent timeline-container] [pict-builder (λ (vregion) (timeline-pict-for-trace-data vregion the-trace frameinfo segments))] [hover-handler (λ (x y vregion) (let ([seg (find-seg-for-coords x y timeline-mouse-index)]) @@ -155,15 +157,14 @@ [click-handler (λ (x y vregion) (let ([seg (find-seg-for-coords x y timeline-mouse-index)]) (set! tacked-seg seg) - (post-event listener-table 'segment-click timeline-panel seg)))] + (post-event listener-table 'segment-click timeline-panel seg) + seg))] [overlay-builder (λ (vregion scale-factor) (timeline-overlay vregion tacked-seg hover-seg frameinfo the-trace))] - [min-width 500] - [min-height (inexact->exact (round (* winh .7)))] [style '(hscroll vscroll)] [stretchable-width #t])) ;; TODO sometimes the sizes passed to the scrollbars are so big we blow up! @@ -182,16 +183,15 @@ (define hovered-graph-node #f) (define creategraph-panel (new pict-canvas% - [parent graph-container] - [redraw-on-resize #f] + [parent graph-container] [pict-builder (λ (vregion) (draw-creategraph-pict vregion creation-tree-layout))] - [hover-handler #f #;(λ (x y vregion) - (set! hovered-graph-node - (find-node-for-coords x - y - (graph-layout-nodes creation-tree-layout))))] + #;[hover-handler #f (λ (x y vregion) + (set! hovered-graph-node + (find-node-for-coords x + y + (graph-layout-nodes creation-tree-layout))))] [click-handler (λ (x y vregion) (define fid (find-fid-for-coords x y (graph-layout-nodes creation-tree-layout) @@ -202,14 +202,12 @@ (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) + #;[overlay-builder (λ (vregion scale-factor) (graph-overlay-pict hovered-graph-node the-trace creation-tree-layout vregion scale-factor))] - [min-width 500] - [min-height 500] [style '(hscroll vscroll)] [stretchable-width #t])) @@ -218,7 +216,7 @@ (inexact->exact (floor (graph-layout-width creation-tree-layout))) (inexact->exact (floor (graph-layout-height creation-tree-layout))) 0.0 - 0.0) + 0.0) (define graph-footer (new horizontal-panel% @@ -350,5 +348,5 @@ (send graphic-panel add-child graph-container) (send item set-label "Hide Creation Tree"))) (set! showing-create-graph (not showing-create-graph)))]) - + (send f show #t))