| ︙ | | | ︙ | |
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
(define *db* (open-db))
(define toplevel #f)
(define dlg #f)
(define max-test-num 0)
(define *keys* (get-keys *db*))
(define dbkeys (map (lambda (x)(vector-ref x 0))
(append *keys* (list (vector "runname" "blah")))))
(define *header* #f)
(define *allruns* '())
(define *buttondat* (make-hash-table)) ;; <run-id color text test run-key>
(define *alltestnamelst* '())
(define *searchpatts* (make-hash-table))
(define *num-runs* 8)
|
|
|
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
(define *db* (open-db))
(define toplevel #f)
(define dlg #f)
(define max-test-num 0)
(define *keys* (get-keys *db*))
(define *dbkeys* (map (lambda (x)(vector-ref x 0))
(append *keys* (list (vector "runname" "blah")))))
(define *header* #f)
(define *allruns* '())
(define *buttondat* (make-hash-table)) ;; <run-id color text test run-key>
(define *alltestnamelst* '())
(define *searchpatts* (make-hash-table))
(define *num-runs* 8)
|
| ︙ | | | ︙ | |
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
(define (colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
(delta (map (lambda (a b)(abs (- a b))) c1 c2)))
(null? (filter (lambda (x)(> x 3)) delta))))
(define (update-rundat runnamepatt numruns testnamepatt itemnamepatt)
(let* ((allruns (db-get-runs *db* runnamepatt numruns *start-run-offset*))
(header (db:get-header allruns))
(runs (db:get-rows allruns))
(result '())
(maxtests 0))
(if (> (+ *last-update* 300) (current-seconds)) ;; every five minutes
(begin
(set! *last-update* (current-seconds))
|
>
|
|
|
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
(define (colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
(delta (map (lambda (a b)(abs (- a b))) c1 c2)))
(null? (filter (lambda (x)(> x 3)) delta))))
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
(define (update-rundat runnamepatt numruns testnamepatt itemnamepatt keypatts)
(let* ((allruns (db:get-runs *db* runnamepatt numruns *start-run-offset* keypatts))
(header (db:get-header allruns))
(runs (db:get-rows allruns))
(result '())
(maxtests 0))
(if (> (+ *last-update* 300) (current-seconds)) ;; every five minutes
(begin
(set! *last-update* (current-seconds))
|
| ︙ | | | ︙ | |
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
|
(vector lftcol header runsvec)))
(if (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS" ))
(begin
(set! *num-tests* (string->number (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS"))))
(update-rundat "%" *num-runs* "%" "%"))
(set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20)))
(define *tim* (iup:timer))
(define *ord* #f)
(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")
(define (run-update x)
(update-buttons uidat *num-runs* *num-tests*)
(update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
(hash-table-ref/default *searchpatts* "test-name" "%")
(hash-table-ref/default *searchpatts* "item-name" "%")))
(cond
((args:get-arg "-run")
(let ((runid (string->number (args:get-arg "-run"))))
(if runid
(begin
(lambda (x)
|
|
|
|
>
>
>
>
>
>
|
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
|
(vector lftcol header runsvec)))
(if (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS" ))
(begin
(set! *num-tests* (string->number (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS"))))
(update-rundat "%" *num-runs* "%" "%" '()))
(set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%" '()) 8) 20)))
(define *tim* (iup:timer))
(define *ord* #f)
(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")
(define (run-update x)
(update-buttons uidat *num-runs* *num-tests*)
(update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
(hash-table-ref/default *searchpatts* "test-name" "%")
(hash-table-ref/default *searchpatts* "item-name" "%")
(let ((res '()))
(for-each (lambda (key)
(let ((val (hash-table-ref/default *searchpatts* key #f)))
(if val (set! res (cons (list key val) res)))))
*dbkeys*)
res)))
(cond
((args:get-arg "-run")
(let ((runid (string->number (args:get-arg "-run"))))
(if runid
(begin
(lambda (x)
|
| ︙ | | | ︙ | |
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
|
(let ((testid (string->number (args:get-arg "-test"))))
(if testid
(examine-test *db* testid)
(begin
(print "ERROR: testid is not a number " (args:get-arg "-test"))
(exit 1)))))
(else
(set! uidat (make-dashboard-buttons *num-runs* *num-tests* dbkeys))
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (x)
(run-update x)))))
;(print x)))))
(iup:main-loop)
|
|
|
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
|
(let ((testid (string->number (args:get-arg "-test"))))
(if testid
(examine-test *db* testid)
(begin
(print "ERROR: testid is not a number " (args:get-arg "-test"))
(exit 1)))))
(else
(set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*))
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (x)
(run-update x)))))
;(print x)))))
(iup:main-loop)
|