Overview
| Comment: | Merged with v1.61 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | popup_menu |
| Files: | files | file ages | folders |
| SHA1: |
a05a9a1fd3bd6078087e0ff4dd85005a |
| User & Date: | ritikaag on 2016-08-02 15:43:39 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-08-16
| ||
| 14:42 | Resolved merge conflict Closed-Leaf check-in: 2d12c06379 user: ritikaag tags: popup_menu | |
|
2016-08-02
| ||
| 15:43 | Merged with v1.61 check-in: a05a9a1fd3 user: ritikaag tags: popup_menu | |
| 11:43 | Added crude labels for graph check-in: 339230da14 user: mrwellan tags: v1.61 | |
|
2016-08-01
| ||
| 23:59 | Copied in Ritika's graph label changes and hacked a little check-in: dfa2cc9171 user: matt tags: v1.61 | |
| 15:13 | slight improvements to layout check-in: 8ff975d7ca user: mrwellan tags: v1.61 | |
| 14:19 | Merged with main branch check-in: deb7dcac14 user: ritikaag tags: popup_menu | |
Changes
Modified common.scm from [62abc5daf1] to [1aafdfd6ed].
| ︙ | ︙ | |||
977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 |
(time->string
(seconds->local-time sec) "%yww%V.%w"))
(define (seconds->year-work-week/day-time sec)
(time->string
(seconds->local-time sec) "%Yww%V.%w %H:%M"))
(define (seconds->quarter sec)
(case (string->number
(time->string
(seconds->local-time sec)
"%m"))
((1 2 3) 1)
((4 5 6) 2)
((7 8 9) 3)
((10 11 12) 4)
(else #f)))
;;======================================================================
;; C O L O R S
;;======================================================================
(define (common:name->iup-color name)
(case (string->symbol (string-downcase name))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 |
(time->string
(seconds->local-time sec) "%yww%V.%w"))
(define (seconds->year-work-week/day-time sec)
(time->string
(seconds->local-time sec) "%Yww%V.%w %H:%M"))
(define (seconds->year-week/day-time sec)
(time->string
(seconds->local-time sec) "%Yw%V.%w %H:%M"))
(define (seconds->quarter sec)
(case (string->number
(time->string
(seconds->local-time sec)
"%m"))
((1 2 3) 1)
((4 5 6) 2)
((7 8 9) 3)
((10 11 12) 4)
(else #f)))
;; given span of seconds tstart to tend
;; find start time to mark and mark delta
;;
(define (common:find-start-mark-and-mark-delta tstart tend)
(let* ((deltat (- tend tstart))
(result #f)
(min 60)
(hr (* 60 60))
(day (* 24 hr))
(yr (* 365 day)) ;; year
(mo (/ yr 12))
(wk (* day 7)))
(for-each
(lambda (max-blks)
(for-each
(lambda (span) ;; 5 2 1
(if (not result)
(for-each
(lambda (timeunit timesym) ;; year month day hr min sec
(if (not result)
(let* ((time-blk (* span timeunit))
(num-blks (quotient deltat time-blk)))
(if (and (> num-blks 4)(< num-blks max-blks))
(let ((first (* (quotient tstart time-blk) time-blk)))
(set! result (list span timeunit time-blk first timesym))
)))))
(list yr mo wk day hr min 1)
'( y mo w d h m s))))
(list 8 6 5 2 1)))
'(5 10 15 20 30 40 50 500))
(apply values result)))
;;======================================================================
;; C O L O R S
;;======================================================================
(define (common:name->iup-color name)
(case (string->symbol (string-downcase name))
|
| ︙ | ︙ |
Modified dashboard.scm from [fef9966a31] to [190459f5ad].
| ︙ | ︙ | |||
1155 1156 1157 1158 1159 1160 1161 | #:addexpanded "NO" #:selection-cb (lambda (obj id state) (debug:catch-and-dump (lambda () (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) | | > | 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 | #:addexpanded "NO" #:selection-cb (lambda (obj id state) (debug:catch-and-dump (lambda () (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print "run-path: " run-path) (dboard:tabdat-layout-update-ok-set! tabdat #f) (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) |
| ︙ | ︙ | |||
1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 | (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) ;; (dashboard:update-run-summary-tab) ) (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix | > | 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 | (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) (dboard:tabdat-layout-update-ok-set! tabdat #f) ;; (dashboard:update-run-summary-tab) ) (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix |
| ︙ | ︙ | |||
1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 | (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) ;; (dashboard:update-run-summary-tab) ) (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix | > | 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 | (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) (dboard:tabdat-layout-update-ok-set! tabdat #f) ;; (dashboard:update-run-summary-tab) ) (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix |
| ︙ | ︙ | |||
1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 | ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) ;; (dashboard:update-new-view-tab) ) (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix #:expand "YES" | > | 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 | ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) ;; (dashboard:update-new-view-tab) (dboard:tabdat-layout-update-ok-set! tabdat #f) ) (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix #:expand "YES" |
| ︙ | ︙ | |||
2297 2298 2299 2300 2301 2302 2303 | ;; controls )) ;; (data (dboard:tabdat-init (make-d:data))) (tabs (iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (debug:catch-and-dump (lambda () | | > > | > > > > | 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 | ;; controls )) ;; (data (dboard:tabdat-init (make-d:data))) (tabs (iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (debug:catch-and-dump (lambda () (let* ((tab-num (dboard:commondat-curr-tab-num commondat)) (tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (dboard:tabdat-layout-update-ok-set! tabdat #f)) (dboard:commondat-curr-tab-num-set! commondat curr) (let* ((tab-num (dboard:commondat-curr-tab-num commondat)) (tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (dboard:commondat-please-update-set! commondat #t) (dboard:tabdat-layout-update-ok-set! tabdat #t))) "tabchangepos")) (dashboard:summary commondat stats-dat tab-num: 0) runs-view (dashboard:one-run commondat onerun-dat tab-num: 2) ;; (dashboard:new-view db data new-view-dat tab-num: 3) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4) |
| ︙ | ︙ | |||
2326 2327 2328 2329 2330 2331 2332 | (dboard:common-set-tabdat! commondat 0 stats-dat) (dboard:common-set-tabdat! commondat 1 runs-dat) (dboard:common-set-tabdat! commondat 2 onerun-dat) (dboard:common-set-tabdat! commondat 3 runcontrols-dat) (dboard:common-set-tabdat! commondat 4 runtimes-dat) (iup:vbox tabs | | > | 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 |
(dboard:common-set-tabdat! commondat 0 stats-dat)
(dboard:common-set-tabdat! commondat 1 runs-dat)
(dboard:common-set-tabdat! commondat 2 onerun-dat)
(dboard:common-set-tabdat! commondat 3 runcontrols-dat)
(dboard:common-set-tabdat! commondat 4 runtimes-dat)
(iup:vbox
tabs
;; controls
))))
(vector keycol lftcol header runsvec)))
(define (dboard:setup-num-rows tabdat)
(if (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS" ))
(begin
(dboard:tabdat-num-tests-set! tabdat (string->number
|
| ︙ | ︙ | |||
2668 2669 2670 2671 2672 2673 2674 | res-ht) #f))))) ;; graph data ;; tsc=timescale, tfn=function; time->x ;; (define (dboard:graph commondat tabdat tabnum llx lly ulx uly tstart tend tsc tfn compname cmargin) | | | | | | | | > > > > > > > > > > > > > > > > > > > > > | | | > > | > > > > > > > | | | > | | < | | 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 |
res-ht)
#f)))))
;; graph data
;; tsc=timescale, tfn=function; time->x
;;
(define (dboard:graph commondat tabdat tabnum llx lly ulx uly tstart tend tsc tfn compname cmargin)
(let* ((dwg (dboard:tabdat-drawing tabdat))
(lib (vg:get/create-lib dwg "runslib"))
(cnv (dboard:tabdat-cnv tabdat))
(dur (- tstart tend)) ;; time duration
(cmp (vg:get-component dwg "runslib" compname))
(cfg (configf:get-section *configdat* "graph"))
(stdcolor (vg:rgb->number 120 130 140))
(delta-y (- uly lly)))
(vg:add-obj-to-comp
cmp
(vg:make-rect-obj llx lly ulx uly))
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- (tfn tstart) 10)(- lly 10)(seconds->year-week/day-time tstart)))
(let*-values (((span timeunit time-blk first timesym) (common:find-start-mark-and-mark-delta tstart tend)))
(let loop ((mark first)
(count 0))
(let* ((smark (tfn mark)) ;; scale the mark
(mark-delta (quotient (- mark tstart) time-blk)) ;; how far from first mark
(label (conc (* count span) timesym))) ;; was mark-delta
(if (> count 2)
(begin
(vg:add-obj-to-comp
cmp
(vg:make-rect-obj (- smark 1)(- lly 2)(+ smark 1) lly))
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- smark 1)(- lly 10) label))))
(if (< mark (- tend time-blk))
(loop (+ mark time-blk)(+ count 1))))))
(for-each
(lambda (cf)
(let* ((alldat (dboard:graph-read-data (cadr cf) tstart tend)))
(if alldat
(for-each
(lambda (fieldn)
(let* ((dat (hash-table-ref alldat fieldn ))
(vals (map (lambda (x)(vector-ref x 2)) dat)))
(print "RA : dat " dat " vals " vals " fieldn " fieldn " lly " lly " llx " llx)
(if (not (null? vals))
(let* ((maxval (apply max vals))
(minval (apply min vals))
(yoff (- minval lly)) ;; minval))
(deltaval (- maxval minval))
(yscale (/ delta-y (if (eq? deltaval 0) 1 deltaval)))
(yfunc (lambda (y)(+ lly (* yscale (- y minval)))))) ;; (lambda (y)(* (+ y yoff) yscale))))
(print (car cf) "; maxval: " maxval " minval: " minval " deltaval: " deltaval " yscale: " yscale)
(yfunc (lambda (y)(+ lly (* yscale (- y minval)))))) ;; (lambda (y)(* (+ y yoff) yscale))))
;; (print (car cf) "; maxval: " maxval " minval: " minval " deltaval: " deltaval " yscale: " yscale)
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- llx 10)(yfunc maxval) (conc maxval)))
(vg:add-obj-to-comp
cmp
(vg:make-text-obj (- llx 10)(yfunc minval) (conc minval)))
(fold
(lambda (next prev) ;; #(time ? val) #(time ? val)
(if prev
(let* ((yval (vector-ref prev 2))
(last-tval (tfn (vector-ref prev 0)))
(last-yval (yfunc yval)) ;; (+ lly (* yscale (vector-ref prev 2))))
(curr-tval (tfn (vector-ref next 0))))
(if (>= curr-tval last-tval)
(vg:add-obj-to-comp
cmp
(vg:make-rect-obj last-tval lly curr-tval last-yval ;; (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
fill-color: stdcolor
line-color: stdcolor))
(print "ERROR: curr-tval is not > last-tval; curr-tval " curr-tval ", last-tval " last-tval))))
next)
;; for init create vector tstart,0
#f ;; (vector tstart minval minval)
dat)
;; (for-each
;; (lambda (dpt)
;; (let* ((tval (vector-ref dpt 0))
;; (yval (vector-ref dpt 2))
;; (stval (tfn tval))
;; (syval (yfunc yval)))
;; (vg:add-obj-to-comp
;; cmp
;; (vg:make-rect-obj (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
;; fill-color: stdcolor))))
;; dat)
)))) ;; for each data point in the series
(hash-table-keys alldat)))))
cfg)))
;; 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 escapeloop ((escape #f))
(if (and (not escape)
tabdat)
(let* ((canvas-margin 10)
(not-done-runs (dboard:tabdat-not-done-runs tabdat))
(mtx (dboard:tabdat-runs-mutex tabdat))
(drawing (dboard:tabdat-drawing tabdat))
(runslib (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
(allruns (dboard:tabdat-allruns tabdat))
(num-runs (length allruns))
(cnv (dboard:tabdat-cnv tabdat))
(compact-layout (dboard:tabdat-compact-layout tabdat))
(row-height (if compact-layout 2 10))
(graph-height 120)
(run-to-run-margin 25))
(dboard:tabdat-layout-update-ok-set! tabdat #t)
(if (canvas? cnv)
(let*-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv))
((calc-y) (lambda (rownum)
(- (/ sizey 2)
(* rownum row-height))))
|
| ︙ | ︙ | |||
2817 2818 2819 2820 2821 2822 2823 | (print "timeoffset: " timeoffset " timescale: " timescale " run-duration: " (seconds->hr-min-sec run-duration) " width: " width " sec-per-50pt: " sec-per-50pt) ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx) (mutex-lock! mtx) (vg:add-comp-to-lib runslib run-full-name runcomp) ;; Have to keep moving the instantiated box as it is anchored at the lower left ;; this should have worked for x in next statement? (maptime run-start) ;; add 60 to make room for the graph | | | 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 | (print "timeoffset: " timeoffset " timescale: " timescale " run-duration: " (seconds->hr-min-sec run-duration) " width: " width " sec-per-50pt: " sec-per-50pt) ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx) (mutex-lock! mtx) (vg:add-comp-to-lib runslib run-full-name runcomp) ;; Have to keep moving the instantiated box as it is anchored at the lower left ;; this should have worked for x in next statement? (maptime run-start) ;; add 60 to make room for the graph (vg:instantiate drawing "runslib" run-full-name run-full-name 8 (- (calc-y curr-run-start-row) (+ 5 graph-height run-to-run-margin))) (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)) |
| ︙ | ︙ | |||
2895 2896 2897 2898 2899 2900 2901 | ;; This is the box around the tests of an iterated test (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))) line-color: (vg:rgb->number 0 0 255 a: 128) font: "Helvetica -10")) ;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat)) (dboard:tabdat-view-changed-set! tabdat #t))) ;; trigger a redraw | | < | > > | < | > > | | | | > | | | 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 |
;; This is the box around the tests of an iterated test
(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)))
line-color: (vg:rgb->number 0 0 255 a: 128)
font: "Helvetica -10"))
;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat))
(dboard:tabdat-view-changed-set! tabdat #t))) ;; trigger a redraw
(if (dboard:tabdat-layout-update-ok tabdat)
(testitemloop (car tidstal)(cdr tidstal)(+ item-num 1) new-test-objs)
(escapeloop #t) ;; (dboard:tabdat-layout-update-ok tabdat)
)))))
;; If it is an iterated test put box around it now.
(if (not (null? tests-tal))
(if #f ;; (> (- (current-seconds) update-start-time) 5)
(print "drawing runs taking too long")
(if (dboard:tabdat-layout-update-ok tabdat)
(testsloop (car tests-tal)(cdr tests-tal)(+ test-num 1))
(escapeloop #t) ;; (dboard:tabdat-layout-update-ok tabdat)
)))))
;; placeholder box
(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 1))
;; (let ((y (calc-y (dboard:tabdat-max-row tabdat)))) ;; (- 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
(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))
(outln (vg:make-rect-obj -5 lly ulx uly
text: run-full-name
line-color: (vg:rgb->number 255 0 255 a: 128))))
; (vg:components-get-extents d1 c1)))
;; this is the box around the run
(mutex-lock! mtx)
(vg:add-obj-to-comp runcomp outln)
(mutex-unlock! mtx)
;; this is where we have enough info to place the graph
(dboard:graph commondat tabdat tab-num -5 (+ uly 10) ulx (+ uly graph-height 3) run-start run-end timescale maptime run-full-name canvas-margin)
(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat)(quotient (+ graph-height 40 3) row-height)))
;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat))
))
;; end of the run handling loop
(if (not (dboard:tabdat-layout-update-ok tabdat))
(escapeloop #t) ;; (dboard:tabdat-layout-update-ok tabdat)
(let ((newdoneruns (cons rundat doneruns)))
(if (null? runtal)
(begin
(dboard:rundat-data-changed-set! rundat #f)
(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))
(begin
(if (dboard:tabdat-layout-update-ok tabdat)
(runloop (car runtal)(cdr runtal) (+ run-num 1) newdoneruns)
(escapeloop #t) ;; (dboard:tabdat-layout-update-ok tabdat)
))))))))) ;; 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)))
|
| ︙ | ︙ |