Artifact
95dd548d602eddf523f88cc35be4c2aad304df5d:
0000: 3b 3b 20 2d 2a 2d 20 6d 6f 64 65 3a 20 53 63 68 ;; -*- mode: Sch
0010: 65 6d 65 3b 20 74 61 62 2d 77 69 64 74 68 3a 20 eme; tab-width:
0020: 32 3b 20 2d 2a 2d 20 3b 3b 0a 0a 3b 3b 20 7b 7b 2; -*- ;;..;; {{
0030: 7b 20 44 61 74 61 20 74 79 70 65 73 0a 0a 28 66 { Data types..(f
0040: 6f 72 65 69 67 6e 2d 64 65 63 6c 61 72 65 0a 09 oreign-declare..
0050: 22 23 69 6e 63 6c 75 64 65 20 3c 63 64 2e 68 3e "#include <cd.h>
0060: 5c 6e 22 29 0a 0a 28 64 65 66 69 6e 65 20 2a 63 \n")..(define *c
0070: 61 6e 76 61 73 2d 74 61 67 2a 20 22 63 64 43 61 anvas-tag* "cdCa
0080: 6e 76 61 73 22 29 0a 28 64 65 66 69 6e 65 20 63 nvas").(define c
0090: 61 6e 76 61 73 3f 20 28 63 75 74 20 74 61 67 67 anvas? (cut tagg
00a0: 65 64 2d 70 6f 69 6e 74 65 72 3f 20 3c 3e 20 2a ed-pointer? <> *
00b0: 63 61 6e 76 61 73 2d 74 61 67 2a 29 29 0a 0a 28 canvas-tag*))..(
00c0: 64 65 66 69 6e 65 20 28 63 61 6e 76 61 73 2d 3e define (canvas->
00d0: 70 6f 69 6e 74 65 72 20 6e 6f 6e 6e 75 6c 6c 3f pointer nonnull?
00e0: 29 0a 09 28 69 66 20 6e 6f 6e 6e 75 6c 6c 3f 0a )..(if nonnull?.
00f0: 09 09 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 ..(lambda (canva
0100: 73 29 0a 09 09 09 28 65 6e 73 75 72 65 20 63 61 s)....(ensure ca
0110: 6e 76 61 73 3f 20 63 61 6e 76 61 73 29 0a 09 09 nvas? canvas)...
0120: 09 63 61 6e 76 61 73 29 0a 09 09 28 6c 61 6d 62 .canvas)...(lamb
0130: 64 61 20 28 63 61 6e 76 61 73 29 0a 09 09 09 28 da (canvas)....(
0140: 65 6e 73 75 72 65 20 28 64 69 73 6a 6f 69 6e 20 ensure (disjoin
0150: 6e 6f 74 20 63 61 6e 76 61 73 3f 29 20 63 61 6e not canvas?) can
0160: 76 61 73 29 0a 09 09 09 63 61 6e 76 61 73 29 29 vas)....canvas))
0170: 29 0a 0a 28 64 65 66 69 6e 65 20 28 70 6f 69 6e )..(define (poin
0180: 74 65 72 2d 3e 63 61 6e 76 61 73 20 6e 6f 6e 6e ter->canvas nonn
0190: 75 6c 6c 3f 29 0a 09 28 69 66 20 6e 6f 6e 6e 75 ull?)..(if nonnu
01a0: 6c 6c 3f 0a 09 09 28 6c 61 6d 62 64 61 20 28 63 ll?...(lambda (c
01b0: 61 6e 76 61 73 29 0a 09 09 09 28 74 61 67 2d 70 anvas)....(tag-p
01c0: 6f 69 6e 74 65 72 20 63 61 6e 76 61 73 20 2a 63 ointer canvas *c
01d0: 61 6e 76 61 73 2d 74 61 67 2a 29 29 0a 09 09 28 anvas-tag*))...(
01e0: 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 29 0a lambda (canvas).
01f0: 09 09 09 28 61 6e 64 20 63 61 6e 76 61 73 20 28 ...(and canvas (
0200: 74 61 67 2d 70 6f 69 6e 74 65 72 20 63 61 6e 76 tag-pointer canv
0210: 61 73 20 2a 63 61 6e 76 61 73 2d 74 61 67 2a 29 as *canvas-tag*)
0220: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 63 ))))..(define *c
0230: 6f 6e 74 65 78 74 2d 74 61 67 2a 20 22 63 64 43 ontext-tag* "cdC
0240: 6f 6e 74 65 78 74 22 29 0a 28 64 65 66 69 6e 65 ontext").(define
0250: 20 63 6f 6e 74 65 78 74 3f 20 28 63 75 74 20 74 context? (cut t
0260: 61 67 67 65 64 2d 70 6f 69 6e 74 65 72 3f 20 3c agged-pointer? <
0270: 3e 20 2a 63 6f 6e 74 65 78 74 2d 74 61 67 2a 29 > *context-tag*)
0280: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 6f 6e 74 )..(define (cont
0290: 65 78 74 2d 3e 70 6f 69 6e 74 65 72 20 6e 6f 6e ext->pointer non
02a0: 6e 75 6c 6c 3f 29 0a 09 28 69 66 20 6e 6f 6e 6e null?)..(if nonn
02b0: 75 6c 6c 3f 0a 09 09 28 6c 61 6d 62 64 61 20 28 ull?...(lambda (
02c0: 63 6f 6e 74 65 78 74 29 0a 09 09 09 28 65 6e 73 context)....(ens
02d0: 75 72 65 20 63 6f 6e 74 65 78 74 3f 20 63 6f 6e ure context? con
02e0: 74 65 78 74 29 0a 09 09 09 63 6f 6e 74 65 78 74 text)....context
02f0: 29 0a 09 09 28 6c 61 6d 62 64 61 20 28 63 6f 6e )...(lambda (con
0300: 74 65 78 74 29 0a 09 09 09 28 65 6e 73 75 72 65 text)....(ensure
0310: 20 28 64 69 73 6a 6f 69 6e 20 6e 6f 74 20 63 6f (disjoin not co
0320: 6e 74 65 78 74 3f 29 20 63 6f 6e 74 65 78 74 29 ntext?) context)
0330: 0a 09 09 09 63 6f 6e 74 65 78 74 29 29 29 0a 0a ....context)))..
0340: 28 64 65 66 69 6e 65 20 28 70 6f 69 6e 74 65 72 (define (pointer
0350: 2d 3e 63 6f 6e 74 65 78 74 20 6e 6f 6e 6e 75 6c ->context nonnul
0360: 6c 3f 29 0a 09 28 69 66 20 6e 6f 6e 6e 75 6c 6c l?)..(if nonnull
0370: 3f 0a 09 09 28 6c 61 6d 62 64 61 20 28 63 6f 6e ?...(lambda (con
0380: 74 65 78 74 29 0a 09 09 09 28 74 61 67 2d 70 6f text)....(tag-po
0390: 69 6e 74 65 72 20 63 6f 6e 74 65 78 74 20 2a 63 inter context *c
03a0: 6f 6e 74 65 78 74 2d 74 61 67 2a 29 29 0a 09 09 ontext-tag*))...
03b0: 28 6c 61 6d 62 64 61 20 28 63 6f 6e 74 65 78 74 (lambda (context
03c0: 29 0a 09 09 09 28 61 6e 64 20 63 6f 6e 74 65 78 )....(and contex
03d0: 74 20 28 74 61 67 2d 70 6f 69 6e 74 65 72 20 63 t (tag-pointer c
03e0: 6f 6e 74 65 78 74 20 2a 63 6f 6e 74 65 78 74 2d ontext *context-
03f0: 74 61 67 2a 29 29 29 29 29 0a 0a 28 64 65 66 69 tag*)))))..(defi
0400: 6e 65 20 2a 73 74 61 74 65 2d 74 61 67 2a 20 22 ne *state-tag* "
0410: 63 64 53 74 61 74 65 22 29 0a 28 64 65 66 69 6e cdState").(defin
0420: 65 20 73 74 61 74 65 3f 20 28 63 75 74 20 74 61 e state? (cut ta
0430: 67 67 65 64 2d 70 6f 69 6e 74 65 72 3f 20 3c 3e gged-pointer? <>
0440: 20 2a 73 74 61 74 65 2d 74 61 67 2a 29 29 0a 0a *state-tag*))..
0450: 28 64 65 66 69 6e 65 20 28 73 74 61 74 65 2d 3e (define (state->
0460: 70 6f 69 6e 74 65 72 20 6e 6f 6e 6e 75 6c 6c 3f pointer nonnull?
0470: 29 0a 09 28 69 66 20 6e 6f 6e 6e 75 6c 6c 3f 0a )..(if nonnull?.
0480: 09 09 28 6c 61 6d 62 64 61 20 28 73 74 61 74 65 ..(lambda (state
0490: 29 0a 09 09 09 28 65 6e 73 75 72 65 20 73 74 61 )....(ensure sta
04a0: 74 65 3f 20 73 74 61 74 65 29 0a 09 09 09 73 74 te? state)....st
04b0: 61 74 65 29 0a 09 09 28 6c 61 6d 62 64 61 20 28 ate)...(lambda (
04c0: 73 74 61 74 65 29 0a 09 09 09 28 65 6e 73 75 72 state)....(ensur
04d0: 65 20 28 64 69 73 6a 6f 69 6e 20 6e 6f 74 20 73 e (disjoin not s
04e0: 74 61 74 65 3f 29 20 73 74 61 74 65 29 0a 09 09 tate?) state)...
04f0: 09 73 74 61 74 65 29 29 29 0a 0a 28 64 65 66 69 .state)))..(defi
0500: 6e 65 20 28 70 6f 69 6e 74 65 72 2d 3e 73 74 61 ne (pointer->sta
0510: 74 65 20 6e 6f 6e 6e 75 6c 6c 3f 29 0a 09 28 69 te nonnull?)..(i
0520: 66 20 6e 6f 6e 6e 75 6c 6c 3f 0a 09 09 28 6c 61 f nonnull?...(la
0530: 6d 62 64 61 20 28 73 74 61 74 65 29 0a 09 09 09 mbda (state)....
0540: 28 74 61 67 2d 70 6f 69 6e 74 65 72 20 73 74 61 (tag-pointer sta
0550: 74 65 20 2a 73 74 61 74 65 2d 74 61 67 2a 29 29 te *state-tag*))
0560: 0a 09 09 28 6c 61 6d 62 64 61 20 28 73 74 61 74 ...(lambda (stat
0570: 65 29 0a 09 09 09 28 61 6e 64 20 73 74 61 74 65 e)....(and state
0580: 20 28 74 61 67 2d 70 6f 69 6e 74 65 72 20 73 74 (tag-pointer st
0590: 61 74 65 20 2a 73 74 61 74 65 2d 74 61 67 2a 29 ate *state-tag*)
05a0: 29 29 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 ))))..(include "
05b0: 63 61 6e 76 61 73 2d 64 72 61 77 2d 74 79 70 65 canvas-draw-type
05c0: 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 7d 7d 7d 0a s.scm")..;; }}}.
05d0: 0a 3b 3b 20 7b 7b 7b 20 43 61 6e 76 61 73 20 6d .;; {{{ Canvas m
05e0: 61 6e 61 67 65 6d 65 6e 74 0a 0a 28 64 65 66 69 anagement..(defi
05f0: 6e 65 20 63 6f 6e 74 65 78 74 2d 63 61 70 61 62 ne context-capab
0600: 69 6c 69 74 69 65 73 0a 09 28 6c 65 74 72 65 63 ilities..(letrec
0610: 20 28 5b 63 6f 6e 74 65 78 74 2d 63 61 70 61 62 ([context-capab
0620: 69 6c 69 74 69 65 73 2f 72 61 77 0a 09 09 09 20 ilities/raw....
0630: 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 (foreign-la
0640: 6d 62 64 61 20 69 6e 74 20 22 63 64 43 6f 6e 74 mbda int "cdCont
0650: 65 78 74 43 61 70 73 22 20 6e 6f 6e 6e 75 6c 6c extCaps" nonnull
0660: 2d 63 6f 6e 74 65 78 74 29 5d 0a 09 20 20 20 20 -context)]..
0670: 20 20 20 20 20 5b 63 61 70 61 62 69 6c 69 74 69 [capabiliti
0680: 65 73 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c es.. (l
0690: 69 73 74 0a 09 20 20 20 20 20 20 20 20 20 20 09 ist.. .
06a0: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
06b0: 20 09 09 27 66 6c 75 73 68 0a 09 20 20 20 20 20 ..'flush..
06c0: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
06d0: 76 61 6c 75 65 20 22 43 44 5f 43 41 50 5f 46 4c value "CD_CAP_FL
06e0: 55 53 48 22 20 69 6e 74 29 29 0a 09 20 20 20 20 USH" int))..
06f0: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
0700: 20 20 20 20 20 20 20 20 09 09 27 63 6c 65 61 72 ..'clear
0710: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
0720: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
0730: 5f 43 41 50 5f 43 4c 45 41 52 22 20 69 6e 74 29 _CAP_CLEAR" int)
0740: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
0750: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
0760: 09 27 70 6c 61 79 0a 09 20 20 20 20 20 20 20 20 .'play..
0770: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
0780: 75 65 20 22 43 44 5f 43 41 50 5f 50 4c 41 59 22 ue "CD_CAP_PLAY"
0790: 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 int))..
07a0: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
07b0: 20 20 20 20 09 09 27 79 2d 61 78 69 73 0a 09 20 ..'y-axis..
07c0: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
07d0: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 41 ign-value "CD_CA
07e0: 50 5f 59 41 58 49 53 22 20 69 6e 74 29 29 0a 09 P_YAXIS" int))..
07f0: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
0800: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 63 .. ..'c
0810: 6c 69 70 2d 61 72 65 61 0a 09 20 20 20 20 20 20 lip-area..
0820: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
0830: 61 6c 75 65 20 22 43 44 5f 43 41 50 5f 43 4c 49 alue "CD_CAP_CLI
0840: 50 41 52 45 41 22 20 69 6e 74 29 29 0a 09 20 20 PAREA" int))..
0850: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
0860: 20 20 20 20 20 20 20 20 20 20 09 09 27 63 6c 69 ..'cli
0870: 70 2d 70 6f 6c 79 67 6f 6e 0a 09 20 20 20 20 20 p-polygon..
0880: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
0890: 76 61 6c 75 65 20 22 43 44 5f 43 41 50 5f 43 4c value "CD_CAP_CL
08a0: 49 50 50 4f 4c 59 22 20 69 6e 74 29 29 0a 09 20 IPPOLY" int))..
08b0: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
08c0: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 72 65 . ..'re
08d0: 67 69 6f 6e 0a 09 20 20 20 20 20 20 20 20 20 20 gion..
08e0: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
08f0: 20 22 43 44 5f 43 41 50 5f 52 45 47 49 4f 4e 22 "CD_CAP_REGION"
0900: 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 int))..
0910: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
0920: 20 20 20 20 09 09 27 72 65 63 74 61 6e 67 6c 65 ..'rectangle
0930: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
0940: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
0950: 5f 43 41 50 5f 52 45 43 54 22 20 69 6e 74 29 29 _CAP_RECT" int))
0960: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
0970: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
0980: 27 63 68 6f 72 64 0a 09 20 20 20 20 20 20 20 20 'chord..
0990: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
09a0: 75 65 20 22 43 44 5f 43 41 50 5f 43 48 4f 52 44 ue "CD_CAP_CHORD
09b0: 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 " int))..
09c0: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
09d0: 20 20 20 20 20 09 09 27 69 6d 61 67 65 2f 72 67 ..'image/rg
09e0: 62 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 b.. ..(
09f0: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
0a00: 44 5f 43 41 50 5f 49 4d 41 47 45 52 47 42 22 20 D_CAP_IMAGERGB"
0a10: 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 int))..
0a20: 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 .(cons..
0a30: 20 20 20 09 09 27 69 6d 61 67 65 2f 72 67 62 61 ..'image/rgba
0a40: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
0a50: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
0a60: 5f 43 41 50 5f 49 4d 41 47 45 52 47 42 41 22 20 _CAP_IMAGERGBA"
0a70: 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 int))..
0a80: 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 .(cons..
0a90: 20 20 20 09 09 27 69 6d 61 67 65 2f 6d 61 70 0a ..'image/map.
0aa0: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
0ab0: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
0ac0: 43 41 50 5f 49 4d 41 47 45 4d 41 50 22 20 69 6e CAP_IMAGEMAP" in
0ad0: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
0ae0: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
0af0: 20 09 09 27 67 65 74 2d 69 6d 61 67 65 2f 72 67 ..'get-image/rg
0b00: 62 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 b.. ..(
0b10: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
0b20: 44 5f 43 41 50 5f 47 45 54 49 4d 41 47 45 52 47 D_CAP_GETIMAGERG
0b30: 42 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 B" int))..
0b40: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
0b50: 20 20 20 20 20 20 09 09 27 69 6d 61 67 65 2f 73 ..'image/s
0b60: 65 72 76 65 72 0a 09 20 20 20 20 20 20 20 20 20 erver..
0b70: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
0b80: 65 20 22 43 44 5f 43 41 50 5f 49 4d 41 47 45 53 e "CD_CAP_IMAGES
0b90: 52 56 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 RV" int))..
0ba0: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
0bb0: 20 20 20 20 20 20 20 09 09 27 62 61 63 6b 67 72 ..'backgr
0bc0: 6f 75 6e 64 0a 09 20 20 20 20 20 20 20 20 20 20 ound..
0bd0: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
0be0: 20 22 43 44 5f 43 41 50 5f 42 41 43 4b 47 52 4f "CD_CAP_BACKGRO
0bf0: 55 4e 44 22 20 69 6e 74 29 29 0a 09 20 20 20 20 UND" int))..
0c00: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
0c10: 20 20 20 20 20 20 20 20 09 09 27 62 61 63 6b 67 ..'backg
0c20: 72 6f 75 6e 64 2d 6f 70 61 63 69 74 79 0a 09 20 round-opacity..
0c30: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
0c40: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 41 ign-value "CD_CA
0c50: 50 5f 42 41 43 4b 4f 50 41 43 49 54 59 22 20 69 P_BACKOPACITY" i
0c60: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
0c70: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
0c80: 20 20 09 09 27 77 72 69 74 65 2d 6d 6f 64 65 0a ..'write-mode.
0c90: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
0ca0: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
0cb0: 43 41 50 5f 57 52 49 54 45 4d 4f 44 45 22 20 69 CAP_WRITEMODE" i
0cc0: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
0cd0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
0ce0: 20 20 09 09 27 6c 69 6e 65 2d 73 74 79 6c 65 0a ..'line-style.
0cf0: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
0d00: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
0d10: 43 41 50 5f 4c 49 4e 45 53 54 59 4c 45 22 20 69 CAP_LINESTYLE" i
0d20: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
0d30: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
0d40: 20 20 09 09 27 6c 69 6e 65 2d 77 69 64 74 68 0a ..'line-width.
0d50: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
0d60: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
0d70: 43 41 50 5f 4c 49 4e 45 57 49 54 48 22 20 69 6e CAP_LINEWITH" in
0d80: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
0d90: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
0da0: 20 09 09 27 66 70 72 69 6d 74 69 76 65 73 0a 09 ..'fprimtives..
0db0: 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 ..(for
0dc0: 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 eign-value "CD_C
0dd0: 41 50 5f 46 50 52 49 4d 54 49 56 45 53 22 20 69 AP_FPRIMTIVES" i
0de0: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
0df0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
0e00: 20 20 09 09 27 68 61 74 63 68 0a 09 20 20 20 20 ..'hatch..
0e10: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
0e20: 2d 76 61 6c 75 65 20 22 43 44 5f 43 41 50 5f 48 -value "CD_CAP_H
0e30: 41 54 43 48 22 20 69 6e 74 29 29 0a 09 20 20 20 ATCH" int))..
0e40: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
0e50: 20 20 20 20 20 20 20 20 20 09 09 27 73 74 69 70 ..'stip
0e60: 70 6c 65 0a 09 20 20 20 20 20 20 20 20 20 20 09 ple.. .
0e70: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
0e80: 22 43 44 5f 43 41 50 5f 53 54 49 50 50 4c 45 22 "CD_CAP_STIPPLE"
0e90: 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 int))..
0ea0: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
0eb0: 20 20 20 20 09 09 27 70 61 74 74 65 72 6e 0a 09 ..'pattern..
0ec0: 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 ..(for
0ed0: 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 eign-value "CD_C
0ee0: 41 50 5f 50 41 54 54 45 52 4e 22 20 69 6e 74 29 AP_PATTERN" int)
0ef0: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
0f00: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
0f10: 09 27 66 6f 6e 74 0a 09 20 20 20 20 20 20 20 20 .'font..
0f20: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
0f30: 75 65 20 22 43 44 5f 43 41 50 5f 46 4f 4e 54 22 ue "CD_CAP_FONT"
0f40: 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 int))..
0f50: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
0f60: 20 20 20 20 09 09 27 66 6f 6e 74 2d 64 69 6d 65 ..'font-dime
0f70: 6e 73 69 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 nsions..
0f80: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
0f90: 75 65 20 22 43 44 5f 43 41 50 5f 46 4f 4e 54 44 ue "CD_CAP_FONTD
0fa0: 49 4d 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 IM" int))..
0fb0: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
0fc0: 20 20 20 20 20 20 20 09 09 27 74 65 78 74 2d 73 ..'text-s
0fd0: 69 7a 65 0a 09 20 20 20 20 20 20 20 20 20 20 09 ize.. .
0fe0: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
0ff0: 22 43 44 5f 43 41 50 5f 54 45 58 54 53 49 5a 45 "CD_CAP_TEXTSIZE
1000: 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 " int))..
1010: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
1020: 20 20 20 20 20 09 09 27 74 65 78 74 2d 6f 72 69 ..'text-ori
1030: 65 6e 74 61 74 69 6f 6e 0a 09 20 20 20 20 20 20 entation..
1040: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
1050: 61 6c 75 65 20 22 43 44 5f 43 41 50 5f 54 45 58 alue "CD_CAP_TEX
1060: 54 4f 52 49 45 4e 54 41 54 49 4f 4e 22 20 69 6e TORIENTATION" in
1070: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
1080: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
1090: 20 09 09 27 70 61 6c 65 74 74 65 0a 09 20 20 20 ..'palette..
10a0: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
10b0: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 41 50 5f n-value "CD_CAP_
10c0: 50 41 4c 45 54 54 45 22 20 69 6e 74 29 29 0a 09 PALETTE" int))..
10d0: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
10e0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 6c .. ..'l
10f0: 69 6e 65 2d 63 61 70 0a 09 20 20 20 20 20 20 20 ine-cap..
1100: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
1110: 6c 75 65 20 22 43 44 5f 43 41 50 5f 4c 49 4e 45 lue "CD_CAP_LINE
1120: 43 41 50 22 20 69 6e 74 29 29 0a 09 20 20 20 20 CAP" int))..
1130: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
1140: 20 20 20 20 20 20 20 20 09 09 27 6c 69 6e 65 2d ..'line-
1150: 6a 6f 69 6e 0a 09 20 20 20 20 20 20 20 20 20 20 join..
1160: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
1170: 20 22 43 44 5f 43 41 50 5f 4c 49 4e 45 4a 4f 49 "CD_CAP_LINEJOI
1180: 4e 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 N" int))..
1190: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
11a0: 20 20 20 20 20 20 09 09 27 70 61 74 68 0a 09 20 ..'path..
11b0: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
11c0: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 41 ign-value "CD_CA
11d0: 50 5f 50 41 54 48 22 20 69 6e 74 29 29 0a 09 20 P_PATH" int))..
11e0: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
11f0: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 62 65 . ..'be
1200: 7a 69 65 72 0a 09 20 20 20 20 20 20 20 20 20 20 zier..
1210: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
1220: 20 22 43 44 5f 43 41 50 5f 42 45 5a 49 45 52 22 "CD_CAP_BEZIER"
1230: 20 69 6e 74 29 29 29 5d 29 0a 09 20 20 28 6c 61 int)))]).. (la
1240: 6d 62 64 61 20 28 63 6f 6e 74 65 78 74 29 0a 09 mbda (context)..
1250: 20 20 09 28 6c 65 74 20 28 5b 63 61 70 61 62 69 .(let ([capabi
1260: 6c 69 74 69 65 73 2f 72 61 77 20 28 63 6f 6e 74 lities/raw (cont
1270: 65 78 74 2d 63 61 70 61 62 69 6c 69 74 69 65 73 ext-capabilities
1280: 2f 72 61 77 20 63 6f 6e 74 65 78 74 29 5d 29 0a /raw context)]).
1290: 09 09 09 09 28 66 69 6c 74 65 72 2d 6d 61 70 0a ....(filter-map.
12a0: 09 09 09 09 09 28 6c 61 6d 62 64 61 20 28 69 6e .....(lambda (in
12b0: 66 6f 29 0a 09 09 09 09 09 09 28 6c 65 74 20 28 fo).......(let (
12c0: 5b 6d 61 73 6b 20 28 63 64 72 20 69 6e 66 6f 29 [mask (cdr info)
12d0: 5d 29 0a 09 09 09 09 09 09 09 28 61 6e 64 20 28 ])........(and (
12e0: 3d 20 28 62 69 74 77 69 73 65 2d 61 6e 64 20 6d = (bitwise-and m
12f0: 61 73 6b 20 63 61 70 61 62 69 6c 69 74 69 65 73 ask capabilities
1300: 2f 72 61 77 29 20 6d 61 73 6b 29 20 28 63 61 72 /raw) mask) (car
1310: 20 69 6e 66 6f 29 29 29 29 0a 09 09 09 09 09 63 info))))......c
1320: 61 70 61 62 69 6c 69 74 69 65 73 29 29 29 29 29 apabilities)))))
1330: 0a 0a 28 64 65 66 69 6e 65 20 75 73 65 2d 63 6f ..(define use-co
1340: 6e 74 65 78 74 2b 0a 09 28 6d 61 6b 65 2d 70 61 ntext+..(make-pa
1350: 72 61 6d 65 74 65 72 20 23 66 29 29 0a 0a 28 64 rameter #f))..(d
1360: 65 66 69 6e 65 20 6d 61 6b 65 2d 63 61 6e 76 61 efine make-canva
1370: 73 2f 70 74 72 0a 09 28 66 6f 72 65 69 67 6e 2d s/ptr..(foreign-
1380: 6c 61 6d 62 64 61 2a 20 63 61 6e 76 61 73 20 28 lambda* canvas (
1390: 5b 6e 6f 6e 6e 75 6c 6c 2d 63 6f 6e 74 65 78 74 [nonnull-context
13a0: 20 63 6f 6e 74 65 78 74 5d 20 5b 62 6f 6f 6c 20 context] [bool
13b0: 70 6c 75 73 5d 20 5b 63 2d 70 6f 69 6e 74 65 72 plus] [c-pointer
13c0: 20 64 61 74 61 5d 29 0a 09 09 22 63 64 55 73 65 data])..."cdUse
13d0: 43 6f 6e 74 65 78 74 50 6c 75 73 28 70 6c 75 73 ContextPlus(plus
13e0: 29 3b 5c 6e 22 0a 09 09 22 43 5f 72 65 74 75 72 );\n"..."C_retur
13f0: 6e 28 63 64 43 72 65 61 74 65 43 61 6e 76 61 73 n(cdCreateCanvas
1400: 28 63 6f 6e 74 65 78 74 2c 20 64 61 74 61 29 29 (context, data))
1410: 3b 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 6d 61 ;"))..(define ma
1420: 6b 65 2d 63 61 6e 76 61 73 2f 73 74 72 69 6e 67 ke-canvas/string
1430: 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 ..(foreign-lambd
1440: 61 2a 20 63 61 6e 76 61 73 20 28 5b 6e 6f 6e 6e a* canvas ([nonn
1450: 75 6c 6c 2d 63 6f 6e 74 65 78 74 20 63 6f 6e 74 ull-context cont
1460: 65 78 74 5d 20 5b 62 6f 6f 6c 20 70 6c 75 73 5d ext] [bool plus]
1470: 20 5b 63 2d 73 74 72 69 6e 67 20 64 61 74 61 5d [c-string data]
1480: 29 0a 09 09 22 63 64 55 73 65 43 6f 6e 74 65 78 )..."cdUseContex
1490: 74 50 6c 75 73 28 70 6c 75 73 29 3b 5c 6e 22 0a tPlus(plus);\n".
14a0: 09 09 22 43 5f 72 65 74 75 72 6e 28 63 64 43 72 .."C_return(cdCr
14b0: 65 61 74 65 43 61 6e 76 61 73 28 63 6f 6e 74 65 eateCanvas(conte
14c0: 78 74 2c 20 28 76 6f 69 64 20 2a 29 64 61 74 61 xt, (void *)data
14d0: 29 29 3b 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 ));"))..(define
14e0: 63 61 6e 76 61 73 2d 6b 69 6c 6c 21 0a 09 28 66 canvas-kill!..(f
14f0: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f oreign-lambda vo
1500: 69 64 20 22 63 64 4b 69 6c 6c 43 61 6e 76 61 73 id "cdKillCanvas
1510: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
1520: 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 ))..(define canv
1530: 61 73 2d 61 63 74 69 76 61 74 65 21 0a 09 28 66 as-activate!..(f
1540: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f oreign-lambda vo
1550: 69 64 20 22 63 64 43 61 6e 76 61 73 41 63 74 69 id "cdCanvasActi
1560: 76 61 74 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 vate" nonnull-ca
1570: 6e 76 61 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 nvas))..(define
1580: 63 61 6e 76 61 73 2d 64 65 61 63 74 69 76 61 74 canvas-deactivat
1590: 65 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d e!..(foreign-lam
15a0: 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e 76 bda void "cdCanv
15b0: 61 73 44 65 61 63 74 69 76 61 74 65 22 20 6e 6f asDeactivate" no
15c0: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 29 29 0a 0a nnull-canvas))..
15d0: 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 63 61 (define (make-ca
15e0: 6e 76 61 73 20 63 6f 6e 74 65 78 74 20 64 61 74 nvas context dat
15f0: 61 29 0a 09 28 6c 65 74 20 28 5b 6d 61 6b 65 2d a)..(let ([make-
1600: 63 61 6e 76 61 73 2f 64 61 74 61 20 28 69 66 20 canvas/data (if
1610: 28 73 74 72 69 6e 67 3f 20 64 61 74 61 29 20 6d (string? data) m
1620: 61 6b 65 2d 63 61 6e 76 61 73 2f 73 74 72 69 6e ake-canvas/strin
1630: 67 20 6d 61 6b 65 2d 63 61 6e 76 61 73 2f 70 74 g make-canvas/pt
1640: 72 29 5d 29 0a 09 09 28 63 6f 6e 64 0a 09 09 09 r)])...(cond....
1650: 5b 28 6d 61 6b 65 2d 63 61 6e 76 61 73 2f 64 61 [(make-canvas/da
1660: 74 61 20 63 6f 6e 74 65 78 74 20 28 75 73 65 2d ta context (use-
1670: 63 6f 6e 74 65 78 74 2b 29 20 64 61 74 61 29 0a context+) data).
1680: 09 09 09 20 3d 3e 20 28 63 75 74 20 73 65 74 2d ... => (cut set-
1690: 66 69 6e 61 6c 69 7a 65 72 21 20 3c 3e 20 63 61 finalizer! <> ca
16a0: 6e 76 61 73 2d 6b 69 6c 6c 21 29 5d 0a 09 09 09 nvas-kill!)]....
16b0: 5b 65 6c 73 65 0a 09 09 09 20 28 65 72 72 6f 72 [else.... (error
16c0: 20 27 6d 61 6b 65 2d 63 61 6e 76 61 73 20 22 66 'make-canvas "f
16d0: 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 ailed to create
16e0: 63 61 6e 76 61 73 22 29 5d 29 29 29 0a 0a 28 64 canvas")])))..(d
16f0: 65 66 69 6e 65 20 63 61 6c 6c 2d 77 69 74 68 2d efine call-with-
1700: 63 61 6e 76 61 73 0a 09 28 63 61 73 65 2d 6c 61 canvas..(case-la
1710: 6d 62 64 61 0a 09 09 5b 28 63 61 6e 76 61 73 20 mbda...[(canvas
1720: 70 72 6f 63 29 0a 09 09 20 28 64 79 6e 61 6d 69 proc)... (dynami
1730: 63 2d 77 69 6e 64 0a 09 09 20 09 20 28 63 75 74 c-wind... . (cut
1740: 20 63 61 6e 76 61 73 2d 61 63 74 69 76 61 74 65 canvas-activate
1750: 21 20 63 61 6e 76 61 73 29 0a 09 09 20 09 20 28 ! canvas)... . (
1760: 63 75 74 20 70 72 6f 63 20 63 61 6e 76 61 73 29 cut proc canvas)
1770: 0a 09 09 20 09 20 28 63 75 74 20 63 61 6e 76 61 ... . (cut canva
1780: 73 2d 64 65 61 63 74 69 76 61 74 65 21 20 63 61 s-deactivate! ca
1790: 6e 76 61 73 29 29 5d 0a 09 09 5b 28 63 6f 6e 74 nvas))]...[(cont
17a0: 65 78 74 20 64 61 74 61 20 70 72 6f 63 29 0a 09 ext data proc)..
17b0: 09 20 28 6c 65 74 2a 20 28 5b 6d 61 6b 65 2d 63 . (let* ([make-c
17c0: 61 6e 76 61 73 2f 64 61 74 61 20 28 69 66 20 28 anvas/data (if (
17d0: 73 74 72 69 6e 67 3f 20 64 61 74 61 29 20 6d 61 string? data) ma
17e0: 6b 65 2d 63 61 6e 76 61 73 2f 73 74 72 69 6e 67 ke-canvas/string
17f0: 20 6d 61 6b 65 2d 63 61 6e 76 61 73 2f 70 74 72 make-canvas/ptr
1800: 29 5d 0a 09 09 20 09 09 20 20 20 20 5b 63 61 6e )]... .. [can
1810: 76 61 73 20 28 6d 61 6b 65 2d 63 61 6e 76 61 73 vas (make-canvas
1820: 2f 64 61 74 61 20 63 6f 6e 74 65 78 74 20 28 75 /data context (u
1830: 73 65 2d 63 6f 6e 74 65 78 74 2b 29 20 64 61 74 se-context+) dat
1840: 61 29 5d 29 0a 09 09 20 09 20 28 75 6e 6c 65 73 a)])... . (unles
1850: 73 20 63 61 6e 76 61 73 20 28 65 72 72 6f 72 20 s canvas (error
1860: 27 63 61 6c 6c 2d 77 69 74 68 2d 63 61 6e 76 61 'call-with-canva
1870: 73 20 22 66 61 69 6c 65 64 20 74 6f 20 63 72 65 s "failed to cre
1880: 61 74 65 20 63 61 6e 76 61 73 22 29 29 0a 09 09 ate canvas"))...
1890: 09 20 28 64 79 6e 61 6d 69 63 2d 77 69 6e 64 0a . (dynamic-wind.
18a0: 09 09 09 20 09 20 28 63 75 74 20 63 61 6e 76 61 ... . (cut canva
18b0: 73 2d 61 63 74 69 76 61 74 65 21 20 63 61 6e 76 s-activate! canv
18c0: 61 73 29 0a 09 09 09 20 09 20 28 63 75 74 20 70 as).... . (cut p
18d0: 72 6f 63 20 63 61 6e 76 61 73 29 0a 09 09 09 20 roc canvas)....
18e0: 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 . (lambda ()....
18f0: 20 09 20 09 20 28 77 68 65 6e 20 63 61 6e 76 61 . . (when canva
1900: 73 0a 09 09 09 09 09 09 20 28 63 61 6e 76 61 73 s....... (canvas
1910: 2d 6b 69 6c 6c 21 20 63 61 6e 76 61 73 29 0a 09 -kill! canvas)..
1920: 09 09 09 09 09 20 28 73 65 74 21 20 63 61 6e 76 ..... (set! canv
1930: 61 73 20 23 66 29 29 29 29 29 5d 29 29 0a 0a 28 as #f)))))]))..(
1940: 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 63 6f define canvas-co
1950: 6e 74 65 78 74 0a 09 28 66 6f 72 65 69 67 6e 2d ntext..(foreign-
1960: 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 63 lambda nonnull-c
1970: 6f 6e 74 65 78 74 20 22 63 64 43 61 6e 76 61 73 ontext "cdCanvas
1980: 47 65 74 43 6f 6e 74 65 78 74 22 20 6e 6f 6e 6e GetContext" nonn
1990: 75 6c 6c 2d 63 61 6e 76 61 73 29 29 0a 0a 28 64 ull-canvas))..(d
19a0: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 73 69 6d efine canvas-sim
19b0: 75 6c 61 74 65 21 0a 09 28 6c 65 74 72 65 63 20 ulate!..(letrec
19c0: 28 5b 63 61 6e 76 61 73 2d 73 69 6d 75 6c 61 74 ([canvas-simulat
19d0: 65 2f 72 61 77 21 0a 09 20 20 20 20 20 20 20 20 e/raw!..
19e0: 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 (foreign-lambd
19f0: 61 20 69 6e 74 20 22 63 64 43 61 6e 76 61 73 53 a int "cdCanvasS
1a00: 69 6d 75 6c 61 74 65 22 20 6e 6f 6e 6e 75 6c 6c imulate" nonnull
1a10: 2d 63 61 6e 76 61 73 20 69 6e 74 29 5d 0a 09 20 -canvas int)]..
1a20: 20 20 20 20 20 20 20 20 5b 66 6c 61 67 73 0a 09 [flags..
1a30: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 0a (list.
1a40: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
1a50: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
1a60: 6c 69 6e 65 0a 09 20 20 20 20 20 20 20 20 20 20 line..
1a70: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
1a80: 20 22 43 44 5f 53 49 4d 5f 4c 49 4e 45 22 20 69 "CD_SIM_LINE" i
1a90: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
1aa0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
1ab0: 20 20 09 09 27 72 65 63 74 61 6e 67 6c 65 0a 09 ..'rectangle..
1ac0: 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 ..(for
1ad0: 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 53 eign-value "CD_S
1ae0: 49 4d 5f 52 45 43 54 22 20 69 6e 74 29 29 0a 09 IM_RECT" int))..
1af0: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
1b00: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 62 .. ..'b
1b10: 6f 78 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ox.. ..
1b20: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
1b30: 43 44 5f 53 49 4d 5f 42 4f 58 22 20 69 6e 74 29 CD_SIM_BOX" int)
1b40: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
1b50: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
1b60: 09 27 61 72 63 0a 09 20 20 20 20 20 20 20 20 20 .'arc..
1b70: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
1b80: 65 20 22 43 44 5f 53 49 4d 5f 41 52 43 22 20 69 e "CD_SIM_ARC" i
1b90: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
1ba0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
1bb0: 20 20 09 09 27 73 65 63 74 6f 72 0a 09 20 20 20 ..'sector..
1bc0: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
1bd0: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 53 49 4d 5f n-value "CD_SIM_
1be0: 53 45 43 54 4f 52 22 20 69 6e 74 29 29 0a 09 20 SECTOR" int))..
1bf0: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
1c00: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 63 68 . ..'ch
1c10: 6f 72 64 0a 09 20 20 20 20 20 20 20 20 20 20 09 ord.. .
1c20: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
1c30: 22 43 44 5f 53 49 4d 5f 43 48 4f 52 44 22 20 69 "CD_SIM_CHORD" i
1c40: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
1c50: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
1c60: 20 20 09 09 27 70 6f 6c 79 6c 69 6e 65 0a 09 20 ..'polyline..
1c70: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
1c80: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 53 49 ign-value "CD_SI
1c90: 4d 5f 50 4f 4c 59 4c 49 4e 45 22 20 69 6e 74 29 M_POLYLINE" int)
1ca0: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
1cb0: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
1cc0: 09 27 70 6f 6c 79 67 6f 6e 0a 09 20 20 20 20 20 .'polygon..
1cd0: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
1ce0: 76 61 6c 75 65 20 22 43 44 5f 53 49 4d 5f 50 4f value "CD_SIM_PO
1cf0: 4c 59 47 4f 4e 22 20 69 6e 74 29 29 0a 09 20 20 LYGON" int))..
1d00: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
1d10: 20 20 20 20 20 20 20 20 20 20 09 09 27 74 65 78 ..'tex
1d20: 74 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 t.. ..(
1d30: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
1d40: 44 5f 53 49 4d 5f 54 45 58 54 22 20 69 6e 74 29 D_SIM_TEXT" int)
1d50: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
1d60: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
1d70: 09 27 61 6c 6c 0a 09 20 20 20 20 20 20 20 20 20 .'all..
1d80: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
1d90: 65 20 22 43 44 5f 53 49 4d 5f 41 4c 4c 22 20 69 e "CD_SIM_ALL" i
1da0: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
1db0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
1dc0: 20 20 09 09 27 6c 69 6e 65 73 0a 09 20 20 20 20 ..'lines..
1dd0: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
1de0: 2d 76 61 6c 75 65 20 22 43 44 5f 53 49 4d 5f 4c -value "CD_SIM_L
1df0: 49 4e 45 53 22 20 69 6e 74 29 29 0a 09 20 20 20 INES" int))..
1e00: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
1e10: 20 20 20 20 20 20 20 20 20 09 09 27 66 69 6c 6c ..'fill
1e20: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 s.. ..(
1e30: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
1e40: 44 5f 53 49 4d 5f 46 49 4c 4c 53 22 20 69 6e 74 D_SIM_FILLS" int
1e50: 29 29 29 5d 29 0a 09 20 20 28 6c 61 6d 62 64 61 )))]).. (lambda
1e60: 20 28 63 61 6e 76 61 73 20 66 6c 61 67 73 2d 69 (canvas flags-i
1e70: 6e 29 0a 09 20 20 09 28 6c 65 74 20 28 5b 66 6c n).. .(let ([fl
1e80: 61 67 73 2d 6f 75 74 0a 09 20 20 09 20 20 20 20 ags-out.. .
1e90: 20 20 20 28 63 61 6e 76 61 73 2d 73 69 6d 75 6c (canvas-simul
1ea0: 61 74 65 2f 72 61 77 21 0a 09 20 20 09 20 20 20 ate/raw!.. .
1eb0: 20 20 20 20 09 20 63 61 6e 76 61 73 0a 09 20 20 . canvas..
1ec0: 09 20 20 20 20 20 20 20 09 20 28 66 6f 6c 64 0a . . (fold.
1ed0: 09 20 20 09 20 20 20 20 20 20 20 09 20 09 20 62 . . . . b
1ee0: 69 74 77 69 73 65 2d 69 6f 72 20 30 0a 09 20 20 itwise-ior 0..
1ef0: 09 20 20 20 20 20 20 20 09 20 09 20 28 6d 61 70 . . . (map
1f00: 0a 09 20 20 09 20 20 20 20 20 20 20 09 20 09 20 .. . . .
1f10: 09 20 28 6c 61 6d 62 64 61 20 28 66 6c 61 67 29 . (lambda (flag)
1f20: 0a 09 20 20 09 20 20 20 20 20 20 20 09 20 09 20 .. . . .
1f30: 09 20 09 20 28 63 6f 6e 64 0a 09 20 20 09 20 20 . . (cond.. .
1f40: 20 20 20 20 20 09 20 09 20 09 20 09 20 09 20 5b . . . . . [
1f50: 28 61 73 73 71 20 66 6c 61 67 20 66 6c 61 67 73 (assq flag flags
1f60: 29 20 3d 3e 20 63 64 72 5d 0a 09 20 20 09 20 20 ) => cdr].. .
1f70: 20 20 20 20 20 09 20 09 20 09 20 09 20 09 20 5b . . . . . [
1f80: 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e else (error 'can
1f90: 76 61 73 2d 73 69 6d 75 6c 61 74 65 21 20 22 75 vas-simulate! "u
1fa0: 6e 6b 6e 6f 77 6e 20 66 6c 61 67 22 20 66 6c 61 nknown flag" fla
1fb0: 67 29 5d 29 29 0a 09 20 20 09 20 20 20 20 20 20 g)])).. .
1fc0: 20 09 20 09 20 09 20 66 6c 61 67 73 2d 69 6e 29 . . . flags-in)
1fd0: 29 29 5d 29 0a 09 20 20 09 20 20 28 66 69 6c 74 ))]).. . (filt
1fe0: 65 72 2d 6d 61 70 0a 09 20 20 09 20 20 09 28 6c er-map.. . .(l
1ff0: 61 6d 62 64 61 20 28 69 6e 66 6f 29 0a 09 20 20 ambda (info)..
2000: 09 20 20 09 09 28 6c 65 74 20 28 5b 6d 61 73 6b . ..(let ([mask
2010: 20 28 63 64 72 20 69 6e 66 6f 29 5d 29 0a 09 09 (cdr info)])...
2020: 09 09 09 09 09 28 61 6e 64 20 28 3d 20 28 62 69 .....(and (= (bi
2030: 74 77 69 73 65 2d 61 6e 64 20 6d 61 73 6b 20 66 twise-and mask f
2040: 6c 61 67 73 2d 6f 75 74 29 20 6d 61 73 6b 29 20 lags-out) mask)
2050: 28 63 61 72 20 69 6e 66 6f 29 29 29 29 0a 09 20 (car info))))..
2060: 20 09 20 20 09 66 6c 61 67 73 29 29 29 29 29 0a . .flags))))).
2070: 0a 28 64 65 66 69 6e 65 20 28 6e 61 6d 65 2d 3e .(define (name->
2080: 73 74 72 69 6e 67 20 6e 61 6d 65 29 0a 09 28 63 string name)..(c
2090: 6f 6e 64 0a 09 09 5b 28 73 79 6d 62 6f 6c 3f 20 ond...[(symbol?
20a0: 6e 61 6d 65 29 0a 09 09 20 28 73 74 72 69 6e 67 name)... (string
20b0: 2d 75 70 63 61 73 65 20 28 73 74 72 69 6e 67 2d -upcase (string-
20c0: 74 72 61 6e 73 6c 61 74 65 20 28 73 79 6d 62 6f translate (symbo
20d0: 6c 2d 3e 73 74 72 69 6e 67 20 6e 61 6d 65 29 20 l->string name)
20e0: 23 5c 2d 20 23 5c 5f 29 29 5d 0a 09 09 5b 65 6c #\- #\_))]...[el
20f0: 73 65 0a 09 09 20 6e 61 6d 65 5d 29 29 0a 0a 28 se... name]))..(
2100: 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 61 74 define canvas-at
2110: 74 72 69 62 75 74 65 2d 73 65 74 21 0a 09 28 6c tribute-set!..(l
2120: 65 74 72 65 63 20 28 5b 63 61 6e 76 61 73 2d 61 etrec ([canvas-a
2130: 74 74 72 69 62 75 74 65 2d 73 65 74 2f 72 61 77 ttribute-set/raw
2140: 21 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 ! (foreign-lambd
2150: 61 20 76 6f 69 64 20 22 63 64 43 61 6e 76 61 73 a void "cdCanvas
2160: 53 65 74 41 74 74 72 69 62 75 74 65 22 20 6e 6f SetAttribute" no
2170: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 6e 6f 6e nnull-canvas non
2180: 6e 75 6c 6c 2d 63 2d 73 74 72 69 6e 67 20 63 2d null-c-string c-
2190: 73 74 72 69 6e 67 29 5d 29 0a 09 09 28 6c 61 6d string)])...(lam
21a0: 62 64 61 20 28 63 61 6e 76 61 73 20 6e 61 6d 65 bda (canvas name
21b0: 20 76 61 6c 75 65 29 0a 09 09 09 28 63 61 6e 76 value)....(canv
21c0: 61 73 2d 61 74 74 72 69 62 75 74 65 2d 73 65 74 as-attribute-set
21d0: 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 6e 61 /raw! canvas (na
21e0: 6d 65 2d 3e 73 74 72 69 6e 67 20 6e 61 6d 65 29 me->string name)
21f0: 20 76 61 6c 75 65 29 29 29 29 0a 0a 28 64 65 66 value))))..(def
2200: 69 6e 65 20 63 61 6e 76 61 73 2d 61 74 74 72 69 ine canvas-attri
2210: 62 75 74 65 0a 09 28 6c 65 74 72 65 63 20 28 5b bute..(letrec ([
2220: 63 61 6e 76 61 73 2d 61 74 74 72 69 62 75 74 65 canvas-attribute
2230: 2f 72 61 77 20 28 66 6f 72 65 69 67 6e 2d 6c 61 /raw (foreign-la
2240: 6d 62 64 61 20 63 2d 73 74 72 69 6e 67 20 22 63 mbda c-string "c
2250: 64 43 61 6e 76 61 73 47 65 74 41 74 74 72 69 62 dCanvasGetAttrib
2260: 75 74 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e ute" nonnull-can
2270: 76 61 73 20 6e 6f 6e 6e 75 6c 6c 2d 63 2d 73 74 vas nonnull-c-st
2280: 72 69 6e 67 29 5d 29 0a 09 09 28 67 65 74 74 65 ring)])...(gette
2290: 72 2d 77 69 74 68 2d 73 65 74 74 65 72 0a 09 09 r-with-setter...
22a0: 09 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 .(lambda (canvas
22b0: 20 6e 61 6d 65 29 0a 09 09 09 09 28 63 61 6e 76 name).....(canv
22c0: 61 73 2d 61 74 74 72 69 62 75 74 65 2f 72 61 77 as-attribute/raw
22d0: 20 63 61 6e 76 61 73 20 28 6e 61 6d 65 2d 3e 73 canvas (name->s
22e0: 74 72 69 6e 67 20 6e 61 6d 65 29 29 29 0a 09 09 tring name)))...
22f0: 09 63 61 6e 76 61 73 2d 61 74 74 72 69 62 75 74 .canvas-attribut
2300: 65 2d 73 65 74 21 29 29 29 0a 0a 28 64 65 66 69 e-set!)))..(defi
2310: 6e 65 20 63 61 6e 76 61 73 2d 73 74 61 74 65 2d ne canvas-state-
2320: 73 65 74 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c set!..(foreign-l
2330: 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 ambda void "cdCa
2340: 6e 76 61 73 52 65 73 74 6f 72 65 53 74 61 74 65 nvasRestoreState
2350: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
2360: 20 6e 6f 6e 6e 75 6c 6c 2d 73 74 61 74 65 29 29 nonnull-state))
2370: 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 ..(define canvas
2380: 2d 73 74 61 74 65 0a 09 28 6c 65 74 72 65 63 20 -state..(letrec
2390: 28 5b 73 61 76 65 2d 73 74 61 74 65 20 28 66 6f ([save-state (fo
23a0: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e reign-lambda non
23b0: 6e 75 6c 6c 2d 73 74 61 74 65 20 22 63 64 43 61 null-state "cdCa
23c0: 6e 76 61 73 53 61 76 65 53 74 61 74 65 22 20 6e nvasSaveState" n
23d0: 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 29 5d 0a onnull-canvas)].
23e0: 09 20 20 20 20 20 20 20 20 20 5b 72 65 6c 65 61 . [relea
23f0: 73 65 2d 73 74 61 74 65 21 20 28 66 6f 72 65 69 se-state! (forei
2400: 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 gn-lambda void "
2410: 63 64 52 65 6c 65 61 73 65 53 74 61 74 65 22 20 cdReleaseState"
2420: 6e 6f 6e 6e 75 6c 6c 2d 73 74 61 74 65 29 5d 29 nonnull-state)])
2430: 0a 09 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d ...(getter-with-
2440: 73 65 74 74 65 72 0a 09 09 09 28 6c 61 6d 62 64 setter....(lambd
2450: 61 20 28 63 61 6e 76 61 73 29 0a 09 09 09 09 28 a (canvas).....(
2460: 73 65 74 2d 66 69 6e 61 6c 69 7a 65 72 21 20 28 set-finalizer! (
2470: 73 61 76 65 2d 73 74 61 74 65 20 63 61 6e 76 61 save-state canva
2480: 73 29 20 72 65 6c 65 61 73 65 2d 73 74 61 74 65 s) release-state
2490: 21 29 29 0a 09 09 09 63 61 6e 76 61 73 2d 73 74 !))....canvas-st
24a0: 61 74 65 2d 73 65 74 21 29 29 29 0a 0a 28 64 65 ate-set!)))..(de
24b0: 66 69 6e 65 20 63 61 6e 76 61 73 2d 63 6c 65 61 fine canvas-clea
24c0: 72 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d r!..(foreign-lam
24d0: 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e 76 bda void "cdCanv
24e0: 61 73 43 6c 65 61 72 22 20 6e 6f 6e 6e 75 6c 6c asClear" nonnull
24f0: 2d 63 61 6e 76 61 73 29 29 0a 0a 28 64 65 66 69 -canvas))..(defi
2500: 6e 65 20 63 61 6e 76 61 73 2d 66 6c 75 73 68 0a ne canvas-flush.
2510: 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 .(foreign-lambda
2520: 20 76 6f 69 64 20 22 63 64 43 61 6e 76 61 73 46 void "cdCanvasF
2530: 6c 75 73 68 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 lush" nonnull-ca
2540: 6e 76 61 73 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a nvas))..;; }}}..
2550: 3b 3b 20 7b 7b 7b 20 43 6f 6f 72 64 69 6e 61 74 ;; {{{ Coordinat
2560: 65 20 73 79 73 74 65 6d 0a 0a 28 64 65 66 69 6e e system..(defin
2570: 65 20 63 61 6e 76 61 73 2d 73 69 7a 65 0a 09 28 e canvas-size..(
2580: 6c 65 74 72 65 63 20 28 5b 63 61 6e 76 61 73 2d letrec ([canvas-
2590: 73 69 7a 65 2f 72 61 77 20 28 66 6f 72 65 69 67 size/raw (foreig
25a0: 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 n-lambda void "c
25b0: 64 43 61 6e 76 61 73 47 65 74 53 69 7a 65 22 20 dCanvasGetSize"
25c0: 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 28 nonnull-canvas (
25d0: 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 c-pointer int) (
25e0: 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 c-pointer int) (
25f0: 63 2d 70 6f 69 6e 74 65 72 20 64 6f 75 62 6c 65 c-pointer double
2600: 29 20 28 63 2d 70 6f 69 6e 74 65 72 20 64 6f 75 ) (c-pointer dou
2610: 62 6c 65 29 29 5d 29 0a 09 09 28 6c 61 6d 62 64 ble))])...(lambd
2620: 61 20 28 63 61 6e 76 61 73 29 0a 09 09 09 28 6c a (canvas)....(l
2630: 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 28 5b 77 69 et-location ([wi
2640: 64 74 68 2f 70 78 20 69 6e 74 20 30 5d 20 5b 68 dth/px int 0] [h
2650: 65 69 67 68 74 2f 70 78 20 69 6e 74 20 30 5d 0a eight/px int 0].
2660: 09 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 ...
2670: 20 20 5b 77 69 64 74 68 2f 6d 6d 20 64 6f 75 62 [width/mm doub
2680: 6c 65 20 30 5d 20 5b 68 65 69 67 68 74 2f 6d 6d le 0] [height/mm
2690: 20 64 6f 75 62 6c 65 20 30 5d 29 0a 09 09 09 20 double 0])....
26a0: 20 28 63 61 6e 76 61 73 2d 73 69 7a 65 2f 72 61 (canvas-size/ra
26b0: 77 0a 09 09 09 20 20 09 63 61 6e 76 61 73 0a 09 w.... .canvas..
26c0: 09 09 20 20 09 28 6c 6f 63 61 74 69 6f 6e 20 77 .. .(location w
26d0: 69 64 74 68 2f 70 78 29 20 28 6c 6f 63 61 74 69 idth/px) (locati
26e0: 6f 6e 20 68 65 69 67 68 74 2f 70 78 29 0a 09 09 on height/px)...
26f0: 09 20 20 09 28 6c 6f 63 61 74 69 6f 6e 20 77 69 . .(location wi
2700: 64 74 68 2f 6d 6d 29 20 28 6c 6f 63 61 74 69 6f dth/mm) (locatio
2710: 6e 20 68 65 69 67 68 74 2f 6d 6d 29 29 0a 09 09 n height/mm))...
2720: 09 20 20 28 76 61 6c 75 65 73 0a 09 09 09 20 20 . (values....
2730: 09 77 69 64 74 68 2f 70 78 20 68 65 69 67 68 74 .width/px height
2740: 2f 70 78 0a 09 09 09 20 20 09 77 69 64 74 68 2f /px.... .width/
2750: 6d 6d 20 68 65 69 67 68 74 2f 6d 6d 29 29 29 29 mm height/mm))))
2760: 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 )..(define canva
2770: 73 2d 6d 6d 2d 3e 70 78 0a 09 28 6c 65 74 72 65 s-mm->px..(letre
2780: 63 20 28 5b 63 61 6e 76 61 73 2d 6d 6d 2d 3e 70 c ([canvas-mm->p
2790: 78 2f 72 61 77 20 28 66 6f 72 65 69 67 6e 2d 6c x/raw (foreign-l
27a0: 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 ambda void "cdCa
27b0: 6e 76 61 73 4d 4d 32 50 69 78 65 6c 22 20 6e 6f nvasMM2Pixel" no
27c0: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 64 6f 75 nnull-canvas dou
27d0: 62 6c 65 20 64 6f 75 62 6c 65 20 28 63 2d 70 6f ble double (c-po
27e0: 69 6e 74 65 72 20 69 6e 74 29 20 28 63 2d 70 6f inter int) (c-po
27f0: 69 6e 74 65 72 20 69 6e 74 29 29 5d 29 0a 09 09 inter int))])...
2800: 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 (lambda (canvas
2810: 78 2f 6d 6d 20 79 2f 6d 6d 29 0a 09 09 09 28 6c x/mm y/mm)....(l
2820: 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 28 5b 78 2f et-location ([x/
2830: 70 78 20 69 6e 74 20 30 5d 20 5b 79 2f 70 78 20 px int 0] [y/px
2840: 69 6e 74 20 30 5d 29 0a 09 09 09 09 28 63 61 6e int 0]).....(can
2850: 76 61 73 2d 6d 6d 2d 3e 70 78 2f 72 61 77 20 63 vas-mm->px/raw c
2860: 61 6e 76 61 73 20 78 2f 6d 6d 20 79 2f 6d 6d 20 anvas x/mm y/mm
2870: 28 6c 6f 63 61 74 69 6f 6e 20 78 2f 70 78 29 20 (location x/px)
2880: 28 6c 6f 63 61 74 69 6f 6e 20 79 2f 70 78 29 29 (location y/px))
2890: 0a 09 09 09 09 28 76 61 6c 75 65 73 20 78 2f 70 .....(values x/p
28a0: 78 20 79 2f 70 78 29 29 29 29 29 0a 0a 28 64 65 x y/px)))))..(de
28b0: 66 69 6e 65 20 63 61 6e 76 61 73 2d 70 78 2d 3e fine canvas-px->
28c0: 6d 6d 0a 09 28 6c 65 74 72 65 63 20 28 5b 63 61 mm..(letrec ([ca
28d0: 6e 76 61 73 2d 6d 6d 2d 3e 70 78 2f 72 61 77 20 nvas-mm->px/raw
28e0: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 (foreign-lambda
28f0: 76 6f 69 64 20 22 63 64 43 61 6e 76 61 73 50 69 void "cdCanvasPi
2900: 78 65 6c 32 4d 4d 22 20 6e 6f 6e 6e 75 6c 6c 2d xel2MM" nonnull-
2910: 63 61 6e 76 61 73 20 69 6e 74 20 69 6e 74 20 28 canvas int int (
2920: 63 2d 70 6f 69 6e 74 65 72 20 64 6f 75 62 6c 65 c-pointer double
2930: 29 20 28 63 2d 70 6f 69 6e 74 65 72 20 64 6f 75 ) (c-pointer dou
2940: 62 6c 65 29 29 5d 29 0a 09 09 28 6c 61 6d 62 64 ble))])...(lambd
2950: 61 20 28 63 61 6e 76 61 73 20 78 2f 70 78 20 79 a (canvas x/px y
2960: 2f 70 78 29 0a 09 09 09 28 6c 65 74 2d 6c 6f 63 /px)....(let-loc
2970: 61 74 69 6f 6e 20 28 5b 78 2f 6d 6d 20 64 6f 75 ation ([x/mm dou
2980: 62 6c 65 20 2b 6e 61 6e 2e 30 5d 20 5b 79 2f 6d ble +nan.0] [y/m
2990: 6d 20 64 6f 75 62 6c 65 20 2b 6e 61 6e 2e 30 5d m double +nan.0]
29a0: 29 0a 09 09 09 09 28 63 61 6e 76 61 73 2d 6d 6d ).....(canvas-mm
29b0: 2d 3e 70 78 2f 72 61 77 20 63 61 6e 76 61 73 20 ->px/raw canvas
29c0: 78 2f 70 78 20 79 2f 70 78 20 28 6c 6f 63 61 74 x/px y/px (locat
29d0: 69 6f 6e 20 78 2f 6d 6d 29 20 28 6c 6f 63 61 74 ion x/mm) (locat
29e0: 69 6f 6e 20 79 2f 6d 6d 29 29 0a 09 09 09 09 28 ion y/mm)).....(
29f0: 76 61 6c 75 65 73 20 78 2f 6d 6d 20 79 2f 6d 6d values x/mm y/mm
2a00: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 )))))..(define c
2a10: 61 6e 76 61 73 2d 6f 72 69 67 69 6e 2d 73 65 74 anvas-origin-set
2a20: 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 !..(foreign-lamb
2a30: 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e 76 61 da void "cdCanva
2a40: 73 4f 72 69 67 69 6e 22 20 6e 6f 6e 6e 75 6c 6c sOrigin" nonnull
2a50: 2d 63 61 6e 76 61 73 20 69 6e 74 20 69 6e 74 29 -canvas int int)
2a60: 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 )..(define canva
2a70: 73 2d 6f 72 69 67 69 6e 0a 09 28 6c 65 74 72 65 s-origin..(letre
2a80: 63 20 28 5b 63 61 6e 76 61 73 2d 6f 72 69 67 69 c ([canvas-origi
2a90: 6e 2f 72 61 77 20 28 66 6f 72 65 69 67 6e 2d 6c n/raw (foreign-l
2aa0: 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 ambda void "cdCa
2ab0: 6e 76 61 73 47 65 74 4f 72 69 67 69 6e 22 20 6e nvasGetOrigin" n
2ac0: 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 28 63 onnull-canvas (c
2ad0: 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 63 -pointer int) (c
2ae0: 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 29 5d 29 -pointer int))])
2af0: 0a 09 09 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 ...(lambda (canv
2b00: 61 73 29 0a 09 09 09 28 6c 65 74 2d 6c 6f 63 61 as)....(let-loca
2b10: 74 69 6f 6e 20 28 5b 78 20 69 6e 74 20 30 5d 20 tion ([x int 0]
2b20: 5b 79 20 69 6e 74 20 30 5d 29 0a 09 09 09 09 28 [y int 0]).....(
2b30: 63 61 6e 76 61 73 2d 6f 72 69 67 69 6e 2f 72 61 canvas-origin/ra
2b40: 77 20 63 61 6e 76 61 73 20 28 6c 6f 63 61 74 69 w canvas (locati
2b50: 6f 6e 20 78 29 20 28 6c 6f 63 61 74 69 6f 6e 20 on x) (location
2b60: 79 29 29 0a 09 09 09 09 28 76 61 6c 75 65 73 20 y)).....(values
2b70: 78 20 79 29 29 29 29 29 0a 0a 28 64 65 66 69 6e x y)))))..(defin
2b80: 65 20 28 74 72 61 6e 73 66 6f 72 6d 2d 3e 66 36 e (transform->f6
2b90: 34 76 65 63 74 6f 72 20 70 72 6f 63 29 0a 09 28 4vector proc)..(
2ba0: 6c 65 74 20 28 5b 76 20 28 6d 61 6b 65 2d 66 36 let ([v (make-f6
2bb0: 34 76 65 63 74 6f 72 20 36 29 5d 29 0a 09 09 28 4vector 6)])...(
2bc0: 6c 65 74 2d 76 61 6c 75 65 73 20 28 5b 28 64 78 let-values ([(dx
2bd0: 20 64 79 29 20 28 70 72 6f 63 20 30 20 30 29 5d dy) (proc 0 0)]
2be0: 29 0a 09 09 09 28 66 36 34 76 65 63 74 6f 72 2d )....(f64vector-
2bf0: 73 65 74 21 20 76 20 34 20 64 78 29 0a 09 09 09 set! v 4 dx)....
2c00: 28 66 36 34 76 65 63 74 6f 72 2d 73 65 74 21 20 (f64vector-set!
2c10: 76 20 35 20 64 79 29 0a 09 09 09 28 6c 65 74 2d v 5 dy)....(let-
2c20: 76 61 6c 75 65 73 20 28 5b 28 78 20 79 29 20 28 values ([(x y) (
2c30: 70 72 6f 63 20 31 20 30 29 5d 29 0a 09 09 09 09 proc 1 0)]).....
2c40: 28 66 36 34 76 65 63 74 6f 72 2d 73 65 74 21 20 (f64vector-set!
2c50: 76 20 30 20 28 2d 20 78 20 64 78 29 29 0a 09 09 v 0 (- x dx))...
2c60: 09 09 28 66 36 34 76 65 63 74 6f 72 2d 73 65 74 ..(f64vector-set
2c70: 21 20 76 20 31 20 28 2d 20 79 20 64 79 29 29 29 ! v 1 (- y dy)))
2c80: 0a 09 09 09 28 6c 65 74 2d 76 61 6c 75 65 73 20 ....(let-values
2c90: 28 5b 28 78 20 79 29 20 28 70 72 6f 63 20 30 20 ([(x y) (proc 0
2ca0: 31 29 5d 29 0a 09 09 09 09 28 66 36 34 76 65 63 1)]).....(f64vec
2cb0: 74 6f 72 2d 73 65 74 21 20 76 20 32 20 28 2d 20 tor-set! v 2 (-
2cc0: 78 20 64 78 29 29 0a 09 09 09 09 28 66 36 34 76 x dx)).....(f64v
2cd0: 65 63 74 6f 72 2d 73 65 74 21 20 76 20 33 20 28 ector-set! v 3 (
2ce0: 2d 20 79 20 64 79 29 29 29 29 0a 09 09 76 29 29 - y dy))))...v))
2cf0: 0a 0a 28 64 65 66 69 6e 65 20 28 28 66 36 34 76 ..(define ((f64v
2d00: 65 63 74 6f 72 2d 3e 74 72 61 6e 73 66 6f 72 6d ector->transform
2d10: 20 76 29 20 78 20 79 29 0a 09 28 76 61 6c 75 65 v) x y)..(value
2d20: 73 0a 09 09 28 2b 20 28 2a 20 28 66 36 34 76 65 s...(+ (* (f64ve
2d30: 63 74 6f 72 2d 72 65 66 20 76 20 30 29 20 78 29 ctor-ref v 0) x)
2d40: 20 28 2a 20 28 66 36 34 76 65 63 74 6f 72 2d 72 (* (f64vector-r
2d50: 65 66 20 76 20 32 29 20 79 29 20 28 66 36 34 76 ef v 2) y) (f64v
2d60: 65 63 74 6f 72 2d 72 65 66 20 76 20 34 29 29 0a ector-ref v 4)).
2d70: 09 09 28 2b 20 28 2a 20 28 66 36 34 76 65 63 74 ..(+ (* (f64vect
2d80: 6f 72 2d 72 65 66 20 76 20 31 29 20 78 29 20 28 or-ref v 1) x) (
2d90: 2a 20 28 66 36 34 76 65 63 74 6f 72 2d 72 65 66 * (f64vector-ref
2da0: 20 76 20 33 29 20 79 29 20 28 66 36 34 76 65 63 v 3) y) (f64vec
2db0: 74 6f 72 2d 72 65 66 20 76 20 35 29 29 29 29 0a tor-ref v 5)))).
2dc0: 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d .(define canvas-
2dd0: 74 72 61 6e 73 66 6f 72 6d 2d 73 65 74 21 0a 09 transform-set!..
2de0: 28 6c 65 74 72 65 63 20 28 5b 63 61 6e 76 61 73 (letrec ([canvas
2df0: 2d 74 72 61 6e 73 66 6f 72 6d 2d 73 65 74 2f 72 -transform-set/r
2e00: 61 77 21 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d aw! (foreign-lam
2e10: 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e 76 bda void "cdCanv
2e20: 61 73 54 72 61 6e 73 66 6f 72 6d 22 20 6e 6f 6e asTransform" non
2e30: 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 66 36 34 76 null-canvas f64v
2e40: 65 63 74 6f 72 29 5d 29 0a 09 09 28 6c 61 6d 62 ector)])...(lamb
2e50: 64 61 20 28 63 61 6e 76 61 73 20 70 72 6f 63 29 da (canvas proc)
2e60: 0a 09 09 09 28 63 61 6e 76 61 73 2d 74 72 61 6e ....(canvas-tran
2e70: 73 66 6f 72 6d 2d 73 65 74 2f 72 61 77 21 20 63 sform-set/raw! c
2e80: 61 6e 76 61 73 20 28 61 6e 64 20 70 72 6f 63 20 anvas (and proc
2e90: 28 74 72 61 6e 73 66 6f 72 6d 2d 3e 66 36 34 76 (transform->f64v
2ea0: 65 63 74 6f 72 20 70 72 6f 63 29 29 29 29 29 29 ector proc))))))
2eb0: 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 ..(define canvas
2ec0: 2d 74 72 61 6e 73 66 6f 72 6d 0a 09 28 6c 65 74 -transform..(let
2ed0: 72 65 63 20 28 5b 63 61 6e 76 61 73 2d 74 72 61 rec ([canvas-tra
2ee0: 6e 73 66 6f 72 6d 2f 72 61 77 0a 09 20 20 20 20 nsform/raw..
2ef0: 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c (foreign-l
2f00: 61 6d 62 64 61 2a 20 62 6f 6f 6c 20 28 5b 6e 6f ambda* bool ([no
2f10: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e nnull-canvas can
2f20: 76 61 73 5d 20 5b 6e 6f 6e 6e 75 6c 6c 2d 66 36 vas] [nonnull-f6
2f30: 34 76 65 63 74 6f 72 20 76 5d 29 0a 09 20 20 20 4vector v])..
2f40: 20 20 20 20 20 20 20 09 22 64 6f 75 62 6c 65 20 ."double
2f50: 2a 77 20 3d 20 63 64 43 61 6e 76 61 73 47 65 74 *w = cdCanvasGet
2f60: 54 72 61 6e 73 66 6f 72 6d 28 63 61 6e 76 61 73 Transform(canvas
2f70: 29 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 );\n"..
2f80: 20 09 22 69 66 20 28 77 29 20 6d 65 6d 63 70 79 ."if (w) memcpy
2f90: 28 76 2c 20 77 2c 20 36 20 2a 20 73 69 7a 65 6f (v, w, 6 * sizeo
2fa0: 66 28 64 6f 75 62 6c 65 29 29 3b 5c 6e 22 0a 09 f(double));\n"..
2fb0: 20 20 20 20 20 20 20 20 20 20 09 22 43 5f 72 65 ."C_re
2fc0: 74 75 72 6e 28 77 29 3b 22 29 5d 29 0a 09 09 28 turn(w);")])...(
2fd0: 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 74 74 getter-with-sett
2fe0: 65 72 0a 09 09 09 28 6c 61 6d 62 64 61 20 28 63 er....(lambda (c
2ff0: 61 6e 76 61 73 29 0a 09 09 09 09 28 6c 65 74 20 anvas).....(let
3000: 28 5b 76 20 28 6d 61 6b 65 2d 66 36 34 76 65 63 ([v (make-f64vec
3010: 74 6f 72 20 36 29 5d 29 0a 09 09 09 09 09 28 61 tor 6)])......(a
3020: 6e 64 20 28 63 61 6e 76 61 73 2d 74 72 61 6e 73 nd (canvas-trans
3030: 66 6f 72 6d 2f 72 61 77 20 63 61 6e 76 61 73 20 form/raw canvas
3040: 76 29 20 28 66 36 34 76 65 63 74 6f 72 2d 3e 74 v) (f64vector->t
3050: 72 61 6e 73 66 6f 72 6d 20 76 29 29 29 29 0a 09 ransform v))))..
3060: 09 09 63 61 6e 76 61 73 2d 74 72 61 6e 73 66 6f ..canvas-transfo
3070: 72 6d 2d 73 65 74 21 29 29 29 0a 0a 28 64 65 66 rm-set!)))..(def
3080: 69 6e 65 20 63 61 6e 76 61 73 2d 74 72 61 6e 73 ine canvas-trans
3090: 66 6f 72 6d 2d 63 6f 6d 70 6f 73 65 21 0a 09 28 form-compose!..(
30a0: 6c 65 74 72 65 63 20 28 5b 63 61 6e 76 61 73 2d letrec ([canvas-
30b0: 74 72 61 6e 73 66 6f 72 6d 2d 63 6f 6d 70 6f 73 transform-compos
30c0: 65 2f 72 61 77 21 20 28 66 6f 72 65 69 67 6e 2d e/raw! (foreign-
30d0: 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 lambda void "cdC
30e0: 61 6e 76 61 73 54 72 61 6e 73 66 6f 72 6d 4d 75 anvasTransformMu
30f0: 6c 74 69 70 6c 79 22 20 6e 6f 6e 6e 75 6c 6c 2d ltiply" nonnull-
3100: 63 61 6e 76 61 73 20 6e 6f 6e 6e 75 6c 6c 2d 66 canvas nonnull-f
3110: 36 34 76 65 63 74 6f 72 29 5d 29 0a 09 09 28 6c 64vector)])...(l
3120: 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 70 72 ambda (canvas pr
3130: 6f 63 29 0a 09 09 09 28 63 61 6e 76 61 73 2d 74 oc)....(canvas-t
3140: 72 61 6e 73 66 6f 72 6d 2d 63 6f 6d 70 6f 73 65 ransform-compose
3150: 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 74 72 /raw! canvas (tr
3160: 61 6e 73 66 6f 72 6d 2d 3e 66 36 34 76 65 63 74 ansform->f64vect
3170: 6f 72 20 70 72 6f 63 29 29 29 29 29 0a 0a 28 64 or proc)))))..(d
3180: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 74 72 61 efine canvas-tra
3190: 6e 73 66 6f 72 6d 2d 74 72 61 6e 73 6c 61 74 65 nsform-translate
31a0: 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 !..(foreign-lamb
31b0: 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e 76 61 da void "cdCanva
31c0: 73 54 72 61 6e 73 66 6f 72 6d 54 72 61 6e 73 6c sTransformTransl
31d0: 61 74 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e ate" nonnull-can
31e0: 76 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c vas double doubl
31f0: 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e e))..(define can
3200: 76 61 73 2d 74 72 61 6e 73 66 6f 72 6d 2d 73 63 vas-transform-sc
3210: 61 6c 65 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c ale!..(foreign-l
3220: 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 ambda void "cdCa
3230: 6e 76 61 73 54 72 61 6e 73 66 6f 72 6d 53 63 61 nvasTransformSca
3240: 6c 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 le" nonnull-canv
3250: 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 as double double
3260: 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 ))..(define canv
3270: 61 73 2d 74 72 61 6e 73 66 6f 72 6d 2d 72 6f 74 as-transform-rot
3280: 61 74 65 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c ate!..(foreign-l
3290: 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 ambda void "cdCa
32a0: 6e 76 61 73 54 72 61 6e 73 66 6f 72 6d 52 6f 74 nvasTransformRot
32b0: 61 74 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e ate" nonnull-can
32c0: 76 61 73 20 64 6f 75 62 6c 65 29 29 0a 0a 3b 3b vas double))..;;
32d0: 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 47 65 6e }}}..;; {{{ Gen
32e0: 65 72 61 6c 20 61 74 74 72 69 62 75 74 65 73 0a eral attributes.
32f0: 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d .(define canvas-
3300: 66 6f 72 65 67 72 6f 75 6e 64 2d 73 65 74 21 0a foreground-set!.
3310: 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 .(foreign-lambda
3320: 20 76 6f 69 64 20 22 63 64 43 61 6e 76 61 73 53 void "cdCanvasS
3330: 65 74 46 6f 72 65 67 72 6f 75 6e 64 22 20 6e 6f etForeground" no
3340: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 75 6e 73 nnull-canvas uns
3350: 69 67 6e 65 64 2d 6c 6f 6e 67 29 29 0a 0a 28 64 igned-long))..(d
3360: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 66 6f 72 efine canvas-for
3370: 65 67 72 6f 75 6e 64 0a 09 28 67 65 74 74 65 72 eground..(getter
3380: 2d 77 69 74 68 2d 73 65 74 74 65 72 0a 09 09 28 -with-setter...(
3390: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 foreign-lambda*
33a0: 75 6e 73 69 67 6e 65 64 2d 6c 6f 6e 67 20 28 5b unsigned-long ([
33b0: 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 nonnull-canvas c
33c0: 61 6e 76 61 73 5d 29 0a 09 09 09 22 43 5f 72 65 anvas])...."C_re
33d0: 74 75 72 6e 28 63 64 43 61 6e 76 61 73 46 6f 72 turn(cdCanvasFor
33e0: 65 67 72 6f 75 6e 64 28 63 61 6e 76 61 73 2c 20 eground(canvas,
33f0: 43 44 5f 51 55 45 52 59 29 29 3b 22 29 0a 09 09 CD_QUERY));")...
3400: 63 61 6e 76 61 73 2d 66 6f 72 65 67 72 6f 75 6e canvas-foregroun
3410: 64 2d 73 65 74 21 29 29 0a 0a 28 64 65 66 69 6e d-set!))..(defin
3420: 65 20 63 61 6e 76 61 73 2d 62 61 63 6b 67 72 6f e canvas-backgro
3430: 75 6e 64 2d 73 65 74 21 0a 09 28 66 6f 72 65 69 und-set!..(forei
3440: 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 gn-lambda void "
3450: 63 64 43 61 6e 76 61 73 53 65 74 42 61 63 6b 67 cdCanvasSetBackg
3460: 72 6f 75 6e 64 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 round" nonnull-c
3470: 61 6e 76 61 73 20 75 6e 73 69 67 6e 65 64 2d 6c anvas unsigned-l
3480: 6f 6e 67 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 ong))..(define c
3490: 61 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 anvas-background
34a0: 0a 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 ..(getter-with-s
34b0: 65 74 74 65 72 0a 09 09 28 66 6f 72 65 69 67 6e etter...(foreign
34c0: 2d 6c 61 6d 62 64 61 2a 20 75 6e 73 69 67 6e 65 -lambda* unsigne
34d0: 64 2d 6c 6f 6e 67 20 28 5b 6e 6f 6e 6e 75 6c 6c d-long ([nonnull
34e0: 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 -canvas canvas])
34f0: 0a 09 09 09 22 43 5f 72 65 74 75 72 6e 28 63 64 ...."C_return(cd
3500: 43 61 6e 76 61 73 42 61 63 6b 67 72 6f 75 6e 64 CanvasBackground
3510: 28 63 61 6e 76 61 73 2c 20 43 44 5f 51 55 45 52 (canvas, CD_QUER
3520: 59 29 29 3b 22 29 0a 09 09 63 61 6e 76 61 73 2d Y));")...canvas-
3530: 62 61 63 6b 67 72 6f 75 6e 64 2d 73 65 74 21 29 background-set!)
3540: 29 0a 0a 28 64 65 66 69 6e 65 2d 76 61 6c 75 65 )..(define-value
3550: 73 20 28 63 61 6e 76 61 73 2d 77 72 69 74 65 2d s (canvas-write-
3560: 6d 6f 64 65 20 63 61 6e 76 61 73 2d 77 72 69 74 mode canvas-writ
3570: 65 2d 6d 6f 64 65 2d 73 65 74 21 29 0a 09 28 6c e-mode-set!)..(l
3580: 65 74 72 65 63 20 28 5b 77 72 69 74 65 2d 6d 6f etrec ([write-mo
3590: 64 65 73 0a 09 20 20 20 20 20 20 20 20 20 20 28 des.. (
35a0: 6c 69 73 74 0a 09 20 20 20 20 20 20 20 20 20 20 list..
35b0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
35c0: 20 20 09 09 27 72 65 70 6c 61 63 65 0a 09 20 20 ..'replace..
35d0: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
35e0: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 52 45 50 gn-value "CD_REP
35f0: 4c 41 43 45 22 20 69 6e 74 29 29 0a 09 20 20 20 LACE" int))..
3600: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
3610: 20 20 20 20 20 20 20 20 20 09 09 27 78 6f 72 0a ..'xor.
3620: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
3630: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
3640: 58 4f 52 22 20 69 6e 74 29 29 0a 09 20 20 20 20 XOR" int))..
3650: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
3660: 20 20 20 20 20 20 20 20 09 09 27 6e 6f 74 2d 78 ..'not-x
3670: 6f 72 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 or.. ..
3680: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
3690: 43 44 5f 4e 4f 54 5f 58 4f 52 22 20 69 6e 74 29 CD_NOT_XOR" int)
36a0: 29 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 ))].. [c
36b0: 61 6e 76 61 73 2d 77 72 69 74 65 2d 6d 6f 64 65 anvas-write-mode
36c0: 2d 73 65 74 2f 72 61 77 21 0a 09 20 20 20 20 20 -set/raw!..
36d0: 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 (foreign-la
36e0: 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e mbda void "cdCan
36f0: 76 61 73 57 72 69 74 65 4d 6f 64 65 22 20 6e 6f vasWriteMode" no
3700: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 69 6e 74 nnull-canvas int
3710: 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 )].. [ca
3720: 6e 76 61 73 2d 77 72 69 74 65 2d 6d 6f 64 65 2d nvas-write-mode-
3730: 73 65 74 21 0a 09 20 20 20 20 20 20 20 20 20 20 set!..
3740: 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 (lambda (canvas
3750: 77 72 69 74 65 2d 6d 6f 64 65 29 0a 09 20 20 20 write-mode)..
3760: 20 20 20 20 20 20 20 09 28 63 61 6e 76 61 73 2d .(canvas-
3770: 77 72 69 74 65 2d 6d 6f 64 65 2d 73 65 74 2f 72 write-mode-set/r
3780: 61 77 21 0a 09 20 20 20 20 20 20 20 20 20 20 09 aw!.. .
3790: 09 63 61 6e 76 61 73 0a 09 20 20 20 20 20 20 20 .canvas..
37a0: 20 20 20 09 09 28 63 6f 6e 64 0a 09 20 20 20 20 ..(cond..
37b0: 20 20 20 20 20 20 09 09 09 5b 28 61 73 73 71 20 ...[(assq
37c0: 77 72 69 74 65 2d 6d 6f 64 65 20 77 72 69 74 65 write-mode write
37d0: 2d 6d 6f 64 65 73 29 20 3d 3e 20 63 64 72 5d 0a -modes) => cdr].
37e0: 09 20 20 20 20 20 20 20 20 20 20 09 09 09 5b 65 . ...[e
37f0: 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e 76 lse (error 'canv
3800: 61 73 2d 77 72 69 74 65 2d 6d 6f 64 65 2d 73 65 as-write-mode-se
3810: 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 77 72 69 74 t! "unknown writ
3820: 65 20 6d 6f 64 65 22 20 77 72 69 74 65 2d 6d 6f e mode" write-mo
3830: 64 65 29 5d 29 29 29 5d 0a 09 20 20 20 20 20 20 de)])))]..
3840: 20 20 20 5b 63 61 6e 76 61 73 2d 77 72 69 74 65 [canvas-write
3850: 2d 6d 6f 64 65 2f 72 61 77 0a 09 20 20 20 20 20 -mode/raw..
3860: 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 (foreign-la
3870: 6d 62 64 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e mbda* int ([nonn
3880: 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 ull-canvas canva
3890: 73 5d 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 s]).. .
38a0: 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 "C_return(cdCanv
38b0: 61 73 57 72 69 74 65 4d 6f 64 65 28 63 61 6e 76 asWriteMode(canv
38c0: 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 as, CD_QUERY));"
38d0: 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 )].. [ca
38e0: 6e 76 61 73 2d 77 72 69 74 65 2d 6d 6f 64 65 0a nvas-write-mode.
38f0: 09 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 . (lamb
3900: 64 61 20 28 63 61 6e 76 61 73 29 0a 09 20 20 20 da (canvas)..
3910: 20 20 20 20 20 20 20 09 28 6c 65 74 20 28 5b 77 .(let ([w
3920: 72 69 74 65 2d 6d 6f 64 65 20 28 63 61 6e 76 61 rite-mode (canva
3930: 73 2d 77 72 69 74 65 2d 6d 6f 64 65 2f 72 61 77 s-write-mode/raw
3940: 20 63 61 6e 76 61 73 29 5d 29 0a 09 20 20 20 20 canvas)])..
3950: 20 20 20 20 20 20 09 09 28 63 6f 6e 64 0a 09 20 ..(cond..
3960: 20 20 20 20 20 20 20 20 20 09 09 09 5b 28 72 61 ...[(ra
3970: 73 73 6f 63 20 77 72 69 74 65 2d 6d 6f 64 65 20 ssoc write-mode
3980: 77 72 69 74 65 2d 6d 6f 64 65 73 29 20 3d 3e 20 write-modes) =>
3990: 63 61 72 5d 0a 09 20 20 20 20 20 20 20 20 20 20 car]..
39a0: 09 09 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 ...[else (error
39b0: 27 63 61 6e 76 61 73 2d 77 72 69 74 65 2d 6d 6f 'canvas-write-mo
39c0: 64 65 20 22 75 6e 6b 6e 6f 77 6e 20 77 72 69 74 de "unknown writ
39d0: 65 20 6d 6f 64 65 22 20 77 72 69 74 65 2d 6d 6f e mode" write-mo
39e0: 64 65 29 5d 29 29 29 5d 29 0a 09 20 20 28 76 61 de)])))]).. (va
39f0: 6c 75 65 73 0a 09 20 20 09 28 67 65 74 74 65 72 lues.. .(getter
3a00: 2d 77 69 74 68 2d 73 65 74 74 65 72 20 63 61 6e -with-setter can
3a10: 76 61 73 2d 77 72 69 74 65 2d 6d 6f 64 65 20 63 vas-write-mode c
3a20: 61 6e 76 61 73 2d 77 72 69 74 65 2d 6d 6f 64 65 anvas-write-mode
3a30: 2d 73 65 74 21 29 0a 09 20 20 09 63 61 6e 76 61 -set!).. .canva
3a40: 73 2d 77 72 69 74 65 2d 6d 6f 64 65 2d 73 65 74 s-write-mode-set
3a50: 21 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b !)))..;; }}}..;;
3a60: 20 7b 7b 7b 20 43 6c 69 70 70 69 6e 67 0a 0a 28 {{{ Clipping..(
3a70: 64 65 66 69 6e 65 2d 76 61 6c 75 65 73 20 28 63 define-values (c
3a80: 61 6e 76 61 73 2d 63 6c 69 70 2d 6d 6f 64 65 20 anvas-clip-mode
3a90: 63 61 6e 76 61 73 2d 63 6c 69 70 2d 6d 6f 64 65 canvas-clip-mode
3aa0: 2d 73 65 74 21 29 0a 09 28 6c 65 74 72 65 63 20 -set!)..(letrec
3ab0: 28 5b 63 6c 69 70 2d 6d 6f 64 65 73 0a 09 20 20 ([clip-modes..
3ac0: 20 20 20 20 20 20 20 20 28 6c 69 73 74 0a 09 20 (list..
3ad0: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
3ae0: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 61 72 . ..'ar
3af0: 65 61 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ea.. ..
3b00: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
3b10: 43 44 5f 43 4c 49 50 41 52 45 41 22 20 69 6e 74 CD_CLIPAREA" int
3b20: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
3b30: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
3b40: 09 09 27 70 6f 6c 79 67 6f 6e 0a 09 20 20 20 20 ..'polygon..
3b50: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
3b60: 2d 76 61 6c 75 65 20 22 43 44 5f 43 4c 49 50 50 -value "CD_CLIPP
3b70: 4f 4c 59 47 4f 4e 22 20 69 6e 74 29 29 0a 09 20 OLYGON" int))..
3b80: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
3b90: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 72 65 . ..'re
3ba0: 67 69 6f 6e 0a 09 20 20 20 20 20 20 20 20 20 20 gion..
3bb0: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
3bc0: 20 22 43 44 5f 43 4c 49 50 52 45 47 49 4f 4e 22 "CD_CLIPREGION"
3bd0: 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 int))..
3be0: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
3bf0: 20 20 20 20 09 09 23 66 0a 09 20 20 20 20 20 20 ..#f..
3c00: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
3c10: 61 6c 75 65 20 22 43 44 5f 43 4c 49 50 4f 46 46 alue "CD_CLIPOFF
3c20: 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 " int)))]..
3c30: 20 20 20 20 5b 63 61 6e 76 61 73 2d 63 6c 69 70 [canvas-clip
3c40: 2d 6d 6f 64 65 2d 73 65 74 2f 72 61 77 21 0a 09 -mode-set/raw!..
3c50: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 (forei
3c60: 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 gn-lambda void "
3c70: 63 64 43 61 6e 76 61 73 43 6c 69 70 22 20 6e 6f cdCanvasClip" no
3c80: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 69 6e 74 nnull-canvas int
3c90: 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 )].. [ca
3ca0: 6e 76 61 73 2d 63 6c 69 70 2d 6d 6f 64 65 2d 73 nvas-clip-mode-s
3cb0: 65 74 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 et!.. (
3cc0: 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 63 lambda (canvas c
3cd0: 6c 69 70 2d 6d 6f 64 65 29 0a 09 20 20 20 20 20 lip-mode)..
3ce0: 20 20 20 20 20 09 28 63 61 6e 76 61 73 2d 63 6c .(canvas-cl
3cf0: 69 70 2d 6d 6f 64 65 2d 73 65 74 2f 72 61 77 21 ip-mode-set/raw!
3d00: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 63 61 .. ..ca
3d10: 6e 76 61 73 0a 09 20 20 20 20 20 20 20 20 20 20 nvas..
3d20: 09 09 28 63 6f 6e 64 0a 09 20 20 20 20 20 20 20 ..(cond..
3d30: 20 20 20 09 09 09 5b 28 61 73 73 71 20 63 6c 69 ...[(assq cli
3d40: 70 2d 6d 6f 64 65 20 63 6c 69 70 2d 6d 6f 64 65 p-mode clip-mode
3d50: 73 29 20 3d 3e 20 63 64 72 5d 0a 09 20 20 20 20 s) => cdr]..
3d60: 20 20 20 20 20 20 09 09 09 5b 65 6c 73 65 20 28 ...[else (
3d70: 65 72 72 6f 72 20 27 63 61 6e 76 61 73 2d 63 6c error 'canvas-cl
3d80: 69 70 2d 6d 6f 64 65 2d 73 65 74 21 20 22 75 6e ip-mode-set! "un
3d90: 6b 6e 6f 77 6e 20 63 6c 69 70 20 6d 6f 64 65 22 known clip mode"
3da0: 20 63 6c 69 70 2d 6d 6f 64 65 29 5d 29 29 29 5d clip-mode)])))]
3db0: 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 .. [canv
3dc0: 61 73 2d 63 6c 69 70 2d 6d 6f 64 65 2f 72 61 77 as-clip-mode/raw
3dd0: 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 .. (for
3de0: 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 69 6e 74 eign-lambda* int
3df0: 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 ([nonnull-canva
3e00: 73 20 63 61 6e 76 61 73 5d 29 0a 09 20 20 20 20 s canvas])..
3e10: 20 20 20 20 20 20 09 22 43 5f 72 65 74 75 72 6e ."C_return
3e20: 28 63 64 43 61 6e 76 61 73 43 6c 69 70 28 63 61 (cdCanvasClip(ca
3e30: 6e 76 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 nvas, CD_QUERY))
3e40: 3b 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b ;")].. [
3e50: 63 61 6e 76 61 73 2d 63 6c 69 70 2d 6d 6f 64 65 canvas-clip-mode
3e60: 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d .. (lam
3e70: 62 64 61 20 28 63 61 6e 76 61 73 29 0a 09 20 20 bda (canvas)..
3e80: 20 20 20 20 20 20 20 20 09 28 6c 65 74 20 28 5b .(let ([
3e90: 63 6c 69 70 2d 6d 6f 64 65 20 28 63 61 6e 76 61 clip-mode (canva
3ea0: 73 2d 63 6c 69 70 2d 6d 6f 64 65 2f 72 61 77 20 s-clip-mode/raw
3eb0: 63 61 6e 76 61 73 29 5d 29 0a 09 20 20 20 20 20 canvas)])..
3ec0: 20 20 20 20 20 09 09 28 63 6f 6e 64 0a 09 20 20 ..(cond..
3ed0: 20 20 20 20 20 20 20 20 09 09 09 5b 28 72 61 73 ...[(ras
3ee0: 73 6f 63 20 63 6c 69 70 2d 6d 6f 64 65 20 63 6c soc clip-mode cl
3ef0: 69 70 2d 6d 6f 64 65 73 29 20 3d 3e 20 63 61 72 ip-modes) => car
3f00: 5d 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 09 ].. ...
3f10: 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 [else (error 'ca
3f20: 6e 76 61 73 2d 77 72 69 74 65 2d 6d 6f 64 65 20 nvas-write-mode
3f30: 22 75 6e 6b 6e 6f 77 6e 20 63 6c 69 70 20 6d 6f "unknown clip mo
3f40: 64 65 22 20 63 6c 69 70 2d 6d 6f 64 65 29 5d 29 de" clip-mode)])
3f50: 29 29 5d 29 0a 09 20 20 28 76 61 6c 75 65 73 0a ))]).. (values.
3f60: 09 20 20 09 28 67 65 74 74 65 72 2d 77 69 74 68 . .(getter-with
3f70: 2d 73 65 74 74 65 72 20 63 61 6e 76 61 73 2d 63 -setter canvas-c
3f80: 6c 69 70 2d 6d 6f 64 65 20 63 61 6e 76 61 73 2d lip-mode canvas-
3f90: 63 6c 69 70 2d 6d 6f 64 65 2d 73 65 74 21 29 0a clip-mode-set!).
3fa0: 09 20 20 09 63 61 6e 76 61 73 2d 63 6c 69 70 2d . .canvas-clip-
3fb0: 6d 6f 64 65 2d 73 65 74 21 29 29 29 0a 0a 28 64 mode-set!)))..(d
3fc0: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 63 6c 69 efine canvas-cli
3fd0: 70 2d 61 72 65 61 2d 73 65 74 21 0a 09 28 66 6f p-area-set!..(fo
3fe0: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 reign-lambda voi
3ff0: 64 20 22 63 64 66 43 61 6e 76 61 73 43 6c 69 70 d "cdfCanvasClip
4000: 41 72 65 61 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 Area" nonnull-ca
4010: 6e 76 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 nvas double doub
4020: 6c 65 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 le double double
4030: 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 ))..(define canv
4040: 61 73 2d 63 6c 69 70 2d 61 72 65 61 0a 09 28 6c as-clip-area..(l
4050: 65 74 72 65 63 20 28 5b 63 61 6e 76 61 73 2d 63 etrec ([canvas-c
4060: 6c 69 70 2d 61 72 65 61 2f 72 61 77 20 28 66 6f lip-area/raw (fo
4070: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 reign-lambda voi
4080: 64 20 22 63 64 66 43 61 6e 76 61 73 47 65 74 43 d "cdfCanvasGetC
4090: 6c 69 70 41 72 65 61 22 20 6e 6f 6e 6e 75 6c 6c lipArea" nonnull
40a0: 2d 63 61 6e 76 61 73 20 28 63 2d 70 6f 69 6e 74 -canvas (c-point
40b0: 65 72 20 64 6f 75 62 6c 65 29 20 28 63 2d 70 6f er double) (c-po
40c0: 69 6e 74 65 72 20 64 6f 75 62 6c 65 29 20 28 63 inter double) (c
40d0: 2d 70 6f 69 6e 74 65 72 20 64 6f 75 62 6c 65 29 -pointer double)
40e0: 20 28 63 2d 70 6f 69 6e 74 65 72 20 64 6f 75 62 (c-pointer doub
40f0: 6c 65 29 29 5d 29 0a 09 09 28 6c 61 6d 62 64 61 le))])...(lambda
4100: 20 28 63 61 6e 76 61 73 29 0a 09 09 09 28 6c 65 (canvas)....(le
4110: 74 2d 6c 6f 63 61 74 69 6f 6e 20 28 5b 78 30 20 t-location ([x0
4120: 64 6f 75 62 6c 65 20 30 5d 20 5b 78 31 20 64 6f double 0] [x1 do
4130: 75 62 6c 65 20 30 5d 20 5b 79 30 20 64 6f 75 62 uble 0] [y0 doub
4140: 6c 65 20 30 5d 20 5b 79 31 20 64 6f 75 62 6c 65 le 0] [y1 double
4150: 20 30 5d 29 0a 09 09 09 09 28 63 61 6e 76 61 73 0]).....(canvas
4160: 2d 63 6c 69 70 2d 61 72 65 61 2f 72 61 77 20 63 -clip-area/raw c
4170: 61 6e 76 61 73 20 28 6c 6f 63 61 74 69 6f 6e 20 anvas (location
4180: 78 30 29 20 28 6c 6f 63 61 74 69 6f 6e 20 78 31 x0) (location x1
4190: 29 20 28 6c 6f 63 61 74 69 6f 6e 20 79 30 29 20 ) (location y0)
41a0: 28 6c 6f 63 61 74 69 6f 6e 20 79 31 29 29 0a 09 (location y1))..
41b0: 09 09 09 28 76 61 6c 75 65 73 20 78 30 20 78 31 ...(values x0 x1
41c0: 20 79 30 20 79 31 29 29 29 29 29 0a 0a 3b 3b 20 y0 y1)))))..;;
41d0: 7d 7d 7d 0a }}}.