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

#!/opt/bin/perl
package util;

sub format_time($) {
   my ($time) = @_;

   $time > 60*60
      ? sprintf "%d:%02d:%02d", $time / (60 * 60), $time / 60 % 60, $time % 60
      : sprintf      "%d:%02d", $time / 60 % 60, $time % 60;
}


package goclock;

use Time::HiRes ();

use Gtk2;
use Glib::Object::Subclass Gtk2::Label;

sub INIT_INSTANCE {
   my $self = shift;

   $self->signal_connect (destroy => sub { $_[0]->stop });

   $self->{format} = sub {
      if ($_[0] < 0) {
         "TIMEOUT";
      } elsif ($self->{moves} < 0) {
         util::format_time $_[0];
      } else {
         my $time = int (($_[0] - 1) % $self->{interval} + 1);

         sprintf "%s/%d (%d sec/move)",
                 util::format_time $time,
                 $self->{moves},
                 $self->{moves} > 1 ? $time / $self->{moves} : $self->{interval};
      }
   }

}                   

sub FINALIZE_INSTANCE {
   my $self = shift;

   $self->stop;
}     

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

   my $timer = $self->{time};
   print "TIM: $self->{time} $self->{moves} $self->{interval}\n";

   $self->set_text ($self->{format}->($timer));
}

sub set_time {
   my ($self, $start, $time, $moves, $interval) = @_;

   $self->{interval} = $interval;
   $self->{time}  = $time;
   $self->{moves} = $moves;

   $self->refresh;
   if ($start) {
      $self->start;
   } else {
      $self->stop;
   }
}

sub start {
   my ($self, $interval) = @_;

   $self->stop;

   my $timeout; $timeout = sub {
      $self->{timeout} = add Glib::Timeout 1000, $timeout;
      $self->{time}--;
      $self->refresh;
      0;
   };

   $self->{time}++;
   $timeout->();
}

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

   remove Glib::Source delete $self->{timeout} if $self->{timeout};
}


package main;
use lib 'igsueme/';
use lib 'lib/';
use Glib;
use Gtk2 -init;
use Gtk2::Helper;
use Gtk2::SimpleList;
use Gtk2::GoBoard;
use Games::Go::SimpleBoard;
use IO::Socket::INET;
use IGS;
use strict;
require Data::Dumper;

my %games;

my @timers;

my %alphmap = (
      A => 1, 
      B => 2, 
      C => 3, 
      D => 4, 
      E => 5, 
      F => 6, 
      G => 7, 
      H => 8, 
      J => 9, 
      K => 10, 
      L => 11, 
      M => 12, 
      N => 13, 
      O => 14, 
      P => 15, 
      Q => 16, 
      R => 17, 
      S => 18, 
      T => 19, 
      U => 20, 
      V => 21, 
      W => 22, 
);

sub dump($) {
   print Data::Dumper::Dumper ([$_[0]]);
}

sub con {
   my ($host, $port) = @_;

   my $socket = new IO::Socket::INET PeerAddr => $host, PeerPort => $port
         or die "cannot connect to $host:$port: $!";

   $socket->autoflush (1);
   return $socket;
}

