@@ -200,11 +200,14 @@ statuses target test-patts tests tests-tree - tot-runs + tot-runs + view-changed + xadj + yadj ) (define (dboard:tabdat-target-string vec) (let ((targ (dboard:tabdat-target vec))) (if (list? targ)(string-intersperse targ "/") "no-target-specified"))) @@ -238,10 +241,13 @@ 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 ))) (dboard:setup-tabdat dat) (dboard:setup-num-rows dat) dat)) @@ -1029,21 +1035,30 @@ #:posy "0.5" #:action (make-canvas-action (lambda (c xadj yadj) (if (not (dboard:tabdat-cnv tabdat)) (dboard:tabdat-cnv-set! tabdat c)) - (let ((drawing (dboard:tabdat-drawing tabdat))) - #f ;; finish me!! - ))) + (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) + (dboard:tabdat-xadj-set! tabdat (* -500 (- xadj 0.5))) + (dboard:tabdat-yadj-set! tabdat (* 500 (- yadj 0.5))) + ))))) #:wheel-cb (lambda (obj step x y dir) ;; dir is 4 for up and 5 for down. I think. (let* ((drawing (dboard:tabdat-drawing tabdat)) (scalex (vg:drawing-scalex drawing))) + (dboard:tabdat-view-changed-set! tabdat #t) + (print "step: " step " x: " x " y: " y " dir: " dir " scalex: " scalex) (vg:drawing-scalex-set! drawing (+ scalex (if (> step 0) - (* scalex 0.01) - (* scalex -0.01)))))) + (* scalex 0.02) + (* scalex -0.02)))))) ))) cnv-obj)))) ;;====================================================================== ;; S U M M A R Y @@ -1909,15 +1924,18 @@ ;; 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)) (canvas-margin 10) - (start-row 0)) ;; each run starts in this row - (if tabdat - (let* ((row-height 20) - (drawing (dboard:tabdat-drawing tabdat)) + (start-row 0) ;; each run starts in this row + (row-height 10)) + (if (and tabdat + (dboard:tabdat-view-changed tabdat)) + (let* ((drawing (dboard:tabdat-drawing tabdat)) (runslib (vg:get/create-lib drawing "runslib"))) ;; creates and adds lib + (vg:drawing-xoff-set! drawing (dboard:tabdat-xadj tabdat)) + (vg:drawing-yoff-set! drawing (dboard:tabdat-yadj tabdat)) (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" "%") @@ -1931,11 +1949,11 @@ (let ((allruns (dboard:tabdat-allruns tabdat)) (rowhash (make-hash-table)) ;; store me in tabdat (cnv (dboard:tabdat-cnv tabdat))) (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv)) ((originx originy) (canvas-origin cnv))) - (print "allruns: " allruns) + ;; (print "allruns: " allruns) (for-each (lambda (rundat) (if (vector? rundat) (let* ((run (vector-ref rundat 0)) (testsdat (sort (vector-ref rundat 1) @@ -1949,11 +1967,11 @@ (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) + ;; (row-height 4) (run-start (apply min (map db:test-get-event_time testsdat))) (run-end (apply 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)) @@ -1961,15 +1979,16 @@ run-duration (current-seconds)))) ;; a least lously guess (maptime (lambda (tsecs)(* timescale (+ tsecs timeoffset))))) ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx) (vg:add-comp-to-lib runslib run-full-name runcomp) - (vg:add-objs-to-comp runcomp (vg:make-text - 10 - (- sizey (* start-row row-height)) - run-full-name - font: "Helvetica -10")) + (set! start-row (+ start-row 1)) + (let ((x 10) + (y (- sizey (* start-row row-height)))) + (vg:add-objs-to-comp runcomp (vg:make-text x y run-full-name font: "Helvetica -10")) + (dashboard:add-bar rowhash start-row x (+ x 100))) + (set! start-row (+ start-row 1)) ;; get tests in list sorted by event time ascending (for-each (lambda (testdat) (let* ((event-time (maptime (db:test-get-event_time testdat))) (run-duration (* timescale (db:test-get-run_duration testdat))) @@ -1987,14 +2006,20 @@ (if (dashboard:row-collision rowhash rownum event-time end-time) (loop (+ rownum 1)) (let* ((lly (- sizey (* 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 - fill-color: - ;; (string->number (string-substitute " " "" (car name-color)))))))) - (vg:iup-color->number (car name-color))))))) + (vg:add-objs-to-comp runcomp + (vg:make-rect event-time lly end-time uly + fill-color: (vg:iup-color->number (car name-color)) + text: (conc test-name "/" item-path) + font: "Helvetica -10") + ;; (vg:make-text (+ event-time 2) + ;; (+ lly 2) + ;; (conc test-name "/" item-path) + ;; font: "Helvetica -10") + )))) ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration) )) testsdat) ;; instantiate the component (let* ((extents (vg:components-get-extents drawing runcomp)) @@ -2013,11 +2038,12 @@ (vg:instantiate drawing "runslib" run-full-name run-full-name 0 0))))) ;; scalex: scalex scaley: 1))))) allruns) (vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)(dboard:tabdat-cnv tabdat)) ;; cnv-obj) (canvas-clear! (dboard:tabdat-cnv tabdat)) ;; -obj) - (print "All objs: " (vg:draw (dboard:tabdat-drawing tabdat) #t)) + (print "Number of objs: " (length (vg:draw (dboard:tabdat-drawing tabdat) #t))) + (dboard:tabdat-view-changed-set! tabdat #f) ))) (print "no tabdat for run-times-tab-updater")))) (define (dashboard:runs-tab-updater commondat tab-num) (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))