1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
|
#: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))))
#: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)
|
|
>
>
>
|
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
|
#: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)
|
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
|
(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)
;; 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))
|
>
>
>
>
>
|
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
|
(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))
|
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
|
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))
(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))
|
|
|
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
|
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))
|