Megatest

Check-in [94ad80d186]
Login
Overview
Comment:Boxes now in right place
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: 94ad80d186deaf90443edb2dea9ef8cc217b7802
User & Date: matt on 2016-07-16 13:38:17
Other Links: branch diff | manifest | tags
Context
2016-07-16
22:23
Now have semi-decent temporal view of tests check-in: 6cffe7588b user: matt tags: v1.61
13:38
Boxes now in right place check-in: 94ad80d186 user: matt tags: v1.61
06:19
Tests now show up on time line check-in: 9aaa15bf91 user: matt tags: v1.61
Changes

Modified dashboard.scm from [f220243be5] to [4a617de25b].

1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
  ;; 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 20)
	(start-row     0)) ;; each run starts in this row
    (if tabdat
	(let* ((row-height 10)
	       (drawing    (dboard:tabdat-drawing tabdat))
	       (runslib    (vg:get/create-lib drawing "runslib"))) ;; creates and adds lib
	  (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" "%")







|







1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
  ;; 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 20)
	(start-row     0)) ;; each run starts in this row
    (if tabdat
	(let* ((row-height 20)
	       (drawing    (dboard:tabdat-drawing tabdat))
	       (runslib    (vg:get/create-lib drawing "runslib"))) ;; creates and adds lib
	  (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" "%")
1951
1952
1953
1954
1955
1956
1957


1958

1959
1960
1961
1962
1963
1964
1965
1966
1967
1968



1969
1970
1971
1972
1973
1974
1975
		       (for-each 
			(lambda (testdat)
			  (let* ((event-time   (maptime (db:test-get-event_time   testdat)))
				 (run-duration (* timescale (db:test-get-run_duration testdat)))
				 (end-time     (+ event-time run-duration))
				 (test-name    (db:test-get-testname     testdat))
				 (item-path    (db:test-get-item-path    testdat))


				 (test-fullname (conc test-name "/" item-path)))

			    (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)
			    (let loop ((rownum start-row)) ;; (+ start-row 1)))
			      (set! start-row (max rownum start-row)) ;; track the max row used
			      (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)))))



			    ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
			    ))
			testsdat)
		       ;; instantiate the component 
		       (let* ((extents (vg:components-get-extents runcomp))
			      (llx     (list-ref extents 0))
			      (lly     (list-ref extents 1))







>
>
|
>









|
>
>
>







1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
		       (for-each 
			(lambda (testdat)
			  (let* ((event-time   (maptime (db:test-get-event_time   testdat)))
				 (run-duration (* timescale (db:test-get-run_duration testdat)))
				 (end-time     (+ event-time run-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)))
			    (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)
			    (let loop ((rownum start-row)) ;; (+ start-row 1)))
			      (set! start-row (max rownum start-row)) ;; track the max row used
			      (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)))))))
			    ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
			    ))
			testsdat)
		       ;; instantiate the component 
		       (let* ((extents (vg:components-get-extents runcomp))
			      (llx     (list-ref extents 0))
			      (lly     (list-ref extents 1))

Modified vg.scm from [873f3428fe] to [382e81ebe7].

235
236
237
238
239
240
241









242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260


261
262
263
264











265

266
267
268
269
270
271
272
273
	 (if (or (not llx)(< ollx llx))(set! llx ollx))
	 (if (or (not lly)(< olly lly))(set! lly olly))
	 (if (or (not ulx)(> oulx ulx))(set! ulx oulx))
	 (if (or (not uly)(> ouly uly))(set! uly ouly))))
     xtnt-lst)
    (list llx lly ulx uly)))











;;======================================================================
;; Unravel and draw the objects
;;======================================================================

;; with get-extents = #t return the extents
;; with draw = #f don't actually draw the object
;;
(define (vg:draw-obj drawing obj #!key (draw #t))
  ;; (print "obj type: " (vg:obj-type obj))
  (case (vg:obj-type obj)
    ((r)(vg:draw-rect drawing obj draw: draw))))

;; given a rect obj draw it on the canvas applying first the drawing
;; scale and offset
;;
(define (vg:draw-rect drawing obj #!key (draw #t))
  (let* ((cnv (vg:drawing-cnv drawing))
	 (pts (vg:drawing-apply-scale drawing (vg:obj-pts obj)))


	 (llx (car pts))
	 (lly (cadr pts))
	 (ulx (caddr pts))
	 (uly (cadddr pts)))











    (if draw (canvas-rectangle! cnv llx ulx lly uly))

    pts)) ;; return extents

(define (vg:draw drawing draw-mode . instnames)
  (let ((insts (vg:drawing-insts drawing))
	(res   '()))
    (for-each 
     (lambda (instname)
       (let* ((inst     (hash-table-ref insts instname))







>
>
>
>
>
>
>
>
>



















>
>



|
>
>
>
>
>
>
>
>
>
>
>
|
>
|







235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
	 (if (or (not llx)(< ollx llx))(set! llx ollx))
	 (if (or (not lly)(< olly lly))(set! lly olly))
	 (if (or (not ulx)(> oulx ulx))(set! ulx oulx))
	 (if (or (not uly)(> ouly uly))(set! uly ouly))))
     xtnt-lst)
    (list llx lly ulx uly)))

;;======================================================================
;; color
;;======================================================================

(define (vg:rgb->number r g b #!key (a 0))
   (u32vector-ref (blob->u32vector (u8vector->blob (list->u8vector (list a r g b)))) 0))

(define (vg:iup-color->number iup-color)
  (apply vg:rgb->number (map string->number (string-split iup-color))))

;;======================================================================
;; Unravel and draw the objects
;;======================================================================

;; with get-extents = #t return the extents
;; with draw = #f don't actually draw the object
;;
(define (vg:draw-obj drawing obj #!key (draw #t))
  ;; (print "obj type: " (vg:obj-type obj))
  (case (vg:obj-type obj)
    ((r)(vg:draw-rect drawing obj draw: draw))))

;; given a rect obj draw it on the canvas applying first the drawing
;; scale and offset
;;
(define (vg:draw-rect drawing obj #!key (draw #t))
  (let* ((cnv (vg:drawing-cnv drawing))
	 (pts (vg:drawing-apply-scale drawing (vg:obj-pts obj)))
	 (fill-color (vg:obj-fill-color obj))
	 (line-color (vg:obj-line-color obj))
	 (llx (car pts))
	 (lly (cadr pts))
	 (ulx (caddr pts))
	 (uly (cadddr pts))
	 (w   (- ulx llx))
	 (h   (- uly lly)))
    (if draw 
	(let ((prev-background-color (canvas-background cnv))
	      (prev-foreground-color (canvas-foreground cnv)))
	  (if fill-color (canvas-foreground-set! cnv fill-color))
	  (canvas-box! cnv llx ulx lly uly) ;; docs are all over the place on this one.;; w h)
	  (if line-color
	      (canvas-foreground-set! cnv line-color)
	      (if fill-color
		  (canvas-foreground-set! cnv prev-background-color)))
	  (canvas-rectangle! cnv llx ulx lly uly)
	  (canvas-foreground-set! cnv prev-background-color)))
    pts)) ;; return extents 

(define (vg:draw drawing draw-mode . instnames)
  (let ((insts (vg:drawing-insts drawing))
	(res   '()))
    (for-each 
     (lambda (instname)
       (let* ((inst     (hash-table-ref insts instname))