Megatest

		     #:expand "YES"
		     #:scrollbar "YES"
		     #:posx "0.5"
		     #: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!!
				   )))
		     #: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)))
				    (vg:drawing-scalex-set! drawing
							    (+ scalex
							       (if (> step 0)
								   (* scalex 0.01)

			    (timescale  (/ (- sizex (* 2 canvas-margin))
					   (if (> run-duration 0)
					       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"))
		       ;; 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)))
				 (end-time     (+ event-time run-duration))
				 (test-name    (db:test-get-testname     testdat))

									       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 drawing runcomp))
			      (llx     (list-ref extents 0))
			      (lly     (list-ref extents 1))
			      (ulx     (list-ref extents 2))
			      (uly     (list-ref extents 3))
			      ;; move the following into mapping functions in vg.scm
			      (deltax  (- llx ulx))
			      (scalex  (if (> deltax 0)(/ sizex deltax) 1))

(use canvas-draw iup)
(import canvas-draw-iup)

(load "vg.scm")

(use trace)
(trace 
 vg:draw-rect
 vg:grow-rect
 vg:components-get-extents)

(define d1 (vg:drawing-new))
(define l1 (vg:lib-new))
(define c1 (vg:comp-new))
(define c2 (vg:comp-new))
(let ((r1 (vg:make-rect 20 20 40 40))
      (r2 (vg:make-rect 40 40 80 80))
      (t1 (vg:make-text 40 40 "The middle" font: "Helvetica, -10")))
  (vg:add-objs-to-comp c1 r1 r2 t1))

;; add the c1 component to lib l1 with name firstcomp
(vg:add-comp-to-lib l1 "firstcomp" c1)
(vg:add-comp-to-lib l1 "secondcomp" c2)

;; add the l1 lib to drawing with name firstlib
(vg:add-lib d1 "firstlib" l1)

;; (define xtnts (vg:scale-offset-xy 
;; 	       (vg:component-get-extents c1)
;; 	       1.1 1.1 -2 -2))

;; get extents of c1 and put a rectange around it
;;
(define xtnts (apply vg:grow-rect 10 10 (vg:components-get-extents d1 c1)))
(vg:add-objs-to-comp c1 (apply vg:make-rect xtnts))

;; get extents of all objects and put rectangle around it
;;
(define big-xtnts (vg:instances-get-extents d1))
(vg:add-objs-to-comp c2 (apply vg:make-rect big-xtnts))
(vg:instantiate d1 "firstlib" "secondcomp" "inst3" 0 0)

(declare (unit vg))
(use canvas-draw iup)
(import canvas-draw-iup)
;; structs
;;
(defstruct vg:lib     comps)
(defstruct vg:comp    objs name file)
(defstruct vg:obj     type pts fill-color text line-color call-back angle font attrib)
(defstruct vg:inst    libname compname theta xoff yoff scalex scaley mirrx mirry call-back cache)
(defstruct vg:drawing libs insts scalex scaley xoff yoff cnv cache) ;; libs: hash of name->lib, insts: hash of instname->inst

;; inits
;;
(define (vg:comp-new)
  (make-vg:comp objs: '() name: #f file: #f))

;; apply both drawing and instance scaling to a list of xy points
;; 
(define (vg:drawing-inst-apply-scale-offset drawing inst lstxy)
  (vg:drawing-apply-scale 
   drawing
   (vg:inst-apply-scale inst lstxy)))

;;======================================================================
;; objects
;;======================================================================

;;   (vg:inst-apply-scale 
;;    inst
;;    (vg:drawing-apply-scale drawing lstxy)))

;; 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))

