Megatest

Check-in [efed051fe1]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Incremental drawing now working.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: efed051fe1bf247d359ba62c5ce433ff69a36c30
User & Date: matt on 2016-07-23 21:57:31
Other Links: branch diff | manifest | tags
Context
2016-07-23
23:26
Bit better on the layout, still broken check-in: 1fd3017375 user: matt tags: v1.61
21:57
Incremental drawing now working. check-in: efed051fe1 user: matt tags: v1.61
20:59
reorganised code layout for run times canvas view check-in: ae5d869b0c user: matt tags: v1.61
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [27c42dd921] to [c13d28ecc7].

︙
184
185
186
187
188
189
190

191
192
193
194
195
196
197

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198








+








  cnv
  cnv-obj
  drawing
  draw-cache     ;; 
  start-row
  run-start-row
  max-row
  running-layout

  ;; Controls used to launch runs etc.
  command
  command-tb 
  run-name         ;; from run name setting widget
  states           ;; states for -state s1,s2 ...
  statuses         ;; statuses for -status s1,s2 ...
︙
262
263
264
265
266
267
268

269
270
271
272
273
274
275

263
264
265
266
267
268
269
270
271
272
273
274
275
276
277








+








	      not-done-runs:        '()
	      done-runs:            '()
	      num-tests:            15
	      numruns:              16
	      path-run-ids:         (make-hash-table)
	      run-ids:              (make-hash-table)
	      run-keys:             (make-hash-table)
	      running-layout:       #f
	      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
︙
1125
1126
1127
1128
1129
1130
1131

1132
1133
1134
1135









1136
1137
1138
1139
1140
1141
1142

1127
1128
1129
1130
1131
1132
1133
1134




