]> mj.ucw.cz Git - moe.git/blob - submit/gtktest.pl
Added a trivial testing utility for perl-gtk.
[moe.git] / submit / gtktest.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Gtk2 -init;
7
8 sub timer {
9         print STDERR "Brum!\n";
10         return 1;
11 }
12 Glib::Timeout->add(5000, \&timer);
13
14 my $window = Gtk2::Window->new ('toplevel');
15
16 my $b1 = Gtk2::Button->new ('Quit');
17 $b1->signal_connect (clicked => sub { Gtk2->main_quit });
18 my $b2 = Gtk2::Button->new ('Exit');
19 $b2->signal_connect (clicked => sub { Gtk2->main_quit });
20 my $b3 = Gtk2::Button->new ('Apage!');
21 $b3->signal_connect (clicked => sub { Gtk2->main_quit });
22 my $box = Gtk2::HBox->new();
23 $box->pack_start_defaults($b1);
24 $box->pack_start_defaults($b2);
25 $box->pack_start_defaults($b3);
26
27 my $bb = Gtk2::Button->new ('Brum!');
28 $bb->signal_connect (clicked => sub {
29                 my $dialog = Gtk2::MessageDialog->new($window, [qw/modal destroy-with-parent/], 'question', 'ok-cancel', "So what?");
30                 $dialog->set_default_response("ok");
31                 $dialog->signal_connect (response => sub { $_[0]->destroy });
32                 $dialog->show_all;
33         });
34
35 my $store = Gtk2::ListStore->new('Glib::Uint', 'Glib::String');
36 for (my $i=0; $i<10; $i++) {
37         my $iter = $store->append;
38         $store->set($iter, 0, $i, 1, "Hey ($i)");
39 }
40
41 my $tree = Gtk2::TreeView->new($store);
42 my $rend = Gtk2::CellRendererText->new;
43 my $col = Gtk2::TreeViewColumn->new_with_attributes("Int", $rend, "text", 0);
44 $tree->append_column($col);
45 $col = Gtk2::TreeViewColumn->new_with_attributes("String", $rend, "text", 1);
46 $tree->append_column($col);
47
48 my $sel = $tree->get_selection;
49 $sel->set_mode('single');
50 $sel->signal_connect(changed => sub {
51         my $iter = $_[0]->get_selected;
52         my $val = $store->get($iter, 0);
53         print "Selected $val\n";
54         });
55
56 my $lay = Gtk2::ScrolledWindow->new;
57 $lay->set_policy("automatic", "automatic");
58 $lay->add($tree);
59
60 my $lab = Gtk2::Label->new;
61 $lab->set_markup("<span size='x-large'>Welcome to the Cave</span>");
62
63 my $bbox = Gtk2::VBox->new();
64 $bbox->pack_start_defaults($lab);
65 $bbox->pack_start_defaults($box);
66 $bbox->pack_start_defaults($lay);
67 $bbox->pack_start_defaults($bb);
68
69 $window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
70 $window->set ("title" => "Brum");
71 $window->add ($bbox);
72 $window->show_all;
73 Gtk2->main;