| ︙ | | | ︙ | |
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
((not-done-runs '()) : list) ;; list of runs not yet drawn
(header #f) ;; header for decoding the run records
(keys #f) ;; keys for this run (i.e. target components)
((numruns (string->number (or (args:get-arg "-cols") "8"))) : number) ;;
((tot-runs 0) : number)
((last-data-update 0) : number) ;; last time the data in allruns was updated
(runs-mutex (make-mutex)) ;; use to prevent parallel access to draw objects
;; Runs view
((buttondat (make-hash-table)) : hash-table) ;;
((item-test-names '()) : list) ;; list of itemized tests
((run-keys (make-hash-table)) : hash-table)
(runs-matrix #f) ;; used in newdashboard
((start-run-offset 0) : number) ;; left-right slider value
|
>
>
>
|
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
((not-done-runs '()) : list) ;; list of runs not yet drawn
(header #f) ;; header for decoding the run records
(keys #f) ;; keys for this run (i.e. target components)
((numruns (string->number (or (args:get-arg "-cols") "8"))) : number) ;;
((tot-runs 0) : number)
((last-data-update 0) : number) ;; last time the data in allruns was updated
(runs-mutex (make-mutex)) ;; use to prevent parallel access to draw objects
((run-update-times (make-hash-table)) : hash-table) ;; update times indexed by run-id
(last-test-dat #f) ;; cache last tests dat
((run-db-paths (make-hash-table)) : hash-table) ;; cache the paths to the run db files
;; Runs view
((buttondat (make-hash-table)) : hash-table) ;;
((item-test-names '()) : list) ;; list of itemized tests
((run-keys (make-hash-table)) : hash-table)
(runs-matrix #f) ;; used in newdashboard
((start-run-offset 0) : number) ;; left-right slider value
|
| ︙ | | | ︙ | |
298
299
300
301
302
303
304
305
306
307
308
309
310
311
|
rowsused ;; hash of lists covering what areas used - replace with quadtree
hierdat ;; put hierarchial sorted list here
tests ;; hash of id => testdat
tests-by-name ;; hash of testfullname => testdat
key-vals
((last-update 0) : fixnum) ;; last query to db got records from before last-update
data-changed
)
(define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f)(last-update -100));; -100 is before time began
(make-dboard:rundat
run: run
tests: (or tests (make-hash-table))
tests-by-name: (make-hash-table)
|
>
|
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
|
rowsused ;; hash of lists covering what areas used - replace with quadtree
hierdat ;; put hierarchial sorted list here
tests ;; hash of id => testdat
tests-by-name ;; hash of testfullname => testdat
key-vals
((last-update 0) : fixnum) ;; last query to db got records from before last-update
data-changed
(db-path #f)
)
(define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f)(last-update -100));; -100 is before time began
(make-dboard:rundat
run: run
tests: (or tests (make-hash-table))
tests-by-name: (make-hash-table)
|
| ︙ | | | ︙ | |
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
|
(if rec
rec
(let ((rd (dboard:rundat-make-init run: run key-vals: key-vals)))
(hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd)
rd))))
;; (prev-tests (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1))
(last-update (dboard:rundat-last-update run-dat)) ;; (vector-ref prev-dat 3))
(tmptests (rmt:get-tests-for-run run-id testnamepatt states statuses ;; run-id testpatt states statuses
#f #f ;; offset limit
(dboard:tabdat-hide-not-hide tabdat) ;; no-in
sort-by ;; sort-by
sort-order ;; sort-order
#f ;; 'shortlist ;; qrytype
(if (dboard:tabdat-filters-changed tabdat)
0
last-update) ;; last-update
*dashboard-mode*)) ;; use dashboard mode
(use-new (dboard:tabdat-hide-not-hide tabdat))
(tests-ht (if (dboard:tabdat-filters-changed tabdat)
(let ((ht (make-hash-table)))
(dboard:rundat-tests-set! run-dat ht)
ht)
(dboard:rundat-tests run-dat)))
(start-time (current-seconds)))
|
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
>
|
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
|
(if rec
rec
(let ((rd (dboard:rundat-make-init run: run key-vals: key-vals)))
(hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd)
rd))))
;; (prev-tests (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1))
(last-update (dboard:rundat-last-update run-dat)) ;; (vector-ref prev-dat 3))
(db-path (or (dboard:rundat-db-path run-dat)
(let* ((db-dir (tasks:get-task-db-path))
(db-pth (conc db-dir "/" run-id ".db")))
(dboard:rundat-db-path-set! run-dat db-pth)
db-pth)))
(tmptests (if (or (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")
(>= (file-modification-time db-path) last-update))
(rmt:get-tests-for-run run-id testnamepatt states statuses ;; run-id testpatt states statuses
#f #f ;; offset limit
(dboard:tabdat-hide-not-hide tabdat) ;; no-in
sort-by ;; sort-by
sort-order ;; sort-order
#f ;; 'shortlist ;; qrytype
(if (dboard:tabdat-filters-changed tabdat)
0
last-update) ;; last-update
*dashboard-mode*) ;; use dashboard mode
'()))
(use-new (dboard:tabdat-hide-not-hide tabdat))
(tests-ht (if (dboard:tabdat-filters-changed tabdat)
(let ((ht (make-hash-table)))
(dboard:rundat-tests-set! run-dat ht)
ht)
(dboard:rundat-tests run-dat)))
(start-time (current-seconds)))
|
| ︙ | | | ︙ | |
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
|
(vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)
(dboard:tabdat-cnv tabdat))))
(let ((drawing (dboard:tabdat-drawing tabdat))
(old-xadj (dboard:tabdat-xadj tabdat))
(old-yadj (dboard:tabdat-yadj tabdat)))
(if (not (and (eq? xadj old-xadj)(eq? yadj old-yadj)))
(begin
(print "xadj: " xadj " yadj: " yadj "changed: "(eq? xadj old-xadj) " " (eq? yadj old-yadj))
(dboard:tabdat-view-changed-set! tabdat #t)
(dboard:tabdat-xadj-set! tabdat (* -2000 (- xadj 0.5)))
(dboard:tabdat-yadj-set! tabdat (* 2000 (- yadj 0.5)))
))))
"iup:canvas action")))
#:wheel-cb (lambda (obj step x y dir) ;; dir is 4 for up and 5 for down. I think.
(debug:catch-and-dump
|
|
|
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
|
(vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)
(dboard:tabdat-cnv tabdat))))
(let ((drawing (dboard:tabdat-drawing tabdat))
(old-xadj (dboard:tabdat-xadj tabdat))
(old-yadj (dboard:tabdat-yadj tabdat)))
(if (not (and (eq? xadj old-xadj)(eq? yadj old-yadj)))
(begin
;; (print "xadj: " xadj " yadj: " yadj "changed: "(eq? xadj old-xadj) " " (eq? yadj old-yadj))
(dboard:tabdat-view-changed-set! tabdat #t)
(dboard:tabdat-xadj-set! tabdat (* -2000 (- xadj 0.5)))
(dboard:tabdat-yadj-set! tabdat (* 2000 (- yadj 0.5)))
))))
"iup:canvas action")))
#:wheel-cb (lambda (obj step x y dir) ;; dir is 4 for up and 5 for down. I think.
(debug:catch-and-dump
|
| ︙ | | | ︙ | |
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
|
(define (tree-path->run-id tabdat path)
(if (not (null? path))
(hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) path #f)
#f))
(define (dboard:get-tests-dat tabdat run-id last-update)
(let ((tdat (if run-id (rmt:get-tests-for-run run-id
(hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
(hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)) ;; '()
(hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)) ;; '()
#f #f ;; offset limit
(dboard:tabdat-hide-not-hide tabdat) ;; not-in
#f #f ;; sort-by sort-order
#f ;; get all? "id,testname,item_path,state,status,event_time,run_duration" ;; qryval
|
|
|
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
|
(define (tree-path->run-id tabdat path)
(if (not (null? path))
(hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) path #f)
#f))
(define (dboard:get-tests-dat tabdat run-id last-update)
(let* ((tdat (if run-id (rmt:get-tests-for-run run-id
(hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
(hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)) ;; '()
(hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)) ;; '()
#f #f ;; offset limit
(dboard:tabdat-hide-not-hide tabdat) ;; not-in
#f #f ;; sort-by sort-order
#f ;; get all? "id,testname,item_path,state,status,event_time,run_duration" ;; qryval
|
| ︙ | | | ︙ | |
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
|
))))
run-ids)))
(define (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix)
(let* ((runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
(runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
(run-id (dboard:tabdat-curr-run-id tabdat))
(last-update 0) ;; fix me - have to create and store a rundat record for this
(tests-dat (dboard:get-tests-dat tabdat run-id last-update))
(tests-mindat (dcommon:minimize-test-data tests-dat))
(indices (common:sparse-list-generate-index tests-mindat)) ;; proc: set-cell))
(row-indices (cadr indices))
(col-indices (car indices))
(max-row (if (null? row-indices) 1 (common:max (map cadr row-indices))))
(max-col (if (null? col-indices) 1 (common:max (map cadr col-indices))))
(max-visible (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) ;; (dboard:tabdat-num-tests tabdat) is proportional to the size of the window
(numrows 1)
(numcols 1)
(changed #f)
(runs-hash (let ((ht (make-hash-table)))
(for-each (lambda (run)
(hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
(vector-ref runs-dat 1))
ht)))
(dboard:tabdat-filters-changed-set! tabdat #f)
(let loop ((pass-num 0)
(changed #f))
;; Update the runs tree
(dboard:update-tree tabdat runs-hash runs-header tb)
(if (eq? pass-num 1)
(begin ;; big reset
(iup:attribute-set! run-matrix "CLEARVALUE" "ALL") ;; NOTE: Was CONTENTS
(iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
(iup:attribute-set! run-matrix "RESIZEMATRIX" "YES")
(iup:attribute-set! run-matrix "NUMCOL" max-col )
(iup:attribute-set! run-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)))) ;; min of 20
;; Row labels
(for-each (lambda (ind)
(let* ((name (car ind))
(num (cadr ind))
(key (conc num ":0")))
(if (not (equal? (iup:attribute run-matrix key) name))
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key name)))))
row-indices)
;; (print "row-indices: " row-indices " col-indices: " col-indices)
(if (and (eq? pass-num 0) changed)
(loop 1 #t)) ;; force second pass
;; Cell contents
(for-each (lambda (entry)
;; (print "entry: " entry)
(let* ((row-name (cadr entry))
(col-name (car entry))
(valuedat (caddr entry))
(test-id (list-ref valuedat 0))
|
|
>
>
>
>
>
>
>
>
|
>
>
>
|
|
|
|
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
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
|
))))
run-ids)))
(define (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix)
(let* ((runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
(runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
(run-id (dboard:tabdat-curr-run-id tabdat))
(last-update (hash-table-ref/default (dboard:tabdat-run-update-times tabdat) run-id 0))
(db-path (or (hash-table-ref/default (dboard:tabdat-run-db-paths tabdat) run-id #f)
(let* ((db-dir (tasks:get-task-db-path))
(db-pth (conc db-dir "/" run-id ".db")))
(hash-table-set! (dboard:tabdat-run-db-paths tabdat) run-id db-pth)
db-pth)))
(tests-dat (if (or (not run-id)
(configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")
(>= (file-modification-time db-path) last-update))
(dboard:get-tests-dat tabdat run-id last-update)
(dboard:tabdat-last-test-dat tabdat)))
(tests-mindat (dcommon:minimize-test-data tests-dat))
(indices (common:sparse-list-generate-index tests-mindat)) ;; proc: set-cell))
(row-indices (cadr indices))
(col-indices (car indices))
(max-row (if (null? row-indices) 1 (common:max (map cadr row-indices))))
(max-col (if (null? col-indices) 1 (common:max (map cadr col-indices))))
(max-visible (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) ;; (dboard:tabdat-num-tests tabdat) is proportional to the size of the window
(numrows 1)
(numcols 1)
(changed #f)
(runs-hash (let ((ht (make-hash-table)))
(for-each (lambda (run)
(hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
(vector-ref runs-dat 1))
ht)))
(dboard:tabdat-last-test-dat-set! tabdat tests-dat)
(hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- (current-seconds) 10))
(dboard:tabdat-filters-changed-set! tabdat #f)
(let loop ((pass-num 0)
(changed #f))
;; Update the runs tree
(dboard:update-tree tabdat runs-hash runs-header tb)
(if (eq? pass-num 1)
(begin ;; big reset
(iup:attribute-set! run-matrix "CLEARVALUE" "ALL") ;; NOTE: Was CONTENTS
(iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
(iup:attribute-set! run-matrix "RESIZEMATRIX" "YES")
(iup:attribute-set! run-matrix "NUMCOL" max-col )
(iup:attribute-set! run-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)))) ;; min of 20
;; Row labels
(for-each (lambda (ind)
(let* ((name (car ind))
(num (cadr ind))
(key (conc num ":0")))
(if (not (equal? (iup:attribute run-matrix key) name))
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key name)))))
row-indices)
;; (print "row-indices: " row-indices " col-indices: " col-indices)
(if (and (eq? pass-num 0) changed)
(loop 1 #t)) ;; force second pass
;; Cell contents
(for-each (lambda (entry)
;; (print "entry: " entry)
(let* ((row-name (cadr entry))
(col-name (car entry))
(valuedat (caddr entry))
(test-id (list-ref valuedat 0))
|
| ︙ | | | ︙ | |
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
|
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key (cadr value))
(iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
tests-mindat)
;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
(for-each (lambda (ind)
(let* ((name (car ind))
(num (cadr ind))
(key (conc "0:" num)))
(if (not (equal? (iup:attribute run-matrix key) name))
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key name)
(iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num))))))
col-indices)
(if (and (eq? pass-num 0) changed)
(loop 1 #t)) ;; force second pass due to column labels changing
;; (debug:print 0 *default-debug-port* "one-run-updater, changed: " changed " pass-num: " pass-num)
;; (print "one-run-updater, changed: " changed " pass-num: " pass-num)
(if changed (iup:attribute-set! run-matrix "REDRAW" "ALL")))))
;;======================================================================
;; S U M M A R Y
;;======================================================================
|
|
|
|
|
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
|
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key (cadr value))
(iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
tests-mindat)
;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
(for-each (lambda (ind)
(let* ((name (car ind))
(num (cadr ind))
(key (conc "0:" num)))
(if (not (equal? (iup:attribute run-matrix key) name))
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key name)
(iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num))))))
col-indices)
(if (and (eq? pass-num 0) changed)
(loop 1 #t)) ;; force second pass due to column labels changing
;; (debug:print 0 *default-debug-port* "one-run-updater, changed: " changed " pass-num: " pass-num)
;; (print "one-run-updater, changed: " changed " pass-num: " pass-num)
(if changed (iup:attribute-set! run-matrix "REDRAW" "ALL")))))
;;======================================================================
;; S U M M A R Y
;;======================================================================
|
| ︙ | | | ︙ | |
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
|
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
;; (set! colnum (+ colnum 1))
))))
run-ids))
(print "Updating rundat")
(if (dboard:tabdat-keys tabdat) ;; have keys yet?
(let* ((num-keys (length (dboard:tabdat-keys tabdat)))
(targpatt (map (lambda (k v)
(list k v))
(dboard:tabdat-keys tabdat)
(take (append (or (dboard:tabdat-target tabdat);; (string-split (dboard: "/")
'("%" "%"))
(make-list num-keys "%"))
num-keys)
))
(runpatt (if (dboard:tabdat-target tabdat)
(last (dboard:tabdat-target tabdat))
"%"))
(testpatt (or (dboard:tabdat-test-patts tabdat) "%"))
(filtrstr (conc targpatt "/" runpatt "/" testpatt)))
(print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt)
(if (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr))
(let ((dwg (dboard:tabdat-drawing tabdat)))
(print "reseting drawing")
(dboard:tabdat-layout-update-ok-set! tabdat #f)
(vg:drawing-libs-set! dwg (make-hash-table))
(vg:drawing-insts-set! dwg (make-hash-table))
|
|
|
|
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
|
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
;; (set! colnum (+ colnum 1))
))))
run-ids))
;; (print "Updating rundat")
(if (dboard:tabdat-keys tabdat) ;; have keys yet?
(let* ((num-keys (length (dboard:tabdat-keys tabdat)))
(targpatt (map (lambda (k v)
(list k v))
(dboard:tabdat-keys tabdat)
(take (append (or (dboard:tabdat-target tabdat);; (string-split (dboard: "/")
'("%" "%"))
(make-list num-keys "%"))
num-keys)
))
(runpatt (if (dboard:tabdat-target tabdat)
(last (dboard:tabdat-target tabdat))
"%"))
(testpatt (or (dboard:tabdat-test-patts tabdat) "%"))
(filtrstr (conc targpatt "/" runpatt "/" testpatt)))
;; (print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt)
(if (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr))
(let ((dwg (dboard:tabdat-drawing tabdat)))
(print "reseting drawing")
(dboard:tabdat-layout-update-ok-set! tabdat #f)
(vg:drawing-libs-set! dwg (make-hash-table))
(vg:drawing-insts-set! dwg (make-hash-table))
|
| ︙ | | | ︙ | |