Artifact
eea8264eeefe22f40fa615ed5e5f87f834d6f269:
0000: 28 72 65 71 75 69 72 65 2d 6c 69 62 72 61 72 79 (require-library
0010: 20 69 75 70 2d 62 61 73 65 29 0a 0a 28 6d 6f 64 iup-base)..(mod
0020: 75 6c 65 20 69 75 70 2d 67 6c 63 61 6e 76 61 73 ule iup-glcanvas
0030: 0a 09 28 67 6c 63 61 6e 76 61 73 0a 09 20 63 61 ..(glcanvas.. ca
0040: 6c 6c 2d 77 69 74 68 2d 67 6c 63 61 6e 76 61 73 ll-with-glcanvas
0050: 20 67 6c 63 61 6e 76 61 73 2d 69 73 2d 63 75 72 glcanvas-is-cur
0060: 72 65 6e 74 3f 0a 09 20 67 6c 63 61 6e 76 61 73 rent?.. glcanvas
0070: 2d 70 61 6c 65 74 74 65 2d 73 65 74 21 20 67 6c -palette-set! gl
0080: 63 61 6e 76 61 73 2d 66 6f 6e 74 2d 73 65 74 21 canvas-font-set!
0090: 29 0a 09 28 69 6d 70 6f 72 74 0a 09 09 73 63 68 )..(import...sch
00a0: 65 6d 65 20 63 68 69 63 6b 65 6e 20 66 6f 72 65 eme chicken fore
00b0: 69 67 6e 0a 09 09 69 75 70 2d 62 61 73 65 29 0a ign...iup-base).
00c0: 0a 3b 3b 20 7b 7b 7b 20 44 61 74 61 20 74 79 70 .;; {{{ Data typ
00d0: 65 73 0a 0a 28 66 6f 72 65 69 67 6e 2d 64 65 63 es..(foreign-dec
00e0: 6c 61 72 65 0a 09 22 23 69 6e 63 6c 75 64 65 20 lare.."#include
00f0: 3c 69 75 70 2e 68 3e 5c 6e 22 0a 09 22 23 69 6e <iup.h>\n".."#in
0100: 63 6c 75 64 65 20 3c 69 75 70 67 6c 2e 68 3e 5c clude <iupgl.h>\
0110: 6e 22 29 0a 09 0a 28 69 6e 63 6c 75 64 65 20 22 n")...(include "
0120: 69 75 70 2d 74 79 70 65 73 2e 73 63 6d 22 29 0a iup-types.scm").
0130: 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 .;; }}}..;; {{{
0140: 47 4c 43 61 6e 76 61 73 20 63 6f 6e 74 72 6f 6c GLCanvas control
0150: 0a 0a 28 64 65 66 69 6e 65 20 67 6c 63 61 6e 76 ..(define glcanv
0160: 61 73 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e 73 74 as. (make-const
0170: 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 72 65 ructor-procedure
0180: 0a 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d . .(foreign-lam
0190: 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e bda nonnull-ihan
01a0: 64 6c 65 20 22 49 75 70 47 4c 43 61 6e 76 61 73 dle "IupGLCanvas
01b0: 22 20 69 6e 61 6d 65 2f 75 70 63 61 73 65 29 0a " iname/upcase).
01c0: 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 .#:apply-args
01d0: 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b (optional-args [
01e0: 61 63 74 69 6f 6e 20 23 66 5d 29 29 29 0a 0a 3b action #f])))..;
01f0: 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 4f 70 ; }}}..;; {{{ Op
0200: 65 6e 47 4c 20 63 6f 6e 74 65 78 74 20 66 75 6e enGL context fun
0210: 63 74 69 6f 6e 73 0a 0a 28 64 65 66 69 6e 65 20 ctions..(define
0220: 63 61 6c 6c 2d 77 69 74 68 2d 67 6c 63 61 6e 76 call-with-glcanv
0230: 61 73 0a 20 20 28 6c 65 74 72 65 63 20 28 5b 67 as. (letrec ([g
0240: 6c 63 61 6e 76 61 73 2d 6d 61 6b 65 2d 63 75 72 lcanvas-make-cur
0250: 72 65 6e 74 20 28 66 6f 72 65 69 67 6e 2d 6c 61 rent (foreign-la
0260: 6d 62 64 61 20 76 6f 69 64 20 22 49 75 70 47 4c mbda void "IupGL
0270: 4d 61 6b 65 43 75 72 72 65 6e 74 22 20 6e 6f 6e MakeCurrent" non
0280: 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 29 5d 0a 20 null-ihandle)].
0290: 20 20 20 20 20 20 20 20 20 20 5b 67 6c 63 61 6e [glcan
02a0: 76 61 73 2d 73 77 61 70 2d 62 75 66 66 65 72 73 vas-swap-buffers
02b0: 20 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 (foreign-lambda
02c0: 20 76 6f 69 64 20 22 49 75 70 47 4c 53 77 61 70 void "IupGLSwap
02d0: 42 75 66 66 65 72 73 22 20 6e 6f 6e 6e 75 6c 6c Buffers" nonnull
02e0: 2d 69 68 61 6e 64 6c 65 29 5d 0a 20 20 20 20 20 -ihandle)].
02f0: 20 20 20 20 20 20 5b 67 6c 63 61 6e 76 61 73 2d [glcanvas-
0300: 77 61 69 74 20 28 66 6f 72 65 69 67 6e 2d 6c 61 wait (foreign-la
0310: 6d 62 64 61 20 76 6f 69 64 20 22 49 75 70 47 4c mbda void "IupGL
0320: 57 61 69 74 22 20 62 6f 6f 6c 29 5d 29 0a 20 20 Wait" bool)]).
0330: 20 20 28 6c 61 6d 62 64 61 20 28 68 61 6e 64 6c (lambda (handl
0340: 65 20 70 72 6f 63 20 23 21 6b 65 79 20 5b 73 77 e proc #!key [sw
0350: 61 70 3f 20 23 66 5d 20 5b 73 79 6e 63 3f 20 23 ap? #f] [sync? #
0360: 66 5d 29 0a 20 20 20 20 20 20 28 64 79 6e 61 6d f]). (dynam
0370: 69 63 2d 77 69 6e 64 0a 20 20 20 20 20 20 20 28 ic-wind. (
0380: 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 lambda ().
0390: 20 20 20 28 67 6c 63 61 6e 76 61 73 2d 6d 61 6b (glcanvas-mak
03a0: 65 2d 63 75 72 72 65 6e 74 20 68 61 6e 64 6c 65 e-current handle
03b0: 29 0a 20 20 20 20 20 20 20 20 20 28 77 68 65 6e ). (when
03c0: 20 73 79 6e 63 3f 20 28 67 6c 63 61 6e 76 61 73 sync? (glcanvas
03d0: 2d 77 61 69 74 20 23 66 29 29 29 0a 20 20 20 20 -wait #f))).
03e0: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 (lambda ().
03f0: 20 20 20 20 20 20 20 28 70 72 6f 63 20 68 61 6e (proc han
0400: 64 6c 65 29 29 0a 20 20 20 20 20 20 20 28 6c 61 dle)). (la
0410: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 mbda ().
0420: 20 28 77 68 65 6e 20 73 77 61 70 3f 20 28 67 6c (when swap? (gl
0430: 63 61 6e 76 61 73 2d 73 77 61 70 2d 62 75 66 66 canvas-swap-buff
0440: 65 72 73 20 68 61 6e 64 6c 65 29 29 0a 20 20 20 ers handle)).
0450: 20 20 20 20 20 20 28 77 68 65 6e 20 73 79 6e 63 (when sync
0460: 3f 20 28 67 6c 63 61 6e 76 61 73 2d 77 61 69 74 ? (glcanvas-wait
0470: 20 23 74 29 29 29 29 29 29 29 0a 0a 28 64 65 66 #t)))))))..(def
0480: 69 6e 65 20 67 6c 63 61 6e 76 61 73 2d 69 73 2d ine glcanvas-is-
0490: 63 75 72 72 65 6e 74 3f 0a 09 28 66 6f 72 65 69 current?..(forei
04a0: 67 6e 2d 6c 61 6d 62 64 61 20 62 6f 6f 6c 20 22 gn-lambda bool "
04b0: 49 75 70 47 4c 49 73 43 75 72 72 65 6e 74 22 20 IupGLIsCurrent"
04c0: 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 29 nonnull-ihandle)
04d0: 29 0a 0a 28 64 65 66 69 6e 65 20 67 6c 63 61 6e )..(define glcan
04e0: 76 61 73 2d 70 61 6c 65 74 74 65 2d 73 65 74 21 vas-palette-set!
04f0: 0a 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 ..(foreign-lambd
0500: 61 20 76 6f 69 64 20 22 49 75 70 47 4c 50 61 6c a void "IupGLPal
0510: 65 74 74 65 22 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 ette" nonnull-ih
0520: 61 6e 64 6c 65 20 69 6e 74 20 66 6c 6f 61 74 20 andle int float
0530: 66 6c 6f 61 74 20 66 6c 6f 61 74 29 29 0a 0a 28 float float))..(
0540: 64 65 66 69 6e 65 20 67 6c 63 61 6e 76 61 73 2d define glcanvas-
0550: 66 6f 6e 74 2d 73 65 74 21 0a 09 28 66 6f 72 65 font-set!..(fore
0560: 69 67 6e 2d 6c 61 6d 62 64 61 20 76 6f 69 64 20 ign-lambda void
0570: 22 49 75 70 47 4c 55 73 65 46 6f 6e 74 22 20 6e "IupGLUseFont" n
0580: 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 69 onnull-ihandle i
0590: 6e 74 20 69 6e 74 20 69 6e 74 29 29 0a 0a 3b 3b nt int int))..;;
05a0: 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 4c 69 62 }}}..;; {{{ Lib
05b0: 72 61 72 79 20 73 65 74 75 70 0a 0a 28 66 6f 72 rary setup..(for
05c0: 65 69 67 6e 2d 63 6f 64 65 20 22 49 75 70 47 4c eign-code "IupGL
05d0: 43 61 6e 76 61 73 4f 70 65 6e 28 29 3b 22 29 0a CanvasOpen();").
05e0: 0a 3b 3b 20 7d 7d 7d 0a 0a 29 0a .;; }}}..).