Overview
| Comment: | Progress on run time display |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.61 |
| Files: | files | file ages | folders |
| SHA1: |
cd3c0cae4dcf13cb5b7d7905b4f76cc2 |
| User & Date: | mrwellan on 2016-07-12 17:49:57 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-07-12
| ||
| 23:01 | Added instance and drawing scale x and y, offset x and y check-in: 2548ff7aad user: matt tags: v1.61 | |
| 17:49 | Progress on run time display check-in: cd3c0cae4d user: mrwellan tags: v1.61 | |
| 01:46 | Force getting some run data check-in: fdb15678bf user: matt tags: v1.61 | |
Changes
Modified dashboard.scm from [b5a492a3b9] to [bb09c340a6].
| ︙ | ︙ | |||
1011 1012 1013 1014 1015 1016 1017 | ;; R U N C O N T R O L S ;;====================================================================== ;; ;; A gui for launching tests ;; (define (dashboard:run-times commondat tabdat #!key (tab-num #f)) ;; (dashboard:run-times-tab-updater commondat tab-num) | | < | 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 |
;; R U N C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
(define (dashboard:run-times commondat tabdat #!key (tab-num #f))
;; (dashboard:run-times-tab-updater commondat tab-num)
(let ((drawing (vg:drawing-new))
(run-times-tab-updater (lambda ()
(dashboard:run-times-tab-updater commondat tab-num))))
(dboard:tabdat-drawing-set! tabdat drawing)
(dboard:commondat-add-updater commondat run-times-tab-updater tab-num: tab-num)
(iup:vbox
(let* ((cnv-obj (iup:canvas
#:size "500x400"
|
| ︙ | ︙ | |||
1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 |
(define (dashboard:database-changed? commondat tabdat)
(let* ((run-update-time (current-seconds))
(modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!!
(recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat))))
(dboard:commondat-please-update-set! commondat #f)
recalc))
(define (dashboard:run-times-tab-updater commondat tab-num)
(let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
(if tabdat
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > < > > > | > > > | | > | > > > > > > > > | > | 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 |
(define (dashboard:database-changed? commondat tabdat)
(let* ((run-update-time (current-seconds))
(modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!!
(recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat))))
(dboard:commondat-please-update-set! commondat #f)
recalc))
;; point inside line
;;
(define-inline (dashboard:px-between px lx1 lx2)
(and (< lx1 px)(> lx2 px)))
;; can a bar be placed in row "rownum" covering x1 to x2 without overlapping with existing
;; bars?
;;
(define (dashboard:row-collision rowhash rownum x1 x2)
(let ((rowdat (hash-table-ref/default rowhash rownum '()))
(collision #f))
(for-each
(lambda (bar)
(let ((bx1 (car bar))
(bx2 (cdr bar)))
(cond
;; newbar x1 inside bar
((dashboard:px-between x1 bx1 bx2)(set! collision #t))
((dashboard:px-between x2 bx1 bx2)(set! collision #t))
((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 '()))))
(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)))
(if tabdat
(let* ((row-height 10)
(drawing (dboard:tabdat-drawing tabdat))
(runslib (vg:get/create-lib drawing "runslib")))
(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))
(let ((allruns (dboard:tabdat-allruns tabdat))
(rowhash (make-hash-table))) ;; store me in tabdat
(print "allruns: " allruns)
(for-each
(lambda (rundat)
(if (vector? rundat)
(let* ((run (vector-ref rundat 0))
(testsdat (sort (vector-ref rundat 1)
(lambda (a b)
(< (db:test-get-event_time a)
(db:test-get-event_time b)))))
(key-val-dat (vector-ref rundat 2))
(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 "/"))
(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))
(vg:add-comp-to-lib runslib run-full-name runcomp)
;; get tests in list sorted by event time ascending
(for-each
(lambda (testdat)
(let* ((event-time (/ (db:test-get-event_time testdat) 60))
(run-duration (/ (db:test-get-run_duration testdat) 60))
(end-time (+ event-time run-duration))
(test-name (db:test-get-testname testdat))
(item-path (db:test-get-item_path testdat)))
(let loop ((rownum 0))
(if (dashboard:row-collision rowhash rownum event-time end-time)
(loop (+ rownum 1))
(let* ((lly (* rownum row-height))
(uly (+ lly row-height)))
(dashboard:add-bar rowhash rownum event-time end-time)
(vg:add-objs-to-comp runcomp (vg:make-rect event_time lly end-time uly)))))
;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
))
testsdat))))
allruns)
(vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)(dboard:tabdat-cnv tabdat)) ;; cnv-obj)
(canvas-clear! (dboard:tabdat-cnv tabdat)) ;; -obj)
(vg:draw (dboard:tabdat-drawing tabdat))
))
(print "no tabdat for run-times-tab-updater"))))
|
| ︙ | ︙ |
Modified vg.scm from [47e6fcaa5e] to [eb7981f441].
| ︙ | ︙ | |||
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
(make-vg:drawing libs: (make-hash-table) insts: (make-hash-table)))
;; make a rectangle obj
;;
(define (vg:make-rect x1 y1 x2 y2 #!key (line-color #f)(fill-color #f))
(make-vg:obj type: 'r pts: (list x1 y1 x2 y2) text: #f line-color: line-color fill-color: fill-color))
;; add obj to comp
;;
(define (vg:add-objs-to-comp comp . objs)
(vg:comp-objs-set! comp (append (vg:comp-objs comp) objs)))
;; add comp to lib
;;
(define (vg:add-comp-to-lib lib compname comp)
(hash-table-set! (vg:lib-comps lib) compname comp))
;; instanciate component in drawing
;;
(define (vg:instantiate drawing libname compname instname xoff yoff t #!key (scale 1)(mirrx #f)(mirry #f))
(let ((inst (make-vg:inst libname: libname compname: compname xoff: xoff yoff: yoff theta: t scale: scale mirrx: mirrx mirry: mirry)) )
(hash-table-set! (vg:drawing-insts drawing) instname inst)))
;; get component from drawing (look in apropriate lib) given libname and compname
(define (vg:get-component drawing libname compname)
(let* ((lib (hash-table-ref (vg:drawing-libs drawing) libname))
(inst (hash-table-ref (vg:lib-comps lib) compname)))
inst))
;; register lib with drawing
;;
(define (vg:add-lib drawing libname lib)
(hash-table-set! (vg:drawing-libs drawing) libname lib))
;;======================================================================
;; map objects given offset, scale and mirror
;;======================================================================
(define (vg:map-obj xoff yoff theta scale mirrx mirry obj)
(case (vg:obj-type obj)
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 |
(make-vg:drawing libs: (make-hash-table) insts: (make-hash-table)))
;; make a rectangle obj
;;
(define (vg:make-rect x1 y1 x2 y2 #!key (line-color #f)(fill-color #f))
(make-vg:obj type: 'r pts: (list x1 y1 x2 y2) text: #f line-color: line-color fill-color: fill-color))
;; get extents, use knowledge of type ...
;;
(define (vg:obj-get-extents obj)
(let ((type (vg:obj-type obj)))
(case type
((r)(vg:rect-get-extents obj)))))
(define (vg:rect-get-extents obj)
(vg:obj-pts obj)) ;; extents are just the points for a rectangle
;;======================================================================
;; components
;;======================================================================
;; add obj to comp
;;
(define (vg:add-objs-to-comp comp . objs)
(vg:comp-objs-set! comp (append (vg:comp-objs comp) objs)))
;; use the struct. leave this here to remind of this!
;;
;; (define (vg:comp-get-objs comp)
;; (vg:comp-objs comp))
;; add comp to lib
;;
(define (vg:add-comp-to-lib lib compname comp)
(hash-table-set! (vg:lib-comps lib) compname comp))
;; instanciate component in drawing
;;
(define (vg:instantiate drawing libname compname instname xoff yoff t #!key (scale 1)(mirrx #f)(mirry #f))
(let ((inst (make-vg:inst libname: libname compname: compname xoff: xoff yoff: yoff theta: t scale: scale mirrx: mirrx mirry: mirry)) )
(hash-table-set! (vg:drawing-insts drawing) instname inst)))
;; get component from drawing (look in apropriate lib) given libname and compname
(define (vg:get-component drawing libname compname)
(let* ((lib (hash-table-ref (vg:drawing-libs drawing) libname))
(inst (hash-table-ref (vg:lib-comps lib) compname)))
inst))
(define (vg:component-get-extents comp)
(let ((llx #f)
(lly #f)
(ulx #f)
(uly #f)
(objs (vg:comp-objs comp)))
(for-each
(lambda (obj)
(let* ((extents (vg:get-extents obj))
(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))
(if (or (not lly)(< olly llx))(set! llx ollx))
(if (or (not ulx)(< ollx llx))(set! llx ollx))
(if (or (not uly)(< ollx llx))(set! llx ollx))))
objs)
(list llx lly ulx uly)))
;;======================================================================
;; libraries
;;======================================================================
;; register lib with drawing
;;
(define (vg:add-lib drawing libname lib)
(hash-table-set! (vg:drawing-libs drawing) libname lib))
(define (vg:get-lib drawing libname)
(hash-table-ref/default (vg:drawing-libs drawing) libname #f))
(define (vg:get/create-lib drawing libname)
(let ((lib (vg:get-lib drawing libname)))
(if lib
lib
(let ((newlib (vg:lib-new)))
(vg:add-lib drawing libname newlib)
newlib))))
;;======================================================================
;; map objects given offset, scale and mirror
;;======================================================================
(define (vg:map-obj xoff yoff theta scale mirrx mirry obj)
(case (vg:obj-type obj)
|
| ︙ | ︙ |