diff --git a/collects/future-visualizer/private/pict-canvas.rkt b/collects/future-visualizer/private/pict-canvas.rkt index 7d27710413..a26480dffc 100644 --- a/collects/future-visualizer/private/pict-canvas.rkt +++ b/collects/future-visualizer/private/pict-canvas.rkt @@ -17,24 +17,15 @@ (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 need-redraw? #f) - (define delaying-redraw #f) - (define cached-bitmap #f) + (define delaying-redraw? #f) + (define cached-base-bitmap #f) (define cached-overlay-bitmap #f) - (define cached-base-pict #f) - (define repainting? #f) (define/private (get-viewable-region) (define-values (x y) (get-view-start)) @@ -48,10 +39,8 @@ ;pict layers for the canvas ;;rebuild-the-pict : viewable-region -> void (define/private (rebuild-the-pict! vregion #:only-the-overlay? [only-the-overlay? #f]) - (when (or (not cached-base-pict) (not only-the-overlay?)) - (define base (scale (bp vregion) scale-factor)) - ;(set! cached-base-pict base) - (set! cached-bitmap (pict->bitmap base))) + (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))))) @@ -70,35 +59,31 @@ [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 (λ () - (set! delaying-redraw #f) + (set! delaying-redraw? #f) (set! need-redraw? #t) (redraw-the-bitmap/maybe-delayed! (get-viewable-region) #:only-the-overlay? only-the-overlay?) (refresh))] [interval delay] [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)))) + (set! delaying-redraw? #t)])) (define last-vregion #f) + (define (scroll-or-size-event? vregion) + (not (equal? vregion last-vregion))) + (define/override (on-paint) (define vregion (get-viewable-region)) - (when (and (not delaying-redraw) (not (equal? vregion last-vregion))) + (when (and (not delaying-redraw?) (scroll-or-size-event? vregion)) (redraw-the-bitmap/maybe-delayed! vregion)) (set! last-vregion vregion) (define dc (get-dc)) - (when cached-bitmap + (when cached-base-bitmap (send dc draw-bitmap - cached-bitmap + cached-base-bitmap (viewable-region-x vregion) (viewable-region-y vregion))) (when cached-overlay-bitmap @@ -115,7 +100,7 @@ (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 + (when (mh x y vregion) ;Mouse handler returns non-false if a state change requiring redraw occurred (redraw-the-bitmap/maybe-delayed! vregion #:delay 0 #:only-the-overlay? #t)))] [(left-up) (when ch (ch x y vregion)) ;Ditto for click handler diff --git a/collects/future-visualizer/private/visualizer-drawing.rkt b/collects/future-visualizer/private/visualizer-drawing.rkt index 824cd2cb6a..fbcefb8b6c 100644 --- a/collects/future-visualizer/private/visualizer-drawing.rkt +++ b/collects/future-visualizer/private/visualizer-drawing.rkt @@ -437,20 +437,8 @@ #:forecolor (header-forecolor) #:padding HEADER-PADDING #:opacity opacity - #:width (viewable-region-width vregion))] - [row-mid (- (- (* index (frame-info-row-height finfo)) - (pict-height proc-title)) - (viewable-region-y vregion))]) + #:width (viewable-region-width vregion))]) (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 (- (* (add1 index) (frame-info-row-height finfo)) (viewable-region-y vregion)) (colorize (hline (viewable-region-width vregion) 1) (timeline-baseline-color))) @@ -586,14 +574,14 @@ #:with-arrow with-arrow #:style style)))) -(define (get-seg-left-of-vregion vregion seg) +#;(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] + [(not prev-in-time) seg] + [((segment-edge prev-in-time) . < . (viewable-region-x vregion)) prev-in-time] [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-left-of-vregion vregion seg)) (let loop ([p base-pct] [cur-seg fst]) @@ -606,14 +594,14 @@ next-seg p (event-connection-line-color) - #:width 2)) + #:width 1)) (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 -#;(define (draw-arrows base-pct vregion seg) +(define (draw-arrows base-pct vregion seg) (let ([fst (get-seg-previous-to-vregion vregion seg)]) (let loop ([pct base-pct] [cur-seg fst])