Changeset 25748 in project
- Timestamp:
- 01/02/12 14:05:59 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
wiki/iup-tutor
r25662 r25748 895 895 </enscript> 896 896 897 === Some other examples 898 899 The following examples are a bit more involved. The first implements a 900 primitive but fully functional web browser, the other a quick and dirty 901 class inspector. 902 903 ==== webbrowser.scm 904 905 Now an example which shows how mighty iup-web is, a Chicken 906 implementation of the webkit engine. With some lines of code we can 907 write a fully functional webbrowser. But there is one caveat with it: 908 For reasons I don't understand, the program will crash unless you load 909 libiupweb.so via the LD_PRELOAD environment variable. 910 911 <enscript highlight="scheme"> 912 913 (use iup iup-web data-structures) 914 915 ;;; webbrowser callbacks 916 917 (define (on-history self) 918 (let ( 919 (back (attribute (handle-ref "dlg-web") backcount:)) 920 (fwrd (attribute (handle-ref "dlg-web") forwardcount:)) 921 ) 922 (print "History items") 923 (let loop ((i (if (string? back) (- (string->number back)) 0))) 924 (unless (zero? i) 925 (printf "Backward ~a: ~a~%" 926 i (attribute (handle-ref "dlg-web") 927 (string->keyword (sprintf "itemhistory~a" i)))) 928 (loop (+ i 1)))) 929 (printf "Current ~a: ~a~%" 930 0 (attribute (handle-ref "dlg-web") itemhistory0:)) 931 (let ((fwd (if (string? fwrd) (string->number fwrd) 0))) 932 (let loop ((i 1)) 933 (unless (> i fwd) 934 (printf "Forward ~a: ~a~%" 935 i (attribute (handle-ref "dlg-web") 936 (string->keyword (sprintf "itemhistory~a" i)))) 937 (loop (+ i 1))))) 938 'default)) 939 940 (define (on-navigation self url) 941 (print "web-browser navigate-cb: url " url) 942 (if (substring-index "download" url) 943 'ignore 944 'default)) 945 946 (define (on-error self url) 947 (print "web-browser error-cb: url " url) 948 'default) 949 950 (define (on-completion self); url) 951 (print "web-browser completed-cb: value: " (attribute self value:)); url) 952 (attribute-set! (handle-ref "dlg-listbox") insertitem1: 953 (attribute self value:)) 954 (attribute-set! (handle-ref "dlg-listbox") value: 955 (attribute self value:)) 956 'default) 957 ; note, that the documentation required two arguments, but the attribute 958 ; completed-cb: accepted only one. 959 960 (define (on-newwindow self url) 961 (print "web-browser newwindow-cb: url " url) 962 (attribute-set! self value: url) 963 'default) 964 965 ;;; button callbacks 966 967 (define (on-back self) 968 (attribute-set! (handle-ref "dlg-web") backforward: -1) 969 'default) 970 971 (define (on-forward self) 972 (attribute-set! (handle-ref "dlg-web") backforward: 1) 973 'default) 974 975 (define (on-stop self) 976 (attribute-set! (handle-ref "dlg-web") stop: 'no) 977 'default) 978 979 (define (on-reload self) 980 (attribute-set! (handle-ref "dlg-web") reload: 'no) 981 'default) 982 983 (define (on-load self) 984 (attribute-set! (handle-ref "dlg-web") value: 985 (attribute (handle-ref "dlg-listbox") value:)) 986 'default) 987 988 (define (on-search self) 989 (attribute-set! (handle-ref "dlg-web") value: 990 "https://eu.ixquick.com") 991 'default) 992 993 (define (on-home self) 994 (attribute-set! (handle-ref "dlg-web") value: 995 "http://www.call-cc.org") 996 'default) 997 998 ;;; listbox callbacks 999 1000 (define (on-valuechanged self) 1001 (print "listbox valuechanged-cb: value: "(attribute self value:)) 1002 (attribute-set! (handle-ref "dlg-web") value: 1003 (attribute self value:)) 1004 'default) 1005 1006 (define (on-dropdown self state) 1007 (print "listbox dropdown-cb: state " state " value: " (attribute self value:)) 1008 'default) 1009 1010 (define (on-action self text item state) 1011 (print "listbox action: text " text " item " item " state " state) 1012 (if (= state 1) 1013 (attribute-set! (handle-ref "dlg-web") value: text)) 1014 'default) 1015 1016 (define (on-key self key) 1017 (print "listbox k-any: key " key) 1018 (if (= key (char->integer #\return)) 1019 (attribute-set! (handle-ref "dlg-web") value: 1020 (attribute self value:))) 1021 'continue) 1022 1023 ;;;;;;;;;;;;;;;;; WebBrowserTest 1024 1025 ;(define dlg-textbox 1026 ; (textbox value: "http://wiki.call-cc.org";www.tecgraf.puc-rio.br/iup" 1027 ; expand: 'horizontal)) 1028 ;(handle-name-set! dlg-textbox "dlg-textbox") 1029 1030 (define dlg-listbox 1031 (listbox value: "http://www.tecgraf.puc-rio.br/iup";call-cc.org" 1032 expand: 'horizontal 1033 dropdown: 'yes 1034 editbox: 'yes 1035 #:1 "http://api.call-cc.org" 1036 action: on-action 1037 k-any: on-key 1038 dropdown-cb: on-dropdown 1039 ;valuechanged-cb: on-valuechanged 1040 ;edit-cb: on-edit 1041 )) 1042 (handle-name-set! dlg-listbox "dlg-listbox") 1043 1044 (define dlg-web 1045 (web-browser value: (attribute dlg-listbox value:) 1046 ;value: (attribute dlg-textbox value:) 1047 newwindow-cb: on-newwindow 1048 navigate-cb: on-navigation 1049 error-cb: on-error 1050 completed-cb: on-completion)) 1051 ;(lambda (self) 1052 ; (on-completion self (attribute self value:))))) 1053 ; ;; wrapper replaces the C typecast (Icallback) 1054 (handle-name-set! dlg-web "dlg-web") 1055 1056 (define dlg 1057 (dialog 1058 (vbox 1059 (hbox 1060 (button "&Home" action: on-home) 1061 (button "&Back" action: on-back) 1062 (button "&Forward" action: on-forward) 1063 (button "&Load" action: on-load) 1064 (button "&Reload" action: on-reload) 1065 (button "S&top" action: on-stop) 1066 (button "H&istory" action: on-history) 1067 (button "&Search" action: on-search) 1068 (fill) 1069 (button "E&xit" action: (lambda (self) 'close)) 1070 ) 1071 dlg-listbox 1072 dlg-web) 1073 rastersize: '800x600 1074 title: 'WebBrowser)) 1075 ;defaultenter: btn-load 1076 ;margin: '10x10 1077 ;gap: 10)) 1078 1079 (show dlg) 1080 (main-loop) 1081 (destroy! dlg) 1082 (exit 0) 1083 1084 </enscript> 1085 1086 ==== inspector.scm 1087 1088 The last example is an utility to help with development. When writing an 1089 Iup application, you have always the problem, that you don't know in 1090 advance, what are the available widgets and what are the registered 1091 attributes and callbacks of each widget. To help with problems like this 1092 you can, of course, study the original documentation, and as a method of 1093 last resort you have to do that. But for a quick overview you can start 1094 the program "inspector" below. You must compile it, because it ports the 1095 C-function IupElementPropertiesDialog to Chicken. This function is 1096 originally intended as an object inspector. We use it on the most 1097 primitive instantiation of each class. 1098 1099 I know, that in the real world, C-functions and Scheme functions 1100 shouldn't reside in the same module. Besides that, the inspector is 1101 rather ugly. But that's not important here. 1102 1103 <enscript highlight="scheme"> 1104 1105 (require-library iup-base iup-controls iup-dialogs iup-web iup-pplot 1106 iup-glcanvas) 1107 1108 (import foreign iup-base iup-controls iup-dialogs iup-web iup-pplot 1109 iup-glcanvas) 1110 1111 (foreign-declare 1112 "#include <iup.h>\n") 1113 1114 (define-foreign-type nonnull-ihandle (nonnull-c-pointer "Ihandle") 1115 (ihandle->pointer #t) 1116 (pointer->ihandle #t)) 1117 1118 (define element-properties-dialog 1119 (make-constructor-procedure 1120 (foreign-lambda nonnull-ihandle "IupElementPropertiesDialog" 1121 nonnull-ihandle))) 1122 1123 (define (popup dlg . args) 1124 (apply show dlg #:modal? 'yes args) 1125 (destroy! dlg)) 1126 1127 (define (properties ih) 1128 (popup (element-properties-dialog ih)) 1129 'default) 1130 1131 (define dlg 1132 (dialog 1133 (vbox 1134 (hbox ; headline 1135 (fill) 1136 (frame (label " Inspect control and dialog classes " 1137 fontsize: 15)) 1138 (fill) 1139 margin: '0x0) 1140 1141 (label "") 1142 (label "Dialogs" fontsize: 12) 1143 (hbox 1144 (button "dialog" 1145 action: (lambda (self) (properties (dialog (vbox))))) 1146 (button "color-dialog" 1147 action: (lambda (self) (properties (color-dialog)))) 1148 (button "file-dialog" 1149 action: (lambda (self) (properties (file-dialog)))) 1150 (button "font-dialog" 1151 action: (lambda (self) (properties (font-dialog)))) 1152 (button "message-dialog" 1153 action: (lambda (self) (properties (message-dialog)))) 1154 (fill) 1155 margin: '0x0) 1156 1157 (label "") 1158 (label "Composition widgets" fontsize: 12) 1159 (hbox 1160 (button "fill" 1161 action: (lambda (self) (properties (fill)))) 1162 (button "hbox" 1163 action: (lambda (self) (properties (hbox)))) 1164 (button "vbox" 1165 action: (lambda (self) (properties (vbox)))) 1166 (button "zbox" 1167 action: (lambda (self) (properties (zbox)))) 1168 (button "radio" 1169 action: (lambda (self) (properties (radio (vbox))))) 1170 (button "normalizer" 1171 action: (lambda (self) (properties (normalizer)))) 1172 (button "cbox" 1173 action: (lambda (self) (properties (cbox)))) 1174 (button "sbox" 1175 action: (lambda (self) (properties (sbox (vbox))))) 1176 (button "split" 1177 action: (lambda (self) (properties (split (vbox) (vbox))))) 1178 (fill) 1179 margin: '0x0) 1180 1181 (label "") 1182 (label "Standard widgets" fontsize: 12) 1183 (hbox 1184 (button "button" 1185 action: (lambda (self) (properties (button)))) 1186 (button "canvas" 1187 action: (lambda (self) (properties (canvas)))) 1188 (button "frame" 1189 action: (lambda (self) (properties (frame)))) 1190 (button "label" 1191 action: (lambda (self) (properties (label)))) 1192 (button "listbox" 1193 action: (lambda (self) (properties (listbox)))) 1194 (button "progress-bar" 1195 action: (lambda (self) (properties (progress-bar)))) 1196 (button "spin" 1197 action: (lambda (self) (properties (spin)))) 1198 (fill) 1199 margin: '0x0) 1200 (hbox 1201 (button "tabs" 1202 action: (lambda (self) (properties (tabs)))) 1203 (button "textbox" 1204 action: (lambda (self) (properties (textbox)))) 1205 (button "toggle" 1206 action: (lambda (self) (properties (toggle)))) 1207 (button "treebox" 1208 action: (lambda (self) (properties (treebox)))) 1209 (button "valuator" 1210 action: (lambda (self) (properties (valuator "")))) 1211 (fill) 1212 margin: '0x0) 1213 1214 (label "") 1215 (label "Additional widgets" fontsize: 12) 1216 (hbox 1217 (button "cells" 1218 action: (lambda (self) (properties (cells)))) 1219 (button "color-bar" 1220 action: (lambda (self) (properties (color-bar)))) 1221 (button "color-browser" 1222 action: (lambda (self) (properties (color-browser)))) 1223 (button "dial" 1224 action: (lambda (self) (properties (dial "")))) 1225 (button "matrix" 1226 action: (lambda (self) (properties (matrix)))) 1227 (button "pplot" 1228 action: (lambda (self) (properties (pplot)))) 1229 (button "glcanvas" 1230 action: (lambda (self) (properties (glcanvas)))) 1231 (button "web-browser" 1232 action: (lambda (self) (properties (web-browser)))) 1233 (fill) 1234 margin: '0x0) 1235 1236 (label "") 1237 (label "Menu widgets" fontsize: 12) 1238 (hbox 1239 (button "menu" 1240 action: (lambda (self) (properties (menu)))) 1241 (button "menu-item" 1242 action: (lambda (self) (properties (menu-item)))) 1243 (button "menu-separator" 1244 action: (lambda (self) (properties (menu-separator)))) 1245 (fill) 1246 margin: '0x0) 1247 1248 (label "") 1249 (label "Other widgets" fontsize: 12) 1250 (hbox 1251 (button "clipboard" 1252 action: (lambda (self) (properties (clipboard)))) 1253 (button "timer" 1254 action: (lambda (self) (properties (timer)))) 1255 (button "spinbox" 1256 action: (lambda (self) (properties (spinbox (vbox))))) 1257 (fill) 1258 margin: '0x0) 1259 1260 (fill) 1261 (button "E&xit" 1262 expand: 'horizontal 1263 action: (lambda (self) 'close)) 1264 ) 1265 margin: '15x15 1266 title: "Iup inspector")) 1267 1268 (show dlg) 1269 (main-loop) 1270 (exit 0) 1271 1272 </enscript> 1273 1274 When you compile this program and use it, you will note, that some 1275 attributes can be inherited. That means, that all children of an object 1276 inherit those attributes. To override this, you must set those 1277 attributes in the children anew (look at the margin: attribute above). 1278 Moreover, you'll notice that there are tabs not only on attributes and 1279 callbacks, but on a hash-table as well. This is how Iup handles class 1280 extension. If you want a widget to have an attribute "foo", you can 1281 simply use (attribute-set! widget "foo" "value"). Those hash-table 1282 attributes are inherited as well. By the way, you are not obliged, to 1283 use strings only in their definition. 1284 897 1285 === Concluding remark 898 1286 … … 909 1297 == Last updated 910 1298 911 Dec 04, 2011 1299 Jan 02, 2012
Note: See TracChangeset
for help on using the changeset viewer.