Artifact
11955c7efc964c2d548713dc861251fc0a952208:
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 63 6f 6e 74 72 6f 6c 73 ule iup-controls
0030: 0a 09 28 63 61 6e 76 61 73 0a 09 20 66 72 61 6d ..(canvas.. fram
0040: 65 20 74 61 62 73 0a 09 20 6c 61 62 65 6c 20 62 e tabs.. label b
0050: 75 74 74 6f 6e 20 74 6f 67 67 6c 65 0a 09 20 73 utton toggle.. s
0060: 70 69 6e 20 73 70 69 6e 62 6f 78 20 76 61 6c 75 pin spinbox valu
0070: 61 74 6f 72 0a 09 20 74 65 78 74 62 6f 78 20 6c ator.. textbox l
0080: 69 73 74 62 6f 78 20 74 72 65 65 62 6f 78 0a 09 istbox treebox..
0090: 20 70 72 6f 67 72 65 73 73 2d 62 61 72 0a 09 20 progress-bar..
00a0: 6d 61 74 72 69 78 20 63 65 6c 6c 73 0a 09 20 63 matrix cells.. c
00b0: 6f 6c 6f 72 2d 62 61 72 20 63 6f 6c 6f 72 2d 62 olor-bar color-b
00c0: 72 6f 77 73 65 72 0a 09 20 64 69 61 6c 29 0a 09 rowser.. dial)..
00d0: 28 69 6d 70 6f 72 74 0a 09 09 73 63 68 65 6d 65 (import...scheme
00e0: 20 63 68 69 63 6b 65 6e 20 66 6f 72 65 69 67 6e chicken foreign
00f0: 0a 09 09 69 75 70 2d 62 61 73 65 29 0a 0a 3b 3b ...iup-base)..;;
0100: 20 7b 7b 7b 20 44 61 74 61 20 74 79 70 65 73 0a {{{ Data types.
0110: 0a 28 66 6f 72 65 69 67 6e 2d 64 65 63 6c 61 72 .(foreign-declar
0120: 65 0a 09 22 23 69 6e 63 6c 75 64 65 20 3c 69 75 e.."#include <iu
0130: 70 2e 68 3e 5c 6e 22 0a 09 22 23 69 6e 63 6c 75 p.h>\n".."#inclu
0140: 64 65 20 3c 69 75 70 63 6f 6e 74 72 6f 6c 73 2e de <iupcontrols.
0150: 68 3e 5c 6e 22 29 0a 09 0a 28 69 6e 63 6c 75 64 h>\n")...(includ
0160: 65 20 22 69 75 70 2d 74 79 70 65 73 2e 73 63 6d e "iup-types.scm
0170: 22 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b ")..;; }}}..;; {
0180: 7b 7b 20 53 74 61 6e 64 61 72 64 20 63 6f 6e 74 {{ Standard cont
0190: 72 6f 6c 73 0a 0a 28 64 65 66 69 6e 65 20 63 61 rols..(define ca
01a0: 6e 76 61 73 0a 09 28 6d 61 6b 65 2d 63 6f 6e 73 nvas..(make-cons
01b0: 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 72 tructor-procedur
01c0: 65 0a 09 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d e...(foreign-lam
01d0: 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e bda nonnull-ihan
01e0: 64 6c 65 20 22 49 75 70 43 61 6e 76 61 73 22 20 dle "IupCanvas"
01f0: 69 6e 61 6d 65 2f 75 70 63 61 73 65 29 0a 09 09 iname/upcase)...
0200: 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 28 6f 70 #:apply-args (op
0210: 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b 61 63 74 tional-args [act
0220: 69 6f 6e 20 23 66 5d 29 29 29 0a 0a 28 64 65 66 ion #f])))..(def
0230: 69 6e 65 20 66 72 61 6d 65 0a 09 28 6d 61 6b 65 ine frame..(make
0240: 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f -constructor-pro
0250: 63 65 64 75 72 65 0a 09 09 28 66 6f 72 65 69 67 cedure...(foreig
0260: 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c n-lambda nonnull
0270: 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 46 72 61 -ihandle "IupFra
0280: 6d 65 22 20 69 68 61 6e 64 6c 65 29 0a 09 09 23 me" ihandle)...#
0290: 3a 61 70 70 6c 79 2d 61 72 67 73 20 28 6f 70 74 :apply-args (opt
02a0: 69 6f 6e 61 6c 2d 61 72 67 73 20 5b 61 63 74 69 ional-args [acti
02b0: 6f 6e 20 23 66 5d 29 29 29 0a 0a 28 64 65 66 69 on #f])))..(defi
02c0: 6e 65 20 74 61 62 73 0a 20 20 28 6d 61 6b 65 2d ne tabs. (make-
02d0: 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 constructor-proc
02e0: 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 69 67 edure. .(foreig
02f0: 6e 2d 6c 61 6d 62 64 61 2a 20 6e 6f 6e 6e 75 6c n-lambda* nonnul
0300: 6c 2d 69 68 61 6e 64 6c 65 20 28 5b 69 68 61 6e l-ihandle ([ihan
0310: 64 6c 65 2d 6c 69 73 74 20 68 61 6e 64 6c 65 73 dle-list handles
0320: 5d 29 0a 20 20 09 09 22 43 5f 72 65 74 75 72 6e ]). .."C_return
0330: 28 49 75 70 54 61 62 73 76 28 28 49 68 61 6e 64 (IupTabsv((Ihand
0340: 6c 65 20 2a 2a 29 68 61 6e 64 6c 65 73 29 29 3b le **)handles));
0350: 22 29 0a 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 "). .#:apply-ar
0360: 67 73 20 6c 69 73 74 29 29 0a 0a 28 64 65 66 69 gs list))..(defi
0370: 6e 65 20 6c 61 62 65 6c 0a 20 20 28 6d 61 6b 65 ne label. (make
0380: 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f -constructor-pro
0390: 63 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 69 cedure. .(forei
03a0: 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c gn-lambda nonnul
03b0: 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 4c 61 l-ihandle "IupLa
03c0: 62 65 6c 22 20 63 2d 73 74 72 69 6e 67 29 0a 20 bel" c-string).
03d0: 20 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 28 .#:apply-args (
03e0: 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b 61 optional-args [a
03f0: 63 74 69 6f 6e 20 23 66 5d 29 29 29 0a 0a 28 64 ction #f])))..(d
0400: 65 66 69 6e 65 20 62 75 74 74 6f 6e 0a 20 20 28 efine button. (
0410: 6d 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 make-constructor
0420: 2d 70 72 6f 63 65 64 75 72 65 0a 20 20 09 28 66 -procedure. .(f
0430: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f oreign-lambda no
0440: 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 nnull-ihandle "I
0450: 75 70 42 75 74 74 6f 6e 22 20 63 2d 73 74 72 69 upButton" c-stri
0460: 6e 67 20 69 6e 61 6d 65 2f 75 70 63 61 73 65 29 ng iname/upcase)
0470: 0a 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 . .#:apply-args
0480: 20 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 (optional-args
0490: 5b 74 69 74 6c 65 20 23 66 5d 20 5b 61 63 74 69 [title #f] [acti
04a0: 6f 6e 20 23 66 5d 29 29 29 0a 0a 28 64 65 66 69 on #f])))..(defi
04b0: 6e 65 20 74 6f 67 67 6c 65 0a 20 20 28 6d 61 6b ne toggle. (mak
04c0: 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 e-constructor-pr
04d0: 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 ocedure. .(fore
04e0: 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 ign-lambda nonnu
04f0: 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 54 ll-ihandle "IupT
0500: 6f 67 67 6c 65 22 20 63 2d 73 74 72 69 6e 67 20 oggle" c-string
0510: 69 6e 61 6d 65 2f 75 70 63 61 73 65 29 0a 20 20 iname/upcase).
0520: 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 28 6f .#:apply-args (o
0530: 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b 74 69 ptional-args [ti
0540: 74 6c 65 20 23 66 5d 20 5b 61 63 74 69 6f 6e 20 tle #f] [action
0550: 23 66 5d 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 #f])))..(define
0560: 73 70 69 6e 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e spin. (make-con
0570: 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 structor-procedu
0580: 72 65 0a 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c re. .(foreign-l
0590: 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 ambda nonnull-ih
05a0: 61 6e 64 6c 65 20 22 49 75 70 53 70 69 6e 22 29 andle "IupSpin")
05b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 73 70 69 6e ))..(define spin
05c0: 62 6f 78 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e 73 box. (make-cons
05d0: 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 72 tructor-procedur
05e0: 65 0a 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c 61 e. .(foreign-la
05f0: 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 mbda nonnull-iha
0600: 6e 64 6c 65 20 22 49 75 70 53 70 69 6e 62 6f 78 ndle "IupSpinbox
0610: 22 20 69 68 61 6e 64 6c 65 29 29 29 0a 0a 28 64 " ihandle)))..(d
0620: 65 66 69 6e 65 20 76 61 6c 75 61 74 6f 72 0a 20 efine valuator.
0630: 20 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 (make-construct
0640: 6f 72 2d 70 72 6f 63 65 64 75 72 65 0a 20 20 09 or-procedure. .
0650: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 (foreign-lambda
0660: 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 nonnull-ihandle
0670: 22 49 75 70 56 61 6c 22 20 63 2d 73 74 72 69 6e "IupVal" c-strin
0680: 67 29 0a 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 g). .#:apply-ar
0690: 67 73 20 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 gs (optional-arg
06a0: 73 20 5b 74 79 70 65 20 22 48 4f 52 49 5a 4f 4e s [type "HORIZON
06b0: 54 41 4c 22 5d 29 29 29 0a 0a 28 64 65 66 69 6e TAL"])))..(defin
06c0: 65 20 74 65 78 74 62 6f 78 0a 20 20 28 6d 61 6b e textbox. (mak
06d0: 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 e-constructor-pr
06e0: 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 ocedure. .(fore
06f0: 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 ign-lambda nonnu
0700: 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 54 ll-ihandle "IupT
0710: 65 78 74 22 20 69 6e 61 6d 65 2f 75 70 63 61 73 ext" iname/upcas
0720: 65 29 0a 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 e). .#:apply-ar
0730: 67 73 20 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 gs (optional-arg
0740: 73 20 5b 61 63 74 69 6f 6e 20 23 66 5d 29 29 29 s [action #f])))
0750: 0a 0a 28 64 65 66 69 6e 65 20 6c 69 73 74 62 6f ..(define listbo
0760: 78 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 x. (make-constr
0770: 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 72 65 0a uctor-procedure.
0780: 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 .(foreign-lamb
0790: 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 da nonnull-ihand
07a0: 6c 65 20 22 49 75 70 4c 69 73 74 22 20 69 6e 61 le "IupList" ina
07b0: 6d 65 2f 75 70 63 61 73 65 29 0a 20 20 09 23 3a me/upcase). .#:
07c0: 61 70 70 6c 79 2d 61 72 67 73 20 28 6f 70 74 69 apply-args (opti
07d0: 6f 6e 61 6c 2d 61 72 67 73 20 5b 61 63 74 69 6f onal-args [actio
07e0: 6e 20 23 66 5d 29 29 29 0a 0a 28 64 65 66 69 6e n #f])))..(defin
07f0: 65 20 74 72 65 65 62 6f 78 0a 20 20 28 6d 61 6b e treebox. (mak
0800: 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 e-constructor-pr
0810: 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 ocedure. .(fore
0820: 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 ign-lambda nonnu
0830: 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 54 ll-ihandle "IupT
0840: 72 65 65 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 ree")))..(define
0850: 20 70 72 6f 67 72 65 73 73 2d 62 61 72 0a 20 20 progress-bar.
0860: 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 6f (make-constructo
0870: 72 2d 70 72 6f 63 65 64 75 72 65 0a 20 20 09 28 r-procedure. .(
0880: 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 6e foreign-lambda n
0890: 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 onnull-ihandle "
08a0: 49 75 70 50 72 6f 67 72 65 73 73 42 61 72 22 29 IupProgressBar")
08b0: 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b ))..;; }}}..;; {
08c0: 7b 7b 20 45 78 74 65 6e 64 65 64 20 63 6f 6e 74 {{ Extended cont
08d0: 72 6f 6c 73 0a 0a 28 64 65 66 69 6e 65 20 6d 61 rols..(define ma
08e0: 74 72 69 78 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e trix. (make-con
08f0: 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 structor-procedu
0900: 72 65 0a 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c re. .(foreign-l
0910: 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 ambda nonnull-ih
0920: 61 6e 64 6c 65 20 22 49 75 70 4d 61 74 72 69 78 andle "IupMatrix
0930: 22 20 69 6e 61 6d 65 2f 75 70 63 61 73 65 29 0a " iname/upcase).
0940: 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 .#:apply-args
0950: 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b (optional-args [
0960: 61 63 74 69 6f 6e 20 23 66 5d 29 29 29 0a 0a 28 action #f])))..(
0970: 64 65 66 69 6e 65 20 63 65 6c 6c 73 0a 20 20 28 define cells. (
0980: 6d 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 make-constructor
0990: 2d 70 72 6f 63 65 64 75 72 65 0a 20 20 09 28 66 -procedure. .(f
09a0: 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f oreign-lambda no
09b0: 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 nnull-ihandle "I
09c0: 75 70 43 65 6c 6c 73 22 29 29 29 0a 0a 28 64 65 upCells")))..(de
09d0: 66 69 6e 65 20 63 6f 6c 6f 72 2d 62 61 72 0a 20 fine color-bar.
09e0: 20 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 (make-construct
09f0: 6f 72 2d 70 72 6f 63 65 64 75 72 65 0a 20 20 09 or-procedure. .
0a00: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 (foreign-lambda
0a10: 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 nonnull-ihandle
0a20: 22 49 75 70 43 6f 6c 6f 72 62 61 72 22 29 29 29 "IupColorbar")))
0a30: 0a 0a 28 64 65 66 69 6e 65 20 63 6f 6c 6f 72 2d ..(define color-
0a40: 62 72 6f 77 73 65 72 0a 20 20 28 6d 61 6b 65 2d browser. (make-
0a50: 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 constructor-proc
0a60: 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 69 67 edure. .(foreig
0a70: 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c n-lambda nonnull
0a80: 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 43 6f 6c -ihandle "IupCol
0a90: 6f 72 42 72 6f 77 73 65 72 22 29 29 29 0a 0a 28 orBrowser")))..(
0aa0: 64 65 66 69 6e 65 20 64 69 61 6c 0a 20 20 28 6d define dial. (m
0ab0: 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d ake-constructor-
0ac0: 70 72 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f procedure. .(fo
0ad0: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e reign-lambda non
0ae0: 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 null-ihandle "Iu
0af0: 70 44 69 61 6c 22 20 63 2d 73 74 72 69 6e 67 29 pDial" c-string)
0b00: 0a 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 . .#:apply-args
0b10: 20 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 (optional-args
0b20: 5b 74 79 70 65 20 22 48 4f 52 49 5a 4f 4e 54 41 [type "HORIZONTA
0b30: 4c 22 5d 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a L"])))..;; }}}..
0b40: 3b 3b 20 7b 7b 7b 20 4c 69 62 72 61 72 79 20 73 ;; {{{ Library s
0b50: 65 74 75 70 0a 0a 28 6c 65 74 20 28 5b 73 74 61 etup..(let ([sta
0b60: 74 75 73 20 28 66 6f 72 65 69 67 6e 2d 76 61 6c tus (foreign-val
0b70: 75 65 20 22 49 75 70 43 6f 6e 74 72 6f 6c 73 4f ue "IupControlsO
0b80: 70 65 6e 28 29 22 20 69 73 74 61 74 75 73 29 5d pen()" istatus)]
0b90: 29 0a 09 28 63 61 73 65 20 73 74 61 74 75 73 0a )..(case status.
0ba0: 09 09 5b 28 23 74 20 69 67 6e 6f 72 65 29 20 28 ..[(#t ignore) (
0bb0: 76 6f 69 64 29 5d 0a 09 09 5b 65 6c 73 65 20 20 void)]...[else
0bc0: 20 20 20 20 20 20 28 65 72 72 6f 72 20 27 69 75 (error 'iu
0bd0: 70 20 22 66 61 69 6c 65 64 20 74 6f 20 69 6e 69 p "failed to ini
0be0: 74 69 61 6c 69 7a 65 20 6c 69 62 72 61 72 79 20 tialize library
0bf0: 28 7e 73 29 22 20 73 74 61 74 75 73 29 5d 29 29 (~s)" status)]))
0c00: 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 29 0a ..;; }}}..).