Overview
| Comment: | Incremental drawing now working. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.61 |
| Files: | files | file ages | folders |
| SHA1: |
efed051fe1bf247d359ba62c5ce433ff |
| User & Date: | matt on 2016-07-23 21:57:31 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-07-23
| ||
| 23:26 | Bit better on the layout, still broken check-in: 1fd3017375 user: matt tags: v1.61 | |
| 21:57 | Incremental drawing now working. check-in: efed051fe1 user: matt tags: v1.61 | |
| 20:59 | reorganised code layout for run times canvas view check-in: ae5d869b0c user: matt tags: v1.61 | |
Changes
Modified dashboard.scm from [27c42dd921] to [c13d28ecc7].
| ︙ | ︙ | |||
184 185 186 187 188 189 190 191 192 193 194 195 196 197 | cnv cnv-obj drawing draw-cache ;; start-row run-start-row max-row ;; Controls used to launch runs etc. command command-tb run-name ;; from run name setting widget states ;; states for -state s1,s2 ... statuses ;; statuses for -status s1,s2 ... | > | 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | cnv cnv-obj drawing draw-cache ;; start-row run-start-row max-row running-layout ;; Controls used to launch runs etc. command command-tb run-name ;; from run name setting widget states ;; states for -state s1,s2 ... statuses ;; statuses for -status s1,s2 ... |
| ︙ | ︙ | |||
262 263 264 265 266 267 268 269 270 271 272 273 274 275 | 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 start-test-offset: 0 state-ignore-hash: (make-hash-table) status-ignore-hash: (make-hash-table) xadj: 0 yadj: 0 | > | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 | 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) running-layout: #f searchpatts: (make-hash-table) start-run-offset: 0 start-test-offset: 0 state-ignore-hash: (make-hash-table) status-ignore-hash: (make-hash-table) xadj: 0 yadj: 0 |
| ︙ | ︙ | |||
1125 1126 1127 1128 1129 1130 1131 | (lambda () (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (if tabdat (let ((last-data-update (dboard:tabdat-last-data-update tabdat)) (now-time (current-seconds))) (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num) (if (> (- now-time last-data-update) 5) | > | | > > > > | | > | 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 |
(lambda ()
(let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
(if tabdat
(let ((last-data-update (dboard:tabdat-last-data-update tabdat))
(now-time (current-seconds)))
(dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
(if (> (- now-time last-data-update) 5)
(if (not (dboard:tabdat-running-layout tabdat))
(begin
(dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
(dboard:tabdat-last-data-update-set! tabdat now-time)
(thread-start! (make-thread
(lambda ()
(dboard:tabdat-running-layout-set! tabdat #t)
(dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
(dboard:tabdat-running-layout-set! tabdat #f)))))
))))))
"dashboard:run-times-tab-updater"))))
(dboard:tabdat-drawing-set! tabdat drawing)
(dboard:commondat-add-updater commondat run-times-tab-updater tab-num: tab-num)
(iup:split
#:orientation "VERTICAL" ;; "HORIZONTAL"
#:value 200
(let* ((tb (iup:treebox
|
| ︙ | ︙ | |||
2490 2491 2492 2493 2494 2495 2496 | res)))) ;; run times canvas updater ;; (define (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num) (let ((cnv (dboard:tabdat-cnv tabdat)) (dwg (dboard:tabdat-drawing tabdat)) | | > | | 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 |
res))))
;; run times canvas updater
;;
(define (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
(let ((cnv (dboard:tabdat-cnv tabdat))
(dwg (dboard:tabdat-drawing tabdat))
(mtx (dboard:tabdat-runs-mutex tabdat))
(vch (dboard:tabdat-view-changed tabdat)))
(if (and cnv dwg vch)
(begin
(mutex-lock! mtx)
(canvas-clear! cnv)
(vg:draw dwg tabdat)
(mutex-unlock! mtx)
(dboard:tabdat-view-changed-set! tabdat #f)))))
|
| ︙ | ︙ | |||
2515 2516 2517 2518 2519 2520 2521 |
(mtx (dboard:tabdat-runs-mutex tabdat)))
(if tabdat
(let* ((drawing (dboard:tabdat-drawing tabdat))
(runslib (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
(compute-start (current-seconds)))
(vg:drawing-xoff-set! drawing (dboard:tabdat-xadj tabdat))
(vg:drawing-yoff-set! drawing (dboard:tabdat-yadj tabdat))
| | | | | > | | | | | 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 |
(mtx (dboard:tabdat-runs-mutex tabdat)))
(if tabdat
(let* ((drawing (dboard:tabdat-drawing tabdat))
(runslib (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
(compute-start (current-seconds)))
(vg:drawing-xoff-set! drawing (dboard:tabdat-xadj tabdat))
(vg:drawing-yoff-set! drawing (dboard:tabdat-yadj tabdat))
(let* ((allruns (dboard:tabdat-allruns tabdat))
(num-runs (length allruns))
(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))
(run-num 1)
(doneruns '())
(run-start-row 0))
(let* ((run (dboard:rundat-run rundat))
(rowhash (make-hash-table)) ;; store me in tabdat
(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 "/")))
(if (not (vg:lib-get-component runslib run-full-name))
(let* ((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))
|
| ︙ | ︙ | |||
2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 | (maptime (lambda (tsecs)(* timescale (+ tsecs timeoffset)))) (num-tests (length hierdat)) (tot-tests (length testsdat)) (new-run-start-row (+ (dboard:tabdat-max-row tabdat) 2))) ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx) (mutex-lock! mtx) (vg:add-comp-to-lib runslib run-full-name runcomp) (mutex-unlock! mtx) ;; (set! run-start-row (+ max-row 2)) ;; (dboard:tabdat-start-row-set! tabdat (+ new-run-start-row 1)) ;; get tests in list sorted by event time ascending (let testsloop ((test-ids (car hierdat)) ;; loop on tests (NOTE: not items!) (tests-tal (cdr hierdat)) (test-num 1)) | > | 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 | (maptime (lambda (tsecs)(* timescale (+ tsecs timeoffset)))) (num-tests (length hierdat)) (tot-tests (length testsdat)) (new-run-start-row (+ (dboard:tabdat-max-row tabdat) 2))) ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx) (mutex-lock! mtx) (vg:add-comp-to-lib runslib run-full-name runcomp) (vg:instantiate drawing "runslib" run-full-name run-full-name 0 (* new-run-start-row row-height)) (mutex-unlock! mtx) ;; (set! run-start-row (+ max-row 2)) ;; (dboard:tabdat-start-row-set! tabdat (+ new-run-start-row 1)) ;; get tests in list sorted by event time ascending (let testsloop ((test-ids (car hierdat)) ;; loop on tests (NOTE: not items!) (tests-tal (cdr hierdat)) (test-num 1)) |
| ︙ | ︙ | |||
2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 | ;; (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) (let ((newdoneruns (cons rundat doneruns))) (if (not (null? tidstal)) (if #f ;; (> (- (current-seconds) update-start-time) 5) (begin (print "drawing runs taking too long.... have " (length runtal) " remaining") | > | 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 | ;; (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) (dboard:tabdat-view-changed-set! tabdat #t) (set! test-objs (cons obj test-objs))))) ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration) (let ((newdoneruns (cons rundat doneruns))) (if (not (null? tidstal)) (if #f ;; (> (- (current-seconds) update-start-time) 5) (begin (print "drawing runs taking too long.... have " (length runtal) " remaining") |
| ︙ | ︙ | |||
2626 2627 2628 2629 2630 2631 2632 | (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))) | | > > | < | 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 | (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")) (dboard:tabdat-view-changed-set! tabdat #t) ;; trigger a redraw )) (if (not (null? tests-tal)) (if #f ;; (> (- (current-seconds) update-start-time) 5) (print "drawing runs taking too long") (testsloop (car tests-tal)(cdr tests-tal)(+ test-num 1)))))) ;; placeholder box (dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 1)) (let ((y (- sizey (* (dboard:tabdat-max-row tabdat) row-height)))) (vg:add-obj-to-comp runcomp (vg:make-rect-obj 0 y 0 y))) ;; instantiate the component (mutex-lock! mtx) (let* ((extents (vg:components-get-extents drawing runcomp)) (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))) (mutex-unlock! mtx) (dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 1))) ;; end of the run handling loop (let ((newdoneruns (cons rundat doneruns))) (if (null? runtal) (begin (dboard:tabdat-not-done-runs-set! tabdat '()) |
| ︙ | ︙ |