Megatest

Diff
Login

Differences From Artifact [eb7981f441]:

To Artifact [ff6b4c8f1a]:


16
17
18
19
20
21
22
23
24


25
26
27
28
29
30
31
32
33
34
35



















































36
37
38
39
40
41
42
16
17
18
19
20
21
22


23
24
25
26
27
28
29
30
31
32
33
34

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92







-
-
+
+










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







(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 font)
(defstruct vg:inst    libname compname theta xoff yoff scale mirrx mirry call-back)
(defstruct vg:drawing libs insts cnv) ;; libs: hash of name->lib, insts: hash of instname->inst
(defstruct vg:inst    libname compname theta xoff yoff scalex scaley mirrx mirry call-back)
(defstruct vg:drawing libs insts scalex scaley xoff yoff cnv) ;; libs: hash of name->lib, insts: hash of instname->inst

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

(define (vg:lib-new)
  (make-vg:lib comps: (make-hash-table)))

(define (vg:drawing-new)
  (make-vg:drawing libs: (make-hash-table) insts: (make-hash-table)))
  (make-vg:drawing scalex: 1 scaley: 1 xoff: 0 yoff: 0 libs: (make-hash-table) insts: (make-hash-table)))

;;======================================================================
;; scaling and offsets
;;======================================================================

(define-inline (vg:scale-offset val s o)
  (+ o (* val s)))

