Artifact
79994f610cf8d2f79f864321464965f35f81fbcd:
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 28 75 73 65 20 caltime')..(use
0330: 74 79 70 65 64 2d 72 65 63 6f 72 64 73 20 73 72 typed-records sr
0340: 66 69 2d 31 29 0a 0a 28 64 65 63 6c 61 72 65 20 fi-1)..(declare
0350: 28 75 6e 69 74 20 76 67 29 29 0a 28 75 73 65 20 (unit vg)).(use
0360: 63 61 6e 76 61 73 2d 64 72 61 77 20 69 75 70 29 canvas-draw iup)
0370: 0a 28 69 6d 70 6f 72 74 20 63 61 6e 76 61 73 2d .(import canvas-
0380: 64 72 61 77 2d 69 75 70 29 0a 0a 28 69 6e 63 6c draw-iup)..(incl
0390: 75 64 65 20 22 76 67 5f 72 65 63 6f 72 64 73 2e ude "vg_records.
03a0: 73 63 6d 22 29 0a 0a 3b 3b 20 3b 3b 20 73 74 72 scm")..;; ;; str
03b0: 75 63 74 73 0a 3b 3b 20 3b 3b 0a 3b 3b 20 28 64 ucts.;; ;;.;; (d
03c0: 65 66 73 74 72 75 63 74 20 76 67 3a 6c 69 62 20 efstruct vg:lib
03d0: 20 20 20 20 63 6f 6d 70 73 29 0a 3b 3b 20 28 64 comps).;; (d
03e0: 65 66 73 74 72 75 63 74 20 76 67 3a 63 6f 6d 70 efstruct vg:comp
03f0: 20 20 20 20 6f 62 6a 73 20 6e 61 6d 65 20 66 69 objs name fi
0400: 6c 65 29 0a 3b 3b 20 3b 3b 20 65 78 74 65 6e 74 le).;; ;; extent
0410: 73 20 63 61 63 68 65 73 20 65 78 74 65 6e 74 73 s caches extents
0420: 20 63 61 6c 63 75 6c 61 74 65 64 20 6f 6e 20 64 calculated on d
0430: 72 61 77 0a 3b 3b 20 3b 3b 20 70 72 6f 63 20 69 raw.;; ;; proc i
0440: 73 20 63 61 6c 6c 65 64 20 6f 6e 20 64 72 61 77 s called on draw
0450: 20 61 6e 64 20 74 61 6b 65 73 20 74 68 65 20 6f and takes the o
0460: 62 6a 20 69 74 73 65 6c 66 20 61 73 20 61 20 70 bj itself as a p
0470: 61 72 61 6d 65 74 65 72 0a 3b 3b 20 3b 3b 20 61 arameter.;; ;; a
0480: 74 74 72 69 62 20 69 73 20 61 6e 20 61 6c 69 73 ttrib is an alis
0490: 74 20 6f 66 20 70 61 72 61 6d 65 74 65 72 73 0a t of parameters.
04a0: 3b 3b 20 28 64 65 66 73 74 72 75 63 74 20 76 67 ;; (defstruct vg
04b0: 3a 6f 62 6a 20 20 20 20 20 74 79 70 65 20 70 74 :obj type pt
04c0: 73 20 66 69 6c 6c 2d 63 6f 6c 6f 72 20 74 65 78 s fill-color tex
04d0: 74 20 6c 69 6e 65 2d 63 6f 6c 6f 72 20 63 61 6c t line-color cal
04e0: 6c 2d 62 61 63 6b 20 61 6e 67 6c 65 20 66 6f 6e l-back angle fon
04f0: 74 20 61 74 74 72 69 62 20 65 78 74 65 6e 74 73 t attrib extents
0500: 20 70 72 6f 63 29 0a 3b 3b 20 28 64 65 66 73 74 proc).;; (defst
0510: 72 75 63 74 20 76 67 3a 69 6e 73 74 20 20 20 20 ruct vg:inst
0520: 6c 69 62 6e 61 6d 65 20 63 6f 6d 70 6e 61 6d 65 libname compname
0530: 20 74 68 65 74 61 20 78 6f 66 66 20 79 6f 66 66 theta xoff yoff
0540: 20 73 63 61 6c 65 78 20 73 63 61 6c 65 79 20 6d scalex scaley m
0550: 69 72 72 78 20 6d 69 72 72 79 20 63 61 6c 6c 2d irrx mirry call-
0560: 62 61 63 6b 20 63 61 63 68 65 29 0a 3b 3b 20 28 back cache).;; (
0570: 64 65 66 73 74 72 75 63 74 20 76 67 3a 64 72 61 defstruct vg:dra
0580: 77 69 6e 67 20 6c 69 62 73 20 69 6e 73 74 73 20 wing libs insts
0590: 73 63 61 6c 65 78 20 73 63 61 6c 65 79 20 78 6f scalex scaley xo
05a0: 66 66 20 79 6f 66 66 20 63 6e 76 20 63 61 63 68 ff yoff cnv cach
05b0: 65 29 20 3b 3b 20 6c 69 62 73 3a 20 68 61 73 68 e) ;; libs: hash
05c0: 20 6f 66 20 6e 61 6d 65 2d 3e 6c 69 62 2c 20 69 of name->lib, i
05d0: 6e 73 74 73 3a 20 68 61 73 68 20 6f 66 20 69 6e nsts: hash of in
05e0: 73 74 6e 61 6d 65 2d 3e 69 6e 73 74 0a 0a 3b 3b stname->inst..;;
05f0: 20 69 6e 69 74 73 0a 3b 3b 0a 28 64 65 66 69 6e inits.;;.(defin
0600: 65 20 28 76 67 3a 63 6f 6d 70 2d 6e 65 77 29 0a e (vg:comp-new).
0610: 20 20 28 6d 61 6b 65 2d 76 67 3a 63 6f 6d 70 20 (make-vg:comp
0620: 6f 62 6a 73 3a 20 27 28 29 20 6e 61 6d 65 3a 20 objs: '() name:
0630: 23 66 20 66 69 6c 65 3a 20 23 66 29 29 0a 0a 28 #f file: #f))..(
0640: 64 65 66 69 6e 65 20 28 76 67 3a 6c 69 62 2d 6e define (vg:lib-n
0650: 65 77 29 0a 20 20 28 6d 61 6b 65 2d 76 67 3a 6c ew). (make-vg:l
0660: 69 62 20 63 6f 6d 70 73 3a 20 28 6d 61 6b 65 2d ib comps: (make-
0670: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 0a 28 hash-table)))..(
0680: 64 65 66 69 6e 65 20 28 76 67 3a 64 72 61 77 69 define (vg:drawi
0690: 6e 67 2d 6e 65 77 29 0a 20 20 28 6d 61 6b 65 2d ng-new). (make-
06a0: 76 67 3a 64 72 61 77 69 6e 67 20 73 63 61 6c 65 vg:drawing scale
06b0: 78 3a 20 31 20 0a 09 09 20 20 20 73 63 61 6c 65 x: 1 ... scale
06c0: 79 3a 20 31 20 0a 09 09 20 20 20 78 6f 66 66 3a y: 1 ... xoff:
06d0: 20 30 20 0a 09 09 20 20 20 79 6f 66 66 3a 20 30 0 ... yoff: 0
06e0: 20 0a 09 09 20 20 20 6c 69 62 73 3a 20 28 6d 61 ... libs: (ma
06f0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 0a ke-hash-table) .
0700: 09 09 20 20 20 69 6e 73 74 73 3a 20 28 6d 61 6b .. insts: (mak
0710: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a 09 09 e-hash-table)...
0720: 20 20 20 63 61 63 68 65 3a 20 27 28 29 29 29 0a cache: '())).
0730: 0a 3b 3b 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 3d 3d 3d ================
0760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 73 63 61 =========.;; sca
0780: 6c 69 6e 67 20 61 6e 64 20 6f 66 66 73 65 74 73 ling and offsets
0790: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
07a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
07e0: 6e 65 2d 69 6e 6c 69 6e 65 20 28 76 67 3a 73 63 ne-inline (vg:sc
07f0: 61 6c 65 2d 6f 66 66 73 65 74 20 76 61 6c 20 73 ale-offset val s
0800: 20 6f 29 0a 20 20 28 2b 20 6f 20 28 2a 20 76 61 o). (+ o (* va
0810: 6c 20 73 29 29 29 0a 20 20 3b 3b 20 28 2a 20 28 l s))). ;; (* (
0820: 2b 20 6f 20 76 61 6c 29 20 73 29 29 0a 0a 3b 3b + o val) s))..;;
0830: 20 61 70 70 6c 79 20 73 63 61 6c 65 20 61 6e 64 apply scale and
0840: 20 6f 66 66 73 65 74 20 74 6f 20 61 20 6c 69 73 offset to a lis
0850: 74 20 6f 66 20 78 20 79 20 76 61 6c 75 65 73 0a t of x y values.
0860: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 73 ;;.(define (vg:s
0870: 63 61 6c 65 2d 6f 66 66 73 65 74 2d 78 79 20 6c cale-offset-xy l
0880: 73 74 78 79 20 73 78 20 73 79 20 6f 78 20 6f 79 stxy sx sy ox oy
0890: 29 0a 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 ). (if (> (leng
08a0: 74 68 20 6c 73 74 78 79 29 20 31 29 20 3b 3b 20 th lstxy) 1) ;;
08b0: 68 61 76 65 20 61 74 20 6c 65 61 73 74 20 6f 6e have at least on
08c0: 65 20 78 79 20 70 61 69 72 0a 20 20 20 20 20 20 e xy pair.
08d0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 78 20 20 20 (let loop ((x
08e0: 28 63 61 72 20 6c 73 74 78 79 29 29 0a 09 09 20 (car lstxy))...
08f0: 28 79 20 20 20 28 63 61 64 72 20 6c 73 74 78 79 (y (cadr lstxy
0900: 29 29 0a 09 09 20 28 74 61 6c 20 28 63 64 64 72 ))... (tal (cddr
0910: 20 6c 73 74 78 79 29 29 0a 09 09 20 28 72 65 73 lstxy))... (res
0920: 20 27 28 29 29 29 0a 09 28 6c 65 74 20 28 28 6e '()))..(let ((n
0930: 65 77 72 65 73 20 28 63 6f 6e 73 20 28 76 67 3a ewres (cons (vg:
0940: 73 63 61 6c 65 2d 6f 66 66 73 65 74 20 79 20 73 scale-offset y s
0950: 79 20 6f 79 29 0a 09 09 09 20 20 20 20 28 63 6f y oy).... (co
0960: 6e 73 20 28 76 67 3a 73 63 61 6c 65 2d 6f 66 66 ns (vg:scale-off
0970: 73 65 74 20 78 20 73 78 20 6f 78 29 0a 09 09 09 set x sx ox)....
0980: 09 20 20 72 65 73 29 29 29 29 0a 09 20 20 28 69 . res)))).. (i
0990: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 74 61 6c f (> (length tal
09a0: 29 20 31 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f ) 1).. (loo
09b0: 70 20 28 63 61 72 20 74 61 6c 29 28 63 61 64 72 p (car tal)(cadr
09c0: 20 74 61 6c 29 28 63 64 64 72 20 74 61 6c 29 20 tal)(cddr tal)
09d0: 6e 65 77 72 65 73 29 0a 09 20 20 20 20 20 20 28 newres).. (
09e0: 72 65 76 65 72 73 65 20 6e 65 77 72 65 73 29 29 reverse newres))
09f0: 29 29 0a 20 20 20 20 20 20 27 28 29 29 29 0a 0a )). '()))..
0a00: 3b 3b 20 61 70 70 6c 79 20 64 72 61 77 69 6e 67 ;; apply drawing
0a10: 20 6f 66 66 73 65 74 20 61 6e 64 20 73 63 61 6c offset and scal
0a20: 69 6e 67 20 74 6f 20 74 68 65 20 70 6f 69 6e 74 ing to the point
0a30: 73 20 69 6e 20 6c 73 74 78 79 0a 3b 3b 0a 28 64 s in lstxy.;;.(d
0a40: 65 66 69 6e 65 20 28 76 67 3a 64 72 61 77 69 6e efine (vg:drawin
0a50: 67 2d 61 70 70 6c 79 2d 73 63 61 6c 65 20 64 72 g-apply-scale dr
0a60: 61 77 69 6e 67 20 6c 73 74 78 79 29 0a 20 20 28 awing lstxy). (
0a70: 76 67 3a 73 63 61 6c 65 2d 6f 66 66 73 65 74 2d vg:scale-offset-
0a80: 78 79 20 0a 20 20 20 6c 73 74 78 79 0a 20 20 20 xy . lstxy.
0a90: 28 76 67 3a 64 72 61 77 69 6e 67 2d 73 63 61 6c (vg:drawing-scal
0aa0: 65 78 20 64 72 61 77 69 6e 67 29 0a 20 20 20 28 ex drawing). (
0ab0: 76 67 3a 64 72 61 77 69 6e 67 2d 73 63 61 6c 65 vg:drawing-scale
0ac0: 79 20 64 72 61 77 69 6e 67 29 0a 20 20 20 28 76 y drawing). (v
0ad0: 67 3a 64 72 61 77 69 6e 67 2d 78 6f 66 66 20 20 g:drawing-xoff
0ae0: 20 64 72 61 77 69 6e 67 29 0a 20 20 20 28 76 67 drawing). (vg
0af0: 3a 64 72 61 77 69 6e 67 2d 79 6f 66 66 20 20 20 :drawing-yoff
0b00: 64 72 61 77 69 6e 67 29 29 29 0a 0a 3b 3b 20 61 drawing)))..;; a
0b10: 70 70 6c 79 20 69 6e 73 74 61 6e 63 65 20 6f 66 pply instance of
0b20: 66 73 65 74 20 61 6e 64 20 73 63 61 6c 69 6e 67 fset and scaling
0b30: 20 74 6f 20 74 68 65 20 70 6f 69 6e 74 73 20 69 to the points i
0b40: 6e 20 6c 73 74 78 79 0a 3b 3b 0a 28 64 65 66 69 n lstxy.;;.(defi
0b50: 6e 65 20 28 76 67 3a 69 6e 73 74 2d 61 70 70 6c ne (vg:inst-appl
0b60: 79 2d 73 63 61 6c 65 20 69 6e 73 74 20 6c 73 74 y-scale inst lst
0b70: 78 79 29 0a 20 20 28 76 67 3a 73 63 61 6c 65 2d xy). (vg:scale-
0b80: 6f 66 66 73 65 74 2d 78 79 20 0a 20 20 20 6c 73 offset-xy . ls
0b90: 74 78 79 0a 20 20 20 28 76 67 3a 69 6e 73 74 2d txy. (vg:inst-
0ba0: 73 63 61 6c 65 78 20 69 6e 73 74 29 0a 20 20 20 scalex inst).
0bb0: 28 76 67 3a 69 6e 73 74 2d 73 63 61 6c 65 79 20 (vg:inst-scaley
0bc0: 69 6e 73 74 29 0a 20 20 20 28 76 67 3a 69 6e 73 inst). (vg:ins
0bd0: 74 2d 78 6f 66 66 20 20 20 69 6e 73 74 29 0a 20 t-xoff inst).
0be0: 20 20 28 76 67 3a 69 6e 73 74 2d 79 6f 66 66 20 (vg:inst-yoff
0bf0: 20 20 69 6e 73 74 29 29 29 0a 0a 3b 3b 20 61 70 inst)))..;; ap
0c00: 70 6c 79 20 62 6f 74 68 20 64 72 61 77 69 6e 67 ply both drawing
0c10: 20 61 6e 64 20 69 6e 73 74 61 6e 63 65 20 73 63 and instance sc
0c20: 61 6c 69 6e 67 20 74 6f 20 61 20 6c 69 73 74 20 aling to a list
0c30: 6f 66 20 78 79 20 70 6f 69 6e 74 73 0a 3b 3b 20 of xy points.;;
0c40: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 64 72 61 .(define (vg:dra
0c50: 77 69 6e 67 2d 69 6e 73 74 2d 61 70 70 6c 79 2d wing-inst-apply-
0c60: 73 63 61 6c 65 2d 6f 66 66 73 65 74 20 64 72 61 scale-offset dra
0c70: 77 69 6e 67 20 69 6e 73 74 20 6c 73 74 78 79 29 wing inst lstxy)
0c80: 0a 20 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 61 . (vg:drawing-a
0c90: 70 70 6c 79 2d 73 63 61 6c 65 20 0a 20 20 20 64 pply-scale . d
0ca0: 72 61 77 69 6e 67 0a 20 20 20 28 76 67 3a 69 6e rawing. (vg:in
0cb0: 73 74 2d 61 70 70 6c 79 2d 73 63 61 6c 65 20 69 st-apply-scale i
0cc0: 6e 73 74 20 6c 73 74 78 79 29 29 29 0a 0a 3b 3b nst lstxy)))..;;
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 3d 3d ================
0cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d10: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6f 62 6a 65 63 74 ======.;; object
0d20: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
0d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 20 ==========..;;
0d70: 20 28 76 67 3a 69 6e 73 74 2d 61 70 70 6c 79 2d (vg:inst-apply-
0d80: 73 63 61 6c 65 20 0a 3b 3b 20 20 20 20 69 6e 73 scale .;; ins
0d90: 74 0a 3b 3b 20 20 20 20 28 76 67 3a 64 72 61 77 t.;; (vg:draw
0da0: 69 6e 67 2d 61 70 70 6c 79 2d 73 63 61 6c 65 20 ing-apply-scale
0db0: 64 72 61 77 69 6e 67 20 6c 73 74 78 79 29 29 29 drawing lstxy)))
0dc0: 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 72 65 63 74 ..;; make a rect
0dd0: 61 6e 67 6c 65 20 6f 62 6a 0a 3b 3b 0a 28 64 65 angle obj.;;.(de
0de0: 66 69 6e 65 20 28 76 67 3a 6d 61 6b 65 2d 72 65 fine (vg:make-re
0df0: 63 74 2d 6f 62 6a 20 78 31 20 79 31 20 78 32 20 ct-obj x1 y1 x2
0e00: 79 32 20 23 21 6b 65 79 20 28 6c 69 6e 65 2d 63 y2 #!key (line-c
0e10: 6f 6c 6f 72 20 23 66 29 28 66 69 6c 6c 2d 63 6f olor #f)(fill-co
0e20: 6c 6f 72 20 23 66 29 28 74 65 78 74 20 23 66 29 lor #f)(text #f)
0e30: 28 66 6f 6e 74 20 23 66 29 28 65 78 74 65 6e 74 (font #f)(extent
0e40: 73 20 23 66 29 29 0a 20 20 28 6d 61 6b 65 2d 76 s #f)). (make-v
0e50: 67 3a 6f 62 6a 20 74 79 70 65 3a 20 27 72 20 70 g:obj type: 'r p
0e60: 74 73 3a 20 28 6c 69 73 74 20 78 31 20 79 31 20 ts: (list x1 y1
0e70: 78 32 20 79 32 29 20 74 65 78 74 3a 20 74 65 78 x2 y2) text: tex
0e80: 74 20 66 6f 6e 74 3a 20 66 6f 6e 74 20 6c 69 6e t font: font lin
0e90: 65 2d 63 6f 6c 6f 72 3a 20 6c 69 6e 65 2d 63 6f e-color: line-co
0ea0: 6c 6f 72 20 66 69 6c 6c 2d 63 6f 6c 6f 72 3a 20 lor fill-color:
0eb0: 66 69 6c 6c 2d 63 6f 6c 6f 72 20 65 78 74 65 6e fill-color exten
0ec0: 74 73 3a 20 65 78 74 65 6e 74 73 29 29 0a 0a 3b ts: extents))..;
0ed0: 3b 20 6d 61 6b 65 20 61 20 72 65 63 74 61 6e 67 ; make a rectang
0ee0: 6c 65 20 6f 62 6a 0a 3b 3b 20 0a 28 64 65 66 69 le obj.;; .(defi
0ef0: 6e 65 20 28 76 67 3a 6d 61 6b 65 2d 6c 69 6e 65 ne (vg:make-line
0f00: 2d 6f 62 6a 20 78 31 20 79 31 20 78 32 20 79 32 -obj x1 y1 x2 y2
0f10: 20 23 21 6b 65 79 20 28 6c 69 6e 65 2d 63 6f 6c #!key (line-col
0f20: 6f 72 20 23 66 29 28 66 69 6c 6c 2d 63 6f 6c 6f or #f)(fill-colo
0f30: 72 20 23 66 29 28 74 65 78 74 20 23 66 29 28 66 r #f)(text #f)(f
0f40: 6f 6e 74 20 23 66 29 28 65 78 74 65 6e 74 73 20 ont #f)(extents
0f50: 23 66 29 29 0a 20 20 28 6d 61 6b 65 2d 76 67 3a #f)). (make-vg:
0f60: 6f 62 6a 20 74 79 70 65 3a 20 27 6c 20 70 74 73 obj type: 'l pts
0f70: 3a 20 28 6c 69 73 74 20 78 31 20 79 31 20 78 32 : (list x1 y1 x2
0f80: 20 79 32 29 20 74 65 78 74 3a 20 74 65 78 74 20 y2) text: text
0f90: 66 6f 6e 74 3a 20 66 6f 6e 74 20 6c 69 6e 65 2d font: font line-
0fa0: 63 6f 6c 6f 72 3a 20 6c 69 6e 65 2d 63 6f 6c 6f color: line-colo
0fb0: 72 20 65 78 74 65 6e 74 73 3a 20 65 78 74 65 6e r extents: exten
0fc0: 74 73 29 29 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 ts))..;; make a
0fd0: 74 65 78 74 20 6f 62 6a 0a 3b 3b 0a 28 64 65 66 text obj.;;.(def
0fe0: 69 6e 65 20 28 76 67 3a 6d 61 6b 65 2d 74 65 78 ine (vg:make-tex
0ff0: 74 2d 6f 62 6a 20 78 31 20 79 31 20 74 65 78 74 t-obj x1 y1 text
1000: 20 23 21 6b 65 79 20 28 6c 69 6e 65 2d 63 6f 6c #!key (line-col
1010: 6f 72 20 23 66 29 28 66 69 6c 6c 2d 63 6f 6c 6f or #f)(fill-colo
1020: 72 20 23 66 29 0a 09 09 20 20 20 20 20 20 28 61 r #f)... (a
1030: 6e 67 6c 65 20 23 66 29 28 73 63 61 6c 65 2d 77 ngle #f)(scale-w
1040: 69 74 68 2d 7a 6f 6f 6d 20 23 66 29 28 66 6f 6e ith-zoom #f)(fon
1050: 74 20 23 66 29 0a 09 09 20 20 20 20 20 20 28 66 t #f)... (f
1060: 6f 6e 74 2d 73 69 7a 65 20 23 66 29 29 0a 20 20 ont-size #f)).
1070: 28 6d 61 6b 65 2d 76 67 3a 6f 62 6a 20 74 79 70 (make-vg:obj typ
1080: 65 3a 20 27 74 20 70 74 73 3a 20 28 6c 69 73 74 e: 't pts: (list
1090: 20 78 31 20 79 31 29 20 74 65 78 74 3a 20 74 65 x1 y1) text: te
10a0: 78 74 20 0a 09 20 20 20 20 20 20 20 6c 69 6e 65 xt .. line
10b0: 2d 63 6f 6c 6f 72 3a 20 6c 69 6e 65 2d 63 6f 6c -color: line-col
10c0: 6f 72 20 66 69 6c 6c 2d 63 6f 6c 6f 72 3a 20 66 or fill-color: f
10d0: 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 20 20 20 20 20 ill-color..
10e0: 20 20 61 6e 67 6c 65 3a 20 61 6e 67 6c 65 20 66 angle: angle f
10f0: 6f 6e 74 3a 20 66 6f 6e 74 20 65 78 74 65 6e 74 ont: font extent
1100: 73 3a 20 23 66 0a 09 20 20 20 20 20 20 20 61 74 s: #f.. at
1110: 74 72 69 62 75 74 65 73 3a 20 28 76 67 3a 6d 61 tributes: (vg:ma
1120: 6b 65 2d 61 74 74 72 69 62 20 27 66 6f 6e 74 2d ke-attrib 'font-
1130: 73 69 7a 65 20 66 6f 6e 74 2d 73 69 7a 65 29 29 size font-size))
1140: 29 0a 0a 3b 3b 20 70 72 6f 63 20 74 61 6b 65 73 )..;; proc takes
1150: 20 73 74 61 72 74 6e 75 6d 20 61 6e 64 20 65 6e startnum and en
1160: 64 6e 75 6d 20 61 6e 64 20 79 69 65 6c 64 73 20 dnum and yields
1170: 73 63 61 6c 65 66 2c 20 70 65 72 2d 67 72 61 64 scalef, per-grad
1180: 20 61 6e 64 20 75 6e 69 74 6e 61 6d 65 0a 3b 3b and unitname.;;
1190: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 6d 61 6b .(define (vg:mak
11a0: 65 2d 78 61 78 69 73 2d 6f 62 6a 20 78 31 20 79 e-xaxis-obj x1 y
11b0: 31 20 78 32 20 79 32 20 23 21 6b 65 79 20 28 6c 1 x2 y2 #!key (l
11c0: 69 6e 65 2d 63 6f 6c 6f 72 20 23 66 29 28 66 69 ine-color #f)(fi
11d0: 6c 6c 2d 63 6f 6c 6f 72 20 23 66 29 28 74 65 78 ll-color #f)(tex
11e0: 74 20 23 66 29 28 66 6f 6e 74 20 23 66 29 28 70 t #f)(font #f)(p
11f0: 72 6f 63 20 23 66 29 29 0a 20 20 28 6d 61 6b 65 roc #f)). (make
1200: 2d 76 67 3a 6f 62 6a 20 74 79 70 65 3a 20 27 78 -vg:obj type: 'x
1210: 20 70 74 73 3a 20 28 6c 69 73 74 20 78 31 20 79 pts: (list x1 y
1220: 31 20 78 32 20 79 32 29 20 74 65 78 74 3a 20 74 1 x2 y2) text: t
1230: 65 78 74 20 66 6f 6e 74 3a 20 66 6f 6e 74 20 6c ext font: font l
1240: 69 6e 65 2d 63 6f 6c 6f 72 3a 20 6c 69 6e 65 2d ine-color: line-
1250: 63 6f 6c 6f 72 20 66 69 6c 6c 2d 63 6f 6c 6f 72 color fill-color
1260: 3a 20 66 69 6c 6c 2d 63 6f 6c 6f 72 20 65 78 74 : fill-color ext
1270: 65 6e 74 73 3a 20 23 66 20 70 72 6f 63 3a 20 70 ents: #f proc: p
1280: 72 6f 63 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d roc))..;;=======
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 3d 3d 3d 3d 3d 3d 3d ================
12c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12d0: 3b 3b 20 6f 62 6a 20 6d 6f 64 69 66 69 65 72 73 ;; obj modifiers
12e0: 20 61 6e 64 20 71 75 65 72 69 65 73 0a 3b 3b 3d and queries.;;=
12f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1330: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 74 20 65 78 =====..;; get ex
1340: 74 65 6e 74 73 2c 20 75 73 65 20 6b 6e 6f 77 6c tents, use knowl
1350: 65 64 67 65 20 6f 66 20 74 79 70 65 20 2e 2e 2e edge of type ...
1360: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 3a .;;.(define (vg:
1370: 6f 62 6a 2d 67 65 74 2d 65 78 74 65 6e 74 73 20 obj-get-extents
1380: 64 72 61 77 69 6e 67 20 6f 62 6a 29 0a 20 20 28 drawing obj). (
1390: 6c 65 74 20 28 28 74 79 70 65 20 28 76 67 3a 6f let ((type (vg:o
13a0: 62 6a 2d 74 79 70 65 20 6f 62 6a 29 29 29 0a 20 bj-type obj))).
13b0: 20 20 20 28 63 61 73 65 20 74 79 70 65 0a 20 20 (case type.
13c0: 20 20 20 20 28 28 6c 29 28 76 67 3a 72 65 63 74 ((l)(vg:rect
13d0: 2d 67 65 74 2d 65 78 74 65 6e 74 73 20 6f 62 6a -get-extents obj
13e0: 29 29 0a 20 20 20 20 20 20 28 28 72 29 28 76 67 )). ((r)(vg
13f0: 3a 72 65 63 74 2d 67 65 74 2d 65 78 74 65 6e 74 :rect-get-extent
1400: 73 20 6f 62 6a 29 29 0a 20 20 20 20 20 20 28 28 s obj)). ((
1410: 74 29 28 76 67 3a 64 72 61 77 2d 74 65 78 74 20 t)(vg:draw-text
1420: 64 72 61 77 69 6e 67 20 6f 62 6a 20 64 72 61 77 drawing obj draw
1430: 3a 20 23 66 29 29 0a 20 20 20 20 20 20 28 65 6c : #f)). (el
1440: 73 65 20 23 66 29 29 29 29 0a 0a 28 64 65 66 69 se #f))))..(defi
1450: 6e 65 20 28 76 67 3a 72 65 63 74 2d 67 65 74 2d ne (vg:rect-get-
1460: 65 78 74 65 6e 74 73 20 6f 62 6a 29 0a 20 20 28 extents obj). (
1470: 76 67 3a 6f 62 6a 2d 70 74 73 20 6f 62 6a 29 29 vg:obj-pts obj))
1480: 20 3b 3b 20 65 78 74 65 6e 74 73 20 61 72 65 20 ;; extents are
1490: 6a 75 73 74 20 74 68 65 20 70 6f 69 6e 74 73 20 just the points
14a0: 66 6f 72 20 61 20 72 65 63 74 61 6e 67 6c 65 0a for a rectangle.
14b0: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 67 72 6f .(define (vg:gro
14c0: 77 2d 72 65 63 74 20 62 6f 72 64 65 72 78 20 62 w-rect borderx b
14d0: 6f 72 64 65 72 79 20 78 31 20 79 31 20 78 32 20 ordery x1 y1 x2
14e0: 79 32 29 0a 20 20 28 6c 69 73 74 0a 20 20 20 28 y2). (list. (
14f0: 2d 20 78 31 20 62 6f 72 64 65 72 78 29 0a 20 20 - x1 borderx).
1500: 20 28 2d 20 79 31 20 62 6f 72 64 65 72 79 29 0a (- y1 bordery).
1510: 20 20 20 28 2b 20 78 32 20 62 6f 72 64 65 72 78 (+ x2 borderx
1520: 29 0a 20 20 20 28 2b 20 79 32 20 62 6f 72 64 65 ). (+ y2 borde
1530: 72 79 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ry)))..(define (
1540: 76 67 3a 6d 61 6b 65 2d 61 74 74 72 69 62 20 2e vg:make-attrib .
1550: 20 61 74 74 72 69 62 2d 6c 69 73 74 29 0a 20 20 attrib-list).
1560: 23 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d #f)..;;=========
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 3d 3d 3d 3d 3d 3d 3d 3d ================
1590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
15b0: 20 63 6f 6d 70 6f 6e 65 6e 74 73 0a 3b 3b 3d 3d components.;;==
15c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1600: 3d 3d 3d 3d 0a 0a 3b 3b 20 61 64 64 20 6f 62 6a ====..;; add obj
1610: 20 74 6f 20 63 6f 6d 70 0a 3b 3b 0a 28 64 65 66 to comp.;;.(def
1620: 69 6e 65 20 28 76 67 3a 61 64 64 2d 6f 62 6a 73 ine (vg:add-objs
1630: 2d 74 6f 2d 63 6f 6d 70 20 63 6f 6d 70 20 2e 20 -to-comp comp .
1640: 6f 62 6a 73 29 0a 20 20 28 76 67 3a 63 6f 6d 70 objs). (vg:comp
1650: 2d 6f 62 6a 73 2d 73 65 74 21 20 63 6f 6d 70 20 -objs-set! comp
1660: 28 61 70 70 65 6e 64 20 28 76 67 3a 63 6f 6d 70 (append (vg:comp
1670: 2d 6f 62 6a 73 20 63 6f 6d 70 29 20 6f 62 6a 73 -objs comp) objs
1680: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 )))..(define (vg
1690: 3a 61 64 64 2d 6f 62 6a 2d 74 6f 2d 63 6f 6d 70 :add-obj-to-comp
16a0: 20 63 6f 6d 70 20 6f 62 6a 29 0a 20 20 28 76 67 comp obj). (vg
16b0: 3a 63 6f 6d 70 2d 6f 62 6a 73 2d 73 65 74 21 20 :comp-objs-set!
16c0: 63 6f 6d 70 20 28 63 6f 6e 73 20 6f 62 6a 20 28 comp (cons obj (
16d0: 76 67 3a 63 6f 6d 70 2d 6f 62 6a 73 20 63 6f 6d vg:comp-objs com
16e0: 70 29 29 29 29 0a 0a 3b 3b 20 75 73 65 20 74 68 p))))..;; use th
16f0: 65 20 73 74 72 75 63 74 2e 20 6c 65 61 76 65 20 e struct. leave
1700: 74 68 69 73 20 68 65 72 65 20 74 6f 20 72 65 6d this here to rem
1710: 69 6e 64 20 6f 66 20 74 68 69 73 21 0a 3b 3b 0a ind of this!.;;.
1720: 3b 3b 20 28 64 65 66 69 6e 65 20 28 76 67 3a 63 ;; (define (vg:c
1730: 6f 6d 70 2d 67 65 74 2d 6f 62 6a 73 20 63 6f 6d omp-get-objs com
1740: 70 29 0a 3b 3b 20 20 20 28 76 67 3a 63 6f 6d 70 p).;; (vg:comp
1750: 2d 6f 62 6a 73 20 63 6f 6d 70 29 29 0a 0a 3b 3b -objs comp))..;;
1760: 20 61 64 64 20 63 6f 6d 70 20 74 6f 20 6c 69 62 add comp to lib
1770: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 3a .;;.(define (vg:
1780: 61 64 64 2d 63 6f 6d 70 2d 74 6f 2d 6c 69 62 20 add-comp-to-lib
1790: 6c 69 62 20 63 6f 6d 70 6e 61 6d 65 20 63 6f 6d lib compname com
17a0: 70 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 p). (hash-table
17b0: 2d 73 65 74 21 20 28 76 67 3a 6c 69 62 2d 63 6f -set! (vg:lib-co
17c0: 6d 70 73 20 6c 69 62 29 20 63 6f 6d 70 6e 61 6d mps lib) compnam
17d0: 65 20 63 6f 6d 70 29 29 0a 0a 3b 3b 20 69 6e 73 e comp))..;; ins
17e0: 74 61 6e 63 69 61 74 65 20 63 6f 6d 70 6f 6e 65 tanciate compone
17f0: 6e 74 20 69 6e 20 64 72 61 77 69 6e 67 0a 3b 3b nt in drawing.;;
1800: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 69 6e 73 .(define (vg:ins
1810: 74 61 6e 74 69 61 74 65 20 64 72 61 77 69 6e 67 tantiate drawing
1820: 20 6c 69 62 6e 61 6d 65 20 63 6f 6d 70 6e 61 6d libname compnam
1830: 65 20 69 6e 73 74 6e 61 6d 65 20 78 6f 66 66 20 e instname xoff
1840: 79 6f 66 66 20 23 21 6b 65 79 20 28 74 68 65 74 yoff #!key (thet
1850: 61 20 30 29 28 73 63 61 6c 65 78 20 31 29 28 73 a 0)(scalex 1)(s
1860: 63 61 6c 65 79 20 31 29 28 6d 69 72 72 78 20 23 caley 1)(mirrx #
1870: 66 29 28 6d 69 72 72 79 20 23 66 29 29 0a 20 20 f)(mirry #f)).
1880: 28 6c 65 74 20 28 28 69 6e 73 74 20 28 6d 61 6b (let ((inst (mak
1890: 65 2d 76 67 3a 69 6e 73 74 20 6c 69 62 6e 61 6d e-vg:inst libnam
18a0: 65 3a 20 6c 69 62 6e 61 6d 65 20 63 6f 6d 70 6e e: libname compn
18b0: 61 6d 65 3a 20 63 6f 6d 70 6e 61 6d 65 20 78 6f ame: compname xo
18c0: 66 66 3a 20 78 6f 66 66 20 79 6f 66 66 3a 20 79 ff: xoff yoff: y
18d0: 6f 66 66 20 74 68 65 74 61 3a 20 74 68 65 74 61 off theta: theta
18e0: 20 73 63 61 6c 65 78 3a 20 73 63 61 6c 65 78 20 scalex: scalex
18f0: 73 63 61 6c 65 79 3a 20 73 63 61 6c 65 79 20 6d scaley: scaley m
1900: 69 72 72 78 3a 20 6d 69 72 72 78 20 6d 69 72 72 irrx: mirrx mirr
1910: 79 3a 20 6d 69 72 72 79 29 29 20 29 0a 20 20 20 y: mirry)) ).
1920: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
1930: 21 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 69 6e ! (vg:drawing-in
1940: 73 74 73 20 64 72 61 77 69 6e 67 29 20 69 6e 73 sts drawing) ins
1950: 74 6e 61 6d 65 20 69 6e 73 74 29 29 29 0a 0a 28 tname inst)))..(
1960: 64 65 66 69 6e 65 20 28 76 67 3a 69 6e 73 74 61 define (vg:insta
1970: 6e 63 65 2d 6d 6f 76 65 20 64 72 61 77 69 6e 67 nce-move drawing
1980: 20 69 6e 73 74 6e 61 6d 65 20 6e 65 77 78 20 6e instname newx n
1990: 65 77 79 29 0a 20 20 28 6c 65 74 20 28 28 69 6e ewy). (let ((in
19a0: 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 st (hash-table-r
19b0: 65 66 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 69 ef (vg:drawing-i
19c0: 6e 73 74 73 20 64 72 61 77 69 6e 67 29 20 69 6e nsts drawing) in
19d0: 73 74 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 76 stname))). (v
19e0: 67 3a 69 6e 73 74 2d 78 6f 66 66 2d 73 65 74 21 g:inst-xoff-set!
19f0: 20 69 6e 73 74 20 6e 65 77 78 29 0a 20 20 20 20 inst newx).
1a00: 28 76 67 3a 69 6e 73 74 2d 79 6f 66 66 2d 73 65 (vg:inst-yoff-se
1a10: 74 21 20 69 6e 73 74 20 6e 65 77 79 29 29 29 0a t! inst newy))).
1a20: 0a 3b 3b 20 67 65 74 20 63 6f 6d 70 6f 6e 65 6e .;; get componen
1a30: 74 20 66 72 6f 6d 20 64 72 61 77 69 6e 67 20 28 t from drawing (
1a40: 6c 6f 6f 6b 20 69 6e 20 61 70 72 6f 70 72 69 61 look in apropria
1a50: 74 65 20 6c 69 62 29 20 67 69 76 65 6e 20 6c 69 te lib) given li
1a60: 62 6e 61 6d 65 20 61 6e 64 20 63 6f 6d 70 6e 61 bname and compna
1a70: 6d 65 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 67 me.(define (vg:g
1a80: 65 74 2d 63 6f 6d 70 6f 6e 65 6e 74 20 64 72 61 et-component dra
1a90: 77 69 6e 67 20 6c 69 62 6e 61 6d 65 20 63 6f 6d wing libname com
1aa0: 70 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 pname). (let* (
1ab0: 28 6c 69 62 20 20 28 68 61 73 68 2d 74 61 62 6c (lib (hash-tabl
1ac0: 65 2d 72 65 66 20 28 76 67 3a 64 72 61 77 69 6e e-ref (vg:drawin
1ad0: 67 2d 6c 69 62 73 20 64 72 61 77 69 6e 67 29 20 g-libs drawing)
1ae0: 6c 69 62 6e 61 6d 65 29 29 0a 09 20 28 69 6e 73 libname)).. (ins
1af0: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
1b00: 66 20 28 76 67 3a 6c 69 62 2d 63 6f 6d 70 73 20 f (vg:lib-comps
1b10: 6c 69 62 29 20 63 6f 6d 70 6e 61 6d 65 29 29 29 lib) compname)))
1b20: 0a 20 20 20 20 69 6e 73 74 29 29 0a 0a 28 64 65 . inst))..(de
1b30: 66 69 6e 65 20 28 76 67 3a 67 65 74 2d 65 78 74 fine (vg:get-ext
1b40: 65 6e 74 73 2d 66 6f 72 2d 6f 62 6a 73 20 64 72 ents-for-objs dr
1b50: 61 77 69 6e 67 20 6f 62 6a 73 29 0a 20 20 28 69 awing objs). (i
1b60: 66 20 28 6f 72 20 28 6e 6f 74 20 6f 62 6a 73 29 f (or (not objs)
1b70: 0a 09 20 20 28 6e 75 6c 6c 3f 20 6f 62 6a 73 29 .. (null? objs)
1b80: 29 0a 20 20 20 20 20 20 23 66 0a 20 20 20 20 20 ). #f.
1b90: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
1ba0: 20 20 20 20 20 28 63 61 72 20 6f 62 6a 73 29 29 (car objs))
1bb0: 0a 09 09 20 28 74 61 6c 20 20 20 20 20 28 63 64 ... (tal (cd
1bc0: 72 20 6f 62 6a 73 29 29 0a 09 09 20 28 65 78 74 r objs))... (ext
1bd0: 65 6e 74 73 20 28 76 67 3a 6f 62 6a 2d 67 65 74 ents (vg:obj-get
1be0: 2d 65 78 74 65 6e 74 73 20 64 72 61 77 69 6e 67 -extents drawing
1bf0: 20 28 63 61 72 20 6f 62 6a 73 29 29 29 29 0a 09 (car objs))))..
1c00: 28 6c 65 74 20 28 28 6e 65 77 65 78 74 65 6e 74 (let ((newextent
1c10: 73 0a 09 20 20 20 20 20 20 20 28 76 67 3a 67 65 s.. (vg:ge
1c20: 74 2d 65 78 74 65 6e 74 73 2d 66 6f 72 2d 74 77 t-extents-for-tw
1c30: 6f 2d 72 65 63 74 73 0a 09 09 65 78 74 65 6e 74 o-rects...extent
1c40: 73 0a 09 09 28 76 67 3a 6f 62 6a 2d 67 65 74 2d s...(vg:obj-get-
1c50: 65 78 74 65 6e 74 73 20 64 72 61 77 69 6e 67 20 extents drawing
1c60: 68 65 64 29 29 29 29 0a 09 20 20 28 69 66 20 28 hed)))).. (if (
1c70: 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 null? tal)..
1c80: 20 20 65 78 74 65 6e 74 73 0a 09 20 20 20 20 20 extents..
1c90: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
1ca0: 28 63 64 72 20 74 61 6c 29 20 6e 65 77 65 78 74 (cdr tal) newext
1cb0: 65 6e 74 73 29 29 29 29 29 29 0a 0a 3b 3b 20 20 ents))))))..;;
1cc0: 20 28 6c 65 74 20 28 28 65 78 74 65 6e 74 73 20 (let ((extents
1cd0: 23 66 29 29 0a 3b 3b 20 20 20 20 20 28 66 6f 72 #f)).;; (for
1ce0: 2d 65 61 63 68 0a 3b 3b 20 20 20 20 20 20 28 6c -each.;; (l
1cf0: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 3b 3b 20 20 ambda (obj).;;
1d00: 20 20 20 20 20 20 28 73 65 74 21 20 65 78 74 65 (set! exte
1d10: 6e 74 73 0a 3b 3b 20 09 20 28 76 67 3a 67 65 74 nts.;; . (vg:get
1d20: 2d 65 78 74 65 6e 74 73 2d 66 6f 72 2d 74 77 6f -extents-for-two
1d30: 2d 72 65 63 74 73 0a 3b 3b 20 09 20 20 65 78 74 -rects.;; . ext
1d40: 65 6e 74 73 0a 3b 3b 20 09 20 20 28 76 67 3a 6f ents.;; . (vg:o
1d50: 62 6a 2d 67 65 74 2d 65 78 74 65 6e 74 73 20 64 bj-get-extents d
1d60: 72 61 77 69 6e 67 20 6f 62 6a 29 29 29 29 0a 3b rawing obj)))).;
1d70: 3b 20 20 20 20 20 20 6f 62 6a 73 29 0a 3b 3b 20 ; objs).;;
1d80: 20 20 20 20 65 78 74 65 6e 74 73 29 29 0a 0a 3b extents))..;
1d90: 3b 20 67 69 76 65 6e 20 72 65 63 74 61 6e 67 6c ; given rectangl
1da0: 65 73 20 72 31 20 61 6e 64 20 72 32 2c 20 72 65 es r1 and r2, re
1db0: 74 75 72 6e 20 74 68 65 20 62 6f 78 20 74 68 61 turn the box tha
1dc0: 74 20 62 6f 75 6e 64 73 20 62 6f 74 68 0a 3b 3b t bounds both.;;
1dd0: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 67 65 74 .(define (vg:get
1de0: 2d 65 78 74 65 6e 74 73 2d 66 6f 72 2d 74 77 6f -extents-for-two
1df0: 2d 72 65 63 74 73 20 72 31 20 72 32 29 0a 20 20 -rects r1 r2).
1e00: 28 69 66 20 28 6e 6f 74 20 72 31 29 0a 20 20 20 (if (not r1).
1e10: 20 20 20 72 32 0a 20 20 20 20 20 20 28 69 66 20 r2. (if
1e20: 28 6e 6f 74 20 72 32 29 0a 09 20 20 72 31 20 3b (not r2).. r1 ;
1e30: 3b 20 23 66 20 3b 3b 20 6e 6f 20 65 78 74 65 6e ; #f ;; no exten
1e40: 74 73 20 66 72 6f 6d 20 23 66 20 23 66 0a 09 20 ts from #f #f..
1e50: 20 28 6c 69 73 74 20 28 6d 69 6e 20 28 63 61 72 (list (min (car
1e60: 20 72 31 29 28 63 61 72 20 72 32 29 29 20 20 20 r1)(car r2))
1e70: 20 20 20 20 20 20 20 20 3b 3b 20 6c 6c 78 0a 09 ;; llx..
1e80: 09 28 6d 69 6e 20 28 63 61 64 72 20 72 31 29 28 .(min (cadr r1)(
1e90: 63 61 64 72 20 72 32 29 29 20 20 20 20 20 20 20 cadr r2))
1ea0: 20 20 3b 3b 20 6c 6c 79 0a 09 09 28 6d 61 78 20 ;; lly...(max
1eb0: 28 63 61 64 64 72 20 72 31 29 28 63 61 64 64 72 (caddr r1)(caddr
1ec0: 20 72 32 29 29 20 20 20 20 20 20 20 3b 3b 20 75 r2)) ;; u
1ed0: 6c 78 0a 09 09 28 6d 61 78 20 28 63 61 64 64 64 lx...(max (caddd
1ee0: 72 20 72 31 29 28 63 61 64 64 64 72 20 72 32 29 r r1)(cadddr r2)
1ef0: 29 29 29 29 29 20 3b 3b 20 75 6c 79 0a 0a 28 64 ))))) ;; uly..(d
1f00: 65 66 69 6e 65 20 28 76 67 3a 63 6f 6d 70 6f 6e efine (vg:compon
1f10: 65 6e 74 73 2d 67 65 74 2d 65 78 74 65 6e 74 73 ents-get-extents
1f20: 20 64 72 61 77 69 6e 67 20 2e 20 63 6f 6d 70 73 drawing . comps
1f30: 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 63 ). (if (null? c
1f40: 6f 6d 70 73 29 0a 20 20 20 20 20 20 23 66 0a 20 omps). #f.
1f50: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
1f60: 28 68 65 64 20 20 28 63 61 72 20 63 6f 6d 70 73 (hed (car comps
1f70: 29 29 0a 09 09 20 28 74 61 6c 20 20 28 63 64 72 ))... (tal (cdr
1f80: 20 63 6f 6d 70 73 29 29 0a 09 09 20 28 65 78 74 comps))... (ext
1f90: 65 6e 74 73 20 23 66 29 29 0a 09 28 6c 65 74 2a ents #f))..(let*
1fa0: 20 28 28 6f 62 6a 73 20 20 28 76 67 3a 63 6f 6d ((objs (vg:com
1fb0: 70 2d 6f 62 6a 73 20 68 65 64 29 29 0a 09 20 20 p-objs hed))..
1fc0: 20 20 20 20 20 28 6e 65 77 65 78 74 65 6e 74 73 (newextents
1fd0: 20 28 69 66 20 65 78 74 65 6e 74 73 0a 09 09 09 (if extents....
1fe0: 20 20 20 20 20 20 20 28 76 67 3a 67 65 74 2d 65 (vg:get-e
1ff0: 78 74 65 6e 74 73 2d 66 6f 72 2d 74 77 6f 2d 72 xtents-for-two-r
2000: 65 63 74 73 0a 09 09 09 09 65 78 74 65 6e 74 73 ects.....extents
2010: 0a 09 09 09 09 28 76 67 3a 67 65 74 2d 65 78 74 .....(vg:get-ext
2020: 65 6e 74 73 2d 66 6f 72 2d 6f 62 6a 73 20 64 72 ents-for-objs dr
2030: 61 77 69 6e 67 20 6f 62 6a 73 29 29 0a 09 09 09 awing objs))....
2040: 20 20 20 20 20 20 20 28 76 67 3a 67 65 74 2d 65 (vg:get-e
2050: 78 74 65 6e 74 73 2d 66 6f 72 2d 6f 62 6a 73 20 xtents-for-objs
2060: 64 72 61 77 69 6e 67 20 6f 62 6a 73 29 29 29 29 drawing objs))))
2070: 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 .. (if (null? t
2080: 61 6c 29 0a 09 20 20 20 20 20 20 6e 65 77 65 78 al).. newex
2090: 74 65 6e 74 73 0a 09 20 20 20 20 20 20 28 6c 6f tents.. (lo
20a0: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
20b0: 20 74 61 6c 29 20 6e 65 77 65 78 74 65 6e 74 73 tal) newextents
20c0: 29 29 29 29 29 29 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d ================
20f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2110: 0a 3b 3b 20 6c 69 62 72 61 72 69 65 73 0a 3b 3b .;; libraries.;;
2120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2160: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 65 67 69 73 ======..;; regis
2170: 74 65 72 20 6c 69 62 20 77 69 74 68 20 64 72 61 ter lib with dra
2180: 77 69 6e 67 0a 0a 3b 3b 0a 28 64 65 66 69 6e 65 wing..;;.(define
2190: 20 28 76 67 3a 61 64 64 2d 6c 69 62 20 64 72 61 (vg:add-lib dra
21a0: 77 69 6e 67 20 6c 69 62 6e 61 6d 65 20 6c 69 62 wing libname lib
21b0: 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ). (hash-table-
21c0: 73 65 74 21 20 28 76 67 3a 64 72 61 77 69 6e 67 set! (vg:drawing
21d0: 2d 6c 69 62 73 20 64 72 61 77 69 6e 67 29 20 6c -libs drawing) l
21e0: 69 62 6e 61 6d 65 20 6c 69 62 29 29 0a 0a 28 64 ibname lib))..(d
21f0: 65 66 69 6e 65 20 28 76 67 3a 67 65 74 2d 6c 69 efine (vg:get-li
2200: 62 20 64 72 61 77 69 6e 67 20 6c 69 62 6e 61 6d b drawing libnam
2210: 65 29 0a 20 20 28 68 61 73 68 2d 74 61 62 6c 65 e). (hash-table
2220: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 28 76 67 -ref/default (vg
2230: 3a 64 72 61 77 69 6e 67 2d 6c 69 62 73 20 64 72 :drawing-libs dr
2240: 61 77 69 6e 67 29 20 6c 69 62 6e 61 6d 65 20 23 awing) libname #
2250: 66 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 f))..(define (vg
2260: 3a 67 65 74 2f 63 72 65 61 74 65 2d 6c 69 62 20 :get/create-lib
2270: 64 72 61 77 69 6e 67 20 6c 69 62 6e 61 6d 65 29 drawing libname)
2280: 0a 20 20 28 6c 65 74 20 28 28 6c 69 62 20 28 76 . (let ((lib (v
2290: 67 3a 67 65 74 2d 6c 69 62 20 64 72 61 77 69 6e g:get-lib drawin
22a0: 67 20 6c 69 62 6e 61 6d 65 29 29 29 0a 20 20 20 g libname))).
22b0: 20 28 69 66 20 6c 69 62 0a 09 6c 69 62 0a 09 28 (if lib..lib..(
22c0: 6c 65 74 20 28 28 6e 65 77 6c 69 62 20 28 76 67 let ((newlib (vg
22d0: 3a 6c 69 62 2d 6e 65 77 29 29 29 0a 09 20 20 28 :lib-new))).. (
22e0: 76 67 3a 61 64 64 2d 6c 69 62 20 64 72 61 77 69 vg:add-lib drawi
22f0: 6e 67 20 6c 69 62 6e 61 6d 65 20 6e 65 77 6c 69 ng libname newli
2300: 62 29 0a 09 20 20 6e 65 77 6c 69 62 29 29 29 29 b).. newlib))))
2310: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
2320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b 20 6d 61 ==========.;; ma
2360: 70 20 6f 62 6a 65 63 74 73 20 67 69 76 65 6e 20 p objects given
2370: 6f 66 66 73 65 74 2c 20 73 63 61 6c 65 20 61 6e offset, scale an
2380: 64 20 6d 69 72 72 6f 72 2c 20 72 65 73 75 6c 74 d mirror, result
2390: 69 6e 67 20 6f 62 6a 20 69 73 20 64 69 73 70 6c ing obj is displ
23a0: 61 79 65 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d ayed.;;=========
23b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
23e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
23f0: 3b 20 64 69 73 70 61 74 63 68 20 74 68 65 20 64 ; dispatch the d
2400: 72 61 77 69 6e 67 20 6f 66 20 6f 62 6a 20 6f 66 rawing of obj of
2410: 66 20 74 6f 20 74 68 65 20 63 6f 72 72 65 63 74 f to the correct
2420: 20 64 72 61 77 69 6e 67 20 72 6f 75 74 69 6e 65 drawing routine
2430: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 3a .;;.(define (vg:
2440: 6d 61 70 2d 6f 62 6a 20 64 72 61 77 69 6e 67 20 map-obj drawing
2450: 69 6e 73 74 20 6f 62 6a 29 0a 20 20 28 63 61 73 inst obj). (cas
2460: 65 20 28 76 67 3a 6f 62 6a 2d 74 79 70 65 20 6f e (vg:obj-type o
2470: 62 6a 29 0a 20 20 20 20 28 28 6c 29 28 76 67 3a bj). ((l)(vg:
2480: 6d 61 70 2d 6c 69 6e 65 20 20 20 64 72 61 77 69 map-line drawi
2490: 6e 67 20 69 6e 73 74 20 6f 62 6a 29 29 0a 20 20 ng inst obj)).
24a0: 20 20 28 28 72 29 28 76 67 3a 6d 61 70 2d 72 65 ((r)(vg:map-re
24b0: 63 74 20 20 20 64 72 61 77 69 6e 67 20 69 6e 73 ct drawing ins
24c0: 74 20 6f 62 6a 29 29 0a 20 20 20 20 28 28 74 29 t obj)). ((t)
24d0: 28 76 67 3a 6d 61 70 2d 74 65 78 74 20 20 20 64 (vg:map-text d
24e0: 72 61 77 69 6e 67 20 69 6e 73 74 20 6f 62 6a 29 rawing inst obj)
24f0: 29 0a 20 20 20 20 28 28 78 29 28 76 67 3a 6d 61 ). ((x)(vg:ma
2500: 70 2d 78 61 78 69 73 20 20 64 72 61 77 69 6e 67 p-xaxis drawing
2510: 20 69 6e 73 74 20 6f 62 6a 29 29 0a 20 20 20 20 inst obj)).
2520: 28 65 6c 73 65 20 23 66 29 29 29 0a 0a 3b 3b 20 (else #f)))..;;
2530: 67 69 76 65 6e 20 61 20 64 72 61 77 69 6e 67 20 given a drawing
2540: 61 6e 64 20 61 20 69 6e 73 74 20 6d 61 70 20 61 and a inst map a
2550: 20 72 65 63 74 61 6e 67 6c 65 20 74 6f 20 69 74 rectangle to it
2560: 20 73 63 72 65 65 6e 20 63 6f 6f 72 64 69 6e 61 screen coordina
2570: 74 65 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 tes.;;.(define (
2580: 76 67 3a 6d 61 70 2d 72 65 63 74 20 64 72 61 77 vg:map-rect draw
2590: 69 6e 67 20 69 6e 73 74 20 6f 62 6a 29 0a 20 20 ing inst obj).
25a0: 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 (let ((res (make
25b0: 2d 76 67 3a 6f 62 6a 20 74 79 70 65 3a 20 20 20 -vg:obj type:
25c0: 20 20 20 20 27 72 20 3b 3b 20 69 73 20 74 68 65 'r ;; is the
25d0: 72 65 20 61 20 64 65 66 73 74 72 75 63 74 20 63 re a defstruct c
25e0: 6f 70 79 3f 0a 09 09 09 20 20 66 69 6c 6c 2d 63 opy?.... fill-c
25f0: 6f 6c 6f 72 3a 20 28 76 67 3a 6f 62 6a 2d 66 69 olor: (vg:obj-fi
2600: 6c 6c 2d 63 6f 6c 6f 72 20 6f 62 6a 29 0a 09 09 ll-color obj)...
2610: 09 20 20 74 65 78 74 3a 20 20 20 20 20 20 20 28 . text: (
2620: 76 67 3a 6f 62 6a 2d 74 65 78 74 20 20 20 20 20 vg:obj-text
2630: 20 20 6f 62 6a 29 0a 09 09 09 20 20 6c 69 6e 65 obj).... line
2640: 2d 63 6f 6c 6f 72 3a 20 28 76 67 3a 6f 62 6a 2d -color: (vg:obj-
2650: 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f 62 6a 29 0a line-color obj).
2660: 09 09 09 20 20 66 6f 6e 74 3a 20 20 20 20 20 20 ... font:
2670: 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e 74 20 20 20 (vg:obj-font
2680: 20 20 20 20 6f 62 6a 29 29 29 0a 09 28 70 74 73 obj)))..(pts
2690: 20 28 76 67 3a 6f 62 6a 2d 70 74 73 20 6f 62 6a (vg:obj-pts obj
26a0: 29 29 29 0a 20 20 20 20 28 76 67 3a 6f 62 6a 2d ))). (vg:obj-
26b0: 70 74 73 2d 73 65 74 21 20 72 65 73 20 28 76 67 pts-set! res (vg
26c0: 3a 64 72 61 77 69 6e 67 2d 69 6e 73 74 2d 61 70 :drawing-inst-ap
26d0: 70 6c 79 2d 73 63 61 6c 65 2d 6f 66 66 73 65 74 ply-scale-offset
26e0: 20 64 72 61 77 69 6e 67 20 69 6e 73 74 20 70 74 drawing inst pt
26f0: 73 29 29 0a 20 20 20 20 28 76 67 3a 64 72 61 77 s)). (vg:draw
2700: 69 6e 67 2d 63 61 63 68 65 2d 73 65 74 21 20 64 ing-cache-set! d
2710: 72 61 77 69 6e 67 20 28 63 6f 6e 73 20 72 65 73 rawing (cons res
2720: 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 63 61 63 (vg:drawing-cac
2730: 68 65 20 64 72 61 77 69 6e 67 29 20 29 29 0a 20 he drawing) )).
2740: 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 67 69 76 res))..;; giv
2750: 65 6e 20 61 20 64 72 61 77 69 6e 67 20 61 6e 64 en a drawing and
2760: 20 61 20 69 6e 73 74 20 6d 61 70 20 61 20 6c 69 a inst map a li
2770: 6e 65 20 74 6f 20 69 74 20 73 63 72 65 65 6e 20 ne to it screen
2780: 63 6f 6f 72 64 69 6e 61 74 65 73 0a 3b 3b 0a 28 coordinates.;;.(
2790: 64 65 66 69 6e 65 20 28 76 67 3a 6d 61 70 2d 6c define (vg:map-l
27a0: 69 6e 65 20 64 72 61 77 69 6e 67 20 69 6e 73 74 ine drawing inst
27b0: 20 6f 62 6a 29 0a 20 20 28 6c 65 74 20 28 28 72 obj). (let ((r
27c0: 65 73 20 28 6d 61 6b 65 2d 76 67 3a 6f 62 6a 20 es (make-vg:obj
27d0: 74 79 70 65 3a 20 20 20 20 20 20 20 27 6c 20 3b type: 'l ;
27e0: 3b 20 69 73 20 74 68 65 72 65 20 61 20 64 65 66 ; is there a def
27f0: 73 74 72 75 63 74 20 63 6f 70 79 3f 0a 09 09 09 struct copy?....
2800: 20 20 6c 69 6e 65 2d 63 6f 6c 6f 72 3a 20 28 76 line-color: (v
2810: 67 3a 6f 62 6a 2d 6c 69 6e 65 2d 63 6f 6c 6f 72 g:obj-line-color
2820: 20 6f 62 6a 29 0a 09 09 09 20 20 66 6f 6e 74 3a obj).... font:
2830: 20 20 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d 66 (vg:obj-f
2840: 6f 6e 74 20 20 20 20 20 20 20 6f 62 6a 29 29 29 ont obj)))
2850: 0a 09 28 70 74 73 20 28 76 67 3a 6f 62 6a 2d 70 ..(pts (vg:obj-p
2860: 74 73 20 6f 62 6a 29 29 29 0a 20 20 20 20 28 76 ts obj))). (v
2870: 67 3a 6f 62 6a 2d 70 74 73 2d 73 65 74 21 20 72 g:obj-pts-set! r
2880: 65 73 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 69 es (vg:drawing-i
2890: 6e 73 74 2d 61 70 70 6c 79 2d 73 63 61 6c 65 2d nst-apply-scale-
28a0: 6f 66 66 73 65 74 20 64 72 61 77 69 6e 67 20 69 offset drawing i
28b0: 6e 73 74 20 70 74 73 29 29 0a 20 20 20 20 28 76 nst pts)). (v
28c0: 67 3a 64 72 61 77 69 6e 67 2d 63 61 63 68 65 2d g:drawing-cache-
28d0: 73 65 74 21 20 64 72 61 77 69 6e 67 20 28 63 6f set! drawing (co
28e0: 6e 73 20 72 65 73 20 28 76 67 3a 64 72 61 77 69 ns res (vg:drawi
28f0: 6e 67 2d 63 61 63 68 65 20 64 72 61 77 69 6e 67 ng-cache drawing
2900: 29 20 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a ) )). res))..
2910: 3b 3b 20 67 69 76 65 6e 20 61 20 64 72 61 77 69 ;; given a drawi
2920: 6e 67 20 61 6e 64 20 61 20 69 6e 73 74 20 6d 61 ng and a inst ma
2930: 70 20 61 20 74 65 78 74 20 74 6f 20 69 74 20 73 p a text to it s
2940: 63 72 65 65 6e 20 63 6f 6f 72 64 69 6e 61 74 65 creen coordinate
2950: 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 76 67 s.;;.(define (vg
2960: 3a 6d 61 70 2d 74 65 78 74 20 64 72 61 77 69 6e :map-text drawin
2970: 67 20 69 6e 73 74 20 6f 62 6a 29 0a 20 20 28 6c g inst obj). (l
2980: 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 76 et ((res (make-v
2990: 67 3a 6f 62 6a 20 74 79 70 65 3a 20 20 20 20 20 g:obj type:
29a0: 20 20 27 74 0a 09 09 09 20 20 66 69 6c 6c 2d 63 't.... fill-c
29b0: 6f 6c 6f 72 3a 20 28 76 67 3a 6f 62 6a 2d 66 69 olor: (vg:obj-fi
29c0: 6c 6c 2d 63 6f 6c 6f 72 20 6f 62 6a 29 0a 09 09 ll-color obj)...
29d0: 09 20 20 74 65 78 74 3a 20 20 20 20 20 20 20 28 . text: (
29e0: 76 67 3a 6f 62 6a 2d 74 65 78 74 20 20 20 20 20 vg:obj-text
29f0: 20 20 6f 62 6a 29 0a 09 09 09 20 20 6c 69 6e 65 obj).... line
2a00: 2d 63 6f 6c 6f 72 3a 20 28 76 67 3a 6f 62 6a 2d -color: (vg:obj-
2a10: 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f 62 6a 29 0a line-color obj).
2a20: 09 09 09 20 20 66 6f 6e 74 3a 20 20 20 20 20 20 ... font:
2a30: 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e 74 20 20 20 (vg:obj-font
2a40: 20 20 20 20 6f 62 6a 29 0a 09 09 09 20 20 61 6e obj).... an
2a50: 67 6c 65 3a 20 20 20 20 20 20 28 76 67 3a 6f 62 gle: (vg:ob
2a60: 6a 2d 61 6e 67 6c 65 20 20 20 20 20 20 6f 62 6a j-angle obj
2a70: 29 0a 09 09 09 20 20 61 74 74 72 69 62 3a 20 20 ).... attrib:
2a80: 20 20 20 28 76 67 3a 6f 62 6a 2d 61 74 74 72 69 (vg:obj-attri
2a90: 62 20 20 20 20 20 6f 62 6a 29 29 29 0a 09 28 70 b obj)))..(p
2aa0: 74 73 20 28 76 67 3a 6f 62 6a 2d 70 74 73 20 6f ts (vg:obj-pts o
2ab0: 62 6a 29 29 29 0a 20 20 20 20 28 76 67 3a 6f 62 bj))). (vg:ob
2ac0: 6a 2d 70 74 73 2d 73 65 74 21 20 72 65 73 20 28 j-pts-set! res (
2ad0: 76 67 3a 64 72 61 77 69 6e 67 2d 69 6e 73 74 2d vg:drawing-inst-
2ae0: 61 70 70 6c 79 2d 73 63 61 6c 65 2d 6f 66 66 73 apply-scale-offs
2af0: 65 74 20 64 72 61 77 69 6e 67 20 69 6e 73 74 20 et drawing inst
2b00: 70 74 73 29 29 0a 20 20 20 20 28 76 67 3a 64 72 pts)). (vg:dr
2b10: 61 77 69 6e 67 2d 63 61 63 68 65 2d 73 65 74 21 awing-cache-set!
2b20: 20 64 72 61 77 69 6e 67 20 28 63 6f 6e 73 20 72 drawing (cons r
2b30: 65 73 20 28 76 67 3a 64 72 61 77 69 6e 67 2d 63 es (vg:drawing-c
2b40: 61 63 68 65 20 64 72 61 77 69 6e 67 29 29 29 0a ache drawing))).
2b50: 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 67 69 res))..;; gi
2b60: 76 65 6e 20 61 20 64 72 61 77 69 6e 67 20 61 6e ven a drawing an
2b70: 64 20 61 20 69 6e 73 74 20 6d 61 70 20 61 20 6c d a inst map a l
2b80: 69 6e 65 20 74 6f 20 69 74 20 73 63 72 65 65 6e ine to it screen
2b90: 20 63 6f 6f 72 64 69 6e 61 74 65 73 0a 3b 3b 0a coordinates.;;.
2ba0: 28 64 65 66 69 6e 65 20 28 76 67 3a 6d 61 70 2d (define (vg:map-
2bb0: 78 61 78 69 73 20 64 72 61 77 69 6e 67 20 69 6e xaxis drawing in
2bc0: 73 74 20 6f 62 6a 29 0a 20 20 28 6c 65 74 20 28 st obj). (let (
2bd0: 28 72 65 73 20 28 6d 61 6b 65 2d 76 67 3a 6f 62 (res (make-vg:ob
2be0: 6a 20 74 79 70 65 3a 20 20 20 20 20 20 27 78 20 j type: 'x
2bf0: 3b 3b 20 69 73 20 74 68 65 72 65 20 61 20 64 65 ;; is there a de
2c00: 66 73 74 72 75 63 74 20 63 6f 70 79 3f 0a 09 09 fstruct copy?...
2c10: 09 20 20 6c 69 6e 65 2d 63 6f 6c 6f 72 3a 20 28 . line-color: (
2c20: 76 67 3a 6f 62 6a 2d 6c 69 6e 65 2d 63 6f 6c 6f vg:obj-line-colo
2c30: 72 20 6f 62 6a 29 0a 09 09 09 20 20 66 6f 6e 74 r obj).... font
2c40: 3a 20 20 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d : (vg:obj-
2c50: 66 6f 6e 74 20 20 20 20 20 20 20 6f 62 6a 29 29 font obj))
2c60: 29 0a 09 28 70 74 73 20 28 76 67 3a 6f 62 6a 2d )..(pts (vg:obj-
2c70: 70 74 73 20 6f 62 6a 29 29 29 0a 20 20 20 20 28 pts obj))). (
2c80: 76 67 3a 6f 62 6a 2d 70 74 73 2d 73 65 74 21 20 vg:obj-pts-set!
2c90: 72 65 73 20 28 76 67 3a 64 72 61 77 69 6e 67 2d res (vg:drawing-
2ca0: 69 6e 73 74 2d 61 70 70 6c 79 2d 73 63 61 6c 65 inst-apply-scale
2cb0: 2d 6f 66 66 73 65 74 20 64 72 61 77 69 6e 67 20 -offset drawing
2cc0: 69 6e 73 74 20 70 74 73 29 29 0a 20 20 20 20 28 inst pts)). (
2cd0: 76 67 3a 64 72 61 77 69 6e 67 2d 63 61 63 68 65 vg:drawing-cache
2ce0: 2d 73 65 74 21 20 64 72 61 77 69 6e 67 20 28 63 -set! drawing (c
2cf0: 6f 6e 73 20 72 65 73 20 28 76 67 3a 64 72 61 77 ons res (vg:draw
2d00: 69 6e 67 2d 63 61 63 68 65 20 64 72 61 77 69 6e ing-cache drawin
2d10: 67 29 20 29 29 0a 20 20 20 20 72 65 73 29 29 0a g) )). res)).
2d20: 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 69 6e 73 =========.;; ins
2d70: 74 61 6e 63 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d tances.;;=======
2d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2dc0: 0a 28 64 65 66 69 6e 65 20 28 76 67 3a 69 6e 73 .(define (vg:ins
2dd0: 74 61 6e 63 65 73 2d 67 65 74 2d 65 78 74 65 6e tances-get-exten
2de0: 74 73 20 64 72 61 77 69 6e 67 20 2e 20 69 6e 73 ts drawing . ins
2df0: 74 61 6e 63 65 2d 6e 61 6d 65 73 29 0a 20 20 28 tance-names). (
2e00: 6c 65 74 20 28 28 78 74 6e 74 2d 6c 73 74 20 28 let ((xtnt-lst (
2e10: 76 67 3a 64 72 61 77 20 64 72 61 77 69 6e 67 20 vg:draw drawing
2e20: 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e #f))). (if (n
2e30: 75 6c 6c 3f 20 78 74 6e 74 2d 6c 73 74 29 0a 09 ull? xtnt-lst)..
2e40: 23 66 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 #f..(let loop ((
2e50: 65 78 74 65 6e 74 73 20 28 63 61 72 20 78 74 6e extents (car xtn
2e60: 74 2d 6c 73 74 29 29 0a 09 09 20 20 20 28 74 61 t-lst))... (ta
2e70: 6c 20 20 20 20 20 28 63 64 72 20 78 74 6e 74 2d l (cdr xtnt-
2e80: 6c 73 74 29 29 0a 09 09 20 20 20 28 6c 6c 78 20 lst))... (llx
2e90: 20 20 20 20 23 66 29 0a 09 09 20 20 20 28 6c 6c #f)... (ll
2ea0: 79 20 20 20 20 20 23 66 29 0a 09 09 20 20 20 28 y #f)... (
2eb0: 75 6c 78 20 20 20 20 20 23 66 29 0a 09 09 20 20 ulx #f)...
2ec0: 20 28 75 6c 79 20 20 20 20 20 23 66 29 29 0a 09 (uly #f))..
2ed0: 20 20 28 6c 65 74 20 28 28 6e 6c 6c 78 20 20 20 (let ((nllx
2ee0: 20 20 20 28 69 66 20 6c 6c 78 20 28 6d 69 6e 20 (if llx (min
2ef0: 6c 6c 78 20 28 6c 69 73 74 2d 72 65 66 20 65 78 llx (list-ref ex
2f00: 74 65 6e 74 73 20 30 29 29 28 6c 69 73 74 2d 72 tents 0))(list-r
2f10: 65 66 20 65 78 74 65 6e 74 73 20 30 29 29 29 0a ef extents 0))).
2f20: 09 09 28 6e 6c 6c 79 20 20 20 20 20 20 28 69 66 ..(nlly (if
2f30: 20 6c 6c 79 20 28 6d 69 6e 20 6c 6c 79 20 28 6c lly (min lly (l
2f40: 69 73 74 2d 72 65 66 20 65 78 74 65 6e 74 73 20 ist-ref extents
2f50: 31 29 29 28 6c 69 73 74 2d 72 65 66 20 65 78 74 1))(list-ref ext
2f60: 65 6e 74 73 20 31 29 29 29 0a 09 09 28 6e 75 6c ents 1)))...(nul
2f70: 78 20 20 20 20 20 20 28 69 66 20 75 6c 78 20 28 x (if ulx (
2f80: 6d 61 78 20 75 6c 78 20 28 6c 69 73 74 2d 72 65 max ulx (list-re
2f90: 66 20 65 78 74 65 6e 74 73 20 32 29 29 28 6c 69 f extents 2))(li
2fa0: 73 74 2d 72 65 66 20 65 78 74 65 6e 74 73 20 32 st-ref extents 2
2fb0: 29 29 29 0a 09 09 28 6e 75 6c 79 20 20 20 20 20 )))...(nuly
2fc0: 20 28 69 66 20 75 6c 79 20 28 6d 61 78 20 75 6c (if uly (max ul
2fd0: 79 20 28 6c 69 73 74 2d 72 65 66 20 65 78 74 65 y (list-ref exte
2fe0: 6e 74 73 20 33 29 29 28 6c 69 73 74 2d 72 65 66 nts 3))(list-ref
2ff0: 20 65 78 74 65 6e 74 73 20 33 29 29 29 29 0a 09 extents 3))))..
3000: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
3010: 61 6c 29 0a 09 09 28 6c 69 73 74 20 6c 6c 78 20 al)...(list llx
3020: 6c 6c 79 20 75 6c 78 20 75 6c 79 29 0a 09 09 28 lly ulx uly)...(
3030: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
3040: 64 72 20 74 61 6c 29 20 6e 6c 6c 78 20 6e 6c 6c dr tal) nllx nll
3050: 79 20 6e 75 6c 78 20 6e 75 6c 79 29 29 29 29 29 y nulx nuly)))))
3060: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 76 67 3a ))..(define (vg:
3070: 6c 69 62 2d 67 65 74 2d 63 6f 6d 70 6f 6e 65 6e lib-get-componen
3080: 74 20 6c 69 62 20 69 6e 73 74 6e 61 6d 65 29 0a t lib instname).
3090: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
30a0: 66 2f 64 65 66 61 75 6c 74 20 20 28 76 67 3a 6c f/default (vg:l
30b0: 69 62 2d 63 6f 6d 70 73 20 6c 69 62 29 20 69 6e ib-comps lib) in
30c0: 73 74 6e 61 6d 65 20 23 66 29 29 0a 0a 3b 3b 3d stname #f))..;;=
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 3d 3d 3d 3d 3d ================
30f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3110: 3d 3d 3d 3d 3d 0a 3b 3b 20 63 6f 6c 6f 72 0a 3b =====.;; color.;
3120: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
3130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3160: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
3170: 20 28 76 67 3a 72 67 62 2d 3e 6e 75 6d 62 65 72 (vg:rgb->number
3180: 20 72 20 67 20 62 20 23 21 6b 65 79 20 28 61 20 r g b #!key (a
3190: 30 29 29 0a 20 20 28 62 69 74 77 69 73 65 2d 69 0)). (bitwise-i
31a0: 6f 72 0a 20 20 20 20 28 61 72 69 74 68 6d 65 74 or. (arithmet
31b0: 69 63 2d 73 68 69 66 74 20 61 20 32 34 29 0a 20 ic-shift a 24).
31c0: 20 20 20 28 61 72 69 74 68 6d 65 74 69 63 2d 73 (arithmetic-s
31d0: 68 69 66 74 20 72 20 31 36 29 0a 20 20 20 20 28 hift r 16). (
31e0: 61 72 69 74 68 6d 65 74 69 63 2d 73 68 69 66 74 arithmetic-shift
31f0: 20 67 20 38 29 0a 20 20 20 20 62 29 29 0a 0a 3b g 8). b))..;
3200: 3b 20 4f 62 73 6f 6c 65 74 65 20 66 75 6e 63 74 ; Obsolete funct
3210: 69 6f 6e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 ion.;;.(define (
3220: 76 67 3a 67 65 6e 65 72 61 74 65 2d 63 6f 6c 6f vg:generate-colo
3230: 72 29 0a 20 20 28 76 67 3a 72 67 62 2d 3e 6e 75 r). (vg:rgb->nu
3240: 6d 62 65 72 20 28 72 61 6e 64 6f 6d 20 32 35 35 mber (random 255
3250: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3260: 20 20 20 20 28 72 61 6e 64 6f 6d 20 32 35 35 29 (random 255)
3270: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3280: 20 20 20 28 72 61 6e 64 6f 6d 20 32 35 35 29 29 (random 255))
3290: 29 0a 0a 3b 3b 20 4e 65 65 64 20 74 6f 20 72 65 )..;; Need to re
32a0: 74 75 72 6e 20 61 20 73 74 72 69 6e 67 20 6f 66 turn a string of
32b0: 20 72 61 6e 64 6f 6d 20 69 75 70 2d 63 6f 6c 6f random iup-colo
32c0: 72 20 66 6f 72 20 67 72 61 70 68 0a 3b 3b 0a 28 r for graph.;;.(
32d0: 64 65 66 69 6e 65 20 28 76 67 3a 67 65 6e 65 72 define (vg:gener
32e0: 61 74 65 2d 63 6f 6c 6f 72 2d 72 67 62 29 0a 20 ate-color-rgb).
32f0: 20 28 63 6f 6e 63 20 28 6e 75 6d 62 65 72 2d 3e (conc (number->
3300: 73 74 72 69 6e 67 20 28 72 61 6e 64 6f 6d 20 32 string (random 2
3310: 35 35 29 29 20 22 20 22 0a 20 20 20 20 20 20 20 55)) " ".
3320: 20 28 6e 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 (number->string
3330: 20 28 72 61 6e 64 6f 6d 20 32 35 35 29 29 20 22 (random 255)) "
3340: 20 22 0a 20 20 20 20 20 20 20 20 28 6e 75 6d 62 ". (numb
3350: 65 72 2d 3e 73 74 72 69 6e 67 20 28 72 61 6e 64 er->string (rand
3360: 6f 6d 20 32 35 35 29 29 29 29 0a 0a 28 64 65 66 om 255))))..(def
3370: 69 6e 65 20 28 76 67 3a 69 75 70 2d 63 6f 6c 6f ine (vg:iup-colo
3380: 72 2d 3e 6e 75 6d 62 65 72 20 69 75 70 2d 63 6f r->number iup-co
3390: 6c 6f 72 29 0a 20 20 28 61 70 70 6c 79 20 76 67 lor). (apply vg
33a0: 3a 72 67 62 2d 3e 6e 75 6d 62 65 72 20 28 6d 61 :rgb->number (ma
33b0: 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 p string->number
33c0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 69 (string-split i
33d0: 75 70 2d 63 6f 6c 6f 72 29 29 29 29 0a 0a 3b 3b up-color))))..;;
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 3d ================
3400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3420: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 67 72 61 70 68 69 ======.;; graphi
3430: 6e 67 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ng.;;===========
3440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
3480: 66 69 6e 65 20 28 76 67 3a 6d 61 6b 65 2d 78 61 fine (vg:make-xa
3490: 78 69 73 20 64 72 61 77 69 6e 67 20 63 6f 6d 70 xis drawing comp
34a0: 6f 6e 65 6e 74 20 78 31 20 79 31 20 78 32 20 79 onent x1 y1 x2 y
34b0: 32 20 73 74 61 72 74 6e 75 6d 20 65 6e 64 6e 75 2 startnum endnu
34c0: 6d 20 73 63 61 6c 65 70 72 6f 63 29 0a 20 20 28 m scaleproc). (
34d0: 6c 65 74 20 28 28 6f 62 6a 20 28 76 67 3a 6d 61 let ((obj (vg:ma
34e0: 6b 65 2d 78 61 78 69 73 2d 6f 62 6a 20 78 31 20 ke-xaxis-obj x1
34f0: 79 31 20 78 32 20 79 32 29 29 29 0a 20 20 20 20 y1 x2 y2))).
3500: 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d #f))..;;========
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 3d 3d 3d 3d 3d ================
3540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
3550: 3b 20 55 6e 72 61 76 65 6c 20 61 6e 64 20 64 72 ; Unravel and dr
3560: 61 77 20 74 68 65 20 6f 62 6a 65 63 74 73 0a 3b aw the objects.;
3570: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
3580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35b0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 77 69 74 68 =======..;; with
35c0: 20 67 65 74 2d 65 78 74 65 6e 74 73 20 3d 20 23 get-extents = #
35d0: 74 20 72 65 74 75 72 6e 20 74 68 65 20 65 78 74 t return the ext
35e0: 65 6e 74 73 0a 3b 3b 20 77 69 74 68 20 64 72 61 ents.;; with dra
35f0: 77 20 3d 20 23 66 20 64 6f 6e 27 74 20 61 63 74 w = #f don't act
3600: 75 61 6c 6c 79 20 64 72 61 77 20 74 68 65 20 6f ually draw the o
3610: 62 6a 65 63 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 bject.;;.(define
3620: 20 28 76 67 3a 64 72 61 77 2d 6f 62 6a 20 64 72 (vg:draw-obj dr
3630: 61 77 69 6e 67 20 6f 62 6a 20 23 21 6b 65 79 20 awing obj #!key
3640: 28 64 72 61 77 20 23 74 29 29 0a 20 20 3b 3b 20 (draw #t)). ;;
3650: 28 70 72 69 6e 74 20 22 6f 62 6a 20 74 79 70 65 (print "obj type
3660: 3a 20 22 20 28 76 67 3a 6f 62 6a 2d 74 79 70 65 : " (vg:obj-type
3670: 20 6f 62 6a 29 29 0a 20 20 28 63 61 73 65 20 28 obj)). (case (
3680: 76 67 3a 6f 62 6a 2d 74 79 70 65 20 6f 62 6a 29 vg:obj-type obj)
3690: 0a 20 20 20 20 28 28 6c 29 28 76 67 3a 64 72 61 . ((l)(vg:dra
36a0: 77 2d 6c 69 6e 65 20 64 72 61 77 69 6e 67 20 6f w-line drawing o
36b0: 62 6a 20 64 72 61 77 3a 20 64 72 61 77 29 29 0a bj draw: draw)).
36c0: 20 20 20 20 28 28 72 29 28 76 67 3a 64 72 61 77 ((r)(vg:draw
36d0: 2d 72 65 63 74 20 64 72 61 77 69 6e 67 20 6f 62 -rect drawing ob
36e0: 6a 20 64 72 61 77 3a 20 64 72 61 77 29 29 0a 20 j draw: draw)).
36f0: 20 20 20 28 28 74 29 28 76 67 3a 64 72 61 77 2d ((t)(vg:draw-
3700: 74 65 78 74 20 64 72 61 77 69 6e 67 20 6f 62 6a text drawing obj
3710: 20 64 72 61 77 3a 20 64 72 61 77 29 29 29 29 0a draw: draw)))).
3720: 0a 3b 3b 20 67 69 76 65 6e 20 61 20 72 65 63 74 .;; given a rect
3730: 20 6f 62 6a 20 64 72 61 77 20 69 74 20 6f 6e 20 obj draw it on
3740: 74 68 65 20 63 61 6e 76 61 73 20 61 70 70 6c 79 the canvas apply
3750: 69 6e 67 20 66 69 72 73 74 20 74 68 65 20 64 72 ing first the dr
3760: 61 77 69 6e 67 0a 3b 3b 20 73 63 61 6c 65 20 61 awing.;; scale a
3770: 6e 64 20 6f 66 66 73 65 74 0a 3b 3b 0a 28 64 65 nd offset.;;.(de
3780: 66 69 6e 65 20 28 76 67 3a 64 72 61 77 2d 72 65 fine (vg:draw-re
3790: 63 74 20 64 72 61 77 69 6e 67 20 6f 62 6a 20 23 ct drawing obj #
37a0: 21 6b 65 79 20 28 64 72 61 77 20 23 74 29 29 0a !key (draw #t)).
37b0: 20 20 28 6c 65 74 2a 20 28 28 63 6e 76 20 28 76 (let* ((cnv (v
37c0: 67 3a 64 72 61 77 69 6e 67 2d 63 6e 76 20 64 72 g:drawing-cnv dr
37d0: 61 77 69 6e 67 29 29 0a 09 20 28 70 74 73 20 28 awing)).. (pts (
37e0: 76 67 3a 64 72 61 77 69 6e 67 2d 61 70 70 6c 79 vg:drawing-apply
37f0: 2d 73 63 61 6c 65 20 64 72 61 77 69 6e 67 20 28 -scale drawing (
3800: 76 67 3a 6f 62 6a 2d 70 74 73 20 6f 62 6a 29 29 vg:obj-pts obj))
3810: 29 0a 09 20 28 66 69 6c 6c 2d 63 6f 6c 6f 72 20 ).. (fill-color
3820: 28 76 67 3a 6f 62 6a 2d 66 69 6c 6c 2d 63 6f 6c (vg:obj-fill-col
3830: 6f 72 20 6f 62 6a 29 29 0a 09 20 28 6c 69 6e 65 or obj)).. (line
3840: 2d 63 6f 6c 6f 72 20 28 76 67 3a 6f 62 6a 2d 6c -color (vg:obj-l
3850: 69 6e 65 2d 63 6f 6c 6f 72 20 6f 62 6a 29 29 0a ine-color obj)).
3860: 09 20 28 74 65 78 74 20 20 20 20 20 20 20 28 76 . (text (v
3870: 67 3a 6f 62 6a 2d 74 65 78 74 20 6f 62 6a 29 29 g:obj-text obj))
3880: 0a 09 20 28 66 6f 6e 74 20 20 20 20 20 20 20 28 .. (font (
3890: 76 67 3a 6f 62 6a 2d 66 6f 6e 74 20 6f 62 6a 29 vg:obj-font obj)
38a0: 29 0a 09 20 28 6c 6c 78 20 20 20 20 20 20 20 20 ).. (llx
38b0: 28 63 61 72 20 70 74 73 29 29 0a 09 20 28 6c 6c (car pts)).. (ll
38c0: 79 20 20 20 20 20 20 20 20 28 63 61 64 72 20 70 y (cadr p
38d0: 74 73 29 29 0a 09 20 28 75 6c 78 20 20 20 20 20 ts)).. (ulx
38e0: 20 20 20 28 63 61 64 64 72 20 70 74 73 29 29 0a (caddr pts)).
38f0: 09 20 28 75 6c 79 20 20 20 20 20 20 20 20 28 63 . (uly (c
3900: 61 64 64 64 72 20 70 74 73 29 29 0a 09 20 28 77 adddr pts)).. (w
3910: 20 20 20 20 20 20 20 20 20 20 28 2d 20 75 6c 78 (- ulx
3920: 20 6c 6c 78 29 29 0a 09 20 28 68 20 20 20 20 20 llx)).. (h
3930: 20 20 20 20 20 28 2d 20 75 6c 79 20 6c 6c 79 29 (- uly lly)
3940: 29 0a 09 20 28 74 65 78 74 2d 78 6d 61 78 20 20 ).. (text-xmax
3950: 23 66 29 0a 09 20 28 74 65 78 74 2d 79 6d 61 78 #f).. (text-ymax
3960: 20 20 23 66 29 29 0a 20 20 20 20 28 69 66 20 64 #f)). (if d
3970: 72 61 77 20 0a 09 28 6c 65 74 20 28 28 70 72 65 raw ..(let ((pre
3980: 76 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 63 6f 6c v-background-col
3990: 6f 72 20 28 63 61 6e 76 61 73 2d 62 61 63 6b 67 or (canvas-backg
39a0: 72 6f 75 6e 64 20 63 6e 76 29 29 0a 09 20 20 20 round cnv))..
39b0: 20 20 20 28 70 72 65 76 2d 66 6f 72 65 67 72 6f (prev-foregro
39c0: 75 6e 64 2d 63 6f 6c 6f 72 20 28 63 61 6e 76 61 und-color (canva
39d0: 73 2d 66 6f 72 65 67 72 6f 75 6e 64 20 63 6e 76 s-foreground cnv
39e0: 29 29 29 0a 09 20 20 28 69 66 20 66 69 6c 6c 2d ))).. (if fill-
39f0: 63 6f 6c 6f 72 0a 09 20 20 20 20 20 20 28 62 65 color.. (be
3a00: 67 69 6e 0a 09 09 28 63 61 6e 76 61 73 2d 66 6f gin...(canvas-fo
3a10: 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 20 63 6e reground-set! cn
3a20: 76 20 66 69 6c 6c 2d 63 6f 6c 6f 72 29 0a 09 09 v fill-color)...
3a30: 28 63 61 6e 76 61 73 2d 62 6f 78 21 20 63 6e 76 (canvas-box! cnv
3a40: 20 6c 6c 78 20 75 6c 78 20 6c 6c 79 20 75 6c 79 llx ulx lly uly
3a50: 29 29 29 20 3b 3b 20 64 6f 63 73 20 61 72 65 20 ))) ;; docs are
3a60: 61 6c 6c 20 6f 76 65 72 20 74 68 65 20 70 6c 61 all over the pla
3a70: 63 65 20 6f 6e 20 74 68 69 73 20 6f 6e 65 2e 3b ce on this one.;
3a80: 3b 20 77 20 68 29 0a 09 20 20 28 69 66 20 6c 69 ; w h).. (if li
3a90: 6e 65 2d 63 6f 6c 6f 72 0a 09 20 20 20 20 20 20 ne-color..
3aa0: 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 (canvas-foregrou
3ab0: 6e 64 2d 73 65 74 21 20 63 6e 76 20 6c 69 6e 65 nd-set! cnv line
3ac0: 2d 63 6f 6c 6f 72 29 0a 09 20 20 20 20 20 20 28 -color).. (
3ad0: 69 66 20 66 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 09 if fill-color...
3ae0: 20 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 (canvas-foregr
3af0: 6f 75 6e 64 2d 73 65 74 21 20 63 6e 76 20 70 72 ound-set! cnv pr
3b00: 65 76 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 63 6f ev-foreground-co
3b10: 6c 6f 72 29 29 29 0a 09 20 20 28 63 61 6e 76 61 lor))).. (canva
3b20: 73 2d 72 65 63 74 61 6e 67 6c 65 21 20 63 6e 76 s-rectangle! cnv
3b30: 20 6c 6c 78 20 75 6c 78 20 6c 6c 79 20 75 6c 79 llx ulx lly uly
3b40: 29 0a 09 20 20 28 63 61 6e 76 61 73 2d 66 6f 72 ).. (canvas-for
3b50: 65 67 72 6f 75 6e 64 2d 73 65 74 21 20 63 6e 76 eground-set! cnv
3b60: 20 70 72 65 76 2d 66 6f 72 65 67 72 6f 75 6e 64 prev-foreground
3b70: 2d 63 6f 6c 6f 72 29 0a 09 20 20 28 69 66 20 74 -color).. (if t
3b80: 65 78 74 20 0a 09 20 20 20 20 20 20 28 6c 65 74 ext .. (let
3b90: 2a 20 28 28 70 72 65 76 2d 66 6f 6e 74 20 20 20 * ((prev-font
3ba0: 20 28 63 61 6e 76 61 73 2d 66 6f 6e 74 20 63 6e (canvas-font cn
3bb0: 76 29 29 0a 09 09 20 20 20 20 20 28 66 6f 6e 74 v))... (font
3bc0: 2d 63 68 61 6e 67 65 64 20 28 61 6e 64 20 66 6f -changed (and fo
3bd0: 6e 74 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 nt (not (equal?
3be0: 66 6f 6e 74 20 70 72 65 76 2d 66 6f 6e 74 29 29 font prev-font))
3bf0: 29 29 29 0a 09 09 28 69 66 20 66 6f 6e 74 2d 63 )))...(if font-c
3c00: 68 61 6e 67 65 64 20 28 63 61 6e 76 61 73 2d 66 hanged (canvas-f
3c10: 6f 6e 74 2d 73 65 74 21 20 63 6e 76 20 66 6f 6e ont-set! cnv fon
3c20: 74 29 29 0a 09 09 28 63 61 6e 76 61 73 2d 74 65 t))...(canvas-te
3c30: 78 74 21 20 63 6e 76 20 28 2b 20 32 20 6c 6c 78 xt! cnv (+ 2 llx
3c40: 29 28 2b 20 32 20 6c 6c 79 29 20 74 65 78 74 29 )(+ 2 lly) text)
3c50: 0a 09 09 28 69 66 20 28 65 71 3f 20 64 72 61 77 ...(if (eq? draw
3c60: 20 27 67 65 74 2d 65 78 74 65 6e 74 73 29 0a 09 'get-extents)..
3c70: 09 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 . (let-values
3c80: 20 28 28 28 78 6d 61 78 20 79 6d 61 78 29 28 63 (((xmax ymax)(c
3c90: 61 6e 76 61 73 2d 74 65 78 74 2d 73 69 7a 65 20 anvas-text-size
3ca0: 63 6e 76 20 74 65 78 74 29 29 29 0a 09 09 09 09 cnv text))).....
3cb0: 28 73 65 74 21 20 74 65 78 74 2d 78 6d 61 78 20 (set! text-xmax
3cc0: 78 6d 61 78 29 28 73 65 74 21 20 74 65 78 74 2d xmax)(set! text-
3cd0: 79 6d 61 78 20 79 6d 61 78 29 29 29 0a 09 09 28 ymax ymax)))...(
3ce0: 69 66 20 66 6f 6e 74 2d 63 68 61 6e 67 65 64 20 if font-changed
3cf0: 28 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 74 (canvas-font-set
3d00: 21 20 63 6e 76 20 70 72 65 76 2d 66 6f 6e 74 29 ! cnv prev-font)
3d10: 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 ))))). ;; (pr
3d20: 69 6e 74 20 22 74 65 78 74 2d 78 6d 61 78 3a 20 int "text-xmax:
3d30: 22 20 74 65 78 74 2d 78 6d 61 78 20 22 20 74 65 " text-xmax " te
3d40: 78 74 2d 79 6d 61 78 3a 20 22 20 74 65 78 74 2d xt-ymax: " text-
3d50: 79 6d 61 78 29 0a 20 20 20 20 28 69 66 20 28 76 ymax). (if (v
3d60: 67 3a 6f 62 6a 2d 65 78 74 65 6e 74 73 20 6f 62 g:obj-extents ob
3d70: 6a 29 0a 09 28 76 67 3a 6f 62 6a 2d 65 78 74 65 j)..(vg:obj-exte
3d80: 6e 74 73 20 6f 62 6a 29 0a 09 28 69 66 20 28 6e nts obj)..(if (n
3d90: 6f 74 20 74 65 78 74 29 0a 09 20 20 20 20 70 74 ot text).. pt
3da0: 73 20 3b 3b 20 6e 6f 20 74 65 78 74 0a 09 20 20 s ;; no text..
3db0: 20 20 28 69 66 20 28 61 6e 64 20 74 65 78 74 2d (if (and text-
3dc0: 78 6d 61 78 20 74 65 78 74 2d 79 6d 61 78 29 20 xmax text-ymax)
3dd0: 3b 3b 20 68 61 76 65 20 74 65 78 74 0a 09 09 28 ;; have text...(
3de0: 6c 65 74 20 28 28 78 74 20 28 6c 69 73 74 20 6c let ((xt (list l
3df0: 6c 78 20 6c 6c 79 0a 09 09 09 09 28 6d 61 78 20 lx lly.....(max
3e00: 75 6c 78 20 28 2b 20 6c 6c 78 20 74 65 78 74 2d ulx (+ llx text-
3e10: 78 6d 61 78 29 29 0a 09 09 09 09 28 6d 61 78 20 xmax)).....(max
3e20: 75 6c 79 20 28 2b 20 6c 6c 79 20 74 65 78 74 2d uly (+ lly text-
3e30: 79 6d 61 78 29 29 29 29 29 0a 09 09 20 20 28 76 ymax)))))... (v
3e40: 67 3a 6f 62 6a 2d 65 78 74 65 6e 74 73 2d 73 65 g:obj-extents-se
3e50: 74 21 20 6f 62 6a 20 78 74 29 0a 09 09 20 20 78 t! obj xt)... x
3e60: 74 29 0a 09 09 28 69 66 20 63 6e 76 0a 09 09 20 t)...(if cnv...
3e70: 20 20 20 28 69 66 20 28 65 71 3f 20 64 72 61 77 (if (eq? draw
3e80: 20 27 67 65 74 2d 65 78 74 65 6e 74 73 29 0a 09 'get-extents)..
3e90: 09 09 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 ..(let-values ((
3ea0: 28 78 6d 61 78 20 79 6d 61 78 29 28 63 61 6e 76 (xmax ymax)(canv
3eb0: 61 73 2d 74 65 78 74 2d 73 69 7a 65 20 63 6e 76 as-text-size cnv
3ec0: 20 74 65 78 74 29 29 29 0a 09 09 09 09 20 20 20 text))).....
3ed0: 20 28 6c 65 74 20 28 28 78 74 20 28 6c 69 73 74 (let ((xt (list
3ee0: 20 6c 6c 78 20 6c 6c 79 0a 09 09 09 09 09 09 20 llx lly.......
3ef0: 20 20 20 28 6d 61 78 20 75 6c 78 20 28 2b 20 6c (max ulx (+ l
3f00: 6c 78 20 78 6d 61 78 29 29 0a 09 09 09 09 09 09 lx xmax)).......
3f10: 20 20 20 20 28 6d 61 78 20 75 6c 79 20 28 2b 20 (max uly (+
3f20: 6c 6c 79 20 79 6d 61 78 29 29 29 29 29 0a 09 09 lly ymax)))))...
3f30: 09 09 20 20 20 20 20 20 28 76 67 3a 6f 62 6a 2d .. (vg:obj-
3f40: 65 78 74 65 6e 74 73 2d 73 65 74 21 20 6f 62 6a extents-set! obj
3f50: 20 78 74 29 0a 09 09 09 09 20 20 20 20 20 20 78 xt)..... x
3f60: 74 29 29 0a 09 09 09 70 74 73 29 0a 09 09 20 20 t))....pts)...
3f70: 20 20 70 74 73 29 29 29 29 29 29 20 3b 3b 20 72 pts)))))) ;; r
3f80: 65 74 75 72 6e 20 65 78 74 65 6e 74 73 20 0a 0a eturn extents ..
3f90: 3b 3b 20 67 69 76 65 6e 20 61 20 72 65 63 74 20 ;; given a rect
3fa0: 6f 62 6a 20 64 72 61 77 20 69 74 20 6f 6e 20 74 obj draw it on t
3fb0: 68 65 20 63 61 6e 76 61 73 20 61 70 70 6c 79 69 he canvas applyi
3fc0: 6e 67 20 66 69 72 73 74 20 74 68 65 20 64 72 61 ng first the dra
3fd0: 77 69 6e 67 0a 3b 3b 20 73 63 61 6c 65 20 61 6e wing.;; scale an
3fe0: 64 20 6f 66 66 73 65 74 0a 3b 3b 0a 28 64 65 66 d offset.;;.(def
3ff0: 69 6e 65 20 28 76 67 3a 64 72 61 77 2d 6c 69 6e ine (vg:draw-lin
4000: 65 20 64 72 61 77 69 6e 67 20 6f 62 6a 20 23 21 e drawing obj #!
4010: 6b 65 79 20 28 64 72 61 77 20 23 74 29 29 0a 20 key (draw #t)).
4020: 20 28 6c 65 74 2a 20 28 28 63 6e 76 20 28 76 67 (let* ((cnv (vg
4030: 3a 64 72 61 77 69 6e 67 2d 63 6e 76 20 64 72 61 :drawing-cnv dra
4040: 77 69 6e 67 29 29 0a 09 20 28 70 74 73 20 28 76 wing)).. (pts (v
4050: 67 3a 64 72 61 77 69 6e 67 2d 61 70 70 6c 79 2d g:drawing-apply-
4060: 73 63 61 6c 65 20 64 72 61 77 69 6e 67 20 28 76 scale drawing (v
4070: 67 3a 6f 62 6a 2d 70 74 73 20 6f 62 6a 29 29 29 g:obj-pts obj)))
4080: 0a 09 20 3b 3b 20 28 66 69 6c 6c 2d 63 6f 6c 6f .. ;; (fill-colo
4090: 72 20 28 76 67 3a 6f 62 6a 2d 66 69 6c 6c 2d 63 r (vg:obj-fill-c
40a0: 6f 6c 6f 72 20 6f 62 6a 29 29 0a 09 20 28 6c 69 olor obj)).. (li
40b0: 6e 65 2d 63 6f 6c 6f 72 20 28 76 67 3a 6f 62 6a ne-color (vg:obj
40c0: 2d 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f 62 6a 29 -line-color obj)
40d0: 29 0a 09 20 28 74 65 78 74 20 20 20 20 20 20 20 ).. (text
40e0: 28 76 67 3a 6f 62 6a 2d 74 65 78 74 20 6f 62 6a (vg:obj-text obj
40f0: 29 29 0a 09 20 28 66 6f 6e 74 20 20 20 20 20 20 )).. (font
4100: 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e 74 20 6f 62 (vg:obj-font ob
4110: 6a 29 29 0a 09 20 28 6c 6c 78 20 20 20 20 20 20 j)).. (llx
4120: 20 20 28 63 61 72 20 70 74 73 29 29 0a 09 20 28 (car pts)).. (
4130: 6c 6c 79 20 20 20 20 20 20 20 20 28 63 61 64 72 lly (cadr
4140: 20 70 74 73 29 29 0a 09 20 28 75 6c 78 20 20 20 pts)).. (ulx
4150: 20 20 20 20 20 28 63 61 64 64 72 20 70 74 73 29 (caddr pts)
4160: 29 0a 09 20 28 75 6c 79 20 20 20 20 20 20 20 20 ).. (uly
4170: 28 63 61 64 64 64 72 20 70 74 73 29 29 0a 09 20 (cadddr pts))..
4180: 28 77 20 20 20 20 20 20 20 20 20 20 28 2d 20 75 (w (- u
4190: 6c 78 20 6c 6c 78 29 29 0a 09 20 28 68 20 20 20 lx llx)).. (h
41a0: 20 20 20 20 20 20 20 28 2d 20 75 6c 79 20 6c 6c (- uly ll
41b0: 79 29 29 0a 09 20 28 74 65 78 74 2d 78 6d 61 78 y)).. (text-xmax
41c0: 20 20 23 66 29 0a 09 20 28 74 65 78 74 2d 79 6d #f).. (text-ym
41d0: 61 78 20 20 23 66 29 29 0a 20 20 20 20 28 69 66 ax #f)). (if
41e0: 20 64 72 61 77 20 0a 09 28 6c 65 74 20 28 28 70 draw ..(let ((p
41f0: 72 65 76 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 63 rev-background-c
4200: 6f 6c 6f 72 20 28 63 61 6e 76 61 73 2d 62 61 63 olor (canvas-bac
4210: 6b 67 72 6f 75 6e 64 20 63 6e 76 29 29 0a 09 20 kground cnv))..
4220: 20 20 20 20 20 28 70 72 65 76 2d 66 6f 72 65 67 (prev-foreg
4230: 72 6f 75 6e 64 2d 63 6f 6c 6f 72 20 28 63 61 6e round-color (can
4240: 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 20 63 vas-foreground c
4250: 6e 76 29 29 29 0a 09 3b 3b 20 28 69 66 20 66 69 nv)))..;; (if fi
4260: 6c 6c 2d 63 6f 6c 6f 72 0a 09 3b 3b 20 20 20 20 ll-color..;;
4270: 20 28 62 65 67 69 6e 0a 09 3b 3b 20 09 28 63 61 (begin..;; .(ca
4280: 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 2d nvas-foreground-
4290: 73 65 74 21 20 63 6e 76 20 66 69 6c 6c 2d 63 6f set! cnv fill-co
42a0: 6c 6f 72 29 0a 09 3b 3b 20 09 28 63 61 6e 76 61 lor)..;; .(canva
42b0: 73 2d 62 6f 78 21 20 63 6e 76 20 6c 6c 78 20 75 s-box! cnv llx u
42c0: 6c 78 20 6c 6c 79 20 75 6c 79 29 29 29 20 3b 3b lx lly uly))) ;;
42d0: 20 64 6f 63 73 20 61 72 65 20 61 6c 6c 20 6f 76 docs are all ov
42e0: 65 72 20 74 68 65 20 70 6c 61 63 65 20 6f 6e 20 er the place on
42f0: 74 68 69 73 20 6f 6e 65 2e 3b 3b 20 77 20 68 29 this one.;; w h)
4300: 0a 09 20 20 28 69 66 20 6c 69 6e 65 2d 63 6f 6c .. (if line-col
4310: 6f 72 0a 09 20 20 20 20 20 20 28 63 61 6e 76 61 or.. (canva
4320: 73 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 s-foreground-set
4330: 21 20 63 6e 76 20 6c 69 6e 65 2d 63 6f 6c 6f 72 ! cnv line-color
4340: 29 29 0a 09 20 20 20 20 20 3b 3b 20 28 69 66 20 )).. ;; (if
4350: 66 69 6c 6c 2d 63 6f 6c 6f 72 0a 09 20 20 20 20 fill-color..
4360: 20 3b 3b 20 20 28 63 61 6e 76 61 73 2d 66 6f 72 ;; (canvas-for
4370: 65 67 72 6f 75 6e 64 2d 73 65 74 21 20 63 6e 76 eground-set! cnv
4380: 20 70 72 65 76 2d 66 6f 72 65 67 72 6f 75 6e 64 prev-foreground
4390: 2d 63 6f 6c 6f 72 29 29 29 0a 09 20 20 28 63 61 -color))).. (ca
43a0: 6e 76 61 73 2d 6c 69 6e 65 21 20 63 6e 76 20 6c nvas-line! cnv l
43b0: 6c 78 20 6c 6c 79 20 75 6c 78 20 75 6c 79 29 0a lx lly ulx uly).
43c0: 09 20 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 . (canvas-foreg
43d0: 72 6f 75 6e 64 2d 73 65 74 21 20 63 6e 76 20 70 round-set! cnv p
43e0: 72 65 76 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 63 rev-foreground-c
43f0: 6f 6c 6f 72 29 0a 09 20 20 28 69 66 20 74 65 78 olor).. (if tex
4400: 74 20 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 t .. (let*
4410: 28 28 70 72 65 76 2d 66 6f 6e 74 20 20 20 20 28 ((prev-font (
4420: 63 61 6e 76 61 73 2d 66 6f 6e 74 20 63 6e 76 29 canvas-font cnv)
4430: 29 0a 09 09 20 20 20 20 20 28 66 6f 6e 74 2d 63 )... (font-c
4440: 68 61 6e 67 65 64 20 28 61 6e 64 20 66 6f 6e 74 hanged (and font
4450: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 66 6f (not (equal? fo
4460: 6e 74 20 70 72 65 76 2d 66 6f 6e 74 29 29 29 29 nt prev-font))))
4470: 29 0a 09 09 28 69 66 20 66 6f 6e 74 2d 63 68 61 )...(if font-cha
4480: 6e 67 65 64 20 28 63 61 6e 76 61 73 2d 66 6f 6e nged (canvas-fon
4490: 74 2d 73 65 74 21 20 63 6e 76 20 66 6f 6e 74 29 t-set! cnv font)
44a0: 29 0a 09 09 28 63 61 6e 76 61 73 2d 74 65 78 74 )...(canvas-text
44b0: 21 20 63 6e 76 20 28 2b 20 32 20 6c 6c 78 29 28 ! cnv (+ 2 llx)(
44c0: 2b 20 32 20 6c 6c 79 29 20 74 65 78 74 29 0a 09 + 2 lly) text)..
44d0: 09 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 .(let-values (((
44e0: 78 6d 61 78 20 79 6d 61 78 29 28 63 61 6e 76 61 xmax ymax)(canva
44f0: 73 2d 74 65 78 74 2d 73 69 7a 65 20 63 6e 76 20 s-text-size cnv
4500: 74 65 78 74 29 29 29 0a 09 09 20 20 28 73 65 74 text)))... (set
4510: 21 20 74 65 78 74 2d 78 6d 61 78 20 78 6d 61 78 ! text-xmax xmax
4520: 29 28 73 65 74 21 20 74 65 78 74 2d 79 6d 61 78 )(set! text-ymax
4530: 20 79 6d 61 78 29 29 0a 09 09 28 69 66 20 66 6f ymax))...(if fo
4540: 6e 74 2d 63 68 61 6e 67 65 64 20 28 63 61 6e 76 nt-changed (canv
4550: 61 73 2d 66 6f 6e 74 2d 73 65 74 21 20 63 6e 76 as-font-set! cnv
4560: 20 70 72 65 76 2d 66 6f 6e 74 29 29 29 29 29 29 prev-font))))))
4570: 0a 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 . ;; (print "
4580: 74 65 78 74 2d 78 6d 61 78 3a 20 22 20 74 65 78 text-xmax: " tex
4590: 74 2d 78 6d 61 78 20 22 20 74 65 78 74 2d 79 6d t-xmax " text-ym
45a0: 61 78 3a 20 22 20 74 65 78 74 2d 79 6d 61 78 29 ax: " text-ymax)
45b0: 0a 20 20 20 20 28 69 66 20 28 76 67 3a 6f 62 6a . (if (vg:obj
45c0: 2d 65 78 74 65 6e 74 73 20 6f 62 6a 29 0a 09 28 -extents obj)..(
45d0: 76 67 3a 6f 62 6a 2d 65 78 74 65 6e 74 73 20 6f vg:obj-extents o
45e0: 62 6a 29 0a 09 28 69 66 20 28 6e 6f 74 20 74 65 bj)..(if (not te
45f0: 78 74 29 0a 09 20 20 20 20 70 74 73 0a 09 20 20 xt).. pts..
4600: 20 20 28 69 66 20 28 61 6e 64 20 74 65 78 74 2d (if (and text-
4610: 78 6d 61 78 20 74 65 78 74 2d 79 6d 61 78 29 0a xmax text-ymax).
4620: 09 09 28 6c 65 74 20 28 28 78 74 20 28 6c 69 73 ..(let ((xt (lis
4630: 74 20 6c 6c 78 20 6c 6c 79 0a 09 09 09 09 28 6d t llx lly.....(m
4640: 61 78 20 75 6c 78 20 28 2b 20 6c 6c 78 20 74 65 ax ulx (+ llx te
4650: 78 74 2d 78 6d 61 78 29 29 0a 09 09 09 09 28 6d xt-xmax)).....(m
4660: 61 78 20 75 6c 79 20 28 2b 20 6c 6c 79 20 74 65 ax uly (+ lly te
4670: 78 74 2d 79 6d 61 78 29 29 29 29 29 0a 09 09 20 xt-ymax)))))...
4680: 20 28 76 67 3a 6f 62 6a 2d 65 78 74 65 6e 74 73 (vg:obj-extents
4690: 2d 73 65 74 21 20 6f 62 6a 20 78 74 29 0a 09 09 -set! obj xt)...
46a0: 20 20 78 74 29 0a 09 09 28 69 66 20 63 6e 76 0a xt)...(if cnv.
46b0: 09 09 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 .. (let-value
46c0: 73 20 28 28 28 78 6d 61 78 20 79 6d 61 78 29 28 s (((xmax ymax)(
46d0: 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 69 7a 65 canvas-text-size
46e0: 20 63 6e 76 20 74 65 78 74 29 29 29 0a 09 09 20 cnv text)))...
46f0: 20 20 20 20 20 28 6c 65 74 20 28 28 78 74 20 28 (let ((xt (
4700: 6c 69 73 74 20 6c 6c 78 20 6c 6c 79 0a 09 09 09 list llx lly....
4710: 09 20 20 20 20 20 20 28 6d 61 78 20 75 6c 78 20 . (max ulx
4720: 28 2b 20 6c 6c 78 20 78 6d 61 78 29 29 0a 09 09 (+ llx xmax))...
4730: 09 09 20 20 20 20 20 20 28 6d 61 78 20 75 6c 79 .. (max uly
4740: 20 28 2b 20 6c 6c 79 20 79 6d 61 78 29 29 29 29 (+ lly ymax))))
4750: 29 0a 09 09 09 28 76 67 3a 6f 62 6a 2d 65 78 74 )....(vg:obj-ext
4760: 65 6e 74 73 2d 73 65 74 21 20 6f 62 6a 20 78 74 ents-set! obj xt
4770: 29 0a 09 09 09 78 74 29 29 0a 09 09 20 20 20 20 )....xt))...
4780: 70 74 73 29 29 29 29 29 29 20 3b 3b 20 72 65 74 pts)))))) ;; ret
4790: 75 72 6e 20 65 78 74 65 6e 74 73 20 0a 0a 3b 3b urn extents ..;;
47a0: 20 67 69 76 65 6e 20 61 20 72 65 63 74 20 6f 62 given a rect ob
47b0: 6a 20 64 72 61 77 20 69 74 20 6f 6e 20 74 68 65 j draw it on the
47c0: 20 63 61 6e 76 61 73 20 61 70 70 6c 79 69 6e 67 canvas applying
47d0: 20 66 69 72 73 74 20 74 68 65 20 64 72 61 77 69 first the drawi
47e0: 6e 67 0a 3b 3b 20 73 63 61 6c 65 20 61 6e 64 20 ng.;; scale and
47f0: 6f 66 66 73 65 74 0a 3b 3b 0a 28 64 65 66 69 6e offset.;;.(defin
4800: 65 20 28 76 67 3a 64 72 61 77 2d 78 61 78 69 73 e (vg:draw-xaxis
4810: 20 64 72 61 77 69 6e 67 20 6f 62 6a 20 23 21 6b drawing obj #!k
4820: 65 79 20 28 64 72 61 77 20 23 74 29 29 0a 20 20 ey (draw #t)).
4830: 28 6c 65 74 2a 20 28 28 63 6e 76 20 28 76 67 3a (let* ((cnv (vg:
4840: 64 72 61 77 69 6e 67 2d 63 6e 76 20 64 72 61 77 drawing-cnv draw
4850: 69 6e 67 29 29 0a 09 20 28 70 74 73 20 28 76 67 ing)).. (pts (vg
4860: 3a 64 72 61 77 69 6e 67 2d 61 70 70 6c 79 2d 73 :drawing-apply-s
4870: 63 61 6c 65 20 64 72 61 77 69 6e 67 20 28 76 67 cale drawing (vg
4880: 3a 6f 62 6a 2d 70 74 73 20 6f 62 6a 29 29 29 0a :obj-pts obj))).
4890: 09 20 3b 3b 20 28 66 69 6c 6c 2d 63 6f 6c 6f 72 . ;; (fill-color
48a0: 20 28 76 67 3a 6f 62 6a 2d 66 69 6c 6c 2d 63 6f (vg:obj-fill-co
48b0: 6c 6f 72 20 6f 62 6a 29 29 0a 09 20 28 6c 69 6e lor obj)).. (lin
48c0: 65 2d 63 6f 6c 6f 72 20 28 76 67 3a 6f 62 6a 2d e-color (vg:obj-
48d0: 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f 62 6a 29 29 line-color obj))
48e0: 0a 09 20 28 74 65 78 74 20 20 20 20 20 20 20 28 .. (text (
48f0: 76 67 3a 6f 62 6a 2d 74 65 78 74 20 6f 62 6a 29 vg:obj-text obj)
4900: 29 0a 09 20 28 66 6f 6e 74 20 20 20 20 20 20 20 ).. (font
4910: 28 76 67 3a 6f 62 6a 2d 66 6f 6e 74 20 6f 62 6a (vg:obj-font obj
4920: 29 29 0a 09 20 28 6c 6c 78 20 20 20 20 20 20 20 )).. (llx
4930: 20 28 63 61 72 20 70 74 73 29 29 0a 09 20 28 6c (car pts)).. (l
4940: 6c 79 20 20 20 20 20 20 20 20 28 63 61 64 72 20 ly (cadr
4950: 70 74 73 29 29 0a 09 20 28 75 6c 78 20 20 20 20 pts)).. (ulx
4960: 20 20 20 20 28 63 61 64 64 72 20 70 74 73 29 29 (caddr pts))
4970: 0a 09 20 28 75 6c 79 20 20 20 20 20 20 20 20 28 .. (uly (
4980: 63 61 64 64 64 72 20 70 74 73 29 29 0a 09 20 28 cadddr pts)).. (
4990: 77 20 20 20 20 20 20 20 20 20 20 28 2d 20 75 6c w (- ul
49a0: 78 20 6c 6c 78 29 29 0a 09 20 28 68 20 20 20 20 x llx)).. (h
49b0: 20 20 20 20 20 20 28 2d 20 75 6c 79 20 6c 6c 79 (- uly lly
49c0: 29 29 0a 09 20 28 74 65 78 74 2d 78 6d 61 78 20 )).. (text-xmax
49d0: 20 23 66 29 0a 09 20 28 74 65 78 74 2d 79 6d 61 #f).. (text-yma
49e0: 78 20 20 23 66 29 29 0a 20 20 20 20 28 69 66 20 x #f)). (if
49f0: 64 72 61 77 20 0a 09 28 6c 65 74 20 28 28 70 72 draw ..(let ((pr
4a00: 65 76 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 63 6f ev-background-co
4a10: 6c 6f 72 20 28 63 61 6e 76 61 73 2d 62 61 63 6b lor (canvas-back
4a20: 67 72 6f 75 6e 64 20 63 6e 76 29 29 0a 09 20 20 ground cnv))..
4a30: 20 20 20 20 28 70 72 65 76 2d 66 6f 72 65 67 72 (prev-foregr
4a40: 6f 75 6e 64 2d 63 6f 6c 6f 72 20 28 63 61 6e 76 ound-color (canv
4a50: 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 20 63 6e as-foreground cn
4a60: 76 29 29 29 0a 09 3b 3b 20 28 69 66 20 66 69 6c v)))..;; (if fil
4a70: 6c 2d 63 6f 6c 6f 72 0a 09 3b 3b 20 20 20 20 20 l-color..;;
4a80: 28 62 65 67 69 6e 0a 09 3b 3b 20 09 28 63 61 6e (begin..;; .(can
4a90: 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 vas-foreground-s
4aa0: 65 74 21 20 63 6e 76 20 66 69 6c 6c 2d 63 6f 6c et! cnv fill-col
4ab0: 6f 72 29 0a 09 3b 3b 20 09 28 63 61 6e 76 61 73 or)..;; .(canvas
4ac0: 2d 62 6f 78 21 20 63 6e 76 20 6c 6c 78 20 75 6c -box! cnv llx ul
4ad0: 78 20 6c 6c 79 20 75 6c 79 29 29 29 20 3b 3b 20 x lly uly))) ;;
4ae0: 64 6f 63 73 20 61 72 65 20 61 6c 6c 20 6f 76 65 docs are all ove
4af0: 72 20 74 68 65 20 70 6c 61 63 65 20 6f 6e 20 74 r the place on t
4b00: 68 69 73 20 6f 6e 65 2e 3b 3b 20 77 20 68 29 0a his one.;; w h).
4b10: 09 20 20 28 69 66 20 6c 69 6e 65 2d 63 6f 6c 6f . (if line-colo
4b20: 72 0a 09 20 20 20 20 20 20 28 63 61 6e 76 61 73 r.. (canvas
4b30: 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 -foreground-set!
4b40: 20 63 6e 76 20 6c 69 6e 65 2d 63 6f 6c 6f 72 29 cnv line-color)
4b50: 0a 09 20 20 20 20 20 20 28 69 66 20 66 69 6c 6c .. (if fill
4b60: 2d 63 6f 6c 6f 72 0a 09 09 20 20 28 63 61 6e 76 -color... (canv
4b70: 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 as-foreground-se
4b80: 74 21 20 63 6e 76 20 70 72 65 76 2d 66 6f 72 65 t! cnv prev-fore
4b90: 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 29 29 29 0a ground-color))).
4ba0: 09 20 20 28 63 61 6e 76 61 73 2d 6c 69 6e 65 21 . (canvas-line!
4bb0: 20 63 6e 76 20 6c 6c 78 20 75 6c 78 20 6c 6c 79 cnv llx ulx lly
4bc0: 20 75 6c 79 29 0a 09 20 20 28 63 61 6e 76 61 73 uly).. (canvas
4bd0: 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 -foreground-set!
4be0: 20 63 6e 76 20 70 72 65 76 2d 66 6f 72 65 67 72 cnv prev-foregr
4bf0: 6f 75 6e 64 2d 63 6f 6c 6f 72 29 0a 09 20 20 28 ound-color).. (
4c00: 69 66 20 74 65 78 74 20 0a 09 20 20 20 20 20 20 if text ..
4c10: 28 6c 65 74 2a 20 28 28 70 72 65 76 2d 66 6f 6e (let* ((prev-fon
4c20: 74 20 20 20 20 28 63 61 6e 76 61 73 2d 66 6f 6e t (canvas-fon
4c30: 74 20 63 6e 76 29 29 0a 09 09 20 20 20 20 20 28 t cnv))... (
4c40: 66 6f 6e 74 2d 63 68 61 6e 67 65 64 20 28 61 6e font-changed (an
4c50: 64 20 66 6f 6e 74 20 28 6e 6f 74 20 28 65 71 75 d font (not (equ
4c60: 61 6c 3f 20 66 6f 6e 74 20 70 72 65 76 2d 66 6f al? font prev-fo
4c70: 6e 74 29 29 29 29 29 0a 09 09 28 69 66 20 66 6f nt)))))...(if fo
4c80: 6e 74 2d 63 68 61 6e 67 65 64 20 28 63 61 6e 76 nt-changed (canv
4c90: 61 73 2d 66 6f 6e 74 2d 73 65 74 21 20 63 6e 76 as-font-set! cnv
4ca0: 20 66 6f 6e 74 29 29 0a 09 09 28 63 61 6e 76 61 font))...(canva
4cb0: 73 2d 74 65 78 74 21 20 63 6e 76 20 28 2b 20 32 s-text! cnv (+ 2
4cc0: 20 6c 6c 78 29 28 2b 20 32 20 6c 6c 79 29 20 74 llx)(+ 2 lly) t
4cd0: 65 78 74 29 0a 09 09 28 6c 65 74 2d 76 61 6c 75 ext)...(let-valu
4ce0: 65 73 20 28 28 28 78 6d 61 78 20 79 6d 61 78 29 es (((xmax ymax)
4cf0: 28 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 69 7a (canvas-text-siz
4d00: 65 20 63 6e 76 20 74 65 78 74 29 29 29 0a 09 09 e cnv text)))...
4d10: 20 20 28 73 65 74 21 20 74 65 78 74 2d 78 6d 61 (set! text-xma
4d20: 78 20 78 6d 61 78 29 28 73 65 74 21 20 74 65 78 x xmax)(set! tex
4d30: 74 2d 79 6d 61 78 20 79 6d 61 78 29 29 0a 09 09 t-ymax ymax))...
4d40: 28 69 66 20 66 6f 6e 74 2d 63 68 61 6e 67 65 64 (if font-changed
4d50: 20 28 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 (canvas-font-se
4d60: 74 21 20 63 6e 76 20 70 72 65 76 2d 66 6f 6e 74 t! cnv prev-font
4d70: 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 )))))). ;; (p
4d80: 72 69 6e 74 20 22 74 65 78 74 2d 78 6d 61 78 3a rint "text-xmax:
4d90: 20 22 20 74 65 78 74 2d 78 6d 61 78 20 22 20 74 " text-xmax " t
4da0: 65 78 74 2d 79 6d 61 78 3a 20 22 20 74 65 78 74 ext-ymax: " text
4db0: 2d 79 6d 61 78 29 0a 20 20 20 20 28 69 66 20 28 -ymax). (if (
4dc0: 76 67 3a 6f 62 6a 2d 65 78 74 65 6e 74 73 20 6f vg:obj-extents o
4dd0: 62 6a 29 0a 09 28 76 67 3a 6f 62 6a 2d 65 78 74 bj)..(vg:obj-ext
4de0: 65 6e 74 73 20 6f 62 6a 29 0a 09 28 69 66 20 28 ents obj)..(if (
4df0: 6e 6f 74 20 74 65 78 74 29 0a 09 20 20 20 20 70 not text).. p
4e00: 74 73 0a 09 20 20 20 20 28 69 66 20 28 61 6e 64 ts.. (if (and
4e10: 20 74 65 78 74 2d 78 6d 61 78 20 74 65 78 74 2d text-xmax text-
4e20: 79 6d 61 78 29 0a 09 09 28 6c 65 74 20 28 28 78 ymax)...(let ((x
4e30: 74 20 28 6c 69 73 74 20 6c 6c 78 20 6c 6c 79 0a t (list llx lly.
4e40: 09 09 09 09 28 6d 61 78 20 75 6c 78 20 28 2b 20 ....(max ulx (+
4e50: 6c 6c 78 20 74 65 78 74 2d 78 6d 61 78 29 29 0a llx text-xmax)).
4e60: 09 09 09 09 28 6d 61 78 20 75 6c 79 20 28 2b 20 ....(max uly (+
4e70: 6c 6c 79 20 74 65 78 74 2d 79 6d 61 78 29 29 29 lly text-ymax)))
4e80: 29 29 0a 09 09 20 20 28 76 67 3a 6f 62 6a 2d 65 ))... (vg:obj-e
4e90: 78 74 65 6e 74 73 2d 73 65 74 21 20 6f 62 6a 20 xtents-set! obj
4ea0: 78 74 29 0a 09 09 20 20 78 74 29 0a 09 09 28 69 xt)... xt)...(i
4eb0: 66 20 63 6e 76 0a 09 09 20 20 20 20 28 6c 65 74 f cnv... (let
4ec0: 2d 76 61 6c 75 65 73 20 28 28 28 78 6d 61 78 20 -values (((xmax
4ed0: 79 6d 61 78 29 28 63 61 6e 76 61 73 2d 74 65 78 ymax)(canvas-tex
4ee0: 74 2d 73 69 7a 65 20 63 6e 76 20 74 65 78 74 29 t-size cnv text)
4ef0: 29 29 0a 09 09 20 20 20 20 20 20 28 6c 65 74 20 ))... (let
4f00: 28 28 78 74 20 28 6c 69 73 74 20 6c 6c 78 20 6c ((xt (list llx l
4f10: 6c 79 0a 09 09 09 09 20 20 20 20 20 20 28 6d 61 ly..... (ma
4f20: 78 20 75 6c 78 20 28 2b 20 6c 6c 78 20 78 6d 61 x ulx (+ llx xma
4f30: 78 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 6d x))..... (m
4f40: 61 78 20 75 6c 79 20 28 2b 20 6c 6c 79 20 79 6d ax uly (+ lly ym
4f50: 61 78 29 29 29 29 29 0a 09 09 09 28 76 67 3a 6f ax)))))....(vg:o
4f60: 62 6a 2d 65 78 74 65 6e 74 73 2d 73 65 74 21 20 bj-extents-set!
4f70: 6f 62 6a 20 78 74 29 0a 09 09 09 78 74 29 29 0a obj xt)....xt)).
4f80: 09 09 20 20 20 20 70 74 73 29 29 29 29 29 29 20 .. pts))))))
4f90: 3b 3b 20 72 65 74 75 72 6e 20 65 78 74 65 6e 74 ;; return extent
4fa0: 73 20 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 72 s ..;; given a r
4fb0: 65 63 74 20 6f 62 6a 20 64 72 61 77 20 69 74 20 ect obj draw it
4fc0: 6f 6e 20 74 68 65 20 63 61 6e 76 61 73 20 61 70 on the canvas ap
4fd0: 70 6c 79 69 6e 67 20 66 69 72 73 74 20 74 68 65 plying first the
4fe0: 20 64 72 61 77 69 6e 67 0a 3b 3b 20 73 63 61 6c drawing.;; scal
4ff0: 65 20 61 6e 64 20 6f 66 66 73 65 74 0a 3b 3b 0a e and offset.;;.
5000: 28 64 65 66 69 6e 65 20 28 76 67 3a 64 72 61 77 (define (vg:draw
5010: 2d 74 65 78 74 20 64 72 61 77 69 6e 67 20 6f 62 -text drawing ob
5020: 6a 20 23 21 6b 65 79 20 28 64 72 61 77 20 23 74 j #!key (draw #t
5030: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6e 76 )). (let* ((cnv
5040: 20 20 20 20 20 20 20 20 28 76 67 3a 64 72 61 77 (vg:draw
5050: 69 6e 67 2d 63 6e 76 20 64 72 61 77 69 6e 67 29 ing-cnv drawing)
5060: 29 0a 09 20 28 70 74 73 20 20 20 20 20 20 20 20 ).. (pts
5070: 28 76 67 3a 64 72 61 77 69 6e 67 2d 61 70 70 6c (vg:drawing-appl
5080: 79 2d 73 63 61 6c 65 20 64 72 61 77 69 6e 67 20 y-scale drawing
5090: 28 76 67 3a 6f 62 6a 2d 70 74 73 20 6f 62 6a 29 (vg:obj-pts obj)
50a0: 29 29 0a 09 20 28 74 65 78 74 20 20 20 20 20 20 )).. (text
50b0: 20 28 76 67 3a 6f 62 6a 2d 74 65 78 74 20 6f 62 (vg:obj-text ob
50c0: 6a 29 29 0a 09 20 28 66 6f 6e 74 20 20 20 20 20 j)).. (font
50d0: 20 20 28 76 67 3a 6f 62 6a 2d 66 6f 6e 74 20 6f (vg:obj-font o
50e0: 62 6a 29 29 0a 09 20 28 66 69 6c 6c 2d 63 6f 6c bj)).. (fill-col
50f0: 6f 72 20 28 76 67 3a 6f 62 6a 2d 66 69 6c 6c 2d or (vg:obj-fill-
5100: 63 6f 6c 6f 72 20 6f 62 6a 29 29 0a 09 20 28 6c color obj)).. (l
5110: 69 6e 65 2d 63 6f 6c 6f 72 20 28 76 67 3a 6f 62 ine-color (vg:ob
5120: 6a 2d 6c 69 6e 65 2d 63 6f 6c 6f 72 20 6f 62 6a j-line-color obj
5130: 29 29 0a 09 20 28 6c 6c 78 20 20 20 20 20 20 20 )).. (llx
5140: 20 28 63 61 72 20 70 74 73 29 29 20 0a 09 20 28 (car pts)) .. (
5150: 6c 6c 79 20 20 20 20 20 20 20 20 28 63 61 64 72 lly (cadr
5160: 20 70 74 73 29 29 29 0a 20 20 20 20 28 69 66 20 pts))). (if
5170: 64 72 61 77 20 0a 09 28 6c 65 74 2a 20 28 28 70 draw ..(let* ((p
5180: 72 65 76 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 63 rev-background-c
5190: 6f 6c 6f 72 20 28 63 61 6e 76 61 73 2d 62 61 63 olor (canvas-bac
51a0: 6b 67 72 6f 75 6e 64 20 63 6e 76 29 29 0a 09 20 kground cnv))..
51b0: 20 20 20 20 20 20 28 70 72 65 76 2d 66 6f 72 65 (prev-fore
51c0: 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 20 28 63 61 ground-color (ca
51d0: 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 20 nvas-foreground
51e0: 63 6e 76 29 29 0a 09 20 20 20 20 20 20 20 28 70 cnv)).. (p
51f0: 72 65 76 2d 66 6f 6e 74 20 20 20 20 20 20 20 20 rev-font
5200: 20 20 20 20 20 28 63 61 6e 76 61 73 2d 66 6f 6e (canvas-fon
5210: 74 20 20 20 20 20 20 20 63 6e 76 29 29 0a 09 20 t cnv))..
5220: 20 20 20 20 20 20 28 66 6f 6e 74 2d 63 68 61 6e (font-chan
5230: 67 65 64 20 20 20 20 28 61 6e 64 20 66 6f 6e 74 ged (and font
5240: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 66 6f (not (equal? fo
5250: 6e 74 20 70 72 65 76 2d 66 6f 6e 74 29 29 29 29 nt prev-font))))
5260: 29 0a 09 20 20 28 69 66 20 6c 69 6e 65 2d 63 6f ).. (if line-co
5270: 6c 6f 72 0a 09 20 20 20 20 20 20 28 63 61 6e 76 lor.. (canv
5280: 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 as-foreground-se
5290: 74 21 20 63 6e 76 20 6c 69 6e 65 2d 63 6f 6c 6f t! cnv line-colo
52a0: 72 29 0a 09 20 20 20 20 20 20 28 69 66 20 66 69 r).. (if fi
52b0: 6c 6c 2d 63 6f 6c 6f 72 0a 09 09 20 20 28 63 61 ll-color... (ca
52c0: 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e 64 2d nvas-foreground-
52d0: 73 65 74 21 20 63 6e 76 20 70 72 65 76 2d 66 6f set! cnv prev-fo
52e0: 72 65 67 72 6f 75 6e 64 2d 63 6f 6c 6f 72 29 29 reground-color))
52f0: 29 0a 09 20 20 28 69 66 20 66 6f 6e 74 2d 63 68 ).. (if font-ch
5300: 61 6e 67 65 64 20 28 63 61 6e 76 61 73 2d 66 6f anged (canvas-fo
5310: 6e 74 2d 73 65 74 21 20 63 6e 76 20 66 6f 6e 74 nt-set! cnv font
5320: 29 29 0a 09 20 20 28 63 61 6e 76 61 73 2d 74 65 )).. (canvas-te
5330: 78 74 21 20 63 6e 76 20 6c 6c 78 20 6c 6c 79 20 xt! cnv llx lly
5340: 74 65 78 74 29 0a 09 20 20 3b 3b 20 4e 4f 54 45 text).. ;; NOTE
5350: 3a 20 77 65 20 64 6f 20 6e 6f 74 20 73 65 74 20 : we do not set
5360: 74 68 65 20 66 6f 6e 74 20 62 61 63 6b 21 21 0a the font back!!.
5370: 09 20 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 67 . (canvas-foreg
5380: 72 6f 75 6e 64 2d 73 65 74 21 20 63 6e 76 20 70 round-set! cnv p
5390: 72 65 76 2d 66 6f 72 65 67 72 6f 75 6e 64 2d 63 rev-foreground-c
53a0: 6f 6c 6f 72 29 29 29 0a 20 20 20 20 28 69 66 20 olor))). (if
53b0: 63 6e 76 0a 09 28 69 66 20 28 65 71 3f 20 64 72 cnv..(if (eq? dr
53c0: 61 77 20 27 67 65 74 2d 65 78 74 65 6e 74 73 29 aw 'get-extents)
53d0: 0a 09 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 .. (let-value
53e0: 73 20 28 28 28 78 6d 61 78 20 79 6d 61 78 29 28 s (((xmax ymax)(
53f0: 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 69 7a 65 canvas-text-size
5400: 20 63 6e 76 20 74 65 78 74 29 29 29 0a 09 09 09 cnv text)))....
5410: 28 61 70 70 65 6e 64 20 70 74 73 20 28 6c 69 73 (append pts (lis
5420: 74 20 28 2b 20 6c 6c 78 20 78 6d 61 78 29 28 2b t (+ llx xmax)(+
5430: 20 6c 6c 79 20 79 6d 61 78 29 29 29 29 20 3b 3b lly ymax)))) ;;
5440: 20 77 69 6c 6c 20 62 65 20 77 72 6f 6e 67 20 69 will be wrong i
5450: 66 20 74 65 78 74 20 69 73 20 72 6f 74 61 74 65 f text is rotate
5460: 64 3f 0a 09 20 20 20 20 28 61 70 70 65 6e 64 20 d?.. (append
5470: 70 74 73 20 70 74 73 29 29 0a 09 28 61 70 70 65 pts pts))..(appe
5480: 6e 64 20 70 74 73 20 70 74 73 29 29 29 29 0a 0a nd pts pts))))..
5490: 28 64 65 66 69 6e 65 20 28 76 67 3a 64 72 61 77 (define (vg:draw
54a0: 2d 69 6e 73 74 20 64 72 61 77 69 6e 67 20 69 6e -inst drawing in
54b0: 73 74 20 23 21 6b 65 79 20 28 64 72 61 77 2d 6d st #!key (draw-m
54c0: 6f 64 65 20 23 74 29 28 70 72 65 76 2d 65 78 74 ode #t)(prev-ext
54d0: 65 6e 74 73 20 27 28 29 29 29 0a 20 20 28 6c 65 ents '())). (le
54e0: 74 2a 20 28 28 6c 69 62 6e 61 6d 65 20 20 28 76 t* ((libname (v
54f0: 67 3a 69 6e 73 74 2d 6c 69 62 6e 61 6d 65 20 69 g:inst-libname i
5500: 6e 73 74 29 29 0a 09 20 28 63 6f 6d 70 6e 61 6d nst)).. (compnam
5510: 65 20 28 76 67 3a 69 6e 73 74 2d 63 6f 6d 70 6e e (vg:inst-compn
5520: 61 6d 65 20 69 6e 73 74 29 29 0a 09 20 28 63 6f ame inst)).. (co
5530: 6d 70 20 20 20 20 20 28 76 67 3a 67 65 74 2d 63 mp (vg:get-c
5540: 6f 6d 70 6f 6e 65 6e 74 20 64 72 61 77 69 6e 67 omponent drawing
5550: 20 6c 69 62 6e 61 6d 65 20 63 6f 6d 70 6e 61 6d libname compnam
5560: 65 29 29 0a 09 20 28 6f 62 6a 73 20 20 20 20 20 e)).. (objs
5570: 28 76 67 3a 63 6f 6d 70 2d 6f 62 6a 73 20 63 6f (vg:comp-objs co
5580: 6d 70 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 mp))). ;; (pr
5590: 69 6e 74 20 22 63 6f 6d 70 3a 20 22 20 63 6f 6d int "comp: " com
55a0: 70 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c p). (if (null
55b0: 3f 20 6f 62 6a 73 29 0a 09 70 72 65 76 2d 65 78 ? objs)..prev-ex
55c0: 74 65 6e 74 73 0a 09 28 6c 65 74 20 6c 6f 6f 70 tents..(let loop
55d0: 20 28 28 6f 62 6a 20 28 63 61 72 20 6f 62 6a 73 ((obj (car objs
55e0: 29 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 ))... (tal (cd
55f0: 72 20 6f 62 6a 73 29 29 0a 09 09 20 20 20 28 72 r objs))... (r
5600: 65 73 20 70 72 65 76 2d 65 78 74 65 6e 74 73 29 es prev-extents)
5610: 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 6f 62 6a ).. (let* ((obj
5620: 2d 78 66 72 6d 64 20 28 76 67 3a 6d 61 70 2d 6f -xfrmd (vg:map-o
5630: 62 6a 20 64 72 61 77 69 6e 67 20 69 6e 73 74 20 bj drawing inst
5640: 6f 62 6a 29 29 0a 09 09 20 28 6e 65 77 72 65 73 obj))... (newres
5650: 20 20 20 20 28 63 6f 6e 73 20 28 76 67 3a 64 72 (cons (vg:dr
5660: 61 77 2d 6f 62 6a 20 64 72 61 77 69 6e 67 20 6f aw-obj drawing o
5670: 62 6a 2d 78 66 72 6d 64 20 64 72 61 77 3a 20 64 bj-xfrmd draw: d
5680: 72 61 77 2d 6d 6f 64 65 29 20 72 65 73 29 29 29 raw-mode) res)))
5690: 0a 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f .. (if (null?
56a0: 20 74 61 6c 29 0a 09 09 6e 65 77 72 65 73 0a 09 tal)...newres..
56b0: 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 .(loop (car tal)
56c0: 28 63 64 72 20 74 61 6c 29 20 6e 65 77 72 65 73 (cdr tal) newres
56d0: 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))))))..(define
56e0: 20 28 76 67 3a 64 72 61 77 20 64 72 61 77 69 6e (vg:draw drawin
56f0: 67 20 64 72 61 77 2d 6d 6f 64 65 20 2e 20 69 6e g draw-mode . in
5700: 73 74 6e 61 6d 65 73 29 0a 20 20 28 6c 65 74 2a stnames). (let*
5710: 20 28 28 69 6e 73 74 73 20 28 76 67 3a 64 72 61 ((insts (vg:dra
5720: 77 69 6e 67 2d 69 6e 73 74 73 20 64 72 61 77 69 wing-insts drawi
5730: 6e 67 29 29 0a 09 20 28 61 6c 6c 2d 69 6e 73 74 ng)).. (all-inst
5740: 2d 6e 61 6d 65 73 20 28 68 61 73 68 2d 74 61 62 -names (hash-tab
5750: 6c 65 2d 6b 65 79 73 20 69 6e 73 74 73 29 29 0a le-keys insts)).
5760: 09 20 28 6d 61 73 74 65 72 2d 6c 69 73 74 20 20 . (master-list
5770: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 69 6e 73 (if (null? ins
5780: 74 6e 61 6d 65 73 29 0a 09 09 09 20 20 20 20 20 tnames)....
5790: 61 6c 6c 2d 69 6e 73 74 2d 6e 61 6d 65 73 0a 09 all-inst-names..
57a0: 09 09 20 20 20 20 20 69 6e 73 74 6e 61 6d 65 73 .. instnames
57b0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c ))). (if (nul
57c0: 6c 3f 20 6d 61 73 74 65 72 2d 6c 69 73 74 29 0a l? master-list).
57d0: 09 27 28 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 .'()..(let loop
57e0: 28 28 69 6e 73 74 6e 61 6d 65 20 28 63 61 72 20 ((instname (car
57f0: 6d 61 73 74 65 72 2d 6c 69 73 74 29 29 0a 09 09 master-list))...
5800: 20 20 20 28 74 61 6c 20 20 20 20 20 20 28 63 64 (tal (cd
5810: 72 20 6d 61 73 74 65 72 2d 6c 69 73 74 29 29 0a r master-list)).
5820: 09 09 20 20 20 28 72 65 73 20 20 20 20 20 20 27 .. (res '
5830: 28 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 ())).. (let* ((
5840: 69 6e 73 74 20 20 20 20 20 28 68 61 73 68 2d 74 inst (hash-t
5850: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
5860: 20 69 6e 73 74 73 20 69 6e 73 74 6e 61 6d 65 20 insts instname
5870: 23 66 29 29 0a 09 09 20 28 6e 65 77 72 65 73 20 #f))... (newres
5880: 20 20 28 69 66 20 69 6e 73 74 0a 09 09 09 20 20 (if inst....
5890: 20 20 20 20 20 28 76 67 3a 64 72 61 77 2d 69 6e (vg:draw-in
58a0: 73 74 20 64 72 61 77 69 6e 67 20 69 6e 73 74 20 st drawing inst
58b0: 64 72 61 77 2d 6d 6f 64 65 3a 20 64 72 61 77 2d draw-mode: draw-
58c0: 6d 6f 64 65 20 70 72 65 76 2d 65 78 74 65 6e 74 mode prev-extent
58d0: 73 3a 20 72 65 73 29 0a 09 09 09 20 20 20 20 20 s: res)....
58e0: 20 20 72 65 73 29 29 29 0a 09 20 20 20 20 28 69 res))).. (i
58f0: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
5900: 6e 65 77 72 65 73 0a 09 09 28 6c 6f 6f 70 20 28 newres...(loop (
5910: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
5920: 29 20 6e 65 77 72 65 73 29 29 29 29 29 29 29 0a ) newres))))))).