39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
+
|
(declare (uses mt))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2012-2016
Usage: dashboard [options]
|
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
|
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
|
-
+
+
|
(begin
(dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
(dboard:tabdat-last-data-update-set! tabdat now-time)
(thread-start! (make-thread
(lambda ()
(dboard:tabdat-running-layout-set! tabdat #t)
(dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
(dboard:tabdat-running-layout-set! tabdat #f)))))
(dboard:tabdat-running-layout-set! tabdat #f))
"run-times-tab-layout-updater")))
))))))
"dashboard:run-times-tab-updater"))))
(dboard:tabdat-drawing-set! tabdat drawing)
(dboard:commondat-add-updater commondat run-times-tab-updater tab-num: tab-num)
(iup:split
#:orientation "VERTICAL" ;; "HORIZONTAL"
#:value 200
|
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
|
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
|
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
-
+
+
|
(define-inline (dashboard:px-between px lx1 lx2)
(and (< lx1 px)(> lx2 px)))
;; can a bar be placed in row "rownum" covering x1 to x2 without overlapping with existing
;; bars? Use num-rows to check that a block will fit from rownum to (+ rownum num-rows)
;;
(define (dashboard:row-collision rowhash rownum x1 x2 #!key (num-rows #f))
(let ((collision #f)
(lastrow (if num-rows (+ rownum num-rows) rownum)))
(for-each
(lambda (bar)
(let ((bx1 (car bar))
(bx2 (cdr bar)))
(cond
;; newbar x1 inside bar
((dashboard:px-between x1 bx1 bx2)(set! collision #t))
((dashboard:px-between x2 bx1 bx2)(set! collision #t))
((and (<= x1 bx1)(>= x2 bx2))(set! collision #t)))))
rowdat)
(if (< i lastrow)
(loop (+ i 1)
(hash-table-ref/default rowhash (+ rownum i) '()))))
collision))
|