[ViewVC] Annotation of: cvs/kgsueme/bin/kgsueme

#!/usr/bin/perl -I../lib/

#use PApp::Util qw(dumpval); # debug only

use Gtk;
use Gtk::Gdk;
#use Gtk::Gdk::Pixbuf;
use Gtk::Gdk::ImlibImage;

use Gnome;

use KGS::Protocol;
use KGS::Listener::Debug;

use IO::Socket::INET;

use Errno;

init Gnome "kgsueme";

$HACK = 1; # do NEVER enable. ;)

our $config;
our $IMGDIR = "images";

sub load_img {
#   new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
   load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
      or die "$IMGDIR/$_[0]: $!";
}

our @black_img =       load_img "b-01.png";
our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5;
our $board_img =       load_img "woodgrain-01.jpg";

{
   use Storable ();
   use Scalar::Util ();

   my $staterc = "$ENV{HOME}/.kgsueme";

   my $state = -r $staterc ? Storable::retrieve($staterc) : {};
   my @widgets;

   $config = $state->{config} ||= {};

   # grr... more gtk+ brokenness
   my %get = (
      hpane_position  => sub { ($_[0]->children)[0]->allocation->[2] },
      vpane_position  => sub { ($_[0]->children)[0]->allocation->[3] },
      window_size     => sub { [ @{$_[0]->allocation}[2,3] ] },
      #window_pos     => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] },
      clist_column_widths => sub {
         $_[0]{column_widths};
      },
   );

   my %set = (
      hpane_position => sub { $_[0]->set_position($_[1]) },
      vpane_position => sub { $_[0]->set_position($_[1]) },
      window_size    => sub { $_[0]->set_default_size(@{$_[1]}) },
      #window_pos     => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[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]; });
      },
   );

   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}{"*"}{$get};
         $v = $state->{$class}{$instance}{$get} if exists $state->{$class}{$instance}{$get};
         $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
      }

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

      @widgets = (grep $_->[0], @widgets, $widget);
   }

   sub save_state {
      for (@widgets) {
         if ($_->[0]) {
            my ($widget, $class, $instance, $attr) = @$_;

            $widget->realize;

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

               $state->{$class}{"*"}{$get}       = $v;
               $state->{$class}{$instance}{$get} = $v;
            }
         }
         ::status("save_state", "layout saved");
      }

      Storable::nstore($state, $staterc);
   }
}

# 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;
      });
   }
   
}

{
   my $main = new kgsueme;

   my %context_id;

   sub status {
      my ($type, $text) = @_;

      $main->{status}->pop($context_id{$type}) if $context_id{$type};
      $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
   }
}

main Gtk;

#############################################################################

package kgsueme;

use base KGS::Listener;

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

   $self->{conn} = new KGS::Protocol;

   KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)

   $self->listen($self->{conn});

   $self->{roomlist} = new roomlist conn => $self->{conn};

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title('kgsueme');
   ::state $self->{window}, "main::window", undef, window_size => [400, 100];
   $self->{window}->signal_connect(delete_event => sub { main_quit Gtk; 1 });

   $self->{window}->add(my $vbox = new Gtk::VBox);

   $vbox->pack_start(($buttonbox = new Gtk::HButtonBox), 0, 1, 0);
   $buttonbox->set_spacing(0);

   my $button = sub {
      $buttonbox->add(my $button = new Gtk::Button $_[0]);
      signal_connect $button clicked => $_[1];
   };

   $button->("Login", sub { $self->login; });
   $button->("Roomlist", sub { $self->{roomlist}->show; });
   $button->("Save Config & Layout", sub { ::save_state });
   $button->("Quit", sub { main_quit Gtk });

   $vbox->pack_start((my $hbox = new Gtk::HBox), 0, 1, 0);

   $hbox->add(new Gtk::Label "Login");

   $hbox->add($self->{login} = new_with_max_length Gtk::Entry 12);
   $self->{login}->set_text($::config->{login});

   if ($::HACK) {
      $self->{login}->signal_connect(activate => sub {
         $self->{conn}{name} = $self->{login}->get_text;
      });
   }

   $hbox->add(new Gtk::Label "Password");
   $hbox->add($self->{password} = new Gtk::Entry);
   $self->{password}->set_visibility(0);

   $vbox->pack_start(($self->{status} = new Gtk::Statusbar), 0, 1, 0);

   $self->{window}->show_all;

   $self;
}