1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150








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








				  (lambda ()
				    (let ((tabdat        (dboard:common-get-tabdat commondat tab-num: tab-num)))
				      (if tabdat
					  (let ((last-data-update (dboard:tabdat-last-data-update tabdat))
						(now-time         (current-seconds)))
					    (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
					    (if (> (- now-time last-data-update) 5)
						(if (not (dboard:tabdat-running-layout tabdat))
						(begin
						  (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
						  (dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
						  (dboard:tabdat-last-data-update-set! tabdat now-time)))))))
						    (begin
						      (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
						      (dboard:tabdat-last-data-update-set! tabdat now-time)
						      (thread-start! (make-thread
								      (lambda ()
									(dboard:tabdat-running-layout-set! tabdat #t)
									(dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
									(dboard:tabdat-running-layout-set! tabdat #f)))))
						  ))))))
				  "dashboard:run-times-tab-updater"))))
    (dboard:tabdat-drawing-set! tabdat drawing)
    (dboard:commondat-add-updater commondat run-times-tab-updater tab-num: tab-num)
    (iup:split
     #:orientation "VERTICAL" ;; "HORIZONTAL"
     #:value 200
     (let* ((tb      (iup:treebox
︙
2490
2491
2492
2493
2494
2495
2496
2497
2498



2499
2500
2501
2502
2503
2504
2505

2498
2499
2500
2501
2502
2503
2504


2505
2506
2507
2508
2509
2510
2511
2512
2513
2514








-
-
+
+
+








		     res))))

;; run times canvas updater
;;
(define (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
  (let ((cnv (dboard:tabdat-cnv tabdat))
	(dwg (dboard:tabdat-drawing tabdat))
	(mtx (dboard:tabdat-runs-mutex tabdat)))
    (if (and cnv dwg)
	(mtx (dboard:tabdat-runs-mutex tabdat))
	(vch (dboard:tabdat-view-changed tabdat)))
    (if (and cnv dwg vch)
	(begin
	  (mutex-lock! mtx)
	  (canvas-clear! cnv)
	  (vg:draw dwg tabdat)
	  (mutex-unlock! mtx)
	  (dboard:tabdat-view-changed-set! tabdat #f)))))
︙
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524



2525
2526
2527
2528
2529
2530
2531
2532
2533
2534


2535
2536
2537
2538
2539




2540
2541
2542
2543
2544
2545
2546

2524
2525
2526
2527
2528
2529
2530



2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542

2543
2544
2545




2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556








-
-
-
+
+
+









-
+
+

-
-
-
-
+
+
+
+








	 (mtx           (dboard:tabdat-runs-mutex tabdat))) 
    (if tabdat
	(let* ((drawing    (dboard:tabdat-drawing tabdat))
	       (runslib    (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
	       (compute-start (current-seconds)))
	  (vg:drawing-xoff-set! drawing (dboard:tabdat-xadj tabdat))
	  (vg:drawing-yoff-set! drawing (dboard:tabdat-yadj tabdat))
	  (let ((allruns (dboard:tabdat-allruns tabdat))
		(rowhash (make-hash-table)) ;; store me in tabdat
		(cnv     (dboard:tabdat-cnv tabdat)))
	  (let* ((allruns (dboard:tabdat-allruns tabdat))
		 (num-runs (length allruns))
		 (cnv     (dboard:tabdat-cnv tabdat)))
	    (print "allruns: " allruns)
	    (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
			 ((originx originy)             (canvas-origin cnv)))
	      ;; (print "allruns: " allruns)
	      (let runloop ((rundat   (car allruns))
			    (runtal   (cdr allruns))
			    (run-num   1)
			    (doneruns '())
			    (run-start-row 0))
		(let* ((run       (dboard:rundat-run rundat))
		(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-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 "/")))
		  (if (not (vg:lib-get-component runslib run-full-name))
		      (let* ((hierdat   (dboard:tests-sort-by-time-group-by-item (dboard:rundat-tests rundat))) ;; hierarchial list of ids
			     (tests-ht  (dboard:rundat-tests rundat))
			     (all-tids  (hash-table-keys   tests-ht)) ;; (apply append hierdat)) ;; was testsdat
			     (testsdat  (hash-table-values tests-ht))
︙
2558
2559
2560
2561
2562
2563
2564

2565
2566
2567
2568
2569
2570
2571

2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582








+








			     (maptime    (lambda (tsecs)(* timescale (+ tsecs timeoffset))))
			     (num-tests  (length hierdat))
			     (tot-tests  (length testsdat))
			     (new-run-start-row (+ (dboard:tabdat-max-row tabdat) 2)))
			;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx)
			(mutex-lock! mtx)
			(vg:add-comp-to-lib runslib run-full-name runcomp)
			(vg:instantiate drawing "runslib" run-full-name run-full-name 0 (* new-run-start-row row-height))
			(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))
︙
2605
2606
2607
2608
2609
2610
2611

2612
2613
2614
2615
2616
2617
2618

2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630








+








					;;     (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)))
					(dashboard:add-bar rowhash rownum event-time end-time)
					(vg:add-obj-to-comp runcomp obj)
					(dboard:tabdat-view-changed-set! tabdat #t)
					(set! test-objs (cons obj test-objs)))))
				;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
				(let ((newdoneruns (cons rundat doneruns)))
				  (if (not (null? tidstal))
				      (if #f ;; (> (- (current-seconds) update-start-time) 5)
					  (begin
					    (print "drawing runs taking too long....  have " (length runtal) " remaining")
︙
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

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








-
+
+
+

















-
+
-








				       (llx (- (car xtents)   5))
				       (lly (- (cadr xtents) 10))
				       (ulx (+ 5 (caddr xtents)))
				       (uly (+ 0 (cadddr xtents))))
				  (dashboard:add-bar rowhash first-rownum llx ulx num-rows:  num-items)
				  (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)))
										font: "Helvetica -10"))))
										font: "Helvetica -10"))
				  (dboard:tabdat-view-changed-set! tabdat #t) ;; trigger a redraw
				  ))
			    (if (not (null? tests-tal))
				(if #f ;; (> (- (current-seconds) update-start-time) 5)
				    (print "drawing runs taking too long")
				    (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   (- 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
			(mutex-lock! mtx)
			(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))
			       ) ;;  (vg:components-get-extents d1 c1)))
			  (vg:add-obj-to-comp runcomp (vg:make-rect-obj llx lly ulx uly text: run-full-name))
			  (vg:add-obj-to-comp runcomp (vg:make-rect-obj llx lly ulx uly text: run-full-name)))
			  (vg:instantiate drawing "runslib" run-full-name run-full-name 0 0))
			(mutex-unlock! mtx)
			(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 1)))
		      ;; end of the run handling loop 
		      (let ((newdoneruns (cons rundat doneruns)))
			(if (null? runtal)
			    (begin
			      (dboard:tabdat-not-done-runs-set! tabdat '())
︙

This page was generated in about 0.114s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00