kgsueme/kgsueme/gtk.pl

package gtk;

use Carp;

our $text_renderer = new Gtk2::CellRendererText;
our $int_renderer  = new Gtk2::CellRendererText;
$int_renderer->set (xalign => 1);

our $state = $util::state->{gtk} ||= {};

# shows the properties of a glib object
sub info {
   my ($idx, $obj) = @_;
   return if $seen{$idx}++;
   print "\n$idx\n";
   for ($obj->list_properties) {
      printf "%-16s %-24s %-24s %s\n", $_->{name}, $_->{type}, (join ":", @{$_->{flags}}), $_->{descr};
   }
}

# grr... more gtk+ brokenness
my %get = (
   window_size     => sub { [ ($_[0]->allocation->values)[2,3] ] },
   #window_pos     => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
   column_size     => sub { $_[0]->get("width") || $_[0]->get("fixed_width") },
   clist_column_widths => sub {
      $_[0]{column_widths};
   },
);

my %set = (
   window_size     => sub { $_[0]->set_default_size(@{$_[1]}) },
   #window_pos     => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
   column_size     => sub { $_[0]->set(fixed_width => $_[1]) },
   clist_column_widths => sub {
      my ($w, $v) = @_;
      $v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
      $w->{column_widths} = $v;
      $w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
   },
);

my %widget;

sub state {
   my ($widget, $class, $instance, %attr) = @_;

   while (my ($k, $v) = each %attr) {
      my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
      $v = $state->{$class}{"*"}{$get}       if exists $state->{$class}{"*"} && exists $state->{$class}{"*"}{$get};
      $v = $state->{$class}{$instance}{$get} if defined $instance && exists $state->{$class}{$instance} && exists $state->{$class}{$instance}{$get};
      $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
   }

   $widget->signal_connect(destroy => sub { delete $widget{$widget}; 0 });

   $widget{$widget} = [$widget, $class, $instance, \%attr];
   Scalar::Util::weaken $widget{$widget}[0];
}

sub save_state {
   for (grep $_, values %widget) {
      my ($widget, $class, $instance, $attr) = @$_;

      $widget->realize if $widget->can("realize");

      while (my ($k, $v) = each %$attr) {
         my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
         $v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
         warn "got $widget -> $get => $v\n";

         $state->{$class}{"*"}{$get}       = $v;
         $state->{$class}{$instance}{$get} = $v if defined $instance;
      }
   }
}

# make a clist unselectable
sub clist_autosort {
   my $w = shift;
   my ($c, $o) = (-1);
   for (0..$w->columns-1) {
      $w->signal_connect(click_column => sub {
         if ($_[1] != $c) {
            $c = $_[1];
            $o = 0;
         } else {
            $o = !$o;
         }
         $w->set_sort_column($c);
         $w->set_sort_type($o ? "descending" : "ascending");
         $w->sort;
      });
   }
}

package gtk::widget;

# hacked gtk pseudo-widget

sub new {
   my $class = shift;
   bless { @_ }, $class;
}

sub widget { $_[0]{widget} }

sub AUTOLOAD {
   $AUTOLOAD =~ /::([^:]+)$/ or Carp::confess "$AUTOLOAD: no such method (illegal name)";
   ref $_[0]{widget} or Carp::confess "AUTOLOAD: non-method call $AUTOLOAD(@_)\n";
   my $method = $_[0]{widget}->can($1)
      or Carp::confess "$AUTOLOAD: no such method";
   # do NOT cache.. we are fats enough this way
   unshift @_, shift->{widget};
   &$method;
}

sub destroy {
   my ($self) = @_;
   for (keys %$self) {
      (delete $self->{$_})->destroy
         if UNIVERSAL::isa ($self->{$_}, Glib::Object) && $self->{$_}->can("destroy");
   }
}

sub DESTROY {
   my ($self) = @_;
}

package gtk::text;

use base gtk::widget;

sub new {
   my $class = shift;
   my $self = $class->SUPER::new(@_);

   $self->{buffer} = new Gtk2::TextBuffer undef;

   $self->{widget} = new_with_buffer Gtk2::TextView $self->{buffer};

   $self;
}

sub append_text {
   my ($self, $text) = @_;

   $self->{buffer}->insert ($self->{buffer}->get_end_iter, $text);
}

sub set_text {
   my ($self, $text) = @_;

   $self->{buffer}->set_text ("");
   $self->append_text ($text);
}

package gtk::userlist;

use base gtk::widget;

