Megatest

Diff
Login

Differences From Artifact [a343609fb9]:

To Artifact [350c9e115f]:


166
167
168
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
166
167
168
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








-
-
+
+
-
-
-

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

-
+







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

(define (vg:components-get-extents drawing . comps)
  (let ((llx #f)
(define (vg:get-extents-for-objs drawing objs)
  (let ((extents #f))
	(lly #f)
	(ulx #f)
	(uly #f))
    (for-each
     (lambda (comp)
       (let ((objs (vg:comp-objs comp)))
	 (for-each
	  (lambda (obj)
	    (let* ((extents (vg:obj-get-extents drawing obj))
		   (ollx    (list-ref extents 0))
		   (olly    (list-ref extents 1))
		   (oulx    (list-ref extents 2))
     (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)
	  #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
		   (ouly    (list-ref extents 3)))
	      (if (or (not llx)(< ollx llx))(set! llx ollx))
	      (if (or (not lly)(< olly lly))(set! lly olly))
	      (if (or (not ulx)(> oulx ulx))(set! ulx oulx))
	      (if (or (not uly)(> ouly uly))(set! uly ouly))))
	  objs)))
	    (vg:get-extents-for-objs drawing objs)))))
     comps)
    (list llx lly ulx uly)))
    extents))

;;======================================================================
;; libraries
;;======================================================================

;; register lib with drawing

336
337
338
339
340
341
342







343

344
345
346
347
348
349
350
348
349
350
351
352
353
354
355
356
357
358
359
360
361

362
363
364
365
366
367
368
369







+
+
+
+
+
+
+
-
+







	  (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)
		(if font-changed (canvas-font-set! cnv prev-font))))))
    (if (not text)
	pts
	(if cnv
	    (let-values (((xmax ymax)(canvas-text-size cnv text)))
	      (list llx lly
		    (max ulx (+ llx xmax))
		    (max uly (+ lly ymax))))
    pts)) ;; return extents 
	    pts)))) ;; return extents 

;; given a rect obj draw it on the canvas applying first the drawing
;; scale and offset
;;
(define (vg:draw-text drawing obj #!key (draw #t))
  (let* ((cnv        (vg:drawing-cnv drawing))
	 (pts        (vg:drawing-apply-scale drawing (vg:obj-pts obj)))