Megatest

Check-in [d681096cd6]
Login
Overview
Comment:Added changes for lines to graph
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: d681096cd6a7b3cb17b1479c1ec56e37ba42738c
User & Date: ritikaag on 2016-08-03 14:43:20
Other Links: branch diff | manifest | tags
Context
2016-08-03
16:26
Improvements to graph check-in: 2a00bcf6b3 user: mrwellan tags: v1.61
15:54
updated web api check-in: f8b41f4fe3 user: pjhatwal tags: v1.61
14:43
Added changes for lines to graph check-in: d681096cd6 user: ritikaag tags: v1.61
2016-08-02
11:43
Added crude labels for graph check-in: 339230da14 user: mrwellan tags: v1.61
Changes

Modified dashboard.scm from [86509bb1ce] to [334a650ad8].

2727
2728
2729
2730
2731
2732
2733

2734
2735

2736
2737

2738
2739
2740

2741




2742
2743
2744
2745
2746
2747
2748
2749
			(vg:add-obj-to-comp
			 cmp 
			 (vg:make-text-obj (- llx 10)(yfunc minval) (conc minval)))
			(fold 
			 (lambda (next prev)  ;; #(time ? val) #(time ? val)
			   (if prev
			       (let* ((yval       (vector-ref prev 2))

				      (last-tval  (tfn   (vector-ref prev 0)))
				      (last-yval  (yfunc yval)) ;; (+ lly (* yscale (vector-ref prev 2))))

				      (curr-tval  (tfn   (vector-ref next 0))))
				 (if (>= curr-tval last-tval)

				     (vg:add-obj-to-comp
				      cmp 
				      (vg:make-rect-obj last-tval lly curr-tval last-yval ;; (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))

							fill-color: stdcolor




							line-color: stdcolor))
				     (print "ERROR: curr-tval is not > last-tval; curr-tval " curr-tval ", last-tval " last-tval))))
			   next)
			 ;; for init create vector tstart,0
			 #f ;; (vector tstart minval minval)
			 dat)
			   
			 ;; (for-each







>


>


>
|
|
|
>
|
>
>
>
>
|







2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
			(vg:add-obj-to-comp
			 cmp 
			 (vg:make-text-obj (- llx 10)(yfunc minval) (conc minval)))
			(fold 
			 (lambda (next prev)  ;; #(time ? val) #(time ? val)
			   (if prev
			       (let* ((yval       (vector-ref prev 2))
                                      (yval-next  (vector-ref next 2))
				      (last-tval  (tfn   (vector-ref prev 0)))
				      (last-yval  (yfunc yval)) ;; (+ lly (* yscale (vector-ref prev 2))))
                                      (next-yval  (yfunc yval-next))
				      (curr-tval  (tfn   (vector-ref next 0))))
				 (if (>= curr-tval last-tval)
                                     (begin
                                       (vg:add-obj-to-comp
                                        cmp 
                                        ;;(vg:make-rect-obj last-tval lly curr-tval last-yval ;; (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
                                        (vg:make-line-obj last-tval last-yval curr-tval last-yval
                                                          line-color: stdcolor))
                                       (vg:add-obj-to-comp
                                        cmp 
                                        ;;(vg:make-rect-obj last-tval lly curr-tval last-yval ;; (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
                                        (vg:make-line-obj curr-tval last-yval curr-tval next-yval
                                                 line-color: stdcolor)))         
				     (print "ERROR: curr-tval is not > last-tval; curr-tval " curr-tval ", last-tval " last-tval))))
			   next)
			 ;; for init create vector tstart,0
			 #f ;; (vector tstart minval minval)
			 dat)
			   
			 ;; (for-each

Modified vg-test.scm from [d11657d763] to [3a58c56b03].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
(use canvas-draw iup foof-loop)
(import canvas-draw-iup)

(load "vg.scm")

(define numtorun 1000)
;; (if (> (length (argv)) 1)
;; 		     (string->number (cadr (argv)))
;; 		     1000))

 (use trace)
 (trace 
  ;; vg:draw-rect
  ;; vg:grow-rect
  vg:get-extents-for-objs
  vg:components-get-extents
  vg:instances-get-extents
  vg:get-extents-for-two-rects)


(define d1 (vg:drawing-new))
(define l1 (vg:lib-new))
(define c1 (vg:comp-new))
(define c2 (vg:comp-new))
(define bt1 (vg:make-rect-obj 10 40 20 50 text: "A long piece of text" font: "Helvetica, -10"))












|
|
|
|
|
|
|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
(use canvas-draw iup foof-loop)
(import canvas-draw-iup)

(load "vg.scm")

(define numtorun 1000)
;; (if (> (length (argv)) 1)
;; 		     (string->number (cadr (argv)))
;; 		     1000))

 (use trace)
 ;; (trace 
 ;;  ;; vg:draw-rect
 ;;  ;; vg:grow-rect
 ;;  vg:get-extents-for-objs
 ;;  vg:components-get-extents
 ;;  vg:instances-get-extents
 ;;  vg:get-extents-for-two-rects
 ;;  canvas-line!)

(define d1 (vg:drawing-new))
(define l1 (vg:lib-new))
(define c1 (vg:comp-new))
(define c2 (vg:comp-new))
(define bt1 (vg:make-rect-obj 10 40 20 50 text: "A long piece of text" font: "Helvetica, -10"))

34
35
36
37
38
39
40


41
42
43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
      
(let ((start (current-seconds)))
  (let loop ((i 0))
    (vg:add-obj-to-comp c1 (vg:make-rect-obj 0 0 100 100))
    (if (< i numtorun)(loop (+ i 1))))
  (print "Run time: " (- (current-seconds) start)))



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

;; instantiate firstlib/firstcomp as inst1 in drawing d1 at 0,0
(vg:instantiate d1 "firstlib" "firstcomp" "inst1" 0 0)
(vg:instantiate d1 "firstlib" "firstcomp" "inst2" 200 200)


;; (vg:drawing-scalex-set! d1 1.1)
;; (vg:drawing-scaley-set! d1 0.5)

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







>
>










>







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
      
(let ((start (current-seconds)))
  (let loop ((i 0))
    (vg:add-obj-to-comp c1 (vg:make-rect-obj 0 0 100 100))
    (if (< i numtorun)(loop (+ i 1))))
  (print "Run time: " (- (current-seconds) start)))

(vg:add-obj-to-comp c1 (vg:make-line-obj 0 0 100 100))

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

;; instantiate firstlib/firstcomp as inst1 in drawing d1 at 0,0
(vg:instantiate d1 "firstlib" "firstcomp" "inst1" 0 0)
(vg:instantiate d1 "firstlib" "firstcomp" "inst2" 200 200)


;; (vg:drawing-scalex-set! d1 1.1)
;; (vg:drawing-scaley-set! d1 0.5)

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

Modified vg.scm from [956a3fc218] to [5fae70cb5b].

135
136
137
138
139
140
141

142
143
144
145
146
147
148
;;======================================================================

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








>







135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
;;======================================================================

;; get extents, use knowledge of type ...
;;
(define (vg:obj-get-extents drawing obj)
  (let ((type (vg:obj-type obj)))
    (case type
      ((l)(vg:rect-get-extents obj))
      ((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

386
387
388
389
390
391
392

393
394
395
396
397
398
399

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







>







387
388
389
390
391
392
393
394
395
396
397
398
399
400
401

;; 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)
    ((l)(vg:draw-line drawing obj draw: draw))
    ((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))
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
	(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-line! cnv llx ulx lly uly)
	  (canvas-foreground-set! cnv prev-foreground-color)
	  (if text 
	      (let* ((prev-font    (canvas-font cnv))
		     (font-changed (and font (not (equal? font prev-font)))))
		(if font-changed (canvas-font-set! cnv font))
		(canvas-text! cnv (+ 2 llx)(+ 2 lly) text)
		(let-values (((xmax ymax)(canvas-text-size cnv text)))







|
|
|
|







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
	(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-line! cnv llx lly ulx uly)
	  (canvas-foreground-set! cnv prev-foreground-color)
	  (if text 
	      (let* ((prev-font    (canvas-font cnv))
		     (font-changed (and font (not (equal? font prev-font)))))
		(if font-changed (canvas-font-set! cnv font))
		(canvas-text! cnv (+ 2 llx)(+ 2 lly) text)
		(let-values (((xmax ymax)(canvas-text-size cnv text)))