11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use defstruct srfi-1)
(declare (unit vg))
(use canvas-draw iup)
(import canvas-draw-iup)
;; structs
;;
(defstruct vg:lib comps)
(defstruct vg:comp objs name file)
;; extents caches extents calculated on draw
;; proc is called on draw and takes the obj itself as a parameter
;; attrib is an alist of parameters
(defstruct vg:obj type pts fill-color text line-color call-back angle font attrib extents proc)
(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))
(define (vg:lib-new)
|
>
>
>
|
|
|
|
|
|
|
|
|
|
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use defstruct srfi-1)
(declare (unit vg))
(use canvas-draw iup)
(import canvas-draw-iup)
(include "vg_records.scm")
;; ;; structs
;; ;;
;; (defstruct vg:lib comps)
;; (defstruct vg:comp objs name file)
;; ;; extents caches extents calculated on draw
;; ;; proc is called on draw and takes the obj itself as a parameter
;; ;; attrib is an alist of parameters
;; (defstruct vg:obj type pts fill-color text line-color call-back angle font attrib extents proc)
;; (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))
(define (vg:lib-new)
|
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
226
227
228
229
230
231
232
233
234
235
|
;; 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:get-extents-for-objs drawing objs)
(let ((extents #f))
(for-each
(lambda (obj)
(set! extents
(vg:get-extents-for-two-rects
extents
(vg:obj-get-extents drawing obj))))
objs)
extents))
;; given rectangles r1 and r2, return the box that bounds both
;;
(define (vg:get-extents-for-two-rects r1 r2)
(if (not r1)
r2
(if (not r2)
r1 ;; #f ;; no extents from #f #f
(list (min (car r1)(car r2)) ;; llx
(min (cadr r1)(cadr r2)) ;; lly
(max (caddr r1)(caddr r2)) ;; ulx
(max (cadddr r1)(cadddr r2)))))) ;; uly
(define (vg:components-get-extents drawing . comps)
(let ((extents #f))
(for-each
(lambda (comp)
(let* ((objs (vg:comp-objs comp)))
(set! extents
(vg:get-extents-for-two-rects
extents
(vg:get-extents-for-objs drawing objs)))))
comps)
extents))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
>
>
>
>
|
<
<
|
|
|
|
>
|
<
>
|
>
|
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
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
;; 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:get-extents-for-objs drawing objs)
(if (or (not objs)
(null? objs))
#f
(let loop ((hed (car objs))
(tal (cdr objs))
(extents (vg:obj-get-extents drawing (car objs))))
(let ((newextents
(vg:get-extents-for-two-rects
extents
(vg:obj-get-extents drawing hed))))
(if (null? tal)
extents
(loop (car tal)(cdr tal) newextents))))))
;; (let ((extents #f))
;; (for-each
;; (lambda (obj)
;; (set! extents
;; (vg:get-extents-for-two-rects
;; extents
;; (vg:obj-get-extents drawing obj))))
;; objs)
;; extents))
;; given rectangles r1 and r2, return the box that bounds both
;;
(define (vg:get-extents-for-two-rects r1 r2)
(if (not r1)
r2
(if (not r2)
r1 ;; #f ;; no extents from #f #f
(list (min (car r1)(car r2)) ;; llx
(min (cadr r1)(cadr r2)) ;; lly
(max (caddr r1)(caddr r2)) ;; ulx
(max (cadddr r1)(cadddr r2)))))) ;; uly
(define (vg:components-get-extents drawing . comps)
(if (null? comps)
#f
(let loop ((hed (car comps))
(tal (cdr comps))
(extents #f))
(let* ((objs (vg:comp-objs hed))
(newextents (if extents
(vg:get-extents-for-two-rects
extents
(vg:get-extents-for-objs drawing objs))
(vg:get-extents-for-objs drawing objs))))
(if (null? tal)
newextents
(loop (car tal)(cdr tal) newextents))))))
;;======================================================================
;; libraries
;;======================================================================
;; register lib with drawing
|