sub new {
   my $class = shift;
   my $self = $class->SUPER::new(@_);

   $self->{model} = new Gtk2::ListStore Glib::Scalar, Glib::String, Glib::String, Glib::Int, Glib::String;

   $self->{widget} = new Gtk2::TreeView $self->{model};

   $self->{widget}->set_search_column(1);

   my $column = $self->{rlcolumns}[0] =
      Gtk2::TreeViewColumn->new_with_attributes ("Name", $gtk::text_renderer, text => 1);
   $column->set_sort_column_id(1);
   $column->set(resizable => 1);
   $column->set(sizing => 'fixed');
   gtk::state $column, "userlist::model::Name", undef, column_size => 120;
   $self->{widget}->append_column ($column);

   my $column = $self->{rlcolumns}[1] =
      Gtk2::TreeViewColumn->new_with_attributes ("Rank", $gtk::text_renderer, text => 2);
   $column->set_sort_column_id(3);
   $column->set(resizable => 1);
   $column->set(sizing => 'fixed');
   gtk::state $column, "userlist::model::Rank", undef, column_size => 40;
   $self->{widget}->append_column ($column);

   my $column = $self->{rlcolumns}[2] =
      Gtk2::TreeViewColumn->new_with_attributes ("Flags", $gtk::text_renderer, text => 4);
   $column->set(resizable => 1);
   $column->set(sizing => 'fixed');
   gtk::state $column, "userlist::model::Flags", undef, column_size => 80;
   $self->{widget}->append_column ($column);

   $self->{widget}->signal_connect(row_activated => sub {
      my ($widget, $path, $column) = @_;
      my $user = $self->{model}->get ($self->{model}->get_iter ($path), 0);
      warn "selected user $user\n";
   });

   $self;
}

sub update {
   my ($self, $users) = @_;

   remove Glib::Source delete $self->{event_update} if $self->{event_update};
   $self->{event_update} ||= add Glib::Timeout 100, sub {
      my $l = $self->{model};

      $l->clear;

      for (values %$users) {
         $l->set ($l->append,
                      0, $_,
                      1, $_->{name},
                      2, $_->rank_string,
                      3, $_->rank,
                      4, "?");
      }

      delete $self->{event_update};
      0;
   };
}

1;

