@@ -1895,11 +1895,13 @@ (define (dashboard:run-times-tab-updater commondat tab-num) ;; each test is an object in the run component ;; each run is a component ;; all runs stored in runslib library - (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) + (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)) + (canvas-margin 20) + (start-row 0)) ;; each run starts in this row (if tabdat (let* ((row-height 10) (drawing (dboard:tabdat-drawing tabdat)) (runslib (vg:get/create-lib drawing "runslib"))) ;; creates and adds lib (update-rundat tabdat @@ -1915,52 +1917,61 @@ (dboard:tabdat-dbkeys tabdat)) res)) (let ((allruns (dboard:tabdat-allruns tabdat)) (rowhash (make-hash-table)) ;; store me in tabdat (cnv (dboard:tabdat-cnv tabdat))) - (print "allruns: " allruns) - (for-each - (lambda (rundat) - (if (vector? rundat) - (let* ((run (vector-ref rundat 0)) - (testsdat (sort (vector-ref rundat 1) - (lambda (a b) - (< (db:test-get-event_time a) - (db:test-get-event_time b))))) - (key-val-dat (vector-ref rundat 2)) - (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)) - (vg:add-comp-to-lib runslib run-full-name runcomp) - ;; get tests in list sorted by event time ascending - (for-each - (lambda (testdat) - (let* ((event-time (/ (db:test-get-event_time testdat) 60.0)) - (run-duration (/ (db:test-get-run_duration testdat) 60.0)) - (end-time (+ event-time run-duration)) - (test-name (db:test-get-testname testdat)) - (item-path (db:test-get-item-path testdat)) - (test-fullname (conc test-name "/" item-path))) - (let loop ((rownum 0)) - (if (dashboard:row-collision rowhash rownum event-time end-time) - (loop (+ rownum 1)) - (let* ((lly (* rownum row-height)) - (uly (+ lly row-height))) - (dashboard:add-bar rowhash rownum event-time end-time) - (vg:add-objs-to-comp runcomp (vg:make-rect event-time lly end-time uly))))) - ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration) - )) - testsdat) - ;; instantiate the component - (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv)) - ((originx originy) (canvas-origin cnv))) + (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv)) + ((originx originy) (canvas-origin cnv))) + (print "allruns: " allruns) + (for-each + (lambda (rundat) + (if (vector? rundat) + (let* ((run (vector-ref rundat 0)) + (testsdat (sort (vector-ref rundat 1) + (lambda (a b) + (< (db:test-get-event_time a) + (db:test-get-event_time b))))) + (key-val-dat (vector-ref rundat 2)) + (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 (apply min (map db:test-get-event_time testsdat))) + (run-end (apply max (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat))) + (timeoffset (- (+ originx canvas-margin) run-start)) + (timescale (/ (- sizex (* 2 canvas-margin)) (- run-end run-start))) + (maptime (lambda (tsecs)(* timescale (+ tsecs timeoffset))))) + (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx) + (vg:add-comp-to-lib runslib run-full-name runcomp) + ;; get tests in list sorted by event time ascending + (for-each + (lambda (testdat) + (let* ((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)) + (test-fullname (conc test-name "/" item-path))) + (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) + (let loop ((rownum start-row)) ;; (+ start-row 1))) + (set! start-row (max rownum start-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))) + (dashboard:add-bar rowhash rownum event-time end-time) + (vg:add-objs-to-comp runcomp (vg:make-rect event-time lly end-time uly))))) + ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration) + )) + testsdat) + ;; instantiate the component (let* ((extents (vg:components-get-extents runcomp)) (llx (list-ref extents 0)) (lly (list-ref extents 1)) (ulx (list-ref extents 2)) (uly (list-ref extents 3)) @@ -1969,16 +1980,18 @@ (scalex (/ sizex deltax)) (sllx (* scalex llx)) (offx (- sllx originx))) (print "llx: " llx " lly: " lly "ulx: " ulx " uly: " uly " deltax: " deltax " scalex: " scalex " sllx: " sllx " offx: " offx) (print " run-full-name: " run-full-name) - (vg:instantiate drawing "runslib" run-full-name "wrongname" offx 0 scalex: scalex scaley: 1)))))) - allruns) - (vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)(dboard:tabdat-cnv tabdat)) ;; cnv-obj) - (canvas-clear! (dboard:tabdat-cnv tabdat)) ;; -obj) - (vg:draw (dboard:tabdat-drawing tabdat) #t) - )) + ;; (vg:instantiate drawing "runslib" run-full-name "wrongname" offx 0))))) + (vg:instantiate drawing "runslib" run-full-name "wrongname" 0 0))))) + ;; scalex: scalex scaley: 1))))) + allruns) + (vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)(dboard:tabdat-cnv tabdat)) ;; cnv-obj) + (canvas-clear! (dboard:tabdat-cnv tabdat)) ;; -obj) + (print "All objs: " (vg:draw (dboard:tabdat-drawing tabdat) #t)) + ))) (print "no tabdat for run-times-tab-updater")))) (define (dashboard:runs-tab-updater commondat tab-num) (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat)