Overview
| Comment: | default is to start with compact view |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.61 |
| Files: | files | file ages | folders |
| SHA1: |
e3e3f2e657d6a76668adb29865bf5a63 |
| User & Date: | matt on 2016-07-25 21:45:39 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-07-26
| ||
| 02:26 | Almost useful now check-in: 46fe8c7d3d user: matt tags: v1.61 | |
|
2016-07-25
| ||
| 21:45 | default is to start with compact view check-in: e3e3f2e657 user: matt tags: v1.61 | |
| 20:31 | Added compact view check-in: 3cd616b626 user: matt tags: v1.61 | |
Changes
Modified dashboard.scm from [864e15d8e9] to [4a5065fbc2].
| ︙ | ︙ | |||
256 257 258 259 260 261 262 | (define (dboard:tabdat-make-data) (let ((dat (make-dboard:tabdat allruns-by-id: (make-hash-table) allruns: '() ;; list of run records (vectors) buttondat: (make-hash-table) curr-test-ids: (make-hash-table) command: "" | | | 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 | (define (dboard:tabdat-make-data) (let ((dat (make-dboard:tabdat allruns-by-id: (make-hash-table) allruns: '() ;; list of run records (vectors) buttondat: (make-hash-table) curr-test-ids: (make-hash-table) command: "" compact-layout: #t dbdir: #f filters-changed: #f header: #f hide-empty-runs: #f hide-not-hide-button: #f hide-not-hide: #t item-test-names: '() |
| ︙ | ︙ | |||
1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 |
(dboard:tabdat-runs-tree-set! tabdat tb)
tb)
(iup:hbox
(iup:toggle
"Compact layout"
#:fontsize 8
#:expand "YES"
#:action (lambda (obj tstate)
(debug:catch-and-dump
(lambda ()
(print "tstate: " tstate)
(if (eq? tstate 0)
(dboard:tabdat-compact-layout-set! tabdat #f)
(dboard:tabdat-compact-layout-set! tabdat #t))
| > | 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 |
(dboard:tabdat-runs-tree-set! tabdat tb)
tb)
(iup:hbox
(iup:toggle
"Compact layout"
#:fontsize 8
#:expand "YES"
#:value 1
#:action (lambda (obj tstate)
(debug:catch-and-dump
(lambda ()
(print "tstate: " tstate)
(if (eq? tstate 0)
(dboard:tabdat-compact-layout-set! tabdat #f)
(dboard:tabdat-compact-layout-set! tabdat #t))
|
| ︙ | ︙ | |||
2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 | (vg:drawing-yoff-set! dwg (dboard:tabdat-yadj tabdat)) (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 | > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | 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 2675 2676 2677 2678 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 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 |
(vg:drawing-yoff-set! dwg (dboard:tabdat-yadj tabdat))
(mutex-lock! mtx)
(canvas-clear! cnv)
(vg:draw dwg tabdat)
(mutex-unlock! mtx)
(dboard:tabdat-view-changed-set! tabdat #f)))))
;; doesn't work.
(define (gotoescape tabdat escape)
(or (dboard:tabdat-layout-update-ok tabdat)
(escape #t)))
;; 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
(layout-start (current-milliseconds))
(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)))
(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))))
((fixed-originx) (if (dboard:tabdat-originx tabdat)
(dboard:tabdat-originx tabdat)
(begin
(dboard:tabdat-originx-set! tabdat originx)
originx)))
((fixed-originy) (if (dboard:tabdat-originy tabdat)
(dboard:tabdat-originy tabdat)
(begin
(dboard:tabdat-originy-set! tabdat originy)
originy))))
;; (print "allruns: " allruns)
(let runloop ((rundat (car allruns))
(runtal (cdr allruns))
(run-num 1)
(doneruns '()))
(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)
(if (not (vg:lib-get-component runslib run-full-name))
(let* ((hierdat (if (or (dboard:rundat-data-changed rundat) ;; attempt to not sort when possible.
(not (dboard:rundat-hierdat rundat)))
(let ((hd (dboard:tests-sort-by-time-group-by-item (dboard:rundat-tests rundat)))) ;; hierarchial list of ids
(dboard:rundat-hierdat-set! rundat hd)
hd)
(dboard:rundat-hierdat rundat)))
(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 (- (+ fixed-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))
)
(print "Testing. (maptime run-start=" run-start "): " (maptime run-start) " (maptime run-end=" run-end "): " (maptime run-end) " run-duration: " run-duration)
;; (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)
(vg:instantiate drawing "runslib" run-full-name run-full-name fixed-originx (calc-y curr-run-start-row)) ;; 0) ;; (calc-y (dboard:tabdat-max-row tabdat)))
(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 ((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)
(test-objs '()))
(let* ((testdat (hash-table-ref tests-ht test-id))
(event-time (maptime (db:test-get-event_time testdat)))
(test-duration (* timescale (db:test-get-run_duration testdat)))
(end-time (+ event-time test-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))
(new-test-objs
(let loop ((rownum 0)) ;; new-run-start-row)) ;; (+ start-row 1)))
(if (dashboard:row-collision rowhash rownum event-time end-time)
(loop (+ rownum 1))
(let* ((title (if iterated (if compact-layout #f item-path) test-name))
(lly (calc-y rownum)) ;; (- sizey (* rownum row-height)))
(uly (+ lly row-height))
(use-end (if (< (- end-time event-time) 3)(+ event-time 3) end-time)) ;; if short grow it a little to give the user something to click on
(obj (vg:make-rect-obj event-time lly use-end uly
fill-color: (vg:iup-color->number (car name-color))
text: title
font: "Helvetica -10"))
(bar-end (+ 5 (max use-end
(+ 3 event-time
(if compact-layout
0
(* (string-length title) 10))))))) ;; 8 pixels per letter
;; (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)))
(dboard:tabdat-max-row-set! tabdat (max (+ curr-run-start-row rownum)
(dboard:tabdat-max-row tabdat))) ;; track the max row used
;; bar-end has some margin for text - accounting for text in extents not yet working.
(dashboard:add-bar rowhash rownum event-time bar-end) ;; (+ end-time 5))
(vg:add-obj-to-comp runcomp obj)
;; (vg:instance-move drawing run-full-name 0 (calc-y (dboard:tabdat-max-row tabdat)))
(dboard:tabdat-view-changed-set! tabdat #t)
(cons obj test-objs))))))
;; (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")))
;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
(let ((newdoneruns (cons rundat doneruns)))
(if (null? tidstal)
(if iterated
(let* ((xtents (vg:get-extents-for-objs drawing new-test-objs))
(llx (- (car xtents) 5))
(lly (- (cadr xtents) 10))
(ulx (+ 5 (caddr xtents)))
(uly (+ 0 (cadddr xtents))))
;; (dashboard:add-bar rowhash 0 llx ulx num-rows: num-items)
;; 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 (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
(testitemloop (car tidstal)(cdr tidstal)(+ item-num 1) new-test-objs))))))
;; 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 (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
(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 (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 llx 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)
(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 2))
;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat))
))
;; end of the run handling loop
(if (gotoescape tabdat escape) ;; (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 (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
(runloop (car runtal)(cdr runtal) (+ run-num 1) newdoneruns)))))))))) ;; new-run-start-row
)
(print "Layout end: " (current-milliseconds) " delta: " (- (current-milliseconds) layout-start))))
(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)))
(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" "%/%")
|
| ︙ | ︙ |
Modified dcommon.scm from [afcab61b40] to [ed528fceb8].
| ︙ | ︙ | |||
971 972 973 974 975 976 977 | tabdat (dboard:lines->test-patt b)) (dashboard:update-run-command tabdat)) "command-testname-selector tb action")) #:value (dboard:test-patt->lines (dboard:tabdat-test-patts-use tabdat)) #:expand "YES" | | | 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 |
tabdat
(dboard:lines->test-patt b))
(dashboard:update-run-command tabdat))
"command-testname-selector tb action"))
#:value (dboard:test-patt->lines
(dboard:tabdat-test-patts-use tabdat))
#:expand "YES"
#:size "10x30"
#:multiline "YES")))
(set! test-patterns-textbox tb)
tb))
;; (iup:frame
;; #:title "Target"
;; ;; Target selectors
;; (apply iup:hbox
|
| ︙ | ︙ |