Overview
| Comment: | reorganised code layout for run times canvas view |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.61 |
| Files: | files | file ages | folders |
| SHA1: |
ae5d869b0c437093339e5a1b96ca1ad1 |
| User & Date: | matt on 2016-07-23 20:59:40 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-08-12
| ||
| 10:51 | Lost changes Closed-Leaf check-in: 824081a391 user: mrwellan tags: lost-v1.61-changes | |
|
2016-07-23
| ||
| 21:57 | Incremental drawing now working. check-in: efed051fe1 user: matt tags: v1.61 | |
| 20:59 | reorganised code layout for run times canvas view check-in: ae5d869b0c user: matt tags: v1.61 | |
| 12:47 | More on incremental drawing. Added use of -log in tests check-in: 398d85a266 user: matt tags: v1.61 | |
Changes
Modified dashboard.scm from [0acea2413c] to [27c42dd921].
| ︙ | ︙ | |||
165 166 167 168 169 170 171 172 173 174 175 176 177 178 | allruns-by-id ;; hash of run-id -> dboard:rundat records done-runs ;; list of runs already drawn not-done-runs ;; list of runs not yet drawn header ;; header for decoding the run records keys ;; keys for this run (i.e. target components) numruns tot-runs ;; Runs view buttondat item-test-names run-keys runs-matrix ;; used in newdashboard start-run-offset ;; left-right slider value | > > | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | allruns-by-id ;; hash of run-id -> dboard:rundat records done-runs ;; list of runs already drawn not-done-runs ;; list of runs not yet drawn header ;; header for decoding the run records keys ;; keys for this run (i.e. target components) numruns tot-runs last-data-update ;; last time the data in allruns was updated runs-mutex ;; use to prevent parallel access to draw objects ;; Runs view buttondat item-test-names run-keys runs-matrix ;; used in newdashboard start-run-offset ;; left-right slider value |
| ︙ | ︙ | |||
252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 |
filters-changed: #f
header: #f
hide-empty-runs: #f
hide-not-hide-button: #f
hide-not-hide: #t
item-test-names: '()
last-db-update: 0
not-done-runs: '()
done-runs: '()
num-tests: 15
numruns: 16
path-run-ids: (make-hash-table)
run-ids: (make-hash-table)
run-keys: (make-hash-table)
searchpatts: (make-hash-table)
start-run-offset: 0
start-test-offset: 0
state-ignore-hash: (make-hash-table)
status-ignore-hash: (make-hash-table)
xadj: 0
yadj: 0
view-changed: #t
run-start-row: 0
max-row: 0
)))
(dboard:setup-tabdat dat)
(dboard:setup-num-rows dat)
dat))
(define (dboard:setup-tabdat tabdat)
(dboard:tabdat-dbdir-set! tabdat (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
| > > | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 |
filters-changed: #f
header: #f
hide-empty-runs: #f
hide-not-hide-button: #f
hide-not-hide: #t
item-test-names: '()
last-db-update: 0
last-data-update: 0
not-done-runs: '()
done-runs: '()
num-tests: 15
numruns: 16
path-run-ids: (make-hash-table)
run-ids: (make-hash-table)
run-keys: (make-hash-table)
searchpatts: (make-hash-table)
start-run-offset: 0
start-test-offset: 0
state-ignore-hash: (make-hash-table)
status-ignore-hash: (make-hash-table)
xadj: 0
yadj: 0
view-changed: #t
run-start-row: 0
max-row: 0
runs-mutex: (make-mutex)
)))
(dboard:setup-tabdat dat)
(dboard:setup-num-rows dat)
dat))
(define (dboard:setup-tabdat tabdat)
(dboard:tabdat-dbdir-set! tabdat (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
|
| ︙ | ︙ | |||
309 310 311 312 313 314 315 316 317 318 319 320 321 322 | ;; used to keep the rundata from rmt:get-tests-for-run ;; in sync. ;; (defstruct dboard:rundat run tests-drawn ;; list of id's already drawn on screen tests-notdrawn ;; list of id's NOT already drawn tests ;; hash of id => testdat tests-by-name ;; hash of testfullname => testdat key-vals last-update ;; last query to db got records from before last-update ) (define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f)(last-update -100)) | > | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 | ;; used to keep the rundata from rmt:get-tests-for-run ;; in sync. ;; (defstruct dboard:rundat run tests-drawn ;; list of id's already drawn on screen tests-notdrawn ;; list of id's NOT already drawn rowsused ;; hash of lists covering what areas used - replace with quadtree tests ;; hash of id => testdat tests-by-name ;; hash of testfullname => testdat key-vals last-update ;; last query to db got records from before last-update ) (define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f)(last-update -100)) |
| ︙ | ︙ | |||
1116 1117 1118 1119 1120 1121 1122 | (define (dashboard:run-times commondat tabdat #!key (tab-num #f)) (let ((drawing (vg:drawing-new)) (run-times-tab-updater (lambda () (debug:catch-and-dump (lambda () (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (if tabdat | > > | > > > > > | 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 |
(define (dashboard:run-times commondat tabdat #!key (tab-num #f))
(let ((drawing (vg:drawing-new))
(run-times-tab-updater (lambda ()
(debug:catch-and-dump
(lambda ()
(let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
(if tabdat
(let ((last-data-update (dboard:tabdat-last-data-update tabdat))
(now-time (current-seconds)))
(dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
(if (> (- now-time last-data-update) 5)
(begin
(dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
(dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
(dboard:tabdat-last-data-update-set! tabdat now-time)))))))
"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
(let* ((tb (iup:treebox
|
| ︙ | ︙ | |||
1138 1139 1140 1141 1142 1143 1144 | (lambda () (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (print "run-path: " run-path) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) | | < > | > > | 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 |
(lambda ()
(let* ((run-path (tree:node->path obj id))
(run-id (tree-path->run-id tabdat (cdr run-path))))
(print "run-path: " run-path)
(if (number? run-id)
(begin
(dboard:tabdat-curr-run-id-set! tabdat run-id)
(dboard:tabdat-view-changed-set! tabdat #t))
(debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))))
"treebox"))
;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
)))
(dboard:tabdat-runs-tree-set! tabdat tb)
tb)
(iup:vbox
(let* ((cnv-obj (iup:canvas
;; #:size "500x400"
#:expand "YES"
#:scrollbar "YES"
#:posx "0.5"
#:posy "0.5"
#:action (make-canvas-action
(lambda (c xadj yadj)
(debug:catch-and-dump
(lambda ()
(if (not (dboard:tabdat-cnv tabdat))
(let ((cnv (dboard:tabdat-cnv tabdat)))
(dboard:tabdat-cnv-set! tabdat c)
(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)
|
| ︙ | ︙ | |||
2414 2415 2416 2417 2418 2419 2420 | (hash-table-keys test-ids-by-name)) ;; finally sort by the event time of the first test (sort (hash-table-values test-ids-by-name) (lambda (a b) (< (db:test-get-event_time (hash-table-ref testsdat (car a))) (db:test-get-event_time (hash-table-ref testsdat (car b)))))))))) | > > | < < < < < < < < | | > > > > | | | | | | | | | | | < < < | | | | | | | > > > > > > > > > > > > > > > | > > > > | > > > > > | > > > > > > > > > > > > < < < < < < < < < < < < < < < < | < < < < < < < < < < | > > > > > | | | | | | | | | | | | | | | | > | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | > > > > > > | | | | | | | | | | | | | > > | | | | | | > | < < < < < | | | | | | | | > | | | | | | | | | | | > | | < < < < | 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 |
(hash-table-keys test-ids-by-name))
;; finally sort by the event time of the first test
(sort (hash-table-values test-ids-by-name)
(lambda (a b)
(< (db:test-get-event_time (hash-table-ref testsdat (car a)))
(db:test-get-event_time (hash-table-ref testsdat (car b))))))))))
;; run times tab data updater
;;
(define (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
(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
(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))
(run-ids (sort (filter number? (hash-table-keys runs-hash))
(lambda (a b)
(let* ((record-a (hash-table-ref runs-hash a))
(record-b (hash-table-ref runs-hash b))
(time-a (db:get-value-by-header record-a runs-header "event_time"))
(time-b (db:get-value-by-header record-b runs-header "event_time")))
(< time-a time-b)))))
(tb (dboard:tabdat-runs-tree tabdat))
(num-runs (length (hash-table-keys runs-hash)))
(update-start-time (current-seconds))
(inc-mode #f))
;; fill in the tree
(if (and tb
(not inc-mode))
(for-each
(lambda (run-id)
(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
(key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key))
(dboard:tabdat-keys tabdat)))
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name)))
(existing (tree:find-node tb run-path)))
(if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
(begin
(hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
;; 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")
(update-rundat tabdat
"%" ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%")
100 ;; (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 '()))
(for-each (lambda (key)
(if (not (equal? key "runname"))
(let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
(if val (set! res (cons (list key val) res))))))
(dboard:tabdat-dbkeys tabdat))
res))))
;; run times canvas updater
;;
(define (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
(let ((cnv (dboard:tabdat-cnv tabdat))
(dwg (dboard:tabdat-drawing tabdat))
(mtx (dboard:tabdat-runs-mutex tabdat)))
(if (and cnv dwg)
(begin
(mutex-lock! mtx)
(canvas-clear! cnv)
(vg:draw dwg tabdat)
(mutex-unlock! mtx)
(dboard:tabdat-view-changed-set! tabdat #f)))))
;; 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
(let* ((canvas-margin 10)
(row-height 10)
(not-done-runs (dboard:tabdat-not-done-runs tabdat))
(mtx (dboard:tabdat-runs-mutex tabdat)))
(if tabdat
(let* ((drawing (dboard:tabdat-drawing tabdat))
(runslib (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
(compute-start (current-seconds)))
(vg:drawing-xoff-set! drawing (dboard:tabdat-xadj tabdat))
(vg:drawing-yoff-set! drawing (dboard:tabdat-yadj tabdat))
(let ((allruns (dboard:tabdat-allruns tabdat))
(rowhash (make-hash-table)) ;; store me in tabdat
(cnv (dboard:tabdat-cnv tabdat)))
(print "allruns: " allruns)
(let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv)))
;; (print "allruns: " allruns)
(let runloop ((rundat (car allruns))
(runtal (cdr allruns))
(run-num 1)
(doneruns '())
(run-start-row 0))
(let* ((run (dboard:rundat-run rundat))
(key-val-dat (dboard:rundat-key-vals rundat))
(run-id (db:get-value-by-header run (dboard:tabdat-header tabdat) "id"))
(key-vals (append key-val-dat
(list (let ((x (db:get-value-by-header run (dboard:tabdat-header tabdat) "runname")))
(if x x "")))))
(run-key (string-intersperse key-vals "\n"))
(run-full-name (string-intersperse key-vals "/")))
(if (not (vg:lib-get-component runslib run-full-name))
(let* ((hierdat (dboard:tests-sort-by-time-group-by-item (dboard:rundat-tests rundat))) ;; hierarchial list of ids
(tests-ht (dboard:rundat-tests rundat))
(all-tids (hash-table-keys tests-ht)) ;; (apply append hierdat)) ;; was testsdat
(testsdat (hash-table-values tests-ht))
(runcomp (vg:comp-new));; new component for this run
(rows-used (make-hash-table)) ;; keep track of what parts of the rows are used here row1 = (obj1 obj2 ...)
;; (row-height 4)
(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))))
(num-tests (length hierdat))
(tot-tests (length testsdat))
(new-run-start-row (+ (dboard:tabdat-max-row tabdat) 2)))
;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx)
(mutex-lock! mtx)
(vg:add-comp-to-lib runslib run-full-name runcomp)
(mutex-unlock! mtx)
;; (set! run-start-row (+ max-row 2))
;; (dboard:tabdat-start-row-set! tabdat (+ new-run-start-row 1))
;; get tests in list sorted by event time ascending
(let testsloop ((test-ids (car hierdat)) ;; loop on tests (NOTE: not items!)
(tests-tal (cdr hierdat))
(test-num 1))
(let ((test-objs '())
(iterated (> (length test-ids) 1))
(first-rownum #f)
(num-items (length test-ids)))
(let testitemloop ((test-id (car test-ids)) ;; loop on test or test items
(tidstal (cdr test-ids))
(item-num 1))
(let* ((testdat (hash-table-ref tests-ht test-id))
(event-time (maptime (db:test-get-event_time testdat)))
(run-duration (* timescale (db:test-get-run_duration testdat)))
(end-time (+ event-time run-duration))
(test-name (db:test-get-testname testdat))
(item-path (db:test-get-item-path testdat))
(state (db:test-get-state testdat))
(status (db:test-get-status testdat))
(test-fullname (conc test-name "/" item-path))
(name-color (gutils:get-color-for-state-status state status)))
;; (print "event_time: " (db:test-get-event_time testdat) " mapped event_time: " event-time)
;; (print "run-duration: " (db:test-get-run_duration testdat) " mapped run_duration: " run-duration)
(if (> item-num 50)
(if (eq? 0 (modulo item-num 50))
(print "processing " run-num " of " num-runs " runs " item-num " of " num-items " of test " test-name ", " test-num " of " num-tests " tests")))
(let loop ((rownum new-run-start-row)) ;; (+ start-row 1)))
(dboard:tabdat-max-row-set! tabdat (max rownum (dboard:tabdat-max-row tabdat))) ;; track the max row used
(if (dashboard:row-collision rowhash rownum event-time end-time)
(loop (+ rownum 1))
(let* ((lly (- sizey (* rownum row-height)))
(uly (+ lly row-height))
(obj (vg:make-rect-obj event-time lly end-time uly
fill-color: (vg:iup-color->number (car name-color))
text: (if iterated item-path test-name)
font: "Helvetica -10")))
;; (if iterated
;; (dashboard:add-bar rowhash (- rownum 1) event-time end-time num-rows: (+ 1 num-items))
(if (not first-rownum)
(begin
(dashboard:row-collision rowhash (- rownum 1) event-time end-time num-rows: num-items)
(set! first-rownum rownum)))
(dashboard:add-bar rowhash rownum event-time end-time)
(vg:add-obj-to-comp runcomp obj)
(set! test-objs (cons obj test-objs)))))
;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
(let ((newdoneruns (cons rundat doneruns)))
(if (not (null? tidstal))
(if #f ;; (> (- (current-seconds) update-start-time) 5)
(begin
(print "drawing runs taking too long.... have " (length runtal) " remaining")
;; (dboard:tabdat-done-runs-set! tabdat newdoneruns) ;; taking too long? stop here!
;; (dboard:tabdat-not-done-runs-set! tabdat runtal)
)
(testitemloop (car tidstal)(cdr tidstal)(+ item-num 1)))))))
;; If it is an iterated test put box around it now.
(if iterated
(let* ((xtents (vg:get-extents-for-objs drawing test-objs))
(llx (- (car xtents) 5))
(lly (- (cadr xtents) 10))
(ulx (+ 5 (caddr xtents)))
(uly (+ 0 (cadddr xtents))))
(dashboard:add-bar rowhash first-rownum llx ulx num-rows: num-items)
(vg:add-obj-to-comp runcomp (vg:make-rect-obj llx lly ulx uly
text: (db:test-get-testname (hash-table-ref tests-ht (car test-ids)))
font: "Helvetica -10"))))
(if (not (null? tests-tal))
(if #f ;; (> (- (current-seconds) update-start-time) 5)
(print "drawing runs taking too long")
(testsloop (car tests-tal)(cdr tests-tal)(+ test-num 1))))))
;; placeholder box
(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 1))
(let ((y (- sizey (* (dboard:tabdat-max-row tabdat) row-height))))
(vg:add-obj-to-comp runcomp (vg:make-rect-obj 0 y 0 y)))
;; instantiate the component
(mutex-lock! mtx)
(let* ((extents (vg:components-get-extents drawing runcomp))
(new-xtnts (apply vg:grow-rect 5 5 extents))
(llx (list-ref new-xtnts 0))
(lly (list-ref new-xtnts 1))
(ulx (list-ref new-xtnts 2))
(uly (list-ref new-xtnts 3))
) ;; (vg:components-get-extents d1 c1)))
(vg:add-obj-to-comp runcomp (vg:make-rect-obj llx lly ulx uly text: run-full-name))
(vg:instantiate drawing "runslib" run-full-name run-full-name 0 0))
(mutex-unlock! mtx)
(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 1)))
;; end of the run handling loop
(let ((newdoneruns (cons rundat doneruns)))
(if (null? runtal)
(begin
(dboard:tabdat-not-done-runs-set! tabdat '())
(dboard:tabdat-done-runs-set! tabdat allruns))
(if #f ;; (> (- (current-seconds) update-start-time) 5)
(begin
(print "drawing runs taking too long.... have " (length runtal) " remaining")
;; (dboard:tabdat-done-runs-set! tabdat newdoneruns) ;; taking too long? stop here!
;; (time (vg:draw (dboard:tabdat-drawing tabdat) #t))
(dboard:tabdat-not-done-runs-set! tabdat runtal))
(runloop (car runtal)(cdr runtal) (+ run-num 1) newdoneruns new-run-start-row)))))))
)))
(debug:print 2 *default-log-port* "no tabdat for run-times-tab-updater"))))
(define (dashboard:runs-tab-updater commondat tab-num)
(debug:catch-and-dump
(lambda ()
(let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
|
| ︙ | ︙ |
Modified vg.scm from [99d7742afe] to [e3c87e0aa9].
| ︙ | ︙ | |||
326 327 328 329 330 331 332 333 334 335 336 337 338 339 |
(if (or (not llx)(< ollx llx))(set! llx ollx))
(if (or (not lly)(< olly lly))(set! lly olly))
(if (or (not ulx)(> oulx ulx))(set! ulx oulx))
(if (or (not uly)(> ouly uly))(set! uly ouly))))
xtnt-lst)
(list llx lly ulx uly)))
;;======================================================================
;; color
;;======================================================================
(define (vg:rgb->number r g b #!key (a 0))
(bitwise-ior
(arithmetic-shift a 24)
| > > > | 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 |
(if (or (not llx)(< ollx llx))(set! llx ollx))
(if (or (not lly)(< olly lly))(set! lly olly))
(if (or (not ulx)(> oulx ulx))(set! ulx oulx))
(if (or (not uly)(> ouly uly))(set! uly ouly))))
xtnt-lst)
(list llx lly ulx uly)))
(define (vg:lib-get-component lib instname)
(hash-table-ref/default (vg:lib-comps lib) instname #f))
;;======================================================================
;; color
;;======================================================================
(define (vg:rgb->number r g b #!key (a 0))
(bitwise-ior
(arithmetic-shift a 24)
|
| ︙ | ︙ | |||
578 579 580 581 582 583 584 |
(append pts pts))))
(define (vg:draw drawing draw-mode . instnames)
(let ((insts (vg:drawing-insts drawing))
(res '()))
(for-each
(lambda (instname)
| | > | | | | | | | | | | | > | 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 |
(append pts pts))))
(define (vg:draw drawing draw-mode . instnames)
(let ((insts (vg:drawing-insts drawing))
(res '()))
(for-each
(lambda (instname)
(let* ((inst (hash-table-ref/default insts instname #f)))
(if inst
(let* ((libname (vg:inst-libname inst))
(compname (vg:inst-compname inst))
(comp (vg:get-component drawing libname compname)))
;; (print "comp: " comp)
(for-each
(lambda (obj)
;; (print "obj: " (vg:obj-pts obj))
(let ((obj-xfrmd (vg:map-obj drawing inst obj)))
;; (print "obj-xfrmd: " (vg:obj-pts obj-xfrmd))
(set! res (cons (vg:draw-obj drawing obj-xfrmd draw: draw-mode) res)))) ;;
(vg:comp-objs comp)))
(print "no such instance " instname))))
(if (null? instnames)
(hash-table-keys insts)
instnames))
res)) ;; (hash-table-values insts))))
|