Performance improvements in future visualizer GUI (dragging, scrolling, sizing)
This commit is contained in:
James Swaine
parent
f0aaca0dde
commit
06358fa19d
|
|
@ -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])])
|
||||
|
|
|
|||
131
collects/future-visualizer/private/pict-canvas.rkt
Normal file
131
collects/future-visualizer/private/pict-canvas.rkt
Normal file
|
|
@ -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)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -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]
|
||||
|
|
@ -146,7 +149,6 @@
|
|||
(define timeline-mouse-index (rebuild-mouse-index frameinfo the-trace segments))
|
||||
(define timeline-panel (new pict-canvas%
|
||||
[parent timeline-container]
|
||||
[redraw-on-resize #f]
|
||||
[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!
|
||||
|
|
@ -183,15 +184,14 @@
|
|||
(define hovered-graph-node #f)
|
||||
(define creategraph-panel (new pict-canvas%
|
||||
[parent graph-container]
|
||||
[redraw-on-resize #f]
|
||||
[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]))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user