| ︙ | | |
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
-
+
|
(let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat)))
(updaters (hash-table-ref/default (dboard:commondat-updaters commondat)
tnum
'())))
(debug:print 0 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum)
(for-each
(lambda (updater)
(debug:print 0 *default-log-port* "Running " updater)
(debug:print 3 *default-log-port* "Running " updater)
(updater)
)
updaters))))
;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num
;;
|
| ︙ | | |
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
|
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
|
-
-
+
+
|
(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 (* -500 (- xadj 0.5)))
(dboard:tabdat-yadj-set! tabdat (* 500 (- yadj 0.5)))
(dboard:tabdat-xadj-set! tabdat (* -1000 (- xadj 0.5)))
(dboard:tabdat-yadj-set! tabdat (* 1000 (- yadj 0.5)))
)))))
#:wheel-cb (lambda (obj step x y dir) ;; dir is 4 for up and 5 for down. I think.
(let* ((drawing (dboard:tabdat-drawing tabdat))
(scalex (vg:drawing-scalex drawing)))
(dboard:tabdat-view-changed-set! tabdat #t)
(print "step: " step " x: " x " y: " y " dir: " dir " scalex: " scalex)
(vg:drawing-scalex-set! drawing
|
| ︙ | | |
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
|
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
((and (<= x1 bx1)(>= x2 bx2))(set! collision #t)))))
rowdat)
collision))
(define-inline (dashboard:add-bar rowhash rownum x1 x2)
(hash-table-set! rowhash rownum (cons (cons x1 x2)
(hash-table-ref/default rowhash rownum '()))))
;; get min or max, use > for max and < for min, this works around the limits on apply
;;
(define (dboard:min-max comp lst)
(if (null? lst)
#f ;; better than an exception for my needs
(fold (lambda (a b)
(if (comp a b) a b))
(car lst)
lst)))
(define-inline (dboard:sort-testsdat-by-event-time testsdat)
(sort testsdat
(lambda (a b)
(< (db:test-get-event_time a)
(db:test-get-event_time b)))))
;; first group items into lists, then sort by time
;; finally sort by first item time
;;
(define (dboard:tests-sort-by-time-group-by-item testsdat)
(let* ((tests (let ((ht (make-hash-table)))
(for-each
(lambda (tdat)
(let ((testname (db:test-get-testname tdat)))
(hash-table-set!
ht
testname
(cons tdat (hash-table-ref/default ht testname '())))))
testsdat)
ht)))
;; remove toplevel tests from iterated tests, sort tests in the list by event time
(for-each
(lambda (testname)
(let ((testslst (hash-table-ref tests testname)))
(if (> (length testslst) 1) ;; must be iterated
(hash-table-set! tests
testname
(dboard:sort-testsdat-by-event-time
(filter (lambda (tdat)
(equal? (db:test-get-item-path tdat) ""))
testslst)))
)))
(hash-table-keys tests))
(sort (hash-table-values tests)
(lambda (a b)
(< (db:test-get-event_time (car a))
(db:test-get-event_time (car b)))))))
(define (dashboard:run-times-tab-updater commondat tab-num)
;; each test is an object in the run component
;; each run is a component
;; all runs stored in runslib library
(let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
(canvas-margin 10)
|
| ︙ | | |
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
|
2345
2346
2347
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
|
-
-
+
+
-
-
+
-
-
-
+
+
|
(cnv (dboard:tabdat-cnv tabdat)))
(let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv)))
;; (print "allruns: " allruns)
(for-each
(lambda (rundat)
(if (vector? rundat)
(let* ((run (vector-ref rundat 0))
(testsdat (sort (vector-ref rundat 1)
(let* ((run (vector-ref rundat 0))
(hierdat (dboard:tests-sort-by-time-group-by-item (vector-ref rundat 1)))
(lambda (a b)
(< (db:test-get-event_time a)
(db:test-get-event_time b)))))
(run-start (apply min (map db:test-get-event_time testsdat)))
(run-end (apply max (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat)))
(run-start (dboard:min-max < (map db:test-get-event_time testsdat)))
(run-end (dboard:min-max > (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat)))
(timeoffset (- (+ originx canvas-margin) run-start))
(run-duration (- run-end run-start))
(timescale (/ (- sizex (* 2 canvas-margin))
(if (> run-duration 0)
run-duration
(current-seconds)))) ;; a least lously guess
(maptime (lambda (tsecs)(* timescale (+ tsecs timeoffset)))))
|
| ︙ | | |
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
|
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
|
-
+
|
(set! max-row (+ max-row 1)))))
allruns)
(vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)(dboard:tabdat-cnv tabdat)) ;; cnv-obj)
(canvas-clear! (dboard:tabdat-cnv tabdat)) ;; -obj)
(print "Number of objs: " (length (vg:draw (dboard:tabdat-drawing tabdat) #t)))
(dboard:tabdat-view-changed-set! tabdat #f)
)))
(print "no tabdat for run-times-tab-updater"))))
(debug:print 2 *default-log-port* "no tabdat for run-times-tab-updater"))))
(define (dashboard:runs-tab-updater commondat tab-num)
(let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
(update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat)
(hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
(let ((res '()))
|
| ︙ | | |