Artifact
188fe57c8d275ad747e64921281199c09cb47c01:
0000: 28 72 65 71 75 69 72 65 2d 6c 69 62 72 61 72 79 (require-library
0010: 20 64 61 74 61 2d 73 74 72 75 63 74 75 72 65 73 data-structures
0020: 20 73 72 66 69 2d 34 20 63 61 6e 76 61 73 2d 64 srfi-4 canvas-d
0030: 72 61 77 2d 62 61 73 65 29 0a 0a 28 6d 6f 64 75 raw-base)..(modu
0040: 6c 65 20 63 61 6e 76 61 73 2d 64 72 61 77 2d 70 le canvas-draw-p
0050: 72 69 6d 69 74 69 76 65 73 0a 09 28 63 61 6e 76 rimitives..(canv
0060: 61 73 2d 70 69 78 65 6c 21 0a 09 20 63 61 6e 76 as-pixel!.. canv
0070: 61 73 2d 6d 61 72 6b 21 0a 09 20 63 61 6e 76 61 as-mark!.. canva
0080: 73 2d 6d 61 72 6b 2d 74 79 70 65 20 63 61 6e 76 s-mark-type canv
0090: 61 73 2d 6d 61 72 6b 2d 74 79 70 65 2d 73 65 74 as-mark-type-set
00a0: 21 0a 09 20 63 61 6e 76 61 73 2d 6d 61 72 6b 2d !.. canvas-mark-
00b0: 73 69 7a 65 20 63 61 6e 76 61 73 2d 6d 61 72 6b size canvas-mark
00c0: 2d 73 69 7a 65 2d 73 65 74 21 0a 09 20 63 61 6e -size-set!.. can
00d0: 76 61 73 2d 6c 69 6e 65 21 20 63 61 6e 76 61 73 vas-line! canvas
00e0: 2d 72 65 63 74 61 6e 67 6c 65 21 20 63 61 6e 76 -rectangle! canv
00f0: 61 73 2d 61 72 63 21 0a 09 20 63 61 6e 76 61 73 as-arc!.. canvas
0100: 2d 6c 69 6e 65 2d 73 74 79 6c 65 20 63 61 6e 76 -line-style canv
0110: 61 73 2d 6c 69 6e 65 2d 73 74 79 6c 65 2d 73 65 as-line-style-se
0120: 74 21 0a 09 20 63 61 6e 76 61 73 2d 6c 69 6e 65 t!.. canvas-line
0130: 2d 77 69 64 74 68 20 63 61 6e 76 61 73 2d 6c 69 -width canvas-li
0140: 6e 65 2d 77 69 64 74 68 2d 73 65 74 21 0a 09 20 ne-width-set!..
0150: 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e canvas-line-join
0160: 20 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 canvas-line-joi
0170: 6e 2d 73 65 74 21 0a 09 20 63 61 6e 76 61 73 2d n-set!.. canvas-
0180: 6c 69 6e 65 2d 63 61 70 20 63 61 6e 76 61 73 2d line-cap canvas-
0190: 6c 69 6e 65 2d 63 61 70 2d 73 65 74 21 0a 09 20 line-cap-set!..
01a0: 63 61 6e 76 61 73 2d 62 6f 78 21 20 63 61 6e 76 canvas-box! canv
01b0: 61 73 2d 73 65 63 74 6f 72 21 20 63 61 6e 76 61 as-sector! canva
01c0: 73 2d 63 68 6f 72 64 21 0a 09 20 63 61 6e 76 61 s-chord!.. canva
01d0: 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 s-background-opa
01e0: 63 69 74 79 20 63 61 6e 76 61 73 2d 62 61 63 6b city canvas-back
01f0: 67 72 6f 75 6e 64 2d 6f 70 61 63 69 74 79 2d 73 ground-opacity-s
0200: 65 74 21 0a 09 20 63 61 6e 76 61 73 2d 66 69 6c et!.. canvas-fil
0210: 6c 2d 6d 6f 64 65 20 63 61 6e 76 61 73 2d 66 69 l-mode canvas-fi
0220: 6c 6c 2d 6d 6f 64 65 2d 73 65 74 21 0a 09 20 63 ll-mode-set!.. c
0230: 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d 73 anvas-interior-s
0240: 74 79 6c 65 20 63 61 6e 76 61 73 2d 69 6e 74 65 tyle canvas-inte
0250: 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 74 21 0a rior-style-set!.
0260: 09 20 63 61 6e 76 61 73 2d 74 65 78 74 21 0a 09 . canvas-text!..
0270: 20 63 61 6e 76 61 73 2d 66 6f 6e 74 20 63 61 6e canvas-font can
0280: 76 61 73 2d 66 6f 6e 74 2d 73 65 74 21 0a 09 20 vas-font-set!..
0290: 63 61 6e 76 61 73 2d 74 65 78 74 2d 61 6c 69 67 canvas-text-alig
02a0: 6e 6d 65 6e 74 20 63 61 6e 76 61 73 2d 74 65 78 nment canvas-tex
02b0: 74 2d 61 6c 69 67 6e 6d 65 6e 74 2d 73 65 74 21 t-alignment-set!
02c0: 0a 09 20 63 61 6e 76 61 73 2d 74 65 78 74 2d 6f .. canvas-text-o
02d0: 72 69 65 6e 74 61 74 69 6f 6e 20 63 61 6e 76 61 rientation canva
02e0: 73 2d 74 65 78 74 2d 6f 72 69 65 6e 74 61 74 69 s-text-orientati
02f0: 6f 6e 2d 73 65 74 21 0a 09 20 63 61 6e 76 61 73 on-set!.. canvas
0300: 2d 66 6f 6e 74 2d 64 69 6d 65 6e 73 69 6f 6e 73 -font-dimensions
0310: 20 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 69 7a canvas-text-siz
0320: 65 20 63 61 6e 76 61 73 2d 74 65 78 74 2d 62 6f e canvas-text-bo
0330: 78 0a 09 20 63 61 6c 6c 2d 77 69 74 68 2d 63 61 x.. call-with-ca
0340: 6e 76 61 73 2d 69 6e 2d 6d 6f 64 65 20 63 61 6e nvas-in-mode can
0350: 76 61 73 2d 70 61 74 68 2d 73 65 74 21 0a 09 20 vas-path-set!..
0360: 63 61 6e 76 61 73 2d 76 65 72 74 65 78 21 29 0a canvas-vertex!).
0370: 09 28 69 6d 70 6f 72 74 20 73 63 68 65 6d 65 20 .(import scheme
0380: 63 68 69 63 6b 65 6e 20 66 6f 72 65 69 67 6e 20 chicken foreign
0390: 64 61 74 61 2d 73 74 72 75 63 74 75 72 65 73 20 data-structures
03a0: 73 72 66 69 2d 34 20 63 61 6e 76 61 73 2d 64 72 srfi-4 canvas-dr
03b0: 61 77 2d 62 61 73 65 29 0a 0a 3b 3b 20 7b 7b 7b aw-base)..;; {{{
03c0: 20 44 61 74 61 20 74 79 70 65 73 0a 0a 28 66 6f Data types..(fo
03d0: 72 65 69 67 6e 2d 64 65 63 6c 61 72 65 0a 09 22 reign-declare.."
03e0: 23 69 6e 63 6c 75 64 65 20 3c 63 64 2e 68 3e 5c #include <cd.h>\
03f0: 6e 22 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 n")..(include "c
0400: 61 6e 76 61 73 2d 64 72 61 77 2d 74 79 70 65 73 anvas-draw-types
0410: 2e 73 63 6d 22 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a .scm")..;; }}}..
0420: 3b 3b 20 7b 7b 7b 20 50 6f 69 6e 74 20 64 72 61 ;; {{{ Point dra
0430: 77 69 6e 67 20 66 75 6e 63 74 69 6f 6e 73 0a 0a wing functions..
0440: 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 70 (define canvas-p
0450: 69 78 65 6c 21 0a 09 28 6c 65 74 72 65 63 20 28 ixel!..(letrec (
0460: 5b 63 61 6e 76 61 73 2d 70 69 78 65 6c 2f 72 61 [canvas-pixel/ra
0470: 77 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 w!.. (f
0480: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f oreign-lambda vo
0490: 69 64 20 22 63 64 43 61 6e 76 61 73 50 69 78 65 id "cdCanvasPixe
04a0: 6c 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 l" nonnull-canva
04b0: 73 20 69 6e 74 20 69 6e 74 20 75 6e 73 69 67 6e s int int unsign
04c0: 65 64 2d 6c 6f 6e 67 29 5d 29 0a 09 20 20 28 6c ed-long)]).. (l
04d0: 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 78 20 ambda (canvas x
04e0: 79 20 23 21 6f 70 74 69 6f 6e 61 6c 20 5b 63 6f y #!optional [co
04f0: 6c 6f 72 20 28 63 61 6e 76 61 73 2d 66 6f 72 65 lor (canvas-fore
0500: 67 72 6f 75 6e 64 20 63 61 6e 76 61 73 29 5d 29 ground canvas)])
0510: 0a 09 20 20 09 28 63 61 6e 76 61 73 2d 70 69 78 .. .(canvas-pix
0520: 65 6c 2f 72 61 77 21 20 63 61 6e 76 61 73 20 78 el/raw! canvas x
0530: 20 79 20 63 6f 6c 6f 72 29 29 29 29 0a 0a 28 64 y color))))..(d
0540: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 6d 61 72 efine canvas-mar
0550: 6b 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d k!..(foreign-lam
0560: 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e 76 bda void "cdCanv
0570: 61 73 4d 61 72 6b 22 20 6e 6f 6e 6e 75 6c 6c 2d asMark" nonnull-
0580: 63 61 6e 76 61 73 20 69 6e 74 20 69 6e 74 29 29 canvas int int))
0590: 0a 0a 28 64 65 66 69 6e 65 2d 76 61 6c 75 65 73 ..(define-values
05a0: 20 28 63 61 6e 76 61 73 2d 6d 61 72 6b 2d 74 79 (canvas-mark-ty
05b0: 70 65 20 63 61 6e 76 61 73 2d 6d 61 72 6b 2d 74 pe canvas-mark-t
05c0: 79 70 65 2d 73 65 74 21 29 0a 09 28 6c 65 74 72 ype-set!)..(letr
05d0: 65 63 20 28 5b 6d 61 72 6b 2d 74 79 70 65 73 0a ec ([mark-types.
05e0: 09 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 . (list
05f0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
0600: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
0610: 27 2b 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 '+.. ..
0620: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
0630: 43 44 5f 50 4c 55 53 22 20 69 6e 74 29 29 0a 09 CD_PLUS" int))..
0640: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
0650: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 70 .. ..'p
0660: 6c 75 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 lus.. .
0670: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
0680: 22 43 44 5f 50 4c 55 53 22 20 69 6e 74 29 29 0a "CD_PLUS" int)).
0690: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
06a0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
06b0: 2a 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 *.. ..(
06c0: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
06d0: 44 5f 53 54 41 52 22 20 69 6e 74 29 29 0a 09 20 D_STAR" int))..
06e0: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
06f0: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 73 74 . ..'st
0700: 61 72 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ar.. ..
0710: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
0720: 43 44 5f 53 54 41 52 22 20 69 6e 74 29 29 0a 09 CD_STAR" int))..
0730: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
0740: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 30 .. ..'0
0750: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
0760: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
0770: 5f 43 49 52 43 4c 45 22 20 69 6e 74 29 29 0a 09 _CIRCLE" int))..
0780: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
0790: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 63 .. ..'c
07a0: 69 72 63 6c 65 0a 09 20 20 20 20 20 20 20 20 20 ircle..
07b0: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
07c0: 65 20 22 43 44 5f 43 49 52 43 4c 45 22 20 69 6e e "CD_CIRCLE" in
07d0: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
07e0: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
07f0: 20 09 09 27 4f 0a 09 20 20 20 20 20 20 20 20 20 ..'O..
0800: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
0810: 65 20 22 43 44 5f 48 4f 4c 4c 4f 57 5f 43 49 52 e "CD_HOLLOW_CIR
0820: 43 4c 45 22 20 69 6e 74 29 29 0a 09 20 20 20 20 CLE" int))..
0830: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
0840: 20 20 20 20 20 20 20 20 09 09 27 68 6f 6c 6c 6f ..'hollo
0850: 77 2d 63 69 72 63 6c 65 0a 09 20 20 20 20 20 20 w-circle..
0860: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
0870: 61 6c 75 65 20 22 43 44 5f 48 4f 4c 4c 4f 57 5f alue "CD_HOLLOW_
0880: 43 49 52 43 4c 45 22 20 69 6e 74 29 29 0a 09 20 CIRCLE" int))..
0890: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
08a0: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 58 0a . ..'X.
08b0: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
08c0: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
08d0: 58 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 X" int))..
08e0: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
08f0: 20 20 20 20 20 20 09 09 27 78 0a 09 20 20 20 20 ..'x..
0900: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
0910: 2d 76 61 6c 75 65 20 22 43 44 5f 58 22 20 69 6e -value "CD_X" in
0920: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
0930: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
0940: 20 09 09 27 62 6f 78 0a 09 20 20 20 20 20 20 20 ..'box..
0950: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
0960: 6c 75 65 20 22 43 44 5f 42 4f 58 22 20 69 6e 74 lue "CD_BOX" int
0970: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
0980: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
0990: 09 09 27 68 6f 6c 6c 6f 77 2d 62 6f 78 0a 09 20 ..'hollow-box..
09a0: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
09b0: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 48 4f ign-value "CD_HO
09c0: 4c 4c 4f 57 5f 42 4f 58 22 20 69 6e 74 29 29 0a LLOW_BOX" int)).
09d0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
09e0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
09f0: 64 69 61 6d 6f 6e 64 0a 09 20 20 20 20 20 20 20 diamond..
0a00: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
0a10: 6c 75 65 20 22 43 44 5f 44 49 41 4d 4f 4e 44 22 lue "CD_DIAMOND"
0a20: 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 int))..
0a30: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
0a40: 20 20 20 20 09 09 27 68 6f 6c 6c 6f 77 2d 64 69 ..'hollow-di
0a50: 61 6d 6f 6e 64 0a 09 20 20 20 20 20 20 20 20 20 amond..
0a60: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
0a70: 65 20 22 43 44 5f 48 4f 4c 4c 4f 57 5f 44 49 41 e "CD_HOLLOW_DIA
0a80: 4d 4f 4e 44 22 20 69 6e 74 29 29 29 5d 0a 09 20 MOND" int)))]..
0a90: 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d [canvas-
0aa0: 6d 61 72 6b 2d 74 79 70 65 2d 73 65 74 2f 72 61 mark-type-set/ra
0ab0: 77 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 w!.. (f
0ac0: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f oreign-lambda vo
0ad0: 69 64 20 22 63 64 43 61 6e 76 61 73 4d 61 72 6b id "cdCanvasMark
0ae0: 54 79 70 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 Type" nonnull-ca
0af0: 6e 76 61 73 20 69 6e 74 29 5d 0a 09 20 20 20 20 nvas int)]..
0b00: 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 6d 61 72 [canvas-mar
0b10: 6b 2d 74 79 70 65 2d 73 65 74 21 0a 09 20 20 20 k-type-set!..
0b20: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
0b30: 63 61 6e 76 61 73 20 6d 61 72 6b 2d 74 79 70 65 canvas mark-type
0b40: 29 0a 09 09 09 09 09 09 09 28 63 61 6e 76 61 73 )........(canvas
0b50: 2d 6d 61 72 6b 2d 74 79 70 65 2d 73 65 74 2f 72 -mark-type-set/r
0b60: 61 77 21 0a 09 09 09 09 09 09 09 09 63 61 6e 76 aw!.........canv
0b70: 61 73 0a 09 09 09 09 09 09 09 09 28 63 6f 6e 64 as.........(cond
0b80: 0a 09 09 09 09 09 09 09 09 09 5b 28 61 73 73 71 ..........[(assq
0b90: 20 6d 61 72 6b 2d 74 79 70 65 20 6d 61 72 6b 2d mark-type mark-
0ba0: 74 79 70 65 73 29 20 3d 3e 20 63 64 72 5d 0a 09 types) => cdr]..
0bb0: 09 09 09 09 09 09 09 09 5b 65 6c 73 65 20 28 65 ........[else (e
0bc0: 72 72 6f 72 20 27 63 61 6e 76 61 73 2d 6d 61 72 rror 'canvas-mar
0bd0: 6b 2d 74 79 70 65 2d 73 65 74 21 20 22 75 6e 6b k-type-set! "unk
0be0: 6e 6f 77 6e 20 6d 61 72 6b 20 74 79 70 65 22 20 nown mark type"
0bf0: 6d 61 72 6b 2d 74 79 70 65 29 5d 29 29 29 5d 0a mark-type)])))].
0c00: 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 . [canva
0c10: 73 2d 6d 61 72 6b 2d 74 79 70 65 2f 72 61 77 0a s-mark-type/raw.
0c20: 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 . (fore
0c30: 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 69 6e 74 20 ign-lambda* int
0c40: 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 ([nonnull-canvas
0c50: 20 63 61 6e 76 61 73 5d 29 0a 09 20 20 20 20 20 canvas])..
0c60: 20 20 20 20 20 09 22 43 5f 72 65 74 75 72 6e 28 ."C_return(
0c70: 63 64 43 61 6e 76 61 73 4d 61 72 6b 54 79 70 65 cdCanvasMarkType
0c80: 28 63 61 6e 76 61 73 2c 20 43 44 5f 51 55 45 52 (canvas, CD_QUER
0c90: 59 29 29 3b 22 29 5d 0a 09 20 20 20 20 20 20 20 Y));")]..
0ca0: 20 20 5b 63 61 6e 76 61 73 2d 6d 61 72 6b 2d 74 [canvas-mark-t
0cb0: 79 70 65 0a 09 20 20 20 20 20 20 20 20 20 20 28 ype.. (
0cc0: 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 29 0a lambda (canvas).
0cd0: 09 20 20 20 20 20 20 20 20 20 20 09 28 6c 65 74 . .(let
0ce0: 20 28 5b 6d 61 72 6b 2d 74 79 70 65 20 28 63 61 ([mark-type (ca
0cf0: 6e 76 61 73 2d 6d 61 72 6b 2d 74 79 70 65 2f 72 nvas-mark-type/r
0d00: 61 77 20 63 61 6e 76 61 73 29 5d 29 0a 09 09 09 aw canvas)])....
0d10: 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 .....(cond......
0d20: 09 09 09 09 5b 28 72 61 73 73 6f 63 20 6d 61 72 ....[(rassoc mar
0d30: 6b 2d 74 79 70 65 20 6d 61 72 6b 2d 74 79 70 65 k-type mark-type
0d40: 73 29 20 3d 3e 20 63 61 72 5d 0a 09 09 09 09 09 s) => car]......
0d50: 09 09 09 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 ....[else (error
0d60: 20 27 63 61 6e 76 61 73 2d 6d 61 72 6b 2d 74 79 'canvas-mark-ty
0d70: 70 65 20 22 75 6e 6b 6e 6f 77 6e 20 6d 61 72 6b pe "unknown mark
0d80: 20 74 79 70 65 22 20 6d 61 72 6b 2d 74 79 70 65 type" mark-type
0d90: 29 5d 29 29 29 5d 29 0a 09 20 20 28 76 61 6c 75 )])))]).. (valu
0da0: 65 73 0a 09 20 20 09 28 67 65 74 74 65 72 2d 77 es.. .(getter-w
0db0: 69 74 68 2d 73 65 74 74 65 72 20 63 61 6e 76 61 ith-setter canva
0dc0: 73 2d 6d 61 72 6b 2d 74 79 70 65 20 63 61 6e 76 s-mark-type canv
0dd0: 61 73 2d 6d 61 72 6b 2d 74 79 70 65 2d 73 65 74 as-mark-type-set
0de0: 21 29 0a 09 20 20 09 63 61 6e 76 61 73 2d 6d 61 !).. .canvas-ma
0df0: 72 6b 2d 74 79 70 65 2d 73 65 74 21 29 29 29 0a rk-type-set!))).
0e00: 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d .(define canvas-
0e10: 6d 61 72 6b 2d 73 69 7a 65 2d 73 65 74 21 0a 09 mark-size-set!..
0e20: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 (foreign-lambda
0e30: 76 6f 69 64 20 22 63 64 43 61 6e 76 61 73 4d 61 void "cdCanvasMa
0e40: 72 6b 53 69 7a 65 22 20 6e 6f 6e 6e 75 6c 6c 2d rkSize" nonnull-
0e50: 63 61 6e 76 61 73 20 69 6e 74 29 29 0a 0a 28 64 canvas int))..(d
0e60: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 6d 61 72 efine canvas-mar
0e70: 6b 2d 73 69 7a 65 0a 09 28 67 65 74 74 65 72 2d k-size..(getter-
0e80: 77 69 74 68 2d 73 65 74 74 65 72 0a 09 09 28 66 with-setter...(f
0e90: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 69 oreign-lambda* i
0ea0: 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e nt ([nonnull-can
0eb0: 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 09 09 vas canvas])....
0ec0: 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 "C_return(cdCanv
0ed0: 61 73 4d 61 72 6b 53 69 7a 65 28 63 61 6e 76 61 asMarkSize(canva
0ee0: 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 29 s, CD_QUERY));")
0ef0: 0a 09 09 63 61 6e 76 61 73 2d 6d 61 72 6b 2d 73 ...canvas-mark-s
0f00: 69 7a 65 2d 73 65 74 21 29 29 0a 0a 3b 3b 20 7d ize-set!))..;; }
0f10: 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 4c 69 6e 65 20 }}..;; {{{ Line
0f20: 66 75 6e 63 74 69 6f 6e 73 0a 0a 28 64 65 66 69 functions..(defi
0f30: 6e 65 20 63 61 6e 76 61 73 2d 6c 69 6e 65 21 0a ne canvas-line!.
0f40: 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 .(foreign-lambda
0f50: 20 76 6f 69 64 20 22 63 64 66 43 61 6e 76 61 73 void "cdfCanvas
0f60: 4c 69 6e 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 Line" nonnull-ca
0f70: 6e 76 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 nvas double doub
0f80: 6c 65 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 le double double
0f90: 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 ))..(define canv
0fa0: 61 73 2d 72 65 63 74 61 6e 67 6c 65 21 0a 09 28 as-rectangle!..(
0fb0: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 foreign-lambda v
0fc0: 6f 69 64 20 22 63 64 66 43 61 6e 76 61 73 52 65 oid "cdfCanvasRe
0fd0: 63 74 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 ct" nonnull-canv
0fe0: 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 as double double
0ff0: 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 29 29 double double))
1000: 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 ..(define canvas
1010: 2d 61 72 63 21 0a 09 28 66 6f 72 65 69 67 6e 2d -arc!..(foreign-
1020: 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 66 lambda void "cdf
1030: 43 61 6e 76 61 73 41 72 63 22 20 6e 6f 6e 6e 75 CanvasArc" nonnu
1040: 6c 6c 2d 63 61 6e 76 61 73 20 64 6f 75 62 6c 65 ll-canvas double
1050: 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 double double d
1060: 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f 75 ouble double dou
1070: 62 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 2d 76 ble))..(define-v
1080: 61 6c 75 65 73 20 28 63 61 6e 76 61 73 2d 6c 69 alues (canvas-li
1090: 6e 65 2d 73 74 79 6c 65 20 63 61 6e 76 61 73 2d ne-style canvas-
10a0: 6c 69 6e 65 2d 73 74 79 6c 65 2d 73 65 74 21 29 line-style-set!)
10b0: 0a 09 28 6c 65 74 72 65 63 20 28 5b 6c 69 6e 65 ..(letrec ([line
10c0: 2d 73 74 79 6c 65 73 0a 09 20 20 20 20 20 20 20 -styles..
10d0: 20 20 20 28 6c 69 73 74 0a 09 20 20 20 20 20 20 (list..
10e0: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
10f0: 20 20 20 20 20 20 09 09 27 63 6f 6e 74 69 6e 75 ..'continu
1100: 6f 75 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ous.. .
1110: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
1120: 22 43 44 5f 43 4f 4e 54 49 4e 55 4f 55 53 22 20 "CD_CONTINUOUS"
1130: 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 int))..
1140: 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 .(cons..
1150: 20 20 20 09 09 27 64 61 73 68 65 64 0a 09 20 20 ..'dashed..
1160: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
1170: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 44 41 53 gn-value "CD_DAS
1180: 48 45 44 22 20 69 6e 74 29 29 0a 09 20 20 20 20 HED" int))..
1190: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
11a0: 20 20 20 20 20 20 20 20 09 09 27 64 6f 74 74 65 ..'dotte
11b0: 64 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 d.. ..(
11c0: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
11d0: 44 5f 44 4f 54 54 45 44 22 20 69 6e 74 29 29 0a D_DOTTED" int)).
11e0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
11f0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
1200: 64 61 73 68 2d 64 6f 74 74 65 64 0a 09 20 20 20 dash-dotted..
1210: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
1220: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 44 41 53 48 n-value "CD_DASH
1230: 5f 44 4f 54 22 20 69 6e 74 29 29 0a 09 20 20 20 _DOT" int))..
1240: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
1250: 20 20 20 20 20 20 20 20 20 09 09 27 64 61 73 68 ..'dash
1260: 2d 64 6f 74 2d 64 6f 74 74 65 64 0a 09 20 20 20 -dot-dotted..
1270: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
1280: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 44 41 53 48 n-value "CD_DASH
1290: 5f 44 4f 54 5f 44 4f 54 22 20 69 6e 74 29 29 0a _DOT_DOT" int)).
12a0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
12b0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
12c0: 63 75 73 74 6f 6d 0a 09 20 20 20 20 20 20 20 20 custom..
12d0: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
12e0: 75 65 20 22 43 44 5f 43 55 53 54 4f 4d 22 20 69 ue "CD_CUSTOM" i
12f0: 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 20 20 20 nt)))]..
1300: 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 74 [canvas-line-st
1310: 79 6c 65 2d 73 65 74 2f 72 61 77 21 0a 09 20 20 yle-set/raw!..
1320: 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e (foreign
1330: 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 -lambda void "cd
1340: 43 61 6e 76 61 73 4c 69 6e 65 53 74 79 6c 65 22 CanvasLineStyle"
1350: 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 nonnull-canvas
1360: 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 int)]..
1370: 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 74 79 [canvas-line-sty
1380: 6c 65 2d 64 61 73 68 65 73 2d 73 65 74 2f 72 61 le-dashes-set/ra
1390: 77 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 w!.. (f
13a0: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f oreign-lambda vo
13b0: 69 64 20 22 63 64 43 61 6e 76 61 73 4c 69 6e 65 id "cdCanvasLine
13c0: 53 74 79 6c 65 44 61 73 68 65 73 22 20 6e 6f 6e StyleDashes" non
13d0: 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 6e 6f 6e 6e null-canvas nonn
13e0: 75 6c 6c 2d 73 33 32 76 65 63 74 6f 72 20 69 6e ull-s32vector in
13f0: 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 t)].. [c
1400: 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 74 79 6c 65 anvas-line-style
1410: 2d 73 65 74 21 0a 09 20 20 20 20 20 20 20 20 20 -set!..
1420: 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 (lambda (canvas
1430: 20 6c 69 6e 65 2d 73 74 79 6c 65 29 0a 09 20 20 line-style)..
1440: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 64 0a 09 .(cond..
1450: 20 20 20 20 20 20 20 20 20 20 09 09 5b 28 61 6e ..[(an
1460: 64 20 28 70 61 69 72 3f 20 6c 69 6e 65 2d 73 74 d (pair? line-st
1470: 79 6c 65 29 20 28 65 71 3f 20 28 63 61 72 20 6c yle) (eq? (car l
1480: 69 6e 65 2d 73 74 79 6c 65 29 20 27 63 75 73 74 ine-style) 'cust
1490: 6f 6d 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 om))..
14a0: 09 09 20 28 6c 65 74 20 28 5b 64 61 73 68 65 73 .. (let ([dashes
14b0: 20 28 6c 69 73 74 2d 3e 73 33 32 76 65 63 74 6f (list->s32vecto
14c0: 72 20 28 63 64 72 20 6c 69 6e 65 2d 73 74 79 6c r (cdr line-styl
14d0: 65 29 29 5d 29 0a 09 20 20 20 20 20 20 20 20 20 e))])..
14e0: 20 09 09 20 09 20 28 63 61 6e 76 61 73 2d 6c 69 .. . (canvas-li
14f0: 6e 65 2d 73 74 79 6c 65 2d 64 61 73 68 65 73 2d ne-style-dashes-
1500: 73 65 74 2f 72 61 77 21 20 63 61 6e 76 61 73 20 set/raw! canvas
1510: 64 61 73 68 65 73 20 28 73 33 32 76 65 63 74 6f dashes (s32vecto
1520: 72 2d 6c 65 6e 67 74 68 20 64 61 73 68 65 73 29 r-length dashes)
1530: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 20 ).. ..
1540: 09 20 28 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 . (canvas-line-s
1550: 74 79 6c 65 2d 73 65 74 2f 72 61 77 21 20 63 61 tyle-set/raw! ca
1560: 6e 76 61 73 20 28 63 64 72 20 28 61 73 73 71 20 nvas (cdr (assq
1570: 27 63 75 73 74 6f 6d 20 6c 69 6e 65 2d 73 74 79 'custom line-sty
1580: 6c 65 73 29 29 29 29 5d 0a 09 20 20 20 20 20 20 les))))]..
1590: 20 20 20 20 09 09 5b 65 6c 73 65 0a 09 20 20 20 ..[else..
15a0: 20 20 20 20 20 20 20 09 09 20 28 63 61 6e 76 61 .. (canva
15b0: 73 2d 6c 69 6e 65 2d 73 74 79 6c 65 2d 73 65 74 s-line-style-set
15c0: 2f 72 61 77 21 0a 09 20 20 20 20 20 20 20 20 20 /raw!..
15d0: 20 09 09 20 09 20 63 61 6e 76 61 73 0a 09 20 20 .. . canvas..
15e0: 20 20 20 20 20 20 20 20 09 09 20 09 20 28 63 6f .. . (co
15f0: 6e 64 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 nd.. ..
1600: 20 09 20 09 20 5b 28 61 73 73 71 20 6c 69 6e 65 . . [(assq line
1610: 2d 73 74 79 6c 65 20 6c 69 6e 65 2d 73 74 79 6c -style line-styl
1620: 65 73 29 20 3d 3e 20 63 64 72 5d 0a 09 20 20 20 es) => cdr]..
1630: 20 20 20 20 20 20 20 09 09 20 09 20 09 20 5b 65 .. . . [e
1640: 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e 76 lse (error 'canv
1650: 61 73 2d 6c 69 6e 65 2d 73 74 79 6c 65 2d 73 65 as-line-style-se
1660: 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 6c 69 6e 65 t! "unknown line
1670: 20 73 74 79 6c 65 22 20 6c 69 6e 65 2d 73 74 79 style" line-sty
1680: 6c 65 29 5d 29 29 5d 29 29 5d 0a 09 20 20 20 20 le)]))]))]..
1690: 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 6c 69 6e [canvas-lin
16a0: 65 2d 73 74 79 6c 65 2f 72 61 77 0a 09 20 20 20 e-style/raw..
16b0: 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d (foreign-
16c0: 6c 61 6d 62 64 61 2a 20 69 6e 74 20 28 5b 6e 6f lambda* int ([no
16d0: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e nnull-canvas can
16e0: 76 61 73 5d 29 0a 09 20 20 20 20 20 20 20 20 20 vas])..
16f0: 20 09 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 ."C_return(cdCa
1700: 6e 76 61 73 4c 69 6e 65 53 74 79 6c 65 28 63 61 nvasLineStyle(ca
1710: 6e 76 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 nvas, CD_QUERY))
1720: 3b 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b ;")].. [
1730: 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 74 79 6c canvas-line-styl
1740: 65 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c 61 e.. (la
1750: 6d 62 64 61 20 28 63 61 6e 76 61 73 29 0a 09 20 mbda (canvas)..
1760: 20 20 20 20 20 20 20 20 20 09 28 6c 65 74 20 28 .(let (
1770: 5b 6c 69 6e 65 2d 73 74 79 6c 65 20 28 63 61 6e [line-style (can
1780: 76 61 73 2d 6c 69 6e 65 2d 73 74 79 6c 65 2f 72 vas-line-style/r
1790: 61 77 20 63 61 6e 76 61 73 29 5d 29 0a 09 20 20 aw canvas)])..
17a0: 20 20 20 20 20 20 20 20 09 09 28 63 6f 6e 64 0a ..(cond.
17b0: 09 09 09 09 09 09 09 09 09 5b 28 72 61 73 73 6f .........[(rasso
17c0: 63 20 6c 69 6e 65 2d 73 74 79 6c 65 20 6c 69 6e c line-style lin
17d0: 65 2d 73 74 79 6c 65 73 29 20 3d 3e 20 63 61 72 e-styles) => car
17e0: 5d 0a 09 09 09 09 09 09 09 09 09 5b 65 6c 73 65 ]..........[else
17f0: 20 28 65 72 72 6f 72 20 27 63 61 6e 76 61 73 2d (error 'canvas-
1800: 6c 69 6e 65 2d 73 74 79 6c 65 20 22 75 6e 6b 6e line-style "unkn
1810: 6f 77 6e 20 6c 69 6e 65 20 73 74 79 6c 65 22 20 own line style"
1820: 6c 69 6e 65 2d 73 74 79 6c 65 29 5d 29 29 29 5d line-style)])))]
1830: 29 0a 09 20 20 28 76 61 6c 75 65 73 0a 09 20 20 ).. (values..
1840: 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 .(getter-with-se
1850: 74 74 65 72 20 63 61 6e 76 61 73 2d 6c 69 6e 65 tter canvas-line
1860: 2d 73 74 79 6c 65 20 63 61 6e 76 61 73 2d 6c 69 -style canvas-li
1870: 6e 65 2d 73 74 79 6c 65 2d 73 65 74 21 29 0a 09 ne-style-set!)..
1880: 20 20 09 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 .canvas-line-s
1890: 74 79 6c 65 2d 73 65 74 21 29 29 29 0a 0a 28 64 tyle-set!)))..(d
18a0: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 6c 69 6e efine canvas-lin
18b0: 65 2d 77 69 64 74 68 2d 73 65 74 21 0a 09 28 66 e-width-set!..(f
18c0: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 69 6e oreign-lambda in
18d0: 74 20 22 63 64 43 61 6e 76 61 73 4c 69 6e 65 57 t "cdCanvasLineW
18e0: 69 64 74 68 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 idth" nonnull-ca
18f0: 6e 76 61 73 20 69 6e 74 29 29 0a 0a 28 64 65 66 nvas int))..(def
1900: 69 6e 65 20 63 61 6e 76 61 73 2d 6c 69 6e 65 2d ine canvas-line-
1910: 77 69 64 74 68 0a 09 28 67 65 74 74 65 72 2d 77 width..(getter-w
1920: 69 74 68 2d 73 65 74 74 65 72 0a 09 09 28 66 6f ith-setter...(fo
1930: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 69 6e reign-lambda* in
1940: 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 t ([nonnull-canv
1950: 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 09 09 22 as canvas])...."
1960: 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 61 C_return(cdCanva
1970: 73 4c 69 6e 65 57 69 64 74 68 28 63 61 6e 76 61 sLineWidth(canva
1980: 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 29 s, CD_QUERY));")
1990: 0a 09 09 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 77 ...canvas-line-w
19a0: 69 64 74 68 2d 73 65 74 21 29 29 0a 0a 28 64 65 idth-set!))..(de
19b0: 66 69 6e 65 2d 76 61 6c 75 65 73 20 28 63 61 6e fine-values (can
19c0: 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e 20 63 61 vas-line-join ca
19d0: 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e 2d 73 nvas-line-join-s
19e0: 65 74 21 29 0a 09 28 6c 65 74 72 65 63 20 28 5b et!)..(letrec ([
19f0: 6c 69 6e 65 2d 6a 6f 69 6e 73 0a 09 20 20 20 20 line-joins..
1a00: 20 20 20 20 20 20 28 6c 69 73 74 0a 09 20 20 20 (list..
1a10: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
1a20: 20 20 20 20 20 20 20 20 20 09 09 27 6d 69 74 65 ..'mite
1a30: 72 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 r.. ..(
1a40: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
1a50: 44 5f 4d 49 54 45 52 22 20 69 6e 74 29 29 0a 09 D_MITER" int))..
1a60: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
1a70: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 62 .. ..'b
1a80: 65 76 65 6c 0a 09 20 20 20 20 20 20 20 20 20 20 evel..
1a90: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
1aa0: 20 22 43 44 5f 42 45 56 45 4c 22 20 69 6e 74 29 "CD_BEVEL" int)
1ab0: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
1ac0: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
1ad0: 09 27 72 6f 75 6e 64 0a 09 20 20 20 20 20 20 20 .'round..
1ae0: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
1af0: 6c 75 65 20 22 43 44 5f 52 4f 55 4e 44 22 20 69 lue "CD_ROUND" i
1b00: 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 20 20 20 nt)))]..
1b10: 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f [canvas-line-jo
1b20: 69 6e 2d 73 65 74 2f 72 61 77 21 0a 09 20 20 20 in-set/raw!..
1b30: 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d (foreign-
1b40: 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 lambda void "cdC
1b50: 61 6e 76 61 73 4c 69 6e 65 4a 6f 69 6e 22 20 6e anvasLineJoin" n
1b60: 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 69 6e onnull-canvas in
1b70: 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 t)].. [c
1b80: 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e 2d anvas-line-join-
1b90: 73 65 74 21 0a 09 20 20 20 20 20 20 20 20 20 20 set!..
1ba0: 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 (lambda (canvas
1bb0: 6c 69 6e 65 2d 6a 6f 69 6e 29 0a 09 09 09 09 09 line-join)......
1bc0: 09 09 28 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a ..(canvas-line-j
1bd0: 6f 69 6e 2d 73 65 74 2f 72 61 77 21 0a 09 09 09 oin-set/raw!....
1be0: 09 09 09 09 09 63 61 6e 76 61 73 0a 09 09 09 09 .....canvas.....
1bf0: 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 09 ....(cond.......
1c00: 09 09 09 5b 28 61 73 73 71 20 6c 69 6e 65 2d 6a ...[(assq line-j
1c10: 6f 69 6e 20 6c 69 6e 65 2d 6a 6f 69 6e 73 29 20 oin line-joins)
1c20: 3d 3e 20 63 64 72 5d 0a 09 09 09 09 09 09 09 09 => cdr].........
1c30: 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 .[else (error 'c
1c40: 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e 2d anvas-line-join-
1c50: 73 65 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 6c 69 set! "unknown li
1c60: 6e 65 20 6a 6f 69 6e 22 20 6c 69 6e 65 2d 6a 6f ne join" line-jo
1c70: 69 6e 29 5d 29 29 29 5d 0a 09 20 20 20 20 20 20 in)])))]..
1c80: 20 20 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d [canvas-line-
1c90: 6a 6f 69 6e 2f 72 61 77 0a 09 20 20 20 20 20 20 join/raw..
1ca0: 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d (foreign-lam
1cb0: 62 64 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e 75 bda* int ([nonnu
1cc0: 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 ll-canvas canvas
1cd0: 5d 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 ]).. ."
1ce0: 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 61 C_return(cdCanva
1cf0: 73 4c 69 6e 65 4a 6f 69 6e 28 63 61 6e 76 61 73 sLineJoin(canvas
1d00: 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 29 5d , CD_QUERY));")]
1d10: 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 .. [canv
1d20: 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e 0a 09 20 20 as-line-join..
1d30: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
1d40: 28 63 61 6e 76 61 73 29 0a 09 20 20 20 20 20 20 (canvas)..
1d50: 20 20 20 20 09 28 6c 65 74 20 28 5b 6c 69 6e 65 .(let ([line
1d60: 2d 6a 6f 69 6e 20 28 63 61 6e 76 61 73 2d 6c 69 -join (canvas-li
1d70: 6e 65 2d 6a 6f 69 6e 2f 72 61 77 20 63 61 6e 76 ne-join/raw canv
1d80: 61 73 29 5d 29 0a 09 20 20 20 20 20 20 20 20 20 as)])..
1d90: 20 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 ..(cond........
1da0: 09 09 5b 28 72 61 73 73 6f 63 20 6c 69 6e 65 2d ..[(rassoc line-
1db0: 6a 6f 69 6e 20 6c 69 6e 65 2d 6a 6f 69 6e 73 29 join line-joins)
1dc0: 20 3d 3e 20 63 61 72 5d 0a 09 09 09 09 09 09 09 => car]........
1dd0: 09 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 ..[else (error '
1de0: 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e canvas-line-join
1df0: 20 22 75 6e 6b 6e 6f 77 6e 20 6c 69 6e 65 20 6a "unknown line j
1e00: 6f 69 6e 22 20 6c 69 6e 65 2d 6a 6f 69 6e 29 5d oin" line-join)]
1e10: 29 29 29 5d 29 0a 09 09 28 76 61 6c 75 65 73 0a )))])...(values.
1e20: 09 09 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d ...(getter-with-
1e30: 73 65 74 74 65 72 20 63 61 6e 76 61 73 2d 6c 69 setter canvas-li
1e40: 6e 65 2d 6a 6f 69 6e 20 63 61 6e 76 61 73 2d 6c ne-join canvas-l
1e50: 69 6e 65 2d 6a 6f 69 6e 2d 73 65 74 21 29 0a 09 ine-join-set!)..
1e60: 09 09 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f ..canvas-line-jo
1e70: 69 6e 2d 73 65 74 21 29 29 29 0a 0a 28 64 65 66 in-set!)))..(def
1e80: 69 6e 65 2d 76 61 6c 75 65 73 20 28 63 61 6e 76 ine-values (canv
1e90: 61 73 2d 6c 69 6e 65 2d 63 61 70 20 63 61 6e 76 as-line-cap canv
1ea0: 61 73 2d 6c 69 6e 65 2d 63 61 70 2d 73 65 74 21 as-line-cap-set!
1eb0: 29 0a 09 28 6c 65 74 72 65 63 20 28 5b 6c 69 6e )..(letrec ([lin
1ec0: 65 2d 63 61 70 73 0a 09 20 20 20 20 20 20 20 20 e-caps..
1ed0: 20 20 28 6c 69 73 74 0a 09 20 20 20 20 20 20 20 (list..
1ee0: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
1ef0: 20 20 20 20 20 09 09 27 66 6c 61 74 0a 09 20 20 ..'flat..
1f00: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
1f10: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 41 50 gn-value "CD_CAP
1f20: 46 4c 41 54 22 20 69 6e 74 29 29 0a 09 20 20 20 FLAT" int))..
1f30: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
1f40: 20 20 20 20 20 20 20 20 20 09 09 27 73 71 75 61 ..'squa
1f50: 72 65 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 re.. ..
1f60: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
1f70: 43 44 5f 43 41 50 53 51 55 41 52 45 22 20 69 6e CD_CAPSQUARE" in
1f80: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
1f90: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
1fa0: 20 09 09 27 72 6f 75 6e 64 0a 09 20 20 20 20 20 ..'round..
1fb0: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
1fc0: 76 61 6c 75 65 20 22 43 44 5f 43 41 50 52 4f 55 value "CD_CAPROU
1fd0: 4e 44 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 20 ND" int)))]..
1fe0: 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 6c 69 [canvas-li
1ff0: 6e 65 2d 63 61 70 2d 73 65 74 2f 72 61 77 21 0a ne-cap-set/raw!.
2000: 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 . (fore
2010: 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 ign-lambda void
2020: 22 63 64 43 61 6e 76 61 73 4c 69 6e 65 43 61 70 "cdCanvasLineCap
2030: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
2040: 20 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 int)]..
2050: 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 61 [canvas-line-ca
2060: 70 2d 73 65 74 21 0a 09 20 20 20 20 20 20 20 20 p-set!..
2070: 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 (lambda (canva
2080: 73 20 6c 69 6e 65 2d 63 61 70 29 0a 09 09 09 09 s line-cap).....
2090: 09 09 09 28 63 61 6e 76 61 73 2d 6c 69 6e 65 2d ...(canvas-line-
20a0: 63 61 70 2d 73 65 74 2f 72 61 77 21 0a 09 09 09 cap-set/raw!....
20b0: 09 09 09 09 09 63 61 6e 76 61 73 0a 09 09 09 09 .....canvas.....
20c0: 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 09 ....(cond.......
20d0: 09 09 09 5b 28 61 73 73 71 20 6c 69 6e 65 2d 63 ...[(assq line-c
20e0: 61 70 20 6c 69 6e 65 2d 63 61 70 73 29 20 3d 3e ap line-caps) =>
20f0: 20 63 64 72 5d 0a 09 09 09 09 09 09 09 09 09 5b cdr]..........[
2100: 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e else (error 'can
2110: 76 61 73 2d 6c 69 6e 65 2d 63 61 70 2d 73 65 74 vas-line-cap-set
2120: 21 20 22 75 6e 6b 6e 6f 77 6e 20 6c 69 6e 65 20 ! "unknown line
2130: 63 61 70 22 20 6c 69 6e 65 2d 63 61 70 29 5d 29 cap" line-cap)])
2140: 29 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 ))].. [c
2150: 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 61 70 2f 72 anvas-line-cap/r
2160: 61 77 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 aw.. (f
2170: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 69 oreign-lambda* i
2180: 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e nt ([nonnull-can
2190: 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 20 20 vas canvas])..
21a0: 20 20 20 20 20 20 20 20 09 22 43 5f 72 65 74 75 ."C_retu
21b0: 72 6e 28 63 64 43 61 6e 76 61 73 4c 69 6e 65 43 rn(cdCanvasLineC
21c0: 61 70 28 63 61 6e 76 61 73 2c 20 43 44 5f 51 55 ap(canvas, CD_QU
21d0: 45 52 59 29 29 3b 22 29 5d 0a 09 20 20 20 20 20 ERY));")]..
21e0: 20 20 20 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 [canvas-line
21f0: 2d 63 61 70 0a 09 20 20 20 20 20 20 20 20 20 20 -cap..
2200: 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 29 (lambda (canvas)
2210: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 6c 65 .. .(le
2220: 74 20 28 5b 6c 69 6e 65 2d 63 61 70 20 28 63 61 t ([line-cap (ca
2230: 6e 76 61 73 2d 6c 69 6e 65 2d 63 61 70 2f 72 61 nvas-line-cap/ra
2240: 77 20 63 61 6e 76 61 73 29 5d 29 0a 09 09 09 09 w canvas)]).....
2250: 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 09 ....(cond.......
2260: 09 09 09 5b 28 72 61 73 73 6f 63 20 6c 69 6e 65 ...[(rassoc line
2270: 2d 63 61 70 20 6c 69 6e 65 2d 63 61 70 73 29 20 -cap line-caps)
2280: 3d 3e 20 63 61 72 5d 0a 09 09 09 09 09 09 09 09 => car].........
2290: 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 .[else (error 'c
22a0: 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 61 70 20 22 anvas-line-cap "
22b0: 75 6e 6b 6e 6f 77 6e 20 6c 69 6e 65 20 63 61 70 unknown line cap
22c0: 22 20 6c 69 6e 65 2d 63 61 70 29 5d 29 29 29 5d " line-cap)])))]
22d0: 29 0a 09 09 28 76 61 6c 75 65 73 0a 09 09 09 28 )...(values....(
22e0: 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 74 74 getter-with-sett
22f0: 65 72 20 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 er canvas-line-c
2300: 61 70 20 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 ap canvas-line-c
2310: 61 70 2d 73 65 74 21 29 0a 09 09 09 63 61 6e 76 ap-set!)....canv
2320: 61 73 2d 6c 69 6e 65 2d 63 61 70 2d 73 65 74 21 as-line-cap-set!
2330: 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 )))..;; }}}..;;
2340: 7b 7b 7b 20 46 69 6c 6c 65 64 20 61 72 65 61 20 {{{ Filled area
2350: 66 75 6e 63 74 69 6f 6e 73 0a 0a 28 64 65 66 69 functions..(defi
2360: 6e 65 20 63 61 6e 76 61 73 2d 62 6f 78 21 0a 09 ne canvas-box!..
2370: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 (foreign-lambda
2380: 76 6f 69 64 20 22 63 64 66 43 61 6e 76 61 73 42 void "cdfCanvasB
2390: 6f 78 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 ox" nonnull-canv
23a0: 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 as double double
23b0: 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 29 29 double double))
23c0: 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 ..(define canvas
23d0: 2d 73 65 63 74 6f 72 21 0a 09 28 66 6f 72 65 69 -sector!..(forei
23e0: 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 gn-lambda void "
23f0: 63 64 66 43 61 6e 76 61 73 53 65 63 74 6f 72 22 cdfCanvasSector"
2400: 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 nonnull-canvas
2410: 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f double double do
2420: 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f 75 62 uble double doub
2430: 6c 65 20 64 6f 75 62 6c 65 29 29 0a 0a 28 64 65 le double))..(de
2440: 66 69 6e 65 20 63 61 6e 76 61 73 2d 63 68 6f 72 fine canvas-chor
2450: 64 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d d!..(foreign-lam
2460: 62 64 61 20 76 6f 69 64 20 22 63 64 66 43 61 6e bda void "cdfCan
2470: 76 61 73 43 68 6f 72 64 22 20 6e 6f 6e 6e 75 6c vasChord" nonnul
2480: 6c 2d 63 61 6e 76 61 73 20 64 6f 75 62 6c 65 20 l-canvas double
2490: 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f double double do
24a0: 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f 75 62 uble double doub
24b0: 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 2d 76 61 le))..(define-va
24c0: 6c 75 65 73 20 28 63 61 6e 76 61 73 2d 62 61 63 lues (canvas-bac
24d0: 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 74 79 20 kground-opacity
24e0: 63 61 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e canvas-backgroun
24f0: 64 2d 6f 70 61 63 69 74 79 2d 73 65 74 21 29 0a d-opacity-set!).
2500: 09 28 6c 65 74 72 65 63 20 28 5b 6f 70 61 63 69 .(letrec ([opaci
2510: 74 69 65 73 0a 09 20 20 20 20 20 20 20 20 20 20 ties..
2520: 28 6c 69 73 74 0a 09 20 20 20 20 20 20 20 20 20 (list..
2530: 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 .(cons..
2540: 20 20 20 09 09 27 6f 70 61 71 75 65 0a 09 20 20 ..'opaque..
2550: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
2560: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 4f 50 41 gn-value "CD_OPA
2570: 51 55 45 22 20 69 6e 74 29 29 0a 09 20 20 20 20 QUE" int))..
2580: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
2590: 20 20 20 20 20 20 20 20 09 09 27 74 72 61 6e 73 ..'trans
25a0: 70 61 72 65 6e 74 0a 09 20 20 20 20 20 20 20 20 parent..
25b0: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
25c0: 75 65 20 22 43 44 5f 54 52 41 4e 53 50 41 52 45 ue "CD_TRANSPARE
25d0: 4e 54 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 20 NT" int)))]..
25e0: 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 62 61 [canvas-ba
25f0: 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 74 79 ckground-opacity
2600: 2d 73 65 74 2f 72 61 77 21 0a 09 20 20 20 20 20 -set/raw!..
2610: 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 (foreign-la
2620: 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e mbda void "cdCan
2630: 76 61 73 42 61 63 6b 4f 70 61 63 69 74 79 22 20 vasBackOpacity"
2640: 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 69 nonnull-canvas i
2650: 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b nt)].. [
2660: 63 61 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e canvas-backgroun
2670: 64 2d 6f 70 61 63 69 74 79 2d 73 65 74 21 0a 09 d-opacity-set!..
2680: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
2690: 61 20 28 63 61 6e 76 61 73 20 6f 70 61 63 69 74 a (canvas opacit
26a0: 79 29 0a 09 09 09 09 09 09 09 28 63 61 6e 76 61 y)........(canva
26b0: 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 s-background-opa
26c0: 63 69 74 79 2d 73 65 74 2f 72 61 77 21 0a 09 09 city-set/raw!...
26d0: 09 09 09 09 09 09 63 61 6e 76 61 73 0a 09 09 09 ......canvas....
26e0: 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 .....(cond......
26f0: 09 09 09 09 5b 28 61 73 73 71 20 6f 70 61 63 69 ....[(assq opaci
2700: 74 79 20 6f 70 61 63 69 74 69 65 73 29 20 3d 3e ty opacities) =>
2710: 20 63 64 72 5d 0a 09 09 09 09 09 09 09 09 09 5b cdr]..........[
2720: 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e else (error 'can
2730: 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 6f vas-background-o
2740: 70 61 63 69 74 79 2d 73 65 74 21 20 22 75 6e 6b pacity-set! "unk
2750: 6e 6f 77 6e 20 6c 69 6e 65 20 63 61 70 22 20 6f nown line cap" o
2760: 70 61 63 69 74 79 29 5d 29 29 29 5d 0a 09 20 20 pacity)])))]..
2770: 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 62 [canvas-b
2780: 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 74 ackground-opacit
2790: 79 2f 72 61 77 0a 09 20 20 20 20 20 20 20 20 20 y/raw..
27a0: 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 (foreign-lambda
27b0: 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d * int ([nonnull-
27c0: 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 0a canvas canvas]).
27d0: 09 20 20 20 20 20 20 20 20 20 20 09 22 43 5f 72 . ."C_r
27e0: 65 74 75 72 6e 28 63 64 43 61 6e 76 61 73 42 61 eturn(cdCanvasBa
27f0: 63 6b 4f 70 61 63 69 74 79 28 63 61 6e 76 61 73 ckOpacity(canvas
2800: 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 29 5d , CD_QUERY));")]
2810: 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 .. [canv
2820: 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 as-background-op
2830: 61 63 69 74 79 0a 09 20 20 20 20 20 20 20 20 20 acity..
2840: 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 (lambda (canvas
2850: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 6c ).. .(l
2860: 65 74 20 28 5b 6f 70 61 63 69 74 79 20 28 63 61 et ([opacity (ca
2870: 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d nvas-background-
2880: 6f 70 61 63 69 74 79 2f 72 61 77 20 63 61 6e 76 opacity/raw canv
2890: 61 73 29 5d 29 0a 09 20 20 20 20 20 20 20 20 20 as)])..
28a0: 20 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 ..(cond........
28b0: 09 09 5b 28 72 61 73 73 6f 63 20 6f 70 61 63 69 ..[(rassoc opaci
28c0: 74 79 20 6f 70 61 63 69 74 69 65 73 29 20 3d 3e ty opacities) =>
28d0: 20 63 61 72 5d 0a 09 09 09 09 09 09 09 09 09 5b car]..........[
28e0: 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e else (error 'can
28f0: 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 6f vas-background-o
2900: 70 61 63 69 74 79 20 22 75 6e 6b 6e 6f 77 6e 20 pacity "unknown
2910: 6f 70 61 63 69 74 79 22 20 6f 70 61 63 69 74 79 opacity" opacity
2920: 29 5d 29 29 29 5d 29 0a 09 09 28 76 61 6c 75 65 )])))])...(value
2930: 73 0a 09 09 09 28 67 65 74 74 65 72 2d 77 69 74 s....(getter-wit
2940: 68 2d 73 65 74 74 65 72 20 63 61 6e 76 61 73 2d h-setter canvas-
2950: 62 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 background-opaci
2960: 74 79 20 63 61 6e 76 61 73 2d 62 61 63 6b 67 72 ty canvas-backgr
2970: 6f 75 6e 64 2d 6f 70 61 63 69 74 79 2d 73 65 74 ound-opacity-set
2980: 21 29 0a 09 09 09 63 61 6e 76 61 73 2d 62 61 63 !)....canvas-bac
2990: 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 74 79 2d kground-opacity-
29a0: 73 65 74 21 29 29 29 0a 0a 28 64 65 66 69 6e 65 set!)))..(define
29b0: 2d 76 61 6c 75 65 73 20 28 63 61 6e 76 61 73 2d -values (canvas-
29c0: 66 69 6c 6c 2d 6d 6f 64 65 20 63 61 6e 76 61 73 fill-mode canvas
29d0: 2d 66 69 6c 6c 2d 6d 6f 64 65 2d 73 65 74 21 29 -fill-mode-set!)
29e0: 0a 09 28 6c 65 74 72 65 63 20 28 5b 66 69 6c 6c ..(letrec ([fill
29f0: 2d 6d 6f 64 65 73 0a 09 20 20 20 20 20 20 20 20 -modes..
2a00: 20 20 28 6c 69 73 74 0a 09 20 20 20 20 20 20 20 (list..
2a10: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
2a20: 20 20 20 20 20 09 09 27 65 76 65 6e 2d 6f 64 64 ..'even-odd
2a30: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
2a40: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
2a50: 5f 45 56 45 4e 4f 44 44 22 20 69 6e 74 29 29 0a _EVENODD" int)).
2a60: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
2a70: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
2a80: 77 69 6e 64 69 6e 67 0a 09 20 20 20 20 20 20 20 winding..
2a90: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
2aa0: 6c 75 65 20 22 43 44 5f 57 49 4e 44 49 4e 47 22 lue "CD_WINDING"
2ab0: 20 69 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 20 int)))]..
2ac0: 20 20 20 5b 63 61 6e 76 61 73 2d 66 69 6c 6c 2d [canvas-fill-
2ad0: 6d 6f 64 65 2d 73 65 74 2f 72 61 77 21 0a 09 20 mode-set/raw!..
2ae0: 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 (foreig
2af0: 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 n-lambda void "c
2b00: 64 43 61 6e 76 61 73 46 69 6c 6c 4d 6f 64 65 22 dCanvasFillMode"
2b10: 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 nonnull-canvas
2b20: 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 int)]..
2b30: 5b 63 61 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f 64 [canvas-fill-mod
2b40: 65 2d 73 65 74 21 0a 09 20 20 20 20 20 20 20 20 e-set!..
2b50: 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 (lambda (canva
2b60: 73 20 66 69 6c 6c 2d 6d 6f 64 65 29 0a 09 09 09 s fill-mode)....
2b70: 09 09 09 09 28 63 61 6e 76 61 73 2d 66 69 6c 6c ....(canvas-fill
2b80: 2d 6d 6f 64 65 2d 73 65 74 2f 72 61 77 21 0a 09 -mode-set/raw!..
2b90: 09 09 09 09 09 09 09 63 61 6e 76 61 73 0a 09 09 .......canvas...
2ba0: 09 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 ......(cond.....
2bb0: 09 09 09 09 09 5b 28 61 73 73 71 20 66 69 6c 6c .....[(assq fill
2bc0: 2d 6d 6f 64 65 20 66 69 6c 6c 2d 6d 6f 64 65 73 -mode fill-modes
2bd0: 29 20 3d 3e 20 63 64 72 5d 0a 09 09 09 09 09 09 ) => cdr].......
2be0: 09 09 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 ...[else (error
2bf0: 27 63 61 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f 64 'canvas-fill-mod
2c00: 65 2d 73 65 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 e-set! "unknown
2c10: 66 69 6c 6c 20 6d 6f 64 65 22 20 66 69 6c 6c 2d fill mode" fill-
2c20: 6d 6f 64 65 29 5d 29 29 29 5d 0a 09 20 20 20 20 mode)])))]..
2c30: 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 66 69 6c [canvas-fil
2c40: 6c 2d 6d 6f 64 65 2f 72 61 77 0a 09 20 20 20 20 l-mode/raw..
2c50: 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c (foreign-l
2c60: 61 6d 62 64 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e ambda* int ([non
2c70: 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e 76 null-canvas canv
2c80: 61 73 5d 29 0a 09 20 20 20 20 20 20 20 20 20 20 as])..
2c90: 09 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e ."C_return(cdCan
2ca0: 76 61 73 46 69 6c 6c 4d 6f 64 65 28 63 61 6e 76 vasFillMode(canv
2cb0: 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 as, CD_QUERY));"
2cc0: 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 )].. [ca
2cd0: 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f 64 65 0a 09 nvas-fill-mode..
2ce0: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
2cf0: 61 20 28 63 61 6e 76 61 73 29 0a 09 20 20 20 20 a (canvas)..
2d00: 20 20 20 20 20 20 09 28 6c 65 74 20 28 5b 66 69 .(let ([fi
2d10: 6c 6c 2d 6d 6f 64 65 20 28 63 61 6e 76 61 73 2d ll-mode (canvas-
2d20: 66 69 6c 6c 2d 6d 6f 64 65 2f 72 61 77 20 63 61 fill-mode/raw ca
2d30: 6e 76 61 73 29 5d 29 0a 09 09 09 09 09 09 09 09 nvas)]).........
2d40: 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 5b (cond..........[
2d50: 28 72 61 73 73 6f 63 20 66 69 6c 6c 2d 6d 6f 64 (rassoc fill-mod
2d60: 65 20 66 69 6c 6c 2d 6d 6f 64 65 73 29 20 3d 3e e fill-modes) =>
2d70: 20 63 61 72 5d 0a 09 09 09 09 09 09 09 09 09 5b car]..........[
2d80: 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e else (error 'can
2d90: 76 61 73 2d 66 69 6c 6c 2d 6d 6f 64 65 20 22 75 vas-fill-mode "u
2da0: 6e 6b 6e 6f 77 6e 20 66 69 6c 6c 20 6d 6f 64 65 nknown fill mode
2db0: 22 20 66 69 6c 6c 2d 6d 6f 64 65 29 5d 29 29 29 " fill-mode)])))
2dc0: 5d 29 0a 09 09 28 76 61 6c 75 65 73 0a 09 09 09 ])...(values....
2dd0: 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 74 (getter-with-set
2de0: 74 65 72 20 63 61 6e 76 61 73 2d 66 69 6c 6c 2d ter canvas-fill-
2df0: 6d 6f 64 65 20 63 61 6e 76 61 73 2d 66 69 6c 6c mode canvas-fill
2e00: 2d 6d 6f 64 65 2d 73 65 74 21 29 0a 09 09 09 63 -mode-set!)....c
2e10: 61 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f 64 65 2d anvas-fill-mode-
2e20: 73 65 74 21 29 29 29 0a 0a 28 64 65 66 69 6e 65 set!)))..(define
2e30: 2d 76 61 6c 75 65 73 20 28 63 61 6e 76 61 73 2d -values (canvas-
2e40: 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 20 63 interior-style c
2e50: 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d 73 anvas-interior-s
2e60: 74 79 6c 65 2d 73 65 74 21 29 0a 09 28 6c 65 74 tyle-set!)..(let
2e70: 72 65 63 20 28 5b 69 6e 74 65 72 69 6f 72 2d 73 rec ([interior-s
2e80: 74 79 6c 65 73 0a 09 20 20 20 20 20 20 20 20 20 tyles..
2e90: 20 28 6c 69 73 74 0a 09 20 20 20 20 20 20 20 20 (list..
2ea0: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
2eb0: 20 20 20 20 09 09 27 73 6f 6c 69 64 0a 09 20 20 ..'solid..
2ec0: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
2ed0: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 53 4f 4c gn-value "CD_SOL
2ee0: 49 44 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 ID" int))..
2ef0: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
2f00: 20 20 20 20 20 20 20 09 09 27 68 6f 6c 6c 6f 77 ..'hollow
2f10: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
2f20: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
2f30: 5f 48 4f 4c 4c 4f 57 22 20 69 6e 74 29 29 0a 09 _HOLLOW" int))..
2f40: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
2f50: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 68 .. ..'h
2f60: 61 74 63 68 0a 09 20 20 20 20 20 20 20 20 20 20 atch..
2f70: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
2f80: 20 22 43 44 5f 48 41 54 43 48 22 20 69 6e 74 29 "CD_HATCH" int)
2f90: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
2fa0: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
2fb0: 09 27 73 74 69 70 70 6c 65 0a 09 20 20 20 20 20 .'stipple..
2fc0: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
2fd0: 76 61 6c 75 65 20 22 43 44 5f 53 54 49 50 50 4c value "CD_STIPPL
2fe0: 45 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 E" int))..
2ff0: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
3000: 20 20 20 20 20 20 09 09 27 70 61 74 74 65 72 6e ..'pattern
3010: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
3020: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
3030: 5f 50 41 54 54 45 52 4e 22 20 69 6e 74 29 29 29 _PATTERN" int)))
3040: 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 68 61 74 ].. [hat
3050: 63 68 2d 73 74 79 6c 65 73 0a 09 20 20 20 20 20 ch-styles..
3060: 20 20 20 20 20 28 6c 69 73 74 0a 09 20 20 20 20 (list..
3070: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
3080: 20 20 20 20 20 20 20 20 09 09 27 68 6f 72 69 7a ..'horiz
3090: 6f 6e 74 61 6c 0a 09 20 20 20 20 20 20 20 20 20 ontal..
30a0: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
30b0: 65 20 22 43 44 5f 48 4f 52 49 5a 4f 4e 54 41 4c e "CD_HORIZONTAL
30c0: 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 " int))..
30d0: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
30e0: 20 20 20 20 20 09 09 27 76 65 72 74 69 63 61 6c ..'vertical
30f0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
3100: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
3110: 5f 56 45 52 54 49 43 41 4c 22 20 69 6e 74 29 29 _VERTICAL" int))
3120: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
3130: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
3140: 27 66 6f 72 77 61 72 64 2d 64 69 61 67 6f 6e 61 'forward-diagona
3150: 6c 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 l.. ..(
3160: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
3170: 44 5f 46 44 49 41 47 4f 4e 41 4c 22 20 69 6e 74 D_FDIAGONAL" int
3180: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
3190: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
31a0: 09 09 27 62 61 63 6b 77 61 72 64 2d 64 69 61 67 ..'backward-diag
31b0: 6f 6e 61 6c 0a 09 20 20 20 20 20 20 20 20 20 20 onal..
31c0: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
31d0: 20 22 43 44 5f 42 44 49 41 47 4f 4e 41 4c 22 20 "CD_BDIAGONAL"
31e0: 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 int))..
31f0: 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 .(cons..
3200: 20 20 20 09 09 27 63 72 6f 73 73 0a 09 20 20 20 ..'cross..
3210: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
3220: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 52 4f 53 n-value "CD_CROS
3230: 53 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 S" int))..
3240: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
3250: 20 20 20 20 20 20 09 09 27 64 69 61 67 6f 6e 61 ..'diagona
3260: 6c 2d 63 72 6f 73 73 0a 09 20 20 20 20 20 20 20 l-cross..
3270: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
3280: 6c 75 65 20 22 43 44 5f 44 49 41 47 43 52 4f 53 lue "CD_DIAGCROS
3290: 53 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 20 20 S" int)))]..
32a0: 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 68 61 74 [canvas-hat
32b0: 63 68 2d 73 74 79 6c 65 2d 73 65 74 2f 72 61 77 ch-style-set/raw
32c0: 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f !.. (fo
32d0: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 69 6e 74 reign-lambda int
32e0: 20 22 63 64 43 61 6e 76 61 73 48 61 74 63 68 22 "cdCanvasHatch"
32f0: 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 nonnull-canvas
3300: 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 int)]..
3310: 5b 63 61 6e 76 61 73 2d 68 61 74 63 68 2d 73 74 [canvas-hatch-st
3320: 79 6c 65 2f 72 61 77 0a 09 20 20 20 20 20 20 20 yle/raw..
3330: 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 (foreign-lamb
3340: 64 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c da* int ([nonnul
3350: 6c 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d l-canvas canvas]
3360: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 43 ).. ."C
3370: 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 61 73 _return(cdCanvas
3380: 48 61 74 63 68 28 63 61 6e 76 61 73 2c 20 43 44 Hatch(canvas, CD
3390: 5f 51 55 45 52 59 29 29 3b 22 29 5d 0a 09 20 20 _QUERY));")]..
33a0: 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 73 [canvas-s
33b0: 74 69 70 70 6c 65 2d 73 65 74 2f 72 61 77 21 0a tipple-set/raw!.
33c0: 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 . (fore
33d0: 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 76 6f 69 64 ign-lambda* void
33e0: 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 ([nonnull-canva
33f0: 73 20 63 61 6e 76 61 73 5d 20 5b 69 6e 74 20 77 s canvas] [int w
3400: 69 64 74 68 5d 20 5b 69 6e 74 20 68 65 69 67 68 idth] [int heigh
3410: 74 5d 20 5b 6e 6f 6e 6e 75 6c 6c 2d 62 6c 6f 62 t] [nonnull-blob
3420: 20 64 61 74 61 5d 29 0a 09 20 20 20 20 20 20 20 data])..
3430: 20 20 20 09 22 75 6e 73 69 67 6e 65 64 20 63 68 ."unsigned ch
3440: 61 72 20 6d 61 73 6b 5b 77 69 64 74 68 20 2a 20 ar mask[width *
3450: 68 65 69 67 68 74 5d 3b 5c 6e 22 0a 09 20 20 20 height];\n"..
3460: 20 20 20 20 20 20 20 09 22 69 6e 74 20 69 2c 20 ."int i,
3470: 6a 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 j;\n"..
3480: 20 09 22 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 ."\n"..
3490: 20 20 09 22 66 6f 72 20 28 6a 20 3d 20 30 3b 20 ."for (j = 0;
34a0: 6a 20 3c 20 68 65 69 67 68 74 3b 20 2b 2b 6a 29 j < height; ++j)
34b0: 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 {\n"..
34c0: 20 09 22 09 66 6f 72 20 28 69 20 3d 20 30 3b 20 .".for (i = 0;
34d0: 69 20 3c 20 77 69 64 74 68 3b 20 2b 2b 69 29 20 i < width; ++i)
34e0: 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 {\n"..
34f0: 09 22 09 09 63 6f 6e 73 74 20 69 6e 74 20 6f 66 ."..const int of
3500: 73 20 3d 20 28 6a 20 2a 20 77 69 64 74 68 29 20 s = (j * width)
3510: 2b 20 69 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 + i;\n"..
3520: 20 20 20 09 22 09 09 6d 61 73 6b 5b 6f 66 73 5d ."..mask[ofs]
3530: 20 3d 20 28 64 61 74 61 5b 6f 66 73 20 2f 20 38 = (data[ofs / 8
3540: 5d 20 3e 3e 20 28 6f 66 73 20 25 20 38 29 29 20 ] >> (ofs % 8))
3550: 26 20 31 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 & 1;\n"..
3560: 20 20 20 09 22 09 7d 5c 6e 22 0a 09 20 20 20 20 .".}\n"..
3570: 20 20 20 20 20 20 09 22 7d 5c 6e 22 0a 09 20 20 ."}\n"..
3580: 20 20 20 20 20 20 20 20 09 22 63 64 43 61 6e 76 ."cdCanv
3590: 61 73 53 74 69 70 70 6c 65 28 63 61 6e 76 61 73 asStipple(canvas
35a0: 2c 20 77 69 64 74 68 2c 20 68 65 69 67 68 74 2c , width, height,
35b0: 20 6d 61 73 6b 29 3b 5c 6e 22 29 5d 0a 09 20 20 mask);\n")]..
35c0: 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 73 [canvas-s
35d0: 74 69 70 70 6c 65 2f 72 61 77 0a 09 20 20 20 20 tipple/raw..
35e0: 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c (foreign-l
35f0: 61 6d 62 64 61 2a 20 76 6f 69 64 20 28 5b 6e 6f ambda* void ([no
3600: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e nnull-canvas can
3610: 76 61 73 5d 20 5b 28 63 2d 70 6f 69 6e 74 65 72 vas] [(c-pointer
3620: 20 69 6e 74 29 20 70 77 69 64 74 68 5d 20 5b 28 int) pwidth] [(
3630: 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 70 c-pointer int) p
3640: 68 65 69 67 68 74 5d 20 5b 62 6c 6f 62 20 64 61 height] [blob da
3650: 74 61 5d 29 0a 09 20 20 20 20 20 20 20 20 20 20 ta])..
3660: 09 22 75 6e 73 69 67 6e 65 64 20 63 68 61 72 20 ."unsigned char
3670: 2a 6d 61 73 6b 20 3d 20 63 64 43 61 6e 76 61 73 *mask = cdCanvas
3680: 47 65 74 53 74 69 70 70 6c 65 28 63 61 6e 76 61 GetStipple(canva
3690: 73 2c 20 70 77 69 64 74 68 2c 20 70 68 65 69 67 s, pwidth, pheig
36a0: 68 74 29 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 ht);\n"..
36b0: 20 20 20 09 22 5c 6e 22 0a 09 20 20 20 20 20 20 ."\n"..
36c0: 20 20 20 20 09 22 69 66 20 28 64 61 74 61 29 20 ."if (data)
36d0: 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 {\n"..
36e0: 09 22 09 69 6e 74 20 77 69 64 74 68 20 3d 20 2a .".int width = *
36f0: 70 77 69 64 74 68 2c 20 68 65 69 67 68 74 20 3d pwidth, height =
3700: 20 2a 70 68 65 69 67 68 74 3b 5c 6e 22 0a 09 20 *pheight;\n"..
3710: 20 20 20 20 20 20 20 20 20 09 22 09 69 6e 74 20 .".int
3720: 69 2c 20 6a 3b 5c 6e 22 0a 09 20 20 20 20 20 20 i, j;\n"..
3730: 20 20 20 20 09 22 09 5c 6e 22 0a 09 20 20 20 20 .".\n"..
3740: 20 20 20 20 20 20 09 22 09 66 6f 72 20 28 6a 20 .".for (j
3750: 3d 20 30 3b 20 6a 20 3c 20 68 65 69 67 68 74 3b = 0; j < height;
3760: 20 2b 2b 6a 29 20 7b 5c 6e 22 0a 09 20 20 20 20 ++j) {\n"..
3770: 20 20 20 20 20 20 09 22 09 09 66 6f 72 20 28 69 ."..for (i
3780: 20 3d 20 30 3b 20 69 20 3c 20 77 69 64 74 68 3b = 0; i < width;
3790: 20 2b 2b 69 29 20 7b 5c 6e 22 0a 09 20 20 20 20 ++i) {\n"..
37a0: 20 20 20 20 20 20 09 22 09 09 09 63 6f 6e 73 74 ."...const
37b0: 20 69 6e 74 20 6f 66 73 20 3d 20 28 6a 20 2a 20 int ofs = (j *
37c0: 77 69 64 74 68 29 20 2b 20 69 3b 5c 6e 22 0a 09 width) + i;\n"..
37d0: 20 20 20 20 20 20 20 20 20 20 09 22 09 09 09 63 ."...c
37e0: 6f 6e 73 74 20 69 6e 74 20 76 6f 66 73 20 3d 20 onst int vofs =
37f0: 6f 66 73 20 2f 20 38 2c 20 62 6f 66 73 20 3d 20 ofs / 8, bofs =
3800: 6f 66 73 20 25 20 38 3b 5c 6e 22 0a 09 20 20 20 ofs % 8;\n"..
3810: 20 20 20 20 20 20 20 09 22 09 09 09 63 6f 6e 73 ."...cons
3820: 74 20 75 6e 73 69 67 6e 65 64 20 63 68 61 72 20 t unsigned char
3830: 62 69 74 20 3d 20 6d 61 73 6b 5b 6f 66 73 5d 20 bit = mask[ofs]
3840: 26 20 31 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 & 1;\n"..
3850: 20 20 20 09 22 09 09 09 5c 6e 22 0a 09 20 20 20 ."...\n"..
3860: 20 20 20 20 20 20 20 09 22 09 09 09 69 66 20 28 ."...if (
3870: 62 6f 66 73 20 3e 20 30 29 5c 6e 22 0a 09 20 20 bofs > 0)\n"..
3880: 20 20 20 20 20 20 20 20 09 22 09 09 09 09 64 61 ."....da
3890: 74 61 5b 76 6f 66 73 5d 20 7c 3d 20 62 69 74 20 ta[vofs] |= bit
38a0: 3c 3c 20 62 6f 66 73 3b 5c 6e 22 0a 09 20 20 20 << bofs;\n"..
38b0: 20 20 20 20 20 20 20 09 22 09 09 09 65 6c 73 65 ."...else
38c0: 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 \n".. .
38d0: 22 09 09 09 09 64 61 74 61 5b 76 6f 66 73 5d 20 "....data[vofs]
38e0: 3d 20 62 69 74 3b 5c 6e 22 0a 09 20 20 20 20 20 = bit;\n"..
38f0: 20 20 20 20 20 09 22 09 09 7d 5c 6e 22 0a 09 20 ."..}\n"..
3900: 20 20 20 20 20 20 20 20 20 09 22 09 7d 5c 6e 22 .".}\n"
3910: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 7d 5c .. ."}\
3920: 6e 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b n")].. [
3930: 63 61 6e 76 61 73 2d 70 61 74 74 65 72 6e 2d 73 canvas-pattern-s
3940: 65 74 2f 72 67 62 2f 72 61 77 21 0a 09 20 20 20 et/rgb/raw!..
3950: 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d (foreign-
3960: 6c 61 6d 62 64 61 2a 20 76 6f 69 64 20 28 5b 6e lambda* void ([n
3970: 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 onnull-canvas ca
3980: 6e 76 61 73 5d 20 5b 69 6e 74 20 77 69 64 74 68 nvas] [int width
3990: 5d 20 5b 69 6e 74 20 68 65 69 67 68 74 5d 20 5b ] [int height] [
39a0: 6e 6f 6e 6e 75 6c 6c 2d 62 6c 6f 62 20 64 61 74 nonnull-blob dat
39b0: 61 5d 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 a]).. .
39c0: 22 6c 6f 6e 67 20 63 6f 6c 6f 72 5b 77 69 64 74 "long color[widt
39d0: 68 20 2a 20 68 65 69 67 68 74 5d 3b 5c 6e 22 0a h * height];\n".
39e0: 09 20 20 20 20 20 20 20 20 20 20 09 22 69 6e 74 . ."int
39f0: 20 69 2c 20 6a 3b 5c 6e 22 0a 09 20 20 20 20 20 i, j;\n"..
3a00: 20 20 20 20 20 09 22 5c 6e 22 0a 09 20 20 20 20 ."\n"..
3a10: 20 20 20 20 20 20 09 22 66 6f 72 20 28 6a 20 3d ."for (j =
3a20: 20 30 3b 20 6a 20 3c 20 68 65 69 67 68 74 3b 20 0; j < height;
3a30: 2b 2b 6a 29 20 7b 5c 6e 22 0a 09 20 20 20 20 20 ++j) {\n"..
3a40: 20 20 20 20 20 09 22 09 66 6f 72 20 28 69 20 3d .".for (i =
3a50: 20 30 3b 20 69 20 3c 20 77 69 64 74 68 3b 20 2b 0; i < width; +
3a60: 2b 69 2c 20 64 61 74 61 20 2b 3d 20 33 29 20 7b +i, data += 3) {
3a70: 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 \n".. .
3a80: 22 09 09 63 6f 6c 6f 72 5b 28 6a 20 2a 20 77 69 "..color[(j * wi
3a90: 64 74 68 29 20 2b 20 69 5d 20 3d 5c 6e 22 0a 09 dth) + i] =\n"..
3aa0: 20 20 20 20 20 20 20 20 20 20 09 22 09 09 09 28 ."...(
3ab0: 64 61 74 61 5b 30 5d 20 3c 3c 20 31 36 29 20 7c data[0] << 16) |
3ac0: 20 28 64 61 74 61 5b 31 5d 20 3c 3c 20 38 29 20 (data[1] << 8)
3ad0: 7c 20 28 64 61 74 61 5b 32 5d 29 3b 5c 6e 22 0a | (data[2]);\n".
3ae0: 09 20 20 20 20 20 20 20 20 20 20 09 22 09 7d 5c . .".}\
3af0: 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 n".. ."
3b00: 7d 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 }\n"..
3b10: 09 22 63 64 43 61 6e 76 61 73 50 61 74 74 65 72 ."cdCanvasPatter
3b20: 6e 28 63 61 6e 76 61 73 2c 20 77 69 64 74 68 2c n(canvas, width,
3b30: 20 68 65 69 67 68 74 2c 20 63 6f 6c 6f 72 29 3b height, color);
3b40: 5c 6e 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 \n")]..
3b50: 5b 63 61 6e 76 61 73 2d 70 61 74 74 65 72 6e 2d [canvas-pattern-
3b60: 73 65 74 2f 72 67 62 61 2f 72 61 77 21 0a 09 20 set/rgba/raw!..
3b70: 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 (foreig
3b80: 6e 2d 6c 61 6d 62 64 61 2a 20 76 6f 69 64 20 28 n-lambda* void (
3b90: 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 [nonnull-canvas
3ba0: 63 61 6e 76 61 73 5d 20 5b 69 6e 74 20 77 69 64 canvas] [int wid
3bb0: 74 68 5d 20 5b 69 6e 74 20 68 65 69 67 68 74 5d th] [int height]
3bc0: 20 5b 6e 6f 6e 6e 75 6c 6c 2d 62 6c 6f 62 20 64 [nonnull-blob d
3bd0: 61 74 61 5d 29 0a 09 20 20 20 20 20 20 20 20 20 ata])..
3be0: 20 09 22 6c 6f 6e 67 20 63 6f 6c 6f 72 5b 77 69 ."long color[wi
3bf0: 64 74 68 20 2a 20 68 65 69 67 68 74 5d 3b 5c 6e dth * height];\n
3c00: 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 69 ".. ."i
3c10: 6e 74 20 69 2c 20 6a 3b 5c 6e 22 0a 09 20 20 20 nt i, j;\n"..
3c20: 20 20 20 20 20 20 20 09 22 5c 6e 22 0a 09 20 20 ."\n"..
3c30: 20 20 20 20 20 20 20 20 09 22 66 6f 72 20 28 6a ."for (j
3c40: 20 3d 20 30 3b 20 6a 20 3c 20 68 65 69 67 68 74 = 0; j < height
3c50: 3b 20 2b 2b 6a 29 20 7b 5c 6e 22 0a 09 20 20 20 ; ++j) {\n"..
3c60: 20 20 20 20 20 20 20 09 22 09 66 6f 72 20 28 69 .".for (i
3c70: 20 3d 20 30 3b 20 69 20 3c 20 77 69 64 74 68 3b = 0; i < width;
3c80: 20 2b 2b 69 2c 20 64 61 74 61 20 2b 3d 20 34 29 ++i, data += 4)
3c90: 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 {\n"..
3ca0: 20 09 22 09 09 63 6f 6c 6f 72 5b 28 6a 20 2a 20 ."..color[(j *
3cb0: 77 69 64 74 68 29 20 2b 20 69 5d 20 3d 5c 6e 22 width) + i] =\n"
3cc0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 09 09 .. ."..
3cd0: 09 28 28 30 78 66 66 20 2d 20 64 61 74 61 5b 33 .((0xff - data[3
3ce0: 5d 29 20 3c 3c 20 32 34 29 20 7c 20 28 64 61 74 ]) << 24) | (dat
3cf0: 61 5b 30 5d 20 3c 3c 20 31 36 29 20 7c 20 28 64 a[0] << 16) | (d
3d00: 61 74 61 5b 31 5d 20 3c 3c 20 38 29 20 7c 20 28 ata[1] << 8) | (
3d10: 64 61 74 61 5b 32 5d 29 3b 5c 6e 22 0a 09 20 20 data[2]);\n"..
3d20: 20 20 20 20 20 20 20 20 09 22 09 7d 5c 6e 22 0a .".}\n".
3d30: 09 20 20 20 20 20 20 20 20 20 20 09 22 7d 5c 6e . ."}\n
3d40: 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 63 ".. ."c
3d50: 64 43 61 6e 76 61 73 50 61 74 74 65 72 6e 28 63 dCanvasPattern(c
3d60: 61 6e 76 61 73 2c 20 77 69 64 74 68 2c 20 68 65 anvas, width, he
3d70: 69 67 68 74 2c 20 63 6f 6c 6f 72 29 3b 5c 6e 22 ight, color);\n"
3d80: 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 )].. [ca
3d90: 6e 76 61 73 2d 70 61 74 74 65 72 6e 2f 72 67 62 nvas-pattern/rgb
3da0: 61 2f 72 61 77 0a 09 20 20 20 20 20 20 20 20 20 a/raw..
3db0: 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 (foreign-lambda
3dc0: 2a 20 76 6f 69 64 20 28 5b 6e 6f 6e 6e 75 6c 6c * void ([nonnull
3dd0: 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d 20 -canvas canvas]
3de0: 5b 28 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 [(c-pointer int)
3df0: 20 70 77 69 64 74 68 5d 20 5b 28 63 2d 70 6f 69 pwidth] [(c-poi
3e00: 6e 74 65 72 20 69 6e 74 29 20 70 68 65 69 67 68 nter int) pheigh
3e10: 74 5d 20 5b 62 6c 6f 62 20 64 61 74 61 5d 29 0a t] [blob data]).
3e20: 09 20 20 20 20 20 20 20 20 20 20 09 22 6c 6f 6e . ."lon
3e30: 67 20 2a 63 6f 6c 6f 72 20 3d 20 63 64 43 61 6e g *color = cdCan
3e40: 76 61 73 47 65 74 50 61 74 74 65 72 6e 28 63 61 vasGetPattern(ca
3e50: 6e 76 61 73 2c 20 70 77 69 64 74 68 2c 20 70 68 nvas, pwidth, ph
3e60: 65 69 67 68 74 29 3b 5c 6e 22 0a 09 20 20 20 20 eight);\n"..
3e70: 20 20 20 20 20 20 09 22 5c 6e 22 0a 09 20 20 20 ."\n"..
3e80: 20 20 20 20 20 20 20 09 22 69 66 20 28 64 61 74 ."if (dat
3e90: 61 29 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 a) {\n"..
3ea0: 20 20 20 09 22 09 69 6e 74 20 77 69 64 74 68 20 .".int width
3eb0: 3d 20 2a 70 77 69 64 74 68 2c 20 68 65 69 67 68 = *pwidth, heigh
3ec0: 74 20 3d 20 2a 70 68 65 69 67 68 74 3b 5c 6e 22 t = *pheight;\n"
3ed0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 09 69 .. .".i
3ee0: 6e 74 20 69 2c 20 6a 3b 5c 6e 22 0a 09 20 20 20 nt i, j;\n"..
3ef0: 20 20 20 20 20 20 20 09 22 09 5c 6e 22 0a 09 20 .".\n"..
3f00: 20 20 20 20 20 20 20 20 20 09 22 09 66 6f 72 20 .".for
3f10: 28 6a 20 3d 20 30 3b 20 6a 20 3c 20 68 65 69 67 (j = 0; j < heig
3f20: 68 74 3b 20 2b 2b 6a 29 20 7b 5c 6e 22 0a 09 20 ht; ++j) {\n"..
3f30: 20 20 20 20 20 20 20 20 20 09 22 09 09 66 6f 72 ."..for
3f40: 20 28 69 20 3d 20 30 3b 20 69 20 3c 20 77 69 64 (i = 0; i < wid
3f50: 74 68 3b 20 2b 2b 69 2c 20 64 61 74 61 20 2b 3d th; ++i, data +=
3f60: 20 34 29 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 4) {\n"..
3f70: 20 20 20 20 09 22 09 09 09 6c 6f 6e 67 20 63 20 ."...long c
3f80: 3d 20 63 6f 6c 6f 72 5b 28 6a 20 2a 20 77 69 64 = color[(j * wid
3f90: 74 68 29 20 2b 20 69 5d 3b 5c 6e 22 0a 09 20 20 th) + i];\n"..
3fa0: 20 20 20 20 20 20 20 20 09 22 09 09 09 64 61 74 ."...dat
3fb0: 61 5b 33 5d 20 3d 20 30 78 66 66 20 2d 20 28 28 a[3] = 0xff - ((
3fc0: 63 20 3e 3e 20 32 34 29 20 26 20 30 78 66 66 29 c >> 24) & 0xff)
3fd0: 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 ;\n"..
3fe0: 09 22 09 09 09 64 61 74 61 5b 30 5d 20 3d 20 28 ."...data[0] = (
3ff0: 63 20 3e 3e 20 31 36 29 20 26 20 30 78 66 66 3b c >> 16) & 0xff;
4000: 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 \n".. .
4010: 22 09 09 09 64 61 74 61 5b 31 5d 20 3d 20 28 63 "...data[1] = (c
4020: 20 3e 3e 20 38 29 20 26 20 30 78 66 66 3b 5c 6e >> 8) & 0xff;\n
4030: 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 09 ".. .".
4040: 09 09 64 61 74 61 5b 32 5d 20 3d 20 63 20 26 20 ..data[2] = c &
4050: 30 78 66 66 3b 5c 6e 22 0a 09 20 20 20 20 20 20 0xff;\n"..
4060: 20 20 20 20 09 22 09 09 7d 5c 6e 22 0a 09 20 20 ."..}\n"..
4070: 20 20 20 20 20 20 20 20 09 22 09 7d 5c 6e 22 0a .".}\n".
4080: 09 20 20 20 20 20 20 20 20 20 20 09 22 7d 5c 6e . ."}\n
4090: 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 ")].. [c
40a0: 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d 73 anvas-interior-s
40b0: 74 79 6c 65 2d 73 65 74 2f 72 61 77 21 0a 09 20 tyle-set/raw!..
40c0: 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 (foreig
40d0: 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 n-lambda void "c
40e0: 64 43 61 6e 76 61 73 49 6e 74 65 72 69 6f 72 53 dCanvasInteriorS
40f0: 74 79 6c 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 tyle" nonnull-ca
4100: 6e 76 61 73 20 69 6e 74 29 5d 0a 09 20 20 20 20 nvas int)]..
4110: 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 69 6e 74 [canvas-int
4120: 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 74 21 erior-style-set!
4130: 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d .. (lam
4140: 62 64 61 20 28 63 61 6e 76 61 73 20 69 6e 74 65 bda (canvas inte
4150: 72 69 6f 72 2d 73 74 79 6c 65 29 0a 09 09 09 09 rior-style).....
4160: 09 09 09 28 63 61 73 65 20 28 61 6e 64 20 28 70 ...(case (and (p
4170: 61 69 72 3f 20 69 6e 74 65 72 69 6f 72 2d 73 74 air? interior-st
4180: 79 6c 65 29 20 28 63 61 72 20 69 6e 74 65 72 69 yle) (car interi
4190: 6f 72 2d 73 74 79 6c 65 29 29 0a 09 09 09 09 09 or-style))......
41a0: 09 09 09 5b 28 68 61 74 63 68 29 0a 09 09 09 09 ...[(hatch).....
41b0: 09 09 09 09 20 28 6c 65 74 20 28 5b 68 61 74 63 .... (let ([hatc
41c0: 68 2d 73 74 79 6c 65 20 28 63 61 64 72 20 69 6e h-style (cadr in
41d0: 74 65 72 69 6f 72 2d 73 74 79 6c 65 29 5d 29 0a terior-style)]).
41e0: 09 09 09 09 09 09 09 09 09 20 28 63 61 6e 76 61 ......... (canva
41f0: 73 2d 68 61 74 63 68 2d 73 74 79 6c 65 2d 73 65 s-hatch-style-se
4200: 74 2f 72 61 77 21 0a 09 09 09 09 09 09 09 09 09 t/raw!..........
4210: 09 20 63 61 6e 76 61 73 0a 09 09 09 09 09 09 09 . canvas........
4220: 09 09 09 20 28 63 6f 6e 64 0a 09 09 09 09 09 09 ... (cond.......
4230: 09 09 09 09 20 09 20 5b 28 61 73 73 71 20 68 61 .... . [(assq ha
4240: 74 63 68 2d 73 74 79 6c 65 20 68 61 74 63 68 2d tch-style hatch-
4250: 73 74 79 6c 65 73 29 20 3d 3e 20 63 64 72 5d 0a styles) => cdr].
4260: 09 09 09 09 09 09 09 09 09 09 20 09 20 5b 65 6c .......... . [el
4270: 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e 76 61 se (error 'canva
4280: 73 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 s-interior-style
4290: 2d 73 65 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 68 -set! "unknown h
42a0: 61 74 63 68 20 73 74 79 6c 65 22 20 68 61 74 63 atch style" hatc
42b0: 68 2d 73 74 79 6c 65 29 5d 29 29 0a 09 09 09 09 h-style)])).....
42c0: 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 69 6e ..... (canvas-in
42d0: 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 74 terior-style-set
42e0: 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 63 64 /raw! canvas (cd
42f0: 72 20 28 61 73 73 71 20 27 68 61 74 63 68 20 69 r (assq 'hatch i
4300: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 73 29 29 nterior-styles))
4310: 29 29 5d 0a 09 09 09 09 09 09 09 09 5b 28 73 74 ))].........[(st
4320: 69 70 70 6c 65 29 0a 09 09 09 09 09 09 09 09 20 ipple).........
4330: 28 6c 65 74 20 28 5b 77 69 64 74 68 20 28 63 61 (let ([width (ca
4340: 64 72 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c dr interior-styl
4350: 65 29 5d 0a 09 09 09 09 09 09 09 09 09 09 09 20 e)]............
4360: 5b 68 65 69 67 68 74 20 28 63 61 64 64 72 20 69 [height (caddr i
4370: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 29 5d 0a nterior-style)].
4380: 09 09 09 09 09 09 09 09 09 09 09 20 5b 64 61 74 ........... [dat
4390: 61 20 28 63 61 64 64 64 72 20 69 6e 74 65 72 69 a (cadddr interi
43a0: 6f 72 2d 73 74 79 6c 65 29 5d 29 0a 09 09 09 09 or-style)]).....
43b0: 09 09 09 09 09 20 28 75 6e 6c 65 73 73 20 28 3d ..... (unless (=
43c0: 20 28 62 6c 6f 62 2d 73 69 7a 65 20 64 61 74 61 (blob-size data
43d0: 29 20 28 63 65 69 6c 69 6e 67 20 28 2f 20 28 2a ) (ceiling (/ (*
43e0: 20 77 69 64 74 68 20 68 65 69 67 68 74 29 20 38 width height) 8
43f0: 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 28 )))........... (
4400: 65 72 72 6f 72 20 27 63 61 6e 76 61 73 2d 69 6e error 'canvas-in
4410: 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 74 terior-style-set
4420: 21 20 22 62 61 64 20 73 74 69 70 70 6c 65 20 64 ! "bad stipple d
4430: 61 74 61 20 6c 65 6e 67 74 68 22 20 28 62 6c 6f ata length" (blo
4440: 62 2d 73 69 7a 65 20 64 61 74 61 29 20 28 63 65 b-size data) (ce
4450: 69 6c 69 6e 67 20 28 2f 20 28 2a 20 77 69 64 74 iling (/ (* widt
4460: 68 20 68 65 69 67 68 74 29 20 38 29 29 29 29 0a h height) 8)))).
4470: 09 09 09 09 09 09 09 09 09 20 28 63 61 6e 76 61 ......... (canva
4480: 73 2d 73 74 69 70 70 6c 65 2d 73 65 74 2f 72 61 s-stipple-set/ra
4490: 77 21 20 63 61 6e 76 61 73 20 77 69 64 74 68 20 w! canvas width
44a0: 68 65 69 67 68 74 20 64 61 74 61 29 0a 09 09 09 height data)....
44b0: 09 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 69 ...... (canvas-i
44c0: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 nterior-style-se
44d0: 74 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 63 t/raw! canvas (c
44e0: 64 72 20 28 61 73 73 71 20 27 73 74 69 70 70 6c dr (assq 'stippl
44f0: 65 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 e interior-style
4500: 73 29 29 29 29 5d 0a 09 09 09 09 09 09 09 09 5b s))))].........[
4510: 28 70 61 74 74 65 72 6e 2f 72 67 62 29 0a 09 09 (pattern/rgb)...
4520: 09 09 09 09 09 09 20 28 6c 65 74 20 28 5b 77 69 ...... (let ([wi
4530: 64 74 68 20 28 63 61 64 72 20 69 6e 74 65 72 69 dth (cadr interi
4540: 6f 72 2d 73 74 79 6c 65 29 5d 0a 09 09 09 09 09 or-style)]......
4550: 09 09 09 09 09 09 20 5b 68 65 69 67 68 74 20 28 ...... [height (
4560: 63 61 64 64 72 20 69 6e 74 65 72 69 6f 72 2d 73 caddr interior-s
4570: 74 79 6c 65 29 5d 0a 09 09 09 09 09 09 09 09 09 tyle)]..........
4580: 09 09 20 5b 64 61 74 61 20 28 63 61 64 64 64 72 .. [data (cadddr
4590: 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 29 interior-style)
45a0: 5d 29 0a 09 09 09 09 09 09 09 09 09 20 28 75 6e ]).......... (un
45b0: 6c 65 73 73 20 28 3d 20 28 62 6c 6f 62 2d 73 69 less (= (blob-si
45c0: 7a 65 20 64 61 74 61 29 20 28 2a 20 33 20 77 69 ze data) (* 3 wi
45d0: 64 74 68 20 68 65 69 67 68 74 29 29 0a 09 09 09 dth height))....
45e0: 09 09 09 09 09 09 09 20 28 65 72 72 6f 72 20 27 ....... (error '
45f0: 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d canvas-interior-
4600: 73 74 79 6c 65 2d 73 65 74 21 20 22 62 61 64 20 style-set! "bad
4610: 70 61 74 74 65 72 6e 20 64 61 74 61 20 6c 65 6e pattern data len
4620: 67 74 68 22 20 28 62 6c 6f 62 2d 73 69 7a 65 20 gth" (blob-size
4630: 64 61 74 61 29 20 28 2a 20 33 20 77 69 64 74 68 data) (* 3 width
4640: 20 68 65 69 67 68 74 29 29 29 0a 09 09 09 09 09 height)))......
4650: 09 09 09 09 20 28 63 61 6e 76 61 73 2d 70 61 74 .... (canvas-pat
4660: 74 65 72 6e 2d 73 65 74 2f 72 67 62 2f 72 61 77 tern-set/rgb/raw
4670: 21 20 63 61 6e 76 61 73 20 77 69 64 74 68 20 68 ! canvas width h
4680: 65 69 67 68 74 20 64 61 74 61 29 0a 09 09 09 09 eight data).....
4690: 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 69 6e ..... (canvas-in
46a0: 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 74 terior-style-set
46b0: 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 63 64 /raw! canvas (cd
46c0: 72 20 28 61 73 73 71 20 27 70 61 74 74 65 72 6e r (assq 'pattern
46d0: 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 73 interior-styles
46e0: 29 29 29 29 5d 0a 09 09 09 09 09 09 09 09 5b 28 ))))].........[(
46f0: 70 61 74 74 65 72 6e 2f 72 67 62 61 29 0a 09 09 pattern/rgba)...
4700: 09 09 09 09 09 09 20 28 6c 65 74 20 28 5b 77 69 ...... (let ([wi
4710: 64 74 68 20 28 63 61 64 72 20 69 6e 74 65 72 69 dth (cadr interi
4720: 6f 72 2d 73 74 79 6c 65 29 5d 0a 09 09 09 09 09 or-style)]......
4730: 09 09 09 09 09 09 20 5b 68 65 69 67 68 74 20 28 ...... [height (
4740: 63 61 64 64 72 20 69 6e 74 65 72 69 6f 72 2d 73 caddr interior-s
4750: 74 79 6c 65 29 5d 0a 09 09 09 09 09 09 09 09 09 tyle)]..........
4760: 09 09 20 5b 64 61 74 61 20 28 63 61 64 64 64 72 .. [data (cadddr
4770: 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 29 interior-style)
4780: 5d 29 0a 09 09 09 09 09 09 09 09 09 20 28 75 6e ]).......... (un
4790: 6c 65 73 73 20 28 3d 20 28 62 6c 6f 62 2d 73 69 less (= (blob-si
47a0: 7a 65 20 64 61 74 61 29 20 28 2a 20 34 20 77 69 ze data) (* 4 wi
47b0: 64 74 68 20 68 65 69 67 68 74 29 29 0a 09 09 09 dth height))....
47c0: 09 09 09 09 09 09 09 20 28 65 72 72 6f 72 20 27 ....... (error '
47d0: 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d canvas-interior-
47e0: 73 74 79 6c 65 2d 73 65 74 21 20 22 62 61 64 20 style-set! "bad
47f0: 70 61 74 74 65 72 6e 20 64 61 74 61 20 6c 65 6e pattern data len
4800: 67 74 68 22 20 28 62 6c 6f 62 2d 73 69 7a 65 20 gth" (blob-size
4810: 64 61 74 61 29 20 28 2a 20 34 20 77 69 64 74 68 data) (* 4 width
4820: 20 68 65 69 67 68 74 29 29 29 0a 09 09 09 09 09 height)))......
4830: 09 09 09 09 20 28 63 61 6e 76 61 73 2d 70 61 74 .... (canvas-pat
4840: 74 65 72 6e 2d 73 65 74 2f 72 67 62 61 2f 72 61 tern-set/rgba/ra
4850: 77 21 20 63 61 6e 76 61 73 20 77 69 64 74 68 20 w! canvas width
4860: 68 65 69 67 68 74 20 64 61 74 61 29 0a 09 09 09 height data)....
4870: 09 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 69 ...... (canvas-i
4880: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 nterior-style-se
4890: 74 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 63 t/raw! canvas (c
48a0: 64 72 20 28 61 73 73 71 20 27 70 61 74 74 65 72 dr (assq 'patter
48b0: 6e 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 n interior-style
48c0: 73 29 29 29 29 5d 0a 09 09 09 09 09 09 09 09 5b s))))].........[
48d0: 65 6c 73 65 0a 09 09 09 09 09 09 09 09 20 28 63 else......... (c
48e0: 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d 73 anvas-interior-s
48f0: 74 79 6c 65 2d 73 65 74 2f 72 61 77 21 0a 09 09 tyle-set/raw!...
4900: 09 09 09 09 09 09 09 20 63 61 6e 76 61 73 0a 09 ....... canvas..
4910: 09 09 09 09 09 09 09 09 20 28 63 6f 6e 64 0a 09 ........ (cond..
4920: 09 09 09 09 09 09 09 09 20 09 20 5b 28 61 73 73 ........ . [(ass
4930: 71 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 q interior-style
4940: 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 73 interior-styles
4950: 29 20 3d 3e 20 63 64 72 5d 0a 09 09 09 09 09 09 ) => cdr].......
4960: 09 09 09 20 09 20 5b 65 6c 73 65 20 28 65 72 72 ... . [else (err
4970: 6f 72 20 27 63 61 6e 76 61 73 2d 69 6e 74 65 72 or 'canvas-inter
4980: 69 6f 72 2d 73 74 79 6c 65 2d 73 65 74 21 20 22 ior-style-set! "
4990: 75 6e 6b 6e 6f 77 6e 20 69 6e 74 65 72 69 6f 72 unknown interior
49a0: 20 73 74 79 6c 65 22 20 69 6e 74 65 72 69 6f 72 style" interior
49b0: 2d 73 74 79 6c 65 29 5d 29 29 5d 29 29 5d 0a 09 -style)]))]))]..
49c0: 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 [canvas
49d0: 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2f -interior-style/
49e0: 72 61 77 0a 09 20 20 20 20 20 20 20 20 20 20 28 raw.. (
49f0: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 foreign-lambda*
4a00: 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 int ([nonnull-ca
4a10: 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 20 nvas canvas])..
4a20: 20 20 20 20 20 20 20 20 20 09 22 43 5f 72 65 74 ."C_ret
4a30: 75 72 6e 28 63 64 43 61 6e 76 61 73 49 6e 74 65 urn(cdCanvasInte
4a40: 72 69 6f 72 53 74 79 6c 65 28 63 61 6e 76 61 73 riorStyle(canvas
4a50: 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 29 5d , CD_QUERY));")]
4a60: 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 .. [canv
4a70: 61 73 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c as-interior-styl
4a80: 65 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c 61 e.. (la
4a90: 6d 62 64 61 20 28 63 61 6e 76 61 73 29 0a 09 20 mbda (canvas)..
4aa0: 20 20 20 20 20 20 20 20 20 09 28 6c 65 74 2a 20 .(let*
4ab0: 28 5b 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 ([interior-style
4ac0: 20 28 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f (canvas-interio
4ad0: 72 2d 73 74 79 6c 65 2f 72 61 77 20 63 61 6e 76 r-style/raw canv
4ae0: 61 73 29 5d 0a 09 20 20 20 20 20 20 20 20 20 20 as)]..
4af0: 09 20 20 20 20 20 20 20 5b 69 6e 74 65 72 69 6f . [interio
4b00: 72 2d 73 74 79 6c 65 0a 09 20 20 20 20 20 20 20 r-style..
4b10: 20 20 20 09 20 20 20 20 20 20 20 28 63 6f 6e 64 . (cond
4b20: 0a 09 20 20 20 20 20 20 20 20 20 20 09 20 20 20 .. .
4b30: 20 20 20 20 09 20 5b 28 72 61 73 73 6f 63 20 69 . [(rassoc i
4b40: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 20 69 6e nterior-style in
4b50: 74 65 72 69 6f 72 2d 73 74 79 6c 65 73 29 20 3d terior-styles) =
4b60: 3e 20 63 61 72 5d 0a 09 20 20 20 20 20 20 20 20 > car]..
4b70: 20 20 09 20 20 20 20 20 20 20 09 20 5b 65 6c 73 . . [els
4b80: 65 20 28 65 72 72 6f 72 20 27 63 61 6e 76 61 73 e (error 'canvas
4b90: 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 20 -interior-style
4ba0: 22 75 6e 6b 6e 6f 77 6e 20 69 6e 74 65 72 69 6f "unknown interio
4bb0: 72 20 73 74 79 6c 65 22 20 69 6e 74 65 72 69 6f r style" interio
4bc0: 72 2d 73 74 79 6c 65 29 5d 29 5d 29 0a 09 09 09 r-style)])])....
4bd0: 09 09 09 09 09 28 63 61 73 65 20 69 6e 74 65 72 .....(case inter
4be0: 69 6f 72 2d 73 74 79 6c 65 0a 09 09 09 09 09 09 ior-style.......
4bf0: 09 09 09 5b 28 68 61 74 63 68 29 0a 09 09 09 09 ...[(hatch).....
4c00: 09 09 09 09 09 20 28 6c 65 74 20 28 5b 68 61 74 ..... (let ([hat
4c10: 63 68 2d 73 74 79 6c 65 20 28 63 61 6e 76 61 73 ch-style (canvas
4c20: 2d 68 61 74 63 68 2d 73 74 79 6c 65 2f 72 61 77 -hatch-style/raw
4c30: 20 63 61 6e 76 61 73 29 5d 29 0a 09 09 09 09 09 canvas)])......
4c40: 09 09 09 09 09 20 28 6c 69 73 74 0a 09 09 09 09 ..... (list.....
4c50: 09 09 09 09 09 09 09 20 27 68 61 74 63 68 0a 09 ....... 'hatch..
4c60: 09 09 09 09 09 09 09 09 09 09 20 28 63 6f 6e 64 .......... (cond
4c70: 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 5b 28 ............. [(
4c80: 72 61 73 73 6f 63 20 68 61 74 63 68 2d 73 74 79 rassoc hatch-sty
4c90: 6c 65 20 68 61 74 63 68 2d 73 74 79 6c 65 73 29 le hatch-styles)
4ca0: 20 3d 3e 20 63 61 72 5d 0a 09 09 09 09 09 09 09 => car]........
4cb0: 09 09 09 09 09 20 5b 65 6c 73 65 20 28 65 72 72 ..... [else (err
4cc0: 6f 72 20 27 63 61 6e 76 61 73 2d 69 6e 74 65 72 or 'canvas-inter
4cd0: 69 6f 72 2d 73 74 79 6c 65 20 22 75 6e 6b 6e 6f ior-style "unkno
4ce0: 77 6e 20 68 61 74 63 68 20 73 74 79 6c 65 22 20 wn hatch style"
4cf0: 68 61 74 63 68 2d 73 74 79 6c 65 29 5d 29 29 29 hatch-style)])))
4d00: 5d 0a 09 09 09 09 09 09 09 09 09 5b 28 73 74 69 ]..........[(sti
4d10: 70 70 6c 65 29 0a 09 09 09 09 09 09 09 09 09 20 pple)..........
4d20: 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 28 5b (let-location ([
4d30: 77 69 64 74 68 20 69 6e 74 20 30 5d 20 5b 68 65 width int 0] [he
4d40: 69 67 68 74 20 69 6e 74 20 30 5d 29 0a 09 09 09 ight int 0])....
4d50: 09 09 09 09 09 09 20 09 20 28 63 61 6e 76 61 73 ...... . (canvas
4d60: 2d 73 74 69 70 70 6c 65 2f 72 61 77 20 63 61 6e -stipple/raw can
4d70: 76 61 73 20 28 6c 6f 63 61 74 69 6f 6e 20 77 69 vas (location wi
4d80: 64 74 68 29 20 28 6c 6f 63 61 74 69 6f 6e 20 68 dth) (location h
4d90: 65 69 67 68 74 29 20 23 66 29 0a 09 09 09 09 09 eight) #f)......
4da0: 09 09 09 09 09 20 28 6c 65 74 20 28 5b 64 61 74 ..... (let ([dat
4db0: 61 20 28 6d 61 6b 65 2d 62 6c 6f 62 20 28 69 6e a (make-blob (in
4dc0: 65 78 61 63 74 2d 3e 65 78 61 63 74 20 28 63 65 exact->exact (ce
4dd0: 69 6c 69 6e 67 20 28 2f 20 28 2a 20 77 69 64 74 iling (/ (* widt
4de0: 68 20 68 65 69 67 68 74 29 20 38 29 29 29 29 5d h height) 8))))]
4df0: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 28 63 )............ (c
4e00: 61 6e 76 61 73 2d 73 74 69 70 70 6c 65 2f 72 61 anvas-stipple/ra
4e10: 77 20 63 61 6e 76 61 73 20 28 6c 6f 63 61 74 69 w canvas (locati
4e20: 6f 6e 20 77 69 64 74 68 29 20 28 6c 6f 63 61 74 on width) (locat
4e30: 69 6f 6e 20 68 65 69 67 68 74 29 20 64 61 74 61 ion height) data
4e40: 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 28 6c )............ (l
4e50: 69 73 74 20 27 73 74 69 70 70 6c 65 20 77 69 64 ist 'stipple wid
4e60: 74 68 20 68 65 69 67 68 74 20 64 61 74 61 29 29 th height data))
4e70: 29 5d 0a 09 09 09 09 09 09 09 09 09 5b 28 70 61 )]..........[(pa
4e80: 74 74 65 72 6e 29 0a 09 09 09 09 09 09 09 09 09 ttern)..........
4e90: 20 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 28 (let-location (
4ea0: 5b 77 69 64 74 68 20 69 6e 74 20 30 5d 20 5b 68 [width int 0] [h
4eb0: 65 69 67 68 74 20 69 6e 74 20 30 5d 29 0a 09 09 eight int 0])...
4ec0: 09 09 09 09 09 09 09 20 09 20 28 63 61 6e 76 61 ....... . (canva
4ed0: 73 2d 70 61 74 74 65 72 6e 2f 72 67 62 61 2f 72 s-pattern/rgba/r
4ee0: 61 77 20 63 61 6e 76 61 73 20 28 6c 6f 63 61 74 aw canvas (locat
4ef0: 69 6f 6e 20 77 69 64 74 68 29 20 28 6c 6f 63 61 ion width) (loca
4f00: 74 69 6f 6e 20 68 65 69 67 68 74 29 20 23 66 29 tion height) #f)
4f10: 0a 09 09 09 09 09 09 09 09 09 09 20 28 6c 65 74 ........... (let
4f20: 20 28 5b 64 61 74 61 20 28 6d 61 6b 65 2d 62 6c ([data (make-bl
4f30: 6f 62 20 28 2a 20 34 20 77 69 64 74 68 20 68 65 ob (* 4 width he
4f40: 69 67 68 74 29 29 5d 29 0a 09 09 09 09 09 09 09 ight))])........
4f50: 09 09 09 09 20 28 63 61 6e 76 61 73 2d 70 61 74 .... (canvas-pat
4f60: 74 65 72 6e 2f 72 67 62 61 2f 72 61 77 20 63 61 tern/rgba/raw ca
4f70: 6e 76 61 73 20 28 6c 6f 63 61 74 69 6f 6e 20 77 nvas (location w
4f80: 69 64 74 68 29 20 28 6c 6f 63 61 74 69 6f 6e 20 idth) (location
4f90: 68 65 69 67 68 74 29 20 64 61 74 61 29 0a 09 09 height) data)...
4fa0: 09 09 09 09 09 09 09 09 09 20 28 6c 69 73 74 20 ......... (list
4fb0: 27 70 61 74 74 65 72 6e 2f 72 67 62 61 20 77 69 'pattern/rgba wi
4fc0: 64 74 68 20 68 65 69 67 68 74 20 64 61 74 61 29 dth height data)
4fd0: 29 29 5d 0a 09 09 09 09 09 09 09 09 09 5b 65 6c ))]..........[el
4fe0: 73 65 0a 09 09 09 09 09 09 09 09 09 20 69 6e 74 se.......... int
4ff0: 65 72 69 6f 72 2d 73 74 79 6c 65 5d 29 29 29 5d erior-style])))]
5000: 29 0a 09 09 28 76 61 6c 75 65 73 0a 09 09 09 28 )...(values....(
5010: 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 74 74 getter-with-sett
5020: 65 72 20 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 er canvas-interi
5030: 6f 72 2d 73 74 79 6c 65 20 63 61 6e 76 61 73 2d or-style canvas-
5040: 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 interior-style-s
5050: 65 74 21 29 0a 09 09 09 63 61 6e 76 61 73 2d 69 et!)....canvas-i
5060: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 nterior-style-se
5070: 74 21 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b t!)))..;; }}}..;
5080: 3b 20 7b 7b 7b 20 54 65 78 74 20 66 75 6e 63 74 ; {{{ Text funct
5090: 69 6f 6e 73 0a 0a 28 64 65 66 69 6e 65 20 63 61 ions..(define ca
50a0: 6e 76 61 73 2d 74 65 78 74 21 0a 09 28 66 6f 72 nvas-text!..(for
50b0: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 eign-lambda void
50c0: 20 22 63 64 66 43 61 6e 76 61 73 54 65 78 74 22 "cdfCanvasText"
50d0: 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 nonnull-canvas
50e0: 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 6e 6f double double no
50f0: 6e 6e 75 6c 6c 2d 63 2d 73 74 72 69 6e 67 29 29 nnull-c-string))
5100: 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 ..(define canvas
5110: 2d 66 6f 6e 74 2d 73 65 74 21 0a 09 28 66 6f 72 -font-set!..(for
5120: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 63 2d 73 74 eign-lambda c-st
5130: 72 69 6e 67 20 22 63 64 43 61 6e 76 61 73 4e 61 ring "cdCanvasNa
5140: 74 69 76 65 46 6f 6e 74 22 20 6e 6f 6e 6e 75 6c tiveFont" nonnul
5150: 6c 2d 63 61 6e 76 61 73 20 6e 6f 6e 6e 75 6c 6c l-canvas nonnull
5160: 2d 63 2d 73 74 72 69 6e 67 29 29 0a 0a 28 64 65 -c-string))..(de
5170: 66 69 6e 65 20 63 61 6e 76 61 73 2d 66 6f 6e 74 fine canvas-font
5180: 0a 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 ..(getter-with-s
5190: 65 74 74 65 72 0a 09 09 28 66 6f 72 65 69 67 6e etter...(foreign
51a0: 2d 6c 61 6d 62 64 61 2a 20 63 2d 73 74 72 69 6e -lambda* c-strin
51b0: 67 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 g ([nonnull-canv
51c0: 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 09 09 22 as canvas])...."
51d0: 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 61 C_return(cdCanva
51e0: 73 4e 61 74 69 76 65 46 6f 6e 74 28 63 61 6e 76 sNativeFont(canv
51f0: 61 73 2c 20 4e 55 4c 4c 29 29 3b 22 29 0a 09 09 as, NULL));")...
5200: 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 74 21 canvas-font-set!
5210: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 76 61 6c 75 ))..(define-valu
5220: 65 73 20 28 63 61 6e 76 61 73 2d 74 65 78 74 2d es (canvas-text-
5230: 61 6c 69 67 6e 6d 65 6e 74 20 63 61 6e 76 61 73 alignment canvas
5240: 2d 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 2d -text-alignment-
5250: 73 65 74 21 29 0a 09 28 6c 65 74 72 65 63 20 28 set!)..(letrec (
5260: 5b 61 6c 69 67 6e 6d 65 6e 74 73 0a 09 20 20 20 [alignments..
5270: 20 20 20 20 20 20 20 28 6c 69 73 74 0a 09 20 20 (list..
5280: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
5290: 20 20 20 20 20 20 20 20 20 20 09 09 27 6e 6f 72 ..'nor
52a0: 74 68 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 th.. ..
52b0: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
52c0: 43 44 5f 4e 4f 52 54 48 22 20 69 6e 74 29 29 0a CD_NORTH" int)).
52d0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
52e0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
52f0: 73 6f 75 74 68 0a 09 20 20 20 20 20 20 20 20 20 south..
5300: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
5310: 65 20 22 43 44 5f 53 4f 55 54 48 22 20 69 6e 74 e "CD_SOUTH" int
5320: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
5330: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
5340: 09 09 27 65 61 73 74 0a 09 20 20 20 20 20 20 20 ..'east..
5350: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
5360: 6c 75 65 20 22 43 44 5f 45 41 53 54 22 20 69 6e lue "CD_EAST" in
5370: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
5380: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
5390: 20 09 09 27 77 65 73 74 0a 09 20 20 20 20 20 20 ..'west..
53a0: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
53b0: 61 6c 75 65 20 22 43 44 5f 57 45 53 54 22 20 69 alue "CD_WEST" i
53c0: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
53d0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
53e0: 20 20 09 09 27 6e 6f 72 74 68 2d 65 61 73 74 0a ..'north-east.
53f0: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
5400: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
5410: 4e 4f 52 54 48 5f 45 41 53 54 22 20 69 6e 74 29 NORTH_EAST" int)
5420: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
5430: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
5440: 09 27 6e 6f 72 74 68 2d 77 65 73 74 0a 09 20 20 .'north-west..
5450: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
5460: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 4e 4f 52 gn-value "CD_NOR
5470: 54 48 5f 57 45 53 54 22 20 69 6e 74 29 29 0a 09 TH_WEST" int))..
5480: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
5490: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 73 .. ..'s
54a0: 6f 75 74 68 2d 65 61 73 74 0a 09 20 20 20 20 20 outh-east..
54b0: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
54c0: 76 61 6c 75 65 20 22 43 44 5f 53 4f 55 54 48 5f value "CD_SOUTH_
54d0: 45 41 53 54 22 20 69 6e 74 29 29 0a 09 20 20 20 EAST" int))..
54e0: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
54f0: 20 20 20 20 20 20 20 20 20 09 09 27 73 6f 75 74 ..'sout
5500: 68 2d 77 65 73 74 0a 09 20 20 20 20 20 20 20 20 h-west..
5510: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
5520: 75 65 20 22 43 44 5f 53 4f 55 54 48 5f 57 45 53 ue "CD_SOUTH_WES
5530: 54 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 T" int))..
5540: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
5550: 20 20 20 20 20 20 09 09 27 63 65 6e 74 65 72 0a ..'center.
5560: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
5570: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
5580: 43 45 4e 54 45 52 22 20 69 6e 74 29 29 0a 09 20 CENTER" int))..
5590: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
55a0: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 62 61 . ..'ba
55b0: 73 65 2d 6c 65 66 74 0a 09 20 20 20 20 20 20 20 se-left..
55c0: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
55d0: 6c 75 65 20 22 43 44 5f 42 41 53 45 5f 4c 45 46 lue "CD_BASE_LEF
55e0: 54 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 T" int))..
55f0: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
5600: 20 20 20 20 20 20 09 09 27 62 61 73 65 2d 63 65 ..'base-ce
5610: 6e 74 65 72 0a 09 20 20 20 20 20 20 20 20 20 20 nter..
5620: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
5630: 20 22 43 44 5f 42 41 53 45 5f 43 45 4e 54 45 52 "CD_BASE_CENTER
5640: 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 " int))..
5650: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
5660: 20 20 20 20 20 09 09 27 62 61 73 65 2d 72 69 67 ..'base-rig
5670: 68 74 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ht.. ..
5680: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
5690: 43 44 5f 42 41 53 45 5f 52 49 47 48 54 22 20 69 CD_BASE_RIGHT" i
56a0: 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 20 20 20 nt)))]..
56b0: 20 5b 63 61 6e 76 61 73 2d 74 65 78 74 2d 61 6c [canvas-text-al
56c0: 69 67 6e 6d 65 6e 74 2d 73 65 74 2f 72 61 77 21 ignment-set/raw!
56d0: 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 .. (for
56e0: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 eign-lambda void
56f0: 20 22 63 64 43 61 6e 76 61 73 54 65 78 74 41 6c "cdCanvasTextAl
5700: 69 67 6e 6d 65 6e 74 22 20 6e 6f 6e 6e 75 6c 6c ignment" nonnull
5710: 2d 63 61 6e 76 61 73 20 69 6e 74 29 5d 0a 09 20 -canvas int)]..
5720: 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d [canvas-
5730: 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 2d 73 text-alignment-s
5740: 65 74 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 et!.. (
5750: 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 61 lambda (canvas a
5760: 6c 69 67 6e 6d 65 6e 74 29 0a 09 09 09 09 09 09 lignment).......
5770: 09 28 63 61 6e 76 61 73 2d 74 65 78 74 2d 61 6c .(canvas-text-al
5780: 69 67 6e 6d 65 6e 74 2d 73 65 74 2f 72 61 77 21 ignment-set/raw!
5790: 0a 09 09 09 09 09 09 09 09 63 61 6e 76 61 73 0a .........canvas.
57a0: 09 09 09 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 ........(cond...
57b0: 09 09 09 09 09 09 09 5b 28 61 73 73 71 20 61 6c .......[(assq al
57c0: 69 67 6e 6d 65 6e 74 20 61 6c 69 67 6e 6d 65 6e ignment alignmen
57d0: 74 73 29 20 3d 3e 20 63 64 72 5d 0a 09 09 09 09 ts) => cdr].....
57e0: 09 09 09 09 09 5b 65 6c 73 65 20 28 65 72 72 6f .....[else (erro
57f0: 72 20 27 63 61 6e 76 61 73 2d 74 65 78 74 2d 61 r 'canvas-text-a
5800: 6c 69 67 6e 6d 65 6e 74 2d 73 65 74 21 20 22 75 lignment-set! "u
5810: 6e 6b 6e 6f 77 6e 20 61 6c 69 67 6e 6d 65 6e 74 nknown alignment
5820: 22 20 61 6c 69 67 6e 6d 65 6e 74 29 5d 29 29 29 " alignment)])))
5830: 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e ].. [can
5840: 76 61 73 2d 74 65 78 74 2d 61 6c 69 67 6e 6d 65 vas-text-alignme
5850: 6e 74 2f 72 61 77 0a 09 20 20 20 20 20 20 20 20 nt/raw..
5860: 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 (foreign-lambd
5870: 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c a* int ([nonnull
5880: 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 -canvas canvas])
5890: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 43 5f .. ."C_
58a0: 72 65 74 75 72 6e 28 63 64 43 61 6e 76 61 73 54 return(cdCanvasT
58b0: 65 78 74 41 6c 69 67 6e 6d 65 6e 74 28 63 61 6e extAlignment(can
58c0: 76 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b vas, CD_QUERY));
58d0: 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 ")].. [c
58e0: 61 6e 76 61 73 2d 74 65 78 74 2d 61 6c 69 67 6e anvas-text-align
58f0: 6d 65 6e 74 0a 09 20 20 20 20 20 20 20 20 20 20 ment..
5900: 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 29 (lambda (canvas)
5910: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 6c 65 .. .(le
5920: 74 20 28 5b 61 6c 69 67 6e 6d 65 6e 74 20 28 63 t ([alignment (c
5930: 61 6e 76 61 73 2d 74 65 78 74 2d 61 6c 69 67 6e anvas-text-align
5940: 6d 65 6e 74 2f 72 61 77 20 63 61 6e 76 61 73 29 ment/raw canvas)
5950: 5d 29 0a 09 09 09 09 09 09 09 09 28 63 6f 6e 64 ]).........(cond
5960: 0a 09 09 09 09 09 09 09 09 09 5b 28 72 61 73 73 ..........[(rass
5970: 6f 63 20 61 6c 69 67 6e 6d 65 6e 74 20 61 6c 69 oc alignment ali
5980: 67 6e 6d 65 6e 74 73 29 20 3d 3e 20 63 61 72 5d gnments) => car]
5990: 0a 09 09 09 09 09 09 09 09 09 5b 65 6c 73 65 20 ..........[else
59a0: 28 65 72 72 6f 72 20 27 63 61 6e 76 61 73 2d 74 (error 'canvas-t
59b0: 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 20 22 75 ext-alignment "u
59c0: 6e 6b 6e 6f 77 6e 20 61 6c 69 67 6e 6d 65 6e 74 nknown alignment
59d0: 22 20 61 6c 69 67 6e 6d 65 6e 74 29 5d 29 29 29 " alignment)])))
59e0: 5d 29 0a 09 09 28 76 61 6c 75 65 73 0a 09 09 09 ])...(values....
59f0: 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 74 (getter-with-set
5a00: 74 65 72 20 63 61 6e 76 61 73 2d 74 65 78 74 2d ter canvas-text-
5a10: 61 6c 69 67 6e 6d 65 6e 74 20 63 61 6e 76 61 73 alignment canvas
5a20: 2d 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 2d -text-alignment-
5a30: 73 65 74 21 29 0a 09 09 09 63 61 6e 76 61 73 2d set!)....canvas-
5a40: 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 2d 73 text-alignment-s
5a50: 65 74 21 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 et!)))..(define
5a60: 63 61 6e 76 61 73 2d 74 65 78 74 2d 6f 72 69 65 canvas-text-orie
5a70: 6e 74 61 74 69 6f 6e 2d 73 65 74 21 0a 09 28 66 ntation-set!..(f
5a80: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f oreign-lambda vo
5a90: 69 64 20 22 63 64 43 61 6e 76 61 73 54 65 78 74 id "cdCanvasText
5aa0: 4f 72 69 65 6e 74 61 74 69 6f 6e 22 20 6e 6f 6e Orientation" non
5ab0: 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 64 6f 75 62 null-canvas doub
5ac0: 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 le))..(define ca
5ad0: 6e 76 61 73 2d 74 65 78 74 2d 6f 72 69 65 6e 74 nvas-text-orient
5ae0: 61 74 69 6f 6e 0a 09 28 67 65 74 74 65 72 2d 77 ation..(getter-w
5af0: 69 74 68 2d 73 65 74 74 65 72 0a 09 09 28 66 6f ith-setter...(fo
5b00: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 64 6f reign-lambda* do
5b10: 75 62 6c 65 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 uble ([nonnull-c
5b20: 61 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 anvas canvas])..
5b30: 09 09 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 .."C_return(cdCa
5b40: 6e 76 61 73 54 65 78 74 4f 72 69 65 6e 74 61 74 nvasTextOrientat
5b50: 69 6f 6e 28 63 61 6e 76 61 73 2c 20 43 44 5f 51 ion(canvas, CD_Q
5b60: 55 45 52 59 29 29 3b 22 29 0a 09 09 63 61 6e 76 UERY));")...canv
5b70: 61 73 2d 74 65 78 74 2d 6f 72 69 65 6e 74 61 74 as-text-orientat
5b80: 69 6f 6e 2d 73 65 74 21 29 29 0a 0a 28 64 65 66 ion-set!))..(def
5b90: 69 6e 65 20 63 61 6e 76 61 73 2d 66 6f 6e 74 2d ine canvas-font-
5ba0: 64 69 6d 65 6e 73 69 6f 6e 73 0a 09 28 6c 65 74 dimensions..(let
5bb0: 72 65 63 20 28 5b 63 61 6e 76 61 73 2d 66 6f 6e rec ([canvas-fon
5bc0: 74 2d 64 69 6d 65 6e 73 69 6f 6e 73 2f 72 61 77 t-dimensions/raw
5bd0: 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 .. (for
5be0: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 eign-lambda void
5bf0: 20 22 63 64 43 61 6e 76 61 73 47 65 74 46 6f 6e "cdCanvasGetFon
5c00: 74 44 69 6d 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 tDim" nonnull-ca
5c10: 6e 76 61 73 20 28 63 2d 70 6f 69 6e 74 65 72 20 nvas (c-pointer
5c20: 69 6e 74 29 20 28 63 2d 70 6f 69 6e 74 65 72 20 int) (c-pointer
5c30: 69 6e 74 29 20 28 63 2d 70 6f 69 6e 74 65 72 20 int) (c-pointer
5c40: 69 6e 74 29 20 28 63 2d 70 6f 69 6e 74 65 72 20 int) (c-pointer
5c50: 69 6e 74 29 29 5d 29 0a 09 20 20 28 6c 61 6d 62 int))]).. (lamb
5c60: 64 61 20 28 63 61 6e 76 61 73 29 0a 09 20 20 09 da (canvas).. .
5c70: 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 28 5b (let-location ([
5c80: 6d 61 78 2d 77 69 64 74 68 20 69 6e 74 20 30 5d max-width int 0]
5c90: 0a 09 20 20 09 20 20 20 20 20 20 20 20 20 20 20 .. .
5ca0: 20 20 20 20 5b 68 65 69 67 68 74 20 69 6e 74 20 [height int
5cb0: 30 5d 0a 09 20 20 09 20 20 20 20 20 20 20 20 20 0].. .
5cc0: 20 20 20 20 20 20 5b 61 73 63 65 6e 74 20 69 6e [ascent in
5cd0: 74 20 30 5d 0a 09 20 20 09 20 20 20 20 20 20 20 t 0].. .
5ce0: 20 20 20 20 20 20 20 20 5b 64 65 73 63 65 6e 74 [descent
5cf0: 20 69 6e 74 20 30 5d 29 0a 09 20 20 09 20 20 28 int 0]).. . (
5d00: 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 64 69 6d 65 canvas-font-dime
5d10: 6e 73 69 6f 6e 73 2f 72 61 77 20 63 61 6e 76 61 nsions/raw canva
5d20: 73 20 28 6c 6f 63 61 74 69 6f 6e 20 6d 61 78 2d s (location max-
5d30: 77 69 64 74 68 29 20 28 6c 6f 63 61 74 69 6f 6e width) (location
5d40: 20 68 65 69 67 68 74 29 20 28 6c 6f 63 61 74 69 height) (locati
5d50: 6f 6e 20 61 73 63 65 6e 74 29 20 28 6c 6f 63 61 on ascent) (loca
5d60: 74 69 6f 6e 20 64 65 73 63 65 6e 74 29 29 0a 09 tion descent))..
5d70: 20 20 09 20 20 28 76 61 6c 75 65 73 20 6d 61 78 . (values max
5d80: 2d 77 69 64 74 68 20 68 65 69 67 68 74 20 61 73 -width height as
5d90: 63 65 6e 74 20 64 65 73 63 65 6e 74 29 29 29 29 cent descent))))
5da0: 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 )..(define canva
5db0: 73 2d 74 65 78 74 2d 73 69 7a 65 0a 09 28 6c 65 s-text-size..(le
5dc0: 74 72 65 63 20 28 5b 63 61 6e 76 61 73 2d 74 65 trec ([canvas-te
5dd0: 78 74 2d 73 69 7a 65 2f 72 61 77 0a 09 20 20 20 xt-size/raw..
5de0: 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d (foreign-
5df0: 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 lambda void "cdC
5e00: 61 6e 76 61 73 47 65 74 54 65 78 74 53 69 7a 65 anvasGetTextSize
5e10: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
5e20: 20 6e 6f 6e 6e 75 6c 6c 2d 63 2d 73 74 72 69 6e nonnull-c-strin
5e30: 67 20 28 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 g (c-pointer int
5e40: 29 20 28 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 ) (c-pointer int
5e50: 29 29 5d 29 0a 09 20 20 28 6c 61 6d 62 64 61 20 ))]).. (lambda
5e60: 28 63 61 6e 76 61 73 20 74 65 78 74 29 0a 09 20 (canvas text)..
5e70: 20 09 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 .(let-location
5e80: 28 5b 77 69 64 74 68 20 69 6e 74 20 30 5d 20 5b ([width int 0] [
5e90: 68 65 69 67 68 74 20 69 6e 74 20 30 5d 29 0a 09 height int 0])..
5ea0: 20 20 09 09 28 63 61 6e 76 61 73 2d 74 65 78 74 ..(canvas-text
5eb0: 2d 73 69 7a 65 2f 72 61 77 20 63 61 6e 76 61 73 -size/raw canvas
5ec0: 20 74 65 78 74 20 28 6c 6f 63 61 74 69 6f 6e 20 text (location
5ed0: 77 69 64 74 68 29 20 28 6c 6f 63 61 74 69 6f 6e width) (location
5ee0: 20 68 65 69 67 68 74 29 29 0a 09 20 20 09 09 28 height)).. ..(
5ef0: 76 61 6c 75 65 73 20 77 69 64 74 68 20 68 65 69 values width hei
5f00: 67 68 74 29 29 29 29 29 0a 0a 28 64 65 66 69 6e ght)))))..(defin
5f10: 65 20 63 61 6e 76 61 73 2d 74 65 78 74 2d 62 6f e canvas-text-bo
5f20: 78 0a 09 28 6c 65 74 72 65 63 20 28 5b 63 61 6e x..(letrec ([can
5f30: 76 61 73 2d 74 65 78 74 2d 62 6f 78 2f 72 61 77 vas-text-box/raw
5f40: 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 .. (for
5f50: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 eign-lambda void
5f60: 20 22 63 64 43 61 6e 76 61 73 47 65 74 54 65 78 "cdCanvasGetTex
5f70: 74 42 6f 78 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 tBox" nonnull-ca
5f80: 6e 76 61 73 20 69 6e 74 20 69 6e 74 20 6e 6f 6e nvas int int non
5f90: 6e 75 6c 6c 2d 63 2d 73 74 72 69 6e 67 20 28 63 null-c-string (c
5fa0: 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 63 -pointer int) (c
5fb0: 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 63 -pointer int) (c
5fc0: 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 63 -pointer int) (c
5fd0: 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 29 5d 29 -pointer int))])
5fe0: 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e .. (lambda (can
5ff0: 76 61 73 20 78 20 79 20 74 65 78 74 29 0a 09 20 vas x y text)..
6000: 20 09 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 .(let-location
6010: 28 5b 78 30 20 69 6e 74 20 30 5d 20 5b 78 31 20 ([x0 int 0] [x1
6020: 69 6e 74 20 30 5d 0a 09 20 20 09 20 20 20 20 20 int 0].. .
6030: 20 20 20 20 20 20 20 20 20 20 5b 79 30 20 69 6e [y0 in
6040: 74 20 30 5d 20 5b 79 31 20 69 6e 74 20 30 5d 29 t 0] [y1 int 0])
6050: 0a 09 20 20 09 20 20 28 63 61 6e 76 61 73 2d 74 .. . (canvas-t
6060: 65 78 74 2d 62 6f 78 2f 72 61 77 20 63 61 6e 76 ext-box/raw canv
6070: 61 73 20 78 20 79 20 74 65 78 74 20 28 6c 6f 63 as x y text (loc
6080: 61 74 69 6f 6e 20 78 30 29 20 28 6c 6f 63 61 74 ation x0) (locat
6090: 69 6f 6e 20 78 31 29 20 28 6c 6f 63 61 74 69 6f ion x1) (locatio
60a0: 6e 20 79 30 29 20 28 6c 6f 63 61 74 69 6f 6e 20 n y0) (location
60b0: 79 31 29 29 0a 09 20 20 09 20 20 28 76 61 6c 75 y1)).. . (valu
60c0: 65 73 20 78 30 20 78 31 20 79 30 20 79 31 29 29 es x0 x1 y0 y1))
60d0: 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 )))..;; }}}..;;
60e0: 7b 7b 7b 20 56 65 72 74 65 78 20 66 75 6e 63 74 {{{ Vertex funct
60f0: 69 6f 6e 73 0a 0a 28 64 65 66 69 6e 65 20 63 61 ions..(define ca
6100: 6c 6c 2d 77 69 74 68 2d 63 61 6e 76 61 73 2d 69 ll-with-canvas-i
6110: 6e 2d 6d 6f 64 65 0a 09 28 6c 65 74 72 65 63 20 n-mode..(letrec
6120: 28 5b 63 61 6e 76 61 73 2d 6d 6f 64 65 73 0a 09 ([canvas-modes..
6130: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 0a (list.
6140: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
6150: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
6160: 6f 70 65 6e 2d 6c 69 6e 65 73 0a 09 20 20 20 20 open-lines..
6170: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
6180: 2d 76 61 6c 75 65 20 22 43 44 5f 4f 50 45 4e 5f -value "CD_OPEN_
6190: 4c 49 4e 45 53 22 20 69 6e 74 29 29 0a 09 20 20 LINES" int))..
61a0: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
61b0: 20 20 20 20 20 20 20 20 20 20 09 09 27 63 6c 6f ..'clo
61c0: 73 65 64 2d 6c 69 6e 65 73 0a 09 20 20 20 20 20 sed-lines..
61d0: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
61e0: 76 61 6c 75 65 20 22 43 44 5f 43 4c 4f 53 45 44 value "CD_CLOSED
61f0: 5f 4c 49 4e 45 53 22 20 69 6e 74 29 29 0a 09 20 _LINES" int))..
6200: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
6210: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 66 69 . ..'fi
6220: 6c 6c 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ll.. ..
6230: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
6240: 43 44 5f 46 49 4c 4c 22 20 69 6e 74 29 29 0a 09 CD_FILL" int))..
6250: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
6260: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 63 .. ..'c
6270: 6c 69 70 0a 09 20 20 20 20 20 20 20 20 20 20 09 lip.. .
6280: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
6290: 22 43 44 5f 43 4c 49 50 22 20 69 6e 74 29 29 0a "CD_CLIP" int)).
62a0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
62b0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
62c0: 62 65 7a 69 65 72 0a 09 20 20 20 20 20 20 20 20 bezier..
62d0: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
62e0: 75 65 20 22 43 44 5f 42 45 5a 49 45 52 22 20 69 ue "CD_BEZIER" i
62f0: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
6300: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
6310: 20 20 09 09 27 72 65 67 69 6f 6e 0a 09 20 20 20 ..'region..
6320: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
6330: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 52 45 47 49 n-value "CD_REGI
6340: 4f 4e 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 ON" int))..
6350: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
6360: 20 20 20 20 20 20 20 09 09 27 70 61 74 68 0a 09 ..'path..
6370: 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 ..(for
6380: 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 50 eign-value "CD_P
6390: 41 54 48 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 ATH" int)))]..
63a0: 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 62 [canvas-b
63b0: 65 67 69 6e 0a 09 20 20 20 20 20 20 20 20 20 20 egin..
63c0: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 (foreign-lambda
63d0: 76 6f 69 64 20 22 63 64 43 61 6e 76 61 73 42 65 void "cdCanvasBe
63e0: 67 69 6e 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e gin" nonnull-can
63f0: 76 61 73 20 69 6e 74 29 5d 0a 09 20 20 20 20 20 vas int)]..
6400: 20 20 20 20 5b 63 61 6e 76 61 73 2d 65 6e 64 0a [canvas-end.
6410: 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 . (fore
6420: 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 ign-lambda void
6430: 22 63 64 43 61 6e 76 61 73 45 6e 64 22 20 6e 6f "cdCanvasEnd" no
6440: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 29 5d 29 0a nnull-canvas)]).
6450: 09 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 . (lambda (canv
6460: 61 73 20 63 61 6e 76 61 73 2d 6d 6f 64 65 20 70 as canvas-mode p
6470: 72 6f 63 29 0a 09 20 20 09 28 6c 65 74 20 28 5b roc).. .(let ([
6480: 63 61 6e 76 61 73 2d 6d 6f 64 65 0a 09 20 20 09 canvas-mode.. .
6490: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 09 20 20 (cond..
64a0: 09 20 20 20 20 20 20 20 09 20 5b 28 61 73 73 71 . . [(assq
64b0: 20 63 61 6e 76 61 73 2d 6d 6f 64 65 20 63 61 6e canvas-mode can
64c0: 76 61 73 2d 6d 6f 64 65 73 29 20 3d 3e 20 63 64 vas-modes) => cd
64d0: 72 5d 0a 09 20 20 09 20 20 20 20 20 20 20 09 20 r].. . .
64e0: 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 77 69 [else (error 'wi
64f0: 74 68 2d 63 61 6e 76 61 73 2d 6d 6f 64 65 20 22 th-canvas-mode "
6500: 75 6e 6b 6e 6f 77 6e 20 63 61 6e 76 61 73 20 6d unknown canvas m
6510: 6f 64 65 22 20 63 61 6e 76 61 73 2d 6d 6f 64 65 ode" canvas-mode
6520: 29 5d 29 5d 29 0a 09 09 09 09 28 64 79 6e 61 6d )])]).....(dynam
6530: 69 63 2d 77 69 6e 64 0a 09 09 09 09 09 28 63 75 ic-wind......(cu
6540: 74 20 63 61 6e 76 61 73 2d 62 65 67 69 6e 20 63 t canvas-begin c
6550: 61 6e 76 61 73 20 63 61 6e 76 61 73 2d 6d 6f 64 anvas canvas-mod
6560: 65 29 0a 09 09 09 09 09 28 63 75 74 20 70 72 6f e)......(cut pro
6570: 63 20 63 61 6e 76 61 73 29 0a 09 09 09 09 09 28 c canvas)......(
6580: 63 75 74 20 63 61 6e 76 61 73 2d 65 6e 64 20 63 cut canvas-end c
6590: 61 6e 76 61 73 29 29 29 29 29 29 0a 0a 28 64 65 anvas))))))..(de
65a0: 66 69 6e 65 20 63 61 6e 76 61 73 2d 70 61 74 68 fine canvas-path
65b0: 2d 73 65 74 21 0a 09 28 6c 65 74 72 65 63 20 28 -set!..(letrec (
65c0: 5b 70 61 74 68 2d 61 63 74 69 6f 6e 73 0a 09 20 [path-actions..
65d0: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 0a 09 (list..
65e0: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
65f0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 6e .. ..'n
6600: 65 77 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ew.. ..
6610: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
6620: 43 44 5f 50 41 54 48 5f 4e 45 57 22 20 69 6e 74 CD_PATH_NEW" int
6630: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
6640: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
6650: 09 09 27 6d 6f 76 65 2d 74 6f 0a 09 20 20 20 20 ..'move-to..
6660: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
6670: 2d 76 61 6c 75 65 20 22 43 44 5f 50 41 54 48 5f -value "CD_PATH_
6680: 4d 4f 56 45 54 4f 22 20 69 6e 74 29 29 0a 09 20 MOVETO" int))..
6690: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
66a0: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 6c 69 . ..'li
66b0: 6e 65 2d 74 6f 0a 09 20 20 20 20 20 20 20 20 20 ne-to..
66c0: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
66d0: 65 20 22 43 44 5f 50 41 54 48 5f 4c 49 4e 45 54 e "CD_PATH_LINET
66e0: 4f 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 O" int))..
66f0: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
6700: 20 20 20 20 20 20 09 09 27 61 72 63 0a 09 20 20 ..'arc..
6710: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
6720: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 50 41 54 gn-value "CD_PAT
6730: 48 5f 41 52 43 22 20 69 6e 74 29 29 0a 09 20 20 H_ARC" int))..
6740: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
6750: 20 20 20 20 20 20 20 20 20 20 09 09 27 63 75 72 ..'cur
6760: 76 65 2d 74 6f 0a 09 20 20 20 20 20 20 20 20 20 ve-to..
6770: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
6780: 65 20 22 43 44 5f 50 41 54 48 5f 43 55 52 56 45 e "CD_PATH_CURVE
6790: 54 4f 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 TO" int))..
67a0: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
67b0: 20 20 20 20 20 20 20 09 09 27 63 6c 6f 73 65 0a ..'close.
67c0: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
67d0: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
67e0: 50 41 54 48 5f 43 4c 4f 53 45 22 20 69 6e 74 29 PATH_CLOSE" int)
67f0: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
6800: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
6810: 09 27 66 69 6c 6c 0a 09 20 20 20 20 20 20 20 20 .'fill..
6820: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
6830: 75 65 20 22 43 44 5f 50 41 54 48 5f 46 49 4c 4c ue "CD_PATH_FILL
6840: 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 " int))..
6850: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
6860: 20 20 20 20 20 09 09 27 73 74 72 6f 6b 65 0a 09 ..'stroke..
6870: 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 ..(for
6880: 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 50 eign-value "CD_P
6890: 41 54 48 5f 53 54 52 4f 4b 45 22 20 69 6e 74 29 ATH_STROKE" int)
68a0: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
68b0: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
68c0: 09 27 66 69 6c 6c 2b 73 74 72 6f 6b 65 0a 09 20 .'fill+stroke..
68d0: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
68e0: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 50 41 ign-value "CD_PA
68f0: 54 48 5f 46 49 4c 4c 53 54 52 4f 4b 45 22 20 69 TH_FILLSTROKE" i
6900: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
6910: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
6920: 20 20 09 09 27 63 6c 69 70 0a 09 20 20 20 20 20 ..'clip..
6930: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
6940: 76 61 6c 75 65 20 22 43 44 5f 50 41 54 48 5f 43 value "CD_PATH_C
6950: 4c 49 50 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 LIP" int)))]..
6960: 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 70 [canvas-p
6970: 61 74 68 2d 73 65 74 2f 72 61 77 21 0a 09 20 20 ath-set/raw!..
6980: 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e (foreign
6990: 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 -lambda void "cd
69a0: 43 61 6e 76 61 73 50 61 74 68 53 65 74 22 20 6e CanvasPathSet" n
69b0: 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 69 6e onnull-canvas in
69c0: 74 29 5d 29 0a 09 20 20 28 6c 61 6d 62 64 61 20 t)]).. (lambda
69d0: 28 63 61 6e 76 61 73 20 70 61 74 68 2d 61 63 74 (canvas path-act
69e0: 69 6f 6e 29 0a 09 20 20 09 28 63 61 6e 76 61 73 ion).. .(canvas
69f0: 2d 70 61 74 68 2d 73 65 74 2f 72 61 77 21 0a 09 -path-set/raw!..
6a00: 20 20 09 09 63 61 6e 76 61 73 0a 09 20 20 09 09 ..canvas.. ..
6a10: 28 63 6f 6e 64 0a 09 20 20 09 09 09 5b 28 61 73 (cond.. ...[(as
6a20: 73 71 20 70 61 74 68 2d 61 63 74 69 6f 6e 20 70 sq path-action p
6a30: 61 74 68 2d 61 63 74 69 6f 6e 73 29 20 3d 3e 20 ath-actions) =>
6a40: 63 64 72 5d 0a 09 20 20 09 09 09 5b 65 6c 73 65 cdr].. ...[else
6a50: 20 28 65 72 72 6f 72 20 27 63 61 6e 76 61 73 2d (error 'canvas-
6a60: 70 61 74 68 2d 73 65 74 21 20 22 75 6e 6b 6e 6f path-set! "unkno
6a70: 77 6e 20 70 61 74 68 20 61 63 74 69 6f 6e 22 20 wn path action"
6a80: 70 61 74 68 2d 61 63 74 69 6f 6e 29 5d 29 29 29 path-action)])))
6a90: 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 ))..(define canv
6aa0: 61 73 2d 76 65 72 74 65 78 21 0a 09 28 66 6f 72 as-vertex!..(for
6ab0: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 eign-lambda void
6ac0: 20 22 63 64 66 43 61 6e 76 61 73 56 65 72 74 65 "cdfCanvasVerte
6ad0: 78 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 x" nonnull-canva
6ae0: 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 29 s double double)
6af0: 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 29 0a )..;; }}}..).