;; make a text obj
;;
(define (vg:make-text x1 y1 text #!key (line-color #f)(fill-color #f)
		      (angle #f)(scale-with-zoom #f)(font #f)
		      (font-size #f))
  (make-vg:obj type: 't pts: (list x1 y1) text: text 
	       line-color: line-color fill-color: fill-color
	       angle: angle font: font
	       attributes: (vg:make-attrib 'font-size font-size)))

;;======================================================================
;; obj modifiers and queries
;;======================================================================

;; get extents, use knowledge of type ...
;;
(define (vg:obj-get-extents drawing obj)
  (let ((type (vg:obj-type obj)))
    (case type
      ((r)(vg:rect-get-extents obj))
      ((t)(vg:draw-text drawing obj draw: #f))
      (else #f))))

(define (vg:rect-get-extents obj)
  (vg:obj-pts obj)) ;; extents are just the points for a rectangle

(define (vg:grow-rect borderx bordery x1 y1 x2 y2)
  (list
   (- x1 borderx)
   (- y1 bordery)
   (+ x2 borderx)
   (+ y2 bordery)))

(define (vg:make-attrib . attrib-list)
  #f)

;;======================================================================
;; components
;;======================================================================

;; add obj to comp
;;

;; 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:components-get-extents drawing . comps)
  (let ((llx #f)
	(lly #f)
	(ulx #f)
	(uly #f))
    (for-each
     (lambda (comp)
       (let ((objs (vg:comp-objs comp)))
	 (for-each
	  (lambda (obj)
	    (let* ((extents (vg:obj-get-extents drawing 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 lly))(set! lly olly))
	      (if (or (not ulx)(> oulx ulx))(set! ulx oulx))

;;======================================================================

;; dispatch the drawing of obj off to the correct drawing routine
;;
(define (vg:map-obj drawing inst obj)
  (case (vg:obj-type obj)
    ((r)(vg:map-rect drawing inst obj))
    ((t)(vg:map-text drawing inst obj))
    (else #f)))

;; given a drawing and a inst map a rectangle to it screen coordinates
;;
(define (vg:map-rect drawing inst obj)
  (let ((res (make-vg:obj type:       'r
			  fill-color: (vg:obj-fill-color obj)
			  text:       (vg:obj-text       obj)
			  line-color: (vg:obj-line-color obj)
			  font:       (vg:obj-font       obj)))
	(pts (vg:obj-pts obj)))
    (vg:obj-pts-set! res (vg:drawing-inst-apply-scale-offset drawing inst pts))
    (vg:drawing-cache-set! drawing (cons res (vg:drawing-cache drawing) ))
    res))

;; given a drawing and a inst map a text to it screen coordinates
;;
(define (vg:map-text drawing inst obj)
  (let ((res (make-vg:obj type:       't
			  fill-color: (vg:obj-fill-color obj)
			  text:       (vg:obj-text       obj)
			  line-color: (vg:obj-line-color obj)
			  font:       (vg:obj-font       obj)
			  angle:      (vg:obj-angle      obj)
			  attrib:     (vg:obj-attrib     obj)))
	(pts (vg:obj-pts obj)))
    (vg:obj-pts-set! res (vg:drawing-inst-apply-scale-offset drawing inst pts))
    (vg:drawing-cache-set! drawing (cons res (vg:drawing-cache drawing)))
    res))

;;======================================================================
;; instances
;;======================================================================

(define (vg:instances-get-extents drawing . instance-names)
  (let ((xtnt-lst (vg:draw drawing #f))

;; 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))
    ((t)(vg:draw-text 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
	      (begin
		(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-foreground-color)))
	  (canvas-rectangle! cnv llx ulx lly uly)
	  (canvas-foreground-set! cnv prev-foreground-color)))
    pts)) ;; return extents 

;; given a rect obj draw it on the canvas applying first the drawing
;; scale and offset
;;
(define (vg:draw-text drawing obj #!key (draw #t))
  (let* ((cnv        (vg:drawing-cnv drawing))
	 (pts        (vg:drawing-apply-scale drawing (vg:obj-pts obj)))
	 (text       (vg:obj-text obj))
	 (font       (vg:obj-font obj))
	 (fill-color (vg:obj-fill-color obj))
	 (line-color (vg:obj-line-color obj))
	 (llx        (car pts)) 
	 (lly        (cadr pts)))
    (if draw 
	(let* ((prev-background-color (canvas-background cnv))
	       (prev-foreground-color (canvas-foreground cnv))
	       (prev-font             (canvas-font       cnv))
	       (font-changed    (and font (not (equal? font prev-font)))))
	  (if line-color
	      (canvas-foreground-set! cnv line-color)
	      (if fill-color
		  (canvas-foreground-set! cnv prev-foreground-color)))
	  (if font-changed (canvas-font-set! cnv font))
	  (canvas-text! cnv llx lly text)
	  ;; NOTE: we do not set the font back!!
	  (canvas-foreground-set! cnv prev-foreground-color)))
    (if cnv
	(let-values (((xmax ymax)(canvas-text-size cnv text)))
	  (append pts (list (+ llx xmax)(+ lly ymax)))) ;; will be wrong if text is rotated?
	(append pts pts))))

(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))