Megatest

Diff
Login

Differences From Artifact [2fba186660]:

To Artifact [85a6624511]:


2402
2403
2404
2405
2406
2407
2408
2409

2410
2411
2412
2413
2414
2415
2416
2417
2418


2419
2420
2421
2422
2423
2424
2425
2402
2403
2404
2405
2406
2407
2408

2409
2410
2411
2412
2413
2414
2415
2416
2417

2418
2419
2420
2421
2422
2423
2424
2425
2426







-
+








-
+
+







                                         #:modal? "NO")
                               )
                              )
                            
                             )) "runs-summary-click-callback"))))
	 (runs-summary-updater  
          (lambda ()
	    (mutex-lock! update-mutex)
	    ;; (mutex-lock! update-mutex)
            (if  (or (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-updater)
                     (dboard:tabdat-view-changed tabdat))
                 (debug:catch-and-dump
                  (lambda () ;; check that run-matrix is initialized before calling the updater
		    (if run-matrix 
			(dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix)))
                  "dashboard:runs-summary-updater")
                 )
	    (mutex-unlock! update-mutex)))
	    #;(mutex-unlock! update-mutex)
	    ))
         (runs-summary-control-panel (dashboard:runs-summary-control-panel tabdat))
         )
    (dboard:commondat-add-updater commondat runs-summary-updater tab-num: tab-num)
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (iup:vbox
     (iup:split
      #:value 200
3342
3343
3344
3345
3346
3347
3348
3349

3350
3351
3352

3353
3354
3355
3356
3357
3358
3359
3343
3344
3345
3346
3347
3348
3349

3350
3351
3352

3353
3354
3355
3356
3357
3358
3359
3360







-
+


-
+







	(dwg (dboard:tabdat-drawing tabdat))
	(mtx (dboard:tabdat-runs-mutex tabdat))
	(vch (dboard:tabdat-view-changed tabdat)))
    (if (and cnv dwg vch)
	(begin
	  (vg:drawing-xoff-set! dwg (dboard:tabdat-xadj tabdat))
	  (vg:drawing-yoff-set! dwg (dboard:tabdat-yadj tabdat))
	  (mutex-lock! mtx)
	  ;; (mutex-lock! mtx)
	  (canvas-clear! cnv)
	  (vg:draw dwg tabdat)
	  (mutex-unlock! mtx)
	  ;; (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)))
3629
3630
3631
3632
3633
3634
3635
3636

3637
3638
3639
3640
3641
3642

3643
3644
3645
3646
3647
3648
3649
3630
3631
3632
3633
3634
3635
3636

3637
3638
3639
3640
3641
3642

3643
3644
3645
3646
3647
3648
3649
3650







-
+





-
+







			       (width      (* timescale run-duration))
			       (graph-lly  (calc-y (/ -50 row-height)))
			       (graph-uly  (- (calc-y 0) canvas-margin))
			       (sec-per-50pt (/ 50 timescale))
			       )
			  ;; (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)
			  ;; (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)
			  ;; (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))
3740
3741
3742
3743
3744
3745
3746
3747

3748
3749

3750
3751
3752
3753
3754
3755
3756
3741
3742
3743
3744
3745
3746
3747

3748
3749

3750
3751
3752
3753
3754
3755
3756
3757







-
+

-
+







				 (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)
			    ;; (mutex-lock! mtx)
			    (vg:add-obj-to-comp runcomp outln)
			    (mutex-unlock! mtx)
			    ;; (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))
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897






3898
3899
3900

3901
3902
3903


3904
3905
3906
3907
3908
3909
3910
3886
3887
3888
3889
3890
3891
3892






3893
3894
3895
3896
3897
3898
3899
3900

3901
3902


3903
3904
3905
3906
3907
3908
3909
3910
3911







-
-
-
-
-
-
+
+
+
+
+
+


-
+

-
-
+
+







	;;  (lambda ()
	   ;;  (dashboard:runs-tab-updater commondat 1))
	;; tab-num: 2)
	(iup:callback-set! *tim*
			   "ACTION_CB"
			   (lambda (time-obj)
			     (let ((update-is-running #f))
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)
			     (dboard:commondat-updating-set! commondat #t))
			     (mutex-unlock! (dboard:commondat-update-mutex commondat))
			     (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
			       ;; (mutex-lock! (dboard:commondat-update-mutex commondat))
			       (set! update-is-running (dboard:commondat-updating commondat))
			       (if (not update-is-running)
				   (dboard:commondat-updating-set! commondat #t))
			       ;; (mutex-unlock! (dboard:commondat-update-mutex commondat))
			       (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
			     (begin
			     (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     ;; (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (dboard:commondat-updating-set! commondat #f)
			     (mutex-unlock! (dboard:commondat-update-mutex commondat)))
				   ))
			     ;; (mutex-unlock! (dboard:commondat-update-mutex commondat))
			     )))
			     1))))
      ;; (debug:print 0 *default-log-port* "Starting updaters")
      (let ((th1 (make-thread (lambda ()
				(thread-sleep! 1)
				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
				) "update buttons once"))
	    (th2 (make-thread iup:main-loop "Main loop")))