Overview
Comment: | more incremental draw |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.61 |
Files: | files | file ages | folders |
SHA1: |
4d158f878fc0131cd44a0122fcf883e3 |
User & Date: | mrwellan on 2016-07-22 17:57:21 |
Other Links: | branch diff | manifest | tags |
Context
2016-07-23
| ||
00:46 | Converted to named loops so can exit before all tests drawn check-in: dde8e637fa user: matt tags: v1.61 | |
2016-07-22
| ||
17:57 | more incremental draw check-in: 4d158f878f user: mrwellan tags: v1.61 | |
16:34 | Fixed fallout from refactoring check-in: 66a0b5821b user: mrwellan tags: v1.61 | |
Changes
Modified dashboard.scm from [1d8470c8da] to [25798d6cb1].
︙ | ︙ | |||
159 160 161 162 163 164 165 | ;; data for each specific tab goes here ;; (defstruct dboard:tabdat ;; runs allruns ;; list of dboard:rundat records allruns-by-id ;; hash of run-id -> dboard:rundat records | | | | 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | ;; data for each specific tab goes here ;; (defstruct dboard:tabdat ;; runs allruns ;; list of dboard:rundat records allruns-by-id ;; hash of run-id -> dboard:rundat records done-runs ;; list of runs already drawn not-done-runs ;; list of runs not yet drawn header ;; header for decoding the run records keys ;; keys for this run (i.e. target components) numruns tot-runs ;; Runs view buttondat |
︙ | ︙ | |||
249 250 251 252 253 254 255 256 257 258 259 260 261 262 | filters-changed: #f header: #f hide-empty-runs: #f hide-not-hide-button: #f hide-not-hide: #t item-test-names: '() last-db-update: 0 num-tests: 15 numruns: 16 path-run-ids: (make-hash-table) run-ids: (make-hash-table) run-keys: (make-hash-table) searchpatts: (make-hash-table) start-run-offset: 0 | > > | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 | filters-changed: #f header: #f hide-empty-runs: #f hide-not-hide-button: #f hide-not-hide: #t item-test-names: '() last-db-update: 0 not-done-runs: '() done-runs: '() num-tests: 15 numruns: 16 path-run-ids: (make-hash-table) run-ids: (make-hash-table) run-keys: (make-hash-table) searchpatts: (make-hash-table) start-run-offset: 0 |
︙ | ︙ | |||
2477 2478 2479 2480 2481 2482 2483 | (let ((res '())) (for-each (lambda (key) (if (not (equal? key "runname")) (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f))) (if val (set! res (cons (list key val) res)))))) (dboard:tabdat-dbkeys tabdat)) res)) | > | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > > > > > > > > > | | 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 | (let ((res '())) (for-each (lambda (key) (if (not (equal? key "runname")) (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f))) (if val (set! res (cons (list key val) res)))))) (dboard:tabdat-dbkeys tabdat)) res)) (let ((allruns (if (null? (dboard:tabdat-not-done-runs tabdat)) (dboard:tabdat-allruns tabdat) (dboard:tabdat-not-done-runs tabdat))) (rowhash (make-hash-table)) ;; store me in tabdat (cnv (dboard:tabdat-cnv tabdat))) (print "allruns: " allruns) (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv)) ((originx originy) (canvas-origin cnv))) ;; (print "allruns: " allruns) (let runloop ((rundat (car allruns)) (runtal (cdr allruns)) (doneruns '())) (let* ((run (dboard:rundat-run rundat)) (hierdat (dboard:tests-sort-by-time-group-by-item (dboard:rundat-tests rundat))) ;; hierarchial list of ids (tests-ht (dboard:rundat-tests rundat)) (all-tids (hash-table-keys tests-ht)) ;; (apply append hierdat)) ;; was testsdat (testsdat (hash-table-values tests-ht)) (key-val-dat (dboard:rundat-key-vals rundat)) (run-id (db:get-value-by-header run (dboard:tabdat-header tabdat) "id")) (key-vals (append key-val-dat (list (let ((x (db:get-value-by-header run (dboard:tabdat-header tabdat) "runname"))) (if x x ""))))) (run-key (string-intersperse key-vals "\n")) (run-full-name (string-intersperse key-vals "/")) (runcomp (vg:comp-new));; new component for this run (rows-used (make-hash-table)) ;; keep track of what parts of the rows are used here row1 = (obj1 obj2 ...) ;; (row-height 4) (run-start (dboard:min-max < (map db:test-get-event_time testsdat))) (run-end (dboard:min-max > (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat))) (timeoffset (- (+ originx canvas-margin) run-start)) (run-duration (- run-end run-start)) (timescale (/ (- sizex (* 2 canvas-margin)) (if (> run-duration 0) run-duration (current-seconds)))) ;; a least lously guess (maptime (lambda (tsecs)(* timescale (+ tsecs timeoffset)))) (num-tests (length hierdat)) (test-num 0) (tot-tests (length testsdat))) (set! run-num (+ run-num 1)) ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx) (vg:add-comp-to-lib runslib run-full-name runcomp) (set! run-start-row (+ max-row 2)) (set! start-row run-start-row) ;; this is the run title. move this into the box ;; (let ((x 10) ;; (y (- sizey (* start-row row-height)))) ;; (vg:add-objs-to-comp runcomp (vg:make-text x y run-full-name font: "Helvetica -10")) ;; (dashboard:add-bar rowhash start-row x (+ x 100))) (set! start-row (+ start-row 1)) ;; get tests in list sorted by event time ascending (for-each (lambda (test-ids) (let ((test-objs '()) (iterated (> (length test-ids) 1)) (first-rownum #f) (num-items (length test-ids)) (item-num 0)) (set! test-num (+ test-num 1)) (for-each (lambda (test-id) (let* ((testdat (hash-table-ref tests-ht test-id)) (event-time (maptime (db:test-get-event_time testdat))) (run-duration (* timescale (db:test-get-run_duration testdat))) (end-time (+ event-time run-duration)) (test-name (db:test-get-testname testdat)) (item-path (db:test-get-item-path testdat)) (state (db:test-get-state testdat)) (status (db:test-get-status testdat)) (test-fullname (conc test-name "/" item-path)) (name-color (gutils:get-color-for-state-status state status))) (set! item-num (+ item-num 1)) ;; (print "event_time: " (db:test-get-event_time testdat) " mapped event_time: " event-time) ;; (print "run-duration: " (db:test-get-run_duration testdat) " mapped run_duration: " run-duration) (if (> item-num 50) (if (eq? 0 (modulo item-num 50)) (print "processing " run-num " of " num-runs " runs " item-num " of " num-items " of test " test-name ", " test-num " of " num-tests " tests"))) (let loop ((rownum run-start-row)) ;; (+ start-row 1))) (set! max-row (max rownum max-row)) ;; track the max row used (if (dashboard:row-collision rowhash rownum event-time end-time) (loop (+ rownum 1)) (let* ((lly (- sizey (* rownum row-height))) (uly (+ lly row-height)) (obj (vg:make-rect-obj event-time lly end-time uly fill-color: (vg:iup-color->number (car name-color)) text: (if iterated item-path test-name) font: "Helvetica -10"))) ;; (if iterated ;; (dashboard:add-bar rowhash (- rownum 1) event-time end-time num-rows: (+ 1 num-items)) (if (not first-rownum) (begin (dashboard:row-collision rowhash (- rownum 1) event-time end-time num-rows: num-items) (set! first-rownum rownum))) (dashboard:add-bar rowhash rownum event-time end-time) (vg:add-obj-to-comp runcomp obj) (set! test-objs (cons obj test-objs))))) ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration) )) test-ids) ;; If it is an iterated test put box around it now. (if iterated (let* ((xtents (vg:get-extents-for-objs drawing test-objs)) (llx (- (car xtents) 5)) (lly (- (cadr xtents) 10)) (ulx (+ 5 (caddr xtents))) (uly (+ 0 (cadddr xtents)))) (dashboard:add-bar rowhash first-rownum llx ulx num-rows: num-items) (vg:add-obj-to-comp runcomp (vg:make-rect-obj llx lly ulx uly text: (db:test-get-testname (hash-table-ref tests-ht (car test-ids))) font: "Helvetica -10")))))) hierdat) ;; placeholder box (set! max-row (+ max-row 1)) (let ((y (- sizey (* max-row row-height)))) (vg:add-obj-to-comp runcomp (vg:make-rect-obj 0 y 0 y))) ;; instantiate the component (let* ((extents (vg:components-get-extents drawing runcomp)) ;; move the following into mapping functions in vg.scm ;; (deltax (- llx ulx)) ;; (scalex (if (> deltax 0)(/ sizex deltax) 1)) ;; (sllx (* scalex llx)) ;; (offx (- sllx originx)) (new-xtnts (apply vg:grow-rect 5 5 extents)) (llx (list-ref new-xtnts 0)) (lly (list-ref new-xtnts 1)) (ulx (list-ref new-xtnts 2)) (uly (list-ref new-xtnts 3)) ) ;; (vg:components-get-extents d1 c1))) (vg:add-obj-to-comp runcomp (vg:make-rect-obj llx lly ulx uly text: run-full-name)) (vg:instantiate drawing "runslib" run-full-name run-full-name 0 0)) (set! max-row (+ max-row 1))) ;; end of the run handling loop (let ((newdoneruns (cons rundat doneruns))) (if (null? runtal) (begin (dboard:tabdat-not-done-runs-set! tabdat '()) (dboard:tabdat-done-runs-set! tabdat allruns)) (if (> (- (current-seconds) update-start-time) 5) (begin (print "drawing runs taking too long.... have " (length runtal) " remaining") (dboard:tabdat-done-runs-set! tabdat newdoneruns) ;; taking too long? stop here! (dboard:tabdat-non-done-runs-set! tabdat tal)) (runloop (car runtal)(cdr runtal) newdoneruns))))) (vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)(dboard:tabdat-cnv tabdat)) ;; cnv-obj) (canvas-clear! (dboard:tabdat-cnv tabdat)) ;; -obj) (print "Number of objs: " (length (vg:draw (dboard:tabdat-drawing tabdat) #t))) (dboard:tabdat-view-changed-set! tabdat #f) ))) (debug:print 2 *default-log-port* "no tabdat for run-times-tab-updater")))) |
︙ | ︙ |