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;