;; apply scale and offset to a list of x y values
;;
(define (vg:scale-offset-xy lstxy sx sy ox oy)
  (if (> (length lstxy) 1) ;; have at least one xy pair
      (let loop ((x   (car lstxy))
		 (y   (cadr lstxy))
		 (tal (cddr lstxy))
		 (res '()))
	(let ((newres (cons (vg:scale-offset y sy oy)
			    (cons (vg:scale-offset x sx ox)
				  res))))
	  (if (> (length tal) 1)
	      (loop (car tal)(cadr tal)(cddr tal) newres)
	      (reverse newres))))
      '()))

;; apply drawing offset and scaling to the points in lstxy
;;
(define (vg:drawing-apply-scale drawing lstxy)
  (vg:scale-offset-xy 
   lstxy
   (vg:drawing-scalex drawing)
   (vg:drawing-scaley drawing)
   (vg:drawing-xoff   drawing)
   (vg:drawing-yoff   drawing)))

;; apply instance offset and scaling to the points in lstxy
;;
(define (vg:inst-apply-scale inst lstxy)
  (vg:scale-offset-xy 
   lstxy
   (vg:inst-scalex inst)
   (vg:inst-scaley inst)
   (vg:inst-xoff   inst)
   (vg:inst-yoff   inst)))

;; apply both drawing and instance scaling to a list of xy points
;; 
(define (vg:drawing-inst-apply-scale-offset drawing inst lstxy)
  (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))

;; get extents, use knowledge of type ...
66
67
68
69
70
71
72
73
74


75
76
77
78
79
80
81
116
117
118
119
120
121
122


123
124
125
126
127
128
129
130
131







-
-
+
+







;; add comp to lib
;;
(define (vg:add-comp-to-lib lib compname comp)
  (hash-table-set! (vg:lib-comps lib) compname comp))

;; instanciate component in drawing
;;
(define (vg:instantiate drawing libname compname instname xoff yoff t #!key (scale 1)(mirrx #f)(mirry #f))
  (let ((inst (make-vg:inst libname: libname compname: compname xoff: xoff yoff: yoff theta: t scale: scale mirrx: mirrx mirry: mirry)) )
(define (vg:instantiate drawing libname compname instname xoff yoff t #!key (scalex 1)(scaley 1)(mirrx #f)(mirry #f))
  (let ((inst (make-vg:inst libname: libname compname: compname xoff: xoff yoff: yoff theta: t scalex: scalex scaley: scaley mirrx: mirrx mirry: mirry)) )
    (hash-table-set! (vg:drawing-insts drawing) instname inst)))

;; 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))
119
120
121
122
123
124
125
126

127
128


129

130
131

132
133


134

135
136
137
138
139
140
141

142
143
144
145
146
147
148
149
150
151
152

153
154
155

156
157
158
159



160
161
162
163
164

165
166
167
168

169
170
171
172
173
174
175
176
177
178

179
180
181
182
183
184
185

186
187
169
170
171
172
173
174
175

176
177
178
179
180

181
182

183
184
185
186
187

188
189
190
191
192
193
194

195




196
197
198
199
200
201

202
203
204

205
206



207
208
209





210

211
212

213

214
215







216
217
218
219
220
221
222

223
224
225







-
+


+
+
-
+

-
+


+
+
-
+






-
+
-
-
-
-






-
+


-
+

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


-
+
-


-
-
-
-
-
-
-
+






-
+


    (if lib
	lib
	(let ((newlib (vg:lib-new)))
	  (vg:add-lib drawing libname newlib)
	  newlib))))

;;======================================================================
;; map objects given offset, scale and mirror
;; map objects given offset, scale and mirror, resulting obj is displayed
;;======================================================================

;; dispatch the drawing of obj off to the correct drawing routine
;;
(define (vg:map-obj xoff yoff theta scale mirrx mirry obj)
(define (vg:map-obj drawing inst obj)
  (case (vg:obj-type obj)
    ((r)(vg:map-rect xoff yoff theta scale mirrx mirry obj))
    ((r)(vg:map-rect drawing inst obj))
    (else #f)))

;; given a drawing and a inst map a rectangle to it screen coordinates
;;
(define (vg:map-rect xoff yoff theta scale mirrx mirry obj)
(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:obj-pts-set! res (vg:drawing-inst-apply-scale-offset drawing inst pts))
		     (list (+ xoff (car pts))
			   (+ yoff (cadr pts))
			   (+ xoff (caddr pts))
			   (+ yoff (cadddr pts))))
    res))

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

(define (vg:draw-obj cnv obj)
(define (vg:draw-obj drawing obj)
  (print "obj type: " (vg:obj-type obj))
  (case (vg:obj-type obj)
    ((r)(vg:draw-rect cnv obj))))
    ((r)(vg:draw-rect drawing obj))))

(define (vg:draw-rect cnv obj)
  (let* ((pts (vg:obj-pts obj))
	 (llx (car pts))
(define (vg:draw-rect drawing obj)
  (let* ((cnv (vg:drawing-cnv drawing))
	 (pts (vg:drawing-apply-scale drawing (vg:obj-pts obj))))
	 (lly (cadr pts))
	 (urx (caddr pts))
	 (ury (cadddr pts)))
    (print "(canvas-rectangle! " cnv " " llx " " urx " " lly " " ury ")")
    (canvas-rectangle! cnv llx urx lly ury)
    (apply canvas-rectangle! cnv pts)))
    ))

(define (vg:draw drawing)
  (let ((insts (vg:drawing-insts drawing))
  (let ((insts (vg:drawing-insts drawing)))
	(cnv   (vg:drawing-cnv   drawing)))
    (for-each 
     (lambda (inst)
       (let* ((xoff     (vg:inst-xoff inst))
	      (yoff     (vg:inst-yoff inst))
	      (theta    (vg:inst-theta inst))
	      (scale    (vg:inst-scale inst))
	      (mirrx    (vg:inst-mirrx inst))
	      (mirry    (vg:inst-mirry inst))
	      (libname  (vg:inst-libname inst))
       (let* ((libname  (vg:inst-libname inst))
	      (compname (vg:inst-compname inst))
	      (comp     (vg:get-component drawing libname compname)))
	 (print "comp: " comp)
	 (for-each
	  (lambda (obj)
	    (print "obj: " obj)
	    (vg:draw-obj cnv (vg:map-obj xoff yoff theta scale mirrx mirry obj)))
	    (vg:draw-obj drawing (vg:map-obj drawing inst obj)))
	  (vg:comp-objs comp))))
    (hash-table-values insts))))