Revision:	1.5
Committed:	Sat May 31 13:58:32 2003 UTC (21 years ago) by pcg
Content type:	text/plain
Branch:	MAIN
Changes since 1.4:	+112 -27 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	pcg	1.1	package gtk;
2
3	pcg	1.3	use Carp;
4
5	pcg	1.1	our $text_renderer = new Gtk2::CellRendererText;
6			our $int_renderer = new Gtk2::CellRendererText;
7			$int_renderer->set (xalign => 1);
8
9	pcg	1.5	our $state = $util::state->{gtk} \|\|= {};
10	pcg	1.1
11			# shows the properties of a glib object
12	pcg	1.3	sub info {
13	pcg	1.1	my ($idx, $obj) = @_;
14	pcg	1.5	return if $seen{$idx}++;
15	pcg	1.1	print "\n$idx\n";
16			for ($obj->list_properties) {
17			printf "%-16s %-24s %-24s %s\n", $_->{name}, $_->{type}, (join ":", @{$_->{flags}}), $_->{descr};
18			}
19			}
20
21			# grr... more gtk+ brokenness
22			my %get = (
23			window_size => sub { [ ($_[0]->allocation->values)[2,3] ] },
24			#window_pos => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
25	pcg	1.5	column_size => sub { $_[0]->get("width") \|\| $_[0]->get("fixed_width") },
26	pcg	1.1	clist_column_widths => sub {
27			$_[0]{column_widths};
28			},
29			);
30
31			my %set = (
32	pcg	1.5	window_size => sub { $_[0]->set_default_size(@{$_[1]}) },
33	pcg	1.1	#window_pos => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
34	pcg	1.5	column_size => sub { $_[0]->set(fixed_width => $_[1]) },
35	pcg	1.1	clist_column_widths => sub {
36			my ($w, $v) = @_;
37			$v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
38			$w->{column_widths} = $v;
39			$w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
40			},
41			);
42
43	pcg	1.5	my %widget;
44
45	pcg	1.1	sub state {
46			my ($widget, $class, $instance, %attr) = @_;
47
48			while (my ($k, $v) = each %attr) {
49			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
50	pcg	1.5	$v = $state->{$class}{""}{$get} if exists $state->{$class}{""} && exists $state->{$class}{"*"}{$get};
51			$v = $state->{$class}{$instance}{$get} if defined $instance && exists $state->{$class}{$instance} && exists $state->{$class}{$instance}{$get};
52	pcg	1.1	$set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
53			}
54
55	pcg	1.5	$widget->signal_connect(destroy => sub { delete $widget{$widget}; 0 });
56	pcg	1.1
57	pcg	1.5	$widget{$widget} = [$widget, $class, $instance, \%attr];
58			Scalar::Util::weaken $widget{$widget}[0];
59	pcg	1.1	}
60
61			sub save_state {
62	pcg	1.5	for (grep $_, values %widget) {
63			my ($widget, $class, $instance, $attr) = @$_;
64
65			$widget->realize if $widget->can("realize");
66
67			while (my ($k, $v) = each %$attr) {
68			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
69			$v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
70			warn "got $widget -> $get => $v\n";
71
72			$state->{$class}{"*"}{$get} = $v;
73			$state->{$class}{$instance}{$get} = $v if defined $instance;
74	pcg	1.1	}
75			}
76			}
77
78			# make a clist unselectable
79			sub clist_autosort {
80			my $w = shift;
81			my ($c, $o) = (-1);
82			for (0..$w->columns-1) {
83			$w->signal_connect(click_column => sub {
84			if ($_[1] != $c) {
85			$c = $_[1];
86			$o = 0;
87			} else {
88			$o = !$o;
89			}
90			$w->set_sort_column($c);
91			$w->set_sort_type($o ? "descending" : "ascending");
92			$w->sort;
93			});
94			}
95	pcg	1.2	}
96
97			package gtk::widget;
98
99			# hacked gtk pseudo-widget
100
101	pcg	1.3	sub new {
102			my $class = shift;
103			bless { @_ }, $class;
104			}
105
106	pcg	1.2	sub widget { $_[0]{widget} }
107
108			sub AUTOLOAD {
109	pcg	1.3	$AUTOLOAD =~ /::([^:]+)$/ or Carp::confess "$AUTOLOAD: no such method (illegal name)";
110	pcg	1.5	ref $_[0]{widget} or Carp::confess "AUTOLOAD: non-method call $AUTOLOAD(@_)\n";
111	pcg	1.3	my $method = $_[0]{widget}->can($1)
112			or Carp::confess "$AUTOLOAD: no such method";
113			# do NOT cache.. we are fats enough this way
114			unshift @_, shift->{widget};
115			&$method;
116			}
117
118	pcg	1.5	sub destroy {
119			my ($self) = @_;
120			for (keys %$self) {
121			(delete $self->{$_})->destroy
122			if UNIVERSAL::isa ($self->{$_}, Glib::Object) && $self->{$_}->can("destroy");
123			}
124			}
125
126			sub DESTROY {
127			my ($self) = @_;
128			}
129
130	pcg	1.3	package gtk::text;
131
132			use base gtk::widget;
133
134			sub new {
135			my $class = shift;
136			my $self = $class->SUPER::new(@_);
137
138			$self->{buffer} = new Gtk2::TextBuffer undef;
139
140	pcg	1.5	$self->{widget} = new_with_buffer Gtk2::TextView $self->{buffer};
141	pcg	1.3
142			$self;
143			}
144
145	pcg	1.4	sub append_text {
146	pcg	1.5	my ($self, $text) = @_;
147
148			$self->{buffer}->insert ($self->{buffer}->get_end_iter, $text);
149	pcg	1.4	}
150
151	pcg	1.3	sub set_text {
152			my ($self, $text) = @_;
153	pcg	1.4
154	pcg	1.5	$self->{buffer}->set_text ("");
155			$self->append_text ($text);
156			}
157
158			package gtk::userlist;
159
160			use base gtk::widget;
161
162			sub new {
163			my $class = shift;
164			my $self = $class->SUPER::new(@_);
165
166			$self->{model} = new Gtk2::ListStore Glib::Scalar, Glib::String, Glib::String, Glib::Int, Glib::String;
167
168			$self->{widget} = new Gtk2::TreeView $self->{model};
169
170			$self->{widget}->set_search_column(1);
171
172			my $column = $self->{rlcolumns}[0] =
173			Gtk2::TreeViewColumn->new_with_attributes ("Name", $gtk::text_renderer, text => 1);
174			$column->set_sort_column_id(1);
175			$column->set(resizable => 1);
176			$column->set(sizing => 'fixed');
177			gtk::state $column, "userlist::model::Name", undef, column_size => 120;
178			$self->{widget}->append_column ($column);
179
180			my $column = $self->{rlcolumns}[1] =
181			Gtk2::TreeViewColumn->new_with_attributes ("Rank", $gtk::text_renderer, text => 2);
182			$column->set_sort_column_id(3);
183			$column->set(resizable => 1);
184			$column->set(sizing => 'fixed');
185			gtk::state $column, "userlist::model::Rank", undef, column_size => 40;
186			$self->{widget}->append_column ($column);
187
188			my $column = $self->{rlcolumns}[2] =
189			Gtk2::TreeViewColumn->new_with_attributes ("Flags", $gtk::text_renderer, text => 4);
190			$column->set(resizable => 1);
191			$column->set(sizing => 'fixed');
192			gtk::state $column, "userlist::model::Flags", undef, column_size => 80;
193			$self->{widget}->append_column ($column);
194
195			$self->{widget}->signal_connect(row_activated => sub {
196			my ($widget, $path, $column) = @_;
197			my $user = $self->{model}->get ($self->{model}->get_iter ($path), 0);
198			warn "selected user $user\n";
199			});
200
201			$self;
202			}
203
204			sub update {
205			my ($self, $users) = @_;
206
207			remove Glib::Source delete $self->{event_update} if $self->{event_update};
208			$self->{event_update} \|\|= add Glib::Timeout 100, sub {
209			my $l = $self->{model};
210
211			$l->clear;
212
213			for (values %$users) {
214			$l->set ($l->append,
215			0, $_,
216			1, $_->{name},
217			2, $_->rank_string,
218			3, $_->rank,
219			4, "?");
220			}
221
222			delete $self->{event_update};
223			0;
224			};
225	pcg	1.1	}
226
227			1;
228