Overview
Context
Changes
Modified dashboard.scm
from [020630095d]
to [2db07e95fc].
︙ | | |
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
|
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
|
-
+
+
-
-
+
+
-
+
-
+
+
-
+
|
(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)))
(mtx (dboard:tabdat-runs-mutex tabdat))
(compute-start (current-seconds)))
(if tabdat
(let* ((drawing (dboard:tabdat-drawing tabdat))
(runslib (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
(compute-start (current-seconds)))
(runslib (vg:get/create-lib drawing "runslib"))) ;; creates and adds lib
(print "layout start: " compute-start)
(let* ((allruns (dboard:tabdat-allruns tabdat))
(num-runs (length allruns))
(cnv (dboard:tabdat-cnv tabdat)))
(print "allruns: " allruns)
;; (print "allruns: " allruns)
(let*-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv))
((calc-y) (lambda (rownum)
(- (/ sizey 2)
(* rownum row-height)))))
;; (print "allruns: " allruns)
(let runloop ((rundat (car allruns))
(runtal (cdr allruns))
(run-num 1)
(doneruns '()))
(doneruns '())
(run-draw-start-time (current-seconds)))
(let* ((run (dboard:rundat-run rundat))
(rowhash (make-hash-table)) ;; store me in tabdat
(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 "/"))
(curr-run-start-row (dboard:tabdat-max-row tabdat)))
(print "run: " run-full-name " curr-run-start-row: " curr-run-start-row)
;; (print "run: " run-full-name " curr-run-start-row: " curr-run-start-row)
(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 ...)
|
︙ | | |
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
|
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
|
+
+
-
+
|
(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))
(begin
(print "Layout end: " (current-seconds))
(runloop (car runtal)(cdr runtal) (+ run-num 1) newdoneruns))))))) ;; new-run-start-row
(runloop (car runtal)(cdr runtal) (+ run-num 1) newdoneruns (current-seconds))))))))) ;; 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 [675e34e5b3]
to [5b28628acc].
︙ | | |
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
|
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
|
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
|
res))
;;======================================================================
;; instances
;;======================================================================
(define (vg:instances-get-extents drawing . instance-names)
(let ((xtnt-lst (vg:draw drawing #f))
(llx #f)
(lly #f)
(ulx #f)
(uly #f))
(let ((xtnt-lst (vg:draw drawing #f)))
(if (null? xtnt-lst)
#f
(let loop ((extents (car xtnt-lst))
(tal (cdr xtnt-lst))
(llx #f)
(lly #f)
(ulx #f)
(uly #f))
(for-each
(lambda (extents)
(let* ((ollx (list-ref extents 0))
(olly (list-ref extents 1))
(oulx (list-ref extents 2))
(ouly (list-ref extents 3)))
(if (or (not llx)(< ollx llx))(set! llx ollx))
(let ((nllx (if llx (min llx (list-ref extents 0))(list-ref extents 0)))
(nlly (if lly (min lly (list-ref extents 1))(list-ref extents 1)))
(nulx (if ulx (max ulx (list-ref extents 2))(list-ref extents 2)))
(nuly (if uly (max uly (list-ref extents 3))(list-ref extents 3))))
(if (null? tal)
(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)))
(list llx lly ulx uly)
(loop (car tal)(cdr tal) nllx nlly nulx nuly)))))))
(define (vg:lib-get-component lib instname)
(hash-table-ref/default (vg:lib-comps lib) instname #f))
;;======================================================================
;; color
;;======================================================================
|
︙ | | |
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
|
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
|
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(canvas-foreground-set! cnv prev-foreground-color)))
(if cnv
(if (eq? draw 'get-extents)
(let-values (((xmax ymax)(canvas-text-size cnv text)))
(append pts (list (+ llx xmax)(+ lly ymax)))) ;; will be wrong if text is rotated?
(append pts pts))
(append pts pts))))
(define (vg:draw drawing draw-mode . instnames)
(define (vg:draw-inst drawing inst #!key (draw-mode #t)(prev-extents '()))
(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)))
(let* ((libname (vg:inst-libname inst))
(compname (vg:inst-compname inst))
(comp (vg:get-component drawing libname compname))
(objs (vg:comp-objs comp)))
;; (print "comp: " comp)
(if (null? objs)
prev-extents
(let loop ((obj (car objs))
(tal (cdr objs))
(res prev-extents))
(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)))) ;;
(newres (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))))
(if (null? tal)
newres
(loop (car tal)(cdr tal) newres)))))))
(define (vg:draw drawing draw-mode . instnames)
(let* ((insts (vg:drawing-insts drawing))
(all-inst-names (hash-table-keys insts))
(master-list (if (null? instnames)
all-inst-names
instnames)))
(if (null? master-list)
'()
(let loop ((instname (car master-list))
(tal (cdr master-list))
(res '()))
(let* ((inst (hash-table-ref/default insts instname #f))
(newres (if inst
(vg:draw-inst drawing inst draw-mode: draw-mode prev-extents: res)
res)))
(if (null? tal)
newres
(loop (car tal)(cdr tal) newres)))))))
|
Added vg_records.scm version [c48b950cb7].