Artifact
b2f148338cd9720c36fcb24739c700fd09a5c465:
0000: 3b 3b 20 2d 2a 2d 20 6d 6f 64 65 3a 20 53 63 68 ;; -*- mode: Sch
0010: 65 6d 65 3b 20 74 61 62 2d 77 69 64 74 68 3a 20 eme; tab-width:
0020: 32 3b 20 2d 2a 2d 20 3b 3b 0a 0a 3b 3b 20 7b 7b 2; -*- ;;..;; {{
0030: 7b 20 44 61 74 61 20 74 79 70 65 73 0a 0a 28 66 { Data types..(f
0040: 6f 72 65 69 67 6e 2d 64 65 63 6c 61 72 65 0a 09 oreign-declare..
0050: 22 23 69 6e 63 6c 75 64 65 20 3c 63 64 2e 68 3e "#include <cd.h>
0060: 5c 6e 22 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 \n")..(include "
0070: 63 61 6e 76 61 73 2d 64 72 61 77 2d 74 79 70 65 canvas-draw-type
0080: 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 7d 7d 7d 0a s.scm")..;; }}}.
0090: 0a 3b 3b 20 7b 7b 7b 20 50 6f 69 6e 74 20 64 72 .;; {{{ Point dr
00a0: 61 77 69 6e 67 20 66 75 6e 63 74 69 6f 6e 73 0a awing functions.
00b0: 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d .(define canvas-
00c0: 70 69 78 65 6c 21 0a 09 28 6c 65 74 72 65 63 20 pixel!..(letrec
00d0: 28 5b 63 61 6e 76 61 73 2d 70 69 78 65 6c 2f 72 ([canvas-pixel/r
00e0: 61 77 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 aw!.. (
00f0: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 foreign-lambda v
0100: 6f 69 64 20 22 63 64 43 61 6e 76 61 73 50 69 78 oid "cdCanvasPix
0110: 65 6c 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 el" nonnull-canv
0120: 61 73 20 69 6e 74 20 69 6e 74 20 75 6e 73 69 67 as int int unsig
0130: 6e 65 64 2d 6c 6f 6e 67 29 5d 29 0a 09 20 20 28 ned-long)]).. (
0140: 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 78 lambda (canvas x
0150: 20 79 20 23 21 6f 70 74 69 6f 6e 61 6c 20 5b 63 y #!optional [c
0160: 6f 6c 6f 72 20 28 63 61 6e 76 61 73 2d 66 6f 72 olor (canvas-for
0170: 65 67 72 6f 75 6e 64 20 63 61 6e 76 61 73 29 5d eground canvas)]
0180: 29 0a 09 20 20 09 28 63 61 6e 76 61 73 2d 70 69 ).. .(canvas-pi
0190: 78 65 6c 2f 72 61 77 21 20 63 61 6e 76 61 73 20 xel/raw! canvas
01a0: 78 20 79 20 63 6f 6c 6f 72 29 29 29 29 0a 0a 28 x y color))))..(
01b0: 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 6d 61 define canvas-ma
01c0: 72 6b 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 rk!..(foreign-la
01d0: 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 6e mbda void "cdCan
01e0: 76 61 73 4d 61 72 6b 22 20 6e 6f 6e 6e 75 6c 6c vasMark" nonnull
01f0: 2d 63 61 6e 76 61 73 20 69 6e 74 20 69 6e 74 29 -canvas int int)
0200: 29 0a 0a 28 64 65 66 69 6e 65 2d 76 61 6c 75 65 )..(define-value
0210: 73 20 28 63 61 6e 76 61 73 2d 6d 61 72 6b 2d 74 s (canvas-mark-t
0220: 79 70 65 20 63 61 6e 76 61 73 2d 6d 61 72 6b 2d ype canvas-mark-
0230: 74 79 70 65 2d 73 65 74 21 29 0a 09 28 6c 65 74 type-set!)..(let
0240: 72 65 63 20 28 5b 6d 61 72 6b 2d 74 79 70 65 73 rec ([mark-types
0250: 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 .. (lis
0260: 74 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 t.. .(c
0270: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
0280: 09 27 2b 0a 09 20 20 20 20 20 20 20 20 20 20 09 .'+.. .
0290: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
02a0: 22 43 44 5f 50 4c 55 53 22 20 69 6e 74 29 29 0a "CD_PLUS" int)).
02b0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
02c0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
02d0: 70 6c 75 73 0a 09 20 20 20 20 20 20 20 20 20 20 plus..
02e0: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
02f0: 20 22 43 44 5f 50 4c 55 53 22 20 69 6e 74 29 29 "CD_PLUS" int))
0300: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
0310: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
0320: 27 2a 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 '*.. ..
0330: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
0340: 43 44 5f 53 54 41 52 22 20 69 6e 74 29 29 0a 09 CD_STAR" int))..
0350: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
0360: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 73 .. ..'s
0370: 74 61 72 0a 09 20 20 20 20 20 20 20 20 20 20 09 tar.. .
0380: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
0390: 22 43 44 5f 53 54 41 52 22 20 69 6e 74 29 29 0a "CD_STAR" int)).
03a0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
03b0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
03c0: 30 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 0.. ..(
03d0: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
03e0: 44 5f 43 49 52 43 4c 45 22 20 69 6e 74 29 29 0a D_CIRCLE" int)).
03f0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
0400: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
0410: 63 69 72 63 6c 65 0a 09 20 20 20 20 20 20 20 20 circle..
0420: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
0430: 75 65 20 22 43 44 5f 43 49 52 43 4c 45 22 20 69 ue "CD_CIRCLE" i
0440: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
0450: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
0460: 20 20 09 09 27 4f 0a 09 20 20 20 20 20 20 20 20 ..'O..
0470: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
0480: 75 65 20 22 43 44 5f 48 4f 4c 4c 4f 57 5f 43 49 ue "CD_HOLLOW_CI
0490: 52 43 4c 45 22 20 69 6e 74 29 29 0a 09 20 20 20 RCLE" int))..
04a0: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
04b0: 20 20 20 20 20 20 20 20 20 09 09 27 68 6f 6c 6c ..'holl
04c0: 6f 77 2d 63 69 72 63 6c 65 0a 09 20 20 20 20 20 ow-circle..
04d0: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
04e0: 76 61 6c 75 65 20 22 43 44 5f 48 4f 4c 4c 4f 57 value "CD_HOLLOW
04f0: 5f 43 49 52 43 4c 45 22 20 69 6e 74 29 29 0a 09 _CIRCLE" int))..
0500: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
0510: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 58 .. ..'X
0520: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
0530: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
0540: 5f 58 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 _X" int))..
0550: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
0560: 20 20 20 20 20 20 20 09 09 27 78 0a 09 20 20 20 ..'x..
0570: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
0580: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 58 22 20 69 n-value "CD_X" i
0590: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
05a0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
05b0: 20 20 09 09 27 62 6f 78 0a 09 20 20 20 20 20 20 ..'box..
05c0: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
05d0: 61 6c 75 65 20 22 43 44 5f 42 4f 58 22 20 69 6e alue "CD_BOX" in
05e0: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
05f0: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
0600: 20 09 09 27 68 6f 6c 6c 6f 77 2d 62 6f 78 0a 09 ..'hollow-box..
0610: 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 ..(for
0620: 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 48 eign-value "CD_H
0630: 4f 4c 4c 4f 57 5f 42 4f 58 22 20 69 6e 74 29 29 OLLOW_BOX" int))
0640: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
0650: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
0660: 27 64 69 61 6d 6f 6e 64 0a 09 20 20 20 20 20 20 'diamond..
0670: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
0680: 61 6c 75 65 20 22 43 44 5f 44 49 41 4d 4f 4e 44 alue "CD_DIAMOND
0690: 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 " int))..
06a0: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
06b0: 20 20 20 20 20 09 09 27 68 6f 6c 6c 6f 77 2d 64 ..'hollow-d
06c0: 69 61 6d 6f 6e 64 0a 09 20 20 20 20 20 20 20 20 iamond..
06d0: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
06e0: 75 65 20 22 43 44 5f 48 4f 4c 4c 4f 57 5f 44 49 ue "CD_HOLLOW_DI
06f0: 41 4d 4f 4e 44 22 20 69 6e 74 29 29 29 5d 0a 09 AMOND" int)))]..
0700: 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 [canvas
0710: 2d 6d 61 72 6b 2d 74 79 70 65 2d 73 65 74 2f 72 -mark-type-set/r
0720: 61 77 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 aw!.. (
0730: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 foreign-lambda v
0740: 6f 69 64 20 22 63 64 43 61 6e 76 61 73 4d 61 72 oid "cdCanvasMar
0750: 6b 54 79 70 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 kType" nonnull-c
0760: 61 6e 76 61 73 20 69 6e 74 29 5d 0a 09 20 20 20 anvas int)]..
0770: 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 6d 61 [canvas-ma
0780: 72 6b 2d 74 79 70 65 2d 73 65 74 21 0a 09 20 20 rk-type-set!..
0790: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
07a0: 28 63 61 6e 76 61 73 20 6d 61 72 6b 2d 74 79 70 (canvas mark-typ
07b0: 65 29 0a 09 09 09 09 09 09 09 28 63 61 6e 76 61 e)........(canva
07c0: 73 2d 6d 61 72 6b 2d 74 79 70 65 2d 73 65 74 2f s-mark-type-set/
07d0: 72 61 77 21 0a 09 09 09 09 09 09 09 09 63 61 6e raw!.........can
07e0: 76 61 73 0a 09 09 09 09 09 09 09 09 28 63 6f 6e vas.........(con
07f0: 64 0a 09 09 09 09 09 09 09 09 09 5b 28 61 73 73 d..........[(ass
0800: 71 20 6d 61 72 6b 2d 74 79 70 65 20 6d 61 72 6b q mark-type mark
0810: 2d 74 79 70 65 73 29 20 3d 3e 20 63 64 72 5d 0a -types) => cdr].
0820: 09 09 09 09 09 09 09 09 09 5b 65 6c 73 65 20 28 .........[else (
0830: 65 72 72 6f 72 20 27 63 61 6e 76 61 73 2d 6d 61 error 'canvas-ma
0840: 72 6b 2d 74 79 70 65 2d 73 65 74 21 20 22 75 6e rk-type-set! "un
0850: 6b 6e 6f 77 6e 20 6d 61 72 6b 20 74 79 70 65 22 known mark type"
0860: 20 6d 61 72 6b 2d 74 79 70 65 29 5d 29 29 29 5d mark-type)])))]
0870: 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 .. [canv
0880: 61 73 2d 6d 61 72 6b 2d 74 79 70 65 2f 72 61 77 as-mark-type/raw
0890: 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 .. (for
08a0: 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 69 6e 74 eign-lambda* int
08b0: 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 ([nonnull-canva
08c0: 73 20 63 61 6e 76 61 73 5d 29 0a 09 20 20 20 20 s canvas])..
08d0: 20 20 20 20 20 20 09 22 43 5f 72 65 74 75 72 6e ."C_return
08e0: 28 63 64 43 61 6e 76 61 73 4d 61 72 6b 54 79 70 (cdCanvasMarkTyp
08f0: 65 28 63 61 6e 76 61 73 2c 20 43 44 5f 51 55 45 e(canvas, CD_QUE
0900: 52 59 29 29 3b 22 29 5d 0a 09 20 20 20 20 20 20 RY));")]..
0910: 20 20 20 5b 63 61 6e 76 61 73 2d 6d 61 72 6b 2d [canvas-mark-
0920: 74 79 70 65 0a 09 20 20 20 20 20 20 20 20 20 20 type..
0930: 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 29 (lambda (canvas)
0940: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 6c 65 .. .(le
0950: 74 20 28 5b 6d 61 72 6b 2d 74 79 70 65 20 28 63 t ([mark-type (c
0960: 61 6e 76 61 73 2d 6d 61 72 6b 2d 74 79 70 65 2f anvas-mark-type/
0970: 72 61 77 20 63 61 6e 76 61 73 29 5d 29 0a 09 09 raw canvas)])...
0980: 09 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 ......(cond.....
0990: 09 09 09 09 09 5b 28 72 61 73 73 6f 63 20 6d 61 .....[(rassoc ma
09a0: 72 6b 2d 74 79 70 65 20 6d 61 72 6b 2d 74 79 70 rk-type mark-typ
09b0: 65 73 29 20 3d 3e 20 63 61 72 5d 0a 09 09 09 09 es) => car].....
09c0: 09 09 09 09 09 5b 65 6c 73 65 20 28 65 72 72 6f .....[else (erro
09d0: 72 20 27 63 61 6e 76 61 73 2d 6d 61 72 6b 2d 74 r 'canvas-mark-t
09e0: 79 70 65 20 22 75 6e 6b 6e 6f 77 6e 20 6d 61 72 ype "unknown mar
09f0: 6b 20 74 79 70 65 22 20 6d 61 72 6b 2d 74 79 70 k type" mark-typ
0a00: 65 29 5d 29 29 29 5d 29 0a 09 20 20 28 76 61 6c e)])))]).. (val
0a10: 75 65 73 0a 09 20 20 09 28 67 65 74 74 65 72 2d ues.. .(getter-
0a20: 77 69 74 68 2d 73 65 74 74 65 72 20 63 61 6e 76 with-setter canv
0a30: 61 73 2d 6d 61 72 6b 2d 74 79 70 65 20 63 61 6e as-mark-type can
0a40: 76 61 73 2d 6d 61 72 6b 2d 74 79 70 65 2d 73 65 vas-mark-type-se
0a50: 74 21 29 0a 09 20 20 09 63 61 6e 76 61 73 2d 6d t!).. .canvas-m
0a60: 61 72 6b 2d 74 79 70 65 2d 73 65 74 21 29 29 29 ark-type-set!)))
0a70: 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 73 ..(define canvas
0a80: 2d 6d 61 72 6b 2d 73 69 7a 65 2d 73 65 74 21 0a -mark-size-set!.
0a90: 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 .(foreign-lambda
0aa0: 20 76 6f 69 64 20 22 63 64 43 61 6e 76 61 73 4d void "cdCanvasM
0ab0: 61 72 6b 53 69 7a 65 22 20 6e 6f 6e 6e 75 6c 6c arkSize" nonnull
0ac0: 2d 63 61 6e 76 61 73 20 69 6e 74 29 29 0a 0a 28 -canvas int))..(
0ad0: 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 6d 61 define canvas-ma
0ae0: 72 6b 2d 73 69 7a 65 0a 09 28 67 65 74 74 65 72 rk-size..(getter
0af0: 2d 77 69 74 68 2d 73 65 74 74 65 72 0a 09 09 28 -with-setter...(
0b00: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 foreign-lambda*
0b10: 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 int ([nonnull-ca
0b20: 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 09 nvas canvas])...
0b30: 09 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e ."C_return(cdCan
0b40: 76 61 73 4d 61 72 6b 53 69 7a 65 28 63 61 6e 76 vasMarkSize(canv
0b50: 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 as, CD_QUERY));"
0b60: 29 0a 09 09 63 61 6e 76 61 73 2d 6d 61 72 6b 2d )...canvas-mark-
0b70: 73 69 7a 65 2d 73 65 74 21 29 29 0a 0a 3b 3b 20 size-set!))..;;
0b80: 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 4c 69 6e 65 }}}..;; {{{ Line
0b90: 20 66 75 6e 63 74 69 6f 6e 73 0a 0a 28 64 65 66 functions..(def
0ba0: 69 6e 65 20 63 61 6e 76 61 73 2d 6c 69 6e 65 21 ine canvas-line!
0bb0: 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 ..(foreign-lambd
0bc0: 61 20 76 6f 69 64 20 22 63 64 66 43 61 6e 76 61 a void "cdfCanva
0bd0: 73 4c 69 6e 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 sLine" nonnull-c
0be0: 61 6e 76 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 anvas double dou
0bf0: 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c ble double doubl
0c00: 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e e))..(define can
0c10: 76 61 73 2d 72 65 63 74 61 6e 67 6c 65 21 0a 09 vas-rectangle!..
0c20: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 (foreign-lambda
0c30: 76 6f 69 64 20 22 63 64 66 43 61 6e 76 61 73 52 void "cdfCanvasR
0c40: 65 63 74 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e ect" nonnull-can
0c50: 76 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c vas double doubl
0c60: 65 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 29 e double double)
0c70: 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 )..(define canva
0c80: 73 2d 61 72 63 21 0a 09 28 66 6f 72 65 69 67 6e s-arc!..(foreign
0c90: 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 -lambda void "cd
0ca0: 66 43 61 6e 76 61 73 41 72 63 22 20 6e 6f 6e 6e fCanvasArc" nonn
0cb0: 75 6c 6c 2d 63 61 6e 76 61 73 20 64 6f 75 62 6c ull-canvas doubl
0cc0: 65 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 e double double
0cd0: 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f double double do
0ce0: 75 62 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 2d uble))..(define-
0cf0: 76 61 6c 75 65 73 20 28 63 61 6e 76 61 73 2d 6c values (canvas-l
0d00: 69 6e 65 2d 73 74 79 6c 65 20 63 61 6e 76 61 73 ine-style canvas
0d10: 2d 6c 69 6e 65 2d 73 74 79 6c 65 2d 73 65 74 21 -line-style-set!
0d20: 29 0a 09 28 6c 65 74 72 65 63 20 28 5b 6c 69 6e )..(letrec ([lin
0d30: 65 2d 73 74 79 6c 65 73 0a 09 20 20 20 20 20 20 e-styles..
0d40: 20 20 20 20 28 6c 69 73 74 0a 09 20 20 20 20 20 (list..
0d50: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
0d60: 20 20 20 20 20 20 20 09 09 27 63 6f 6e 74 69 6e ..'contin
0d70: 75 6f 75 73 0a 09 20 20 20 20 20 20 20 20 20 20 uous..
0d80: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
0d90: 20 22 43 44 5f 43 4f 4e 54 49 4e 55 4f 55 53 22 "CD_CONTINUOUS"
0da0: 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 int))..
0db0: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
0dc0: 20 20 20 20 09 09 27 64 61 73 68 65 64 0a 09 20 ..'dashed..
0dd0: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
0de0: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 44 41 ign-value "CD_DA
0df0: 53 48 45 44 22 20 69 6e 74 29 29 0a 09 20 20 20 SHED" int))..
0e00: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
0e10: 20 20 20 20 20 20 20 20 20 09 09 27 64 6f 74 74 ..'dott
0e20: 65 64 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ed.. ..
0e30: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
0e40: 43 44 5f 44 4f 54 54 45 44 22 20 69 6e 74 29 29 CD_DOTTED" int))
0e50: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
0e60: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
0e70: 27 64 61 73 68 2d 64 6f 74 74 65 64 0a 09 20 20 'dash-dotted..
0e80: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
0e90: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 44 41 53 gn-value "CD_DAS
0ea0: 48 5f 44 4f 54 22 20 69 6e 74 29 29 0a 09 20 20 H_DOT" int))..
0eb0: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
0ec0: 20 20 20 20 20 20 20 20 20 20 09 09 27 64 61 73 ..'das
0ed0: 68 2d 64 6f 74 2d 64 6f 74 74 65 64 0a 09 20 20 h-dot-dotted..
0ee0: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
0ef0: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 44 41 53 gn-value "CD_DAS
0f00: 48 5f 44 4f 54 5f 44 4f 54 22 20 69 6e 74 29 29 H_DOT_DOT" int))
0f10: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
0f20: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
0f30: 27 63 75 73 74 6f 6d 0a 09 20 20 20 20 20 20 20 'custom..
0f40: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
0f50: 6c 75 65 20 22 43 44 5f 43 55 53 54 4f 4d 22 20 lue "CD_CUSTOM"
0f60: 69 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 20 20 int)))]..
0f70: 20 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 [canvas-line-s
0f80: 74 79 6c 65 2d 73 65 74 2f 72 61 77 21 0a 09 20 tyle-set/raw!..
0f90: 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 (foreig
0fa0: 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 n-lambda void "c
0fb0: 64 43 61 6e 76 61 73 4c 69 6e 65 53 74 79 6c 65 dCanvasLineStyle
0fc0: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
0fd0: 20 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 int)]..
0fe0: 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 74 [canvas-line-st
0ff0: 79 6c 65 2d 64 61 73 68 65 73 2d 73 65 74 2f 72 yle-dashes-set/r
1000: 61 77 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 aw!.. (
1010: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 foreign-lambda v
1020: 6f 69 64 20 22 63 64 43 61 6e 76 61 73 4c 69 6e oid "cdCanvasLin
1030: 65 53 74 79 6c 65 44 61 73 68 65 73 22 20 6e 6f eStyleDashes" no
1040: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 6e 6f 6e nnull-canvas non
1050: 6e 75 6c 6c 2d 73 33 32 76 65 63 74 6f 72 20 69 null-s32vector i
1060: 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b nt)].. [
1070: 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 74 79 6c canvas-line-styl
1080: 65 2d 73 65 74 21 0a 09 20 20 20 20 20 20 20 20 e-set!..
1090: 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 (lambda (canva
10a0: 73 20 6c 69 6e 65 2d 73 74 79 6c 65 29 0a 09 20 s line-style)..
10b0: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 64 0a .(cond.
10c0: 09 20 20 20 20 20 20 20 20 20 20 09 09 5b 28 61 . ..[(a
10d0: 6e 64 20 28 70 61 69 72 3f 20 6c 69 6e 65 2d 73 nd (pair? line-s
10e0: 74 79 6c 65 29 20 28 65 71 3f 20 28 63 61 72 20 tyle) (eq? (car
10f0: 6c 69 6e 65 2d 73 74 79 6c 65 29 20 27 63 75 73 line-style) 'cus
1100: 74 6f 6d 29 29 0a 09 20 20 20 20 20 20 20 20 20 tom))..
1110: 20 09 09 20 28 6c 65 74 20 28 5b 64 61 73 68 65 .. (let ([dashe
1120: 73 20 28 6c 69 73 74 2d 3e 73 33 32 76 65 63 74 s (list->s32vect
1130: 6f 72 20 28 63 64 72 20 6c 69 6e 65 2d 73 74 79 or (cdr line-sty
1140: 6c 65 29 29 5d 29 0a 09 20 20 20 20 20 20 20 20 le))])..
1150: 20 20 09 09 20 09 20 28 63 61 6e 76 61 73 2d 6c .. . (canvas-l
1160: 69 6e 65 2d 73 74 79 6c 65 2d 64 61 73 68 65 73 ine-style-dashes
1170: 2d 73 65 74 2f 72 61 77 21 20 63 61 6e 76 61 73 -set/raw! canvas
1180: 20 64 61 73 68 65 73 20 28 73 33 32 76 65 63 74 dashes (s32vect
1190: 6f 72 2d 6c 65 6e 67 74 68 20 64 61 73 68 65 73 or-length dashes
11a0: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 )).. ..
11b0: 20 09 20 28 63 61 6e 76 61 73 2d 6c 69 6e 65 2d . (canvas-line-
11c0: 73 74 79 6c 65 2d 73 65 74 2f 72 61 77 21 20 63 style-set/raw! c
11d0: 61 6e 76 61 73 20 28 63 64 72 20 28 61 73 73 71 anvas (cdr (assq
11e0: 20 27 63 75 73 74 6f 6d 20 6c 69 6e 65 2d 73 74 'custom line-st
11f0: 79 6c 65 73 29 29 29 29 5d 0a 09 20 20 20 20 20 yles))))]..
1200: 20 20 20 20 20 09 09 5b 65 6c 73 65 0a 09 20 20 ..[else..
1210: 20 20 20 20 20 20 20 20 09 09 20 28 63 61 6e 76 .. (canv
1220: 61 73 2d 6c 69 6e 65 2d 73 74 79 6c 65 2d 73 65 as-line-style-se
1230: 74 2f 72 61 77 21 0a 09 20 20 20 20 20 20 20 20 t/raw!..
1240: 20 20 09 09 20 09 20 63 61 6e 76 61 73 0a 09 20 .. . canvas..
1250: 20 20 20 20 20 20 20 20 20 09 09 20 09 20 28 63 .. . (c
1260: 6f 6e 64 0a 09 20 20 20 20 20 20 20 20 20 20 09 ond.. .
1270: 09 20 09 20 09 20 5b 28 61 73 73 71 20 6c 69 6e . . . [(assq lin
1280: 65 2d 73 74 79 6c 65 20 6c 69 6e 65 2d 73 74 79 e-style line-sty
1290: 6c 65 73 29 20 3d 3e 20 63 64 72 5d 0a 09 20 20 les) => cdr]..
12a0: 20 20 20 20 20 20 20 20 09 09 20 09 20 09 20 5b .. . . [
12b0: 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e else (error 'can
12c0: 76 61 73 2d 6c 69 6e 65 2d 73 74 79 6c 65 2d 73 vas-line-style-s
12d0: 65 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 6c 69 6e et! "unknown lin
12e0: 65 20 73 74 79 6c 65 22 20 6c 69 6e 65 2d 73 74 e style" line-st
12f0: 79 6c 65 29 5d 29 29 5d 29 29 5d 0a 09 20 20 20 yle)]))]))]..
1300: 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 6c 69 [canvas-li
1310: 6e 65 2d 73 74 79 6c 65 2f 72 61 77 0a 09 20 20 ne-style/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 2a 20 69 6e 74 20 28 5b 6e -lambda* int ([n
1340: 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 onnull-canvas ca
1350: 6e 76 61 73 5d 29 0a 09 20 20 20 20 20 20 20 20 nvas])..
1360: 20 20 09 22 43 5f 72 65 74 75 72 6e 28 63 64 43 ."C_return(cdC
1370: 61 6e 76 61 73 4c 69 6e 65 53 74 79 6c 65 28 63 anvasLineStyle(c
1380: 61 6e 76 61 73 2c 20 43 44 5f 51 55 45 52 59 29 anvas, CD_QUERY)
1390: 29 3b 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 );")]..
13a0: 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 73 74 79 [canvas-line-sty
13b0: 6c 65 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c le.. (l
13c0: 61 6d 62 64 61 20 28 63 61 6e 76 61 73 29 0a 09 ambda (canvas)..
13d0: 20 20 20 20 20 20 20 20 20 20 09 28 6c 65 74 20 .(let
13e0: 28 5b 6c 69 6e 65 2d 73 74 79 6c 65 20 28 63 61 ([line-style (ca
13f0: 6e 76 61 73 2d 6c 69 6e 65 2d 73 74 79 6c 65 2f nvas-line-style/
1400: 72 61 77 20 63 61 6e 76 61 73 29 5d 29 0a 09 20 raw canvas)])..
1410: 20 20 20 20 20 20 20 20 20 09 09 28 63 6f 6e 64 ..(cond
1420: 0a 09 09 09 09 09 09 09 09 09 5b 28 72 61 73 73 ..........[(rass
1430: 6f 63 20 6c 69 6e 65 2d 73 74 79 6c 65 20 6c 69 oc line-style li
1440: 6e 65 2d 73 74 79 6c 65 73 29 20 3d 3e 20 63 61 ne-styles) => ca
1450: 72 5d 0a 09 09 09 09 09 09 09 09 09 5b 65 6c 73 r]..........[els
1460: 65 20 28 65 72 72 6f 72 20 27 63 61 6e 76 61 73 e (error 'canvas
1470: 2d 6c 69 6e 65 2d 73 74 79 6c 65 20 22 75 6e 6b -line-style "unk
1480: 6e 6f 77 6e 20 6c 69 6e 65 20 73 74 79 6c 65 22 nown line style"
1490: 20 6c 69 6e 65 2d 73 74 79 6c 65 29 5d 29 29 29 line-style)])))
14a0: 5d 29 0a 09 20 20 28 76 61 6c 75 65 73 0a 09 20 ]).. (values..
14b0: 20 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 .(getter-with-s
14c0: 65 74 74 65 72 20 63 61 6e 76 61 73 2d 6c 69 6e etter canvas-lin
14d0: 65 2d 73 74 79 6c 65 20 63 61 6e 76 61 73 2d 6c e-style canvas-l
14e0: 69 6e 65 2d 73 74 79 6c 65 2d 73 65 74 21 29 0a ine-style-set!).
14f0: 09 20 20 09 63 61 6e 76 61 73 2d 6c 69 6e 65 2d . .canvas-line-
1500: 73 74 79 6c 65 2d 73 65 74 21 29 29 29 0a 0a 28 style-set!)))..(
1510: 64 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 6c 69 define canvas-li
1520: 6e 65 2d 77 69 64 74 68 2d 73 65 74 21 0a 09 28 ne-width-set!..(
1530: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 69 foreign-lambda i
1540: 6e 74 20 22 63 64 43 61 6e 76 61 73 4c 69 6e 65 nt "cdCanvasLine
1550: 57 69 64 74 68 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 Width" nonnull-c
1560: 61 6e 76 61 73 20 69 6e 74 29 29 0a 0a 28 64 65 anvas int))..(de
1570: 66 69 6e 65 20 63 61 6e 76 61 73 2d 6c 69 6e 65 fine canvas-line
1580: 2d 77 69 64 74 68 0a 09 28 67 65 74 74 65 72 2d -width..(getter-
1590: 77 69 74 68 2d 73 65 74 74 65 72 0a 09 09 28 66 with-setter...(f
15a0: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 69 oreign-lambda* i
15b0: 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e nt ([nonnull-can
15c0: 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 09 09 vas canvas])....
15d0: 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 "C_return(cdCanv
15e0: 61 73 4c 69 6e 65 57 69 64 74 68 28 63 61 6e 76 asLineWidth(canv
15f0: 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 as, CD_QUERY));"
1600: 29 0a 09 09 63 61 6e 76 61 73 2d 6c 69 6e 65 2d )...canvas-line-
1610: 77 69 64 74 68 2d 73 65 74 21 29 29 0a 0a 28 64 width-set!))..(d
1620: 65 66 69 6e 65 2d 76 61 6c 75 65 73 20 28 63 61 efine-values (ca
1630: 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e 20 63 nvas-line-join c
1640: 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e 2d anvas-line-join-
1650: 73 65 74 21 29 0a 09 28 6c 65 74 72 65 63 20 28 set!)..(letrec (
1660: 5b 6c 69 6e 65 2d 6a 6f 69 6e 73 0a 09 20 20 20 [line-joins..
1670: 20 20 20 20 20 20 20 28 6c 69 73 74 0a 09 20 20 (list..
1680: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
1690: 20 20 20 20 20 20 20 20 20 20 09 09 27 6d 69 74 ..'mit
16a0: 65 72 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 er.. ..
16b0: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
16c0: 43 44 5f 4d 49 54 45 52 22 20 69 6e 74 29 29 0a CD_MITER" int)).
16d0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
16e0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
16f0: 62 65 76 65 6c 0a 09 20 20 20 20 20 20 20 20 20 bevel..
1700: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
1710: 65 20 22 43 44 5f 42 45 56 45 4c 22 20 69 6e 74 e "CD_BEVEL" int
1720: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
1730: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
1740: 09 09 27 72 6f 75 6e 64 0a 09 20 20 20 20 20 20 ..'round..
1750: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
1760: 61 6c 75 65 20 22 43 44 5f 52 4f 55 4e 44 22 20 alue "CD_ROUND"
1770: 69 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 20 20 int)))]..
1780: 20 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a [canvas-line-j
1790: 6f 69 6e 2d 73 65 74 2f 72 61 77 21 0a 09 20 20 oin-set/raw!..
17a0: 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e (foreign
17b0: 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 -lambda void "cd
17c0: 43 61 6e 76 61 73 4c 69 6e 65 4a 6f 69 6e 22 20 CanvasLineJoin"
17d0: 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 69 nonnull-canvas i
17e0: 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b nt)].. [
17f0: 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e canvas-line-join
1800: 2d 73 65 74 21 0a 09 20 20 20 20 20 20 20 20 20 -set!..
1810: 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 (lambda (canvas
1820: 20 6c 69 6e 65 2d 6a 6f 69 6e 29 0a 09 09 09 09 line-join).....
1830: 09 09 09 28 63 61 6e 76 61 73 2d 6c 69 6e 65 2d ...(canvas-line-
1840: 6a 6f 69 6e 2d 73 65 74 2f 72 61 77 21 0a 09 09 join-set/raw!...
1850: 09 09 09 09 09 09 63 61 6e 76 61 73 0a 09 09 09 ......canvas....
1860: 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 .....(cond......
1870: 09 09 09 09 5b 28 61 73 73 71 20 6c 69 6e 65 2d ....[(assq line-
1880: 6a 6f 69 6e 20 6c 69 6e 65 2d 6a 6f 69 6e 73 29 join line-joins)
1890: 20 3d 3e 20 63 64 72 5d 0a 09 09 09 09 09 09 09 => cdr]........
18a0: 09 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 ..[else (error '
18b0: 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e canvas-line-join
18c0: 2d 73 65 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 6c -set! "unknown l
18d0: 69 6e 65 20 6a 6f 69 6e 22 20 6c 69 6e 65 2d 6a ine join" line-j
18e0: 6f 69 6e 29 5d 29 29 29 5d 0a 09 20 20 20 20 20 oin)])))]..
18f0: 20 20 20 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 [canvas-line
1900: 2d 6a 6f 69 6e 2f 72 61 77 0a 09 20 20 20 20 20 -join/raw..
1910: 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 (foreign-la
1920: 6d 62 64 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e mbda* int ([nonn
1930: 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 ull-canvas canva
1940: 73 5d 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 s]).. .
1950: 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 "C_return(cdCanv
1960: 61 73 4c 69 6e 65 4a 6f 69 6e 28 63 61 6e 76 61 asLineJoin(canva
1970: 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 29 s, CD_QUERY));")
1980: 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e ].. [can
1990: 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 6e 0a 09 20 vas-line-join..
19a0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
19b0: 20 28 63 61 6e 76 61 73 29 0a 09 20 20 20 20 20 (canvas)..
19c0: 20 20 20 20 20 09 28 6c 65 74 20 28 5b 6c 69 6e .(let ([lin
19d0: 65 2d 6a 6f 69 6e 20 28 63 61 6e 76 61 73 2d 6c e-join (canvas-l
19e0: 69 6e 65 2d 6a 6f 69 6e 2f 72 61 77 20 63 61 6e ine-join/raw can
19f0: 76 61 73 29 5d 29 0a 09 20 20 20 20 20 20 20 20 vas)])..
1a00: 20 20 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 09 ..(cond.......
1a10: 09 09 09 5b 28 72 61 73 73 6f 63 20 6c 69 6e 65 ...[(rassoc line
1a20: 2d 6a 6f 69 6e 20 6c 69 6e 65 2d 6a 6f 69 6e 73 -join line-joins
1a30: 29 20 3d 3e 20 63 61 72 5d 0a 09 09 09 09 09 09 ) => car].......
1a40: 09 09 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 ...[else (error
1a50: 27 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a 6f 69 'canvas-line-joi
1a60: 6e 20 22 75 6e 6b 6e 6f 77 6e 20 6c 69 6e 65 20 n "unknown line
1a70: 6a 6f 69 6e 22 20 6c 69 6e 65 2d 6a 6f 69 6e 29 join" line-join)
1a80: 5d 29 29 29 5d 29 0a 09 09 28 76 61 6c 75 65 73 ])))])...(values
1a90: 0a 09 09 09 28 67 65 74 74 65 72 2d 77 69 74 68 ....(getter-with
1aa0: 2d 73 65 74 74 65 72 20 63 61 6e 76 61 73 2d 6c -setter canvas-l
1ab0: 69 6e 65 2d 6a 6f 69 6e 20 63 61 6e 76 61 73 2d ine-join canvas-
1ac0: 6c 69 6e 65 2d 6a 6f 69 6e 2d 73 65 74 21 29 0a line-join-set!).
1ad0: 09 09 09 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 6a ...canvas-line-j
1ae0: 6f 69 6e 2d 73 65 74 21 29 29 29 0a 0a 28 64 65 oin-set!)))..(de
1af0: 66 69 6e 65 2d 76 61 6c 75 65 73 20 28 63 61 6e fine-values (can
1b00: 76 61 73 2d 6c 69 6e 65 2d 63 61 70 20 63 61 6e vas-line-cap can
1b10: 76 61 73 2d 6c 69 6e 65 2d 63 61 70 2d 73 65 74 vas-line-cap-set
1b20: 21 29 0a 09 28 6c 65 74 72 65 63 20 28 5b 6c 69 !)..(letrec ([li
1b30: 6e 65 2d 63 61 70 73 0a 09 20 20 20 20 20 20 20 ne-caps..
1b40: 20 20 20 28 6c 69 73 74 0a 09 20 20 20 20 20 20 (list..
1b50: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
1b60: 20 20 20 20 20 20 09 09 27 66 6c 61 74 0a 09 20 ..'flat..
1b70: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
1b80: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 41 ign-value "CD_CA
1b90: 50 46 4c 41 54 22 20 69 6e 74 29 29 0a 09 20 20 PFLAT" int))..
1ba0: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
1bb0: 20 20 20 20 20 20 20 20 20 20 09 09 27 73 71 75 ..'squ
1bc0: 61 72 65 0a 09 20 20 20 20 20 20 20 20 20 20 09 are.. .
1bd0: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
1be0: 22 43 44 5f 43 41 50 53 51 55 41 52 45 22 20 69 "CD_CAPSQUARE" i
1bf0: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
1c00: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
1c10: 20 20 09 09 27 72 6f 75 6e 64 0a 09 20 20 20 20 ..'round..
1c20: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
1c30: 2d 76 61 6c 75 65 20 22 43 44 5f 43 41 50 52 4f -value "CD_CAPRO
1c40: 55 4e 44 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 UND" int)))]..
1c50: 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 6c [canvas-l
1c60: 69 6e 65 2d 63 61 70 2d 73 65 74 2f 72 61 77 21 ine-cap-set/raw!
1c70: 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 .. (for
1c80: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 eign-lambda void
1c90: 20 22 63 64 43 61 6e 76 61 73 4c 69 6e 65 43 61 "cdCanvasLineCa
1ca0: 70 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 p" nonnull-canva
1cb0: 73 20 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 s int)]..
1cc0: 20 20 5b 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 [canvas-line-c
1cd0: 61 70 2d 73 65 74 21 0a 09 20 20 20 20 20 20 20 ap-set!..
1ce0: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 (lambda (canv
1cf0: 61 73 20 6c 69 6e 65 2d 63 61 70 29 0a 09 09 09 as line-cap)....
1d00: 09 09 09 09 28 63 61 6e 76 61 73 2d 6c 69 6e 65 ....(canvas-line
1d10: 2d 63 61 70 2d 73 65 74 2f 72 61 77 21 0a 09 09 -cap-set/raw!...
1d20: 09 09 09 09 09 09 63 61 6e 76 61 73 0a 09 09 09 ......canvas....
1d30: 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 .....(cond......
1d40: 09 09 09 09 5b 28 61 73 73 71 20 6c 69 6e 65 2d ....[(assq line-
1d50: 63 61 70 20 6c 69 6e 65 2d 63 61 70 73 29 20 3d cap line-caps) =
1d60: 3e 20 63 64 72 5d 0a 09 09 09 09 09 09 09 09 09 > cdr]..........
1d70: 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 [else (error 'ca
1d80: 6e 76 61 73 2d 6c 69 6e 65 2d 63 61 70 2d 73 65 nvas-line-cap-se
1d90: 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 6c 69 6e 65 t! "unknown line
1da0: 20 63 61 70 22 20 6c 69 6e 65 2d 63 61 70 29 5d cap" line-cap)]
1db0: 29 29 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b )))].. [
1dc0: 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 61 70 2f canvas-line-cap/
1dd0: 72 61 77 0a 09 20 20 20 20 20 20 20 20 20 20 28 raw.. (
1de0: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 foreign-lambda*
1df0: 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 int ([nonnull-ca
1e00: 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 20 nvas canvas])..
1e10: 20 20 20 20 20 20 20 20 20 09 22 43 5f 72 65 74 ."C_ret
1e20: 75 72 6e 28 63 64 43 61 6e 76 61 73 4c 69 6e 65 urn(cdCanvasLine
1e30: 43 61 70 28 63 61 6e 76 61 73 2c 20 43 44 5f 51 Cap(canvas, CD_Q
1e40: 55 45 52 59 29 29 3b 22 29 5d 0a 09 20 20 20 20 UERY));")]..
1e50: 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 6c 69 6e [canvas-lin
1e60: 65 2d 63 61 70 0a 09 20 20 20 20 20 20 20 20 20 e-cap..
1e70: 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 (lambda (canvas
1e80: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 6c ).. .(l
1e90: 65 74 20 28 5b 6c 69 6e 65 2d 63 61 70 20 28 63 et ([line-cap (c
1ea0: 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 61 70 2f 72 anvas-line-cap/r
1eb0: 61 77 20 63 61 6e 76 61 73 29 5d 29 0a 09 09 09 aw canvas)])....
1ec0: 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 .....(cond......
1ed0: 09 09 09 09 5b 28 72 61 73 73 6f 63 20 6c 69 6e ....[(rassoc lin
1ee0: 65 2d 63 61 70 20 6c 69 6e 65 2d 63 61 70 73 29 e-cap line-caps)
1ef0: 20 3d 3e 20 63 61 72 5d 0a 09 09 09 09 09 09 09 => car]........
1f00: 09 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 ..[else (error '
1f10: 63 61 6e 76 61 73 2d 6c 69 6e 65 2d 63 61 70 20 canvas-line-cap
1f20: 22 75 6e 6b 6e 6f 77 6e 20 6c 69 6e 65 20 63 61 "unknown line ca
1f30: 70 22 20 6c 69 6e 65 2d 63 61 70 29 5d 29 29 29 p" line-cap)])))
1f40: 5d 29 0a 09 09 28 76 61 6c 75 65 73 0a 09 09 09 ])...(values....
1f50: 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 74 (getter-with-set
1f60: 74 65 72 20 63 61 6e 76 61 73 2d 6c 69 6e 65 2d ter canvas-line-
1f70: 63 61 70 20 63 61 6e 76 61 73 2d 6c 69 6e 65 2d cap canvas-line-
1f80: 63 61 70 2d 73 65 74 21 29 0a 09 09 09 63 61 6e cap-set!)....can
1f90: 76 61 73 2d 6c 69 6e 65 2d 63 61 70 2d 73 65 74 vas-line-cap-set
1fa0: 21 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b !)))..;; }}}..;;
1fb0: 20 7b 7b 7b 20 46 69 6c 6c 65 64 20 61 72 65 61 {{{ Filled area
1fc0: 20 66 75 6e 63 74 69 6f 6e 73 0a 0a 28 64 65 66 functions..(def
1fd0: 69 6e 65 20 63 61 6e 76 61 73 2d 62 6f 78 21 0a ine canvas-box!.
1fe0: 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 .(foreign-lambda
1ff0: 20 76 6f 69 64 20 22 63 64 66 43 61 6e 76 61 73 void "cdfCanvas
2000: 42 6f 78 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e Box" nonnull-can
2010: 76 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c vas double doubl
2020: 65 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 29 e double double)
2030: 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 )..(define canva
2040: 73 2d 73 65 63 74 6f 72 21 0a 09 28 66 6f 72 65 s-sector!..(fore
2050: 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 ign-lambda void
2060: 22 63 64 66 43 61 6e 76 61 73 53 65 63 74 6f 72 "cdfCanvasSector
2070: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
2080: 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 double double d
2090: 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f 75 ouble double dou
20a0: 62 6c 65 20 64 6f 75 62 6c 65 29 29 0a 0a 28 64 ble double))..(d
20b0: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 63 68 6f efine canvas-cho
20c0: 72 64 21 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 rd!..(foreign-la
20d0: 6d 62 64 61 20 76 6f 69 64 20 22 63 64 66 43 61 mbda void "cdfCa
20e0: 6e 76 61 73 43 68 6f 72 64 22 20 6e 6f 6e 6e 75 nvasChord" nonnu
20f0: 6c 6c 2d 63 61 6e 76 61 73 20 64 6f 75 62 6c 65 ll-canvas double
2100: 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 double double d
2110: 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 64 6f 75 ouble double dou
2120: 62 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 2d 76 ble))..(define-v
2130: 61 6c 75 65 73 20 28 63 61 6e 76 61 73 2d 62 61 alues (canvas-ba
2140: 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 74 79 ckground-opacity
2150: 20 63 61 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 canvas-backgrou
2160: 6e 64 2d 6f 70 61 63 69 74 79 2d 73 65 74 21 29 nd-opacity-set!)
2170: 0a 09 28 6c 65 74 72 65 63 20 28 5b 6f 70 61 63 ..(letrec ([opac
2180: 69 74 69 65 73 0a 09 20 20 20 20 20 20 20 20 20 ities..
2190: 20 28 6c 69 73 74 0a 09 20 20 20 20 20 20 20 20 (list..
21a0: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
21b0: 20 20 20 20 09 09 27 6f 70 61 71 75 65 0a 09 20 ..'opaque..
21c0: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
21d0: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 4f 50 ign-value "CD_OP
21e0: 41 51 55 45 22 20 69 6e 74 29 29 0a 09 20 20 20 AQUE" int))..
21f0: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
2200: 20 20 20 20 20 20 20 20 20 09 09 27 74 72 61 6e ..'tran
2210: 73 70 61 72 65 6e 74 0a 09 20 20 20 20 20 20 20 sparent..
2220: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
2230: 6c 75 65 20 22 43 44 5f 54 52 41 4e 53 50 41 52 lue "CD_TRANSPAR
2240: 45 4e 54 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 ENT" int)))]..
2250: 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 62 [canvas-b
2260: 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 74 ackground-opacit
2270: 79 2d 73 65 74 2f 72 61 77 21 0a 09 20 20 20 20 y-set/raw!..
2280: 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c (foreign-l
2290: 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 43 61 ambda void "cdCa
22a0: 6e 76 61 73 42 61 63 6b 4f 70 61 63 69 74 79 22 nvasBackOpacity"
22b0: 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 nonnull-canvas
22c0: 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 20 int)]..
22d0: 5b 63 61 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 [canvas-backgrou
22e0: 6e 64 2d 6f 70 61 63 69 74 79 2d 73 65 74 21 0a nd-opacity-set!.
22f0: 09 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 . (lamb
2300: 64 61 20 28 63 61 6e 76 61 73 20 6f 70 61 63 69 da (canvas opaci
2310: 74 79 29 0a 09 09 09 09 09 09 09 28 63 61 6e 76 ty)........(canv
2320: 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 as-background-op
2330: 61 63 69 74 79 2d 73 65 74 2f 72 61 77 21 0a 09 acity-set/raw!..
2340: 09 09 09 09 09 09 09 63 61 6e 76 61 73 0a 09 09 .......canvas...
2350: 09 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 09 ......(cond.....
2360: 09 09 09 09 09 5b 28 61 73 73 71 20 6f 70 61 63 .....[(assq opac
2370: 69 74 79 20 6f 70 61 63 69 74 69 65 73 29 20 3d ity opacities) =
2380: 3e 20 63 64 72 5d 0a 09 09 09 09 09 09 09 09 09 > cdr]..........
2390: 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 [else (error 'ca
23a0: 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d nvas-background-
23b0: 6f 70 61 63 69 74 79 2d 73 65 74 21 20 22 75 6e opacity-set! "un
23c0: 6b 6e 6f 77 6e 20 6c 69 6e 65 20 63 61 70 22 20 known line cap"
23d0: 6f 70 61 63 69 74 79 29 5d 29 29 29 5d 0a 09 20 opacity)])))]..
23e0: 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d [canvas-
23f0: 62 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 background-opaci
2400: 74 79 2f 72 61 77 0a 09 20 20 20 20 20 20 20 20 ty/raw..
2410: 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 (foreign-lambd
2420: 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c a* int ([nonnull
2430: 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 -canvas canvas])
2440: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 43 5f .. ."C_
2450: 72 65 74 75 72 6e 28 63 64 43 61 6e 76 61 73 42 return(cdCanvasB
2460: 61 63 6b 4f 70 61 63 69 74 79 28 63 61 6e 76 61 ackOpacity(canva
2470: 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 29 s, CD_QUERY));")
2480: 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e ].. [can
2490: 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 6f vas-background-o
24a0: 70 61 63 69 74 79 0a 09 20 20 20 20 20 20 20 20 pacity..
24b0: 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 (lambda (canva
24c0: 73 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 s).. .(
24d0: 6c 65 74 20 28 5b 6f 70 61 63 69 74 79 20 28 63 let ([opacity (c
24e0: 61 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 anvas-background
24f0: 2d 6f 70 61 63 69 74 79 2f 72 61 77 20 63 61 6e -opacity/raw can
2500: 76 61 73 29 5d 29 0a 09 20 20 20 20 20 20 20 20 vas)])..
2510: 20 20 09 09 28 63 6f 6e 64 0a 09 09 09 09 09 09 ..(cond.......
2520: 09 09 09 5b 28 72 61 73 73 6f 63 20 6f 70 61 63 ...[(rassoc opac
2530: 69 74 79 20 6f 70 61 63 69 74 69 65 73 29 20 3d ity opacities) =
2540: 3e 20 63 61 72 5d 0a 09 09 09 09 09 09 09 09 09 > car]..........
2550: 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 [else (error 'ca
2560: 6e 76 61 73 2d 62 61 63 6b 67 72 6f 75 6e 64 2d nvas-background-
2570: 6f 70 61 63 69 74 79 20 22 75 6e 6b 6e 6f 77 6e opacity "unknown
2580: 20 6f 70 61 63 69 74 79 22 20 6f 70 61 63 69 74 opacity" opacit
2590: 79 29 5d 29 29 29 5d 29 0a 09 09 28 76 61 6c 75 y)])))])...(valu
25a0: 65 73 0a 09 09 09 28 67 65 74 74 65 72 2d 77 69 es....(getter-wi
25b0: 74 68 2d 73 65 74 74 65 72 20 63 61 6e 76 61 73 th-setter canvas
25c0: 2d 62 61 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 -background-opac
25d0: 69 74 79 20 63 61 6e 76 61 73 2d 62 61 63 6b 67 ity canvas-backg
25e0: 72 6f 75 6e 64 2d 6f 70 61 63 69 74 79 2d 73 65 round-opacity-se
25f0: 74 21 29 0a 09 09 09 63 61 6e 76 61 73 2d 62 61 t!)....canvas-ba
2600: 63 6b 67 72 6f 75 6e 64 2d 6f 70 61 63 69 74 79 ckground-opacity
2610: 2d 73 65 74 21 29 29 29 0a 0a 28 64 65 66 69 6e -set!)))..(defin
2620: 65 2d 76 61 6c 75 65 73 20 28 63 61 6e 76 61 73 e-values (canvas
2630: 2d 66 69 6c 6c 2d 6d 6f 64 65 20 63 61 6e 76 61 -fill-mode canva
2640: 73 2d 66 69 6c 6c 2d 6d 6f 64 65 2d 73 65 74 21 s-fill-mode-set!
2650: 29 0a 09 28 6c 65 74 72 65 63 20 28 5b 66 69 6c )..(letrec ([fil
2660: 6c 2d 6d 6f 64 65 73 0a 09 20 20 20 20 20 20 20 l-modes..
2670: 20 20 20 28 6c 69 73 74 0a 09 20 20 20 20 20 20 (list..
2680: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
2690: 20 20 20 20 20 20 09 09 27 65 76 65 6e 2d 6f 64 ..'even-od
26a0: 64 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 d.. ..(
26b0: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
26c0: 44 5f 45 56 45 4e 4f 44 44 22 20 69 6e 74 29 29 D_EVENODD" int))
26d0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
26e0: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
26f0: 27 77 69 6e 64 69 6e 67 0a 09 20 20 20 20 20 20 'winding..
2700: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
2710: 61 6c 75 65 20 22 43 44 5f 57 49 4e 44 49 4e 47 alue "CD_WINDING
2720: 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 " int)))]..
2730: 20 20 20 20 5b 63 61 6e 76 61 73 2d 66 69 6c 6c [canvas-fill
2740: 2d 6d 6f 64 65 2d 73 65 74 2f 72 61 77 21 0a 09 -mode-set/raw!..
2750: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 (forei
2760: 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 gn-lambda void "
2770: 63 64 43 61 6e 76 61 73 46 69 6c 6c 4d 6f 64 65 cdCanvasFillMode
2780: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
2790: 20 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 int)]..
27a0: 20 5b 63 61 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f [canvas-fill-mo
27b0: 64 65 2d 73 65 74 21 0a 09 20 20 20 20 20 20 20 de-set!..
27c0: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 (lambda (canv
27d0: 61 73 20 66 69 6c 6c 2d 6d 6f 64 65 29 0a 09 09 as fill-mode)...
27e0: 09 09 09 09 09 28 63 61 6e 76 61 73 2d 66 69 6c .....(canvas-fil
27f0: 6c 2d 6d 6f 64 65 2d 73 65 74 2f 72 61 77 21 0a l-mode-set/raw!.
2800: 09 09 09 09 09 09 09 09 63 61 6e 76 61 73 0a 09 ........canvas..
2810: 09 09 09 09 09 09 09 28 63 6f 6e 64 0a 09 09 09 .......(cond....
2820: 09 09 09 09 09 09 5b 28 61 73 73 71 20 66 69 6c ......[(assq fil
2830: 6c 2d 6d 6f 64 65 20 66 69 6c 6c 2d 6d 6f 64 65 l-mode fill-mode
2840: 73 29 20 3d 3e 20 63 64 72 5d 0a 09 09 09 09 09 s) => cdr]......
2850: 09 09 09 09 5b 65 6c 73 65 20 28 65 72 72 6f 72 ....[else (error
2860: 20 27 63 61 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f 'canvas-fill-mo
2870: 64 65 2d 73 65 74 21 20 22 75 6e 6b 6e 6f 77 6e de-set! "unknown
2880: 20 66 69 6c 6c 20 6d 6f 64 65 22 20 66 69 6c 6c fill mode" fill
2890: 2d 6d 6f 64 65 29 5d 29 29 29 5d 0a 09 20 20 20 -mode)])))]..
28a0: 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 66 69 [canvas-fi
28b0: 6c 6c 2d 6d 6f 64 65 2f 72 61 77 0a 09 20 20 20 ll-mode/raw..
28c0: 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d (foreign-
28d0: 6c 61 6d 62 64 61 2a 20 69 6e 74 20 28 5b 6e 6f lambda* int ([no
28e0: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e nnull-canvas can
28f0: 76 61 73 5d 29 0a 09 20 20 20 20 20 20 20 20 20 vas])..
2900: 20 09 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 ."C_return(cdCa
2910: 6e 76 61 73 46 69 6c 6c 4d 6f 64 65 28 63 61 6e nvasFillMode(can
2920: 76 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b vas, CD_QUERY));
2930: 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 ")].. [c
2940: 61 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f 64 65 0a anvas-fill-mode.
2950: 09 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 . (lamb
2960: 64 61 20 28 63 61 6e 76 61 73 29 0a 09 20 20 20 da (canvas)..
2970: 20 20 20 20 20 20 20 09 28 6c 65 74 20 28 5b 66 .(let ([f
2980: 69 6c 6c 2d 6d 6f 64 65 20 28 63 61 6e 76 61 73 ill-mode (canvas
2990: 2d 66 69 6c 6c 2d 6d 6f 64 65 2f 72 61 77 20 63 -fill-mode/raw c
29a0: 61 6e 76 61 73 29 5d 29 0a 09 09 09 09 09 09 09 anvas)])........
29b0: 09 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 .(cond..........
29c0: 5b 28 72 61 73 73 6f 63 20 66 69 6c 6c 2d 6d 6f [(rassoc fill-mo
29d0: 64 65 20 66 69 6c 6c 2d 6d 6f 64 65 73 29 20 3d de fill-modes) =
29e0: 3e 20 63 61 72 5d 0a 09 09 09 09 09 09 09 09 09 > car]..........
29f0: 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 [else (error 'ca
2a00: 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f 64 65 20 22 nvas-fill-mode "
2a10: 75 6e 6b 6e 6f 77 6e 20 66 69 6c 6c 20 6d 6f 64 unknown fill mod
2a20: 65 22 20 66 69 6c 6c 2d 6d 6f 64 65 29 5d 29 29 e" fill-mode)]))
2a30: 29 5d 29 0a 09 09 28 76 61 6c 75 65 73 0a 09 09 )])...(values...
2a40: 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 .(getter-with-se
2a50: 74 74 65 72 20 63 61 6e 76 61 73 2d 66 69 6c 6c tter canvas-fill
2a60: 2d 6d 6f 64 65 20 63 61 6e 76 61 73 2d 66 69 6c -mode canvas-fil
2a70: 6c 2d 6d 6f 64 65 2d 73 65 74 21 29 0a 09 09 09 l-mode-set!)....
2a80: 63 61 6e 76 61 73 2d 66 69 6c 6c 2d 6d 6f 64 65 canvas-fill-mode
2a90: 2d 73 65 74 21 29 29 29 0a 0a 28 64 65 66 69 6e -set!)))..(defin
2aa0: 65 2d 76 61 6c 75 65 73 20 28 63 61 6e 76 61 73 e-values (canvas
2ab0: 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 20 -interior-style
2ac0: 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d canvas-interior-
2ad0: 73 74 79 6c 65 2d 73 65 74 21 29 0a 09 28 6c 65 style-set!)..(le
2ae0: 74 72 65 63 20 28 5b 69 6e 74 65 72 69 6f 72 2d trec ([interior-
2af0: 73 74 79 6c 65 73 0a 09 20 20 20 20 20 20 20 20 styles..
2b00: 20 20 28 6c 69 73 74 0a 09 20 20 20 20 20 20 20 (list..
2b10: 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 .(cons..
2b20: 20 20 20 20 20 09 09 27 73 6f 6c 69 64 0a 09 20 ..'solid..
2b30: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
2b40: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 53 4f ign-value "CD_SO
2b50: 4c 49 44 22 20 69 6e 74 29 29 0a 09 20 20 20 20 LID" int))..
2b60: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
2b70: 20 20 20 20 20 20 20 20 09 09 27 68 6f 6c 6c 6f ..'hollo
2b80: 77 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 w.. ..(
2b90: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
2ba0: 44 5f 48 4f 4c 4c 4f 57 22 20 69 6e 74 29 29 0a D_HOLLOW" int)).
2bb0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
2bc0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
2bd0: 68 61 74 63 68 0a 09 20 20 20 20 20 20 20 20 20 hatch..
2be0: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
2bf0: 65 20 22 43 44 5f 48 41 54 43 48 22 20 69 6e 74 e "CD_HATCH" int
2c00: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
2c10: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
2c20: 09 09 27 73 74 69 70 70 6c 65 0a 09 20 20 20 20 ..'stipple..
2c30: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
2c40: 2d 76 61 6c 75 65 20 22 43 44 5f 53 54 49 50 50 -value "CD_STIPP
2c50: 4c 45 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 LE" int))..
2c60: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
2c70: 20 20 20 20 20 20 20 09 09 27 70 61 74 74 65 72 ..'patter
2c80: 6e 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 n.. ..(
2c90: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
2ca0: 44 5f 50 41 54 54 45 52 4e 22 20 69 6e 74 29 29 D_PATTERN" int))
2cb0: 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 68 61 )].. [ha
2cc0: 74 63 68 2d 73 74 79 6c 65 73 0a 09 20 20 20 20 tch-styles..
2cd0: 20 20 20 20 20 20 28 6c 69 73 74 0a 09 20 20 20 (list..
2ce0: 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 .(cons..
2cf0: 20 20 20 20 20 20 20 20 20 09 09 27 68 6f 72 69 ..'hori
2d00: 7a 6f 6e 74 61 6c 0a 09 20 20 20 20 20 20 20 20 zontal..
2d10: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
2d20: 75 65 20 22 43 44 5f 48 4f 52 49 5a 4f 4e 54 41 ue "CD_HORIZONTA
2d30: 4c 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 L" int))..
2d40: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
2d50: 20 20 20 20 20 20 09 09 27 76 65 72 74 69 63 61 ..'vertica
2d60: 6c 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 l.. ..(
2d70: 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 foreign-value "C
2d80: 44 5f 56 45 52 54 49 43 41 4c 22 20 69 6e 74 29 D_VERTICAL" int)
2d90: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 ).. .(c
2da0: 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 ons.. .
2db0: 09 27 66 6f 72 77 61 72 64 2d 64 69 61 67 6f 6e .'forward-diagon
2dc0: 61 6c 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 al.. ..
2dd0: 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 (foreign-value "
2de0: 43 44 5f 46 44 49 41 47 4f 4e 41 4c 22 20 69 6e CD_FDIAGONAL" in
2df0: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
2e00: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
2e10: 20 09 09 27 62 61 63 6b 77 61 72 64 2d 64 69 61 ..'backward-dia
2e20: 67 6f 6e 61 6c 0a 09 20 20 20 20 20 20 20 20 20 gonal..
2e30: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
2e40: 65 20 22 43 44 5f 42 44 49 41 47 4f 4e 41 4c 22 e "CD_BDIAGONAL"
2e50: 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 int))..
2e60: 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 .(cons..
2e70: 20 20 20 20 09 09 27 63 72 6f 73 73 0a 09 20 20 ..'cross..
2e80: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
2e90: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 43 52 4f gn-value "CD_CRO
2ea0: 53 53 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 SS" int))..
2eb0: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
2ec0: 20 20 20 20 20 20 20 09 09 27 64 69 61 67 6f 6e ..'diagon
2ed0: 61 6c 2d 63 72 6f 73 73 0a 09 20 20 20 20 20 20 al-cross..
2ee0: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
2ef0: 61 6c 75 65 20 22 43 44 5f 44 49 41 47 43 52 4f alue "CD_DIAGCRO
2f00: 53 53 22 20 69 6e 74 29 29 29 5d 0a 09 20 20 20 SS" int)))]..
2f10: 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 68 61 [canvas-ha
2f20: 74 63 68 2d 73 74 79 6c 65 2d 73 65 74 2f 72 61 tch-style-set/ra
2f30: 77 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 w!.. (f
2f40: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 69 6e oreign-lambda in
2f50: 74 20 22 63 64 43 61 6e 76 61 73 48 61 74 63 68 t "cdCanvasHatch
2f60: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
2f70: 20 69 6e 74 29 5d 0a 09 20 20 20 20 20 20 20 20 int)]..
2f80: 20 5b 63 61 6e 76 61 73 2d 68 61 74 63 68 2d 73 [canvas-hatch-s
2f90: 74 79 6c 65 2f 72 61 77 0a 09 20 20 20 20 20 20 tyle/raw..
2fa0: 20 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d (foreign-lam
2fb0: 62 64 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e 75 bda* int ([nonnu
2fc0: 6c 6c 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 ll-canvas canvas
2fd0: 5d 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 ]).. ."
2fe0: 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 61 C_return(cdCanva
2ff0: 73 48 61 74 63 68 28 63 61 6e 76 61 73 2c 20 43 sHatch(canvas, C
3000: 44 5f 51 55 45 52 59 29 29 3b 22 29 5d 0a 09 20 D_QUERY));")]..
3010: 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d [canvas-
3020: 73 74 69 70 70 6c 65 2d 73 65 74 2f 72 61 77 21 stipple-set/raw!
3030: 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 .. (for
3040: 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 76 6f 69 eign-lambda* voi
3050: 64 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 d ([nonnull-canv
3060: 61 73 20 63 61 6e 76 61 73 5d 20 5b 69 6e 74 20 as canvas] [int
3070: 77 69 64 74 68 5d 20 5b 69 6e 74 20 68 65 69 67 width] [int heig
3080: 68 74 5d 20 5b 6e 6f 6e 6e 75 6c 6c 2d 62 6c 6f ht] [nonnull-blo
3090: 62 20 64 61 74 61 5d 29 0a 09 20 20 20 20 20 20 b data])..
30a0: 20 20 20 20 09 22 75 6e 73 69 67 6e 65 64 20 63 ."unsigned c
30b0: 68 61 72 20 6d 61 73 6b 5b 77 69 64 74 68 20 2a har mask[width *
30c0: 20 68 65 69 67 68 74 5d 3b 5c 6e 22 0a 09 20 20 height];\n"..
30d0: 20 20 20 20 20 20 20 20 09 22 69 6e 74 20 69 2c ."int i,
30e0: 20 6a 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 j;\n"..
30f0: 20 20 09 22 5c 6e 22 0a 09 20 20 20 20 20 20 20 ."\n"..
3100: 20 20 20 09 22 66 6f 72 20 28 6a 20 3d 20 30 3b ."for (j = 0;
3110: 20 6a 20 3c 20 68 65 69 67 68 74 3b 20 2b 2b 6a j < height; ++j
3120: 29 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 ) {\n"..
3130: 20 20 09 22 09 66 6f 72 20 28 69 20 3d 20 30 3b .".for (i = 0;
3140: 20 69 20 3c 20 77 69 64 74 68 3b 20 2b 2b 69 29 i < width; ++i)
3150: 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 {\n"..
3160: 20 09 22 09 09 63 6f 6e 73 74 20 69 6e 74 20 6f ."..const int o
3170: 66 73 20 3d 20 28 6a 20 2a 20 77 69 64 74 68 29 fs = (j * width)
3180: 20 2b 20 69 3b 5c 6e 22 0a 09 20 20 20 20 20 20 + i;\n"..
3190: 20 20 20 20 09 22 09 09 6d 61 73 6b 5b 6f 66 73 ."..mask[ofs
31a0: 5d 20 3d 20 28 64 61 74 61 5b 6f 66 73 20 2f 20 ] = (data[ofs /
31b0: 38 5d 20 3e 3e 20 28 6f 66 73 20 25 20 38 29 29 8] >> (ofs % 8))
31c0: 20 26 20 31 3b 5c 6e 22 0a 09 20 20 20 20 20 20 & 1;\n"..
31d0: 20 20 20 20 09 22 09 7d 5c 6e 22 0a 09 20 20 20 .".}\n"..
31e0: 20 20 20 20 20 20 20 09 22 7d 5c 6e 22 0a 09 20 ."}\n"..
31f0: 20 20 20 20 20 20 20 20 20 09 22 63 64 43 61 6e ."cdCan
3200: 76 61 73 53 74 69 70 70 6c 65 28 63 61 6e 76 61 vasStipple(canva
3210: 73 2c 20 77 69 64 74 68 2c 20 68 65 69 67 68 74 s, width, height
3220: 2c 20 6d 61 73 6b 29 3b 5c 6e 22 29 5d 0a 09 20 , mask);\n")]..
3230: 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d [canvas-
3240: 73 74 69 70 70 6c 65 2f 72 61 77 0a 09 20 20 20 stipple/raw..
3250: 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e 2d (foreign-
3260: 6c 61 6d 62 64 61 2a 20 76 6f 69 64 20 28 5b 6e lambda* void ([n
3270: 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 61 onnull-canvas ca
3280: 6e 76 61 73 5d 20 5b 28 63 2d 70 6f 69 6e 74 65 nvas] [(c-pointe
3290: 72 20 69 6e 74 29 20 70 77 69 64 74 68 5d 20 5b r int) pwidth] [
32a0: 28 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 (c-pointer int)
32b0: 70 68 65 69 67 68 74 5d 20 5b 62 6c 6f 62 20 64 pheight] [blob d
32c0: 61 74 61 5d 29 0a 09 20 20 20 20 20 20 20 20 20 ata])..
32d0: 20 09 22 75 6e 73 69 67 6e 65 64 20 63 68 61 72 ."unsigned char
32e0: 20 2a 6d 61 73 6b 20 3d 20 63 64 43 61 6e 76 61 *mask = cdCanva
32f0: 73 47 65 74 53 74 69 70 70 6c 65 28 63 61 6e 76 sGetStipple(canv
3300: 61 73 2c 20 70 77 69 64 74 68 2c 20 70 68 65 69 as, pwidth, phei
3310: 67 68 74 29 3b 5c 6e 22 0a 09 20 20 20 20 20 20 ght);\n"..
3320: 20 20 20 20 09 22 5c 6e 22 0a 09 20 20 20 20 20 ."\n"..
3330: 20 20 20 20 20 09 22 69 66 20 28 64 61 74 61 29 ."if (data)
3340: 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 {\n"..
3350: 20 09 22 09 69 6e 74 20 77 69 64 74 68 20 3d 20 .".int width =
3360: 2a 70 77 69 64 74 68 2c 20 68 65 69 67 68 74 20 *pwidth, height
3370: 3d 20 2a 70 68 65 69 67 68 74 3b 5c 6e 22 0a 09 = *pheight;\n"..
3380: 20 20 20 20 20 20 20 20 20 20 09 22 09 69 6e 74 .".int
3390: 20 69 2c 20 6a 3b 5c 6e 22 0a 09 20 20 20 20 20 i, j;\n"..
33a0: 20 20 20 20 20 09 22 09 5c 6e 22 0a 09 20 20 20 .".\n"..
33b0: 20 20 20 20 20 20 20 09 22 09 66 6f 72 20 28 6a .".for (j
33c0: 20 3d 20 30 3b 20 6a 20 3c 20 68 65 69 67 68 74 = 0; j < height
33d0: 3b 20 2b 2b 6a 29 20 7b 5c 6e 22 0a 09 20 20 20 ; ++j) {\n"..
33e0: 20 20 20 20 20 20 20 09 22 09 09 66 6f 72 20 28 ."..for (
33f0: 69 20 3d 20 30 3b 20 69 20 3c 20 77 69 64 74 68 i = 0; i < width
3400: 3b 20 2b 2b 69 29 20 7b 5c 6e 22 0a 09 20 20 20 ; ++i) {\n"..
3410: 20 20 20 20 20 20 20 09 22 09 09 09 63 6f 6e 73 ."...cons
3420: 74 20 69 6e 74 20 6f 66 73 20 3d 20 28 6a 20 2a t int ofs = (j *
3430: 20 77 69 64 74 68 29 20 2b 20 69 3b 5c 6e 22 0a width) + i;\n".
3440: 09 20 20 20 20 20 20 20 20 20 20 09 22 09 09 09 . ."...
3450: 63 6f 6e 73 74 20 69 6e 74 20 76 6f 66 73 20 3d const int vofs =
3460: 20 6f 66 73 20 2f 20 38 2c 20 62 6f 66 73 20 3d ofs / 8, bofs =
3470: 20 6f 66 73 20 25 20 38 3b 5c 6e 22 0a 09 20 20 ofs % 8;\n"..
3480: 20 20 20 20 20 20 20 20 09 22 09 09 09 63 6f 6e ."...con
3490: 73 74 20 75 6e 73 69 67 6e 65 64 20 63 68 61 72 st unsigned char
34a0: 20 62 69 74 20 3d 20 6d 61 73 6b 5b 6f 66 73 5d bit = mask[ofs]
34b0: 20 26 20 31 3b 5c 6e 22 0a 09 20 20 20 20 20 20 & 1;\n"..
34c0: 20 20 20 20 09 22 09 09 09 5c 6e 22 0a 09 20 20 ."...\n"..
34d0: 20 20 20 20 20 20 20 20 09 22 09 09 09 69 66 20 ."...if
34e0: 28 62 6f 66 73 20 3e 20 30 29 5c 6e 22 0a 09 20 (bofs > 0)\n"..
34f0: 20 20 20 20 20 20 20 20 20 09 22 09 09 09 09 64 ."....d
3500: 61 74 61 5b 76 6f 66 73 5d 20 7c 3d 20 62 69 74 ata[vofs] |= bit
3510: 20 3c 3c 20 62 6f 66 73 3b 5c 6e 22 0a 09 20 20 << bofs;\n"..
3520: 20 20 20 20 20 20 20 20 09 22 09 09 09 65 6c 73 ."...els
3530: 65 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 e\n"..
3540: 09 22 09 09 09 09 64 61 74 61 5b 76 6f 66 73 5d ."....data[vofs]
3550: 20 3d 20 62 69 74 3b 5c 6e 22 0a 09 20 20 20 20 = bit;\n"..
3560: 20 20 20 20 20 20 09 22 09 09 7d 5c 6e 22 0a 09 ."..}\n"..
3570: 20 20 20 20 20 20 20 20 20 20 09 22 09 7d 5c 6e .".}\n
3580: 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 7d ".. ."}
3590: 5c 6e 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 \n")]..
35a0: 5b 63 61 6e 76 61 73 2d 70 61 74 74 65 72 6e 2d [canvas-pattern-
35b0: 73 65 74 2f 72 67 62 2f 72 61 77 21 0a 09 20 20 set/rgb/raw!..
35c0: 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e (foreign
35d0: 2d 6c 61 6d 62 64 61 2a 20 76 6f 69 64 20 28 5b -lambda* void ([
35e0: 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 63 nonnull-canvas c
35f0: 61 6e 76 61 73 5d 20 5b 69 6e 74 20 77 69 64 74 anvas] [int widt
3600: 68 5d 20 5b 69 6e 74 20 68 65 69 67 68 74 5d 20 h] [int height]
3610: 5b 6e 6f 6e 6e 75 6c 6c 2d 62 6c 6f 62 20 64 61 [nonnull-blob da
3620: 74 61 5d 29 0a 09 20 20 20 20 20 20 20 20 20 20 ta])..
3630: 09 22 6c 6f 6e 67 20 63 6f 6c 6f 72 5b 77 69 64 ."long color[wid
3640: 74 68 20 2a 20 68 65 69 67 68 74 5d 3b 5c 6e 22 th * height];\n"
3650: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 69 6e .. ."in
3660: 74 20 69 2c 20 6a 3b 5c 6e 22 0a 09 20 20 20 20 t i, j;\n"..
3670: 20 20 20 20 20 20 09 22 5c 6e 22 0a 09 20 20 20 ."\n"..
3680: 20 20 20 20 20 20 20 09 22 66 6f 72 20 28 6a 20 ."for (j
3690: 3d 20 30 3b 20 6a 20 3c 20 68 65 69 67 68 74 3b = 0; j < height;
36a0: 20 2b 2b 6a 29 20 7b 5c 6e 22 0a 09 20 20 20 20 ++j) {\n"..
36b0: 20 20 20 20 20 20 09 22 09 66 6f 72 20 28 69 20 .".for (i
36c0: 3d 20 30 3b 20 69 20 3c 20 77 69 64 74 68 3b 20 = 0; i < width;
36d0: 2b 2b 69 2c 20 64 61 74 61 20 2b 3d 20 33 29 20 ++i, data += 3)
36e0: 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 {\n"..
36f0: 09 22 09 09 63 6f 6c 6f 72 5b 28 6a 20 2a 20 77 ."..color[(j * w
3700: 69 64 74 68 29 20 2b 20 69 5d 20 3d 5c 6e 22 0a idth) + i] =\n".
3710: 09 20 20 20 20 20 20 20 20 20 20 09 22 09 09 09 . ."...
3720: 28 64 61 74 61 5b 30 5d 20 3c 3c 20 31 36 29 20 (data[0] << 16)
3730: 7c 20 28 64 61 74 61 5b 31 5d 20 3c 3c 20 38 29 | (data[1] << 8)
3740: 20 7c 20 28 64 61 74 61 5b 32 5d 29 3b 5c 6e 22 | (data[2]);\n"
3750: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 09 7d .. .".}
3760: 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 \n".. .
3770: 22 7d 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 "}\n"..
3780: 20 09 22 63 64 43 61 6e 76 61 73 50 61 74 74 65 ."cdCanvasPatte
3790: 72 6e 28 63 61 6e 76 61 73 2c 20 77 69 64 74 68 rn(canvas, width
37a0: 2c 20 68 65 69 67 68 74 2c 20 63 6f 6c 6f 72 29 , height, color)
37b0: 3b 5c 6e 22 29 5d 0a 09 20 20 20 20 20 20 20 20 ;\n")]..
37c0: 20 5b 63 61 6e 76 61 73 2d 70 61 74 74 65 72 6e [canvas-pattern
37d0: 2d 73 65 74 2f 72 67 62 61 2f 72 61 77 21 0a 09 -set/rgba/raw!..
37e0: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 (forei
37f0: 67 6e 2d 6c 61 6d 62 64 61 2a 20 76 6f 69 64 20 gn-lambda* void
3800: 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 ([nonnull-canvas
3810: 20 63 61 6e 76 61 73 5d 20 5b 69 6e 74 20 77 69 canvas] [int wi
3820: 64 74 68 5d 20 5b 69 6e 74 20 68 65 69 67 68 74 dth] [int height
3830: 5d 20 5b 6e 6f 6e 6e 75 6c 6c 2d 62 6c 6f 62 20 ] [nonnull-blob
3840: 64 61 74 61 5d 29 0a 09 20 20 20 20 20 20 20 20 data])..
3850: 20 20 09 22 6c 6f 6e 67 20 63 6f 6c 6f 72 5b 77 ."long color[w
3860: 69 64 74 68 20 2a 20 68 65 69 67 68 74 5d 3b 5c idth * height];\
3870: 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 n".. ."
3880: 69 6e 74 20 69 2c 20 6a 3b 5c 6e 22 0a 09 20 20 int i, j;\n"..
3890: 20 20 20 20 20 20 20 20 09 22 5c 6e 22 0a 09 20 ."\n"..
38a0: 20 20 20 20 20 20 20 20 20 09 22 66 6f 72 20 28 ."for (
38b0: 6a 20 3d 20 30 3b 20 6a 20 3c 20 68 65 69 67 68 j = 0; j < heigh
38c0: 74 3b 20 2b 2b 6a 29 20 7b 5c 6e 22 0a 09 20 20 t; ++j) {\n"..
38d0: 20 20 20 20 20 20 20 20 09 22 09 66 6f 72 20 28 .".for (
38e0: 69 20 3d 20 30 3b 20 69 20 3c 20 77 69 64 74 68 i = 0; i < width
38f0: 3b 20 2b 2b 69 2c 20 64 61 74 61 20 2b 3d 20 34 ; ++i, data += 4
3900: 29 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 ) {\n"..
3910: 20 20 09 22 09 09 63 6f 6c 6f 72 5b 28 6a 20 2a ."..color[(j *
3920: 20 77 69 64 74 68 29 20 2b 20 69 5d 20 3d 5c 6e width) + i] =\n
3930: 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 09 ".. .".
3940: 09 09 28 28 30 78 66 66 20 2d 20 64 61 74 61 5b ..((0xff - data[
3950: 33 5d 29 20 3c 3c 20 32 34 29 20 7c 20 28 64 61 3]) << 24) | (da
3960: 74 61 5b 30 5d 20 3c 3c 20 31 36 29 20 7c 20 28 ta[0] << 16) | (
3970: 64 61 74 61 5b 31 5d 20 3c 3c 20 38 29 20 7c 20 data[1] << 8) |
3980: 28 64 61 74 61 5b 32 5d 29 3b 5c 6e 22 0a 09 20 (data[2]);\n"..
3990: 20 20 20 20 20 20 20 20 20 09 22 09 7d 5c 6e 22 .".}\n"
39a0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 7d 5c .. ."}\
39b0: 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 n".. ."
39c0: 63 64 43 61 6e 76 61 73 50 61 74 74 65 72 6e 28 cdCanvasPattern(
39d0: 63 61 6e 76 61 73 2c 20 77 69 64 74 68 2c 20 68 canvas, width, h
39e0: 65 69 67 68 74 2c 20 63 6f 6c 6f 72 29 3b 5c 6e eight, color);\n
39f0: 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 ")].. [c
3a00: 61 6e 76 61 73 2d 70 61 74 74 65 72 6e 2f 72 67 anvas-pattern/rg
3a10: 62 61 2f 72 61 77 0a 09 20 20 20 20 20 20 20 20 ba/raw..
3a20: 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 (foreign-lambd
3a30: 61 2a 20 76 6f 69 64 20 28 5b 6e 6f 6e 6e 75 6c a* void ([nonnul
3a40: 6c 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d l-canvas canvas]
3a50: 20 5b 28 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 [(c-pointer int
3a60: 29 20 70 77 69 64 74 68 5d 20 5b 28 63 2d 70 6f ) pwidth] [(c-po
3a70: 69 6e 74 65 72 20 69 6e 74 29 20 70 68 65 69 67 inter int) pheig
3a80: 68 74 5d 20 5b 62 6c 6f 62 20 64 61 74 61 5d 29 ht] [blob data])
3a90: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 6c 6f .. ."lo
3aa0: 6e 67 20 2a 63 6f 6c 6f 72 20 3d 20 63 64 43 61 ng *color = cdCa
3ab0: 6e 76 61 73 47 65 74 50 61 74 74 65 72 6e 28 63 nvasGetPattern(c
3ac0: 61 6e 76 61 73 2c 20 70 77 69 64 74 68 2c 20 70 anvas, pwidth, p
3ad0: 68 65 69 67 68 74 29 3b 5c 6e 22 0a 09 20 20 20 height);\n"..
3ae0: 20 20 20 20 20 20 20 09 22 5c 6e 22 0a 09 20 20 ."\n"..
3af0: 20 20 20 20 20 20 20 20 09 22 69 66 20 28 64 61 ."if (da
3b00: 74 61 29 20 7b 5c 6e 22 0a 09 20 20 20 20 20 20 ta) {\n"..
3b10: 20 20 20 20 09 22 09 69 6e 74 20 77 69 64 74 68 .".int width
3b20: 20 3d 20 2a 70 77 69 64 74 68 2c 20 68 65 69 67 = *pwidth, heig
3b30: 68 74 20 3d 20 2a 70 68 65 69 67 68 74 3b 5c 6e ht = *pheight;\n
3b40: 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 09 ".. .".
3b50: 69 6e 74 20 69 2c 20 6a 3b 5c 6e 22 0a 09 20 20 int i, j;\n"..
3b60: 20 20 20 20 20 20 20 20 09 22 09 5c 6e 22 0a 09 .".\n"..
3b70: 20 20 20 20 20 20 20 20 20 20 09 22 09 66 6f 72 .".for
3b80: 20 28 6a 20 3d 20 30 3b 20 6a 20 3c 20 68 65 69 (j = 0; j < hei
3b90: 67 68 74 3b 20 2b 2b 6a 29 20 7b 5c 6e 22 0a 09 ght; ++j) {\n"..
3ba0: 20 20 20 20 20 20 20 20 20 20 09 22 09 09 66 6f ."..fo
3bb0: 72 20 28 69 20 3d 20 30 3b 20 69 20 3c 20 77 69 r (i = 0; i < wi
3bc0: 64 74 68 3b 20 2b 2b 69 2c 20 64 61 74 61 20 2b dth; ++i, data +
3bd0: 3d 20 34 29 20 7b 5c 6e 22 0a 09 20 20 20 20 20 = 4) {\n"..
3be0: 20 20 20 20 20 09 22 09 09 09 6c 6f 6e 67 20 63 ."...long c
3bf0: 20 3d 20 63 6f 6c 6f 72 5b 28 6a 20 2a 20 77 69 = color[(j * wi
3c00: 64 74 68 29 20 2b 20 69 5d 3b 5c 6e 22 0a 09 20 dth) + i];\n"..
3c10: 20 20 20 20 20 20 20 20 20 09 22 09 09 09 64 61 ."...da
3c20: 74 61 5b 33 5d 20 3d 20 30 78 66 66 20 2d 20 28 ta[3] = 0xff - (
3c30: 28 63 20 3e 3e 20 32 34 29 20 26 20 30 78 66 66 (c >> 24) & 0xff
3c40: 29 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 );\n"..
3c50: 20 09 22 09 09 09 64 61 74 61 5b 30 5d 20 3d 20 ."...data[0] =
3c60: 28 63 20 3e 3e 20 31 36 29 20 26 20 30 78 66 66 (c >> 16) & 0xff
3c70: 3b 5c 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 ;\n"..
3c80: 09 22 09 09 09 64 61 74 61 5b 31 5d 20 3d 20 28 ."...data[1] = (
3c90: 63 20 3e 3e 20 38 29 20 26 20 30 78 66 66 3b 5c c >> 8) & 0xff;\
3ca0: 6e 22 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 n".. ."
3cb0: 09 09 09 64 61 74 61 5b 32 5d 20 3d 20 63 20 26 ...data[2] = c &
3cc0: 20 30 78 66 66 3b 5c 6e 22 0a 09 20 20 20 20 20 0xff;\n"..
3cd0: 20 20 20 20 20 09 22 09 09 7d 5c 6e 22 0a 09 20 ."..}\n"..
3ce0: 20 20 20 20 20 20 20 20 20 09 22 09 7d 5c 6e 22 .".}\n"
3cf0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 7d 5c .. ."}\
3d00: 6e 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b n")].. [
3d10: 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d canvas-interior-
3d20: 73 74 79 6c 65 2d 73 65 74 2f 72 61 77 21 0a 09 style-set/raw!..
3d30: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 (forei
3d40: 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 gn-lambda void "
3d50: 63 64 43 61 6e 76 61 73 49 6e 74 65 72 69 6f 72 cdCanvasInterior
3d60: 53 74 79 6c 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 Style" nonnull-c
3d70: 61 6e 76 61 73 20 69 6e 74 29 5d 0a 09 20 20 20 anvas int)]..
3d80: 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 69 6e [canvas-in
3d90: 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 74 terior-style-set
3da0: 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c 61 !.. (la
3db0: 6d 62 64 61 20 28 63 61 6e 76 61 73 20 69 6e 74 mbda (canvas int
3dc0: 65 72 69 6f 72 2d 73 74 79 6c 65 29 0a 09 09 09 erior-style)....
3dd0: 09 09 09 09 28 63 61 73 65 20 28 61 6e 64 20 28 ....(case (and (
3de0: 70 61 69 72 3f 20 69 6e 74 65 72 69 6f 72 2d 73 pair? interior-s
3df0: 74 79 6c 65 29 20 28 63 61 72 20 69 6e 74 65 72 tyle) (car inter
3e00: 69 6f 72 2d 73 74 79 6c 65 29 29 0a 09 09 09 09 ior-style)).....
3e10: 09 09 09 09 5b 28 68 61 74 63 68 29 0a 09 09 09 ....[(hatch)....
3e20: 09 09 09 09 09 20 28 6c 65 74 20 28 5b 68 61 74 ..... (let ([hat
3e30: 63 68 2d 73 74 79 6c 65 20 28 63 61 64 72 20 69 ch-style (cadr i
3e40: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 29 5d 29 nterior-style)])
3e50: 0a 09 09 09 09 09 09 09 09 09 20 28 63 61 6e 76 .......... (canv
3e60: 61 73 2d 68 61 74 63 68 2d 73 74 79 6c 65 2d 73 as-hatch-style-s
3e70: 65 74 2f 72 61 77 21 0a 09 09 09 09 09 09 09 09 et/raw!.........
3e80: 09 09 20 63 61 6e 76 61 73 0a 09 09 09 09 09 09 .. canvas.......
3e90: 09 09 09 09 20 28 63 6f 6e 64 0a 09 09 09 09 09 .... (cond......
3ea0: 09 09 09 09 09 20 09 20 5b 28 61 73 73 71 20 68 ..... . [(assq h
3eb0: 61 74 63 68 2d 73 74 79 6c 65 20 68 61 74 63 68 atch-style hatch
3ec0: 2d 73 74 79 6c 65 73 29 20 3d 3e 20 63 64 72 5d -styles) => cdr]
3ed0: 0a 09 09 09 09 09 09 09 09 09 09 20 09 20 5b 65 ........... . [e
3ee0: 6c 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e 76 lse (error 'canv
3ef0: 61 73 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c as-interior-styl
3f00: 65 2d 73 65 74 21 20 22 75 6e 6b 6e 6f 77 6e 20 e-set! "unknown
3f10: 68 61 74 63 68 20 73 74 79 6c 65 22 20 68 61 74 hatch style" hat
3f20: 63 68 2d 73 74 79 6c 65 29 5d 29 29 0a 09 09 09 ch-style)]))....
3f30: 09 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 69 ...... (canvas-i
3f40: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 nterior-style-se
3f50: 74 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 63 t/raw! canvas (c
3f60: 64 72 20 28 61 73 73 71 20 27 68 61 74 63 68 20 dr (assq 'hatch
3f70: 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 73 29 interior-styles)
3f80: 29 29 29 5d 0a 09 09 09 09 09 09 09 09 5b 28 73 )))].........[(s
3f90: 74 69 70 70 6c 65 29 0a 09 09 09 09 09 09 09 09 tipple).........
3fa0: 20 28 6c 65 74 20 28 5b 77 69 64 74 68 20 28 63 (let ([width (c
3fb0: 61 64 72 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 adr interior-sty
3fc0: 6c 65 29 5d 0a 09 09 09 09 09 09 09 09 09 09 09 le)]............
3fd0: 20 5b 68 65 69 67 68 74 20 28 63 61 64 64 72 20 [height (caddr
3fe0: 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 29 5d interior-style)]
3ff0: 0a 09 09 09 09 09 09 09 09 09 09 09 20 5b 64 61 ............ [da
4000: 74 61 20 28 63 61 64 64 64 72 20 69 6e 74 65 72 ta (cadddr inter
4010: 69 6f 72 2d 73 74 79 6c 65 29 5d 29 0a 09 09 09 ior-style)])....
4020: 09 09 09 09 09 09 20 28 75 6e 6c 65 73 73 20 28 ...... (unless (
4030: 3d 20 28 62 6c 6f 62 2d 73 69 7a 65 20 64 61 74 = (blob-size dat
4040: 61 29 20 28 63 65 69 6c 69 6e 67 20 28 2f 20 28 a) (ceiling (/ (
4050: 2a 20 77 69 64 74 68 20 68 65 69 67 68 74 29 20 * width height)
4060: 38 29 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 8)))...........
4070: 28 65 72 72 6f 72 20 27 63 61 6e 76 61 73 2d 69 (error 'canvas-i
4080: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 nterior-style-se
4090: 74 21 20 22 62 61 64 20 73 74 69 70 70 6c 65 20 t! "bad stipple
40a0: 64 61 74 61 20 6c 65 6e 67 74 68 22 20 28 62 6c data length" (bl
40b0: 6f 62 2d 73 69 7a 65 20 64 61 74 61 29 20 28 63 ob-size data) (c
40c0: 65 69 6c 69 6e 67 20 28 2f 20 28 2a 20 77 69 64 eiling (/ (* wid
40d0: 74 68 20 68 65 69 67 68 74 29 20 38 29 29 29 29 th height) 8))))
40e0: 0a 09 09 09 09 09 09 09 09 09 20 28 63 61 6e 76 .......... (canv
40f0: 61 73 2d 73 74 69 70 70 6c 65 2d 73 65 74 2f 72 as-stipple-set/r
4100: 61 77 21 20 63 61 6e 76 61 73 20 77 69 64 74 68 aw! canvas width
4110: 20 68 65 69 67 68 74 20 64 61 74 61 29 0a 09 09 height data)...
4120: 09 09 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d ....... (canvas-
4130: 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 interior-style-s
4140: 65 74 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 et/raw! canvas (
4150: 63 64 72 20 28 61 73 73 71 20 27 73 74 69 70 70 cdr (assq 'stipp
4160: 6c 65 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c le interior-styl
4170: 65 73 29 29 29 29 5d 0a 09 09 09 09 09 09 09 09 es))))].........
4180: 5b 28 70 61 74 74 65 72 6e 2f 72 67 62 29 0a 09 [(pattern/rgb)..
4190: 09 09 09 09 09 09 09 20 28 6c 65 74 20 28 5b 77 ....... (let ([w
41a0: 69 64 74 68 20 28 63 61 64 72 20 69 6e 74 65 72 idth (cadr inter
41b0: 69 6f 72 2d 73 74 79 6c 65 29 5d 0a 09 09 09 09 ior-style)].....
41c0: 09 09 09 09 09 09 09 20 5b 68 65 69 67 68 74 20 ....... [height
41d0: 28 63 61 64 64 72 20 69 6e 74 65 72 69 6f 72 2d (caddr interior-
41e0: 73 74 79 6c 65 29 5d 0a 09 09 09 09 09 09 09 09 style)].........
41f0: 09 09 09 20 5b 64 61 74 61 20 28 63 61 64 64 64 ... [data (caddd
4200: 72 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 r interior-style
4210: 29 5d 29 0a 09 09 09 09 09 09 09 09 09 20 28 75 )]).......... (u
4220: 6e 6c 65 73 73 20 28 3d 20 28 62 6c 6f 62 2d 73 nless (= (blob-s
4230: 69 7a 65 20 64 61 74 61 29 20 28 2a 20 33 20 77 ize data) (* 3 w
4240: 69 64 74 68 20 68 65 69 67 68 74 29 29 0a 09 09 idth height))...
4250: 09 09 09 09 09 09 09 09 20 28 65 72 72 6f 72 20 ........ (error
4260: 27 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 'canvas-interior
4270: 2d 73 74 79 6c 65 2d 73 65 74 21 20 22 62 61 64 -style-set! "bad
4280: 20 70 61 74 74 65 72 6e 20 64 61 74 61 20 6c 65 pattern data le
4290: 6e 67 74 68 22 20 28 62 6c 6f 62 2d 73 69 7a 65 ngth" (blob-size
42a0: 20 64 61 74 61 29 20 28 2a 20 33 20 77 69 64 74 data) (* 3 widt
42b0: 68 20 68 65 69 67 68 74 29 29 29 0a 09 09 09 09 h height))).....
42c0: 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 70 61 ..... (canvas-pa
42d0: 74 74 65 72 6e 2d 73 65 74 2f 72 67 62 2f 72 61 ttern-set/rgb/ra
42e0: 77 21 20 63 61 6e 76 61 73 20 77 69 64 74 68 20 w! canvas width
42f0: 68 65 69 67 68 74 20 64 61 74 61 29 0a 09 09 09 height data)....
4300: 09 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 69 ...... (canvas-i
4310: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 nterior-style-se
4320: 74 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 63 t/raw! canvas (c
4330: 64 72 20 28 61 73 73 71 20 27 70 61 74 74 65 72 dr (assq 'patter
4340: 6e 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 n interior-style
4350: 73 29 29 29 29 5d 0a 09 09 09 09 09 09 09 09 5b s))))].........[
4360: 28 70 61 74 74 65 72 6e 2f 72 67 62 61 29 0a 09 (pattern/rgba)..
4370: 09 09 09 09 09 09 09 20 28 6c 65 74 20 28 5b 77 ....... (let ([w
4380: 69 64 74 68 20 28 63 61 64 72 20 69 6e 74 65 72 idth (cadr inter
4390: 69 6f 72 2d 73 74 79 6c 65 29 5d 0a 09 09 09 09 ior-style)].....
43a0: 09 09 09 09 09 09 09 20 5b 68 65 69 67 68 74 20 ....... [height
43b0: 28 63 61 64 64 72 20 69 6e 74 65 72 69 6f 72 2d (caddr interior-
43c0: 73 74 79 6c 65 29 5d 0a 09 09 09 09 09 09 09 09 style)].........
43d0: 09 09 09 20 5b 64 61 74 61 20 28 63 61 64 64 64 ... [data (caddd
43e0: 72 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 r interior-style
43f0: 29 5d 29 0a 09 09 09 09 09 09 09 09 09 20 28 75 )]).......... (u
4400: 6e 6c 65 73 73 20 28 3d 20 28 62 6c 6f 62 2d 73 nless (= (blob-s
4410: 69 7a 65 20 64 61 74 61 29 20 28 2a 20 34 20 77 ize data) (* 4 w
4420: 69 64 74 68 20 68 65 69 67 68 74 29 29 0a 09 09 idth height))...
4430: 09 09 09 09 09 09 09 09 20 28 65 72 72 6f 72 20 ........ (error
4440: 27 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 'canvas-interior
4450: 2d 73 74 79 6c 65 2d 73 65 74 21 20 22 62 61 64 -style-set! "bad
4460: 20 70 61 74 74 65 72 6e 20 64 61 74 61 20 6c 65 pattern data le
4470: 6e 67 74 68 22 20 28 62 6c 6f 62 2d 73 69 7a 65 ngth" (blob-size
4480: 20 64 61 74 61 29 20 28 2a 20 34 20 77 69 64 74 data) (* 4 widt
4490: 68 20 68 65 69 67 68 74 29 29 29 0a 09 09 09 09 h height))).....
44a0: 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 70 61 ..... (canvas-pa
44b0: 74 74 65 72 6e 2d 73 65 74 2f 72 67 62 61 2f 72 ttern-set/rgba/r
44c0: 61 77 21 20 63 61 6e 76 61 73 20 77 69 64 74 68 aw! canvas width
44d0: 20 68 65 69 67 68 74 20 64 61 74 61 29 0a 09 09 height data)...
44e0: 09 09 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d ....... (canvas-
44f0: 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 interior-style-s
4500: 65 74 2f 72 61 77 21 20 63 61 6e 76 61 73 20 28 et/raw! canvas (
4510: 63 64 72 20 28 61 73 73 71 20 27 70 61 74 74 65 cdr (assq 'patte
4520: 72 6e 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c rn interior-styl
4530: 65 73 29 29 29 29 5d 0a 09 09 09 09 09 09 09 09 es))))].........
4540: 5b 65 6c 73 65 0a 09 09 09 09 09 09 09 09 20 28 [else......... (
4550: 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d canvas-interior-
4560: 73 74 79 6c 65 2d 73 65 74 2f 72 61 77 21 0a 09 style-set/raw!..
4570: 09 09 09 09 09 09 09 09 20 63 61 6e 76 61 73 0a ........ canvas.
4580: 09 09 09 09 09 09 09 09 09 20 28 63 6f 6e 64 0a ......... (cond.
4590: 09 09 09 09 09 09 09 09 09 20 09 20 5b 28 61 73 ......... . [(as
45a0: 73 71 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c sq interior-styl
45b0: 65 20 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 e interior-style
45c0: 73 29 20 3d 3e 20 63 64 72 5d 0a 09 09 09 09 09 s) => cdr]......
45d0: 09 09 09 09 20 09 20 5b 65 6c 73 65 20 28 65 72 .... . [else (er
45e0: 72 6f 72 20 27 63 61 6e 76 61 73 2d 69 6e 74 65 ror 'canvas-inte
45f0: 72 69 6f 72 2d 73 74 79 6c 65 2d 73 65 74 21 20 rior-style-set!
4600: 22 75 6e 6b 6e 6f 77 6e 20 69 6e 74 65 72 69 6f "unknown interio
4610: 72 20 73 74 79 6c 65 22 20 69 6e 74 65 72 69 6f r style" interio
4620: 72 2d 73 74 79 6c 65 29 5d 29 29 5d 29 29 5d 0a r-style)]))]))].
4630: 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 . [canva
4640: 73 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 s-interior-style
4650: 2f 72 61 77 0a 09 20 20 20 20 20 20 20 20 20 20 /raw..
4660: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a (foreign-lambda*
4670: 20 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 int ([nonnull-c
4680: 61 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 anvas canvas])..
4690: 20 20 20 20 20 20 20 20 20 20 09 22 43 5f 72 65 ."C_re
46a0: 74 75 72 6e 28 63 64 43 61 6e 76 61 73 49 6e 74 turn(cdCanvasInt
46b0: 65 72 69 6f 72 53 74 79 6c 65 28 63 61 6e 76 61 eriorStyle(canva
46c0: 73 2c 20 43 44 5f 51 55 45 52 59 29 29 3b 22 29 s, CD_QUERY));")
46d0: 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 6e ].. [can
46e0: 76 61 73 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 vas-interior-sty
46f0: 6c 65 0a 09 20 20 20 20 20 20 20 20 20 20 28 6c le.. (l
4700: 61 6d 62 64 61 20 28 63 61 6e 76 61 73 29 0a 09 ambda (canvas)..
4710: 20 20 20 20 20 20 20 20 20 20 09 28 6c 65 74 2a .(let*
4720: 20 28 5b 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c ([interior-styl
4730: 65 20 28 63 61 6e 76 61 73 2d 69 6e 74 65 72 69 e (canvas-interi
4740: 6f 72 2d 73 74 79 6c 65 2f 72 61 77 20 63 61 6e or-style/raw can
4750: 76 61 73 29 5d 0a 09 20 20 20 20 20 20 20 20 20 vas)]..
4760: 20 09 20 20 20 20 20 20 20 5b 69 6e 74 65 72 69 . [interi
4770: 6f 72 2d 73 74 79 6c 65 0a 09 20 20 20 20 20 20 or-style..
4780: 20 20 20 20 09 20 20 20 20 20 20 20 28 63 6f 6e . (con
4790: 64 0a 09 20 20 20 20 20 20 20 20 20 20 09 20 20 d.. .
47a0: 20 20 20 20 20 09 20 5b 28 72 61 73 73 6f 63 20 . [(rassoc
47b0: 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 20 69 interior-style i
47c0: 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 73 29 20 nterior-styles)
47d0: 3d 3e 20 63 61 72 5d 0a 09 20 20 20 20 20 20 20 => car]..
47e0: 20 20 20 09 20 20 20 20 20 20 20 09 20 5b 65 6c . . [el
47f0: 73 65 20 28 65 72 72 6f 72 20 27 63 61 6e 76 61 se (error 'canva
4800: 73 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 s-interior-style
4810: 20 22 75 6e 6b 6e 6f 77 6e 20 69 6e 74 65 72 69 "unknown interi
4820: 6f 72 20 73 74 79 6c 65 22 20 69 6e 74 65 72 69 or style" interi
4830: 6f 72 2d 73 74 79 6c 65 29 5d 29 5d 29 0a 09 09 or-style)])])...
4840: 09 09 09 09 09 09 28 63 61 73 65 20 69 6e 74 65 ......(case inte
4850: 72 69 6f 72 2d 73 74 79 6c 65 0a 09 09 09 09 09 rior-style......
4860: 09 09 09 09 5b 28 68 61 74 63 68 29 0a 09 09 09 ....[(hatch)....
4870: 09 09 09 09 09 09 20 28 6c 65 74 20 28 5b 68 61 ...... (let ([ha
4880: 74 63 68 2d 73 74 79 6c 65 20 28 63 61 6e 76 61 tch-style (canva
4890: 73 2d 68 61 74 63 68 2d 73 74 79 6c 65 2f 72 61 s-hatch-style/ra
48a0: 77 20 63 61 6e 76 61 73 29 5d 29 0a 09 09 09 09 w canvas)]).....
48b0: 09 09 09 09 09 09 20 28 6c 69 73 74 0a 09 09 09 ...... (list....
48c0: 09 09 09 09 09 09 09 09 20 27 68 61 74 63 68 0a ........ 'hatch.
48d0: 09 09 09 09 09 09 09 09 09 09 09 20 28 63 6f 6e ........... (con
48e0: 64 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 5b d............. [
48f0: 28 72 61 73 73 6f 63 20 68 61 74 63 68 2d 73 74 (rassoc hatch-st
4900: 79 6c 65 20 68 61 74 63 68 2d 73 74 79 6c 65 73 yle hatch-styles
4910: 29 20 3d 3e 20 63 61 72 5d 0a 09 09 09 09 09 09 ) => car].......
4920: 09 09 09 09 09 09 20 5b 65 6c 73 65 20 28 65 72 ...... [else (er
4930: 72 6f 72 20 27 63 61 6e 76 61 73 2d 69 6e 74 65 ror 'canvas-inte
4940: 72 69 6f 72 2d 73 74 79 6c 65 20 22 75 6e 6b 6e rior-style "unkn
4950: 6f 77 6e 20 68 61 74 63 68 20 73 74 79 6c 65 22 own hatch style"
4960: 20 68 61 74 63 68 2d 73 74 79 6c 65 29 5d 29 29 hatch-style)]))
4970: 29 5d 0a 09 09 09 09 09 09 09 09 09 5b 28 73 74 )]..........[(st
4980: 69 70 70 6c 65 29 0a 09 09 09 09 09 09 09 09 09 ipple)..........
4990: 20 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 28 (let-location (
49a0: 5b 77 69 64 74 68 20 69 6e 74 20 30 5d 20 5b 68 [width int 0] [h
49b0: 65 69 67 68 74 20 69 6e 74 20 30 5d 29 0a 09 09 eight int 0])...
49c0: 09 09 09 09 09 09 09 20 09 20 28 63 61 6e 76 61 ....... . (canva
49d0: 73 2d 73 74 69 70 70 6c 65 2f 72 61 77 20 63 61 s-stipple/raw ca
49e0: 6e 76 61 73 20 28 6c 6f 63 61 74 69 6f 6e 20 77 nvas (location w
49f0: 69 64 74 68 29 20 28 6c 6f 63 61 74 69 6f 6e 20 idth) (location
4a00: 68 65 69 67 68 74 29 20 23 66 29 0a 09 09 09 09 height) #f).....
4a10: 09 09 09 09 09 09 20 28 6c 65 74 20 28 5b 64 61 ...... (let ([da
4a20: 74 61 20 28 6d 61 6b 65 2d 62 6c 6f 62 20 28 69 ta (make-blob (i
4a30: 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 28 63 nexact->exact (c
4a40: 65 69 6c 69 6e 67 20 28 2f 20 28 2a 20 77 69 64 eiling (/ (* wid
4a50: 74 68 20 68 65 69 67 68 74 29 20 38 29 29 29 29 th height) 8))))
4a60: 5d 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 28 ])............ (
4a70: 63 61 6e 76 61 73 2d 73 74 69 70 70 6c 65 2f 72 canvas-stipple/r
4a80: 61 77 20 63 61 6e 76 61 73 20 28 6c 6f 63 61 74 aw canvas (locat
4a90: 69 6f 6e 20 77 69 64 74 68 29 20 28 6c 6f 63 61 ion width) (loca
4aa0: 74 69 6f 6e 20 68 65 69 67 68 74 29 20 64 61 74 tion height) dat
4ab0: 61 29 0a 09 09 09 09 09 09 09 09 09 09 09 20 28 a)............ (
4ac0: 6c 69 73 74 20 27 73 74 69 70 70 6c 65 20 77 69 list 'stipple wi
4ad0: 64 74 68 20 68 65 69 67 68 74 20 64 61 74 61 29 dth height data)
4ae0: 29 29 5d 0a 09 09 09 09 09 09 09 09 09 5b 28 70 ))]..........[(p
4af0: 61 74 74 65 72 6e 29 0a 09 09 09 09 09 09 09 09 attern).........
4b00: 09 20 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 . (let-location
4b10: 28 5b 77 69 64 74 68 20 69 6e 74 20 30 5d 20 5b ([width int 0] [
4b20: 68 65 69 67 68 74 20 69 6e 74 20 30 5d 29 0a 09 height int 0])..
4b30: 09 09 09 09 09 09 09 09 20 09 20 28 63 61 6e 76 ........ . (canv
4b40: 61 73 2d 70 61 74 74 65 72 6e 2f 72 67 62 61 2f as-pattern/rgba/
4b50: 72 61 77 20 63 61 6e 76 61 73 20 28 6c 6f 63 61 raw canvas (loca
4b60: 74 69 6f 6e 20 77 69 64 74 68 29 20 28 6c 6f 63 tion width) (loc
4b70: 61 74 69 6f 6e 20 68 65 69 67 68 74 29 20 23 66 ation height) #f
4b80: 29 0a 09 09 09 09 09 09 09 09 09 09 20 28 6c 65 )........... (le
4b90: 74 20 28 5b 64 61 74 61 20 28 6d 61 6b 65 2d 62 t ([data (make-b
4ba0: 6c 6f 62 20 28 2a 20 34 20 77 69 64 74 68 20 68 lob (* 4 width h
4bb0: 65 69 67 68 74 29 29 5d 29 0a 09 09 09 09 09 09 eight))]).......
4bc0: 09 09 09 09 09 20 28 63 61 6e 76 61 73 2d 70 61 ..... (canvas-pa
4bd0: 74 74 65 72 6e 2f 72 67 62 61 2f 72 61 77 20 63 ttern/rgba/raw c
4be0: 61 6e 76 61 73 20 28 6c 6f 63 61 74 69 6f 6e 20 anvas (location
4bf0: 77 69 64 74 68 29 20 28 6c 6f 63 61 74 69 6f 6e width) (location
4c00: 20 68 65 69 67 68 74 29 20 64 61 74 61 29 0a 09 height) data)..
4c10: 09 09 09 09 09 09 09 09 09 09 20 28 6c 69 73 74 .......... (list
4c20: 20 27 70 61 74 74 65 72 6e 2f 72 67 62 61 20 77 'pattern/rgba w
4c30: 69 64 74 68 20 68 65 69 67 68 74 20 64 61 74 61 idth height data
4c40: 29 29 29 5d 0a 09 09 09 09 09 09 09 09 09 5b 65 )))]..........[e
4c50: 6c 73 65 0a 09 09 09 09 09 09 09 09 09 20 69 6e lse.......... in
4c60: 74 65 72 69 6f 72 2d 73 74 79 6c 65 5d 29 29 29 terior-style])))
4c70: 5d 29 0a 09 09 28 76 61 6c 75 65 73 0a 09 09 09 ])...(values....
4c80: 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 74 (getter-with-set
4c90: 74 65 72 20 63 61 6e 76 61 73 2d 69 6e 74 65 72 ter canvas-inter
4ca0: 69 6f 72 2d 73 74 79 6c 65 20 63 61 6e 76 61 73 ior-style canvas
4cb0: 2d 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d -interior-style-
4cc0: 73 65 74 21 29 0a 09 09 09 63 61 6e 76 61 73 2d set!)....canvas-
4cd0: 69 6e 74 65 72 69 6f 72 2d 73 74 79 6c 65 2d 73 interior-style-s
4ce0: 65 74 21 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a et!)))..;; }}}..
4cf0: 3b 3b 20 7b 7b 7b 20 54 65 78 74 20 66 75 6e 63 ;; {{{ Text func
4d00: 74 69 6f 6e 73 0a 0a 28 64 65 66 69 6e 65 20 63 tions..(define c
4d10: 61 6e 76 61 73 2d 74 65 78 74 21 0a 09 28 66 6f anvas-text!..(fo
4d20: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 reign-lambda voi
4d30: 64 20 22 63 64 66 43 61 6e 76 61 73 54 65 78 74 d "cdfCanvasText
4d40: 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 " nonnull-canvas
4d50: 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 20 6e double double n
4d60: 6f 6e 6e 75 6c 6c 2d 63 2d 73 74 72 69 6e 67 29 onnull-c-string)
4d70: 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 )..(define canva
4d80: 73 2d 66 6f 6e 74 2d 73 65 74 21 0a 09 28 66 6f s-font-set!..(fo
4d90: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 63 2d 73 reign-lambda c-s
4da0: 74 72 69 6e 67 20 22 63 64 43 61 6e 76 61 73 4e tring "cdCanvasN
4db0: 61 74 69 76 65 46 6f 6e 74 22 20 6e 6f 6e 6e 75 ativeFont" nonnu
4dc0: 6c 6c 2d 63 61 6e 76 61 73 20 6e 6f 6e 6e 75 6c ll-canvas nonnul
4dd0: 6c 2d 63 2d 73 74 72 69 6e 67 29 29 0a 0a 28 64 l-c-string))..(d
4de0: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 66 6f 6e efine canvas-fon
4df0: 74 0a 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d t..(getter-with-
4e00: 73 65 74 74 65 72 0a 09 09 28 66 6f 72 65 69 67 setter...(foreig
4e10: 6e 2d 6c 61 6d 62 64 61 2a 20 63 2d 73 74 72 69 n-lambda* c-stri
4e20: 6e 67 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e ng ([nonnull-can
4e30: 76 61 73 20 63 61 6e 76 61 73 5d 29 0a 09 09 09 vas canvas])....
4e40: 22 43 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 "C_return(cdCanv
4e50: 61 73 4e 61 74 69 76 65 46 6f 6e 74 28 63 61 6e asNativeFont(can
4e60: 76 61 73 2c 20 4e 55 4c 4c 29 29 3b 22 29 0a 09 vas, NULL));")..
4e70: 09 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 74 .canvas-font-set
4e80: 21 29 29 0a 0a 28 64 65 66 69 6e 65 2d 76 61 6c !))..(define-val
4e90: 75 65 73 20 28 63 61 6e 76 61 73 2d 74 65 78 74 ues (canvas-text
4ea0: 2d 61 6c 69 67 6e 6d 65 6e 74 20 63 61 6e 76 61 -alignment canva
4eb0: 73 2d 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 s-text-alignment
4ec0: 2d 73 65 74 21 29 0a 09 28 6c 65 74 72 65 63 20 -set!)..(letrec
4ed0: 28 5b 61 6c 69 67 6e 6d 65 6e 74 73 0a 09 20 20 ([alignments..
4ee0: 20 20 20 20 20 20 20 20 28 6c 69 73 74 0a 09 20 (list..
4ef0: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
4f00: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 6e 6f . ..'no
4f10: 72 74 68 0a 09 20 20 20 20 20 20 20 20 20 20 09 rth.. .
4f20: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
4f30: 22 43 44 5f 4e 4f 52 54 48 22 20 69 6e 74 29 29 "CD_NORTH" int))
4f40: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
4f50: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
4f60: 27 73 6f 75 74 68 0a 09 20 20 20 20 20 20 20 20 'south..
4f70: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
4f80: 75 65 20 22 43 44 5f 53 4f 55 54 48 22 20 69 6e ue "CD_SOUTH" in
4f90: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
4fa0: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
4fb0: 20 09 09 27 65 61 73 74 0a 09 20 20 20 20 20 20 ..'east..
4fc0: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
4fd0: 61 6c 75 65 20 22 43 44 5f 45 41 53 54 22 20 69 alue "CD_EAST" i
4fe0: 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 nt))..
4ff0: 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 .(cons..
5000: 20 20 09 09 27 77 65 73 74 0a 09 20 20 20 20 20 ..'west..
5010: 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d ..(foreign-
5020: 76 61 6c 75 65 20 22 43 44 5f 57 45 53 54 22 20 value "CD_WEST"
5030: 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 int))..
5040: 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 .(cons..
5050: 20 20 20 09 09 27 6e 6f 72 74 68 2d 65 61 73 74 ..'north-east
5060: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
5070: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
5080: 5f 4e 4f 52 54 48 5f 45 41 53 54 22 20 69 6e 74 _NORTH_EAST" int
5090: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
50a0: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
50b0: 09 09 27 6e 6f 72 74 68 2d 77 65 73 74 0a 09 20 ..'north-west..
50c0: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
50d0: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 4e 4f ign-value "CD_NO
50e0: 52 54 48 5f 57 45 53 54 22 20 69 6e 74 29 29 0a RTH_WEST" int)).
50f0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
5100: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
5110: 73 6f 75 74 68 2d 65 61 73 74 0a 09 20 20 20 20 south-east..
5120: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
5130: 2d 76 61 6c 75 65 20 22 43 44 5f 53 4f 55 54 48 -value "CD_SOUTH
5140: 5f 45 41 53 54 22 20 69 6e 74 29 29 0a 09 20 20 _EAST" int))..
5150: 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 .(cons..
5160: 20 20 20 20 20 20 20 20 20 20 09 09 27 73 6f 75 ..'sou
5170: 74 68 2d 77 65 73 74 0a 09 20 20 20 20 20 20 20 th-west..
5180: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
5190: 6c 75 65 20 22 43 44 5f 53 4f 55 54 48 5f 57 45 lue "CD_SOUTH_WE
51a0: 53 54 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 ST" int))..
51b0: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
51c0: 20 20 20 20 20 20 20 09 09 27 63 65 6e 74 65 72 ..'center
51d0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
51e0: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
51f0: 5f 43 45 4e 54 45 52 22 20 69 6e 74 29 29 0a 09 _CENTER" int))..
5200: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
5210: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 62 .. ..'b
5220: 61 73 65 2d 6c 65 66 74 0a 09 20 20 20 20 20 20 ase-left..
5230: 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 ..(foreign-v
5240: 61 6c 75 65 20 22 43 44 5f 42 41 53 45 5f 4c 45 alue "CD_BASE_LE
5250: 46 54 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 FT" int))..
5260: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
5270: 20 20 20 20 20 20 20 09 09 27 62 61 73 65 2d 63 ..'base-c
5280: 65 6e 74 65 72 0a 09 20 20 20 20 20 20 20 20 20 enter..
5290: 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 ..(foreign-valu
52a0: 65 20 22 43 44 5f 42 41 53 45 5f 43 45 4e 54 45 e "CD_BASE_CENTE
52b0: 52 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 R" int))..
52c0: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
52d0: 20 20 20 20 20 20 09 09 27 62 61 73 65 2d 72 69 ..'base-ri
52e0: 67 68 74 0a 09 20 20 20 20 20 20 20 20 20 20 09 ght.. .
52f0: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
5300: 22 43 44 5f 42 41 53 45 5f 52 49 47 48 54 22 20 "CD_BASE_RIGHT"
5310: 69 6e 74 29 29 29 5d 0a 09 20 20 20 20 20 20 20 int)))]..
5320: 20 20 5b 63 61 6e 76 61 73 2d 74 65 78 74 2d 61 [canvas-text-a
5330: 6c 69 67 6e 6d 65 6e 74 2d 73 65 74 2f 72 61 77 lignment-set/raw
5340: 21 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f !.. (fo
5350: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 reign-lambda voi
5360: 64 20 22 63 64 43 61 6e 76 61 73 54 65 78 74 41 d "cdCanvasTextA
5370: 6c 69 67 6e 6d 65 6e 74 22 20 6e 6f 6e 6e 75 6c lignment" nonnul
5380: 6c 2d 63 61 6e 76 61 73 20 69 6e 74 29 5d 0a 09 l-canvas int)]..
5390: 20 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 [canvas
53a0: 2d 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 2d -text-alignment-
53b0: 73 65 74 21 0a 09 20 20 20 20 20 20 20 20 20 20 set!..
53c0: 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 20 (lambda (canvas
53d0: 61 6c 69 67 6e 6d 65 6e 74 29 0a 09 09 09 09 09 alignment)......
53e0: 09 09 28 63 61 6e 76 61 73 2d 74 65 78 74 2d 61 ..(canvas-text-a
53f0: 6c 69 67 6e 6d 65 6e 74 2d 73 65 74 2f 72 61 77 lignment-set/raw
5400: 21 0a 09 09 09 09 09 09 09 09 63 61 6e 76 61 73 !.........canvas
5410: 0a 09 09 09 09 09 09 09 09 28 63 6f 6e 64 0a 09 .........(cond..
5420: 09 09 09 09 09 09 09 09 5b 28 61 73 73 71 20 61 ........[(assq a
5430: 6c 69 67 6e 6d 65 6e 74 20 61 6c 69 67 6e 6d 65 lignment alignme
5440: 6e 74 73 29 20 3d 3e 20 63 64 72 5d 0a 09 09 09 nts) => cdr]....
5450: 09 09 09 09 09 09 5b 65 6c 73 65 20 28 65 72 72 ......[else (err
5460: 6f 72 20 27 63 61 6e 76 61 73 2d 74 65 78 74 2d or 'canvas-text-
5470: 61 6c 69 67 6e 6d 65 6e 74 2d 73 65 74 21 20 22 alignment-set! "
5480: 75 6e 6b 6e 6f 77 6e 20 61 6c 69 67 6e 6d 65 6e unknown alignmen
5490: 74 22 20 61 6c 69 67 6e 6d 65 6e 74 29 5d 29 29 t" alignment)]))
54a0: 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b 63 61 )].. [ca
54b0: 6e 76 61 73 2d 74 65 78 74 2d 61 6c 69 67 6e 6d nvas-text-alignm
54c0: 65 6e 74 2f 72 61 77 0a 09 20 20 20 20 20 20 20 ent/raw..
54d0: 20 20 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 (foreign-lamb
54e0: 64 61 2a 20 69 6e 74 20 28 5b 6e 6f 6e 6e 75 6c da* int ([nonnul
54f0: 6c 2d 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d l-canvas canvas]
5500: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 22 43 ).. ."C
5510: 5f 72 65 74 75 72 6e 28 63 64 43 61 6e 76 61 73 _return(cdCanvas
5520: 54 65 78 74 41 6c 69 67 6e 6d 65 6e 74 28 63 61 TextAlignment(ca
5530: 6e 76 61 73 2c 20 43 44 5f 51 55 45 52 59 29 29 nvas, CD_QUERY))
5540: 3b 22 29 5d 0a 09 20 20 20 20 20 20 20 20 20 5b ;")].. [
5550: 63 61 6e 76 61 73 2d 74 65 78 74 2d 61 6c 69 67 canvas-text-alig
5560: 6e 6d 65 6e 74 0a 09 20 20 20 20 20 20 20 20 20 nment..
5570: 20 28 6c 61 6d 62 64 61 20 28 63 61 6e 76 61 73 (lambda (canvas
5580: 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 6c ).. .(l
5590: 65 74 20 28 5b 61 6c 69 67 6e 6d 65 6e 74 20 28 et ([alignment (
55a0: 63 61 6e 76 61 73 2d 74 65 78 74 2d 61 6c 69 67 canvas-text-alig
55b0: 6e 6d 65 6e 74 2f 72 61 77 20 63 61 6e 76 61 73 nment/raw canvas
55c0: 29 5d 29 0a 09 09 09 09 09 09 09 09 28 63 6f 6e )]).........(con
55d0: 64 0a 09 09 09 09 09 09 09 09 09 5b 28 72 61 73 d..........[(ras
55e0: 73 6f 63 20 61 6c 69 67 6e 6d 65 6e 74 20 61 6c soc alignment al
55f0: 69 67 6e 6d 65 6e 74 73 29 20 3d 3e 20 63 61 72 ignments) => car
5600: 5d 0a 09 09 09 09 09 09 09 09 09 5b 65 6c 73 65 ]..........[else
5610: 20 28 65 72 72 6f 72 20 27 63 61 6e 76 61 73 2d (error 'canvas-
5620: 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 20 22 text-alignment "
5630: 75 6e 6b 6e 6f 77 6e 20 61 6c 69 67 6e 6d 65 6e unknown alignmen
5640: 74 22 20 61 6c 69 67 6e 6d 65 6e 74 29 5d 29 29 t" alignment)]))
5650: 29 5d 29 0a 09 09 28 76 61 6c 75 65 73 0a 09 09 )])...(values...
5660: 09 28 67 65 74 74 65 72 2d 77 69 74 68 2d 73 65 .(getter-with-se
5670: 74 74 65 72 20 63 61 6e 76 61 73 2d 74 65 78 74 tter canvas-text
5680: 2d 61 6c 69 67 6e 6d 65 6e 74 20 63 61 6e 76 61 -alignment canva
5690: 73 2d 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 s-text-alignment
56a0: 2d 73 65 74 21 29 0a 09 09 09 63 61 6e 76 61 73 -set!)....canvas
56b0: 2d 74 65 78 74 2d 61 6c 69 67 6e 6d 65 6e 74 2d -text-alignment-
56c0: 73 65 74 21 29 29 29 0a 0a 28 64 65 66 69 6e 65 set!)))..(define
56d0: 20 63 61 6e 76 61 73 2d 74 65 78 74 2d 6f 72 69 canvas-text-ori
56e0: 65 6e 74 61 74 69 6f 6e 2d 73 65 74 21 0a 09 28 entation-set!..(
56f0: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 foreign-lambda v
5700: 6f 69 64 20 22 63 64 43 61 6e 76 61 73 54 65 78 oid "cdCanvasTex
5710: 74 4f 72 69 65 6e 74 61 74 69 6f 6e 22 20 6e 6f tOrientation" no
5720: 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 64 6f 75 nnull-canvas dou
5730: 62 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 ble))..(define c
5740: 61 6e 76 61 73 2d 74 65 78 74 2d 6f 72 69 65 6e anvas-text-orien
5750: 74 61 74 69 6f 6e 0a 09 28 67 65 74 74 65 72 2d tation..(getter-
5760: 77 69 74 68 2d 73 65 74 74 65 72 0a 09 09 28 66 with-setter...(f
5770: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 2a 20 64 oreign-lambda* d
5780: 6f 75 62 6c 65 20 28 5b 6e 6f 6e 6e 75 6c 6c 2d ouble ([nonnull-
5790: 63 61 6e 76 61 73 20 63 61 6e 76 61 73 5d 29 0a canvas canvas]).
57a0: 09 09 09 22 43 5f 72 65 74 75 72 6e 28 63 64 43 ..."C_return(cdC
57b0: 61 6e 76 61 73 54 65 78 74 4f 72 69 65 6e 74 61 anvasTextOrienta
57c0: 74 69 6f 6e 28 63 61 6e 76 61 73 2c 20 43 44 5f tion(canvas, CD_
57d0: 51 55 45 52 59 29 29 3b 22 29 0a 09 09 63 61 6e QUERY));")...can
57e0: 76 61 73 2d 74 65 78 74 2d 6f 72 69 65 6e 74 61 vas-text-orienta
57f0: 74 69 6f 6e 2d 73 65 74 21 29 29 0a 0a 28 64 65 tion-set!))..(de
5800: 66 69 6e 65 20 63 61 6e 76 61 73 2d 66 6f 6e 74 fine canvas-font
5810: 2d 64 69 6d 65 6e 73 69 6f 6e 73 0a 09 28 6c 65 -dimensions..(le
5820: 74 72 65 63 20 28 5b 63 61 6e 76 61 73 2d 66 6f trec ([canvas-fo
5830: 6e 74 2d 64 69 6d 65 6e 73 69 6f 6e 73 2f 72 61 nt-dimensions/ra
5840: 77 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f w.. (fo
5850: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 reign-lambda voi
5860: 64 20 22 63 64 43 61 6e 76 61 73 47 65 74 46 6f d "cdCanvasGetFo
5870: 6e 74 44 69 6d 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 ntDim" nonnull-c
5880: 61 6e 76 61 73 20 28 63 2d 70 6f 69 6e 74 65 72 anvas (c-pointer
5890: 20 69 6e 74 29 20 28 63 2d 70 6f 69 6e 74 65 72 int) (c-pointer
58a0: 20 69 6e 74 29 20 28 63 2d 70 6f 69 6e 74 65 72 int) (c-pointer
58b0: 20 69 6e 74 29 20 28 63 2d 70 6f 69 6e 74 65 72 int) (c-pointer
58c0: 20 69 6e 74 29 29 5d 29 0a 09 20 20 28 6c 61 6d int))]).. (lam
58d0: 62 64 61 20 28 63 61 6e 76 61 73 29 0a 09 20 20 bda (canvas)..
58e0: 09 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e 20 28 .(let-location (
58f0: 5b 6d 61 78 2d 77 69 64 74 68 20 69 6e 74 20 30 [max-width int 0
5900: 5d 0a 09 20 20 09 20 20 20 20 20 20 20 20 20 20 ].. .
5910: 20 20 20 20 20 5b 68 65 69 67 68 74 20 69 6e 74 [height int
5920: 20 30 5d 0a 09 20 20 09 20 20 20 20 20 20 20 20 0].. .
5930: 20 20 20 20 20 20 20 5b 61 73 63 65 6e 74 20 69 [ascent i
5940: 6e 74 20 30 5d 0a 09 20 20 09 20 20 20 20 20 20 nt 0].. .
5950: 20 20 20 20 20 20 20 20 20 5b 64 65 73 63 65 6e [descen
5960: 74 20 69 6e 74 20 30 5d 29 0a 09 20 20 09 20 20 t int 0]).. .
5970: 28 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 64 69 6d (canvas-font-dim
5980: 65 6e 73 69 6f 6e 73 2f 72 61 77 20 63 61 6e 76 ensions/raw canv
5990: 61 73 20 28 6c 6f 63 61 74 69 6f 6e 20 6d 61 78 as (location max
59a0: 2d 77 69 64 74 68 29 20 28 6c 6f 63 61 74 69 6f -width) (locatio
59b0: 6e 20 68 65 69 67 68 74 29 20 28 6c 6f 63 61 74 n height) (locat
59c0: 69 6f 6e 20 61 73 63 65 6e 74 29 20 28 6c 6f 63 ion ascent) (loc
59d0: 61 74 69 6f 6e 20 64 65 73 63 65 6e 74 29 29 0a ation descent)).
59e0: 09 20 20 09 20 20 28 76 61 6c 75 65 73 20 6d 61 . . (values ma
59f0: 78 2d 77 69 64 74 68 20 68 65 69 67 68 74 20 61 x-width height a
5a00: 73 63 65 6e 74 20 64 65 73 63 65 6e 74 29 29 29 scent descent)))
5a10: 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 ))..(define canv
5a20: 61 73 2d 74 65 78 74 2d 73 69 7a 65 0a 09 28 6c as-text-size..(l
5a30: 65 74 72 65 63 20 28 5b 63 61 6e 76 61 73 2d 74 etrec ([canvas-t
5a40: 65 78 74 2d 73 69 7a 65 2f 72 61 77 0a 09 20 20 ext-size/raw..
5a50: 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 6e (foreign
5a60: 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 64 -lambda void "cd
5a70: 43 61 6e 76 61 73 47 65 74 54 65 78 74 53 69 7a CanvasGetTextSiz
5a80: 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 e" nonnull-canva
5a90: 73 20 6e 6f 6e 6e 75 6c 6c 2d 63 2d 73 74 72 69 s nonnull-c-stri
5aa0: 6e 67 20 28 63 2d 70 6f 69 6e 74 65 72 20 69 6e ng (c-pointer in
5ab0: 74 29 20 28 63 2d 70 6f 69 6e 74 65 72 20 69 6e t) (c-pointer in
5ac0: 74 29 29 5d 29 0a 09 20 20 28 6c 61 6d 62 64 61 t))]).. (lambda
5ad0: 20 28 63 61 6e 76 61 73 20 74 65 78 74 29 0a 09 (canvas text)..
5ae0: 20 20 09 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e .(let-location
5af0: 20 28 5b 77 69 64 74 68 20 69 6e 74 20 30 5d 20 ([width int 0]
5b00: 5b 68 65 69 67 68 74 20 69 6e 74 20 30 5d 29 0a [height int 0]).
5b10: 09 20 20 09 09 28 63 61 6e 76 61 73 2d 74 65 78 . ..(canvas-tex
5b20: 74 2d 73 69 7a 65 2f 72 61 77 20 63 61 6e 76 61 t-size/raw canva
5b30: 73 20 74 65 78 74 20 28 6c 6f 63 61 74 69 6f 6e s text (location
5b40: 20 77 69 64 74 68 29 20 28 6c 6f 63 61 74 69 6f width) (locatio
5b50: 6e 20 68 65 69 67 68 74 29 29 0a 09 20 20 09 09 n height)).. ..
5b60: 28 76 61 6c 75 65 73 20 77 69 64 74 68 20 68 65 (values width he
5b70: 69 67 68 74 29 29 29 29 29 0a 0a 28 64 65 66 69 ight)))))..(defi
5b80: 6e 65 20 63 61 6e 76 61 73 2d 74 65 78 74 2d 62 ne canvas-text-b
5b90: 6f 78 0a 09 28 6c 65 74 72 65 63 20 28 5b 63 61 ox..(letrec ([ca
5ba0: 6e 76 61 73 2d 74 65 78 74 2d 62 6f 78 2f 72 61 nvas-text-box/ra
5bb0: 77 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f w.. (fo
5bc0: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 reign-lambda voi
5bd0: 64 20 22 63 64 43 61 6e 76 61 73 47 65 74 54 65 d "cdCanvasGetTe
5be0: 78 74 42 6f 78 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 xtBox" nonnull-c
5bf0: 61 6e 76 61 73 20 69 6e 74 20 69 6e 74 20 6e 6f anvas int int no
5c00: 6e 6e 75 6c 6c 2d 63 2d 73 74 72 69 6e 67 20 28 nnull-c-string (
5c10: 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 c-pointer int) (
5c20: 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 c-pointer int) (
5c30: 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 20 28 c-pointer int) (
5c40: 63 2d 70 6f 69 6e 74 65 72 20 69 6e 74 29 29 5d c-pointer int))]
5c50: 29 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 63 61 ).. (lambda (ca
5c60: 6e 76 61 73 20 78 20 79 20 74 65 78 74 29 0a 09 nvas x y text)..
5c70: 20 20 09 28 6c 65 74 2d 6c 6f 63 61 74 69 6f 6e .(let-location
5c80: 20 28 5b 78 30 20 69 6e 74 20 30 5d 20 5b 78 31 ([x0 int 0] [x1
5c90: 20 69 6e 74 20 30 5d 0a 09 20 20 09 20 20 20 20 int 0].. .
5ca0: 20 20 20 20 20 20 20 20 20 20 20 5b 79 30 20 69 [y0 i
5cb0: 6e 74 20 30 5d 20 5b 79 31 20 69 6e 74 20 30 5d nt 0] [y1 int 0]
5cc0: 29 0a 09 20 20 09 20 20 28 63 61 6e 76 61 73 2d ).. . (canvas-
5cd0: 74 65 78 74 2d 62 6f 78 2f 72 61 77 20 63 61 6e text-box/raw can
5ce0: 76 61 73 20 78 20 79 20 74 65 78 74 20 28 6c 6f vas x y text (lo
5cf0: 63 61 74 69 6f 6e 20 78 30 29 20 28 6c 6f 63 61 cation x0) (loca
5d00: 74 69 6f 6e 20 78 31 29 20 28 6c 6f 63 61 74 69 tion x1) (locati
5d10: 6f 6e 20 79 30 29 20 28 6c 6f 63 61 74 69 6f 6e on y0) (location
5d20: 20 79 31 29 29 0a 09 20 20 09 20 20 28 76 61 6c y1)).. . (val
5d30: 75 65 73 20 78 30 20 78 31 20 79 30 20 79 31 29 ues x0 x1 y0 y1)
5d40: 29 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b ))))..;; }}}..;;
5d50: 20 7b 7b 7b 20 56 65 72 74 65 78 20 66 75 6e 63 {{{ Vertex func
5d60: 74 69 6f 6e 73 0a 0a 28 64 65 66 69 6e 65 20 63 tions..(define c
5d70: 61 6c 6c 2d 77 69 74 68 2d 63 61 6e 76 61 73 2d all-with-canvas-
5d80: 69 6e 2d 6d 6f 64 65 0a 09 28 6c 65 74 72 65 63 in-mode..(letrec
5d90: 20 28 5b 63 61 6e 76 61 73 2d 6d 6f 64 65 73 0a ([canvas-modes.
5da0: 09 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 . (list
5db0: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
5dc0: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
5dd0: 27 6f 70 65 6e 2d 6c 69 6e 65 73 0a 09 20 20 20 'open-lines..
5de0: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
5df0: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 4f 50 45 4e n-value "CD_OPEN
5e00: 5f 4c 49 4e 45 53 22 20 69 6e 74 29 29 0a 09 20 _LINES" int))..
5e10: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
5e20: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 63 6c . ..'cl
5e30: 6f 73 65 64 2d 6c 69 6e 65 73 0a 09 20 20 20 20 osed-lines..
5e40: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
5e50: 2d 76 61 6c 75 65 20 22 43 44 5f 43 4c 4f 53 45 -value "CD_CLOSE
5e60: 44 5f 4c 49 4e 45 53 22 20 69 6e 74 29 29 0a 09 D_LINES" int))..
5e70: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
5e80: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 66 .. ..'f
5e90: 69 6c 6c 0a 09 20 20 20 20 20 20 20 20 20 20 09 ill.. .
5ea0: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
5eb0: 22 43 44 5f 46 49 4c 4c 22 20 69 6e 74 29 29 0a "CD_FILL" int)).
5ec0: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
5ed0: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
5ee0: 63 6c 69 70 0a 09 20 20 20 20 20 20 20 20 20 20 clip..
5ef0: 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 ..(foreign-value
5f00: 20 22 43 44 5f 43 4c 49 50 22 20 69 6e 74 29 29 "CD_CLIP" int))
5f10: 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f .. .(co
5f20: 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 ns.. ..
5f30: 27 62 65 7a 69 65 72 0a 09 20 20 20 20 20 20 20 'bezier..
5f40: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
5f50: 6c 75 65 20 22 43 44 5f 42 45 5a 49 45 52 22 20 lue "CD_BEZIER"
5f60: 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 int))..
5f70: 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 .(cons..
5f80: 20 20 20 09 09 27 72 65 67 69 6f 6e 0a 09 20 20 ..'region..
5f90: 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 ..(forei
5fa0: 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 52 45 47 gn-value "CD_REG
5fb0: 49 4f 4e 22 20 69 6e 74 29 29 0a 09 20 20 20 20 ION" int))..
5fc0: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
5fd0: 20 20 20 20 20 20 20 20 09 09 27 70 61 74 68 0a ..'path.
5fe0: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
5ff0: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
6000: 50 41 54 48 22 20 69 6e 74 29 29 29 5d 0a 09 20 PATH" int)))]..
6010: 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d [canvas-
6020: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 20 20 20 begin..
6030: 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 (foreign-lambda
6040: 20 76 6f 69 64 20 22 63 64 43 61 6e 76 61 73 42 void "cdCanvasB
6050: 65 67 69 6e 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 egin" nonnull-ca
6060: 6e 76 61 73 20 69 6e 74 29 5d 0a 09 20 20 20 20 nvas int)]..
6070: 20 20 20 20 20 5b 63 61 6e 76 61 73 2d 65 6e 64 [canvas-end
6080: 0a 09 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 .. (for
6090: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 eign-lambda void
60a0: 20 22 63 64 43 61 6e 76 61 73 45 6e 64 22 20 6e "cdCanvasEnd" n
60b0: 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 29 5d 29 onnull-canvas)])
60c0: 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 63 61 6e .. (lambda (can
60d0: 76 61 73 20 63 61 6e 76 61 73 2d 6d 6f 64 65 20 vas canvas-mode
60e0: 70 72 6f 63 29 0a 09 20 20 09 28 6c 65 74 20 28 proc).. .(let (
60f0: 5b 63 61 6e 76 61 73 2d 6d 6f 64 65 0a 09 20 20 [canvas-mode..
6100: 09 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 09 20 . (cond..
6110: 20 09 20 20 20 20 20 20 20 09 20 5b 28 61 73 73 . . [(ass
6120: 71 20 63 61 6e 76 61 73 2d 6d 6f 64 65 20 63 61 q canvas-mode ca
6130: 6e 76 61 73 2d 6d 6f 64 65 73 29 20 3d 3e 20 63 nvas-modes) => c
6140: 64 72 5d 0a 09 20 20 09 20 20 20 20 20 20 20 09 dr].. . .
6150: 20 5b 65 6c 73 65 20 28 65 72 72 6f 72 20 27 77 [else (error 'w
6160: 69 74 68 2d 63 61 6e 76 61 73 2d 6d 6f 64 65 20 ith-canvas-mode
6170: 22 75 6e 6b 6e 6f 77 6e 20 63 61 6e 76 61 73 20 "unknown canvas
6180: 6d 6f 64 65 22 20 63 61 6e 76 61 73 2d 6d 6f 64 mode" canvas-mod
6190: 65 29 5d 29 5d 29 0a 09 09 09 09 28 64 79 6e 61 e)])]).....(dyna
61a0: 6d 69 63 2d 77 69 6e 64 0a 09 09 09 09 09 28 63 mic-wind......(c
61b0: 75 74 20 63 61 6e 76 61 73 2d 62 65 67 69 6e 20 ut canvas-begin
61c0: 63 61 6e 76 61 73 20 63 61 6e 76 61 73 2d 6d 6f canvas canvas-mo
61d0: 64 65 29 0a 09 09 09 09 09 28 63 75 74 20 70 72 de)......(cut pr
61e0: 6f 63 20 63 61 6e 76 61 73 29 0a 09 09 09 09 09 oc canvas)......
61f0: 28 63 75 74 20 63 61 6e 76 61 73 2d 65 6e 64 20 (cut canvas-end
6200: 63 61 6e 76 61 73 29 29 29 29 29 29 0a 0a 28 64 canvas))))))..(d
6210: 65 66 69 6e 65 20 63 61 6e 76 61 73 2d 70 61 74 efine canvas-pat
6220: 68 2d 73 65 74 21 0a 09 28 6c 65 74 72 65 63 20 h-set!..(letrec
6230: 28 5b 70 61 74 68 2d 61 63 74 69 6f 6e 73 0a 09 ([path-actions..
6240: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 0a (list.
6250: 09 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e . .(con
6260: 73 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 s.. ..'
6270: 6e 65 77 0a 09 20 20 20 20 20 20 20 20 20 20 09 new.. .
6280: 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 .(foreign-value
6290: 22 43 44 5f 50 41 54 48 5f 4e 45 57 22 20 69 6e "CD_PATH_NEW" in
62a0: 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 t)).. .
62b0: 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 (cons..
62c0: 20 09 09 27 6d 6f 76 65 2d 74 6f 0a 09 20 20 20 ..'move-to..
62d0: 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 ..(foreig
62e0: 6e 2d 76 61 6c 75 65 20 22 43 44 5f 50 41 54 48 n-value "CD_PATH
62f0: 5f 4d 4f 56 45 54 4f 22 20 69 6e 74 29 29 0a 09 _MOVETO" int))..
6300: 20 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 .(cons
6310: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 27 6c .. ..'l
6320: 69 6e 65 2d 74 6f 0a 09 20 20 20 20 20 20 20 20 ine-to..
6330: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
6340: 75 65 20 22 43 44 5f 50 41 54 48 5f 4c 49 4e 45 ue "CD_PATH_LINE
6350: 54 4f 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 TO" int))..
6360: 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 .(cons..
6370: 20 20 20 20 20 20 20 09 09 27 61 72 63 0a 09 20 ..'arc..
6380: 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 65 ..(fore
6390: 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 50 41 ign-value "CD_PA
63a0: 54 48 5f 41 52 43 22 20 69 6e 74 29 29 0a 09 20 TH_ARC" int))..
63b0: 20 20 20 20 20 20 20 20 20 09 28 63 6f 6e 73 0a .(cons.
63c0: 09 20 20 20 20 20 20 20 20 20 20 09 09 27 63 75 . ..'cu
63d0: 72 76 65 2d 74 6f 0a 09 20 20 20 20 20 20 20 20 rve-to..
63e0: 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c ..(foreign-val
63f0: 75 65 20 22 43 44 5f 50 41 54 48 5f 43 55 52 56 ue "CD_PATH_CURV
6400: 45 54 4f 22 20 69 6e 74 29 29 0a 09 20 20 20 20 ETO" int))..
6410: 20 20 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 .(cons..
6420: 20 20 20 20 20 20 20 20 09 09 27 63 6c 6f 73 65 ..'close
6430: 0a 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 .. ..(f
6440: 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 oreign-value "CD
6450: 5f 50 41 54 48 5f 43 4c 4f 53 45 22 20 69 6e 74 _PATH_CLOSE" int
6460: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
6470: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
6480: 09 09 27 66 69 6c 6c 0a 09 20 20 20 20 20 20 20 ..'fill..
6490: 20 20 20 09 09 28 66 6f 72 65 69 67 6e 2d 76 61 ..(foreign-va
64a0: 6c 75 65 20 22 43 44 5f 50 41 54 48 5f 46 49 4c lue "CD_PATH_FIL
64b0: 4c 22 20 69 6e 74 29 29 0a 09 20 20 20 20 20 20 L" int))..
64c0: 20 20 20 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 .(cons..
64d0: 20 20 20 20 20 20 09 09 27 73 74 72 6f 6b 65 0a ..'stroke.
64e0: 09 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f . ..(fo
64f0: 72 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f reign-value "CD_
6500: 50 41 54 48 5f 53 54 52 4f 4b 45 22 20 69 6e 74 PATH_STROKE" int
6510: 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 09 28 )).. .(
6520: 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 20 20 20 cons..
6530: 09 09 27 66 69 6c 6c 2b 73 74 72 6f 6b 65 0a 09 ..'fill+stroke..
6540: 20 20 20 20 20 20 20 20 20 20 09 09 28 66 6f 72 ..(for
6550: 65 69 67 6e 2d 76 61 6c 75 65 20 22 43 44 5f 50 eign-value "CD_P
6560: 41 54 48 5f 46 49 4c 4c 53 54 52 4f 4b 45 22 20 ATH_FILLSTROKE"
6570: 69 6e 74 29 29 0a 09 20 20 20 20 20 20 20 20 20 int))..
6580: 20 09 28 63 6f 6e 73 0a 09 20 20 20 20 20 20 20 .(cons..
6590: 20 20 20 09 09 27 63 6c 69 70 0a 09 20 20 20 20 ..'clip..
65a0: 20 20 20 20 20 20 09 09 28 66 6f 72 65 69 67 6e ..(foreign
65b0: 2d 76 61 6c 75 65 20 22 43 44 5f 50 41 54 48 5f -value "CD_PATH_
65c0: 43 4c 49 50 22 20 69 6e 74 29 29 29 5d 0a 09 20 CLIP" int)))]..
65d0: 20 20 20 20 20 20 20 20 5b 63 61 6e 76 61 73 2d [canvas-
65e0: 70 61 74 68 2d 73 65 74 2f 72 61 77 21 0a 09 20 path-set/raw!..
65f0: 20 20 20 20 20 20 20 20 20 28 66 6f 72 65 69 67 (foreig
6600: 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 22 63 n-lambda void "c
6610: 64 43 61 6e 76 61 73 50 61 74 68 53 65 74 22 20 dCanvasPathSet"
6620: 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 61 73 20 69 nonnull-canvas i
6630: 6e 74 29 5d 29 0a 09 20 20 28 6c 61 6d 62 64 61 nt)]).. (lambda
6640: 20 28 63 61 6e 76 61 73 20 70 61 74 68 2d 61 63 (canvas path-ac
6650: 74 69 6f 6e 29 0a 09 20 20 09 28 63 61 6e 76 61 tion).. .(canva
6660: 73 2d 70 61 74 68 2d 73 65 74 2f 72 61 77 21 0a s-path-set/raw!.
6670: 09 20 20 09 09 63 61 6e 76 61 73 0a 09 20 20 09 . ..canvas.. .
6680: 09 28 63 6f 6e 64 0a 09 20 20 09 09 09 5b 28 61 .(cond.. ...[(a
6690: 73 73 71 20 70 61 74 68 2d 61 63 74 69 6f 6e 20 ssq path-action
66a0: 70 61 74 68 2d 61 63 74 69 6f 6e 73 29 20 3d 3e path-actions) =>
66b0: 20 63 64 72 5d 0a 09 20 20 09 09 09 5b 65 6c 73 cdr].. ...[els
66c0: 65 20 28 65 72 72 6f 72 20 27 63 61 6e 76 61 73 e (error 'canvas
66d0: 2d 70 61 74 68 2d 73 65 74 21 20 22 75 6e 6b 6e -path-set! "unkn
66e0: 6f 77 6e 20 70 61 74 68 20 61 63 74 69 6f 6e 22 own path action"
66f0: 20 70 61 74 68 2d 61 63 74 69 6f 6e 29 5d 29 29 path-action)]))
6700: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e )))..(define can
6710: 76 61 73 2d 76 65 72 74 65 78 21 0a 09 28 66 6f vas-vertex!..(fo
6720: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 reign-lambda voi
6730: 64 20 22 63 64 66 43 61 6e 76 61 73 56 65 72 74 d "cdfCanvasVert
6740: 65 78 22 20 6e 6f 6e 6e 75 6c 6c 2d 63 61 6e 76 ex" nonnull-canv
6750: 61 73 20 64 6f 75 62 6c 65 20 64 6f 75 62 6c 65 as double double
6760: 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a ))..;; }}}.