sub login {
   my ($self) = @_;

   $self->{conn}->disconnect;

   # initialize new socket and connection
   my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
      or die;

   $sock->blocking(1);
   $self->{conn}->handshake($sock);
   $sock->blocking(0);

   my $input; $input = input_add Gtk::Gdk fileno $sock, "read", sub {
      # this is dorked
      my $buf;
      if (0 >= sysread $sock, $buf, 16384
          and !$!{EINTR} and !$!{EAGAIN}) {
         input_remove Gtk::Gdk $input;
         $self->event_disconnect;
      }
      $self->{conn}->feed_data($buf);
   };

   # now login
   $self->{conn}->login($self->{login}->get_text, $self->{password}->get_text);
}

sub inject_login {
   my ($self, $msg) = @_;

   ::status("login", "logged in as '$self->{conn}{name}' with status '$msg->{result}'");
   $::config->{login} = $self->{conn}{name};

   if ($msg->{success}) {
      for (keys %{$::config->{rooms}}) {
         $self->{roomlist}->join_room($_);
      }
   }

   warn PApp::Util::dumpval($::config);
}

sub event_disconnect { }

#############################################################################

package roomlist;

use base KGS::Listener::Roomlist;

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

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title('KGS Rooms');
   ::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];

   $self->{window}->signal_connect(delete_event => sub { $self->{window}->hide; 1 });

   $self->{window}->add(my $vbox = new Gtk::VBox);

   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
   $self->{roomlist}->set_selection_mode('multiple');
   ::clist_autosort $self->{roomlist};
   ::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];

   $self->{roomlist}->signal_connect(select_row => sub {
      my $room = $self->{roomlist}->get_row_data($_[1])
         or return;
      $self->{roomlist}->unselect_all;
      $self->join_room($room->{channel});
   });

   $self;
}

sub join_room {
   my ($self, $channel) = @_;

   $self->{room}{$channel} ||= room->new(channel => $channel, conn => $self->{conn}, users => {});
   $self->{room}{$channel}->join;
}

sub show {
   my ($self, $msg) = @_;

   $self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
   $self->{window}->show_all;
}

sub event_update_rooms {
   my ($self) = @_;

   $self->{event_update} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{roomlist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{rooms}}) {
         $l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

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

#############################################################################

package room;

use base KGS::Listener::Room;

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

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title("KGS Room $self->{name}");
   ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];

   $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });

   $self->{window}->add(my $hpane = new Gtk::HPaned);
   ::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;

   $hpane->add(my $vpane = new Gtk::VPaned);
   ::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;

   $vpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
   ::clist_autosort $self->{gamelist};
   ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];

   $self->{gamelist}->signal_connect(select_row => sub {
      my $game = $self->{gamelist}->get_row_data($_[1])
         or return;
      $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn};
      $self->{game}{$game->{channel}}->join;
      $self->{gamelist}->unselect_all;
   });

   $vpane->add(my $vbox = new Gtk::VBox);
   
   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{text} = new Gtk::Text);

   $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
   $self->{entry}->signal_connect(activate => sub {
      my $text = $self->{entry}->get_text;
      $self->say($text) if $text =~ /\S/;
      $self->{entry}->set_text("");
   });

   $hpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
   ::clist_autosort $self->{userlist};
   ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];

   $self;
}

sub event_update_users {
   my ($self) = @_;

   $self->{event_update} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{userlist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{users}}) {
         $l->append($_->{name});
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

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

sub event_update_games {
   my ($self) = @_;

   $self->{event_update_games} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{gamelist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{games}}) {
         $l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

      delete $self->{event_update_games};
      0;
   });
}

sub join {
   my ($self) = @_;
   $self->SUPER::join;

   $self->{window}->show_all;
}

sub part {
   my ($self) = @_;
   $self->SUPER::part;

   delete $::config->{rooms}{$self->{channel}};
   $self->{window}->hide_all;
   $self->event_update;
   $self->event_update_games;
}

sub event_join {
   my ($self) = @_;
   $self->SUPER::event_join;

   $::config->{rooms}{$self->{channel}} = 1;
}

sub event_update_roominfo {
   my ($self) = @_;

   $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
}

sub inject_msg_room {
   my ($self, $msg) = @_;
   return unless $self->{channel} == $msg->{channel};

   $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
}

#############################################################################

package game;

use KGS::Constants;
use KGS::Game::Board;

