Artifact
5df2a61079409285d46f6589818c71c39d5ded95:
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 0a 09 22 23 69 6e 63 6c 75 64 65 20 3c \n".."#include <
0070: 63 64 69 75 70 2e 68 3e 5c 6e 22 29 0a 0a 28 69 cdiup.h>\n")..(i
0080: 6e 63 6c 75 64 65 20 22 63 61 6e 76 61 73 2d 64 nclude "canvas-d
0090: 72 61 77 2d 74 79 70 65 73 2e 73 63 6d 22 29 0a raw-types.scm").
00a0: 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 .;; }}}..;; {{{
00b0: 43 6f 6e 74 65 78 74 20 74 79 70 65 73 0a 0a 28 Context types..(
00c0: 64 65 66 69 6e 65 20 63 6f 6e 74 65 78 74 3a 69 define context:i
00d0: 75 70 0a 09 28 66 6f 72 65 69 67 6e 2d 76 61 6c up..(foreign-val
00e0: 75 65 20 22 43 44 5f 49 55 50 22 20 6e 6f 6e 6e ue "CD_IUP" nonn
00f0: 75 6c 6c 2d 63 6f 6e 74 65 78 74 29 29 0a 0a 3b ull-context))..;
0100: 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 41 75 ; }}}..;; {{{ Au
0110: 78 69 6c 69 61 72 79 20 66 75 6e 63 74 69 6f 6e xiliary function
0120: 73 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 s..(define (make
0130: 2d 63 61 6e 76 61 73 2d 61 63 74 69 6f 6e 20 70 -canvas-action p
0140: 72 6f 63 29 0a 09 28 6c 65 74 20 28 5b 63 61 6e roc)..(let ([can
0150: 76 61 73 20 23 66 5d 29 0a 09 09 28 6c 61 6d 62 vas #f])...(lamb
0160: 64 61 20 28 68 61 6e 64 6c 65 20 78 20 79 29 0a da (handle x y).
0170: 09 09 09 28 75 6e 6c 65 73 73 20 63 61 6e 76 61 ...(unless canva
0180: 73 20 28 73 65 74 21 20 63 61 6e 76 61 73 20 28 s (set! canvas (
0190: 6d 61 6b 65 2d 63 61 6e 76 61 73 20 63 6f 6e 74 make-canvas cont
01a0: 65 78 74 3a 69 75 70 20 68 61 6e 64 6c 65 29 29 ext:iup handle))
01b0: 29 0a 09 09 09 28 63 61 6c 6c 2d 77 69 74 68 2d )....(call-with-
01c0: 63 61 6e 76 61 73 20 63 61 6e 76 61 73 20 28 63 canvas canvas (c
01d0: 75 74 20 70 72 6f 63 20 3c 3e 20 78 20 79 29 29 ut proc <> x y))
01e0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 )))..(define (ma
01f0: 6b 65 2d 63 65 6c 6c 73 2d 64 72 61 77 2d 63 62 ke-cells-draw-cb
0200: 20 70 72 6f 63 29 0a 09 28 6c 65 74 20 28 5b 77 proc)..(let ([w
0210: 72 61 70 20 28 70 6f 69 6e 74 65 72 2d 3e 63 61 rap (pointer->ca
0220: 6e 76 61 73 20 23 74 29 5d 29 0a 09 09 28 6c 61 nvas #t)])...(la
0230: 6d 62 64 61 20 28 68 61 6e 64 6c 65 20 69 20 6a mbda (handle i j
0240: 20 78 2d 6d 69 6e 20 78 2d 6d 61 78 20 79 2d 6d x-min x-max y-m
0250: 69 6e 20 79 2d 6d 61 78 20 63 61 6e 76 61 73 29 in y-max canvas)
0260: 0a 09 09 09 28 63 61 6c 6c 2d 77 69 74 68 2d 63 ....(call-with-c
0270: 61 6e 76 61 73 20 28 77 72 61 70 20 63 61 6e 76 anvas (wrap canv
0280: 61 73 29 20 28 63 75 74 20 70 72 6f 63 20 68 61 as) (cut proc ha
0290: 6e 64 6c 65 20 69 20 6a 20 78 2d 6d 69 6e 20 78 ndle i j x-min x
02a0: 2d 6d 61 78 20 79 2d 6d 69 6e 20 79 2d 6d 61 78 -max y-min y-max
02b0: 20 3c 3e 29 29 29 29 29 0a 0a 3b 3b 20 7d 7d 7d <>)))))..;; }}}
02c0: 0a .