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

Fix "dancing flags" issue with timeline ticks in future visualizer

Browse Source 
(cherry picked from commit 6eed135d02)
This commit is contained in:
James Swaine 2012-07-19 15:13:13 -05:00 committed by Ryan Culpepper
parent b7ef456965
commit a79b122f5e
2 changed files with 72 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -58,7 +58,8 @@
;Represents a vertical line depicting a specific time in the execution history ;Represents a vertical line depicting a specific time in the execution history
(struct timeline-tick (x (struct timeline-tick (x
abs-time abs-time
rel-time) #:transparent) rel-time
show-label?) #:transparent)
;;viewable-region-from-frame : frame-info -> viewable-region ;;viewable-region-from-frame : frame-info -> viewable-region
(define (viewable-region-from-frame finfo) (define (viewable-region-from-frame finfo)
@ -179,19 +180,29 @@
[else [else
(loop (cdr ss))]))) (loop (cdr ss))])))
;;timeline-tick-label-pict : real -> pict
(define (timeline-tick-label-pict rel-time)
(text-block-pict (format "~a ms" (real->decimal-string rel-time))
#:backcolor (timeline-tick-label-backcolor)
#:forecolor (timeline-tick-label-forecolor)
#:padding 3))
;;calc-ticks : (listof segment) float trace -> (listof timeline-tick) ;;calc-ticks : (listof segment) float trace -> (listof timeline-tick)
(define (calc-ticks segs timeToPixMod tr) (define (calc-ticks segs timeToPixMod tr)
(define LABEL-PAD 3)
(define trace-start (inexact->exact (trace-start-time tr))) (define trace-start (inexact->exact (trace-start-time tr)))
(define segs-len (length segs)) (define segs-len (length segs))
(define-values (lt lx tks _) (define-values (lt lx tks _ __)
(for/fold ([last-time trace-start] (for/fold ([last-time trace-start]
[last-x 0] [last-x 0]
[ticks '()] [ticks '()]
[last-label-x-extent 0]
[remain-segs segs]) ([i (in-range 0 (floor (/ (- (trace-end-time tr) [remain-segs segs]) ([i (in-range 0 (floor (/ (- (trace-end-time tr)
trace-start) trace-start)
DEFAULT-TIME-INTERVAL)))]) DEFAULT-TIME-INTERVAL)))])
(define tick-time (+ last-time DEFAULT-TIME-INTERVAL)) #;(define tick-time (+ last-time DEFAULT-TIME-INTERVAL))
(define tick-rel-time (* (add1 i) DEFAULT-TIME-INTERVAL)) (define tick-rel-time (* (add1 i) DEFAULT-TIME-INTERVAL))
(define tick-time (+ trace-start tick-rel-time))
(define want-x (+ last-x (* DEFAULT-TIME-INTERVAL timeToPixMod))) (define want-x (+ last-x (* DEFAULT-TIME-INTERVAL timeToPixMod)))
(define-values (most-recent-seg next-seg r-segs) (define-values (most-recent-seg next-seg r-segs)
(find-most-recent-and-next remain-segs tick-time)) (find-most-recent-and-next remain-segs tick-time))
@ -201,31 +212,37 @@
(define next-evt-time (inexact->exact (event-start-time next-evt))) (define next-evt-time (inexact->exact (event-start-time next-evt)))
(define most-recent-edge (segment-edge most-recent-seg)) (define most-recent-edge (segment-edge most-recent-seg))
(define next-edge (segment-x next-seg)) (define next-edge (segment-x next-seg))
(cond (define tick-x
[(= most-recent-time tick-time) (cond
(values tick-time [(= most-recent-time tick-time) (segment-x most-recent-seg)]
(segment-x most-recent-seg) [(= (segment-x next-seg) (add1 (+ (segment-x most-recent-seg) (segment-width most-recent-seg))))
(cons (timeline-tick (segment-x most-recent-seg) tick-time tick-rel-time) ticks) (+ (segment-x most-recent-seg) (segment-width most-recent-seg))]
r-segs)] [else
[(= (segment-x next-seg) (add1 (+ (segment-x most-recent-seg) (segment-width most-recent-seg)))) (define start-x (max most-recent-edge last-x))
(values tick-time (define start-time (max most-recent-time last-time))
(+ (segment-x most-recent-seg) (segment-width most-recent-seg)) (define size-mod (/ (- next-edge start-x) (- next-evt-time start-time)))
(cons (timeline-tick (+ (segment-x most-recent-seg) (define x-offset (ceiling (* (- tick-time start-time) size-mod)))
(segment-width most-recent-seg)) (round (+ start-x x-offset))]))
tick-time (define show-tick? ((- tick-x last-x) . >= . TIMELINE-MIN-TICK-PADDING))
tick-rel-time) (define show-label?
ticks) (if (not show-tick?)
r-segs)] #f
[else (>= tick-x (+ last-label-x-extent LABEL-PAD))))
(define start-x (max most-recent-edge last-x)) (define new-label-x-extent
(define start-time (max most-recent-time last-time)) (if show-label?
(define size-mod (/ (- next-edge start-x) (- next-evt-time start-time))) (+ tick-x (pict-width (timeline-tick-label-pict tick-rel-time)))
(define x-offset (ceiling (* (- tick-time start-time) size-mod))) last-label-x-extent))
(define tick-x (round (+ start-x x-offset))) (if show-tick?
(values tick-time (values tick-time
tick-x tick-x
(cons (timeline-tick tick-x tick-time tick-rel-time) ticks) (cons (timeline-tick tick-x tick-time tick-rel-time show-label?) ticks)
r-segs)]))) new-label-x-extent
r-segs)
(values tick-time
last-x
ticks
new-label-x-extent
r-segs))))
tks) tks)
;;calc-process-timespan-lines : trace (listof segment) -> (listof (uint . uint)) ;;calc-process-timespan-lines : trace (listof segment) -> (listof (uint . uint))
@ -373,51 +390,23 @@
;;draw-ruler-on : pict viewable-region frameinfo -> pict ;;draw-ruler-on : pict viewable-region frameinfo -> pict
(define (draw-ruler-on base vregion frameinfo) (define (draw-ruler-on base vregion frameinfo)
(let loop ([pct base] (for/fold ([pct base]) ([tick (in-list (filter (λ (t) (in-viewable-region-horiz vregion (timeline-tick-x t)))
[ticks (filter (λ (t) (in-viewable-region-horiz vregion (timeline-tick-x t))) (frame-info-timeline-ticks frameinfo)))])
(frame-info-timeline-ticks frameinfo))] (define cur-x (timeline-tick-x tick))
[next-label-x (viewable-region-x-extent vregion)] (define pinnedline
[next-tick-x (viewable-region-x-extent vregion)]) (pin-over pct
(cond (- cur-x (viewable-region-x vregion))
[(null? ticks) pct] 0
[(< (- next-tick-x (timeline-tick-x (car ticks))) TIMELINE-MIN-TICK-PADDING) (linestyle 'dot
(loop pct (colorize (vline 1
(cdr ticks) (frame-info-adjusted-height frameinfo))
next-label-x (timeline-tick-color)))))
next-tick-x)] (if (timeline-tick-show-label? tick)
[else (let* ([LABEL-PAD 2] (pin-over pinnedline
[VERT-PAD 3] (- cur-x (viewable-region-x vregion))
[cur-tick (car ticks)] 3
[cur-x (timeline-tick-x cur-tick)] (timeline-tick-label-pict (timeline-tick-rel-time tick)))
[tick-desc (format "~a ms" (real->decimal-string pinnedline)))
(timeline-tick-rel-time cur-tick) 1))]
[t (text-block-pict tick-desc
#:backcolor (timeline-tick-label-backcolor)
#:forecolor (timeline-tick-label-forecolor)
#:padding 3)]
[text-width (pict-width t)]
[show-label? (<= (+ cur-x LABEL-PAD text-width) next-label-x)]
[pinnedline (pin-over pct
(- cur-x (viewable-region-x vregion))
0
(linestyle 'dot
(colorize (vline 1
(frame-info-adjusted-height frameinfo))
(if show-label?
(timeline-tick-bold-color)
(timeline-tick-color)))))])
(if show-label?
(loop (pin-over pinnedline
(- cur-x (viewable-region-x vregion))
VERT-PAD
t)
(cdr ticks)
cur-x
cur-x)
(loop pinnedline
(cdr ticks)
next-label-x
cur-x)))])))
;;draw-row-lines-on : pict viewable-region trace frameinfo -> pict ;;draw-row-lines-on : pict viewable-region trace frameinfo -> pict
(define (draw-row-lines-on base vregion tr finfo opacity) (define (draw-row-lines-on base vregion tr finfo opacity)

23
collects/tests/future/visualizer.rkt
View File

@ -41,11 +41,11 @@
(check-true (in-viewable-region-horiz vr 222))) (check-true (in-viewable-region-horiz vr 222)))
(let ([vr (viewable-region 0 0 732 685)] (let ([vr (viewable-region 0 0 732 685)]
[ticks (list (timeline-tick 222.0 #f 0.4999999999999982) [ticks (list (timeline-tick 222.0 #f 0.4999999999999982 #f)
(timeline-tick 169.0 #f 0.3999999999999986) (timeline-tick 169.0 #f 0.3999999999999986 #f)
(timeline-tick 116.0 #f 0.29999999999999893) (timeline-tick 116.0 #f 0.29999999999999893 #f)
(timeline-tick 63.0 #f 0.1999999999999993) (timeline-tick 63.0 #f 0.1999999999999993 #f)
(timeline-tick 10 #f 0.09999999999999964))]) (timeline-tick 10 #f 0.09999999999999964 #f))])
(define in-vr (filter (λ (t) (define in-vr (filter (λ (t)
(in-viewable-region-horiz vr (timeline-tick-x t))) (in-viewable-region-horiz vr (timeline-tick-x t)))
ticks)) ticks))
@ -250,14 +250,9 @@
(indexed-future-event 1 (future-event 0 0 'start-work 11.0 #f #f)) (indexed-future-event 1 (future-event 0 0 'start-work 11.0 #f #f))
(indexed-future-event 2 (future-event 0 0 'end-work 20.0 #f #f)))]) (indexed-future-event 2 (future-event 0 0 'end-work 20.0 #f #f)))])
(define-values (tr finfo segs ticks) (compile-trace-data l)) (define-values (tr finfo segs ticks) (compile-trace-data l))
;Check that number of ticks stays constant whatever the time->pixel modifier ;Number of ticks can vary, but cannot exceed (total trace time / tick interval)
(check-equal? (length ticks) 100) (check-true (<= (length ticks) 100))
(check-equal? (length (calc-ticks segs 700 tr)) 100) (check-equal? (length (calc-ticks segs 1000 tr)) 99))
(for ([i (in-range 0.1 20)])
(check-equal? (length (calc-ticks segs i tr))
100
(format "Wrong number of ticks for time->pix mod ~a\n" i)))
(check-seg-layout tr segs ticks))
(let ([l (list (indexed-future-event 0 '#s(future-event #f 0 create 1334778395768.733 #f 3)) (let ([l (list (indexed-future-event 0 '#s(future-event #f 0 create 1334778395768.733 #f 3))
(indexed-future-event 1 '#s(future-event 3 2 start-work 1334778395768.771 #f #f)) (indexed-future-event 1 '#s(future-event 3 2 start-work 1334778395768.771 #f #f))
@ -267,7 +262,7 @@
(define last-evt (indexed-future-event-fevent (list-ref l 3))) (define last-evt (indexed-future-event-fevent (list-ref l 3)))
(define first-evt (indexed-future-event-fevent (list-ref l 0))) (define first-evt (indexed-future-event-fevent (list-ref l 0)))
(define total-time (- (future-event-time last-evt) (future-event-time first-evt))) (define total-time (- (future-event-time last-evt) (future-event-time first-evt)))
(check-equal? (length ticks) (inexact->exact (floor (* 10 total-time))))) (check-true (<= (length ticks) (inexact->exact (floor (* 10 total-time))))))
(define mand-first (define mand-first
(list (indexed-future-event 0 '#s(future-event #f 0 create 1334779294212.415 #f 1)) (list (indexed-future-event 0 '#s(future-event #f 0 create 1334779294212.415 #f 1))