1 2(********************************************************************) 3(* *) 4(* gtksvtst.sd7 Gtk-server connection test program *) 5(* Copyright (C) 2007 Leonardo Cecchi *) 6(* *) 7(* This program is free software; you can redistribute it and/or *) 8(* modify it under the terms of the GNU General Public License as *) 9(* published by the Free Software Foundation; either version 2 of *) 10(* the License, or (at your option) any later version. *) 11(* *) 12(* This program is distributed in the hope that it will be useful, *) 13(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 14(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 15(* GNU General Public License for more details. *) 16(* *) 17(* You should have received a copy of the GNU General Public *) 18(* License along with this program; if not, write to the *) 19(* Free Software Foundation, Inc., 51 Franklin Street, *) 20(* Fifth Floor, Boston, MA 02110-1301, USA. *) 21(* *) 22(********************************************************************) 23 24 25$ include "seed7_05.s7i"; 26 include "enable_io.s7i"; 27 include "socket.s7i"; 28 include "gtkserver.s7i"; 29 30const proc: show_message(in string: parent, in string: msg) is func 31 local 32 (* widgets *) 33 var string: id is ""; 34 begin 35 id:=gtk("gtk_message_dialog_new " <& parent <& " 0 0 1 \"" <& msg <& "\""); 36 gtk_exec("gtk_dialog_run " <& id); 37 gtk_exec("gtk_widget_destroy " <& id); 38 end func; 39 40const proc: main_window is func 41 local 42 (* widgets *) 43 var string: wptr is ""; 44 var string: vbox is ""; 45 var string: bt_one is ""; 46 var string: bt_two is ""; 47 48 (* temporary *) 49 var boolean: running is TRUE; 50 var string: evt is ""; 51 begin 52 wptr:=gtk("gtk_window_new 0"); 53 gtk_exec("gtk_window_set_title " <& wptr <& " \"Gtk-Server Example\""); 54 55 (* Widgets creation *) 56 vbox:=gtk("gtk_vbox_new 1 1"); 57 bt_one:=gtk("gtk_button_new_with_label \"First Button\""); 58 bt_two:=gtk("gtk_button_new_with_label \"Second Button\""); 59 60 (* Widgets packing *) 61 gtk_exec("gtk_box_pack_start_defaults " <& vbox <& " " <& bt_one); 62 gtk_exec("gtk_box_pack_start_defaults " <& vbox <& " " <& bt_two); 63 gtk_exec("gtk_container_add " <& wptr <& " " <& vbox); 64 65 (* Show window *) 66 gtk_exec("gtk_widget_show_all " <& wptr); 67 68 (* Event loop *) 69 while running do 70 evt:=gtk("gtk_server_callback WAIT"); 71 if evt=wptr then 72 running:=FALSE; 73 elsif evt=bt_one then 74 show_message(wptr, "One!"); 75 elsif evt=bt_two then 76 show_message(wptr, "Two!"); 77 end if; 78 end while; 79 end func; 80 81const proc: main is func 82 local 83 var string: win is ""; 84 var string: but is ""; 85 var string: evt is ""; 86 begin 87 set_gtk_logging(FALSE); 88 gtk_start(8765); 89 gtk_exec("gtk_init NULL NULL"); 90 main_window(); 91 gtk_stop(); 92 end func; 93 94