Artifact
2f4cfbf9d930be8ee604f1357ff2ffcd624ab09a:
0000: 3b 3b 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 ;;.;; Copyright
0010: 32 30 31 36 20 20 4d 61 74 74 68 65 77 20 57 65 2016 Matthew We
0020: 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 lland..;; .;; Th
0030: 69 73 20 66 69 6c 65 20 69 73 20 70 61 72 74 20 is file is part
0040: 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a 3b 3b 20 of Megatest..;;
0050: 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 .;; Megatest
0060: 20 69 73 20 66 72 65 65 20 73 6f 66 74 77 61 72 is free softwar
0070: 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 64 69 73 e: you can redis
0080: 74 72 69 62 75 74 65 20 69 74 20 61 6e 64 2f 6f tribute it and/o
0090: 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 20 20 20 r modify.;;
00a0: 69 74 20 75 6e 64 65 72 20 74 68 65 20 74 65 72 it under the ter
00b0: 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 20 47 65 ms of the GNU Ge
00c0: 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 neral Public Lic
00d0: 65 6e 73 65 20 61 73 20 70 75 62 6c 69 73 68 65 ense as publishe
00e0: 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 68 65 20 d by.;; the
00f0: 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 46 6f Free Software Fo
0100: 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 65 72 undation, either
0110: 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 74 68 version 3 of th
0120: 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a 3b 3b e License, or.;;
0130: 20 20 20 20 20 28 61 74 20 79 6f 75 72 20 6f 70 (at your op
0140: 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 65 72 20 tion) any later
0150: 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 version..;; .;;
0160: 20 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 Megatest is
0170: 64 69 73 74 72 69 62 75 74 65 64 20 69 6e 20 74 distributed in t
0180: 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 74 20 he hope that it
0190: 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c 0a will be useful,.
01a0: 3b 3b 20 20 20 20 20 62 75 74 20 57 49 54 48 4f ;; but WITHO
01b0: 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b UT ANY WARRANTY;
01c0: 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 without even th
01d0: 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 61 6e e implied warran
01e0: 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 4d 45 52 ty of.;; MER
01f0: 43 48 41 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 CHANTABILITY or
0200: 46 49 54 4e 45 53 53 20 46 4f 52 20 41 20 50 41 FITNESS FOR A PA
0210: 52 54 49 43 55 4c 41 52 20 50 55 52 50 4f 53 45 RTICULAR PURPOSE
0220: 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b 20 20 20 . See the.;;
0230: 20 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 GNU General Pu
0240: 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 6f 72 blic License for
0250: 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e 0a 3b more details..;
0260: 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 20 73 68 ; .;; You sh
0270: 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 69 76 ould have receiv
0280: 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68 65 ed a copy of the
0290: 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 62 GNU General Pub
02a0: 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b 3b 20 20 lic License.;;
02b0: 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 20 4d 65 along with Me
02c0: 67 61 74 65 73 74 2e 20 20 49 66 20 6e 6f 74 2c gatest. If not,
02d0: 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f 77 77 77 see <http://www
02e0: 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 65 .gnu.org/license
02f0: 73 2f 3e 2e 0a 0a 3b 3b 20 20 73 74 72 66 74 69 s/>...;; strfti
0300: 6d 65 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 3a me('%m/%d/%Y %H:
0310: 25 4d 3a 25 53 27 2c 27 6e 6f 77 27 2c 27 6c 6f %M:%S','now','lo
0320: 63 61 6c 74 69 6d 65 27 29 0a 0a 3b 3b 20 3b 3b caltime')..;; ;;
0330: 20 73 74 72 75 63 74 73 0a 3b 3b 20 3b 3b 0a 3b structs.;; ;;.;
0340: 3b 20 28 64 65 66 73 74 72 75 63 74 20 76 67 3a ; (defstruct vg:
0350: 6c 69 62 20 20 20 20 20 63 6f 6d 70 73 29 0a 3b lib comps).;
0360: 3b 20 28 64 65 66 73 74 72 75 63 74 20 76 67 3a ; (defstruct vg:
0370: 63 6f 6d 70 20 20 20 20 6f 62 6a 73 20 6e 61 6d comp objs nam
0380: 65 20 66 69 6c 65 29 0a 3b 3b 20 3b 3b 20 65 78 e file).;; ;; ex
0390: 74 65 6e 74 73 20 63 61 63 68 65 73 20 65 78 74 tents caches ext
03a0: 65 6e 74 73 20 63 61 6c 63 75 6c 61 74 65 64 20 ents calculated
03b0: 6f 6e 20 64 72 61 77 0a 3b 3b 20 3b 3b 20 70 72 on draw.;; ;; pr
03c0: 6f 63 20 69 73 20 63 61 6c 6c 65 64 20 6f 6e 20 oc is called on
03d0: 64 72 61 77 20 61 6e 64 20 74 61 6b 65 73 20 74 draw and takes t
03e0: 68 65 20 6f 62 6a 20 69 74 73 65 6c 66 20 61 73 he obj itself as
03f0: 20 61 20 70 61 72 61 6d 65 74 65 72 0a 3b 3b 20 a parameter.;;
0400: 3b 3b 20 61 74 74 72 69 62 20 69 73 20 61 6e 20 ;; attrib is an
0410: 61 6c 69 73 74 20 6f 66 20 70 61 72 61 6d 65 74 alist of paramet
0420: 65 72 73 0a 3b 3b 20 28 64 65 66 73 74 72 75 63 ers.;; (defstruc
0430: 74 20 76 67 3a 6f 62 6a 20 20 20 20 20 74 79 70 t vg:obj typ
0440: 65 20 70 74 73 20 66 69 6c 6c 2d 63 6f 6c 6f 72 e pts fill-color
0450: 20 74 65 78 74 20 6c 69 6e 65 2d 63 6f 6c 6f 72 text line-color
0460: 20 63 61 6c 6c 2d 62 61 63 6b 20 61 6e 67 6c 65 call-back angle
0470: 20 66 6f 6e 74 20 61 74 74 72 69 62 20 65 78 74 font attrib ext
0480: 65 6e 74 73 20 70 72 6f 63 29 0a 3b 3b 20 28 64 ents proc).;; (d
0490: 65 66 73 74 72 75 63 74 20 76 67 3a 69 6e 73 74 efstruct vg:inst
04a0: 20 20 20 20 6c 69 62 6e 61 6d 65 20 63 6f 6d 70 libname comp
04b0: 6e 61 6d 65 20 74 68 65 74 61 20 78 6f 66 66 20 name theta xoff
04c0: 79 6f 66 66 20 73 63 61 6c 65 78 20 73 63 61 6c yoff scalex scal
04d0: 65 79 20 6d 69 72 72 78 20 6d 69 72 72 79 20 63 ey mirrx mirry c
04e0: 61 6c 6c 2d 62 61 63 6b 20 63 61 63 68 65 29 0a all-back cache).
04f0: 3b 3b 20 28 64 65 66 73 74 72 75 63 74 20 76 67 ;; (defstruct vg
0500: 3a 64 72 61 77 69 6e 67 20 6c 69 62 73 20 69 6e :drawing libs in
0510: 73 74 73 20 73 63 61 6c 65 78 20 73 63 61 6c 65 sts scalex scale
0520: 79 20 78 6f 66 66 20 79 6f 66 66 20 63 6e 76 20 y xoff yoff cnv
0530: 63 61 63 68 65 29 20 3b 3b 20 6c 69 62 73 3a 20 cache) ;; libs:
0540: 68 61 73 68 20 6f 66 20 6e 61 6d 65 2d 3e 6c 69 hash of name->li
0550: 62 2c 20 69 6e 73 74 73 3a 20 68 61 73 68 20 6f b, insts: hash o
0560: 66 20 69 6e 73 74 6e 61 6d 65 2d 3e 69 6e 73 74 f instname->inst
0570: 0a 0a 3b 3b 20 69 6e 69 74 73 0a 3b 3b 0a 28 64 ..;; inits.;;.(d
0580: 65 66 69 6e 65 20 28 76 67 3a 63 6f 6d 70 2d 6e efine (vg:comp-n
0590: 65 77 29 0a 20 20 28 6d 61 6b 65 2d 76 67 3a 63 ew). (make-vg:c
05a0: 6f 6d 70 20 6f 62 6a 73 3a 20 27 28 29 20 6e 61 omp objs: '() na
05b0: 6d 65 3a 20 23 66 20 66 69 6c 65 3a 20 23 66 29 me: #f file: #f)
05c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 6c )..(define (vg:l
05d0: 69 62 2d 6e 65 77 29 0a 20 20 28 6d 61 6b 65 2d ib-new). (make-
05e0: 76 67 3a 6c 69 62 20 63 6f 6d 70 73 3a 20 28 6d vg:lib comps: (m
05f0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
0600: 29 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 64 )..(define (vg:d
0610: 72 61 77 69 6e 67 2d 6e 65 77 29 0a 20 20 28 6d rawing-new). (m
0620: 61 6b 65 2d 76 67 3a 64 72 61 77 69 6e 67 20 73 ake-vg:drawing s
0630: 63 61 6c 65 78 3a 20 31 20 0a 09 09 20 20 20 73 calex: 1 ... s
0640: 63 61 6c 65 79 3a 20 31 20 0a 09 09 20 20 20 78 caley: 1 ... x
0650: 6f 66 66 3a 20 30 20 0a 09 09 20 20 20 79 6f 66 off: 0 ... yof
0660: 66 3a 20 30 20 0a 09 09 20 20 20 6c 69 62 73 3a f: 0 ... libs:
0670: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0680: 65 29 20 0a 09 09 20 20 20 69 6e 73 74 73 3a 20 e) ... insts:
0690: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
06a0: 29 0a 09 09 20 20 20 63 61 63 68 65 3a 20 27 28 )... cache: '(
06b0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
06c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
0700: 20 73 63 61 6c 69 6e 67 20 61 6e 64 20 6f 66 66 scaling and off
0710: 73 65 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d sets.;;=========
0720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
0760: 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 76 define-inline (v
0770: 67 3a 73 63 61 6c 65 2d 6f 66 66 73 65 74 20 76 g:scale-offset v
0780: 61 6c 20 73 20 6f 29 0a 20 20 28 2b 20 6f 20 28 al s o). (+ o (
0790: 2a 20 76 61 6c 20 73 29 29 29 0a 20 20 3b 3b 20 * val s))). ;;
07a0: 28 2a 20 28 2b 20 6f 20 76 61 6c 29 20 73 29 29 (* (+ o val) s))
07b0: 0a 0a 3b 3b 20 61 70 70 6c 79 20 73 63 61 6c 65 ..;; apply scale
07c0: 20 61 6e 64 20 6f 66 66 73 65 74 20 74 6f 20 61 and offset to a
07d0: 20 6c 69 73 74 20 6f 66 20 78 20 79 20 76 61 6c list of x y val
07e0: 75 65 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ues.;;.(define (
07f0: 76 67 3a 73 63 61 6c 65 2d 6f 66 66 73 65 74 2d vg:scale-offset-
0800: 78 79 20 6c 73 74 78 79 20 73 78 20 73 79 20 6f xy lstxy sx sy o
0810: 78 20 6f 79 29 0a 20 20 28 69 66 20 28 3e 20 28 x oy). (if (> (
0820: 6c 65 6e 67 74 68 20 6c 73 74 78 79 29 20 31 29 length lstxy) 1)
0830: 20 3b 3b 20 68 61 76 65 20 61 74 20 6c 65 61 73 ;; have at leas
0840: 74 20 6f 6e 65 20 78 79 20 70 61 69 72 0a 20 20 t one xy pair.
0850: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
0860: 78 20 20 20 28 63 61 72 20 6c 73 74 78 79 29 29 x (car lstxy))
0870: 0a 09 09 20 28 79 20 20 20 28 63 61 64 72 20 6c ... (y (cadr l
0880: 73 74 78 79 29 29 0a 09 09 20 28 74 61 6c 20 28 stxy))... (tal (
0890: 63 64 64 72 20 6c 73 74 78 79 29 29 0a 09 09 20 cddr lstxy))...
08a0: 28 72 65 73 20 27 28 29 29 29 0a 09 28 6c 65 74 (res '()))..(let
08b0: 20 28 28 6e 65 77 72 65 73 20 28 63 6f 6e 73 20 ((newres (cons
08c0: 28 76 67 3a 73 63 61 6c 65 2d 6f 66 66 73 65 74 (vg:scale-offset
08d0: 20 79 20 73 79 20 6f 79 29 0a 09 09 09 20 20 20 y sy oy)....
08e0: 20 28 63 6f 6e 73 20 28 76 67 3a 73 63 61 6c 65 (cons (vg:scale
08f0: 2d 6f 66 66 73 65 74 20 78 20 73 78 20 6f 78 29 -offset x sx ox)
0900: 0a 09 09 09 09 20 20 72 65 73 29 29 29 29 0a 09 ..... res))))..
0910: 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 (if (> (length
0920: 20 74 61 6c 29 20 31 29 0a 09 20 20 20 20 20 20 tal) 1)..
0930: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
0940: 63 61 64 72 20 74 61 6c 29 28 63 64 64 72 20 74 cadr tal)(cddr t
0950: 61 6c 29 20 6e 65 77 72 65 73 29 0a 09 20 20 20 al) newres)..
0960: 20 20 20 28 72 65 76 65 72 73 65 20 6e 65 77 72 (reverse newr
0970: 65 73 29 29 29 29 0a 20 20 20 20 20 20 27 28 29 es)))). '()
0980: 29 29 0a 0a 3b 3b 20 61 70 70 6c 79 20 64 72 61 ))..;; apply dra
0990: 77 69 6e 67 20 6f 66 66 73 65 74 20 61 6e 64 20 wing offset and
09a0: 73 63 61 6c 69 6e 67 20 74 6f 20 74 68 65 20 70 scaling to the p
09b0: 6f 69 6e 74 73 20 69 6e 20 6c 73 74 78 79 0a 3b oints in lstxy.;
09c0: 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 64 72 ;.(define (vg:dr
09d0: 61 77 69 6e 67 2d 61 70 70 6c 79 2d 73 63 61 6c awing-apply-scal
09e0: 65 20 64 72 61 77 69 6e 67 20 6c 73 74 78 79 29 e drawing lstxy)
09f0: 0a 20 20 28 76 67 3a 73 63 61 6c 65 2d 6f 66 66 . (vg:scale-off
0a00: 73 65 74 2d 78 79 20 0a 20 20 20 6c 73 74 78 79 set-xy . lstxy
0a10: 0a 20 20 20 28 76 67 3a 64 72 61 77 69 6e 67 2d . (vg:drawing-
0a20: 73 63 61 6c 65 78 20 64 72 61 77 69 6e 67 29 0a scalex drawing).
0a30: 20 20 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 73 (vg:drawing-s
0a40: 63 61 6c 65 79 20 64 72 61 77 69 6e 67 29 0a 20 caley drawing).
0a50: 20 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 78 6f (vg:drawing-xo
0a60: 66 66 20 20 20 64 72 61 77 69 6e 67 29 0a 20 20 ff drawing).
0a70: 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 79 6f 66 (vg:drawing-yof
0a80: 66 20 20 20 64 72 61 77 69 6e 67 29 29 29 0a 0a f drawing)))..
0a90: 3b 3b 20 61 70 70 6c 79 20 69 6e 73 74 61 6e 63 ;; apply instanc
0aa0: 65 20 6f 66 66 73 65 74 20 61 6e 64 20 73 63 61 e offset and sca
0ab0: 6c 69 6e 67 20 74 6f 20 74 68 65 20 70 6f 69 6e ling to the poin
0ac0: 74 73 20 69 6e 20 6c 73 74 78 79 0a 3b 3b 0a 28 ts in lstxy.;;.(
0ad0: 64 65 66 69 6e 65 20 28 76 67 3a 69 6e 73 74 2d define (vg:inst-
0ae0: 61 70 70 6c 79 2d 73 63 61 6c 65 20 69 6e 73 74 apply-scale inst
0af0: 20 6c 73 74 78 79 29 0a 20 20 28 76 67 3a 73 63 lstxy). (vg:sc
0b00: 61 6c 65 2d 6f 66 66 73 65 74 2d 78 79 20 0a 20 ale-offset-xy .
0b10: 20 20 6c 73 74 78 79 0a 20 20 20 28 76 67 3a 69 lstxy. (vg:i
0b20: 6e 73 74 2d 73 63 61 6c 65 78 20 69 6e 73 74 29 nst-scalex inst)
0b30: 0a 20 20 20 28 76 67 3a 69 6e 73 74 2d 73 63 61 . (vg:inst-sca
0b40: 6c 65 79 20 69 6e 73 74 29 0a 20 20 20 28 76 67 ley inst). (vg
0b50: 3a 69 6e 73 74 2d 78 6f 66 66 20 20 20 69 6e 73 :inst-xoff ins
0b60: 74 29 0a 20 20 20 28 76 67 3a 69 6e 73 74 2d 79 t). (vg:inst-y
0b70: 6f 66 66 20 20 20 69 6e 73 74 29 29 29 0a 0a 3b off inst)))..;
0b80: 3b 20 61 70 70 6c 79 20 62 6f 74 68 20 64 72 61 ; apply both dra
0b90: 77 69 6e 67 20 61 6e 64 20 69 6e 73 74 61 6e 63 wing and instanc
0ba0: 65 20 73 63 61 6c 69 6e 67 20 74 6f 20 61 20 6c e scaling to a l
0bb0: 69 73 74 20 6f 66 20 78 79 20 70 6f 69 6e 74 73 ist of xy points
0bc0: 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 76 67 .;; .(define (vg
0bd0: 3a 64 72 61 77 69 6e 67 2d 69 6e 73 74 2d 61 70 :drawing-inst-ap
0be0: 70 6c 79 2d 73 63 61 6c 65 2d 6f 66 66 73 65 74 ply-scale-offset
0bf0: 20 64 72 61 77 69 6e 67 20 69 6e 73 74 20 6c 73 drawing inst ls
0c00: 74 78 79 29 0a 20 20 28 76 67 3a 64 72 61 77 69 txy). (vg:drawi
0c10: 6e 67 2d 61 70 70 6c 79 2d 73 63 61 6c 65 20 0a ng-apply-scale .
0c20: 20 20 20 64 72 61 77 69 6e 67 0a 20 20 20 28 76 drawing. (v
0c30: 67 3a 69 6e 73 74 2d 61 70 70 6c 79 2d 73 63 61 g:inst-apply-sca
0c40: 6c 65 20 69 6e 73 74 20 6c 73 74 78 79 29 29 29 le inst lstxy)))
0c50: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
0c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6f 62 ==========.;; ob
0ca0: 6a 65 63 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d jects.;;========
0cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
0cf0: 3b 3b 20 20 20 28 76 67 3a 69 6e 73 74 2d 61 70 ;; (vg:inst-ap
0d00: 70 6c 79 2d 73 63 61 6c 65 20 0a 3b 3b 20 20 20 ply-scale .;;
0d10: 20 69 6e 73 74 0a 3b 3b 20 20 20 20 28 76 67 3a inst.;; (vg:
0d20: 64 72 61 77 69 6e 67 2d 61 70 70 6c 79 2d 73 63 drawing-apply-sc
0d30: 61 6c 65 20 64 72 61 77 69 6e 67 20 6c 73 74 78 ale drawing lstx
0d40: 79 29 29 29 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 y)))..;; make a
0d50: 72 65 63 74 61 6e 67 6c 65 20 6f 62 6a 0a 3b 3b rectangle obj.;;
0d60: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 6d 61 6b .(define (vg:mak
0d70: 65 2d 72 65 63 74 2d 6f 62 6a 20 78 31 20 79 31 e-rect-obj x1 y1
0d80: 20 78 32 20 79 32 20 23 21 6b 65 79 20 28 6c 69 x2 y2 #!key (li
0d90: 6e 65 2d 63 6f 6c 6f 72 20 23 66 29 28 66 69 6c ne-color #f)(fil
0da0: 6c 2d 63 6f 6c 6f 72 20 23 66 29 28 74 65 78 74 l-color #f)(text
0db0: 20 23 66 29 28 66 6f 6e 74 20 23 66 29 28 65 78 #f)(font #f)(ex
0dc0: 74 65 6e 74 73 20 23 66 29 29 0a 20 20 28 6d 61 tents #f)). (ma
0dd0: 6b 65 2d 76 67 3a 6f 62 6a 20 74 79 70 65 3a 20 ke-vg:obj type:
0de0: 27 72 20 70 74 73 3a 20 28 6c 69 73 74 20 78 31 'r pts: (list x1
0df0: 20 79 31 20 78 32 20 79 32 29 20 74 65 78 74 3a y1 x2 y2) text:
0e00: 20 74 65 78 74 20 66 6f 6e 74 3a 20 66 6f 6e 74 text font: font
0e10: 20 6c 69 6e 65 2d 63 6f 6c 6f 72 3a 20 6c 69 6e line-color: lin
0e20: 65 2d 63 6f 6c 6f 72 20 66 69 6c 6c 2d 63 6f 6c e-color fill-col
0e30: 6f 72 3a 20 66 69 6c 6c 2d 63 6f 6c 6f 72 20 65 or: fill-color e
0e40: 78 74 65 6e 74 73 3a 20 65 78 74 65 6e 74 73 29 xtents: extents)
0e50: 29 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 72 65 63 )..;; make a rec
0e60: 74 61 6e 67 6c 65 20 6f 62 6a 0a 3b 3b 20 0a 28 tangle obj.;; .(
0e70: 64 65 66 69 6e 65 20 28 76 67 3a 6d 61 6b 65 2d define (vg:make-
0e80: 6c 69 6e 65 2d 6f 62 6a 20 78 31 20 79 31 20 78 line-obj x1 y1 x
0e90: 32 20 79 32 20 23 21 6b 65 79 20 28 6c 69 6e 65 2 y2 #!key (line
0ea0: 2d 63 6f 6c 6f 72 20 23 66 29 28 66 69 6c 6c 2d -color #f)(fill-
0eb0: 63 6f 6c 6f 72 20 23 66 29 28 74 65 78 74 20 23 color #f)(text #
0ec0: 66 29 28 66 6f 6e 74 20 23 66 29 28 65 78 74 65 f)(font #f)(exte
0ed0: 6e 74 73 20 23 66 29 29 0a 20 20 28 6d 61 6b 65 nts #f)). (make
0ee0: 2d 76 67 3a 6f 62 6a 20 74 79 70 65 3a 20 27 6c -vg:obj type: 'l
0ef0: 20 70 74 73 3a 20 28 6c 69 73 74 20 78 31 20 79 pts: (list x1 y
0f00: 31 20 78 32 20 79 32 29 20 74 65 78 74 3a 20 74 1 x2 y2) text: t
0f10: 65 78 74 20 66 6f 6e 74 3a 20 66 6f 6e 74 20 6c ext font: font l
0f20: 69 6e 65 2d 63 6f 6c 6f 72 3a 20 6c 69 6e 65 2d ine-color: line-
0f30: 63 6f 6c 6f 72 20 65 78 74 65 6e 74 73 3a 20 65 color extents: e
0f40: 78 74 65 6e 74 73 29 29 0a 0a 3b 3b 20 6d 61 6b xtents))..;; mak
0f50: 65 20 61 20 74 65 78 74 20 6f 62 6a 0a 3b 3b 0a e a text obj.;;.
0f60: 28 64 65 66 69 6e 65 20 28 76 67 3a 6d 61 6b 65 (define (vg:make
0f70: 2d 74 65 78 74 2d 6f 62 6a 20 78 31 20 79 31 20 -text-obj x1 y1
0f80: 74 65 78 74 20 23 21 6b 65 79 20 28 6c 69 6e 65 text #!key (line
0f90: 2d 63 6f 6c 6f 72 20 23 66 29 28 66 69 6c 6c 2d -color #f)(fill-
0fa0: 63 6f 6c 6f 72 20 23 66 29 0a 09 09 20 20 20 20 color #f)...
0fb0: 20 20 28 61 6e 67 6c 65 20 23 66 29 28 73 63 61 (angle #f)(sca
0fc0: 6c 65 2d 77 69 74 68 2d 7a 6f 6f 6d 20 23 66 29 le-with-zoom #f)
0fd0: 28 66 6f 6e 74 20 23 66 29 0a 09 09 20 20 20 20 (font #f)...
0fe0: 20 20 28 66 6f 6e 74 2d 73 69 7a 65 20 23 66 29 (font-size #f)
0ff0: 29 0a 20 20 28 6d 61 6b 65 2d 76 67 3a 6f 62 6a ). (make-vg:obj
1000: 20 74 79 70 65 3a 20 27 74 20 70 74 73 3a 20 28 type: 't pts: (
1010: 6c 69 73 74 20 78 31 20 79 31 29 20 74 65 78 74 list x1 y1) text
1020: 3a 20 74 65 78 74 20 0a 09 20 20 20 20 20 20 20 : text ..
1030: 6c 69 6e 65 2d 63 6f 6c 6f 72 3a 20 6c 69 6e 65 line-color: line
1040: 2d 63 6f 6c 6f 72 20 66 69 6c 6c 2d 63 6f 6c 6f -color fill-colo
1050: 72 3a 20 66 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 20 r: fill-color..
1060: 20 20 20 20 20 20 61 6e 67 6c 65 3a 20 61 6e 67 angle: ang
1070: 6c 65 20 66 6f 6e 74 3a 20 66 6f 6e 74 20 65 78 le font: font ex
1080: 74 65 6e 74 73 3a 20 23 66 0a 09 20 20 20 20 20 tents: #f..
1090: 20 20 61 74 74 72 69 62 75 74 65 73 3a 20 28 76 attributes: (v
10a0: 67 3a 6d 61 6b 65 2d 61 74 74 72 69 62 20 27 66 g:make-attrib 'f
10b0: 6f 6e 74 2d 73 69 7a 65 20 66 6f 6e 74 2d 73 69 ont-size font-si
10c0: 7a 65 29 29 29 0a 0a 3b 3b 20 70 72 6f 63 20 74 ze)))..;; proc t
10d0: 61 6b 65 73 20 73 74 61 72 74 6e 75 6d 20 61 6e akes startnum an
10e0: 64 20 65 6e 64 6e 75 6d 20 61 6e 64 20 79 69 65 d endnum and yie
10f0: 6c 64 73 20 73 63 61 6c 65 66 2c 20 70 65 72 2d lds scalef, per-
1100: 67 72 61 64 20 61 6e 64 20 75 6e 69 74 6e 61 6d grad and unitnam
1110: 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 e.;;.(define (vg
1120: 3a 6d 61 6b 65 2d 78 61 78 69 73 2d 6f 62 6a 20 :make-xaxis-obj
1130: 78 31 20 79 31 20 78 32 20 79 32 20 23 21 6b 65 x1 y1 x2 y2 #!ke
1140: 79 20 28 6c 69 6e 65 2d 63 6f 6c 6f 72 20 23 66 y (line-color #f
1150: 29 28 66 69 6c 6c 2d 63 6f 6c 6f 72 20 23 66 29 )(fill-color #f)
1160: 28 74 65 78 74 20 23 66 29 28 66 6f 6e 74 20 23 (text #f)(font #
1170: 66 29 28 70 72 6f 63 20 23 66 29 29 0a 20 20 28 f)(proc #f)). (
1180: 6d 61 6b 65 2d 76 67 3a 6f 62 6a 20 74 79 70 65 make-vg:obj type
1190: 3a 20 27 78 20 70 74 73 3a 20 28 6c 69 73 74 20 : 'x pts: (list
11a0: 78 31 20 79 31 20 78 32 20 79 32 29 20 74 65 78 x1 y1 x2 y2) tex
11b0: 74 3a 20 74 65 78 74 20 66 6f 6e 74 3a 20 66 6f t: text font: fo
11c0: 6e 74 20 6c 69 6e 65 2d 63 6f 6c 6f 72 3a 20 6c nt line-color: l
11d0: 69 6e 65 2d 63 6f 6c 6f 72 20 66 69 6c 6c 2d 63 ine-color fill-c
11e0: 6f 6c 6f 72 3a 20 66 69 6c 6c 2d 63 6f 6c 6f 72 olor: fill-color
11f0: 20 65 78 74 65 6e 74 73 3a 20 23 66 20 70 72 6f extents: #f pro
1200: 63 3a 20 70 72 6f 63 29 29 0a 0a 3b 3b 3d 3d 3d c: proc))..;;===
1210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1250: 3d 3d 3d 0a 3b 3b 20 6f 62 6a 20 6d 6f 64 69 66 ===.;; obj modif
1260: 69 65 72 73 20 61 6e 64 20 71 75 65 72 69 65 73 iers and queries
1270: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
1280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 =========..;; ge
12c0: 74 20 65 78 74 65 6e 74 73 2c 20 75 73 65 20 6b t extents, use k
12d0: 6e 6f 77 6c 65 64 67 65 20 6f 66 20 74 79 70 65 nowledge of type
12e0: 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 ....;;.(define
12f0: 28 76 67 3a 6f 62 6a 2d 67 65 74 2d 65 78 74 65 (vg:obj-get-exte
1300: 6e 74 73 20 64 72 61 77 69 6e 67 20 6f 62 6a 29 nts drawing obj)
1310: 0a 20 20 28 6c 65 74 20 28 28 74 79 70 65 20 28 . (let ((type (
1320: 76 67 3a 6f 62 6a 2d 74 79 70 65 20 6f 62 6a 29 vg:obj-type obj)
1330: 29 29 0a 20 20 20 20 28 63 61 73 65 20 74 79 70 )). (case typ
1340: 65 0a 20 20 20 20 20 20 28 28 6c 29 28 76 67 3a e. ((l)(vg:
1350: 72 65 63 74 2d 67 65 74 2d 65 78 74 65 6e 74 73 rect-get-extents
1360: 20 6f 62 6a 29 29 0a 20 20 20 20 20 20 28 28 72 obj)). ((r
1370: 29 28 76 67 3a 72 65 63 74 2d 67 65 74 2d 65 78 )(vg:rect-get-ex
1380: 74 65 6e 74 73 20 6f 62 6a 29 29 0a 20 20 20 20 tents obj)).
1390: 20 20 28 28 74 29 28 76 67 3a 64 72 61 77 2d 74 ((t)(vg:draw-t
13a0: 65 78 74 20 64 72 61 77 69 6e 67 20 6f 62 6a 20 ext drawing obj
13b0: 64 72 61 77 3a 20 23 66 29 29 0a 20 20 20 20 20 draw: #f)).
13c0: 20 28 65 6c 73 65 20 23 66 29 29 29 29 0a 0a 28 (else #f))))..(
13d0: 64 65 66 69 6e 65 20 28 76 67 3a 72 65 63 74 2d define (vg:rect-
13e0: 67 65 74 2d 65 78 74 65 6e 74 73 20 6f 62 6a 29 get-extents obj)
13f0: 0a 20 20 28 76 67 3a 6f 62 6a 2d 70 74 73 20 6f . (vg:obj-pts o
1400: 62 6a 29 29 20 3b 3b 20 65 78 74 65 6e 74 73 20 bj)) ;; extents
1410: 61 72 65 20 6a 75 73 74 20 74 68 65 20 70 6f 69 are just the poi
1420: 6e 74 73 20 66 6f 72 20 61 20 72 65 63 74 61 6e nts for a rectan
1430: 67 6c 65 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 gle..(define (vg
1440: 3a 67 72 6f 77 2d 72 65 63 74 20 62 6f 72 64 65 :grow-rect borde
1450: 72 78 20 62 6f 72 64 65 72 79 20 78 31 20 79 31 rx bordery x1 y1
1460: 20 78 32 20 79 32 29 0a 20 20 28 6c 69 73 74 0a x2 y2). (list.
1470: 20 20 20 28 2d 20 78 31 20 62 6f 72 64 65 72 78 (- x1 borderx
1480: 29 0a 20 20 20 28 2d 20 79 31 20 62 6f 72 64 65 ). (- y1 borde
1490: 72 79 29 0a 20 20 20 28 2b 20 78 32 20 62 6f 72 ry). (+ x2 bor
14a0: 64 65 72 78 29 0a 20 20 20 28 2b 20 79 32 20 62 derx). (+ y2 b
14b0: 6f 72 64 65 72 79 29 29 29 0a 0a 28 64 65 66 69 ordery)))..(defi
14c0: 6e 65 20 28 76 67 3a 6d 61 6b 65 2d 61 74 74 72 ne (vg:make-attr
14d0: 69 62 20 2e 20 61 74 74 72 69 62 2d 6c 69 73 74 ib . attrib-list
14e0: 29 0a 20 20 23 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d ). #f)..;;=====
14f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1530: 3d 0a 3b 3b 20 63 6f 6d 70 6f 6e 65 6e 74 73 0a =.;; components.
1540: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
1550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1580: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 61 64 64 ========..;; add
1590: 20 6f 62 6a 20 74 6f 20 63 6f 6d 70 0a 3b 3b 0a obj to comp.;;.
15a0: 28 64 65 66 69 6e 65 20 28 76 67 3a 61 64 64 2d (define (vg:add-
15b0: 6f 62 6a 73 2d 74 6f 2d 63 6f 6d 70 20 63 6f 6d objs-to-comp com
15c0: 70 20 2e 20 6f 62 6a 73 29 0a 20 20 28 76 67 3a p . objs). (vg:
15d0: 63 6f 6d 70 2d 6f 62 6a 73 2d 73 65 74 21 20 63 comp-objs-set! c
15e0: 6f 6d 70 20 28 61 70 70 65 6e 64 20 28 76 67 3a omp (append (vg:
15f0: 63 6f 6d 70 2d 6f 62 6a 73 20 63 6f 6d 70 29 20 comp-objs comp)
1600: 6f 62 6a 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 objs)))..(define
1610: 20 28 76 67 3a 61 64 64 2d 6f 62 6a 2d 74 6f 2d (vg:add-obj-to-
1620: 63 6f 6d 70 20 63 6f 6d 70 20 6f 62 6a 29 0a 20 comp comp obj).
1630: 20 28 76 67 3a 63 6f 6d 70 2d 6f 62 6a 73 2d 73 (vg:comp-objs-s
1640: 65 74 21 20 63 6f 6d 70 20 28 63 6f 6e 73 20 6f et! comp (cons o
1650: 62 6a 20 28 76 67 3a 63 6f 6d 70 2d 6f 62 6a 73 bj (vg:comp-objs
1660: 20 63 6f 6d 70 29 29 29 29 0a 0a 3b 3b 20 75 73 comp))))..;; us
1670: 65 20 74 68 65 20 73 74 72 75 63 74 2e 20 6c 65 e the struct. le
1680: 61 76 65 20 74 68 69 73 20 68 65 72 65 20 74 6f ave this here to
1690: 20 72 65 6d 69 6e 64 20 6f 66 20 74 68 69 73 21 remind of this!
16a0: 0a 3b 3b 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 .;;.;; (define (
16b0: 76 67 3a 63 6f 6d 70 2d 67 65 74 2d 6f 62 6a 73 vg:comp-get-objs
16c0: 20 63 6f 6d 70 29 0a 3b 3b 20 20 20 28 76 67 3a comp).;; (vg:
16d0: 63 6f 6d 70 2d 6f 62 6a 73 20 63 6f 6d 70 29 29 comp-objs comp))
16e0: 0a 0a 3b 3b 20 61 64 64 20 63 6f 6d 70 20 74 6f ..;; add comp to
16f0: 20 6c 69 62 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 lib.;;.(define
1700: 28 76 67 3a 61 64 64 2d 63 6f 6d 70 2d 74 6f 2d (vg:add-comp-to-
1710: 6c 69 62 20 6c 69 62 20 63 6f 6d 70 6e 61 6d 65 lib lib compname
1720: 20 63 6f 6d 70 29 0a 20 20 28 68 61 73 68 2d 74 comp). (hash-t
1730: 61 62 6c 65 2d 73 65 74 21 20 28 76 67 3a 6c 69 able-set! (vg:li
1740: 62 2d 63 6f 6d 70 73 20 6c 69 62 29 20 63 6f 6d b-comps lib) com
1750: 70 6e 61 6d 65 20 63 6f 6d 70 29 29 0a 0a 3b 3b pname comp))..;;
1760: 20 69 6e 73 74 61 6e 63 69 61 74 65 20 63 6f 6d instanciate com
1770: 70 6f 6e 65 6e 74 20 69 6e 20 64 72 61 77 69 6e ponent in drawin
1780: 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 g.;;.(define (vg
1790: 3a 69 6e 73 74 61 6e 74 69 61 74 65 20 64 72 61 :instantiate dra
17a0: 77 69 6e 67 20 6c 69 62 6e 61 6d 65 20 63 6f 6d wing libname com
17b0: 70 6e 61 6d 65 20 69 6e 73 74 6e 61 6d 65 20 78 pname instname x
17c0: 6f 66 66 20 79 6f 66 66 20 23 21 6b 65 79 20 28 off yoff #!key (
17d0: 74 68 65 74 61 20 30 29 28 73 63 61 6c 65 78 20 theta 0)(scalex
17e0: 31 29 28 73 63 61 6c 65 79 20 31 29 28 6d 69 72 1)(scaley 1)(mir
17f0: 72 78 20 23 66 29 28 6d 69 72 72 79 20 23 66 29 rx #f)(mirry #f)
1800: 29 0a 20 20 28 6c 65 74 20 28 28 69 6e 73 74 20 ). (let ((inst
1810: 28 6d 61 6b 65 2d 76 67 3a 69 6e 73 74 20 6c 69 (make-vg:inst li
1820: 62 6e 61 6d 65 3a 20 6c 69 62 6e 61 6d 65 20 63 bname: libname c
1830: 6f 6d 70 6e 61 6d 65 3a 20 63 6f 6d 70 6e 61 6d ompname: compnam
1840: 65 20 78 6f 66 66 3a 20 78 6f 66 66 20 79 6f 66 e xoff: xoff yof
1850: 66 3a 20 79 6f 66 66 20 74 68 65 74 61 3a 20 74 f: yoff theta: t
1860: 68 65 74 61 20 73 63 61 6c 65 78 3a 20 73 63 61 heta scalex: sca
1870: 6c 65 78 20 73 63 61 6c 65 79 3a 20 73 63 61 6c lex scaley: scal
1880: 65 79 20 6d 69 72 72 78 3a 20 6d 69 72 72 78 20 ey mirrx: mirrx
1890: 6d 69 72 72 79 3a 20 6d 69 72 72 79 29 29 20 29 mirry: mirry)) )
18a0: 0a 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
18b0: 2d 73 65 74 21 20 28 76 67 3a 64 72 61 77 69 6e -set! (vg:drawin
18c0: 67 2d 69 6e 73 74 73 20 64 72 61 77 69 6e 67 29 g-insts drawing)
18d0: 20 69 6e 73 74 6e 61 6d 65 20 69 6e 73 74 29 29 instname inst))
18e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 69 )..(define (vg:i
18f0: 6e 73 74 61 6e 63 65 2d 6d 6f 76 65 20 64 72 61 nstance-move dra
1900: 77 69 6e 67 20 69 6e 73 74 6e 61 6d 65 20 6e 65 wing instname ne
1910: 77 78 20 6e 65 77 79 29 0a 20 20 28 6c 65 74 20 wx newy). (let
1920: 28 28 69 6e 73 74 20 28 68 61 73 68 2d 74 61 62 ((inst (hash-tab
1930: 6c 65 2d 72 65 66 20 28 76 67 3a 64 72 61 77 69 le-ref (vg:drawi
1940: 6e 67 2d 69 6e 73 74 73 20 64 72 61 77 69 6e 67 ng-insts drawing
1950: 29 20 69 6e 73 74 6e 61 6d 65 29 29 29 0a 20 20 ) instname))).
1960: 20 20 28 76 67 3a 69 6e 73 74 2d 78 6f 66 66 2d (vg:inst-xoff-
1970: 73 65 74 21 20 69 6e 73 74 20 6e 65 77 78 29 0a set! inst newx).
1980: 20 20 20 20 28 76 67 3a 69 6e 73 74 2d 79 6f 66 (vg:inst-yof
1990: 66 2d 73 65 74 21 20 69 6e 73 74 20 6e 65 77 79 f-set! inst newy
19a0: 29 29 29 0a 0a 3b 3b 20 67 65 74 20 63 6f 6d 70 )))..;; get comp
19b0: 6f 6e 65 6e 74 20 66 72 6f 6d 20 64 72 61 77 69 onent from drawi
19c0: 6e 67 20 28 6c 6f 6f 6b 20 69 6e 20 61 70 72 6f ng (look in apro
19d0: 70 72 69 61 74 65 20 6c 69 62 29 20 67 69 76 65 priate lib) give
19e0: 6e 20 6c 69 62 6e 61 6d 65 20 61 6e 64 20 63 6f n libname and co
19f0: 6d 70 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 mpname.(define (
1a00: 76 67 3a 67 65 74 2d 63 6f 6d 70 6f 6e 65 6e 74 vg:get-component
1a10: 20 64 72 61 77 69 6e 67 20 6c 69 62 6e 61 6d 65 drawing libname
1a20: 20 63 6f 6d 70 6e 61 6d 65 29 0a 20 20 28 6c 65 compname). (le
1a30: 74 2a 20 28 28 6c 69 62 20 20 28 68 61 73 68 2d t* ((lib (hash-
1a40: 74 61 62 6c 65 2d 72 65 66 20 28 76 67 3a 64 72 table-ref (vg:dr
1a50: 61 77 69 6e 67 2d 6c 69 62 73 20 64 72 61 77 69 awing-libs drawi
1a60: 6e 67 29 20 6c 69 62 6e 61 6d 65 29 29 0a 09 20 ng) libname))..
1a70: 28 69 6e 73 74 20 28 68 61 73 68 2d 74 61 62 6c (inst (hash-tabl
1a80: 65 2d 72 65 66 20 28 76 67 3a 6c 69 62 2d 63 6f e-ref (vg:lib-co
1a90: 6d 70 73 20 6c 69 62 29 20 63 6f 6d 70 6e 61 6d mps lib) compnam
1aa0: 65 29 29 29 0a 20 20 20 20 69 6e 73 74 29 29 0a e))). inst)).
1ab0: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 67 65 74 .(define (vg:get
1ac0: 2d 65 78 74 65 6e 74 73 2d 66 6f 72 2d 6f 62 6a -extents-for-obj
1ad0: 73 20 64 72 61 77 69 6e 67 20 6f 62 6a 73 29 0a s drawing objs).
1ae0: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 6f (if (or (not o
1af0: 62 6a 73 29 0a 09 20 20 28 6e 75 6c 6c 3f 20 6f bjs).. (null? o
1b00: 62 6a 73 29 29 0a 20 20 20 20 20 20 23 66 0a 20 bjs)). #f.
1b10: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
1b20: 28 68 65 64 20 20 20 20 20 28 63 61 72 20 6f 62 (hed (car ob
1b30: 6a 73 29 29 0a 09 09 20 28 74 61 6c 20 20 20 20 js))... (tal
1b40: 20 28 63 64 72 20 6f 62 6a 73 29 29 0a 09 09 20 (cdr objs))...
1b50: 28 65 78 74 65 6e 74 73 20 28 76 67 3a 6f 62 6a (extents (vg:obj
1b60: 2d 67 65 74 2d 65 78 74 65 6e 74 73 20 64 72 61 -get-extents dra
1b70: 77 69 6e 67 20 28 63 61 72 20 6f 62 6a 73 29 29 wing (car objs))
1b80: 29 29 0a 09 28 6c 65 74 20 28 28 6e 65 77 65 78 ))..(let ((newex
1b90: 74 65 6e 74 73 0a 09 20 20 20 20 20 20 20 28 76 tents.. (v
1ba0: 67 3a 67 65 74 2d 65 78 74 65 6e 74 73 2d 66 6f g:get-extents-fo
1bb0: 72 2d 74 77 6f 2d 72 65 63 74 73 0a 09 09 65 78 r-two-rects...ex
1bc0: 74 65 6e 74 73 0a 09 09 28 76 67 3a 6f 62 6a 2d tents...(vg:obj-
1bd0: 67 65 74 2d 65 78 74 65 6e 74 73 20 64 72 61 77 get-extents draw
1be0: 69 6e 67 20 68 65 64 29 29 29 29 0a 09 20 20 28 ing hed)))).. (
1bf0: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 if (null? tal)..
1c00: 20 20 20 20 20 20 65 78 74 65 6e 74 73 0a 09 20 extents..
1c10: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
1c20: 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 65 tal)(cdr tal) ne
1c30: 77 65 78 74 65 6e 74 73 29 29 29 29 29 29 0a 0a wextents))))))..
1c40: 3b 3b 20 20 20 28 6c 65 74 20 28 28 65 78 74 65 ;; (let ((exte
1c50: 6e 74 73 20 23 66 29 29 0a 3b 3b 20 20 20 20 20 nts #f)).;;
1c60: 28 66 6f 72 2d 65 61 63 68 0a 3b 3b 20 20 20 20 (for-each.;;
1c70: 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a (lambda (obj).
1c80: 3b 3b 20 20 20 20 20 20 20 20 28 73 65 74 21 20 ;; (set!
1c90: 65 78 74 65 6e 74 73 0a 3b 3b 20 09 20 28 76 67 extents.;; . (vg
1ca0: 3a 67 65 74 2d 65 78 74 65 6e 74 73 2d 66 6f 72 :get-extents-for
1cb0: 2d 74 77 6f 2d 72 65 63 74 73 0a 3b 3b 20 09 20 -two-rects.;; .
1cc0: 20 65 78 74 65 6e 74 73 0a 3b 3b 20 09 20 20 28 extents.;; . (
1cd0: 76 67 3a 6f 62 6a 2d 67 65 74 2d 65 78 74 65 6e vg:obj-get-exten
1ce0: 74 73 20 64 72 61 77 69 6e 67 20 6f 62 6a 29 29 ts drawing obj))
1cf0: 29 29 0a 3b 3b 20 20 20 20 20 20 6f 62 6a 73 29 )).;; objs)
1d00: 0a 3b 3b 20 20 20 20 20 65 78 74 65 6e 74 73 29 .;; extents)
1d10: 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 72 65 63 74 )..;; given rect
1d20: 61 6e 67 6c 65 73 20 72 31 20 61 6e 64 20 72 32 angles r1 and r2
1d30: 2c 20 72 65 74 75 72 6e 20 74 68 65 20 62 6f 78 , return the box
1d40: 20 74 68 61 74 20 62 6f 75 6e 64 73 20 62 6f 74 that bounds bot
1d50: 68 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 h.;;.(define (vg
1d60: 3a 67 65 74 2d 65 78 74 65 6e 74 73 2d 66 6f 72 :get-extents-for
1d70: 2d 74 77 6f 2d 72 65 63 74 73 20 72 31 20 72 32 -two-rects r1 r2
1d80: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 72 31 29 ). (if (not r1)
1d90: 0a 20 20 20 20 20 20 72 32 0a 20 20 20 20 20 20 . r2.
1da0: 28 69 66 20 28 6e 6f 74 20 72 32 29 0a 09 20 20 (if (not r2)..
1db0: 72 31 20 3b 3b 20 23 66 20 3b 3b 20 6e 6f 20 65 r1 ;; #f ;; no e
1dc0: 78 74 65 6e 74 73 20 66 72 6f 6d 20 23 66 20 23 xtents from #f #
1dd0: 66 0a 09 20 20 28 6c 69 73 74 20 28 6d 69 6e 20 f.. (list (min
1de0: 28 63 61 72 20 72 31 29 28 63 61 72 20 72 32 29 (car r1)(car r2)
1df0: 29 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6c ) ;; l
1e00: 6c 78 0a 09 09 28 6d 69 6e 20 28 63 61 64 72 20 lx...(min (cadr
1e10: 72 31 29 28 63 61 64 72 20 72 32 29 29 20 20 20 r1)(cadr r2))
1e20: 20 20 20 20 20 20 3b 3b 20 6c 6c 79 0a 09 09 28 ;; lly...(
1e30: 6d 61 78 20 28 63 61 64 64 72 20 72 31 29 28 63 max (caddr r1)(c
1e40: 61 64 64 72 20 72 32 29 29 20 20 20 20 20 20 20 addr r2))
1e50: 3b 3b 20 75 6c 78 0a 09 09 28 6d 61 78 20 28 63 ;; ulx...(max (c
1e60: 61 64 64 64 72 20 72 31 29 28 63 61 64 64 64 72 adddr r1)(cadddr
1e70: 20 72 32 29 29 29 29 29 29 20 3b 3b 20 75 6c 79 r2)))))) ;; uly
1e80: 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 63 6f ..(define (vg:co
1e90: 6d 70 6f 6e 65 6e 74 73 2d 67 65 74 2d 65 78 74 mponents-get-ext
1ea0: 65 6e 74 73 20 64 72 61 77 69 6e 67 20 2e 20 63 ents drawing . c
1eb0: 6f 6d 70 73 29 0a 20 20 28 69 66 20 28 6e 75 6c omps). (if (nul
1ec0: 6c 3f 20 63 6f 6d 70 73 29 0a 20 20 20 20 20 20 l? comps).
1ed0: 23 66 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f #f. (let lo
1ee0: 6f 70 20 28 28 68 65 64 20 20 28 63 61 72 20 63 op ((hed (car c
1ef0: 6f 6d 70 73 29 29 0a 09 09 20 28 74 61 6c 20 20 omps))... (tal
1f00: 28 63 64 72 20 63 6f 6d 70 73 29 29 0a 09 09 20 (cdr comps))...
1f10: 28 65 78 74 65 6e 74 73 20 23 66 29 29 0a 09 28 (extents #f))..(
1f20: 6c 65 74 2a 20 28 28 6f 62 6a 73 20 20 28 76 67 let* ((objs (vg
1f30: 3a 63 6f 6d 70 2d 6f 62 6a 73 20 68 65 64 29 29 :comp-objs hed))
1f40: 0a 09 20 20 20 20 20 20 20 28 6e 65 77 65 78 74 .. (newext
1f50: 65 6e 74 73 20 28 69 66 20 65 78 74 65 6e 74 73 ents (if extents
1f60: 0a 09 09 09 20 20 20 20 20 20 20 28 76 67 3a 67 .... (vg:g
1f70: 65 74 2d 65 78 74 65 6e 74 73 2d 66 6f 72 2d 74 et-extents-for-t
1f80: 77 6f 2d 72 65 63 74 73 0a 09 09 09 09 65 78 74 wo-rects.....ext
1f90: 65 6e 74 73 0a 09 09 09 09 28 76 67 3a 67 65 74 ents.....(vg:get
1fa0: 2d 65 78 74 65 6e 74 73 2d 66 6f 72 2d 6f 62 6a -extents-for-obj
1fb0: 73 20 64 72 61 77 69 6e 67 20 6f 62 6a 73 29 29 s drawing objs))
1fc0: 0a 09 09 09 20 20 20 20 20 20 20 28 76 67 3a 67 .... (vg:g
1fd0: 65 74 2d 65 78 74 65 6e 74 73 2d 66 6f 72 2d 6f et-extents-for-o
1fe0: 62 6a 73 20 64 72 61 77 69 6e 67 20 6f 62 6a 73 bjs drawing objs
1ff0: 29 29 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c )))).. (if (nul
2000: 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 20 20 6e l? tal).. n
2010: 65 77 65 78 74 65 6e 74 73 0a 09 20 20 20 20 20 ewextents..
2020: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
2030: 28 63 64 72 20 74 61 6c 29 20 6e 65 77 65 78 74 (cdr tal) newext
2040: 65 6e 74 73 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d ents))))))..;;==
2050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2090: 3d 3d 3d 3d 0a 3b 3b 20 6c 69 62 72 61 72 69 65 ====.;; librarie
20a0: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
20b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
20c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
20d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
20e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 ==========..;; r
20f0: 65 67 69 73 74 65 72 20 6c 69 62 20 77 69 74 68 egister lib with
2100: 20 64 72 61 77 69 6e 67 0a 0a 3b 3b 0a 28 64 65 drawing..;;.(de
2110: 66 69 6e 65 20 28 76 67 3a 61 64 64 2d 6c 69 62 fine (vg:add-lib
2120: 20 64 72 61 77 69 6e 67 20 6c 69 62 6e 61 6d 65 drawing libname
2130: 20 6c 69 62 29 0a 20 20 28 68 61 73 68 2d 74 61 lib). (hash-ta
2140: 62 6c 65 2d 73 65 74 21 20 28 76 67 3a 64 72 61 ble-set! (vg:dra
2150: 77 69 6e 67 2d 6c 69 62 73 20 64 72 61 77 69 6e wing-libs drawin
2160: 67 29 20 6c 69 62 6e 61 6d 65 20 6c 69 62 29 29 g) libname lib))
2170: 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 67 65 ..(define (vg:ge
2180: 74 2d 6c 69 62 20 64 72 61 77 69 6e 67 20 6c 69 t-lib drawing li
2190: 62 6e 61 6d 65 29 0a 20 20 28 68 61 73 68 2d 74 bname). (hash-t
21a0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
21b0: 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 6c 69 62 (vg:drawing-lib
21c0: 73 20 64 72 61 77 69 6e 67 29 20 6c 69 62 6e 61 s drawing) libna
21d0: 6d 65 20 23 66 29 29 0a 0a 28 64 65 66 69 6e 65 me #f))..(define
21e0: 20 28 76 67 3a 67 65 74 2f 63 72 65 61 74 65 2d (vg:get/create-
21f0: 6c 69 62 20 64 72 61 77 69 6e 67 20 6c 69 62 6e lib drawing libn
2200: 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 6c 69 ame). (let ((li
2210: 62 20 28 76 67 3a 67 65 74 2d 6c 69 62 20 64 72 b (vg:get-lib dr
2220: 61 77 69 6e 67 20 6c 69 62 6e 61 6d 65 29 29 29 awing libname)))
2230: 0a 20 20 20 20 28 69 66 20 6c 69 62 0a 09 6c 69 . (if lib..li
2240: 62 0a 09 28 6c 65 74 20 28 28 6e 65 77 6c 69 62 b..(let ((newlib
2250: 20 28 76 67 3a 6c 69 62 2d 6e 65 77 29 29 29 0a (vg:lib-new))).
2260: 09 20 20 28 76 67 3a 61 64 64 2d 6c 69 62 20 64 . (vg:add-lib d
2270: 72 61 77 69 6e 67 20 6c 69 62 6e 61 6d 65 20 6e rawing libname n
2280: 65 77 6c 69 62 29 0a 09 20 20 6e 65 77 6c 69 62 ewlib).. newlib
2290: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
22a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
22d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
22e0: 3b 20 6d 61 70 20 6f 62 6a 65 63 74 73 20 67 69 ; map objects gi
22f0: 76 65 6e 20 6f 66 66 73 65 74 2c 20 73 63 61 6c ven offset, scal
2300: 65 20 61 6e 64 20 6d 69 72 72 6f 72 2c 20 72 65 e and mirror, re
2310: 73 75 6c 74 69 6e 67 20 6f 62 6a 20 69 73 20 64 sulting obj is d
2320: 69 73 70 6c 61 79 65 64 0a 3b 3b 3d 3d 3d 3d 3d isplayed.;;=====
2330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2370: 3d 0a 0a 3b 3b 20 64 69 73 70 61 74 63 68 20 74 =..;; dispatch t
2380: 68 65 20 64 72 61 77 69 6e 67 20 6f 66 20 6f 62 he drawing of ob
2390: 6a 20 6f 66 66 20 74 6f 20 74 68 65 20 63 6f 72 j off to the cor
23a0: 72 65 63 74 20 64 72 61 77 69 6e 67 20 72 6f 75 rect drawing rou
23b0: 74 69 6e 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 tine.;;.(define
23c0: 28 76 67 3a 6d 61 70 2d 6f 62 6a 20 64 72 61 77 (vg:map-obj draw
23d0: 69 6e 67 20 69 6e 73 74 20 6f 62 6a 29 0a 20 20 ing inst obj).
23e0: 28 63 61 73 65 20 28 76 67 3a 6f 62 6a 2d 74 79 (case (vg:obj-ty
23f0: 70 65 20 6f 62 6a 29 0a 20 20 20 20 28 28 6c 29 pe obj). ((l)
2400: 28 76 67 3a 6d 61 70 2d 6c 69 6e 65 20 20 20 64 (vg:map-line d
2410: 72 61 77 69 6e 67 20 69 6e 73 74 20 6f 62 6a 29 rawing inst obj)
2420: 29 0a 20 20 20 20 28 28 72 29 28 76 67 3a 6d 61 ). ((r)(vg:ma
2430: 70 2d 72 65 63 74 20 20 20 64 72 61 77 69 6e 67 p-rect drawing
2440: 20 69 6e 73 74 20 6f 62 6a 29 29 0a 20 20 20 20 inst obj)).
2450: 28 28 74 29 28 76 67 3a 6d 61 70 2d 74 65 78 74 ((t)(vg:map-text
2460: 20 20 20 64 72 61 77 69 6e 67 20 69 6e 73 74 20 drawing inst
2470: 6f 62 6a 29 29 0a 20 20 20 20 28 28 78 29 28 76 obj)). ((x)(v
2480: 67 3a 6d 61 70 2d 78 61 78 69 73 20 20 64 72 61 g:map-xaxis dra
2490: 77 69 6e 67 20 69 6e 73 74 20 6f 62 6a 29 29 0a wing inst obj)).
24a0: 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 29 0a (else #f))).
24b0: 0a 3b 3b 20 67 69 76 65 6e 20 61 20 64 72 61 77 .;; given a draw
24c0: 69 6e 67 20 61 6e 64 20 61 20 69 6e 73 74 20 6d ing and a inst m
24d0: 61 70 20 61 20 72 65 63 74 61 6e 67 6c 65 20 74 ap a rectangle t
24e0: 6f 20 69 74 20 73 63 72 65 65 6e 20 63 6f 6f 72 o it screen coor
24f0: 64 69 6e 61 74 65 73 0a 3b 3b 0a 28 64 65 66 69 dinates.;;.(defi
2500: 6e 65 20 28 76 67 3a 6d 61 70 2d 72 65 63 74 20 ne (vg:map-rect
2510: 64 72 61 77 69 6e 67 20 69 6e 73 74 20 6f 62 6a drawing inst obj
2520: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 ). (let ((res (
2530: 6d 61 6b 65 2d 76 67 3a 6f 62 6a 20 74 79 70 65 make-vg:obj type
2540: 3a 20 20 20 20 20 20 20 27 72 20 3b 3b 20 69 73 : 'r ;; is
2550: 20 74 68 65 72 65 20 61 20 64 65 66 73 74 72 75 there a defstru
2560: 63 74 20 63 6f 70 79 3f 0a 09 09 09 20 20 66 69 ct copy?.... fi
2570: 6c 6c 2d 63 6f 6c 6f 72 3a 20 28 76 67 3a 6f 62 ll-color: (vg:ob
2580: 6a 2d 66 69 6c 6c 2d 63 6f 6c 6f 72 20 6f 62 6a j-fill-color obj
2590: 29 0a 09 09 09 20 20 74 65 78 74 3a 20 20 20 20 ).... text:
25a0: 20 20 20 28 76 67 3a 6f 62 6a 2d 74 65 78 74 20 (vg:obj-text
25b0: 20 20 20 20 20 20 6f 62 6a 29 0a 09 09 09 20 20 obj)....
25c0: 6c 69 6e 65 2d 63 6f 6c 6f 72 3a 20 28 76 67 3a line-color: (vg:
25d0: 6f 62 6a 2d 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f obj-line-color o
25e0: 62 6a 29 0a 09 09 09 20 20 66 6f 6e 74 3a 20 20 bj).... font:
25f0: 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e (vg:obj-fon
2600: 74 20 20 20 20 20 20 20 6f 62 6a 29 29 29 0a 09 t obj)))..
2610: 28 70 74 73 20 28 76 67 3a 6f 62 6a 2d 70 74 73 (pts (vg:obj-pts
2620: 20 6f 62 6a 29 29 29 0a 20 20 20 20 28 76 67 3a obj))). (vg:
2630: 6f 62 6a 2d 70 74 73 2d 73 65 74 21 20 72 65 73 obj-pts-set! res
2640: 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 69 6e 73 (vg:drawing-ins
2650: 74 2d 61 70 70 6c 79 2d 73 63 61 6c 65 2d 6f 66 t-apply-scale-of
2660: 66 73 65 74 20 64 72 61 77 69 6e 67 20 69 6e 73 fset drawing ins
2670: 74 20 70 74 73 29 29 0a 20 20 20 20 28 76 67 3a t pts)). (vg:
2680: 64 72 61 77 69 6e 67 2d 63 61 63 68 65 2d 73 65 drawing-cache-se
2690: 74 21 20 64 72 61 77 69 6e 67 20 28 63 6f 6e 73 t! drawing (cons
26a0: 20 72 65 73 20 28 76 67 3a 64 72 61 77 69 6e 67 res (vg:drawing
26b0: 2d 63 61 63 68 65 20 64 72 61 77 69 6e 67 29 20 -cache drawing)
26c0: 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b )). res))..;;
26d0: 20 67 69 76 65 6e 20 61 20 64 72 61 77 69 6e 67 given a drawing
26e0: 20 61 6e 64 20 61 20 69 6e 73 74 20 6d 61 70 20 and a inst map
26f0: 61 20 6c 69 6e 65 20 74 6f 20 69 74 20 73 63 72 a line to it scr
2700: 65 65 6e 20 63 6f 6f 72 64 69 6e 61 74 65 73 0a een coordinates.
2710: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 6d ;;.(define (vg:m
2720: 61 70 2d 6c 69 6e 65 20 64 72 61 77 69 6e 67 20 ap-line drawing
2730: 69 6e 73 74 20 6f 62 6a 29 0a 20 20 28 6c 65 74 inst obj). (let
2740: 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 76 67 3a ((res (make-vg:
2750: 6f 62 6a 20 74 79 70 65 3a 20 20 20 20 20 20 20 obj type:
2760: 27 6c 20 3b 3b 20 69 73 20 74 68 65 72 65 20 61 'l ;; is there a
2770: 20 64 65 66 73 74 72 75 63 74 20 63 6f 70 79 3f defstruct copy?
2780: 0a 09 09 09 20 20 6c 69 6e 65 2d 63 6f 6c 6f 72 .... line-color
2790: 3a 20 28 76 67 3a 6f 62 6a 2d 6c 69 6e 65 2d 63 : (vg:obj-line-c
27a0: 6f 6c 6f 72 20 6f 62 6a 29 0a 09 09 09 20 20 66 olor obj).... f
27b0: 6f 6e 74 3a 20 20 20 20 20 20 20 28 76 67 3a 6f ont: (vg:o
27c0: 62 6a 2d 66 6f 6e 74 20 20 20 20 20 20 20 6f 62 bj-font ob
27d0: 6a 29 29 29 0a 09 28 70 74 73 20 28 76 67 3a 6f j)))..(pts (vg:o
27e0: 62 6a 2d 70 74 73 20 6f 62 6a 29 29 29 0a 20 20 bj-pts obj))).
27f0: 20 20 28 76 67 3a 6f 62 6a 2d 70 74 73 2d 73 65 (vg:obj-pts-se
2800: 74 21 20 72 65 73 20 28 76 67 3a 64 72 61 77 69 t! res (vg:drawi
2810: 6e 67 2d 69 6e 73 74 2d 61 70 70 6c 79 2d 73 63 ng-inst-apply-sc
2820: 61 6c 65 2d 6f 66 66 73 65 74 20 64 72 61 77 69 ale-offset drawi
2830: 6e 67 20 69 6e 73 74 20 70 74 73 29 29 0a 20 20 ng inst pts)).
2840: 20 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 63 61 (vg:drawing-ca
2850: 63 68 65 2d 73 65 74 21 20 64 72 61 77 69 6e 67 che-set! drawing
2860: 20 28 63 6f 6e 73 20 72 65 73 20 28 76 67 3a 64 (cons res (vg:d
2870: 72 61 77 69 6e 67 2d 63 61 63 68 65 20 64 72 61 rawing-cache dra
2880: 77 69 6e 67 29 20 29 29 0a 20 20 20 20 72 65 73 wing) )). res
2890: 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 64 ))..;; given a d
28a0: 72 61 77 69 6e 67 20 61 6e 64 20 61 20 69 6e 73 rawing and a ins
28b0: 74 20 6d 61 70 20 61 20 74 65 78 74 20 74 6f 20 t map a text to
28c0: 69 74 20 73 63 72 65 65 6e 20 63 6f 6f 72 64 69 it screen coordi
28d0: 6e 61 74 65 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 nates.;;.(define
28e0: 20 28 76 67 3a 6d 61 70 2d 74 65 78 74 20 64 72 (vg:map-text dr
28f0: 61 77 69 6e 67 20 69 6e 73 74 20 6f 62 6a 29 0a awing inst obj).
2900: 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 (let ((res (ma
2910: 6b 65 2d 76 67 3a 6f 62 6a 20 74 79 70 65 3a 20 ke-vg:obj type:
2920: 20 20 20 20 20 20 27 74 0a 09 09 09 20 20 66 69 't.... fi
2930: 6c 6c 2d 63 6f 6c 6f 72 3a 20 28 76 67 3a 6f 62 ll-color: (vg:ob
2940: 6a 2d 66 69 6c 6c 2d 63 6f 6c 6f 72 20 6f 62 6a j-fill-color obj
2950: 29 0a 09 09 09 20 20 74 65 78 74 3a 20 20 20 20 ).... text:
2960: 20 20 20 28 76 67 3a 6f 62 6a 2d 74 65 78 74 20 (vg:obj-text
2970: 20 20 20 20 20 20 6f 62 6a 29 0a 09 09 09 20 20 obj)....
2980: 6c 69 6e 65 2d 63 6f 6c 6f 72 3a 20 28 76 67 3a line-color: (vg:
2990: 6f 62 6a 2d 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f obj-line-color o
29a0: 62 6a 29 0a 09 09 09 20 20 66 6f 6e 74 3a 20 20 bj).... font:
29b0: 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e (vg:obj-fon
29c0: 74 20 20 20 20 20 20 20 6f 62 6a 29 0a 09 09 09 t obj)....
29d0: 20 20 61 6e 67 6c 65 3a 20 20 20 20 20 20 28 76 angle: (v
29e0: 67 3a 6f 62 6a 2d 61 6e 67 6c 65 20 20 20 20 20 g:obj-angle
29f0: 20 6f 62 6a 29 0a 09 09 09 20 20 61 74 74 72 69 obj).... attri
2a00: 62 3a 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d 61 b: (vg:obj-a
2a10: 74 74 72 69 62 20 20 20 20 20 6f 62 6a 29 29 29 ttrib obj)))
2a20: 0a 09 28 70 74 73 20 28 76 67 3a 6f 62 6a 2d 70 ..(pts (vg:obj-p
2a30: 74 73 20 6f 62 6a 29 29 29 0a 20 20 20 20 28 76 ts obj))). (v
2a40: 67 3a 6f 62 6a 2d 70 74 73 2d 73 65 74 21 20 72 g:obj-pts-set! r
2a50: 65 73 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 69 es (vg:drawing-i
2a60: 6e 73 74 2d 61 70 70 6c 79 2d 73 63 61 6c 65 2d nst-apply-scale-
2a70: 6f 66 66 73 65 74 20 64 72 61 77 69 6e 67 20 69 offset drawing i
2a80: 6e 73 74 20 70 74 73 29 29 0a 20 20 20 20 28 76 nst pts)). (v
2a90: 67 3a 64 72 61 77 69 6e 67 2d 63 61 63 68 65 2d g:drawing-cache-
2aa0: 73 65 74 21 20 64 72 61 77 69 6e 67 20 28 63 6f set! drawing (co
2ab0: 6e 73 20 72 65 73 20 28 76 67 3a 64 72 61 77 69 ns res (vg:drawi
2ac0: 6e 67 2d 63 61 63 68 65 20 64 72 61 77 69 6e 67 ng-cache drawing
2ad0: 29 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b ))). res))..;
2ae0: 3b 20 67 69 76 65 6e 20 61 20 64 72 61 77 69 6e ; given a drawin
2af0: 67 20 61 6e 64 20 61 20 69 6e 73 74 20 6d 61 70 g and a inst map
2b00: 20 61 20 6c 69 6e 65 20 74 6f 20 69 74 20 73 63 a line to it sc
2b10: 72 65 65 6e 20 63 6f 6f 72 64 69 6e 61 74 65 73 reen coordinates
2b20: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 3a .;;.(define (vg:
2b30: 6d 61 70 2d 78 61 78 69 73 20 64 72 61 77 69 6e map-xaxis drawin
2b40: 67 20 69 6e 73 74 20 6f 62 6a 29 0a 20 20 28 6c g inst obj). (l
2b50: 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 76 et ((res (make-v
2b60: 67 3a 6f 62 6a 20 74 79 70 65 3a 20 20 20 20 20 g:obj type:
2b70: 20 27 78 20 3b 3b 20 69 73 20 74 68 65 72 65 20 'x ;; is there
2b80: 61 20 64 65 66 73 74 72 75 63 74 20 63 6f 70 79 a defstruct copy
2b90: 3f 0a 09 09 09 20 20 6c 69 6e 65 2d 63 6f 6c 6f ?.... line-colo
2ba0: 72 3a 20 28 76 67 3a 6f 62 6a 2d 6c 69 6e 65 2d r: (vg:obj-line-
2bb0: 63 6f 6c 6f 72 20 6f 62 6a 29 0a 09 09 09 20 20 color obj)....
2bc0: 66 6f 6e 74 3a 20 20 20 20 20 20 20 28 76 67 3a font: (vg:
2bd0: 6f 62 6a 2d 66 6f 6e 74 20 20 20 20 20 20 20 6f obj-font o
2be0: 62 6a 29 29 29 0a 09 28 70 74 73 20 28 76 67 3a bj)))..(pts (vg:
2bf0: 6f 62 6a 2d 70 74 73 20 6f 62 6a 29 29 29 0a 20 obj-pts obj))).
2c00: 20 20 20 28 76 67 3a 6f 62 6a 2d 70 74 73 2d 73 (vg:obj-pts-s
2c10: 65 74 21 20 72 65 73 20 28 76 67 3a 64 72 61 77 et! res (vg:draw
2c20: 69 6e 67 2d 69 6e 73 74 2d 61 70 70 6c 79 2d 73 ing-inst-apply-s
2c30: 63 61 6c 65 2d 6f 66 66 73 65 74 20 64 72 61 77 cale-offset draw
2c40: 69 6e 67 20 69 6e 73 74 20 70 74 73 29 29 0a 20 ing inst pts)).
2c50: 20 20 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 63 (vg:drawing-c
2c60: 61 63 68 65 2d 73 65 74 21 20 64 72 61 77 69 6e ache-set! drawin
2c70: 67 20 28 63 6f 6e 73 20 72 65 73 20 28 76 67 3a g (cons res (vg:
2c80: 64 72 61 77 69 6e 67 2d 63 61 63 68 65 20 64 72 drawing-cache dr
2c90: 61 77 69 6e 67 29 20 29 29 0a 20 20 20 20 72 65 awing) )). re
2ca0: 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d s))..;;=========
2cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
2cf0: 20 69 6e 73 74 61 6e 63 65 73 0a 3b 3b 3d 3d 3d instances.;;===
2d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d40: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 ===..(define (vg
2d50: 3a 69 6e 73 74 61 6e 63 65 73 2d 67 65 74 2d 65 :instances-get-e
2d60: 78 74 65 6e 74 73 20 64 72 61 77 69 6e 67 20 2e xtents drawing .
2d70: 20 69 6e 73 74 61 6e 63 65 2d 6e 61 6d 65 73 29 instance-names)
2d80: 0a 20 20 28 6c 65 74 20 28 28 78 74 6e 74 2d 6c . (let ((xtnt-l
2d90: 73 74 20 28 76 67 3a 64 72 61 77 20 64 72 61 77 st (vg:draw draw
2da0: 69 6e 67 20 23 66 29 29 29 0a 20 20 20 20 28 69 ing #f))). (i
2db0: 66 20 28 6e 75 6c 6c 3f 20 78 74 6e 74 2d 6c 73 f (null? xtnt-ls
2dc0: 74 29 0a 09 23 66 0a 09 28 6c 65 74 20 6c 6f 6f t)..#f..(let loo
2dd0: 70 20 28 28 65 78 74 65 6e 74 73 20 28 63 61 72 p ((extents (car
2de0: 20 78 74 6e 74 2d 6c 73 74 29 29 0a 09 09 20 20 xtnt-lst))...
2df0: 20 28 74 61 6c 20 20 20 20 20 28 63 64 72 20 78 (tal (cdr x
2e00: 74 6e 74 2d 6c 73 74 29 29 0a 09 09 20 20 20 28 tnt-lst))... (
2e10: 6c 6c 78 20 20 20 20 20 23 66 29 0a 09 09 20 20 llx #f)...
2e20: 20 28 6c 6c 79 20 20 20 20 20 23 66 29 0a 09 09 (lly #f)...
2e30: 20 20 20 28 75 6c 78 20 20 20 20 20 23 66 29 0a (ulx #f).
2e40: 09 09 20 20 20 28 75 6c 79 20 20 20 20 20 23 66 .. (uly #f
2e50: 29 29 0a 09 20 20 28 6c 65 74 20 28 28 6e 6c 6c )).. (let ((nll
2e60: 78 20 20 20 20 20 20 28 69 66 20 6c 6c 78 20 28 x (if llx (
2e70: 6d 69 6e 20 6c 6c 78 20 28 6c 69 73 74 2d 72 65 min llx (list-re
2e80: 66 20 65 78 74 65 6e 74 73 20 30 29 29 28 6c 69 f extents 0))(li
2e90: 73 74 2d 72 65 66 20 65 78 74 65 6e 74 73 20 30 st-ref extents 0
2ea0: 29 29 29 0a 09 09 28 6e 6c 6c 79 20 20 20 20 20 )))...(nlly
2eb0: 20 28 69 66 20 6c 6c 79 20 28 6d 69 6e 20 6c 6c (if lly (min ll
2ec0: 79 20 28 6c 69 73 74 2d 72 65 66 20 65 78 74 65 y (list-ref exte
2ed0: 6e 74 73 20 31 29 29 28 6c 69 73 74 2d 72 65 66 nts 1))(list-ref
2ee0: 20 65 78 74 65 6e 74 73 20 31 29 29 29 0a 09 09 extents 1)))...
2ef0: 28 6e 75 6c 78 20 20 20 20 20 20 28 69 66 20 75 (nulx (if u
2f00: 6c 78 20 28 6d 61 78 20 75 6c 78 20 28 6c 69 73 lx (max ulx (lis
2f10: 74 2d 72 65 66 20 65 78 74 65 6e 74 73 20 32 29 t-ref extents 2)
2f20: 29 28 6c 69 73 74 2d 72 65 66 20 65 78 74 65 6e )(list-ref exten
2f30: 74 73 20 32 29 29 29 0a 09 09 28 6e 75 6c 79 20 ts 2)))...(nuly
2f40: 20 20 20 20 20 28 69 66 20 75 6c 79 20 28 6d 61 (if uly (ma
2f50: 78 20 75 6c 79 20 28 6c 69 73 74 2d 72 65 66 20 x uly (list-ref
2f60: 65 78 74 65 6e 74 73 20 33 29 29 28 6c 69 73 74 extents 3))(list
2f70: 2d 72 65 66 20 65 78 74 65 6e 74 73 20 33 29 29 -ref extents 3))
2f80: 29 29 0a 09 20 20 20 20 28 69 66 20 28 6e 75 6c )).. (if (nul
2f90: 6c 3f 20 74 61 6c 29 0a 09 09 28 6c 69 73 74 20 l? tal)...(list
2fa0: 6c 6c 78 20 6c 6c 79 20 75 6c 78 20 75 6c 79 29 llx lly ulx uly)
2fb0: 0a 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 ...(loop (car ta
2fc0: 6c 29 28 63 64 72 20 74 61 6c 29 20 6e 6c 6c 78 l)(cdr tal) nllx
2fd0: 20 6e 6c 6c 79 20 6e 75 6c 78 20 6e 75 6c 79 29 nlly nulx nuly)
2fe0: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
2ff0: 28 76 67 3a 6c 69 62 2d 67 65 74 2d 63 6f 6d 70 (vg:lib-get-comp
3000: 6f 6e 65 6e 74 20 6c 69 62 20 69 6e 73 74 6e 61 onent lib instna
3010: 6d 65 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c me). (hash-tabl
3020: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 20 28 e-ref/default (
3030: 76 67 3a 6c 69 62 2d 63 6f 6d 70 73 20 6c 69 62 vg:lib-comps lib
3040: 29 20 69 6e 73 74 6e 61 6d 65 20 23 66 29 29 0a ) instname #f)).
3050: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
3060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 63 6f 6c =========.;; col
30a0: 6f 72 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d or.;;===========
30b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
30f0: 66 69 6e 65 20 28 76 67 3a 72 67 62 2d 3e 6e 75 fine (vg:rgb->nu
3100: 6d 62 65 72 20 72 20 67 20 62 20 23 21 6b 65 79 mber r g b #!key
3110: 20 28 61 20 30 29 29 0a 20 20 28 62 69 74 77 69 (a 0)). (bitwi
3120: 73 65 2d 69 6f 72 0a 20 20 20 20 28 61 72 69 74 se-ior. (arit
3130: 68 6d 65 74 69 63 2d 73 68 69 66 74 20 61 20 32 hmetic-shift a 2
3140: 34 29 0a 20 20 20 20 28 61 72 69 74 68 6d 65 74 4). (arithmet
3150: 69 63 2d 73 68 69 66 74 20 72 20 31 36 29 0a 20 ic-shift r 16).
3160: 20 20 20 28 61 72 69 74 68 6d 65 74 69 63 2d 73 (arithmetic-s
3170: 68 69 66 74 20 67 20 38 29 0a 20 20 20 20 62 29 hift g 8). b)
3180: 29 0a 0a 3b 3b 20 4f 62 73 6f 6c 65 74 65 20 66 )..;; Obsolete f
3190: 75 6e 63 74 69 6f 6e 0a 3b 3b 0a 28 64 65 66 69 unction.;;.(defi
31a0: 6e 65 20 28 76 67 3a 67 65 6e 65 72 61 74 65 2d ne (vg:generate-
31b0: 63 6f 6c 6f 72 29 0a 20 20 28 76 67 3a 72 67 62 color). (vg:rgb
31c0: 2d 3e 6e 75 6d 62 65 72 20 28 72 61 6e 64 6f 6d ->number (random
31d0: 20 32 35 35 29 0a 20 20 20 20 20 20 20 20 20 20 255).
31e0: 20 20 20 20 20 20 20 20 28 72 61 6e 64 6f 6d 20 (random
31f0: 32 35 35 29 0a 20 20 20 20 20 20 20 20 20 20 20 255).
3200: 20 20 20 20 20 20 20 28 72 61 6e 64 6f 6d 20 32 (random 2
3210: 35 35 29 29 29 0a 0a 3b 3b 20 4e 65 65 64 20 74 55)))..;; Need t
3220: 6f 20 72 65 74 75 72 6e 20 61 20 73 74 72 69 6e o return a strin
3230: 67 20 6f 66 20 72 61 6e 64 6f 6d 20 69 75 70 2d g of random iup-
3240: 63 6f 6c 6f 72 20 66 6f 72 20 67 72 61 70 68 0a color for graph.
3250: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 67 ;;.(define (vg:g
3260: 65 6e 65 72 61 74 65 2d 63 6f 6c 6f 72 2d 72 67 enerate-color-rg
3270: 62 29 0a 20 20 28 63 6f 6e 63 20 28 6e 75 6d 62 b). (conc (numb
3280: 65 72 2d 3e 73 74 72 69 6e 67 20 28 72 61 6e 64 er->string (rand
3290: 6f 6d 20 32 35 35 29 29 20 22 20 22 0a 20 20 20 om 255)) " ".
32a0: 20 20 20 20 20 28 6e 75 6d 62 65 72 2d 3e 73 74 (number->st
32b0: 72 69 6e 67 20 28 72 61 6e 64 6f 6d 20 32 35 35 ring (random 255
32c0: 29 29 20 22 20 22 0a 20 20 20 20 20 20 20 20 28 )) " ". (
32d0: 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 28 number->string (
32e0: 72 61 6e 64 6f 6d 20 32 35 35 29 29 29 29 0a 0a random 255))))..
32f0: 28 64 65 66 69 6e 65 20 28 76 67 3a 69 75 70 2d (define (vg:iup-
3300: 63 6f 6c 6f 72 2d 3e 6e 75 6d 62 65 72 20 69 75 color->number iu
3310: 70 2d 63 6f 6c 6f 72 29 0a 20 20 28 61 70 70 6c p-color). (appl
3320: 79 20 76 67 3a 72 67 62 2d 3e 6e 75 6d 62 65 72 y vg:rgb->number
3330: 20 28 6d 61 70 20 73 74 72 69 6e 67 2d 3e 6e 75 (map string->nu
3340: 6d 62 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c mber (string-spl
3350: 69 74 20 69 75 70 2d 63 6f 6c 6f 72 29 29 29 29 it iup-color))))
3360: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
3370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 67 72 ==========.;; gr
33b0: 61 70 68 69 6e 67 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d aphing.;;=======
33c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
33f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
3400: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 6d 61 6b .(define (vg:mak
3410: 65 2d 78 61 78 69 73 20 64 72 61 77 69 6e 67 20 e-xaxis drawing
3420: 63 6f 6d 70 6f 6e 65 6e 74 20 78 31 20 79 31 20 component x1 y1
3430: 78 32 20 79 32 20 73 74 61 72 74 6e 75 6d 20 65 x2 y2 startnum e
3440: 6e 64 6e 75 6d 20 73 63 61 6c 65 70 72 6f 63 29 ndnum scaleproc)
3450: 0a 20 20 28 6c 65 74 20 28 28 6f 62 6a 20 28 76 . (let ((obj (v
3460: 67 3a 6d 61 6b 65 2d 78 61 78 69 73 2d 6f 62 6a g:make-xaxis-obj
3470: 20 78 31 20 79 31 20 78 32 20 79 32 29 29 29 0a x1 y1 x2 y2))).
3480: 20 20 20 20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d #f))..;;====
3490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
34d0: 3d 3d 0a 3b 3b 20 55 6e 72 61 76 65 6c 20 61 6e ==.;; Unravel an
34e0: 64 20 64 72 61 77 20 74 68 65 20 6f 62 6a 65 63 d draw the objec
34f0: 74 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ts.;;===========
3500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
3540: 77 69 74 68 20 67 65 74 2d 65 78 74 65 6e 74 73 with get-extents
3550: 20 3d 20 23 74 20 72 65 74 75 72 6e 20 74 68 65 = #t return the
3560: 20 65 78 74 65 6e 74 73 0a 3b 3b 20 77 69 74 68 extents.;; with
3570: 20 64 72 61 77 20 3d 20 23 66 20 64 6f 6e 27 74 draw = #f don't
3580: 20 61 63 74 75 61 6c 6c 79 20 64 72 61 77 20 74 actually draw t
3590: 68 65 20 6f 62 6a 65 63 74 0a 3b 3b 0a 28 64 65 he object.;;.(de
35a0: 66 69 6e 65 20 28 76 67 3a 64 72 61 77 2d 6f 62 fine (vg:draw-ob
35b0: 6a 20 64 72 61 77 69 6e 67 20 6f 62 6a 20 23 21 j drawing obj #!
35c0: 6b 65 79 20 28 64 72 61 77 20 23 74 29 29 0a 20 key (draw #t)).
35d0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 6f 62 6a 20 ;; (print "obj
35e0: 74 79 70 65 3a 20 22 20 28 76 67 3a 6f 62 6a 2d type: " (vg:obj-
35f0: 74 79 70 65 20 6f 62 6a 29 29 0a 20 20 28 63 61 type obj)). (ca
3600: 73 65 20 28 76 67 3a 6f 62 6a 2d 74 79 70 65 20 se (vg:obj-type
3610: 6f 62 6a 29 0a 20 20 20 20 28 28 6c 29 28 76 67 obj). ((l)(vg
3620: 3a 64 72 61 77 2d 6c 69 6e 65 20 64 72 61 77 69 :draw-line drawi
3630: 6e 67 20 6f 62 6a 20 64 72 61 77 3a 20 64 72 61 ng obj draw: dra
3640: 77 29 29 0a 20 20 20 20 28 28 72 29 28 76 67 3a w)). ((r)(vg:
3650: 64 72 61 77 2d 72 65 63 74 20 64 72 61 77 69 6e draw-rect drawin
3660: 67 20 6f 62 6a 20 64 72 61 77 3a 20 64 72 61 77 g obj draw: draw
3670: 29 29 0a 20 20 20 20 28 28 74 29 28 76 67 3a 64 )). ((t)(vg:d
3680: 72 61 77 2d 74 65 78 74 20 64 72 61 77 69 6e 67 raw-text drawing
3690: 20 6f 62 6a 20 64 72 61 77 3a 20 64 72 61 77 29 obj draw: draw)
36a0: 29 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 )))..;; given a
36b0: 72 65 63 74 20 6f 62 6a 20 64 72 61 77 20 69 74 rect obj draw it
36c0: 20 6f 6e 20 74 68 65 20 63 61 6e 76 61 73 20 61 on the canvas a
36d0: 70 70 6c 79 69 6e 67 20 66 69 72 73 74 20 74 68 pplying first th
36e0: 65 20 64 72 61 77 69 6e 67 0a 3b 3b 20 73 63 61 e drawing.;; sca
36f0: 6c 65 20 61 6e 64 20 6f 66 66 73 65 74 0a 3b 3b le and offset.;;
3700: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 64 72 61 .(define (vg:dra
3710: 77 2d 72 65 63 74 20 64 72 61 77 69 6e 67 20 6f w-rect drawing o
3720: 62 6a 20 23 21 6b 65 79 20 28 64 72 61 77 20 23 bj #!key (draw #
3730: 74 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6e t)). (let* ((cn
3740: 76 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 63 6e v (vg:drawing-cn
3750: 76 20 64 72 61 77 69 6e 67 29 29 0a 09 20 28 70 v drawing)).. (p
3760: 74 73 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 61 ts (vg:drawing-a
3770: 70 70 6c 79 2d 73 63 61 6c 65 20 64 72 61 77 69 pply-scale drawi
3780: 6e 67 20 28 76 67 3a 6f 62 6a 2d 70 74 73 20 6f ng (vg:obj-pts o
3790: 62 6a 29 29 29 0a 09 20 28 66 69 6c 6c 2d 63 6f bj))).. (fill-co
37a0: 6c 6f 72 20 28 76 67 3a 6f 62 6a 2d 66 69 6c 6c lor (vg:obj-fill
37b0: 2d 63 6f 6c 6f 72 20 6f 62 6a 29 29 0a 09 20 28 -color obj)).. (
37c0: 6c 69 6e 65 2d 63 6f 6c 6f 72 20 28 76 67 3a 6f line-color (vg:o
37d0: 62 6a 2d 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f 62 bj-line-color ob
37e0: 6a 29 29 0a 09 20 28 74 65 78 74 20 20 20 20 20 j)).. (text
37f0: 20 20 28 76 67 3a 6f 62 6a 2d 74 65 78 74 20 6f (vg:obj-text o
3800: 62 6a 29 29 0a 09 20 28 66 6f 6e 74 20 20 20 20 bj)).. (font
3810: 20 20 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e 74 20 (vg:obj-font
3820: 6f 62 6a 29 29 0a 09 20 28 6c 6c 78 20 20 20 20 obj)).. (llx
3830: 20 20 20 20 28 63 61 72 20 70 74 73 29 29 0a 09 (car pts))..
3840: 20 28 6c 6c 79 20 20 20 20 20 20 20 20 28 63 61 (lly (ca
3850: 64 72 20 70 74 73 29 29 0a 09 20 28 75 6c 78 20 dr pts)).. (ulx
3860: 20 20 20 20 20 20 20 28 63 61 64 64 72 20 70 74 (caddr pt
3870: 73 29 29 0a 09 20 28 75 6c 79 20 20 20 20 20 20 s)).. (uly
3880: 20 20 28 63 61 64 64 64 72 20 70 74 73 29 29 0a (cadddr pts)).
3890: 09 20 28 77 20 20 20 20 20 20 20 20 20 20 28 2d . (w (-
38a0: 20 75 6c 78 20 6c 6c 78 29 29 0a 09 20 28 68 20 ulx llx)).. (h
38b0: 20 20 20 20 20 20 20 20 20 28 2d 20 75 6c 79 20 (- uly
38c0: 6c 6c 79 29 29 0a 09 20 28 74 65 78 74 2d 78 6d lly)).. (text-xm
38d0: 61 78 20 20 23 66 29 0a 09 20 28 74 65 78 74 2d ax #f).. (text-
38e0: 79 6d 61 78 20 20 23 66 29 29 0a 20 20 20 20 28 ymax #f)). (
38f0: 69 66 20 64 72 61 77 20 0a 09 28 6c 65 74 20 28 if draw ..(let (
3900: 28 70 72 65 76 2d 62 61 63 6b 67 72 6f 75 6e 64 (prev-background
3910: 2d 63 6f 6c 6f 72 20 28 63 61 6e 76 61 73 2d 62 -color (canvas-b
3920: 61 63 6b 67 72 6f 75 6e 64 20 63 6e 76 29 29 0a ackground cnv)).
3930: 09 20 20 20 20 20 20 28 70 72 65 76 2d 66 6f 72 . (prev-for
3940: 65 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 20 28 63 eground-color (c
3950: 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 anvas-foreground
3960: 20 63 6e 76 29 29 29 0a 09 20 20 28 69 66 20 66 cnv))).. (if f
3970: 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 20 20 20 20 20 ill-color..
3980: 20 28 62 65 67 69 6e 0a 09 09 28 63 61 6e 76 61 (begin...(canva
3990: 73 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 s-foreground-set
39a0: 21 20 63 6e 76 20 66 69 6c 6c 2d 63 6f 6c 6f 72 ! cnv fill-color
39b0: 29 0a 09 09 28 63 61 6e 76 61 73 2d 62 6f 78 21 )...(canvas-box!
39c0: 20 63 6e 76 20 6c 6c 78 20 75 6c 78 20 6c 6c 79 cnv llx ulx lly
39d0: 20 75 6c 79 29 29 29 20 3b 3b 20 64 6f 63 73 20 uly))) ;; docs
39e0: 61 72 65 20 61 6c 6c 20 6f 76 65 72 20 74 68 65 are all over the
39f0: 20 70 6c 61 63 65 20 6f 6e 20 74 68 69 73 20 6f place on this o
3a00: 6e 65 2e 3b 3b 20 77 20 68 29 0a 09 20 20 28 69 ne.;; w h).. (i
3a10: 66 20 6c 69 6e 65 2d 63 6f 6c 6f 72 0a 09 20 20 f line-color..
3a20: 20 20 20 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 (canvas-fore
3a30: 67 72 6f 75 6e 64 2d 73 65 74 21 20 63 6e 76 20 ground-set! cnv
3a40: 6c 69 6e 65 2d 63 6f 6c 6f 72 29 0a 09 20 20 20 line-color)..
3a50: 20 20 20 28 69 66 20 66 69 6c 6c 2d 63 6f 6c 6f (if fill-colo
3a60: 72 0a 09 09 20 20 28 63 61 6e 76 61 73 2d 66 6f r... (canvas-fo
3a70: 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 20 63 6e reground-set! cn
3a80: 76 20 70 72 65 76 2d 66 6f 72 65 67 72 6f 75 6e v prev-foregroun
3a90: 64 2d 63 6f 6c 6f 72 29 29 29 0a 09 20 20 28 63 d-color))).. (c
3aa0: 61 6e 76 61 73 2d 72 65 63 74 61 6e 67 6c 65 21 anvas-rectangle!
3ab0: 20 63 6e 76 20 6c 6c 78 20 75 6c 78 20 6c 6c 79 cnv llx ulx lly
3ac0: 20 75 6c 79 29 0a 09 20 20 28 63 61 6e 76 61 73 uly).. (canvas
3ad0: 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 -foreground-set!
3ae0: 20 63 6e 76 20 70 72 65 76 2d 66 6f 72 65 67 72 cnv prev-foregr
3af0: 6f 75 6e 64 2d 63 6f 6c 6f 72 29 0a 09 20 20 28 ound-color).. (
3b00: 69 66 20 74 65 78 74 20 0a 09 20 20 20 20 20 20 if text ..
3b10: 28 6c 65 74 2a 20 28 28 70 72 65 76 2d 66 6f 6e (let* ((prev-fon
3b20: 74 20 20 20 20 28 63 61 6e 76 61 73 2d 66 6f 6e t (canvas-fon
3b30: 74 20 63 6e 76 29 29 0a 09 09 20 20 20 20 20 28 t cnv))... (
3b40: 66 6f 6e 74 2d 63 68 61 6e 67 65 64 20 28 61 6e font-changed (an
3b50: 64 20 66 6f 6e 74 20 28 6e 6f 74 20 28 65 71 75 d font (not (equ
3b60: 61 6c 3f 20 66 6f 6e 74 20 70 72 65 76 2d 66 6f al? font prev-fo
3b70: 6e 74 29 29 29 29 29 0a 09 09 28 69 66 20 66 6f nt)))))...(if fo
3b80: 6e 74 2d 63 68 61 6e 67 65 64 20 28 63 61 6e 76 nt-changed (canv
3b90: 61 73 2d 66 6f 6e 74 2d 73 65 74 21 20 63 6e 76 as-font-set! cnv
3ba0: 20 66 6f 6e 74 29 29 0a 09 09 28 63 61 6e 76 61 font))...(canva
3bb0: 73 2d 74 65 78 74 21 20 63 6e 76 20 28 2b 20 32 s-text! cnv (+ 2
3bc0: 20 6c 6c 78 29 28 2b 20 32 20 6c 6c 79 29 20 74 llx)(+ 2 lly) t
3bd0: 65 78 74 29 0a 09 09 28 69 66 20 28 65 71 3f 20 ext)...(if (eq?
3be0: 64 72 61 77 20 27 67 65 74 2d 65 78 74 65 6e 74 draw 'get-extent
3bf0: 73 29 0a 09 09 20 20 20 20 28 6c 65 74 2d 76 61 s)... (let-va
3c00: 6c 75 65 73 20 28 28 28 78 6d 61 78 20 79 6d 61 lues (((xmax yma
3c10: 78 29 28 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 x)(canvas-text-s
3c20: 69 7a 65 20 63 6e 76 20 74 65 78 74 29 29 29 0a ize cnv text))).
3c30: 09 09 09 09 28 73 65 74 21 20 74 65 78 74 2d 78 ....(set! text-x
3c40: 6d 61 78 20 78 6d 61 78 29 28 73 65 74 21 20 74 max xmax)(set! t
3c50: 65 78 74 2d 79 6d 61 78 20 79 6d 61 78 29 29 29 ext-ymax ymax)))
3c60: 0a 09 09 28 69 66 20 66 6f 6e 74 2d 63 68 61 6e ...(if font-chan
3c70: 67 65 64 20 28 63 61 6e 76 61 73 2d 66 6f 6e 74 ged (canvas-font
3c80: 2d 73 65 74 21 20 63 6e 76 20 70 72 65 76 2d 66 -set! cnv prev-f
3c90: 6f 6e 74 29 29 29 29 29 29 0a 20 20 20 20 3b 3b ont)))))). ;;
3ca0: 20 28 70 72 69 6e 74 20 22 74 65 78 74 2d 78 6d (print "text-xm
3cb0: 61 78 3a 20 22 20 74 65 78 74 2d 78 6d 61 78 20 ax: " text-xmax
3cc0: 22 20 74 65 78 74 2d 79 6d 61 78 3a 20 22 20 74 " text-ymax: " t
3cd0: 65 78 74 2d 79 6d 61 78 29 0a 20 20 20 20 28 69 ext-ymax). (i
3ce0: 66 20 28 76 67 3a 6f 62 6a 2d 65 78 74 65 6e 74 f (vg:obj-extent
3cf0: 73 20 6f 62 6a 29 0a 09 28 76 67 3a 6f 62 6a 2d s obj)..(vg:obj-
3d00: 65 78 74 65 6e 74 73 20 6f 62 6a 29 0a 09 28 69 extents obj)..(i
3d10: 66 20 28 6e 6f 74 20 74 65 78 74 29 0a 09 20 20 f (not text)..
3d20: 20 20 70 74 73 20 3b 3b 20 6e 6f 20 74 65 78 74 pts ;; no text
3d30: 0a 09 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 .. (if (and t
3d40: 65 78 74 2d 78 6d 61 78 20 74 65 78 74 2d 79 6d ext-xmax text-ym
3d50: 61 78 29 20 3b 3b 20 68 61 76 65 20 74 65 78 74 ax) ;; have text
3d60: 0a 09 09 28 6c 65 74 20 28 28 78 74 20 28 6c 69 ...(let ((xt (li
3d70: 73 74 20 6c 6c 78 20 6c 6c 79 0a 09 09 09 09 28 st llx lly.....(
3d80: 6d 61 78 20 75 6c 78 20 28 2b 20 6c 6c 78 20 74 max ulx (+ llx t
3d90: 65 78 74 2d 78 6d 61 78 29 29 0a 09 09 09 09 28 ext-xmax)).....(
3da0: 6d 61 78 20 75 6c 79 20 28 2b 20 6c 6c 79 20 74 max uly (+ lly t
3db0: 65 78 74 2d 79 6d 61 78 29 29 29 29 29 0a 09 09 ext-ymax)))))...
3dc0: 20 20 28 76 67 3a 6f 62 6a 2d 65 78 74 65 6e 74 (vg:obj-extent
3dd0: 73 2d 73 65 74 21 20 6f 62 6a 20 78 74 29 0a 09 s-set! obj xt)..
3de0: 09 20 20 78 74 29 0a 09 09 28 69 66 20 63 6e 76 . xt)...(if cnv
3df0: 0a 09 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 ... (if (eq?
3e00: 64 72 61 77 20 27 67 65 74 2d 65 78 74 65 6e 74 draw 'get-extent
3e10: 73 29 0a 09 09 09 28 6c 65 74 2d 76 61 6c 75 65 s)....(let-value
3e20: 73 20 28 28 28 78 6d 61 78 20 79 6d 61 78 29 28 s (((xmax ymax)(
3e30: 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 69 7a 65 canvas-text-size
3e40: 20 63 6e 76 20 74 65 78 74 29 29 29 0a 09 09 09 cnv text)))....
3e50: 09 20 20 20 20 28 6c 65 74 20 28 28 78 74 20 28 . (let ((xt (
3e60: 6c 69 73 74 20 6c 6c 78 20 6c 6c 79 0a 09 09 09 list llx lly....
3e70: 09 09 09 20 20 20 20 28 6d 61 78 20 75 6c 78 20 ... (max ulx
3e80: 28 2b 20 6c 6c 78 20 78 6d 61 78 29 29 0a 09 09 (+ llx xmax))...
3e90: 09 09 09 09 20 20 20 20 28 6d 61 78 20 75 6c 79 .... (max uly
3ea0: 20 28 2b 20 6c 6c 79 20 79 6d 61 78 29 29 29 29 (+ lly ymax))))
3eb0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 76 67 3a )..... (vg:
3ec0: 6f 62 6a 2d 65 78 74 65 6e 74 73 2d 73 65 74 21 obj-extents-set!
3ed0: 20 6f 62 6a 20 78 74 29 0a 09 09 09 09 20 20 20 obj xt).....
3ee0: 20 20 20 78 74 29 29 0a 09 09 09 70 74 73 29 0a xt))....pts).
3ef0: 09 09 20 20 20 20 70 74 73 29 29 29 29 29 29 20 .. pts))))))
3f00: 3b 3b 20 72 65 74 75 72 6e 20 65 78 74 65 6e 74 ;; return extent
3f10: 73 20 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 72 s ..;; given a r
3f20: 65 63 74 20 6f 62 6a 20 64 72 61 77 20 69 74 20 ect obj draw it
3f30: 6f 6e 20 74 68 65 20 63 61 6e 76 61 73 20 61 70 on the canvas ap
3f40: 70 6c 79 69 6e 67 20 66 69 72 73 74 20 74 68 65 plying first the
3f50: 20 64 72 61 77 69 6e 67 0a 3b 3b 20 73 63 61 6c drawing.;; scal
3f60: 65 20 61 6e 64 20 6f 66 66 73 65 74 0a 3b 3b 0a e and offset.;;.
3f70: 28 64 65 66 69 6e 65 20 28 76 67 3a 64 72 61 77 (define (vg:draw
3f80: 2d 6c 69 6e 65 20 64 72 61 77 69 6e 67 20 6f 62 -line drawing ob
3f90: 6a 20 23 21 6b 65 79 20 28 64 72 61 77 20 23 74 j #!key (draw #t
3fa0: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6e 76 )). (let* ((cnv
3fb0: 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 63 6e 76 (vg:drawing-cnv
3fc0: 20 64 72 61 77 69 6e 67 29 29 0a 09 20 28 70 74 drawing)).. (pt
3fd0: 73 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 61 70 s (vg:drawing-ap
3fe0: 70 6c 79 2d 73 63 61 6c 65 20 64 72 61 77 69 6e ply-scale drawin
3ff0: 67 20 28 76 67 3a 6f 62 6a 2d 70 74 73 20 6f 62 g (vg:obj-pts ob
4000: 6a 29 29 29 0a 09 20 3b 3b 20 28 66 69 6c 6c 2d j))).. ;; (fill-
4010: 63 6f 6c 6f 72 20 28 76 67 3a 6f 62 6a 2d 66 69 color (vg:obj-fi
4020: 6c 6c 2d 63 6f 6c 6f 72 20 6f 62 6a 29 29 0a 09 ll-color obj))..
4030: 20 28 6c 69 6e 65 2d 63 6f 6c 6f 72 20 28 76 67 (line-color (vg
4040: 3a 6f 62 6a 2d 6c 69 6e 65 2d 63 6f 6c 6f 72 20 :obj-line-color
4050: 6f 62 6a 29 29 0a 09 20 28 74 65 78 74 20 20 20 obj)).. (text
4060: 20 20 20 20 28 76 67 3a 6f 62 6a 2d 74 65 78 74 (vg:obj-text
4070: 20 6f 62 6a 29 29 0a 09 20 28 66 6f 6e 74 20 20 obj)).. (font
4080: 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e (vg:obj-fon
4090: 74 20 6f 62 6a 29 29 0a 09 20 28 6c 6c 78 20 20 t obj)).. (llx
40a0: 20 20 20 20 20 20 28 63 61 72 20 70 74 73 29 29 (car pts))
40b0: 0a 09 20 28 6c 6c 79 20 20 20 20 20 20 20 20 28 .. (lly (
40c0: 63 61 64 72 20 70 74 73 29 29 0a 09 20 28 75 6c cadr pts)).. (ul
40d0: 78 20 20 20 20 20 20 20 20 28 63 61 64 64 72 20 x (caddr
40e0: 70 74 73 29 29 0a 09 20 28 75 6c 79 20 20 20 20 pts)).. (uly
40f0: 20 20 20 20 28 63 61 64 64 64 72 20 70 74 73 29 (cadddr pts)
4100: 29 0a 09 20 28 77 20 20 20 20 20 20 20 20 20 20 ).. (w
4110: 28 2d 20 75 6c 78 20 6c 6c 78 29 29 0a 09 20 28 (- ulx llx)).. (
4120: 68 20 20 20 20 20 20 20 20 20 20 28 2d 20 75 6c h (- ul
4130: 79 20 6c 6c 79 29 29 0a 09 20 28 74 65 78 74 2d y lly)).. (text-
4140: 78 6d 61 78 20 20 23 66 29 0a 09 20 28 74 65 78 xmax #f).. (tex
4150: 74 2d 79 6d 61 78 20 20 23 66 29 29 0a 20 20 20 t-ymax #f)).
4160: 20 28 69 66 20 64 72 61 77 20 0a 09 28 6c 65 74 (if draw ..(let
4170: 20 28 28 70 72 65 76 2d 62 61 63 6b 67 72 6f 75 ((prev-backgrou
4180: 6e 64 2d 63 6f 6c 6f 72 20 28 63 61 6e 76 61 73 nd-color (canvas
4190: 2d 62 61 63 6b 67 72 6f 75 6e 64 20 63 6e 76 29 -background cnv)
41a0: 29 0a 09 20 20 20 20 20 20 28 70 72 65 76 2d 66 ).. (prev-f
41b0: 6f 72 65 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 20 oreground-color
41c0: 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 (canvas-foregrou
41d0: 6e 64 20 63 6e 76 29 29 29 0a 09 3b 3b 20 28 69 nd cnv)))..;; (i
41e0: 66 20 66 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 3b 3b f fill-color..;;
41f0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 3b 3b 20 (begin..;;
4200: 09 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f .(canvas-foregro
4210: 75 6e 64 2d 73 65 74 21 20 63 6e 76 20 66 69 6c und-set! cnv fil
4220: 6c 2d 63 6f 6c 6f 72 29 0a 09 3b 3b 20 09 28 63 l-color)..;; .(c
4230: 61 6e 76 61 73 2d 62 6f 78 21 20 63 6e 76 20 6c anvas-box! cnv l
4240: 6c 78 20 75 6c 78 20 6c 6c 79 20 75 6c 79 29 29 lx ulx lly uly))
4250: 29 20 3b 3b 20 64 6f 63 73 20 61 72 65 20 61 6c ) ;; docs are al
4260: 6c 20 6f 76 65 72 20 74 68 65 20 70 6c 61 63 65 l over the place
4270: 20 6f 6e 20 74 68 69 73 20 6f 6e 65 2e 3b 3b 20 on this one.;;
4280: 77 20 68 29 0a 09 20 20 28 69 66 20 6c 69 6e 65 w h).. (if line
4290: 2d 63 6f 6c 6f 72 0a 09 20 20 20 20 20 20 28 63 -color.. (c
42a0: 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 anvas-foreground
42b0: 2d 73 65 74 21 20 63 6e 76 20 6c 69 6e 65 2d 63 -set! cnv line-c
42c0: 6f 6c 6f 72 29 29 0a 09 20 20 20 20 20 3b 3b 20 olor)).. ;;
42d0: 28 69 66 20 66 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 (if fill-color..
42e0: 20 20 20 20 20 3b 3b 20 20 28 63 61 6e 76 61 73 ;; (canvas
42f0: 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 -foreground-set!
4300: 20 63 6e 76 20 70 72 65 76 2d 66 6f 72 65 67 72 cnv prev-foregr
4310: 6f 75 6e 64 2d 63 6f 6c 6f 72 29 29 29 0a 09 20 ound-color)))..
4320: 20 28 63 61 6e 76 61 73 2d 6c 69 6e 65 21 20 63 (canvas-line! c
4330: 6e 76 20 6c 6c 78 20 6c 6c 79 20 75 6c 78 20 75 nv llx lly ulx u
4340: 6c 79 29 0a 09 20 20 28 63 61 6e 76 61 73 2d 66 ly).. (canvas-f
4350: 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 20 63 oreground-set! c
4360: 6e 76 20 70 72 65 76 2d 66 6f 72 65 67 72 6f 75 nv prev-foregrou
4370: 6e 64 2d 63 6f 6c 6f 72 29 0a 09 20 20 28 69 66 nd-color).. (if
4380: 20 74 65 78 74 20 0a 09 20 20 20 20 20 20 28 6c text .. (l
4390: 65 74 2a 20 28 28 70 72 65 76 2d 66 6f 6e 74 20 et* ((prev-font
43a0: 20 20 20 28 63 61 6e 76 61 73 2d 66 6f 6e 74 20 (canvas-font
43b0: 63 6e 76 29 29 0a 09 09 20 20 20 20 20 28 66 6f cnv))... (fo
43c0: 6e 74 2d 63 68 61 6e 67 65 64 20 28 61 6e 64 20 nt-changed (and
43d0: 66 6f 6e 74 20 28 6e 6f 74 20 28 65 71 75 61 6c font (not (equal
43e0: 3f 20 66 6f 6e 74 20 70 72 65 76 2d 66 6f 6e 74 ? font prev-font
43f0: 29 29 29 29 29 0a 09 09 28 69 66 20 66 6f 6e 74 )))))...(if font
4400: 2d 63 68 61 6e 67 65 64 20 28 63 61 6e 76 61 73 -changed (canvas
4410: 2d 66 6f 6e 74 2d 73 65 74 21 20 63 6e 76 20 66 -font-set! cnv f
4420: 6f 6e 74 29 29 0a 09 09 28 63 61 6e 76 61 73 2d ont))...(canvas-
4430: 74 65 78 74 21 20 63 6e 76 20 28 2b 20 32 20 6c text! cnv (+ 2 l
4440: 6c 78 29 28 2b 20 32 20 6c 6c 79 29 20 74 65 78 lx)(+ 2 lly) tex
4450: 74 29 0a 09 09 28 6c 65 74 2d 76 61 6c 75 65 73 t)...(let-values
4460: 20 28 28 28 78 6d 61 78 20 79 6d 61 78 29 28 63 (((xmax ymax)(c
4470: 61 6e 76 61 73 2d 74 65 78 74 2d 73 69 7a 65 20 anvas-text-size
4480: 63 6e 76 20 74 65 78 74 29 29 29 0a 09 09 20 20 cnv text)))...
4490: 28 73 65 74 21 20 74 65 78 74 2d 78 6d 61 78 20 (set! text-xmax
44a0: 78 6d 61 78 29 28 73 65 74 21 20 74 65 78 74 2d xmax)(set! text-
44b0: 79 6d 61 78 20 79 6d 61 78 29 29 0a 09 09 28 69 ymax ymax))...(i
44c0: 66 20 66 6f 6e 74 2d 63 68 61 6e 67 65 64 20 28 f font-changed (
44d0: 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 74 21 canvas-font-set!
44e0: 20 63 6e 76 20 70 72 65 76 2d 66 6f 6e 74 29 29 cnv prev-font))
44f0: 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 69 )))). ;; (pri
4500: 6e 74 20 22 74 65 78 74 2d 78 6d 61 78 3a 20 22 nt "text-xmax: "
4510: 20 74 65 78 74 2d 78 6d 61 78 20 22 20 74 65 78 text-xmax " tex
4520: 74 2d 79 6d 61 78 3a 20 22 20 74 65 78 74 2d 79 t-ymax: " text-y
4530: 6d 61 78 29 0a 20 20 20 20 28 69 66 20 28 76 67 max). (if (vg
4540: 3a 6f 62 6a 2d 65 78 74 65 6e 74 73 20 6f 62 6a :obj-extents obj
4550: 29 0a 09 28 76 67 3a 6f 62 6a 2d 65 78 74 65 6e )..(vg:obj-exten
4560: 74 73 20 6f 62 6a 29 0a 09 28 69 66 20 28 6e 6f ts obj)..(if (no
4570: 74 20 74 65 78 74 29 0a 09 20 20 20 20 70 74 73 t text).. pts
4580: 0a 09 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 .. (if (and t
4590: 65 78 74 2d 78 6d 61 78 20 74 65 78 74 2d 79 6d ext-xmax text-ym
45a0: 61 78 29 0a 09 09 28 6c 65 74 20 28 28 78 74 20 ax)...(let ((xt
45b0: 28 6c 69 73 74 20 6c 6c 78 20 6c 6c 79 0a 09 09 (list llx lly...
45c0: 09 09 28 6d 61 78 20 75 6c 78 20 28 2b 20 6c 6c ..(max ulx (+ ll
45d0: 78 20 74 65 78 74 2d 78 6d 61 78 29 29 0a 09 09 x text-xmax))...
45e0: 09 09 28 6d 61 78 20 75 6c 79 20 28 2b 20 6c 6c ..(max uly (+ ll
45f0: 79 20 74 65 78 74 2d 79 6d 61 78 29 29 29 29 29 y text-ymax)))))
4600: 0a 09 09 20 20 28 76 67 3a 6f 62 6a 2d 65 78 74 ... (vg:obj-ext
4610: 65 6e 74 73 2d 73 65 74 21 20 6f 62 6a 20 78 74 ents-set! obj xt
4620: 29 0a 09 09 20 20 78 74 29 0a 09 09 28 69 66 20 )... xt)...(if
4630: 63 6e 76 0a 09 09 20 20 20 20 28 6c 65 74 2d 76 cnv... (let-v
4640: 61 6c 75 65 73 20 28 28 28 78 6d 61 78 20 79 6d alues (((xmax ym
4650: 61 78 29 28 63 61 6e 76 61 73 2d 74 65 78 74 2d ax)(canvas-text-
4660: 73 69 7a 65 20 63 6e 76 20 74 65 78 74 29 29 29 size cnv text)))
4670: 0a 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ... (let ((
4680: 78 74 20 28 6c 69 73 74 20 6c 6c 78 20 6c 6c 79 xt (list llx lly
4690: 0a 09 09 09 09 20 20 20 20 20 20 28 6d 61 78 20 ..... (max
46a0: 75 6c 78 20 28 2b 20 6c 6c 78 20 78 6d 61 78 29 ulx (+ llx xmax)
46b0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 6d 61 78 )..... (max
46c0: 20 75 6c 79 20 28 2b 20 6c 6c 79 20 79 6d 61 78 uly (+ lly ymax
46d0: 29 29 29 29 29 0a 09 09 09 28 76 67 3a 6f 62 6a )))))....(vg:obj
46e0: 2d 65 78 74 65 6e 74 73 2d 73 65 74 21 20 6f 62 -extents-set! ob
46f0: 6a 20 78 74 29 0a 09 09 09 78 74 29 29 0a 09 09 j xt)....xt))...
4700: 20 20 20 20 70 74 73 29 29 29 29 29 29 20 3b 3b pts)))))) ;;
4710: 20 72 65 74 75 72 6e 20 65 78 74 65 6e 74 73 20 return extents
4720: 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 72 65 63 ..;; given a rec
4730: 74 20 6f 62 6a 20 64 72 61 77 20 69 74 20 6f 6e t obj draw it on
4740: 20 74 68 65 20 63 61 6e 76 61 73 20 61 70 70 6c the canvas appl
4750: 79 69 6e 67 20 66 69 72 73 74 20 74 68 65 20 64 ying first the d
4760: 72 61 77 69 6e 67 0a 3b 3b 20 73 63 61 6c 65 20 rawing.;; scale
4770: 61 6e 64 20 6f 66 66 73 65 74 0a 3b 3b 0a 28 64 and offset.;;.(d
4780: 65 66 69 6e 65 20 28 76 67 3a 64 72 61 77 2d 78 efine (vg:draw-x
4790: 61 78 69 73 20 64 72 61 77 69 6e 67 20 6f 62 6a axis drawing obj
47a0: 20 23 21 6b 65 79 20 28 64 72 61 77 20 23 74 29 #!key (draw #t)
47b0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6e 76 20 ). (let* ((cnv
47c0: 28 76 67 3a 64 72 61 77 69 6e 67 2d 63 6e 76 20 (vg:drawing-cnv
47d0: 64 72 61 77 69 6e 67 29 29 0a 09 20 28 70 74 73 drawing)).. (pts
47e0: 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 61 70 70 (vg:drawing-app
47f0: 6c 79 2d 73 63 61 6c 65 20 64 72 61 77 69 6e 67 ly-scale drawing
4800: 20 28 76 67 3a 6f 62 6a 2d 70 74 73 20 6f 62 6a (vg:obj-pts obj
4810: 29 29 29 0a 09 20 3b 3b 20 28 66 69 6c 6c 2d 63 ))).. ;; (fill-c
4820: 6f 6c 6f 72 20 28 76 67 3a 6f 62 6a 2d 66 69 6c olor (vg:obj-fil
4830: 6c 2d 63 6f 6c 6f 72 20 6f 62 6a 29 29 0a 09 20 l-color obj))..
4840: 28 6c 69 6e 65 2d 63 6f 6c 6f 72 20 28 76 67 3a (line-color (vg:
4850: 6f 62 6a 2d 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f obj-line-color o
4860: 62 6a 29 29 0a 09 20 28 74 65 78 74 20 20 20 20 bj)).. (text
4870: 20 20 20 28 76 67 3a 6f 62 6a 2d 74 65 78 74 20 (vg:obj-text
4880: 6f 62 6a 29 29 0a 09 20 28 66 6f 6e 74 20 20 20 obj)).. (font
4890: 20 20 20 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e 74 (vg:obj-font
48a0: 20 6f 62 6a 29 29 0a 09 20 28 6c 6c 78 20 20 20 obj)).. (llx
48b0: 20 20 20 20 20 28 63 61 72 20 70 74 73 29 29 0a (car pts)).
48c0: 09 20 28 6c 6c 79 20 20 20 20 20 20 20 20 28 63 . (lly (c
48d0: 61 64 72 20 70 74 73 29 29 0a 09 20 28 75 6c 78 adr pts)).. (ulx
48e0: 20 20 20 20 20 20 20 20 28 63 61 64 64 72 20 70 (caddr p
48f0: 74 73 29 29 0a 09 20 28 75 6c 79 20 20 20 20 20 ts)).. (uly
4900: 20 20 20 28 63 61 64 64 64 72 20 70 74 73 29 29 (cadddr pts))
4910: 0a 09 20 28 77 20 20 20 20 20 20 20 20 20 20 28 .. (w (
4920: 2d 20 75 6c 78 20 6c 6c 78 29 29 0a 09 20 28 68 - ulx llx)).. (h
4930: 20 20 20 20 20 20 20 20 20 20 28 2d 20 75 6c 79 (- uly
4940: 20 6c 6c 79 29 29 0a 09 20 28 74 65 78 74 2d 78 lly)).. (text-x
4950: 6d 61 78 20 20 23 66 29 0a 09 20 28 74 65 78 74 max #f).. (text
4960: 2d 79 6d 61 78 20 20 23 66 29 29 0a 20 20 20 20 -ymax #f)).
4970: 28 69 66 20 64 72 61 77 20 0a 09 28 6c 65 74 20 (if draw ..(let
4980: 28 28 70 72 65 76 2d 62 61 63 6b 67 72 6f 75 6e ((prev-backgroun
4990: 64 2d 63 6f 6c 6f 72 20 28 63 61 6e 76 61 73 2d d-color (canvas-
49a0: 62 61 63 6b 67 72 6f 75 6e 64 20 63 6e 76 29 29 background cnv))
49b0: 0a 09 20 20 20 20 20 20 28 70 72 65 76 2d 66 6f .. (prev-fo
49c0: 72 65 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 20 28 reground-color (
49d0: 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e canvas-foregroun
49e0: 64 20 63 6e 76 29 29 29 0a 09 3b 3b 20 28 69 66 d cnv)))..;; (if
49f0: 20 66 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 3b 3b 20 fill-color..;;
4a00: 20 20 20 20 28 62 65 67 69 6e 0a 09 3b 3b 20 09 (begin..;; .
4a10: 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 (canvas-foregrou
4a20: 6e 64 2d 73 65 74 21 20 63 6e 76 20 66 69 6c 6c nd-set! cnv fill
4a30: 2d 63 6f 6c 6f 72 29 0a 09 3b 3b 20 09 28 63 61 -color)..;; .(ca
4a40: 6e 76 61 73 2d 62 6f 78 21 20 63 6e 76 20 6c 6c nvas-box! cnv ll
4a50: 78 20 75 6c 78 20 6c 6c 79 20 75 6c 79 29 29 29 x ulx lly uly)))
4a60: 20 3b 3b 20 64 6f 63 73 20 61 72 65 20 61 6c 6c ;; docs are all
4a70: 20 6f 76 65 72 20 74 68 65 20 70 6c 61 63 65 20 over the place
4a80: 6f 6e 20 74 68 69 73 20 6f 6e 65 2e 3b 3b 20 77 on this one.;; w
4a90: 20 68 29 0a 09 20 20 28 69 66 20 6c 69 6e 65 2d h).. (if line-
4aa0: 63 6f 6c 6f 72 0a 09 20 20 20 20 20 20 28 63 61 color.. (ca
4ab0: 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 2d nvas-foreground-
4ac0: 73 65 74 21 20 63 6e 76 20 6c 69 6e 65 2d 63 6f set! cnv line-co
4ad0: 6c 6f 72 29 0a 09 20 20 20 20 20 20 23 3b 28 69 lor).. #;(i
4ae0: 66 20 66 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 09 20 f fill-color...
4af0: 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f (canvas-foregro
4b00: 75 6e 64 2d 73 65 74 21 20 63 6e 76 20 70 72 65 und-set! cnv pre
4b10: 76 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 63 6f 6c v-foreground-col
4b20: 6f 72 29 29 29 0a 09 20 20 28 63 61 6e 76 61 73 or))).. (canvas
4b30: 2d 6c 69 6e 65 21 20 63 6e 76 20 6c 6c 78 20 75 -line! cnv llx u
4b40: 6c 78 20 6c 6c 79 20 75 6c 79 29 0a 09 20 20 28 lx lly uly).. (
4b50: 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e canvas-foregroun
4b60: 64 2d 73 65 74 21 20 63 6e 76 20 70 72 65 76 2d d-set! cnv prev-
4b70: 66 6f 72 65 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 foreground-color
4b80: 29 0a 09 20 20 28 69 66 20 74 65 78 74 20 0a 09 ).. (if text ..
4b90: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 72 (let* ((pr
4ba0: 65 76 2d 66 6f 6e 74 20 20 20 20 28 63 61 6e 76 ev-font (canv
4bb0: 61 73 2d 66 6f 6e 74 20 63 6e 76 29 29 0a 09 09 as-font cnv))...
4bc0: 20 20 20 20 20 28 66 6f 6e 74 2d 63 68 61 6e 67 (font-chang
4bd0: 65 64 20 28 61 6e 64 20 66 6f 6e 74 20 28 6e 6f ed (and font (no
4be0: 74 20 28 65 71 75 61 6c 3f 20 66 6f 6e 74 20 70 t (equal? font p
4bf0: 72 65 76 2d 66 6f 6e 74 29 29 29 29 29 0a 09 09 rev-font)))))...
4c00: 28 69 66 20 66 6f 6e 74 2d 63 68 61 6e 67 65 64 (if font-changed
4c10: 20 28 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 (canvas-font-se
4c20: 74 21 20 63 6e 76 20 66 6f 6e 74 29 29 0a 09 09 t! cnv font))...
4c30: 28 63 61 6e 76 61 73 2d 74 65 78 74 21 20 63 6e (canvas-text! cn
4c40: 76 20 28 2b 20 32 20 6c 6c 78 29 28 2b 20 32 20 v (+ 2 llx)(+ 2
4c50: 6c 6c 79 29 20 74 65 78 74 29 0a 09 09 28 6c 65 lly) text)...(le
4c60: 74 2d 76 61 6c 75 65 73 20 28 28 28 78 6d 61 78 t-values (((xmax
4c70: 20 79 6d 61 78 29 28 63 61 6e 76 61 73 2d 74 65 ymax)(canvas-te
4c80: 78 74 2d 73 69 7a 65 20 63 6e 76 20 74 65 78 74 xt-size cnv text
4c90: 29 29 29 0a 09 09 20 20 28 73 65 74 21 20 74 65 )))... (set! te
4ca0: 78 74 2d 78 6d 61 78 20 78 6d 61 78 29 28 73 65 xt-xmax xmax)(se
4cb0: 74 21 20 74 65 78 74 2d 79 6d 61 78 20 79 6d 61 t! text-ymax yma
4cc0: 78 29 29 0a 09 09 28 69 66 20 66 6f 6e 74 2d 63 x))...(if font-c
4cd0: 68 61 6e 67 65 64 20 28 63 61 6e 76 61 73 2d 66 hanged (canvas-f
4ce0: 6f 6e 74 2d 73 65 74 21 20 63 6e 76 20 70 72 65 ont-set! cnv pre
4cf0: 76 2d 66 6f 6e 74 29 29 29 29 29 29 0a 20 20 20 v-font)))))).
4d00: 20 3b 3b 20 28 70 72 69 6e 74 20 22 74 65 78 74 ;; (print "text
4d10: 2d 78 6d 61 78 3a 20 22 20 74 65 78 74 2d 78 6d -xmax: " text-xm
4d20: 61 78 20 22 20 74 65 78 74 2d 79 6d 61 78 3a 20 ax " text-ymax:
4d30: 22 20 74 65 78 74 2d 79 6d 61 78 29 0a 20 20 20 " text-ymax).
4d40: 20 28 69 66 20 28 76 67 3a 6f 62 6a 2d 65 78 74 (if (vg:obj-ext
4d50: 65 6e 74 73 20 6f 62 6a 29 0a 09 28 76 67 3a 6f ents obj)..(vg:o
4d60: 62 6a 2d 65 78 74 65 6e 74 73 20 6f 62 6a 29 0a bj-extents obj).
4d70: 09 28 69 66 20 28 6e 6f 74 20 74 65 78 74 29 0a .(if (not text).
4d80: 09 20 20 20 20 70 74 73 0a 09 20 20 20 20 28 69 . pts.. (i
4d90: 66 20 28 61 6e 64 20 74 65 78 74 2d 78 6d 61 78 f (and text-xmax
4da0: 20 74 65 78 74 2d 79 6d 61 78 29 0a 09 09 28 6c text-ymax)...(l
4db0: 65 74 20 28 28 78 74 20 28 6c 69 73 74 20 6c 6c et ((xt (list ll
4dc0: 78 20 6c 6c 79 0a 09 09 09 09 28 6d 61 78 20 75 x lly.....(max u
4dd0: 6c 78 20 28 2b 20 6c 6c 78 20 74 65 78 74 2d 78 lx (+ llx text-x
4de0: 6d 61 78 29 29 0a 09 09 09 09 28 6d 61 78 20 75 max)).....(max u
4df0: 6c 79 20 28 2b 20 6c 6c 79 20 74 65 78 74 2d 79 ly (+ lly text-y
4e00: 6d 61 78 29 29 29 29 29 0a 09 09 20 20 28 76 67 max)))))... (vg
4e10: 3a 6f 62 6a 2d 65 78 74 65 6e 74 73 2d 73 65 74 :obj-extents-set
4e20: 21 20 6f 62 6a 20 78 74 29 0a 09 09 20 20 78 74 ! obj xt)... xt
4e30: 29 0a 09 09 28 69 66 20 63 6e 76 0a 09 09 20 20 )...(if cnv...
4e40: 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 (let-values ((
4e50: 28 78 6d 61 78 20 79 6d 61 78 29 28 63 61 6e 76 (xmax ymax)(canv
4e60: 61 73 2d 74 65 78 74 2d 73 69 7a 65 20 63 6e 76 as-text-size cnv
4e70: 20 74 65 78 74 29 29 29 0a 09 09 20 20 20 20 20 text)))...
4e80: 20 28 6c 65 74 20 28 28 78 74 20 28 6c 69 73 74 (let ((xt (list
4e90: 20 6c 6c 78 20 6c 6c 79 0a 09 09 09 09 20 20 20 llx lly.....
4ea0: 20 20 20 28 6d 61 78 20 75 6c 78 20 28 2b 20 6c (max ulx (+ l
4eb0: 6c 78 20 78 6d 61 78 29 29 0a 09 09 09 09 20 20 lx xmax)).....
4ec0: 20 20 20 20 28 6d 61 78 20 75 6c 79 20 28 2b 20 (max uly (+
4ed0: 6c 6c 79 20 79 6d 61 78 29 29 29 29 29 0a 09 09 lly ymax)))))...
4ee0: 09 28 76 67 3a 6f 62 6a 2d 65 78 74 65 6e 74 73 .(vg:obj-extents
4ef0: 2d 73 65 74 21 20 6f 62 6a 20 78 74 29 0a 09 09 -set! obj xt)...
4f00: 09 78 74 29 29 0a 09 09 20 20 20 20 70 74 73 29 .xt))... pts)
4f10: 29 29 29 29 29 20 3b 3b 20 72 65 74 75 72 6e 20 ))))) ;; return
4f20: 65 78 74 65 6e 74 73 20 0a 0a 3b 3b 20 67 69 76 extents ..;; giv
4f30: 65 6e 20 61 20 72 65 63 74 20 6f 62 6a 20 64 72 en a rect obj dr
4f40: 61 77 20 69 74 20 6f 6e 20 74 68 65 20 63 61 6e aw it on the can
4f50: 76 61 73 20 61 70 70 6c 79 69 6e 67 20 66 69 72 vas applying fir
4f60: 73 74 20 74 68 65 20 64 72 61 77 69 6e 67 0a 3b st the drawing.;
4f70: 3b 20 73 63 61 6c 65 20 61 6e 64 20 6f 66 66 73 ; scale and offs
4f80: 65 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 et.;;.(define (v
4f90: 67 3a 64 72 61 77 2d 74 65 78 74 20 64 72 61 77 g:draw-text draw
4fa0: 69 6e 67 20 6f 62 6a 20 23 21 6b 65 79 20 28 64 ing obj #!key (d
4fb0: 72 61 77 20 23 74 29 29 0a 20 20 28 6c 65 74 2a raw #t)). (let*
4fc0: 20 28 28 63 6e 76 20 20 20 20 20 20 20 20 28 76 ((cnv (v
4fd0: 67 3a 64 72 61 77 69 6e 67 2d 63 6e 76 20 64 72 g:drawing-cnv dr
4fe0: 61 77 69 6e 67 29 29 0a 09 20 28 70 74 73 20 20 awing)).. (pts
4ff0: 20 20 20 20 20 20 28 76 67 3a 64 72 61 77 69 6e (vg:drawin
5000: 67 2d 61 70 70 6c 79 2d 73 63 61 6c 65 20 64 72 g-apply-scale dr
5010: 61 77 69 6e 67 20 28 76 67 3a 6f 62 6a 2d 70 74 awing (vg:obj-pt
5020: 73 20 6f 62 6a 29 29 29 0a 09 20 28 74 65 78 74 s obj))).. (text
5030: 20 20 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d 74 (vg:obj-t
5040: 65 78 74 20 6f 62 6a 29 29 0a 09 20 28 66 6f 6e ext obj)).. (fon
5050: 74 20 20 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d t (vg:obj-
5060: 66 6f 6e 74 20 6f 62 6a 29 29 0a 09 20 28 66 69 font obj)).. (fi
5070: 6c 6c 2d 63 6f 6c 6f 72 20 28 76 67 3a 6f 62 6a ll-color (vg:obj
5080: 2d 66 69 6c 6c 2d 63 6f 6c 6f 72 20 6f 62 6a 29 -fill-color obj)
5090: 29 0a 09 20 28 6c 69 6e 65 2d 63 6f 6c 6f 72 20 ).. (line-color
50a0: 28 76 67 3a 6f 62 6a 2d 6c 69 6e 65 2d 63 6f 6c (vg:obj-line-col
50b0: 6f 72 20 6f 62 6a 29 29 0a 09 20 28 6c 6c 78 20 or obj)).. (llx
50c0: 20 20 20 20 20 20 20 28 63 61 72 20 70 74 73 29 (car pts)
50d0: 29 20 0a 09 20 28 6c 6c 79 20 20 20 20 20 20 20 ) .. (lly
50e0: 20 28 63 61 64 72 20 70 74 73 29 29 29 0a 20 20 (cadr pts))).
50f0: 20 20 28 69 66 20 64 72 61 77 20 0a 09 28 6c 65 (if draw ..(le
5100: 74 2a 20 28 28 70 72 65 76 2d 62 61 63 6b 67 72 t* ((prev-backgr
5110: 6f 75 6e 64 2d 63 6f 6c 6f 72 20 28 63 61 6e 76 ound-color (canv
5120: 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 20 63 6e as-background cn
5130: 76 29 29 0a 09 20 20 20 20 20 20 20 28 70 72 65 v)).. (pre
5140: 76 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 63 6f 6c v-foreground-col
5150: 6f 72 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 or (canvas-foreg
5160: 72 6f 75 6e 64 20 63 6e 76 29 29 0a 09 20 20 20 round cnv))..
5170: 20 20 20 20 28 70 72 65 76 2d 66 6f 6e 74 20 20 (prev-font
5180: 20 20 20 20 20 20 20 20 20 20 20 28 63 61 6e 76 (canv
5190: 61 73 2d 66 6f 6e 74 20 20 20 20 20 20 20 63 6e as-font cn
51a0: 76 29 29 0a 09 20 20 20 20 20 20 20 28 66 6f 6e v)).. (fon
51b0: 74 2d 63 68 61 6e 67 65 64 20 20 20 20 28 61 6e t-changed (an
51c0: 64 20 66 6f 6e 74 20 28 6e 6f 74 20 28 65 71 75 d font (not (equ
51d0: 61 6c 3f 20 66 6f 6e 74 20 70 72 65 76 2d 66 6f al? font prev-fo
51e0: 6e 74 29 29 29 29 29 0a 09 20 20 28 69 66 20 6c nt))))).. (if l
51f0: 69 6e 65 2d 63 6f 6c 6f 72 0a 09 20 20 20 20 20 ine-color..
5200: 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f (canvas-foregro
5210: 75 6e 64 2d 73 65 74 21 20 63 6e 76 20 6c 69 6e und-set! cnv lin
5220: 65 2d 63 6f 6c 6f 72 29 0a 09 20 20 20 20 20 20 e-color)..
5230: 28 69 66 20 66 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 (if fill-color..
5240: 09 20 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 . (canvas-foreg
5250: 72 6f 75 6e 64 2d 73 65 74 21 20 63 6e 76 20 70 round-set! cnv p
5260: 72 65 76 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 63 rev-foreground-c
5270: 6f 6c 6f 72 29 29 29 0a 09 20 20 28 69 66 20 66 olor))).. (if f
5280: 6f 6e 74 2d 63 68 61 6e 67 65 64 20 28 63 61 6e ont-changed (can
5290: 76 61 73 2d 66 6f 6e 74 2d 73 65 74 21 20 63 6e vas-font-set! cn
52a0: 76 20 66 6f 6e 74 29 29 0a 09 20 20 28 63 61 6e v font)).. (can
52b0: 76 61 73 2d 74 65 78 74 21 20 63 6e 76 20 6c 6c vas-text! cnv ll
52c0: 78 20 6c 6c 79 20 74 65 78 74 29 0a 09 20 20 3b x lly text).. ;
52d0: 3b 20 4e 4f 54 45 3a 20 77 65 20 64 6f 20 6e 6f ; NOTE: we do no
52e0: 74 20 73 65 74 20 74 68 65 20 66 6f 6e 74 20 62 t set the font b
52f0: 61 63 6b 21 21 0a 09 20 20 28 63 61 6e 76 61 73 ack!!.. (canvas
5300: 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 -foreground-set!
5310: 20 63 6e 76 20 70 72 65 76 2d 66 6f 72 65 67 72 cnv prev-foregr
5320: 6f 75 6e 64 2d 63 6f 6c 6f 72 29 29 29 0a 20 20 ound-color))).
5330: 20 20 28 69 66 20 63 6e 76 0a 09 28 69 66 20 28 (if cnv..(if (
5340: 65 71 3f 20 64 72 61 77 20 27 67 65 74 2d 65 78 eq? draw 'get-ex
5350: 74 65 6e 74 73 29 0a 09 20 20 20 20 28 6c 65 74 tents).. (let
5360: 2d 76 61 6c 75 65 73 20 28 28 28 78 6d 61 78 20 -values (((xmax
5370: 79 6d 61 78 29 28 63 61 6e 76 61 73 2d 74 65 78 ymax)(canvas-tex
5380: 74 2d 73 69 7a 65 20 63 6e 76 20 74 65 78 74 29 t-size cnv text)
5390: 29 29 0a 09 09 09 28 61 70 70 65 6e 64 20 70 74 ))....(append pt
53a0: 73 20 28 6c 69 73 74 20 28 2b 20 6c 6c 78 20 78 s (list (+ llx x
53b0: 6d 61 78 29 28 2b 20 6c 6c 79 20 79 6d 61 78 29 max)(+ lly ymax)
53c0: 29 29 29 20 3b 3b 20 77 69 6c 6c 20 62 65 20 77 ))) ;; will be w
53d0: 72 6f 6e 67 20 69 66 20 74 65 78 74 20 69 73 20 rong if text is
53e0: 72 6f 74 61 74 65 64 3f 0a 09 20 20 20 20 28 61 rotated?.. (a
53f0: 70 70 65 6e 64 20 70 74 73 20 70 74 73 29 29 0a ppend pts pts)).
5400: 09 28 61 70 70 65 6e 64 20 70 74 73 20 70 74 73 .(append pts pts
5410: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 76 ))))..(define (v
5420: 67 3a 64 72 61 77 2d 69 6e 73 74 20 64 72 61 77 g:draw-inst draw
5430: 69 6e 67 20 69 6e 73 74 20 23 21 6b 65 79 20 28 ing inst #!key (
5440: 64 72 61 77 2d 6d 6f 64 65 20 23 74 29 28 70 72 draw-mode #t)(pr
5450: 65 76 2d 65 78 74 65 6e 74 73 20 27 28 29 29 29 ev-extents '()))
5460: 0a 20 20 28 6c 65 74 2a 20 28 28 6c 69 62 6e 61 . (let* ((libna
5470: 6d 65 20 20 28 76 67 3a 69 6e 73 74 2d 6c 69 62 me (vg:inst-lib
5480: 6e 61 6d 65 20 69 6e 73 74 29 29 0a 09 20 28 63 name inst)).. (c
5490: 6f 6d 70 6e 61 6d 65 20 28 76 67 3a 69 6e 73 74 ompname (vg:inst
54a0: 2d 63 6f 6d 70 6e 61 6d 65 20 69 6e 73 74 29 29 -compname inst))
54b0: 0a 09 20 28 63 6f 6d 70 20 20 20 20 20 28 76 67 .. (comp (vg
54c0: 3a 67 65 74 2d 63 6f 6d 70 6f 6e 65 6e 74 20 64 :get-component d
54d0: 72 61 77 69 6e 67 20 6c 69 62 6e 61 6d 65 20 63 rawing libname c
54e0: 6f 6d 70 6e 61 6d 65 29 29 0a 09 20 28 6f 62 6a ompname)).. (obj
54f0: 73 20 20 20 20 20 28 76 67 3a 63 6f 6d 70 2d 6f s (vg:comp-o
5500: 62 6a 73 20 63 6f 6d 70 29 29 29 0a 20 20 20 20 bjs comp))).
5510: 3b 3b 20 28 70 72 69 6e 74 20 22 63 6f 6d 70 3a ;; (print "comp:
5520: 20 22 20 63 6f 6d 70 29 0a 20 20 20 20 28 69 66 " comp). (if
5530: 20 28 6e 75 6c 6c 3f 20 6f 62 6a 73 29 0a 09 70 (null? objs)..p
5540: 72 65 76 2d 65 78 74 65 6e 74 73 0a 09 28 6c 65 rev-extents..(le
5550: 74 20 6c 6f 6f 70 20 28 28 6f 62 6a 20 28 63 61 t loop ((obj (ca
5560: 72 20 6f 62 6a 73 29 29 0a 09 09 20 20 20 28 74 r objs))... (t
5570: 61 6c 20 28 63 64 72 20 6f 62 6a 73 29 29 0a 09 al (cdr objs))..
5580: 09 20 20 20 28 72 65 73 20 70 72 65 76 2d 65 78 . (res prev-ex
5590: 74 65 6e 74 73 29 29 0a 09 20 20 28 6c 65 74 2a tents)).. (let*
55a0: 20 28 28 6f 62 6a 2d 78 66 72 6d 64 20 28 76 67 ((obj-xfrmd (vg
55b0: 3a 6d 61 70 2d 6f 62 6a 20 64 72 61 77 69 6e 67 :map-obj drawing
55c0: 20 69 6e 73 74 20 6f 62 6a 29 29 0a 09 09 20 28 inst obj))... (
55d0: 6e 65 77 72 65 73 20 20 20 20 28 63 6f 6e 73 20 newres (cons
55e0: 28 76 67 3a 64 72 61 77 2d 6f 62 6a 20 64 72 61 (vg:draw-obj dra
55f0: 77 69 6e 67 20 6f 62 6a 2d 78 66 72 6d 64 20 64 wing obj-xfrmd d
5600: 72 61 77 3a 20 64 72 61 77 2d 6d 6f 64 65 29 20 raw: draw-mode)
5610: 72 65 73 29 29 29 0a 09 20 20 20 20 28 69 66 20 res))).. (if
5620: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 6e 65 (null? tal)...ne
5630: 77 72 65 73 0a 09 09 28 6c 6f 6f 70 20 28 63 61 wres...(loop (ca
5640: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 20 r tal)(cdr tal)
5650: 6e 65 77 72 65 73 29 29 29 29 29 29 29 0a 0a 28 newres)))))))..(
5660: 64 65 66 69 6e 65 20 28 76 67 3a 64 72 61 77 20 define (vg:draw
5670: 64 72 61 77 69 6e 67 20 64 72 61 77 2d 6d 6f 64 drawing draw-mod
5680: 65 20 2e 20 69 6e 73 74 6e 61 6d 65 73 29 0a 20 e . instnames).
5690: 20 28 6c 65 74 2a 20 28 28 69 6e 73 74 73 20 28 (let* ((insts (
56a0: 76 67 3a 64 72 61 77 69 6e 67 2d 69 6e 73 74 73 vg:drawing-insts
56b0: 20 64 72 61 77 69 6e 67 29 29 0a 09 20 28 61 6c drawing)).. (al
56c0: 6c 2d 69 6e 73 74 2d 6e 61 6d 65 73 20 28 68 61 l-inst-names (ha
56d0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 69 6e sh-table-keys in
56e0: 73 74 73 29 29 0a 09 20 28 6d 61 73 74 65 72 2d sts)).. (master-
56f0: 6c 69 73 74 20 20 20 20 28 69 66 20 28 6e 75 6c list (if (nul
5700: 6c 3f 20 69 6e 73 74 6e 61 6d 65 73 29 0a 09 09 l? instnames)...
5710: 09 20 20 20 20 20 61 6c 6c 2d 69 6e 73 74 2d 6e . all-inst-n
5720: 61 6d 65 73 0a 09 09 09 20 20 20 20 20 69 6e 73 ames.... ins
5730: 74 6e 61 6d 65 73 29 29 29 0a 20 20 20 20 28 69 tnames))). (i
5740: 66 20 28 6e 75 6c 6c 3f 20 6d 61 73 74 65 72 2d f (null? master-
5750: 6c 69 73 74 29 0a 09 27 28 29 0a 09 28 6c 65 74 list)..'()..(let
5760: 20 6c 6f 6f 70 20 28 28 69 6e 73 74 6e 61 6d 65 loop ((instname
5770: 20 28 63 61 72 20 6d 61 73 74 65 72 2d 6c 69 73 (car master-lis
5780: 74 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 20 t))... (tal
5790: 20 20 20 28 63 64 72 20 6d 61 73 74 65 72 2d 6c (cdr master-l
57a0: 69 73 74 29 29 0a 09 09 20 20 20 28 72 65 73 20 ist))... (res
57b0: 20 20 20 20 20 27 28 29 29 29 0a 09 20 20 28 6c '())).. (l
57c0: 65 74 2a 20 28 28 69 6e 73 74 20 20 20 20 20 28 et* ((inst (
57d0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
57e0: 65 66 61 75 6c 74 20 69 6e 73 74 73 20 69 6e 73 efault insts ins
57f0: 74 6e 61 6d 65 20 23 66 29 29 0a 09 09 20 28 6e tname #f))... (n
5800: 65 77 72 65 73 20 20 20 28 69 66 20 69 6e 73 74 ewres (if inst
5810: 0a 09 09 09 20 20 20 20 20 20 20 28 76 67 3a 64 .... (vg:d
5820: 72 61 77 2d 69 6e 73 74 20 64 72 61 77 69 6e 67 raw-inst drawing
5830: 20 69 6e 73 74 20 64 72 61 77 2d 6d 6f 64 65 3a inst draw-mode:
5840: 20 64 72 61 77 2d 6d 6f 64 65 20 70 72 65 76 2d draw-mode prev-
5850: 65 78 74 65 6e 74 73 3a 20 72 65 73 29 0a 09 09 extents: res)...
5860: 09 20 20 20 20 20 20 20 72 65 73 29 29 29 0a 09 . res)))..
5870: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
5880: 61 6c 29 0a 09 09 6e 65 77 72 65 73 0a 09 09 28 al)...newres...(
5890: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
58a0: 64 72 20 74 61 6c 29 20 6e 65 77 72 65 73 29 29 dr tal) newres))
58b0: 29 29 29 29 29 0a ))))).