326
327
328
329
330
331
332
333
334
335
336
337
338
339
|
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
|
+
+
+
|
(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
;;======================================================================
(define (vg:rgb->number r g b #!key (a 0))
(bitwise-ior
(arithmetic-shift a 24)
|
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
|
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
|
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(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 insts instname))
(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))))
(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))))
|