2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
|
;; (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 (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))
(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)))
;; (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 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)))
(dashboard:add-bar rowhash rownum event-time end-time)
(vg:add-objs-to-comp runcomp
(vg:make-rect event-time lly end-time uly
fill-color: (vg:iup-color->number (car name-color))
text: (conc test-name "/" item-path)
font: "Helvetica -10")
;; (vg:make-text (+ event-time 2)
;; (+ lly 2)
;; (conc test-name "/" item-path)
;; font: "Helvetica -10")
))))
;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
))
testsdat)
;; placeholder box
(set! max-row (+ max-row 1))
(let ((y (- sizey (* max-row row-height))))
(vg:add-objs-to-comp runcomp (vg:make-rect 0 y 0 y)))
;; instantiate the component
(let* ((extents (vg:components-get-extents drawing runcomp))
;; move the following into mapping functions in vg.scm
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
|
;; (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 (testdats)
(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))
(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)))
;; (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 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)))
(dashboard:add-bar rowhash rownum event-time end-time)
(vg:add-objs-to-comp runcomp
(vg:make-rect event-time lly end-time uly
fill-color: (vg:iup-color->number (car name-color))
text: (conc test-name "/" item-path)
font: "Helvetica -10")
;; (vg:make-text (+ event-time 2)
;; (+ lly 2)
;; (conc test-name "/" item-path)
;; font: "Helvetica -10")
))))
;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
))
testdats))
hierdat)
;; placeholder box
(set! max-row (+ max-row 1))
(let ((y (- sizey (* max-row row-height))))
(vg:add-objs-to-comp runcomp (vg:make-rect 0 y 0 y)))
;; instantiate the component
(let* ((extents (vg:components-get-extents drawing runcomp))
;; move the following into mapping functions in vg.scm
|