Artifact
9d6827e080de98985970567dbdbd1b726ec7a3ee:
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 69 75 70 2e 68 "#include <iup.h
0060: 3e 5c 6e 22 0a 09 22 23 69 6e 63 6c 75 64 65 20 >\n".."#include
0070: 3c 69 75 70 63 6f 6e 74 72 6f 6c 73 2e 68 3e 5c <iupcontrols.h>\
0080: 6e 22 29 0a 09 0a 28 69 6e 63 6c 75 64 65 20 22 n")...(include "
0090: 69 75 70 2d 74 79 70 65 73 2e 73 63 6d 22 29 0a iup-types.scm").
00a0: 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 .;; }}}..;; {{{
00b0: 53 74 61 6e 64 61 72 64 20 63 6f 6e 74 72 6f 6c Standard control
00c0: 73 0a 0a 28 64 65 66 69 6e 65 20 63 61 6e 76 61 s..(define canva
00d0: 73 0a 09 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 75 s..(make-constru
00e0: 63 74 6f 72 2d 70 72 6f 63 65 64 75 72 65 0a 09 ctor-procedure..
00f0: 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 .(foreign-lambda
0100: 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 nonnull-ihandle
0110: 20 22 49 75 70 43 61 6e 76 61 73 22 20 69 6e 61 "IupCanvas" ina
0120: 6d 65 2f 75 70 63 61 73 65 29 0a 09 09 23 3a 61 me/upcase)...#:a
0130: 70 70 6c 79 2d 61 72 67 73 20 28 6f 70 74 69 6f pply-args (optio
0140: 6e 61 6c 2d 61 72 67 73 20 5b 61 63 74 69 6f 6e nal-args [action
0150: 20 23 66 5d 29 29 29 0a 0a 28 64 65 66 69 6e 65 #f])))..(define
0160: 20 66 72 61 6d 65 0a 09 28 6d 61 6b 65 2d 63 6f frame..(make-co
0170: 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 nstructor-proced
0180: 75 72 65 0a 09 09 28 66 6f 72 65 69 67 6e 2d 6c ure...(foreign-l
0190: 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 ambda nonnull-ih
01a0: 61 6e 64 6c 65 20 22 49 75 70 46 72 61 6d 65 22 andle "IupFrame"
01b0: 20 69 68 61 6e 64 6c 65 29 0a 09 09 23 3a 61 70 ihandle)...#:ap
01c0: 70 6c 79 2d 61 72 67 73 20 28 6f 70 74 69 6f 6e ply-args (option
01d0: 61 6c 2d 61 72 67 73 20 5b 61 63 74 69 6f 6e 20 al-args [action
01e0: 23 66 5d 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 #f])))..(define
01f0: 74 61 62 73 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e tabs. (make-con
0200: 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 structor-procedu
0210: 72 65 0a 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c re. .(foreign-l
0220: 61 6d 62 64 61 2a 20 6e 6f 6e 6e 75 6c 6c 2d 69 ambda* nonnull-i
0230: 68 61 6e 64 6c 65 20 28 5b 69 68 61 6e 64 6c 65 handle ([ihandle
0240: 2d 6c 69 73 74 20 68 61 6e 64 6c 65 73 5d 29 0a -list handles]).
0250: 20 20 09 09 22 43 5f 72 65 74 75 72 6e 28 49 75 .."C_return(Iu
0260: 70 54 61 62 73 76 28 28 49 68 61 6e 64 6c 65 20 pTabsv((Ihandle
0270: 2a 2a 29 68 61 6e 64 6c 65 73 29 29 3b 22 29 0a **)handles));").
0280: 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 .#:apply-args
0290: 6c 69 73 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 list))..(define
02a0: 6c 61 62 65 6c 0a 20 20 28 6d 61 6b 65 2d 63 6f label. (make-co
02b0: 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 nstructor-proced
02c0: 75 72 65 0a 20 20 09 28 66 6f 72 65 69 67 6e 2d ure. .(foreign-
02d0: 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 lambda nonnull-i
02e0: 68 61 6e 64 6c 65 20 22 49 75 70 4c 61 62 65 6c handle "IupLabel
02f0: 22 20 63 2d 73 74 72 69 6e 67 29 0a 20 20 09 23 " c-string). .#
0300: 3a 61 70 70 6c 79 2d 61 72 67 73 20 28 6f 70 74 :apply-args (opt
0310: 69 6f 6e 61 6c 2d 61 72 67 73 20 5b 61 63 74 69 ional-args [acti
0320: 6f 6e 20 23 66 5d 29 29 29 0a 0a 28 64 65 66 69 on #f])))..(defi
0330: 6e 65 20 62 75 74 74 6f 6e 0a 20 20 28 6d 61 6b ne button. (mak
0340: 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 e-constructor-pr
0350: 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 ocedure. .(fore
0360: 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 ign-lambda nonnu
0370: 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 42 ll-ihandle "IupB
0380: 75 74 74 6f 6e 22 20 63 2d 73 74 72 69 6e 67 20 utton" c-string
0390: 69 6e 61 6d 65 2f 75 70 63 61 73 65 29 0a 20 20 iname/upcase).
03a0: 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 28 6f .#:apply-args (o
03b0: 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b 74 69 ptional-args [ti
03c0: 74 6c 65 20 23 66 5d 20 5b 61 63 74 69 6f 6e 20 tle #f] [action
03d0: 23 66 5d 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 #f])))..(define
03e0: 74 6f 67 67 6c 65 0a 20 20 28 6d 61 6b 65 2d 63 toggle. (make-c
03f0: 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 onstructor-proce
0400: 64 75 72 65 0a 20 20 09 28 66 6f 72 65 69 67 6e dure. .(foreign
0410: 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d -lambda nonnull-
0420: 69 68 61 6e 64 6c 65 20 22 49 75 70 54 6f 67 67 ihandle "IupTogg
0430: 6c 65 22 20 63 2d 73 74 72 69 6e 67 20 69 6e 61 le" c-string ina
0440: 6d 65 2f 75 70 63 61 73 65 29 0a 20 20 09 23 3a me/upcase). .#:
0450: 61 70 70 6c 79 2d 61 72 67 73 20 28 6f 70 74 69 apply-args (opti
0460: 6f 6e 61 6c 2d 61 72 67 73 20 5b 74 69 74 6c 65 onal-args [title
0470: 20 23 66 5d 20 5b 61 63 74 69 6f 6e 20 23 66 5d #f] [action #f]
0480: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 73 70 69 )))..(define spi
0490: 6e 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 n. (make-constr
04a0: 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 72 65 0a uctor-procedure.
04b0: 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 .(foreign-lamb
04c0: 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 da nonnull-ihand
04d0: 6c 65 20 22 49 75 70 53 70 69 6e 22 29 29 29 0a le "IupSpin"))).
04e0: 0a 28 64 65 66 69 6e 65 20 73 70 69 6e 62 6f 78 .(define spinbox
04f0: 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 75 . (make-constru
0500: 63 74 6f 72 2d 70 72 6f 63 65 64 75 72 65 0a 20 ctor-procedure.
0510: 20 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 .(foreign-lambd
0520: 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c a nonnull-ihandl
0530: 65 20 22 49 75 70 53 70 69 6e 62 6f 78 22 20 69 e "IupSpinbox" i
0540: 68 61 6e 64 6c 65 29 29 29 0a 0a 28 64 65 66 69 handle)))..(defi
0550: 6e 65 20 76 61 6c 75 61 74 6f 72 0a 20 20 28 6d ne valuator. (m
0560: 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d ake-constructor-
0570: 70 72 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f procedure. .(fo
0580: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e reign-lambda non
0590: 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 null-ihandle "Iu
05a0: 70 56 61 6c 22 20 63 2d 73 74 72 69 6e 67 29 0a pVal" c-string).
05b0: 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 .#:apply-args
05c0: 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b (optional-args [
05d0: 74 79 70 65 20 22 48 4f 52 49 5a 4f 4e 54 41 4c type "HORIZONTAL
05e0: 22 5d 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 74 "])))..(define t
05f0: 65 78 74 62 6f 78 0a 20 20 28 6d 61 6b 65 2d 63 extbox. (make-c
0600: 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 onstructor-proce
0610: 64 75 72 65 0a 20 20 09 28 66 6f 72 65 69 67 6e dure. .(foreign
0620: 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d -lambda nonnull-
0630: 69 68 61 6e 64 6c 65 20 22 49 75 70 54 65 78 74 ihandle "IupText
0640: 22 20 69 6e 61 6d 65 2f 75 70 63 61 73 65 29 0a " iname/upcase).
0650: 20 20 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 .#:apply-args
0660: 28 6f 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b (optional-args [
0670: 61 63 74 69 6f 6e 20 23 66 5d 29 29 29 0a 0a 28 action #f])))..(
0680: 64 65 66 69 6e 65 20 6c 69 73 74 62 6f 78 0a 20 define listbox.
0690: 20 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 (make-construct
06a0: 6f 72 2d 70 72 6f 63 65 64 75 72 65 0a 20 20 09 or-procedure. .
06b0: 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 (foreign-lambda
06c0: 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 nonnull-ihandle
06d0: 22 49 75 70 4c 69 73 74 22 20 69 6e 61 6d 65 2f "IupList" iname/
06e0: 75 70 63 61 73 65 29 0a 20 20 09 23 3a 61 70 70 upcase). .#:app
06f0: 6c 79 2d 61 72 67 73 20 28 6f 70 74 69 6f 6e 61 ly-args (optiona
0700: 6c 2d 61 72 67 73 20 5b 61 63 74 69 6f 6e 20 23 l-args [action #
0710: 66 5d 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 74 f])))..(define t
0720: 72 65 65 62 6f 78 0a 20 20 28 6d 61 6b 65 2d 63 reebox. (make-c
0730: 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 onstructor-proce
0740: 64 75 72 65 0a 20 20 09 28 66 6f 72 65 69 67 6e dure. .(foreign
0750: 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d -lambda nonnull-
0760: 69 68 61 6e 64 6c 65 20 22 49 75 70 54 72 65 65 ihandle "IupTree
0770: 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 70 72 ")))..(define pr
0780: 6f 67 72 65 73 73 2d 62 61 72 0a 20 20 28 6d 61 ogress-bar. (ma
0790: 6b 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 ke-constructor-p
07a0: 72 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f 72 rocedure. .(for
07b0: 65 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e eign-lambda nonn
07c0: 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 ull-ihandle "Iup
07d0: 50 72 6f 67 72 65 73 73 42 61 72 22 29 29 29 0a ProgressBar"))).
07e0: 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 7b 7b 7b 20 .;; }}}..;; {{{
07f0: 45 78 74 65 6e 64 65 64 20 63 6f 6e 74 72 6f 6c Extended control
0800: 73 0a 0a 28 64 65 66 69 6e 65 20 6d 61 74 72 69 s..(define matri
0810: 78 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e 73 74 72 x. (make-constr
0820: 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 72 65 0a uctor-procedure.
0830: 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c 61 6d 62 .(foreign-lamb
0840: 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 61 6e 64 da nonnull-ihand
0850: 6c 65 20 22 49 75 70 4d 61 74 72 69 78 22 20 69 le "IupMatrix" i
0860: 6e 61 6d 65 2f 75 70 63 61 73 65 29 0a 20 20 09 name/upcase). .
0870: 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 28 6f 70 #:apply-args (op
0880: 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b 61 63 74 tional-args [act
0890: 69 6f 6e 20 23 66 5d 29 29 29 0a 0a 28 64 65 66 ion #f])))..(def
08a0: 69 6e 65 20 63 65 6c 6c 73 0a 20 20 28 6d 61 6b ine cells. (mak
08b0: 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 e-constructor-pr
08c0: 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 ocedure. .(fore
08d0: 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 ign-lambda nonnu
08e0: 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 43 ll-ihandle "IupC
08f0: 65 6c 6c 73 22 29 29 29 0a 0a 28 64 65 66 69 6e ells")))..(defin
0900: 65 20 63 6f 6c 6f 72 2d 62 61 72 0a 20 20 28 6d e color-bar. (m
0910: 61 6b 65 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d ake-constructor-
0920: 70 72 6f 63 65 64 75 72 65 0a 20 20 09 28 66 6f procedure. .(fo
0930: 72 65 69 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e reign-lambda non
0940: 6e 75 6c 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 null-ihandle "Iu
0950: 70 43 6f 6c 6f 72 62 61 72 22 29 29 29 0a 0a 28 pColorbar")))..(
0960: 64 65 66 69 6e 65 20 63 6f 6c 6f 72 2d 62 72 6f define color-bro
0970: 77 73 65 72 0a 20 20 28 6d 61 6b 65 2d 63 6f 6e wser. (make-con
0980: 73 74 72 75 63 74 6f 72 2d 70 72 6f 63 65 64 75 structor-procedu
0990: 72 65 0a 20 20 09 28 66 6f 72 65 69 67 6e 2d 6c re. .(foreign-l
09a0: 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c 6c 2d 69 68 ambda nonnull-ih
09b0: 61 6e 64 6c 65 20 22 49 75 70 43 6f 6c 6f 72 42 andle "IupColorB
09c0: 72 6f 77 73 65 72 22 29 29 29 0a 0a 28 64 65 66 rowser")))..(def
09d0: 69 6e 65 20 64 69 61 6c 0a 20 20 28 6d 61 6b 65 ine dial. (make
09e0: 2d 63 6f 6e 73 74 72 75 63 74 6f 72 2d 70 72 6f -constructor-pro
09f0: 63 65 64 75 72 65 0a 20 20 09 28 66 6f 72 65 69 cedure. .(forei
0a00: 67 6e 2d 6c 61 6d 62 64 61 20 6e 6f 6e 6e 75 6c gn-lambda nonnul
0a10: 6c 2d 69 68 61 6e 64 6c 65 20 22 49 75 70 44 69 l-ihandle "IupDi
0a20: 61 6c 22 20 63 2d 73 74 72 69 6e 67 29 0a 20 20 al" c-string).
0a30: 09 23 3a 61 70 70 6c 79 2d 61 72 67 73 20 28 6f .#:apply-args (o
0a40: 70 74 69 6f 6e 61 6c 2d 61 72 67 73 20 5b 74 79 ptional-args [ty
0a50: 70 65 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 5d pe "HORIZONTAL"]
0a60: 29 29 29 0a 0a 3b 3b 20 7d 7d 7d 0a 0a 3b 3b 20 )))..;; }}}..;;
0a70: 7b 7b 7b 20 4c 69 62 72 61 72 79 20 73 65 74 75 {{{ Library setu
0a80: 70 0a 0a 28 6c 65 74 20 28 5b 73 74 61 74 75 73 p..(let ([status
0a90: 20 28 66 6f 72 65 69 67 6e 2d 76 61 6c 75 65 20 (foreign-value
0aa0: 22 49 75 70 43 6f 6e 74 72 6f 6c 73 4f 70 65 6e "IupControlsOpen
0ab0: 28 29 22 20 69 73 74 61 74 75 73 29 5d 29 0a 09 ()" istatus)])..
0ac0: 28 63 61 73 65 20 73 74 61 74 75 73 0a 09 09 5b (case status...[
0ad0: 28 23 74 20 69 67 6e 6f 72 65 29 20 28 76 6f 69 (#t ignore) (voi
0ae0: 64 29 5d 0a 09 09 5b 65 6c 73 65 20 20 20 20 20 d)]...[else
0af0: 20 20 20 28 65 72 72 6f 72 20 27 69 75 70 20 22 (error 'iup "
0b00: 66 61 69 6c 65 64 20 74 6f 20 69 6e 69 74 69 61 failed to initia
0b10: 6c 69 7a 65 20 6c 69 62 72 61 72 79 20 28 7e 73 lize library (~s
0b20: 29 22 20 73 74 61 74 75 73 29 5d 29 29 0a 0a 3b )" status)]))..;
0b30: 3b 20 7d 7d 7d 0a ; }}}.