334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
|
res))
;;======================================================================
;; instances
;;======================================================================
(define (vg:instances-get-extents drawing . instance-names)
(let ((xtnt-lst (vg:draw drawing #f))
(llx #f)
(lly #f)
(ulx #f)
(uly #f))
(for-each
(lambda (extents)
(let* ((ollx (list-ref extents 0))
(olly (list-ref extents 1))
(oulx (list-ref extents 2))
(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))))
xtnt-lst)
(list llx lly ulx uly)))
(define (vg:lib-get-component lib instname)
(hash-table-ref/default (vg:lib-comps lib) instname #f))
;;======================================================================
;; color
;;======================================================================
|
|
>
>
>
>
|
|
|
|
<
<
|
|
|
|
|
<
<
<
<
|
>
|
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
|
res))
;;======================================================================
;; instances
;;======================================================================
(define (vg:instances-get-extents drawing . instance-names)
(let ((xtnt-lst (vg:draw drawing #f)))
(if (null? xtnt-lst)
#f
(let loop ((extents (car xtnt-lst))
(tal (cdr xtnt-lst))
(llx #f)
(lly #f)
(ulx #f)
(uly #f))
(let ((nllx (if llx (min llx (list-ref extents 0))(list-ref extents 0)))
(nlly (if lly (min lly (list-ref extents 1))(list-ref extents 1)))
(nulx (if ulx (max ulx (list-ref extents 2))(list-ref extents 2)))
(nuly (if uly (max uly (list-ref extents 3))(list-ref extents 3))))
(if (null? tal)
(list llx lly ulx uly)
(loop (car tal)(cdr tal) nllx nlly nulx nuly)))))))
(define (vg:lib-get-component lib instname)
(hash-table-ref/default (vg:lib-comps lib) instname #f))
;;======================================================================
;; color
;;======================================================================
|
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
|
(canvas-foreground-set! cnv prev-foreground-color)))
(if cnv
(if (eq? draw 'get-extents)
(let-values (((xmax ymax)(canvas-text-size cnv text)))
(append pts (list (+ llx xmax)(+ lly ymax)))) ;; will be wrong if text is rotated?
(append pts pts))
(append pts pts))))
(define (vg:draw drawing draw-mode . instnames)
(let ((insts (vg:drawing-insts drawing))
(res '()))
(for-each
(lambda (instname)
(let* ((inst (hash-table-ref/default insts instname #f)))
(if 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: " (vg:obj-pts obj))
(let ((obj-xfrmd (vg:map-obj drawing inst obj)))
;; (print "obj-xfrmd: " (vg:obj-pts obj-xfrmd))
(set! res (cons (vg:draw-obj drawing obj-xfrmd draw: draw-mode) res)))) ;;
(vg:comp-objs comp)))
(print "no such instance " instname))))
(if (null? instnames)
(hash-table-keys insts)
instnames))
res)) ;; (hash-table-values insts))))
|
|
<
<
<
<
<
<
|
|
|
>
|
>
|
|
|
>
|
<
|
<
<
|
>
>
>
>
>
|
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
|
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
|
(canvas-foreground-set! cnv prev-foreground-color)))
(if cnv
(if (eq? draw 'get-extents)
(let-values (((xmax ymax)(canvas-text-size cnv text)))
(append pts (list (+ llx xmax)(+ lly ymax)))) ;; will be wrong if text is rotated?
(append pts pts))
(append pts pts))))
(define (vg:draw-inst drawing inst #!key (draw-mode #t)(prev-extents '()))
(let* ((libname (vg:inst-libname inst))
(compname (vg:inst-compname inst))
(comp (vg:get-component drawing libname compname))
(objs (vg:comp-objs comp)))
;; (print "comp: " comp)
(if (null? objs)
prev-extents
(let loop ((obj (car objs))
(tal (cdr objs))
(res prev-extents))
(let* ((obj-xfrmd (vg:map-obj drawing inst obj))
(newres (cons (vg:draw-obj drawing obj-xfrmd draw: draw-mode) res)))
(if (null? tal)
newres
(loop (car tal)(cdr tal) newres)))))))
(define (vg:draw drawing draw-mode . instnames)
(let* ((insts (vg:drawing-insts drawing))
(all-inst-names (hash-table-keys insts))
(master-list (if (null? instnames)
all-inst-names
instnames)))
(if (null? master-list)
'()
(let loop ((instname (car master-list))
(tal (cdr master-list))
(res '()))
(let* ((inst (hash-table-ref/default insts instname #f))
(newres (if inst
(vg:draw-inst drawing inst draw-mode: draw-mode prev-extents: res)
res)))
(if (null? tal)
newres
(loop (car tal)(cdr tal) newres)))))))
|