use base KGS::Listener::Game;
use base KGS::Game;

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

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1);
   ::state $self->{window}, "game::window", undef, window_size => [600, 500];

   $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });

   $self->{window}->add(my $hpane = new Gtk::HPaned);
   ::state $hpane, "game::hpane", undef, hpane_position => 500;

   $::config{aa} = 0;
   $self->{canvas} = $::config{aa} ? new_aa Gnome::Canvas : new Gnome::Canvas;
   $hpane->add($self->{canvas});

   {
      my $line_colour = $::config{line_colour} || "darkbrown";
      my $border      = 0.1;
      my $ofs         = 0.5 / $self->{size};
   
      $self->{canvas}->set_pixels_per_unit(1000);
      $self->{canvas}->set_scroll_region(-$border,-$border,1+$border,1+$border);

      $self->{canvas}->signal_connect(size_allocate => sub {
         my ($w, $h) = @{$_[1]}[2,3];

         $self->{canvas}->set_pixels_per_unit(($w > $h ? $h : $w)/(1+$border*2));

         1;
      });

      my $croot  = $self->{canvas}->root;
      my $cgroup = $croot; #->new($croot, "Gnome::CanvasGroup");

      if ($::board_img) {
         $cgroup->new($cgroup, "Gnome::CanvasImage",
            x      => -$border,    y      => -$border,
            width  => 1+$border*2, height => 1+$border*2,
            image  => $::board_img,
            anchor => "nw"
         );
      } else {
         $cgroup->new($cgroup, "Gnome::CanvasRect",
            x1 => -$border, x2 => 1+$border,
            y1 => -$border, y2 => 1+$border,
            outline_color => "black",
            fill_color => "brown",
            width_pixels => 2,
         );
      }

      my $a = "A";
      for my $i (1 .. $self->{size}) { # one more iteration for the last lines
        my $k = $i / $self->{size} - $ofs;

        $cgroup->new($cgroup, "Gnome::CanvasLine",
           points       => [ $k,$ofs, $k,1-$ofs ],
           fill_color   => $line_colour,
           width_pixels => 1);

        $cgroup->new($cgroup, "Gnome::CanvasLine",
           points       => [ $ofs,$k, 1-$ofs,$k ],
           fill_color   => $line_colour,
           width_pixels => 1);

        for ( [$k,-$border*0.5,$a], [$k,1+$border*0.5,$a], [-$border*0.5,$k,$i], [1+$border*0.5,$k,$i] ) {
           my ($x, $y, $text) = @$_;

           my $text = $cgroup->new($cgroup, "Gnome::CanvasText",
              x => 0, y => 0, text => $text,
              justification => "center",
              anchor        => "center",
              font          => $::config{aa} ? "-*-helvetica-medium-r-*--34-*" : "-*-helvetica-bold-r-*--17-*",
              fill_color    => $line_colour);

           $text->affine_relative($border*0.015,0, 0,$border*0.015, $x,$y);
        }

        $a++;
      }

      my $stones = [[]];

      for my $x (1 .. $self->{size}) {
         my $xk = $x / $self->{size} - $ofs;
         for my $y (1 .. $self->{size}) {
            my $yk = $y / $self->{size} - $ofs;

            my $col = $stones->[$x-1][$y-1] = [];

            if (1) {
               $col->[0] =
                  $cgroup->new($cgroup, "Gnome::CanvasImage",
                     x      => $xk,    y      => $yk,
                     width  => $ofs*2, height => $ofs*2,
                     image  => $::black_img[int rand @::black_img],
                     anchor => "center");
               $col->[1] =
                  $cgroup->new($cgroup, "Gnome::CanvasImage",
                     x      => $xk,    y      => $yk,
                     width  => $ofs*2, height => $ofs*2,
                     image  => $::white_img[int rand @::white_img],
                     anchor => "center");
            } else {
               die "need pixmaps\n";
               # too large, scale has NO effect
               $col->[0] =
                  $cgroup->new($cgroup, "Gnome::CanvasEllipse",
                     x1 => $xk, x2 => $xk + 0.001,
                     y1 => $yk, y2 => $yk + 0.001,
                     outline_color => "black", width_pixels => 2,
                     fill_color => "black");
               $col->[1] =
                  $cgroup->new($cgroup, "Gnome::CanvasEllipse",
                     x1 => $xk, x2 => $xk + 0.001,
                     y1 => $yk, y2 => $yk + 0.001,
                     outline_color => "black", width_pixels => 2,
                     fill_color => "white");
            }
         }
      }

      $self->{board_gfx}{stones} = $stones;
   }

   $hpane->add(my $vpane = new Gtk::VPaned);
   ::state $vpane, "game", $self->{name}, vpane_position => 80;

   $vpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
   ::clist_autosort $self->{userlist};
   ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];

   $vpane->add(my $vbox = new Gtk::VBox);
   
   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{text} = new Gtk::Text);

   $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
   $self->{entry}->signal_connect(activate => sub {
      my $text = $self->{entry}->get_text;
      # add message
      $self->{entry}->set_text("");
   });

   $self;
}

sub event_update_users {
   my ($self) = @_;

   room::event_update_users $self;
}

sub join {
   my ($self) = @_;
   $self->SUPER::join;

   $self->{window}->show_all;
}

sub part {
   my ($self) = @_;
   $self->SUPER::part;

   $self->{window}->hide_all;
   $self->event_update;
}

