[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 || $self->{interval} < 0 || $self->{moves} < 0) {
         util::format_time $_[0];

      } else {
         my $time = int $_[0];

         if ($self->{interval} != 0) {
            $time = int (($_[0] - 1) % $self->{interval} + 1);
         }

         sprintf "%s/%d = %d [s/mv]",
                 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 Glib;
use Gtk2 -init;
use Gtk2::Helper;
use Gtk2::SimpleList;
use Gtk2::GoBoard;
use Games::Go::SimpleBoard;
use IO::Socket::INET;
use Net::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 = new Net::IGS;

$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 (my $data, 4096);

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

   $igs->feed_data ($data);

   1;
});

build_ui ($igs);

Gtk2->main;

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