Artifact
cde98249f51821b0038afe248dc5c460101425c8:
0000: 23 6c 61 6e 67 20 72 61 63 6b 65 74 0a 28 72 65 #lang racket.(re
0010: 71 75 69 72 65 0a 20 73 72 66 69 2f 32 36 0a 20 quire. srfi/26.
0020: 66 66 69 2f 75 6e 73 61 66 65 0a 20 22 62 61 73 ffi/unsafe. "bas
0030: 65 2e 72 6b 74 22 29 0a 0a 28 64 65 66 69 6e 65 e.rkt")..(define
0040: 20 6c 69 62 69 75 70 2d 63 64 0a 20 20 28 63 61 libiup-cd. (ca
0050: 73 65 20 28 73 79 73 74 65 6d 2d 74 79 70 65 20 se (system-type
0060: 27 6f 73 29 0a 20 20 20 20 5b 28 77 69 6e 64 6f 'os). [(windo
0070: 77 73 29 0a 20 20 20 20 20 28 66 66 69 2d 6c 69 ws). (ffi-li
0080: 62 20 22 69 75 70 63 64 22 29 5d 0a 20 20 20 20 b "iupcd")].
0090: 5b 65 6c 73 65 0a 20 20 20 20 20 28 66 66 69 2d [else. (ffi-
00a0: 6c 69 62 20 22 6c 69 62 69 75 70 63 64 22 29 5d lib "libiupcd")]
00b0: 29 29 0a 0a 3b 3b 20 7b 7b 7b 20 43 6f 6e 74 65 ))..;; {{{ Conte
00c0: 78 74 20 74 79 70 65 73 0a 0a 28 64 65 66 69 6e xt types..(defin
00d0: 65 20 63 6f 6e 74 65 78 74 3a 69 75 70 0a 20 20 e context:iup.
00e0: 28 28 67 65 74 2d 66 66 69 2d 6f 62 6a 20 22 63 ((get-ffi-obj "c
00f0: 64 43 6f 6e 74 65 78 74 43 47 4d 22 20 6c 69 62 dContextCGM" lib
0100: 69 75 70 2d 63 64 20 28 5f 66 75 6e 20 2d 3e 20 iup-cd (_fun ->
0110: 5b 63 6f 6e 74 65 78 74 20 3a 20 5f 63 6f 6e 74 [context : _cont
0120: 65 78 74 5d 29 29 29 29 0a 0a 28 70 72 6f 76 69 ext]))))..(provi
0130: 64 65 0a 20 63 6f 6e 74 65 78 74 3a 69 75 70 29 de. context:iup)
0140: 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b ..;; }}}..;; {{{
0150: 20 41 75 78 69 6c 69 61 72 79 20 66 75 6e 63 74 Auxiliary funct
0160: 69 6f 6e 73 0a 0a 28 64 65 66 69 6e 65 20 28 6d ions..(define (m
0170: 61 6b 65 2d 63 61 6e 76 61 73 2d 61 63 74 69 6f ake-canvas-actio
0180: 6e 20 70 72 6f 63 29 0a 20 20 28 6c 65 74 20 28 n proc). (let (
0190: 5b 63 61 6e 76 61 73 20 23 66 5d 29 0a 20 20 20 [canvas #f]).
01a0: 20 28 ce bb 20 28 68 61 6e 64 6c 65 20 78 20 79 (λ (handle x y
01b0: 29 0a 20 20 20 20 20 20 28 75 6e 6c 65 73 73 20 ). (unless
01c0: 63 61 6e 76 61 73 20 28 73 65 74 21 20 63 61 6e canvas (set! can
01d0: 76 61 73 20 28 6d 61 6b 65 2d 63 61 6e 76 61 73 vas (make-canvas
01e0: 20 63 6f 6e 74 65 78 74 3a 69 75 70 20 68 61 6e context:iup han
01f0: 64 6c 65 29 29 29 0a 20 20 20 20 20 20 28 63 61 dle))). (ca
0200: 6c 6c 2d 77 69 74 68 2d 63 61 6e 76 61 73 20 63 ll-with-canvas c
0210: 61 6e 76 61 73 20 28 63 75 74 20 70 72 6f 63 20 anvas (cut proc
0220: 3c 3e 20 78 20 79 29 29 29 29 29 0a 0a 28 70 72 <> x y)))))..(pr
0230: 6f 76 69 64 65 0a 20 6d 61 6b 65 2d 63 61 6e 76 ovide. make-canv
0240: 61 73 2d 61 63 74 69 6f 6e 29 0a 0a 3b 3b 20 7d as-action)..;; }
0250: 7d 7d 0a }}.