@@ -186,10 +186,11 @@ 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 @@ -264,10 +265,11 @@ 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) @@ -1127,14 +1129,20 @@ (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) - (begin - (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num) - (dashboard:run-times-tab-layout-updater commondat tabdat tab-num) - (dboard:tabdat-last-data-update-set! tabdat now-time))))))) + (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" @@ -2492,12 +2500,13 @@ ;; 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))) - (if (and cnv dwg) + (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) @@ -2517,28 +2526,29 @@ (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)) - (rowhash (make-hash-table)) ;; store me in tabdat - (cnv (dboard:tabdat-cnv 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)) + (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-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)) @@ -2560,10 +2570,11 @@ (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!) @@ -2607,10 +2618,11 @@ (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) @@ -2628,11 +2640,13 @@ (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")))) + 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 @@ -2646,12 +2660,11 @@ (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)) + (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)