sub event_update_tree {
   my ($self) = @_;

   my $board = new KGS::Game::Board $self->{size};
   $board->interpret_path ($self->get_path);

   for my $x (0 .. $self->{size} - 1) {
      for my $y (0 .. $self->{size} - 1) {
         my $v = $board->{board}[$x][$y];

         $v & MARK_B
            ? $self->{board_gfx}->{stones}->[$x][$y][0]->show
            : $self->{board_gfx}->{stones}->[$x][$y][0]->hide;
         $v & MARK_W
            ? $self->{board_gfx}->{stones}->[$x][$y][1]->show
            : $self->{board_gfx}->{stones}->[$x][$y][1]->hide;
      }
   }

   $self->{text}->backward_delete($self->{text}->get_length);
   $self->{text}->insert(undef, undef, undef, $board->{comment}.PApp::Util::dumpval([$board->{time},$board->{captures}]));
}

1;


Revision:	1.9
Committed:	Thu May 29 10:32:06 2003 UTC (21 years ago) by pcg
Branch:	MAIN
Changes since 1.8:	+9 -33 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	elmex	1.6	#!/usr/bin/perl -I../lib/
2	pcg	1.1
3	elmex	1.6	#use PApp::Util qw(dumpval); # debug only
4	pcg	1.1
5			use Gtk;
6			use Gtk::Gdk;
7	pcg	1.7	#use Gtk::Gdk::Pixbuf;
8			use Gtk::Gdk::ImlibImage;
9
10	elmex	1.6	use Gnome;
11	pcg	1.1
12			use KGS::Protocol;
13			use KGS::Listener::Debug;
14
15			use IO::Socket::INET;
16
17			use Errno;
18
19	pcg	1.7	init Gnome "kgsueme";
20	pcg	1.1
21	pcg	1.3	$HACK = 1; # do NEVER enable. ;)
22
23	pcg	1.2	our $config;
24	pcg	1.7	our $IMGDIR = "images";
25
26			sub load_img {
27			# new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
28			load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
29			or die "$IMGDIR/$_[0]: $!";
30			}
31
32	pcg	1.8	our @black_img = load_img "b-01.png";
33			our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5;
34	pcg	1.7	our $board_img = load_img "woodgrain-01.jpg";
35	pcg	1.2
36	pcg	1.1	{
37			use Storable ();
38			use Scalar::Util ();
39
40			my $staterc = "$ENV{HOME}/.kgsueme";
41
42			my $state = -r $staterc ? Storable::retrieve($staterc) : {};
43			my @widgets;
44
45	pcg	1.2	$config = $state->{config} \|\|= {};
46
47	pcg	1.1	# grr... more gtk+ brokenness
48			my %get = (
49	pcg	1.8	hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
50			vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
51	pcg	1.1	window_size => sub { [ @{$_[0]->allocation}[2,3] ] },
52			#window_pos => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] },
53			clist_column_widths => sub {
54			$_[0]{column_widths};
55			},
56			);
57
58			my %set = (
59			hpane_position => sub { $_[0]->set_position($_[1]) },
60			vpane_position => sub { $_[0]->set_position($_[1]) },
61			window_size => sub { $_[0]->set_default_size(@{$_[1]}) },
62			#window_pos => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
63			clist_column_widths => sub {
64			my ($w, $v) = @_;
65			$v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
66			$w->{column_widths} = $v;
67			$w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
68			},
69			);
70
71			sub state {
72			my ($widget, $class, $instance, %attr) = @_;
73
74			while (my ($k, $v) = each %attr) {
75			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
76			$v = $state->{$class}{""}{$get} if exists $state->{$class}{""}{$get};
77			$v = $state->{$class}{$instance}{$get} if exists $state->{$class}{$instance}{$get};
78			$set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
79			}
80
81			$widget = [$widget, $class, $instance, \%attr];
82			Scalar::Util::weaken $widget->[0];
83
84			@widgets = (grep $_->[0], @widgets, $widget);
85			}
86
87			sub save_state {
88			for (@widgets) {
89			if ($_->[0]) {
90			my ($widget, $class, $instance, $attr) = @$_;
91	pcg	1.7
92			$widget->realize;
93
94	pcg	1.1	while (my ($k, $v) = each %$attr) {
95			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
96			$v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
97
98			$state->{$class}{"*"}{$get} = $v;
99			$state->{$class}{$instance}{$get} = $v;
100			}
101			}
102			::status("save_state", "layout saved");
103			}
104
105			Storable::nstore($state, $staterc);
106			}
107			}
108
109			# make a clist unselectable
110			sub clist_autosort {
111			my $w = shift;
112			my ($c, $o) = (-1);
113			for (0..$w->columns-1) {
114			$w->signal_connect(click_column => sub {
115			if ($_[1] != $c) {
116			$c = $_[1];
117			$o = 0;
118			} else {
119			$o = !$o;
120			}
121			$w->set_sort_column($c);
122			$w->set_sort_type($o ? "descending" : "ascending");
123			$w->sort;
124			});
125			}
126
127			}
128
129			{
130			my $main = new kgsueme;
131
132			my %context_id;
133
134			sub status {
135			my ($type, $text) = @_;
136
137			$main->{status}->pop($context_id{$type}) if $context_id{$type};
138			$main->{status}->push($context_id{$type} \|\|= $main->{status}->get_context_id($type), $text) if $text;
139			}
140			}
141
142			main Gtk;
143
144			#############################################################################
145
146			package kgsueme;
147
148			use base KGS::Listener;
149
150			sub new {
151			my $self = shift;
152			$self = $self->SUPER::new(@_);
153
154			$self->{conn} = new KGS::Protocol;
155
156			KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
157
158			$self->listen($self->{conn});
159
160	pcg	1.4	$self->{roomlist} = new roomlist conn => $self->{conn};
161
162	pcg	1.1	$self->{window} = new Gtk::Window 'toplevel';
163			$self->{window}->set_title('kgsueme');
164			::state $self->{window}, "main::window", undef, window_size => [400, 100];
165	pcg	1.7	$self->{window}->signal_connect(delete_event => sub { main_quit Gtk; 1 });
166	pcg	1.1
167			$self->{window}->add(my $vbox = new Gtk::VBox);
168
169	pcg	1.4	$vbox->pack_start(($buttonbox = new Gtk::HButtonBox), 0, 1, 0);
170			$buttonbox->set_spacing(0);
171	pcg	1.1
172	pcg	1.2	my $button = sub {
173	pcg	1.4	$buttonbox->add(my $button = new Gtk::Button $_[0]);
174	pcg	1.2	signal_connect $button clicked => $_[1];
175			};
176	pcg	1.1
177	pcg	1.4	$button->("Login", sub { $self->login; });
178			$button->("Roomlist", sub { $self->{roomlist}->show; });
179	pcg	1.2	$button->("Save Config & Layout", sub { ::save_state });
180	pcg	1.4	$button->("Quit", sub { main_quit Gtk });
181	pcg	1.1
182			$vbox->pack_start((my $hbox = new Gtk::HBox), 0, 1, 0);
183
184			$hbox->add(new Gtk::Label "Login");
185
186			$hbox->add($self->{login} = new_with_max_length Gtk::Entry 12);
187	pcg	1.2	$self->{login}->set_text($::config->{login});
188	pcg	1.3
189			if ($::HACK) {
190			$self->{login}->signal_connect(activate => sub {
191			$self->{conn}{name} = $self->{login}->get_text;
192			});
193			}
194	pcg	1.1
195			$hbox->add(new Gtk::Label "Password");
196	pcg	1.2	$hbox->add($self->{password} = new Gtk::Entry);
197			$self->{password}->set_visibility(0);
198	pcg	1.1
199			$vbox->pack_start(($self->{status} = new Gtk::Statusbar), 0, 1, 0);
200
201			$self->{window}->show_all;
202
203			$self;
204			}
205
206			sub login {
207			my ($self) = @_;
208
209	pcg	1.2	$self->{conn}->disconnect;
210
211	pcg	1.1	# initialize new socket and connection
212			my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
213			or die;
214
215			$sock->blocking(1);
216			$self->{conn}->handshake($sock);
217			$sock->blocking(0);
218
219			my $input; $input = input_add Gtk::Gdk fileno $sock, "read", sub {
220			# this is dorked
221			my $buf;
222			if (0 >= sysread $sock, $buf, 16384
223			and !$!{EINTR} and !$!{EAGAIN}) {
224			input_remove Gtk::Gdk $input;
225			$self->event_disconnect;
226			}
227			$self->{conn}->feed_data($buf);
228			};
229
230			# now login
231	pcg	1.2	$self->{conn}->login($self->{login}->get_text, $self->{password}->get_text);
232	pcg	1.1	}
233
234			sub inject_login {
235			my ($self, $msg) = @_;
236
237			::status("login", "logged in as '$self->{conn}{name}' with status '$msg->{result}'");
238	pcg	1.2	$::config->{login} = $self->{conn}{name};
239	pcg	1.1
240	pcg	1.4	if ($msg->{success}) {
241			for (keys %{$::config->{rooms}}) {
242			$self->{roomlist}->join_room($_);
243			}
244			}
245
246			warn PApp::Util::dumpval($::config);
247	pcg	1.1	}
248
249			sub event_disconnect { }
250
251			#############################################################################
252
253			package roomlist;
254
255			use base KGS::Listener::Roomlist;
256
257			sub new {
258			my $self = shift;
259			$self = $self->SUPER::new(@_);
260
261			$self->listen($self->{conn});
262
263			$self->{window} = new Gtk::Window 'toplevel';
264			$self->{window}->set_title('KGS Rooms');
265			::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];
266
267	pcg	1.7	$self->{window}->signal_connect(delete_event => sub { $self->{window}->hide; 1 });
268	pcg	1.1
269			$self->{window}->add(my $vbox = new Gtk::VBox);
270
271			$vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
272			$sw->set_policy("automatic", "always");
273
274			$sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
275			$self->{roomlist}->set_selection_mode('multiple');
276			::clist_autosort $self->{roomlist};
277			::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];
278
279			$self->{roomlist}->signal_connect(select_row => sub {
280			my $room = $self->{roomlist}->get_row_data($_[1])
281			or return;
282			$self->{roomlist}->unselect_all;
283	pcg	1.4	$self->join_room($room->{channel});
284	pcg	1.1	});
285
286			$self;
287			}
288
289	pcg	1.4	sub join_room {
290			my ($self, $channel) = @_;
291
292			$self->{room}{$channel} \|\|= room->new(channel => $channel, conn => $self->{conn}, users => {});
293			$self->{room}{$channel}->join;
294			}
295
296	pcg	1.1	sub show {
297			my ($self, $msg) = @_;
298
299			$self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
300			$self->{window}->show_all;
301			}
302
303	pcg	1.9	sub event_update_rooms {
304	pcg	1.1	my ($self) = @_;
305
306			$self->{event_update} \|\|= Gtk->timeout_add(200, sub {
307			my $l = $self->{roomlist};
308
309			$l->freeze;
310			my $pos = $l->get_vadjustment->get_value;
311			$l->clear;
312
313			my $row = 0;
314			for (values %{$self->{rooms}}) {
315			$l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
316			$l->set_row_data($row++, $_);
317			}
318			$l->sort;
319			$l->get_vadjustment->set_value($pos);
320			$l->thaw;
321
322			delete $self->{event_update};
323			0;
324			});
325			}
326
327			#############################################################################
328
329			package room;
330
331			use base KGS::Listener::Room;
332
333			sub new {
334			my $self = shift;
335			$self = $self->SUPER::new(@_);
336
337			$self->listen($self->{conn});
338
339			$self->{window} = new Gtk::Window 'toplevel';
340			$self->{window}->set_title("KGS Room $self->{name}");
341			::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
342
343	pcg	1.7	$self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
344	pcg	1.1
345			$self->{window}->add(my $hpane = new Gtk::HPaned);
346			::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;
347
348			$hpane->add(my $vpane = new Gtk::VPaned);
349			::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;
350
351			$vpane->add(my $sw = new Gtk::ScrolledWindow);
352			$sw->set_policy("automatic", "always");
353
354			$sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
355			::clist_autosort $self->{gamelist};
356			::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
357
358			$self->{gamelist}->signal_connect(select_row => sub {
359			my $game = $self->{gamelist}->get_row_data($_[1])
360			or return;
361			$self->{game}{$game->{channel}} \|\|= new game %$game, conn => $self->{conn};
362			$self->{game}{$game->{channel}}->join;
363			$self->{gamelist}->unselect_all;
364			});
365
366			$vpane->add(my $vbox = new Gtk::VBox);
367
368			$vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
369			$sw->set_policy("automatic", "always");
370
371			$sw->add($self->{text} = new Gtk::Text);
372
373			$vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
374			$self->{entry}->signal_connect(activate => sub {
375			my $text = $self->{entry}->get_text;
376			$self->say($text) if $text =~ /\S/;
377			$self->{entry}->set_text("");
378			});
379
380			$hpane->add(my $sw = new Gtk::ScrolledWindow);
381			$sw->set_policy("automatic", "always");
382
383			$sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
384			::clist_autosort $self->{userlist};
385			::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
386
387			$self;
388			}
389
390	pcg	1.9	sub event_update_users {
391	pcg	1.1	my ($self) = @_;
392
393			$self->{event_update} \|\|= Gtk->timeout_add(200, sub {
394			my $l = $self->{userlist};
395
396			$l->freeze;
397			my $pos = $l->get_vadjustment->get_value;
398			$l->clear;
399
400			my $row = 0;
401			for (values %{$self->{users}}) {
402			$l->append($_->{name});
403			$l->set_row_data($row++, $_);
404			}
405			$l->sort;
406			$l->get_vadjustment->set_value($pos);
407			$l->thaw;
408
409			delete $self->{event_update};
410			0;
411			});
412			}
413
414			sub event_update_games {
415			my ($self) = @_;
416
417			$self->{event_update_games} \|\|= Gtk->timeout_add(200, sub {
418			my $l = $self->{gamelist};
419
420			$l->freeze;
421			my $pos = $l->get_vadjustment->get_value;
422			$l->clear;
423
424			my $row = 0;
425			for (values %{$self->{games}}) {
426			$l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
427			$l->set_row_data($row++, $_);
428			}
429			$l->sort;
430			$l->get_vadjustment->set_value($pos);
431			$l->thaw;
432
433			delete $self->{event_update_games};
434			0;
435			});
436			}
437
438			sub join {
439			my ($self) = @_;
440			$self->SUPER::join;
441
442			$self->{window}->show_all;
443			}
444
445			sub part {
446			my ($self) = @_;
447			$self->SUPER::part;
448
449	pcg	1.4	delete $::config->{rooms}{$self->{channel}};
450	pcg	1.1	$self->{window}->hide_all;
451			$self->event_update;
452			$self->event_update_games;
453	pcg	1.4	}
454
455			sub event_join {
456			my ($self) = @_;
457			$self->SUPER::event_join;
458
459			$::config->{rooms}{$self->{channel}} = 1;
460	pcg	1.1	}
461
462			sub event_update_roominfo {
463			my ($self) = @_;
464
465	pcg	1.7	$self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
466	pcg	1.1	}
467
468			sub inject_msg_room {
469			my ($self, $msg) = @_;
470			return unless $self->{channel} == $msg->{channel};
471
472	pcg	1.7	$self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
473	pcg	1.1	}
474
475			#############################################################################
476
477			package game;
478
479	pcg	1.7	use KGS::Constants;
480	pcg	1.9	use KGS::Game::Board;
481	pcg	1.7
482	pcg	1.1	use base KGS::Listener::Game;
483			use base KGS::Game;
484
485			sub new {
486			my $self = shift;
487			$self = $self->SUPER::new(@_);
488
489			$self->listen($self->{conn});
490
491			$self->{window} = new Gtk::Window 'toplevel';
492			$self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1);
493			::state $self->{window}, "game::window", undef, window_size => [600, 500];
494
495	pcg	1.7	$self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
496	pcg	1.1
497			$self->{window}->add(my $hpane = new Gtk::HPaned);
498			::state $hpane, "game::hpane", undef, hpane_position => 500;
499
500	pcg	1.9	$::config{aa} = 0;
501	pcg	1.7	$self->{canvas} = $::config{aa} ? new_aa Gnome::Canvas : new Gnome::Canvas;
502			$hpane->add($self->{canvas});
503
504	pcg	1.8	{
505			my $line_colour = $::config{line_colour} \|\| "darkbrown";
506			my $border = 0.1;
507			my $ofs = 0.5 / $self->{size};
508
509			$self->{canvas}->set_pixels_per_unit(1000);
510			$self->{canvas}->set_scroll_region(-$border,-$border,1+$border,1+$border);
511
512			$self->{canvas}->signal_connect(size_allocate => sub {
513			my ($w, $h) = @{$_[1]}[2,3];
514	pcg	1.7
515	pcg	1.8	$self->{canvas}->set_pixels_per_unit(($w > $h ? $h : $w)/(1+$border*2));
516
517			1;
518			});
519	pcg	1.7
520			my $croot = $self->{canvas}->root;
521			my $cgroup = $croot; #->new($croot, "Gnome::CanvasGroup");
522
523			if ($::board_img) {
524			$cgroup->new($cgroup, "Gnome::CanvasImage",
525			x => -$border, y => -$border,
526			width => 1+$border2, height => 1+$border2,
527			image => $::board_img,
528			anchor => "nw"
529			);
530			} else {
531			$cgroup->new($cgroup, "Gnome::CanvasRect",
532			x1 => -$border, x2 => 1+$border,
533			y1 => -$border, y2 => 1+$border,
534			outline_color => "black",
535			fill_color => "brown",
536			width_pixels => 2,
537			);
538			}
539
540			my $a = "A";
541			for my $i (1 .. $self->{size}) { # one more iteration for the last lines
542			my $k = $i / $self->{size} - $ofs;
543
544			$cgroup->new($cgroup, "Gnome::CanvasLine",
545			points => [ $k,$ofs, $k,1-$ofs ],
546			fill_color => $line_colour,
547	elmex	1.6	width_pixels => 1);
548	pcg	1.7
549			$cgroup->new($cgroup, "Gnome::CanvasLine",
550			points => [ $ofs,$k, 1-$ofs,$k ],
551			fill_color => $line_colour,
552	elmex	1.6	width_pixels => 1);
553	pcg	1.1
554	pcg	1.7	for ( [$k,-$border0.5,$a], [$k,1+$border0.5,$a], [-$border0.5,$k,$i], [1+$border0.5,$k,$i] ) {
555			my ($x, $y, $text) = @$_;
556
557			my $text = $cgroup->new($cgroup, "Gnome::CanvasText",
558			x => 0, y => 0, text => $text,
559			justification => "center",
560			anchor => "center",
561	pcg	1.8	font => $::config{aa} ? "--helvetica-medium-r---34-" : "--helvetica-bold-r---17-",
562	pcg	1.7	fill_color => $line_colour);
563
564			$text->affine_relative($border0.015,0, 0,$border0.015, $x,$y);
565			}
566
567			$a++;
568			}
569
570			my $stones = [[]];
571
572			for my $x (1 .. $self->{size}) {
573			my $xk = $x / $self->{size} - $ofs;
574			for my $y (1 .. $self->{size}) {
575			my $yk = $y / $self->{size} - $ofs;
576
577			my $col = $stones->[$x-1][$y-1] = [];
578
579			if (1) {
580			$col->[0] =
581			$cgroup->new($cgroup, "Gnome::CanvasImage",
582			x => $xk, y => $yk,
583			width => $ofs2, height => $ofs2,
584			image => $::black_img[int rand @::black_img],
585			anchor => "center");
586			$col->[1] =
587			$cgroup->new($cgroup, "Gnome::CanvasImage",
588			x => $xk, y => $yk,
589			width => $ofs2, height => $ofs2,
590			image => $::white_img[int rand @::white_img],
591			anchor => "center");
592			} else {
593	pcg	1.8	die "need pixmaps\n";
594	pcg	1.7	# too large, scale has NO effect
595			$col->[0] =
596			$cgroup->new($cgroup, "Gnome::CanvasEllipse",
597			x1 => $xk, x2 => $xk + 0.001,
598			y1 => $yk, y2 => $yk + 0.001,
599			outline_color => "black", width_pixels => 2,
600			fill_color => "black");
601			$col->[1] =
602			$cgroup->new($cgroup, "Gnome::CanvasEllipse",
603			x1 => $xk, x2 => $xk + 0.001,
604			y1 => $yk, y2 => $yk + 0.001,
605			outline_color => "black", width_pixels => 2,
606			fill_color => "white");
607			}
608			}
609			}
610
611	pcg	1.8	$self->{board_gfx}{stones} = $stones;
612	pcg	1.7	}
613	pcg	1.1
614			$hpane->add(my $vpane = new Gtk::VPaned);
615			::state $vpane, "game", $self->{name}, vpane_position => 80;
616
617			$vpane->add(my $sw = new Gtk::ScrolledWindow);
618			$sw->set_policy("automatic", "always");
619
620			$sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
621			::clist_autosort $self->{userlist};
622			::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
623
624			$vpane->add(my $vbox = new Gtk::VBox);
625
626			$vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
627			$sw->set_policy("automatic", "always");
628
629			$sw->add($self->{text} = new Gtk::Text);
630
631			$vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
632			$self->{entry}->signal_connect(activate => sub {
633			my $text = $self->{entry}->get_text;
634			# add message
635			$self->{entry}->set_text("");
636			});
637
638			$self;
639			}
640
641	pcg	1.9	sub event_update_users {
642	pcg	1.1	my ($self) = @_;
643
644	pcg	1.9	room::event_update_users $self;
645	pcg	1.1	}
646
647			sub join {
648			my ($self) = @_;
649			$self->SUPER::join;
650
651			$self->{window}->show_all;
652			}
653
654			sub part {
655			my ($self) = @_;
656			$self->SUPER::part;
657
658			$self->{window}->hide_all;
659			$self->event_update;
660			}
661
662			sub event_update_tree {
663			my ($self) = @_;
664
665	pcg	1.7	my $board = new KGS::Game::Board $self->{size};
666			$board->interpret_path ($self->get_path);
667
668	pcg	1.1	for my $x (0 .. $self->{size} - 1) {
669			for my $y (0 .. $self->{size} - 1) {
670	pcg	1.7	my $v = $board->{board}[$x][$y];
671	pcg	1.1
672	pcg	1.7	$v & MARK_B
673			? $self->{board_gfx}->{stones}->[$x][$y][0]->show
674			: $self->{board_gfx}->{stones}->[$x][$y][0]->hide;
675			$v & MARK_W
676			? $self->{board_gfx}->{stones}->[$x][$y][1]->show
677			: $self->{board_gfx}->{stones}->[$x][$y][1]->hide;
678	pcg	1.1	}
679			}
680	pcg	1.9
681			$self->{text}->backward_delete($self->{text}->get_length);
682			$self->{text}->insert(undef, undef, undef, $board->{comment}.PApp::Util::dumpval([$board->{time},$board->{captures}]));
683	pcg	1.1	}
684
685			1;
686
687
688