| ︙ | | | ︙ | |
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
(originx #f)
(originy #f)
((layout-update-ok #t) : boolean)
((compact-layout #t) : boolean)
;; Run times layout
(graph-button-box #f)
;; ((graph-button-dat (make-hash-table)) : hash-table) ;;RA=> Deprecating buttons as of now
;; Controls used to launch runs etc.
((command "") : string) ;; for run control this is the command being built up
(command-tb #f)
(key-listboxes #f)
(key-lbs #f)
|
>
>
>
>
|
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
|
(originx #f)
(originy #f)
((layout-update-ok #t) : boolean)
((compact-layout #t) : boolean)
;; Run times layout
(graph-button-box #f)
(graph-matrix #f)
((graph-matrix-table (make-hash-table)) : hash-table)
((graph-matrix-row 1) : number)
((graph-matrix-col 1) : number)
;; ((graph-button-dat (make-hash-table)) : hash-table) ;;RA=> Deprecating buttons as of now
;; Controls used to launch runs etc.
((command "") : string) ;; for run control this is the command being built up
(command-tb #f)
(key-listboxes #f)
(key-lbs #f)
|
| ︙ | | | ︙ | |
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
|
(color (car (gutils:get-color-for-state-status teststate teststatus)))
(curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
(curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
(if (not (equal? curr-color color))
(iup:attribute-set! button "BGCOLOR" color))
(if (not (equal? curr-title buttontxt))
(iup:attribute-set! button "TITLE" buttontxt))
;;(print "RA => testdat " testdat " teststate " teststate " teststatus " teststatus " buttondat " buttondat " curr-color " curr-color " curr-title " curr-title "buttontxt" buttontxt " title " curr-title )
|
<
|
932
933
934
935
936
937
938
939
940
941
942
943
944
945
|
(color (car (gutils:get-color-for-state-status teststate teststatus)))
(curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
(curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
(if (not (equal? curr-color color))
(iup:attribute-set! button "BGCOLOR" color))
(if (not (equal? curr-title buttontxt))
(iup:attribute-set! button "TITLE" buttontxt))
(vector-set! buttondat 0 run-id)
(vector-set! buttondat 1 color)
(vector-set! buttondat 2 buttontxt)
(vector-set! buttondat 3 testdat)
(vector-set! buttondat 4 run-key)))
(set! rown (+ rown 1))))
(dboard:tabdat-all-test-names tabdat)))
|
| ︙ | | | ︙ | |
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
|
(dboard:tabdat-compact-layout-set! tabdat #t))
(dboard:tabdat-last-filter-str-set! tabdat "")
)
"text-list-toggle-box"))))
(dcommon:command-runname-selector commondat tabdat tab-num: tab-num)
(dcommon:command-testname-selector commondat tabdat update-keyvals))
(iup:vbox
(let* ((cnv-obj (iup:canvas
;; #:size "500x400"
#:expand "YES"
#:scrollbar "YES"
#:posx "0.5"
#:posy "0.5"
#:action (make-canvas-action
|
>
>
>
|
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
|
(dboard:tabdat-compact-layout-set! tabdat #t))
(dboard:tabdat-last-filter-str-set! tabdat "")
)
"text-list-toggle-box"))))
(dcommon:command-runname-selector commondat tabdat tab-num: tab-num)
(dcommon:command-testname-selector commondat tabdat update-keyvals))
(iup:vbox
(iup:split
#:orientation "HORIZONTAL"
#:value 800
(let* ((cnv-obj (iup:canvas
;; #:size "500x400"
#:expand "YES"
#:scrollbar "YES"
#:posx "0.5"
#:posy "0.5"
#:action (make-canvas-action
|
| ︙ | | | ︙ | |
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
|
(+ scalex
(if (> step 0)
(* scalex 0.02)
(* scalex -0.02))))))
"wheel-cb"))
)))
cnv-obj)
;; RA => Delete these if not being referenced for matrix
;; (let* ((hb1 (iup:hbox))
;; (buttondat (dboard:tabdat-graph-button-dat tabdat)))
;; ;; (b1 (iup:button "testbutton")))
;; (dboard:tabdat-graph-button-box-set! tabdat hb1)
;; (for-each
;; (lambda (buttondat)
;; (let* ((b1 (iup:button "buttondat-graph-name")))
;; (iup:child-add! b1 hb1))))
;; hb1)
))))
;;======================================================================
;; R U N
;;======================================================================
;;
;; display and manage a single run at a time
|
<
|
|
>
|
>
>
>
>
>
>
|
>
>
>
>
>
|
|
|
>
>
>
>
|
>
|
>
>
|
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
|
(+ scalex
(if (> step 0)
(* scalex 0.02)
(* scalex -0.02))))))
"wheel-cb"))
)))
cnv-obj)
(let* ((hb1 (iup:hbox))
(graph-matrix-table (dboard:tabdat-graph-matrix-table tabdat))
(curr-column-num 0)
(graph-matrix (iup:matrix
#:alignment1 "ALEFT"
#:expand "YES" ;; "HORIZONTAL"
#:numcol 10
#:numlin 20
#:numcol-visible (min 10)
#:numlin-visible 1)))
(dboard:tabdat-graph-matrix-set! tabdat graph-matrix)
(iup:attribute-set! graph-matrix "WIDTH0" 0)
(iup:attribute-set! graph-matrix "HEIGHT0" 0)
graph-matrix))
;;(hash-table-set! graph-matrix-table 'graph1 "color1")
;;(hash-table-set! graph-matrix-table 'graph2 "color2")
;; (for-each
;; (lambda (name-key)
;; (print "hash-table-key : " name-key)
;; (iup:attribute-set! graph-matrix (conc "0:" curr-column-num) name-key)
;; ;; set the color to the value of mame-key in the table
;; (set! curr-column-num (+ 1 curr-column-num)))
;; (hash-table-keys graph-matrix-table))
;; (iup:split
;; #:orientation "HORIZONTAL" ;; "HORIZONTAL"
;; #:value 50
;; (iup:label "Graph")
;; graph-matrix))
))))
;;======================================================================
;; R U N
;;======================================================================
;;
;; display and manage a single run at a time
|
| ︙ | | | ︙ | |
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
|
(col-num (cadr (assoc col-name col-indices)))
(key (conc row-num ":" col-num)))
(hash-table-set! cell-lookup key test-id)
(if (not (equal? (iup:attribute run-matrix key) (cadr value)))
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key (cadr value))
(iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
matrix-content)
;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
(for-each (lambda (ind)
(let* ((name (car ind))
|
>
|
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
|
(col-num (cadr (assoc col-name col-indices)))
(key (conc row-num ":" col-num)))
(hash-table-set! cell-lookup key test-id)
(if (not (equal? (iup:attribute run-matrix key) (cadr value)))
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key (cadr value))
(print "RA=> value" (car value))
(iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
matrix-content)
;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
(for-each (lambda (ind)
(let* ((name (car ind))
|
| ︙ | | | ︙ | |
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
|
(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"))
(stdcolor (vg:rgb->number 120 130 140))
(delta-y (- uly lly)))
(vg:add-obj-to-comp
cmp
(vg:make-rect-obj llx lly ulx uly))
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- (tfn tstart) 10)(- lly 10)(seconds->year-week/day-time tstart)))
(let*-values (((span timeunit time-blk first timesym) (common:find-start-mark-and-mark-delta tstart tend)))
|
|
>
>
>
|
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
|
(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"))
(stdcolor (vg:rgb->number 120 130 140))
(delta-y (- uly lly))
(graph-matrix-table (dboard:tabdat-graph-matrix-table tabdat))
(graph-matrix (dboard:tabdat-graph-matrix tabdat))
(changed #f))
(vg:add-obj-to-comp
cmp
(vg:make-rect-obj llx lly ulx uly))
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- (tfn tstart) 10)(- lly 10)(seconds->year-week/day-time tstart)))
(let*-values (((span timeunit time-blk first timesym) (common:find-start-mark-and-mark-delta tstart tend)))
|
| ︙ | | | ︙ | |
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
|
(lambda (cf)
(let* ((alldat (dboard:graph-read-data (cadr cf) tstart tend)))
(if alldat
(for-each
(lambda (fieldn)
(let* ((dat (hash-table-ref alldat fieldn))
(vals (map (lambda (x)(vector-ref x 2)) dat)))
;; Check if the dat is already added in the buttondat table; if not add it
(if (not (null? vals))
(let* ((maxval (apply max vals))
(minval (min 0 (apply min vals)))
(yoff (- minval lly)) ;; minval))
(deltaval (- maxval minval))
(yscale (/ delta-y (if (zero? deltaval) 1 deltaval)))
(yfunc (lambda (y)(+ lly (* yscale (- y minval))))) ;; (lambda (y)(* (+ y yoff) yscale))))
(graph-color (vg:generate-color)))
;; (print (car cf) "; maxval: " maxval " minval: " minval " deltaval: " deltaval " yscale: " yscale)
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- llx 10)(yfunc maxval) (conc maxval)))
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- llx 10)(yfunc minval) (conc minval)))
(fold
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
|
(lambda (cf)
(let* ((alldat (dboard:graph-read-data (cadr cf) tstart tend)))
(if alldat
(for-each
(lambda (fieldn)
(let* ((dat (hash-table-ref alldat fieldn))
(vals (map (lambda (x)(vector-ref x 2)) dat)))
(if (not (hash-table-exists? graph-matrix-table fieldn))
;;(print fieldn "exists")
(begin
(let* ((graph-color-rgb (vg:generate-color-rgb))
(graph-color (apply vg:rgb->number graph-color-rgb))
(graph-matrix-col (dboard:tabdat-graph-matrix-col tabdat))
(graph-matrix-row (dboard:tabdat-graph-matrix-row tabdat)))
(hash-table-set! graph-matrix-table fieldn graph-color)
(print "Graph data " graph-matrix-row " " graph-matrix-col " " fieldn " " graph-color " " graph-color-rgb)
(set! changed #t)
(iup:attribute-set! graph-matrix (conc graph-matrix-row ":" graph-matrix-col) fieldn)
(iup:attribute-set! graph-matrix "FGCOLOR1:1" '(70 249 73))
(iup:attribute-set! graph-matrix (conc "BGCOLOR" (conc graph-matrix-row ":" graph-matrix-col)) graph-color-rgb)
(if (> graph-matrix-col 10)
(begin
(dboard:tabdat-graph-matrix-col-set! tabdat 1)
(dboard:tabdat-graph-matrix-row-set! tabdat (+ graph-matrix-row 1)))
(dboard:tabdat-graph-matrix-col-set! tabdat (+ graph-matrix-col 1)))
)))
(if (not (null? vals))
(let* ((maxval (apply max vals))
(minval (min 0 (apply min vals)))
(yoff (- minval lly)) ;; minval))
(deltaval (- maxval minval))
(yscale (/ delta-y (if (zero? deltaval) 1 deltaval)))
(yfunc (lambda (y)(+ lly (* yscale (- y minval))))) ;; (lambda (y)(* (+ y yoff) yscale))))
(graph-color (hash-table-ref graph-matrix-table fieldn)))
;; set to hash-table value for fieldn
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- llx 10)(yfunc maxval) (conc maxval)))
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- llx 10)(yfunc minval) (conc minval)))
(fold
|
| ︙ | | | ︙ | |
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
|
;; (vg:add-obj-to-comp
;; cmp
;; (vg:make-rect-obj (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
;; fill-color: stdcolor))))
;; 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
|
|
>
|
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
|
;; (vg:add-obj-to-comp
;; cmp
;; (vg:make-rect-obj (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
;; fill-color: stdcolor))))
;; dat)
)))) ;; for each data point in the series
(hash-table-keys alldat)))))
cfg)
(if changed (iup:attribute-set! graph-matrix "REDRAW" "ALL"))))
;; 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
|
| ︙ | | | ︙ | |