sub spawn_game_view {
   my ($igs, $gamenr) = @_;

   my $game = $games{$gamenr};
   my $size = $game->{size};

   return if not defined $game;

   my $w = Gtk2::Window->new;
   $w->set_default_size (600, 700);

   $w->add (my $v = new Gtk2::VBox);
      $v->pack_start ((new Gtk2::Label 
            "Game $gamenr: White: $game->{white} [$game->{white_rank}] vs. Black: $game->{black} [$game->{black_rank}]"), 0, 1, 0);
      $v->pack_start ((new Gtk2::Label 
            "Size: $game->{size} Handicap: $game->{handicap}"), 0, 1, 0);
      $v->pack_start ((my $clock1 = new goclock), 0, 1, 0);
      $v->pack_start ((my $clock2 = new goclock), 0, 1, 0);
      $v->pack_start ((my $msg = new Gtk2::Label), 0, 1, 0);
      $v->pack_start ((my $mv_lbl = new Gtk2::Label), 0, 1, 0);

      $v->pack_start ((my $board = new Gtk2::GoBoard size => $size), 1, 1, 0);


   $msg->set_text ($game->{title});

   my $p3 = $igs->set_ev_cb ('game_title' => sub {
      my ($s, $gnr, $t) = @_;
      $gnr == $gamenr or return;
      $msg->set_text ($t);
      $game->{title} = $t;
   });

   my $pos = $igs->set_ev_cb ('game_over' => sub {
      my ($self, $gnr, $result) = @_;
      $gnr == $gamenr or return;
      $clock1->stop;
      $clock2->stop;
      $msg->set_text ($game->{title} . ": Game Over: $result");
   });

   my $pos2 = $igs->set_ev_cb ('game_move' => sub {
      my $self = shift;
      my $gnr = shift;

      $gnr == $gamenr or return;

      my $move = shift;
      
      my $mnr = $move->{number};
      $move->{coords} =~ m/^(.)(\d+)/;
      my $x = $alphmap{$1} - 1;
      my $y = $size - $2;

      my $white_mv = $move->{color} eq 'white';

      $game->{moves}->[$mnr] = $move;
      my $mv = $game->{moves_struct}->[$mnr] 
         = [ $x, $y, ~MARK_CIRCLE, MARK_CIRCLE | MARK_MOVE | ($white_mv ? MARK_W : MARK_B), '' ];

      print "MOVE $gamenr | $mnr | $gnr : $x, $y $move->{color} = $move->{white_time} <=> $move->{black_time} | $move->{white_stones} <-> $move->{black_stones} | $game->{byo}\n";

      $mv_lbl->set_text ("Move " . ($mnr + 1));
      $clock1->set_time ((not $white_mv), $move->{white_time}, $move->{white_stones}, $game->{byo} * 60);
      $clock2->set_time ($white_mv, $move->{black_time}, $move->{black_stones}, $game->{byo} * 60);
      if ($move->{white_time} == 0 && $move->{white_stones} == -1 && $move->{black_time} == 0 && $move->{black_stones} == -1) {
         $clock1->stop ();
         $clock2->stop ();
      }

      my $board_state = new Games::Go::SimpleBoard $size;
      $board_state->update ($game->{moves_struct});
      $board->set_board ($board_state);
   });

   $w->signal_connect (destroy => sub {
      $igs->unset_ev_cb ('game_over', $pos);
      $igs->unset_ev_cb ('game_move', $pos2);
      $igs->unset_ev_cb ('game_title', $p3);
      $igs->feed_event ('req_unobserve', $gamenr);
   });

   $w->show_all;
}

sub build_ui {
   my $igs = shift;

   my $win = Gtk2::Window->new;
   $win->set_default_size (600, 800);

   my $slist = Gtk2::SimpleList->new (
                  'N'      => 'int',          # game number
                  'White'  => 'text',
                  'W Rank' => 'text',
                  'Black'  => 'text',
                  'B Rank' => 'text',
                  'Move'   => 'int',
                  'Size'   => 'int',
                  'Hand'   => 'int',
                  'Komi'   => 'double',
                  'Byo'    => 'int',
                  'F'      => 'text',
                  'R'      => 'text',
               );

   my $plist = Gtk2::SimpleList->new (
                  'Name'   => 'text',
                  'Rank'   => 'text',
                  'Obs'    => 'int',
                  'Pla'    => 'int',
                  'Idle'   => 'text',
                  'Flags'  => 'text',
               );

   $win->add (my $p = Gtk2::VPaned->new);
      $p->add1 (my $sw = Gtk2::ScrolledWindow->new);
         $sw->add ($slist);
      $p->add2 (my $hp = Gtk2::HPaned->new);
         $hp->add1 (my $sw = Gtk2::ScrolledWindow->new);
            $sw->add_with_viewport (my $v = Gtk2::VBox->new);
               $v->pack_start (my $txt = Gtk2::TextView->new, 1, 1, 0);
               $v->pack_start (my $b1 = Gtk2::Button->new ('sort'), 0, 1, 0);
         $hp->add2 (my $sw = Gtk2::ScrolledWindow->new);
            $sw->add ($plist);

   $b1->signal_connect (clicked => sub {
       @{$slist->{data}} = 
              map { my %g = %{$games{$_}}; print "$g{number}\n"; [ @g{qw/number white white_rank black black_rank move size handicap komi byo Fflag Rflag/} ] } 
                 sort { $a <=> $b } keys %games;
   });
   $slist->signal_connect (row_activated => sub {
      my ($sl, $path, $column) = @_;
      my $row_ref = $sl->get_row_data_from_path ($path);

      spawn_game_view ($igs, $row_ref->[0]);

      $igs->feed_event ("req_observe", $row_ref->[0]);
      $igs->feed_event ("req_moves", $row_ref->[0]);
   });

   $p->set_position (400);
   $hp->set_position (300);
        
   $igs->set_ev_cb ('game_list' => sub {
      my %game = %{$_[1]};
      $games{$game{number}} = { %game };
      push @{$slist->{data}}, [ @game{qw/number white white_rank black black_rank move size handicap komi byo Fflag Rflag/} ];
   });

   $igs->set_ev_cb ('player_list' => sub {
      my %player = %{$_[1]};
      push @{$plist->{data}}, [ @player{qw/name rank obs playing idle flags/} ];
#     @{$plist->{data}} = sort { $a->[0] cmp $b->[0] } @{$plist->{data}};
   });

   $win->show_all ();
}

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

