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
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
|
(mutex-lock! mtx)
(canvas-clear! cnv)
(vg:draw dwg tabdat)
(mutex-unlock! mtx)
(dboard:tabdat-view-changed-set! tabdat #f)))))
;; doesn't work.
(define (gotoescape tabdat escape)
(or (dboard:tabdat-layout-update-ok tabdat)
(escape #t)))
;; run times tab
;;
(define (dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
;; each test is an object in the run component
;; each run is a component
;; all runs stored in runslib library
(let escapeloop ((escape #f))
(if (and (not escape)
tabdat)
(let* ((canvas-margin 10)
(not-done-runs (dboard:tabdat-not-done-runs tabdat))
(mtx (dboard:tabdat-runs-mutex tabdat))
(drawing (dboard:tabdat-drawing tabdat))
(runslib (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
(layout-start (current-milliseconds))
(allruns (dboard:tabdat-allruns tabdat))
(num-runs (length allruns))
(cnv (dboard:tabdat-cnv tabdat))
(compact-layout (dboard:tabdat-compact-layout tabdat))
(row-height (if compact-layout 2 10)))
(dboard:tabdat-layout-update-ok-set! tabdat #t)
(if (canvas? cnv)
(let*-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv))
((calc-y) (lambda (rownum)
(- (/ sizey 2)
(* rownum row-height))))
((fixed-originx) (if (dboard:tabdat-originx tabdat)
(dboard:tabdat-originx tabdat)
(begin
(dboard:tabdat-originx-set! tabdat originx)
originx)))
((fixed-originy) (if (dboard:tabdat-originy tabdat)
(dboard:tabdat-originy tabdat)
(begin
(dboard:tabdat-originy-set! tabdat originy)
originy))))
;; (print "allruns: " allruns)
(let runloop ((rundat (car allruns))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
|
|
|
|
|
|
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
2637
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
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
|
(mutex-lock! mtx)
(canvas-clear! cnv)
(vg:draw dwg tabdat)
(mutex-unlock! mtx)
(dboard:tabdat-view-changed-set! tabdat #f)))))
;; doesn't work.
;;
(define (gotoescape tabdat escape)
(or (dboard:tabdat-layout-update-ok tabdat)
(escape #t)))
(define (dboard:graph-db-open dbstr)
(let* ((parts (string-split dbstr ":"))
(dbpth (if (< (length parts) 2) ;; assume then a filename was provided
dbstr
(if (equal? (car parts) "sqlite3")
(cadr parts)
(begin
(debug:print 0 *default-log-port* "ERROR: I only know sqlite3 databases for now: " dbstr)
(cadr parts))))))
(if (file-read-access? dbpth)
(let ((db (sqlite3:open-database dbpth))) ;; (open-database dbpth)))
(sqlite3:set-busy-handler! db (make-busy-timeout 10000))
db))))
(define (dboard:graph-read-data cmdstring tstart tend)
(let* ((parts (string-split cmdstring))) ;; spaces not allowed
(if (< (length parts) 4) ;; sqlite3:path tablename timefieldname field1 field2 ...
(debug:print 0 *default-log-port* "ERROR: malformed graph line: " cmdstring)
(let* ((dbdef (car parts))
(tablen (cadr parts))
(timef (caddr parts))
(fields (cdddr parts))
(db (dboard:graph-db-open dbdef))
(res (make-hash-table)))
(for-each
(lambda (fieldname) ;; fields
(let ((qrystr (conc "SELECT " timef ",var,val FROM " tablen " WHERE var='" fieldname "' AND " timef " >= " tstart " AND " timef " <= " tend " ORDER BY " timef " ASC")))
(print "qrystr: " qrystr)
(hash-table-set! res fieldname ;; (fetch-rows (sql db qrystr)))))
(sqlite3:fold-row
(lambda (res t var val)
(cons (vector t var val) res))
'() db qrystr))))
fields)
res))))
;; graph data
;; tsc=timescale, tfn=function; time->x
;;
(define (dboard:graph commondat tabdat tabnum llx lly ulx uly tstart tend tsc tfn compname cmargin)
(let* ((dwg (dboard:tabdat-drawing tabdat))
(lib (vg:get/create-lib dwg "runslib"))
(cnv (dboard:tabdat-cnv tabdat))
(dur (- tstart tend)) ;; time duration
(cmp (vg:get-component dwg "runslib" compname))
(cfg (configf:get-section *configdat* "graph")))
(vg:add-obj-to-comp
cmp
(vg:make-rect-obj llx lly ulx uly))
(for-each
(lambda (cf)
(let* ((alldat (dboard:graph-read-data (cadr cf) tstart tend)))
(for-each
(lambda (fieldn)
(let* ((dat (hash-table-ref alldat fieldn ))
(vals (map (lambda (x)(vector-ref x 2)) dat)))
(if (not (null? vals))
(let* ((maxval (apply max vals))
(minval (apply min vals))
(yoff (- lly minval))
(yscale (/ (- maxval minval)(- uly lly)))
(yfunc (lambda (y)(* (+ y yoff) yscale))))
;; (print (car cf) ": " (hash-table->alist
(for-each
(lambda (dpt)
(let* ((tval (vector-ref dpt 0))
(yval (vector-ref dpt 2))
(stval (tfn tval))
(syval (yfunc yval)))
(vg:add-obj-to-comp
cmp
(vg:make-rect-obj (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
fill-color: (vg:rgb->number 50 50 50)))))
dat))))) ;; for each data point in the series
(hash-table-keys alldat))))
cfg)))
;; run times tab
;;
(define (dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
;; each test is an object in the run component
;; each run is a component
;; all runs stored in runslib library
(let escapeloop ((escape #f))
(if (and (not escape)
tabdat)
(let* ((canvas-margin 10)
(not-done-runs (dboard:tabdat-not-done-runs tabdat))
(mtx (dboard:tabdat-runs-mutex tabdat))
(drawing (dboard:tabdat-drawing tabdat))
(runslib (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
(layout-start (current-milliseconds))
(allruns (dboard:tabdat-allruns tabdat))
(num-runs (length allruns))
(cnv (dboard:tabdat-cnv tabdat))
(compact-layout (dboard:tabdat-compact-layout tabdat))
(row-height (if compact-layout 2 10))
(graph-height 120)
(run-to-run-margin 20))
(dboard:tabdat-layout-update-ok-set! tabdat #t)
(if (canvas? cnv)
(let*-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv))
((calc-y) (lambda (rownum)
(- (/ sizey 2)
(* rownum row-height))))
((fixed-originx) 0) ;; (if (dboard:tabdat-originx tabdat)
;; (dboard:tabdat-originx tabdat)
;; (begin
;; (dboard:tabdat-originx-set! tabdat originx)
;; originx)))
((fixed-originy) (if (dboard:tabdat-originy tabdat)
(dboard:tabdat-originy tabdat)
(begin
(dboard:tabdat-originy-set! tabdat originy)
originy))))
;; (print "allruns: " allruns)
(let runloop ((rundat (car allruns))
|
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
|
(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))
(tot-tests (length testsdat))
)
(print "Testing. (maptime run-start=" run-start "): " (maptime run-start) " (maptime run-end=" run-end "): " (maptime run-end) " run-duration: " run-duration)
;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx)
(mutex-lock! mtx)
(vg:add-comp-to-lib runslib run-full-name runcomp)
;; Have to keep moving the instantiated box as it is anchored at the lower left
;; this should have worked for x in next statement? (maptime run-start)
(vg:instantiate drawing "runslib" run-full-name run-full-name fixed-originx (calc-y curr-run-start-row)) ;; 0) ;; (calc-y (dboard:tabdat-max-row tabdat)))
(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))
|
>
>
>
|
>
>
|
|
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
|
(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))
(tot-tests (length testsdat))
(width (* timescale run-duration))
(graph-lly (calc-y (/ -50 row-height)))
(graph-uly (- (calc-y 0) canvas-margin))
)
;; (print "Testing. (maptime run-start=" run-start "): " (maptime run-start) " (maptime run-end=" run-end "): " (maptime run-end) " run-duration: " run-duration)
(print "run_duration: " (seconds->hr-min-sec run-duration))
;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx)
(mutex-lock! mtx)
(vg:add-comp-to-lib runslib run-full-name runcomp)
;; Have to keep moving the instantiated box as it is anchored at the lower left
;; this should have worked for x in next statement? (maptime run-start)
;; add 60 to make room for the graph
(vg:instantiate drawing "runslib" run-full-name run-full-name fixed-originx (- (calc-y curr-run-start-row) (+ graph-height run-to-run-margin)))
(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))
|
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
|
line-color: (vg:rgb->number 255 0 255 a: 128))))
; (vg:components-get-extents d1 c1)))
;; this is the box around the run
(mutex-lock! mtx)
(vg:add-obj-to-comp runcomp outln)
(mutex-unlock! mtx)
(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 2))
;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat))
))
;; end of the run handling loop
(if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
(let ((newdoneruns (cons rundat doneruns)))
(if (null? runtal)
(begin
|
>
>
>
>
|
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
|
line-color: (vg:rgb->number 255 0 255 a: 128))))
; (vg:components-get-extents d1 c1)))
;; this is the box around the run
(mutex-lock! mtx)
(vg:add-obj-to-comp runcomp outln)
(mutex-unlock! mtx)
(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 2))
;; this is where we have enough info to place the graph
(dboard:graph commondat tabdat tab-num llx uly ulx (+ uly graph-height) run-start run-end timescale maptime run-full-name canvas-margin)
;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat))
))
;; end of the run handling loop
(if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
(let ((newdoneruns (cons rundat doneruns)))
(if (null? runtal)
(begin
|