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
|
(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
;; 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 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 ...
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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 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 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
|
;; 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)) )
(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))
|
|
|
|
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 (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
|
(if lib
lib
(let ((newlib (vg:lib-new)))
(vg:add-lib drawing libname newlib)
newlib))))
;;======================================================================
;; map objects given offset, scale and mirror
;;======================================================================
(define (vg:map-obj xoff yoff theta scale mirrx mirry obj)
(case (vg:obj-type obj)
((r)(vg:map-rect xoff yoff theta scale mirrx mirry obj))
(else #f)))
(define (vg:map-rect xoff yoff theta scale mirrx mirry 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
(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)
(print "obj type: " (vg:obj-type obj))
(case (vg:obj-type obj)
((r)(vg:draw-rect cnv obj))))
(define (vg:draw-rect cnv obj)
(let* ((pts (vg:obj-pts obj))
(llx (car pts))
(lly (cadr pts))
(urx (caddr pts))
(ury (cadddr pts)))
(print "(canvas-rectangle! " cnv " " llx " " urx " " lly " " ury ")")
(canvas-rectangle! cnv llx urx lly ury)
))
(define (vg:draw 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))
(vg:draw-obj cnv (vg:map-obj xoff yoff theta scale mirrx mirry obj)))
(vg:comp-objs comp))))
(hash-table-values insts))))
|
|
>
>
|
|
>
>
|
|
<
<
<
<
|
|
|
|
|
<
<
<
<
|
<
|
<
<
<
<
<
<
<
|
|
|
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, resulting obj is displayed
;;======================================================================
;; 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))
(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))
res))
;;======================================================================
;; Unravel and draw the objects
;;======================================================================
(define (vg:draw-obj drawing obj)
(print "obj type: " (vg:obj-type obj))
(case (vg:obj-type obj)
((r)(vg:draw-rect drawing obj))))
(define (vg:draw-rect drawing obj)
(let* ((cnv (vg:drawing-cnv drawing))
(pts (vg:drawing-apply-scale drawing (vg:obj-pts obj))))
(apply canvas-rectangle! cnv pts)))
(define (vg:draw drawing)
(let ((insts (vg:drawing-insts drawing)))
(for-each
(lambda (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 drawing (vg:map-obj drawing inst obj)))
(vg:comp-objs comp))))
(hash-table-values insts))))
|