my $igs = IGS::Protocol->new ();

$igs->init ("elmex", "lolfe123");

my $sck = con ("igs.joyjoy.net", 6969);

$igs->set_writer (sub { $sck->syswrite ($_[0]) });

$igs->set_ev_cb ('recv_file' => sub {
   print "FILE [ $_[1] ]\n";
});

$igs->sendline ('games');
$igs->sendline ('players');
my $buffer;

my $pos = $igs->set_ev_cb ('game_over' => sub {
   my ($self, $gnr, $result) = @_;
   delete $games{$gnr};
});

Gtk2::Helper->add_watch (fileno($sck), 'in', sub {
   my $data;

   my $r = $sck->sysread ($data, 4096);

   if (not $r) {
      # check $r == 0 or undef # FIXME
      die "eof from server";
   }

   $buffer .= $data;
   $igs->feed_data (\$buffer);

   1;
});

build_ui ($igs);

Gtk2->main;
Revision:	1.1
Committed:	Tue Jun 21 10:10:30 2005 UTC (18 years, 11 months ago) by elmex
Branch:	MAIN
Log Message:	fist checkin of the IGS client.
#	User	Rev	Content
1	elmex	1.1	#!/opt/bin/perl
2			package util;
3
4			sub format_time($) {
5			my ($time) = @_;
6
7			$time > 60*60
8			? sprintf "%d:%02d:%02d", $time / (60 * 60), $time / 60 % 60, $time % 60
9			: sprintf "%d:%02d", $time / 60 % 60, $time % 60;
10			}
11
12
13			package goclock;
14
15			use Time::HiRes ();
16
17			use Gtk2;
18			use Glib::Object::Subclass Gtk2::Label;
19
20			sub INIT_INSTANCE {
21			my $self = shift;
22
23			$self->signal_connect (destroy => sub { $_[0]->stop });
24
25			$self->{format} = sub {
26			if ($_[0] < 0) {
27			"TIMEOUT";
28			} elsif ($self->{moves} < 0) {
29			util::format_time $_[0];
30			} else {
31			my $time = int (($_[0] - 1) % $self->{interval} + 1);
32
33			sprintf "%s/%d (%d sec/move)",
34			util::format_time $time,
35			$self->{moves},
36			$self->{moves} > 1 ? $time / $self->{moves} : $self->{interval};
37			}
38			}
39
40			}
41
42			sub FINALIZE_INSTANCE {
43			my $self = shift;
44
45			$self->stop;
46			}
47
48			sub refresh {
49			my ($self) = @_;
50
51			my $timer = $self->{time};
52			print "TIM: $self->{time} $self->{moves} $self->{interval}\n";
53
54			$self->set_text ($self->{format}->($timer));
55			}
56
57			sub set_time {
58			my ($self, $start, $time, $moves, $interval) = @_;
59
60			$self->{interval} = $interval;
61			$self->{time} = $time;
62			$self->{moves} = $moves;
63
64			$self->refresh;
65			if ($start) {
66			$self->start;
67			} else {
68			$self->stop;
69			}
70			}
71
72			sub start {
73			my ($self, $interval) = @_;
74
75			$self->stop;
76
77			my $timeout; $timeout = sub {
78			$self->{timeout} = add Glib::Timeout 1000, $timeout;
79			$self->{time}--;
80			$self->refresh;
81			0;
82			};
83
84			$self->{time}++;
85			$timeout->();
86			}
87
88			sub stop {
89			my ($self) = @_;
90
91			remove Glib::Source delete $self->{timeout} if $self->{timeout};
92			}
93
94
95			package main;
96			use lib 'igsueme/';
97			use lib 'lib/';
98			use Glib;
99			use Gtk2 -init;
100			use Gtk2::Helper;
101			use Gtk2::SimpleList;
102			use Gtk2::GoBoard;
103			use Games::Go::SimpleBoard;
104			use IO::Socket::INET;
105			use IGS;
106			use strict;
107			require Data::Dumper;
108
109			my %games;
110
111			my @timers;
112
113			my %alphmap = (
114			A => 1,
115			B => 2,
116			C => 3,
117			D => 4,
118			E => 5,
119			F => 6,
120			G => 7,
121			H => 8,
122			J => 9,
123			K => 10,
124			L => 11,
125			M => 12,
126			N => 13,
127			O => 14,
128			P => 15,
129			Q => 16,
130			R => 17,
131			S => 18,
132			T => 19,
133			U => 20,
134			V => 21,
135			W => 22,
136			);
137
138			sub dump($) {
139			print Data::Dumper::Dumper ([$_[0]]);
140			}
141
142			sub con {
143			my ($host, $port) = @_;
144
145			my $socket = new IO::Socket::INET PeerAddr => $host, PeerPort => $port
146			or die "cannot connect to $host:$port: $!";
147
148			$socket->autoflush (1);
149			return $socket;
150			}
151
152			sub spawn_game_view {
153			my ($igs, $gamenr) = @_;
154
155			my $game = $games{$gamenr};
156			my $size = $game->{size};
157
158			return if not defined $game;
159
160			my $w = Gtk2::Window->new;
161			$w->set_default_size (600, 700);
162
163			$w->add (my $v = new Gtk2::VBox);
164			$v->pack_start ((new Gtk2::Label
165			"Game $gamenr: White: $game->{white} [$game->{white_rank}] vs. Black: $game->{black} [$game->{black_rank}]"), 0, 1, 0);
166			$v->pack_start ((new Gtk2::Label
167			"Size: $game->{size} Handicap: $game->{handicap}"), 0, 1, 0);
168			$v->pack_start ((my $clock1 = new goclock), 0, 1, 0);
169			$v->pack_start ((my $clock2 = new goclock), 0, 1, 0);
170			$v->pack_start ((my $msg = new Gtk2::Label), 0, 1, 0);
171			$v->pack_start ((my $mv_lbl = new Gtk2::Label), 0, 1, 0);
172
173			$v->pack_start ((my $board = new Gtk2::GoBoard size => $size), 1, 1, 0);
174
175
176			$msg->set_text ($game->{title});
177
178			my $p3 = $igs->set_ev_cb ('game_title' => sub {
179			my ($s, $gnr, $t) = @_;
180			$gnr == $gamenr or return;
181			$msg->set_text ($t);
182			$game->{title} = $t;
183			});
184
185			my $pos = $igs->set_ev_cb ('game_over' => sub {
186			my ($self, $gnr, $result) = @_;
187			$gnr == $gamenr or return;
188			$clock1->stop;
189			$clock2->stop;
190			$msg->set_text ($game->{title} . ": Game Over: $result");
191			});
192
193			my $pos2 = $igs->set_ev_cb ('game_move' => sub {
194			my $self = shift;
195			my $gnr = shift;
196
197			$gnr == $gamenr or return;
198
199			my $move = shift;
200
201			my $mnr = $move->{number};
202			$move->{coords} =~ m/^(.)(\d+)/;
203			my $x = $alphmap{$1} - 1;
204			my $y = $size - $2;
205
206			my $white_mv = $move->{color} eq 'white';
207
208			$game->{moves}->[$mnr] = $move;
209			my $mv = $game->{moves_struct}->[$mnr]
210			= [ $x, $y, ~MARK_CIRCLE, MARK_CIRCLE \| MARK_MOVE \| ($white_mv ? MARK_W : MARK_B), '' ];
211
212			print "MOVE $gamenr \| $mnr \| $gnr : $x, $y $move->{color} = $move->{white_time} <=> $move->{black_time} \| $move->{white_stones} <-> $move->{black_stones} \| $game->{byo}\n";
213
214			$mv_lbl->set_text ("Move " . ($mnr + 1));
215			$clock1->set_time ((not $white_mv), $move->{white_time}, $move->{white_stones}, $game->{byo} * 60);
216			$clock2->set_time ($white_mv, $move->{black_time}, $move->{black_stones}, $game->{byo} * 60);
217			if ($move->{white_time} == 0 && $move->{white_stones} == -1 && $move->{black_time} == 0 && $move->{black_stones} == -1) {
218			$clock1->stop ();
219			$clock2->stop ();
220			}
221
222			my $board_state = new Games::Go::SimpleBoard $size;
223			$board_state->update ($game->{moves_struct});
224			$board->set_board ($board_state);
225			});
226
227			$w->signal_connect (destroy => sub {
228			$igs->unset_ev_cb ('game_over', $pos);
229			$igs->unset_ev_cb ('game_move', $pos2);
230			$igs->unset_ev_cb ('game_title', $p3);
231			$igs->feed_event ('req_unobserve', $gamenr);
232			});
233
234			$w->show_all;
235			}
236
237			sub build_ui {
238			my $igs = shift;
239
240			my $win = Gtk2::Window->new;
241			$win->set_default_size (600, 800);
242
243			my $slist = Gtk2::SimpleList->new (
244			'N' => 'int', # game number
245			'White' => 'text',
246			'W Rank' => 'text',
247			'Black' => 'text',
248			'B Rank' => 'text',
249			'Move' => 'int',
250			'Size' => 'int',
251			'Hand' => 'int',
252			'Komi' => 'double',
253			'Byo' => 'int',
254			'F' => 'text',
255			'R' => 'text',
256			);
257
258			my $plist = Gtk2::SimpleList->new (
259			'Name' => 'text',
260			'Rank' => 'text',
261			'Obs' => 'int',
262			'Pla' => 'int',
263			'Idle' => 'text',
264			'Flags' => 'text',
265			);
266
267			$win->add (my $p = Gtk2::VPaned->new);
268			$p->add1 (my $sw = Gtk2::ScrolledWindow->new);
269			$sw->add ($slist);
270			$p->add2 (my $hp = Gtk2::HPaned->new);
271			$hp->add1 (my $sw = Gtk2::ScrolledWindow->new);
272			$sw->add_with_viewport (my $v = Gtk2::VBox->new);
273			$v->pack_start (my $txt = Gtk2::TextView->new, 1, 1, 0);
274			$v->pack_start (my $b1 = Gtk2::Button->new ('sort'), 0, 1, 0);
275			$hp->add2 (my $sw = Gtk2::ScrolledWindow->new);
276			$sw->add ($plist);
277
278			$b1->signal_connect (clicked => sub {
279			@{$slist->{data}} =
280			map { my %g = %{$games{$_}}; print "$g{number}\n"; [ @g{qw/number white white_rank black black_rank move size handicap komi byo Fflag Rflag/} ] }
281			sort { $a <=> $b } keys %games;
282			});
283			$slist->signal_connect (row_activated => sub {
284			my ($sl, $path, $column) = @_;
285			my $row_ref = $sl->get_row_data_from_path ($path);
286
287			spawn_game_view ($igs, $row_ref->[0]);
288
289			$igs->feed_event ("req_observe", $row_ref->[0]);
290			$igs->feed_event ("req_moves", $row_ref->[0]);
291			});
292
293			$p->set_position (400);
294			$hp->set_position (300);
295
296			$igs->set_ev_cb ('game_list' => sub {
297			my %game = %{$_[1]};
298			$games{$game{number}} = { %game };
299			push @{$slist->{data}}, [ @game{qw/number white white_rank black black_rank move size handicap komi byo Fflag Rflag/} ];
300			});
301
302			$igs->set_ev_cb ('player_list' => sub {
303			my %player = %{$_[1]};
304			push @{$plist->{data}}, [ @player{qw/name rank obs playing idle flags/} ];
305			# @{$plist->{data}} = sort { $a->[0] cmp $b->[0] } @{$plist->{data}};
306			});
307
308			$win->show_all ();
309			}
310
311			#################################################################################
312			#################################################################################
313			#################################################################################
314
315			my $igs = IGS::Protocol->new ();
316
317			$igs->init ("elmex", "lolfe123");
318
319			my $sck = con ("igs.joyjoy.net", 6969);
320
321			$igs->set_writer (sub { $sck->syswrite ($_[0]) });
322
323			$igs->set_ev_cb ('recv_file' => sub {
324			print "FILE [ $_[1] ]\n";
325			});
326
327			$igs->sendline ('games');
328			$igs->sendline ('players');
329			my $buffer;
330
331			my $pos = $igs->set_ev_cb ('game_over' => sub {
332			my ($self, $gnr, $result) = @_;
333			delete $games{$gnr};
334			});
335
336			Gtk2::Helper->add_watch (fileno($sck), 'in', sub {
337			my $data;
338
339			my $r = $sck->sysread ($data, 4096);
340
341			if (not $r) {
342			# check $r == 0 or undef # FIXME
343			die "eof from server";
344			}
345
346			$buffer .= $data;
347			$igs->feed_data (\$buffer);
348
349			1;
350			});
351
352			build_ui ($igs);
353
354			Gtk2->main;