ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/game.pl
(Generate patch)

Comparing kgsueme/kgsueme/game.pl (file contents):
Revision 1.19 by pcg, Sun Jun 1 05:18:15 2003 UTC vs.
Revision 1.86 by pcg, Fri May 21 03:18:15 2004 UTC

1use utf8;
2
3use Scalar::Util ();
4
5package game::goclock;
6
7# Lo and Behold! I admit it! The rounding stuff etc.. in goclock
8# is completely borked.
9
10use Time::HiRes ();
11
12use KGS::Constants;
13
14use Glib::Object::Subclass
15 Gtk2::Label;
16
17sub INIT_INSTANCE {
18 my $self = shift;
19
20 $self->signal_connect (destroy => sub { $_[0]->stop });
21
22 $self->{set} = sub { };
23 $self->{format} = sub { "???" };
24}
25
26sub configure {
27 my ($self, $timesys, $main, $interval, $count) = @_;
28
29 if ($timesys == TIMESYS_ABSOLUTE) {
30 $self->{set} = sub { $self->{time} = $_[0] };
31 $self->{format} = sub { util::format_time $_[0] };
32
33 } elsif ($timesys == TIMESYS_BYO_YOMI) {
34 my $low = $interval * $count;
35
36 $self->{set} = sub { $self->{time} = $_[0] };
37
38 $self->{format} = sub {
39 if ($_[0] > $low) {
40 util::format_time $_[0] - $low;
41 } else {
42 sprintf "%s (%d)",
43 util::format_time int (($_[0] - 1) % $interval + 1),
44 ($_[0] - 1) / $interval;
45 }
46 };
47
48 } elsif ($timesys == TIMESYS_CANADIAN) {
49 $self->{set} = sub { $self->{time} = $_[0]; $self->{moves} = $_[1] };
50
51 $self->{format} = sub {
52 if (!$self->{moves}) {
53 util::format_time $_[0] - $low;
54 } else {
55 my $time = int (($_[0] - 1) % $interval + 1);
56
57 sprintf "%s/%d =%d",
58 util::format_time $time,
59 $self->{moves},
60 $self->{moves} > 1
61 ? $time / $self->{moves}
62 : $interval;
63 }
64 };
65
66 } else {
67 # none, or unknown
68 $self->{set} = sub { };
69 $self->{format} = sub { "---" }
70 }
71}
72
73sub refresh {
74 my ($self, $timestamp) = @_;
75 my $timer = $self->{time} + $self->{start} - $timestamp;
76
77 # we round the timer value slightly... the protocol isn't exact anyways,
78 # and this gives smoother timers ;)
79 my @format = $self->{format}->(int ($timer + 0.4));
80 $self->set_text ($self->{format}->(int ($timer + 0.4)));
81
82 $timer - int $timer;
83}
84
85sub set_time {
86 my ($self, $time) = @_;
87
88 # we ignore requests to re-set the time of a running clock.
89 # this is the easiest way to ensure that commentary etc.
90 # doesn't re-set the clock. yes, this is frickle design,
91 # but I think the protocol is to blame here, which gives
92 # very little time information. (cgoban2 also has had quite
93 # a lot of small time update problems...)
94 unless ($self->{timeout}) {
95 $self->{set}->($time->[0], $time->[1]);
96 $self->refresh ($self->{start});
97 }
98}
99
100sub start {
101 my ($self, $when) = @_;
102
103 $self->stop;
104
105 $self->{start} = $when;
106
107 my $timeout; $timeout = sub {
108 my $next = $self->refresh (Time::HiRes::time) * 1000;
109 $next += 1000 if $next < 0;
110 $self->{timeout} = add Glib::Timeout $next, $timeout;
111 0;
112 };
113
114 $timeout->();
115}
116
117sub stop {
118 my ($self) = @_;
119
120 remove Glib::Source delete $self->{timeout} if $self->{timeout};
121}
122
123package game::userpanel;
124
125use Glib::Object::Subclass
126 Gtk2::HBox,
127 properties => [
128 Glib::ParamSpec->IV ("colour", "colour", "User Colour", 0, 1, 0, [qw(construct-only writable)]),
129 ];
130
131sub INIT_INSTANCE {
132 my ($self) = @_;
133
134 $self->add (my $vbox = new Gtk2::VBox);
135
136 $vbox->add ($self->{name} = new Gtk2::Label $self->{name});
137 $vbox->add ($self->{info} = new Gtk2::Label "");
138 $vbox->add ($self->{clock} = new game::goclock); Scalar::Util::weaken $self->{clock};
139
140 $vbox->add ($self->{imagebox} = new Gtk2::VBox);
141
142 $self;
143}
144
145sub configure {
146 my ($self, $app, $user, $rules) = @_;
147
148 if ($self->{name}->get_text ne $user->as_string) {
149 $self->{name}->set_text ($user->as_string);
150
151 $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children;
152 $self->{imagebox}->add (gtk::image_from_data undef);
153 $self->{imagebox}->show_all;
154
155 if ($user->has_pic) {
156 # the big picture...
157 $app->userpic ($user->{name}, sub {
158 return unless $self->{imagebox};
159
160 if ($_[0]) {
161 $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children;
162 $self->{imagebox}->add (gtk::image_from_data $_[0]);
163 $self->{imagebox}->show_all;
164 }
165 });
166 }
167 }
168
169 $self->{clock}->configure (@{$rules}{qw(timesys time interval count)});
170}
171
172sub set_state {
173 my ($self, $captures, $timer, $when) = @_;
174
175 $self->{clock}->stop unless $when;
176 $self->{clock}->set_time ($timer);
177 $self->{clock}->start ($when) if $when;
178
179 $self->{info}->set_text ("$captures pris.");
180}
181
1package game; 182package game;
183
184use Scalar::Util qw(weaken);
2 185
3use KGS::Constants; 186use KGS::Constants;
4use KGS::Game::Board; 187use KGS::Game::Board;
5 188
189use Gtk2::GoBoard;
190
191use Glib::Object::Subclass
192 Gtk2::Window;
193
6use base KGS::Listener::Game; 194use base KGS::Listener::Game;
7use base KGS::Game; 195use base KGS::Game;
8 196
9use base gtk::widget;
10
11use POSIX qw(ceil); 197use POSIX qw(ceil);
12 198
13sub new { 199sub new {
14 my $self = shift; 200 my ($self, %arg) = @_;
15 $self = $self->SUPER::new(@_); 201 $self = $self->Glib::Object::new;
202 $self->{$_} = delete $arg{$_} for keys %arg;
16 203
17 $self->listen($self->{conn}); 204 $self->listen ($self->{conn});
18 205
19 $self->{window} = new Gtk2::Window 'toplevel';
20 my $title = $self->{channel} ? $self->owner->as_string." ".$self->opponent_string : "Game Window";
21 $self->{window}->set_title("KGS Game $title");
22 gtk::state $self->{window}, "game::window", undef, window_size => [600, 500]; 206 gtk::state $self, "game::window", undef, window_size => [600, 500];
23 207
24 $self->{window}->signal_connect(delete_event => sub { 208 $self->signal_connect (delete_event => sub { $self->part; 1 });
25 if ($self->{joined}) { 209 $self->signal_connect (destroy => sub { %{$_[0]} = () });
26 $self->part; 210
211 $self->add (my $hpane = new Gtk2::HPaned);
212 gtk::state $hpane, "game::hpane", undef, position => 500;
213
214 # LEFT PANE
215
216 $hpane->pack1 (($self->{left} = new Gtk2::VBox), 1, 0);
217
218 $self->{boardbox} = new Gtk2::VBox;
219
220 $hpane->pack1((my $vbox = new Gtk2::VBox), 1, 1);
221
222 # board box (aspect/canvas)
223
224 $self->{boardbox}->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0);
225
226 {
227 $frame->add (my $vbox = new Gtk2::VBox);
228 $vbox->add ($self->{title} = new Gtk2::Label $title);
229
230 $vbox->add (my $hbox = new Gtk2::HBox);
231
232 $hbox->pack_start (($self->{board_label} = new Gtk2::Label), 0, 1, 0);
233
234 $self->{moveadj} = new Gtk2::Adjustment 1, 1, 1, 1, 5, 0;
235
236 $hbox->pack_start ((my $scale = new Gtk2::HScale $self->{moveadj}), 1, 1, 0);
237 $scale->set_draw_value (0);
238 $scale->set_digits (0);
239
240 $self->{moveadj}->signal_connect (value_changed => sub { $self->update_board });
241 }
242
243 $self->{boardbox}->add ($self->{board} = new Gtk2::GoBoard size => $self->{size});
244
245 # RIGHT PANE
246
247 $hpane->pack2 (($self->{vpane} = new Gtk2::VPaned), 1, 1);
248 $hpane->set (position_set => 1);
249 gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80;
250
251 $self->{vpane}->add (my $sw = new Gtk2::ScrolledWindow);
252 $sw->set_policy ("automatic", "always");
253
254 $sw->add ($self->{userlist} = new userlist);
255
256 $self->{vpane}->add (my $vbox = new Gtk2::VBox);
257
258 $vbox->pack_start ((my $hbox = new Gtk2::HBox 1), 0, 1, 0);
259
260 $hbox->add ($self->{userpanel}[$_] = new game::userpanel colour => $_)
261 for COLOUR_WHITE, COLOUR_BLACK;
262
263 $vbox->pack_start (($self->{chat} = new superchat), 1, 1, 0);
264 weaken $self->{chat};
265
266 $self->{rules_inlay} = $self->{chat}->new_switchable_inlay ("Game Rules", sub { $self->draw_rules (@_) }, 1);
267
268 $self->{chat}->signal_connect (command => sub {
269 my ($chat, $cmd, $arg) = @_;
270 if ($cmd eq "rsave") {
271 Storable::nstore { tree => $self->{tree}, curnode => $self->{curnode}, move => $self->{move} }, $arg;#d#
27 } else { 272 } else {
28 $self->event_part; 273 $self->{app}->do_command ($chat, $cmd, $arg, userlist => $self->{userlist}, game => $self);
29 } 274 }
30 1;
31 });
32
33 $self->{window}->add($self->{hpane} = new Gtk2::HPaned);
34 gtk::state $self->{hpane}, "game::hpane", undef, position => 500;
35
36 $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1);
37
38 $vbox->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0);
39
40 {
41 # grrr...
42 $frame->add(my $vbox = new Gtk2::VBox);
43 $vbox->add($self->{title} = new Gtk2::Label $title);
44
45 $self->{moveadj} = new Gtk2::Adjustment 1, 0, 1, 0.001, 0.05, 0;
46
47 $vbox->add(my $scale = new Gtk2::HScale $self->{moveadj});
48 $scale->set_draw_value (0);
49
50 $self->{moveadj}->signal_connect (value_changed => sub {
51 return unless $self->{path};
52
53 my $move = int (@{$self->{path}} * $_[0]->get_value);
54
55 $self->{board_label}->set_text ("Move $move");
56
57 $self->{board} = new KGS::Game::Board $self->{size};
58 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]);
59
60 $self->redraw ($self->repaint_board);
61
62 $self->{text}->set_text(KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
63 });
64 }
65
66 #d#TYPOE
67 $vbox->pack_start((my $aspect_frame = gtk_aspect_frame_new Gtk2::AspectFrame "", 0.5, 0.5, 1, 0), 1, 1, 0);
68 $aspect_frame->set (border_width => 0);
69 $aspect_frame->set (shadow_type => 'none');
70 $self->{board_label} = $aspect_frame->get_label_widget;
71
72 $aspect_frame->add($self->{canvas} = new Gtk2::DrawingArea);
73 $self->{canvas}->double_buffered (0);
74
75 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
76 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
77
78 $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 0, 0);
79 $self->{hpane}->set(position_set => 1);
80 gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80;
81
82 $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow);
83 $sw->set_policy("automatic", "always");
84
85 $sw->add(($self->{userlist} = new userlist)->widget);
86
87 $self->{vpane}->add(my $vbox = new Gtk2::VBox);
88
89 $vbox->pack_start((my $sw = new Gtk2::ScrolledWindow), 1, 1, 0);
90 $sw->set_policy("never", "always");
91
92 $sw->add(($self->{text} = new gtk::text)->widget);
93
94 $vbox->pack_start(($self->{entry} = new Gtk2::Entry), 0, 1, 0);
95 $self->{entry}->signal_connect(activate => sub {
96 my $text = $self->{entry}->get_text;
97 $self->say($text) if $text =~ /\S/;
98 $self->{entry}->set_text("");
99 }); 275 });
100 276
101 $self; 277 $self;
102} 278}
103 279
104sub event_update_users { 280sub event_update_users {
105 my ($self, $add, $update, $remove) = @_; 281 my ($self, $add, $update, $remove) = @_;
106 282
283 return unless $self->{userlist};
284
107 $self->{userlist}->update ($add, $update, $remove); 285 $self->{userlist}->update ($add, $update, $remove);
286
287 my %important;
288 $important{$self->{user1}{name}}++;
289 $important{$self->{user2}{name}}++;
290 $important{$self->{user3}{name}}++;
291
292 if (my @users = grep $important{$_->{name}}, @$add) {
293 $self->{chat}->append_text ("\n<header>Joins:</header>");
294 $self->{chat}->append_text (" <user>" . $_->as_string . "</user>") for @users;
295 }
296 if (my @users = grep $important{$_->{name}}, @$remove) {
297 $self->{chat}->append_text ("\n<header>Parts:</header>");
298 $self->{chat}->append_text (" <user>" . $_->as_string . "</user>") for @users;
299 }
300
108} 301}
109 302
110sub join { 303sub join {
111 my ($self) = @_; 304 my ($self) = @_;
305 return if $self->{joined};
306
112 $self->SUPER::join; 307 $self->SUPER::join;
113 308
114 $self->{window}->show_all; 309 $self->show_all;
115} 310}
116 311
117sub part { 312sub update_board {
118 my ($self) = @_; 313 my ($self) = @_;
119 $self->SUPER::part; 314 return unless $self->{path};
120 315
121 $self->{window}->hide; 316 my $move = int $self->{moveadj}->get_value;
122}
123 317
124sub configure_event { 318 my $running = $move == @{$self->{path}};
125 my ($widget, $event, $self) = @_;
126 delete $self->{stack};
127 delete $self->{pixbuf};
128 delete $self->{board_shown};
129 delete $self->{background};
130 $self->repaint_board;
131 0;
132}
133 319
134sub expose_event { 320 $self->{board_label}->set_text ("Move " . ($move - 1));
135 my ($widget, $event, $self) = @_;
136 321
137 $self->{pixbuf} or return; 322 $self->{cur_board} = new KGS::Game::Board $self->{size};
323 $self->{cur_board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]);
138 324
139 my $area = $event->area; 325 for my $colour (COLOUR_WHITE, COLOUR_BLACK) {
140 326 $self->{userpanel}[$colour]->set_state (
141 $self->redraw ($area); 327 $self->{cur_board}{captures}[$colour],
142 328 $self->{cur_board}{timer}[$colour],
143 0; 329 ($running && $self->{lastmove_colour} == !$colour)
144} 330 ? $self->{lastmove_time} : 0
145
146# something Gtk2 fixed
147sub INTERP_NEAREST (){ 'nearest' }
148sub INTERP_TILES (){ 'tiles' }
149sub INTERP_BILINEAR (){ 'bilinear' }
150sub INTERP_HYPER (){ 'hyper' }
151
152sub new_pixbuf {
153 my ($w, $h, $alpha, $fill) = @_;
154
155 my $pixbuf = new Gtk2::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;
156 $pixbuf->fill ($fill) if defined $fill;
157
158 $pixbuf;
159}
160
161sub scale_pixbuf {
162 my ($src, $w, $h, $mode) = @_;
163
164 my $dst = new_pixbuf $w, $h, 1;
165
166 $src->scale(
167 $dst, 0, 0, $w, $h, 0, 0,
168 $w / $src->get_width, $h / $src->get_height,
169 $mode,
170 ); 331 );
332 }
171 333
172 $dst; 334 $self->{board}->set_board ($self->{cur_board});
173} 335}
174 336
175# create a stack of stones 337sub event_update_tree {
176sub create_stack { 338 my ($self) = @_;
177 my ($self, $mark, $size, $rand) = @_;
178 339
179 my $shadow = $size * 0.05; 340 $self->{path} = $self->get_path;
180 341
181 my $c = \$self->{stack}{$mark}; 342 if ($self->{moveadj}) {
182 unless ($$c) { 343 my $upper = $self->{moveadj}->upper;
183 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) { 344 my $pos = $self->{moveadj}->get_value;
184 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 0x00000000; 345 my $move = scalar @{$self->{path}};
185 346
186 # zeroeth the shadow 347 $self->{moveadj}->upper ($move);
187 if ($mark & (MARK_B | MARK_W)) {
188 $::shadow_img->composite (
189 $base, $shadow, $shadow, $size, $size, $shadow - 0.5, $shadow - 0.5,
190 $size / $stone->get_width, $size / $stone->get_height,
191 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 192
192 );
193 } 348
194 349 $self->{moveadj}->changed;
195 # first the big stones (handicap stones different for effect) 350 if ($pos == $upper) {
196 for ([MARK_B, $mark & MARK_MOVE ? 255 : 192], 351 $self->{moveadj}->value ($move);
197 [MARK_W, $mark & MARK_MOVE ? 255 : 192], 352 $self->{moveadj}->value_changed;
198 [MARK_GRAY_B, 128],
199 [MARK_GRAY_W, 128]) {
200 my ($mask, $alpha) = @$_;
201 if ($mark & $mask) {
202 $stone->composite (
203 $base, 0, 0, $size, $size, 0, 0,
204 $size / $stone->get_width, $size / $stone->get_height,
205 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, $alpha
206 );
207 }
208 }
209
210 # then the small stones
211 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]],
212 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) {
213 my ($mask, $img) = @$_;
214 if ($mark & $mask) {
215 $img->composite (
216 $base, (ceil ($size / 4)) x2, (ceil ($size / 2)) x2, (ceil ($size / 4)) x2,
217 $size / $img->get_width / 2, $size / $img->get_height / 2,
218 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 224
219 );
220 }
221 }
222
223 # and lastly any markers
224 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
225
226 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
227 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
228 [MARK_SQUARE, $::square_img[$dark_bg]]) {
229 my ($mask, $img) = @$_;
230 if ($mark & $mask) {
231 $img->composite (
232 $base, 0, 0, $size, $size, -0.5, -0.5,
233 $size / $img->get_width, $size / $img->get_height,
234 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255
235 );
236 }
237 }
238
239 push @$$c, $base;
240 } 353 }
241 } 354 }
242
243 $$c->[$rand % @$$c];
244} 355}
245 356
246sub pixbuf_text { 357sub event_update_comments {
247 my ($pixbuf, $colour, $x, $y, $height, $text) = @_; 358 my ($self, $node, $comment, $newnode) = @_;
359 $self->SUPER::event_update_comments($node, $comment, $newnode);
248 360
249 my @c = grep $_, 361 my $text;
250 map $::font[$colour][$::fontmap{$_}],
251 split //, $text;
252 362
253 if (@c) { 363 $text .= "\n<header>Move <move>$node->{move}</move>, Node <node>$node->{id}</node></header>"
254 my $spacing = $height * 0.1; 364 if $newnode;
255 my $s = $height / List::Util::max map $_->get_height, @c;
256 my $W = List::Util::sum map $_->get_width, @c;
257 365
258 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5; 366 for (split /\n/, $comment) {
259 $y -= $height * 0.5; 367 $text .= "\n";
260 368 if (s/^([0-9a-zA-Z]+ \[[0-9dkp\?\-]+\])://) {
261 for (@c) { 369 $text .= "<user>" . (util::toxml $1) . "</user>:";
262 my $w = $_->get_width * $s;
263 # +2 == don't fight the rounding
264 $_->composite ($pixbuf,
265 $x, $y, $w+2, $height+2, $x, $y, $s, $s,
266 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
267
268 $x += $w + $spacing;
269 } 370 }
270 }
271}
272
273sub pixbuf_rect {
274 my ($pb, $colour, $x1, $y1, $x2, $y2, $alpha) = @_;
275 # we fake lines by... a horrible method :/
276 my $colour_pb = new_pixbuf 1, 1, 0, $colour;
277 $colour_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, $x2 + 1, $y2 + 1,
278 INTERP_NEAREST, $alpha);
279}
280
281sub repaint_board {
282 my ($self) = @_;
283 my $canvas = $self->{canvas};
284 my $expose_area = undef;
285
286 return $expose_area unless $self->{board};
287
288 my ($w, $h) = ($canvas->allocation->values)[2,3];
289
290 die "FATAL: board aspect ratio != 1" unless $w == $h;
291
292 my $s = $w;
293
294 return unless $s >= 200;
295
296 my $size = $self->{size};
297
298 # we leave enough space for the shadows.. I like smaller stones, and we
299 # do no need to do the nifty recursive screen updates that goban2 does
300 my $border = int ($s / ($size + 3) * 0.5);
301 my $s2 = $s - $border * 2;
302 my $edge = int ($s2 / ($size + 1) * 0.96) - ($::config->{randomize} ? 3 : 0);
303 my $ofs = int ($edge / 2);
304
305 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
306
307 my $pixbuf;
308
309 my $oldboard;
310
311 if ($self->{background}) {
312 if ($oldboard = $self->{board_shown}) {
313 $pixbuf = $self->{pixbuf};
314 } else {
315 $pixbuf = $self->{background}->copy;
316 $expose_area = new Gtk2::Gdk::Rectangle 0, 0, $s, $s;
317 } 371
318 } else { 372 # coords only for 19x19 so far
319 $expose_area = new Gtk2::Gdk::Rectangle 0, 0, $s, $s; 373 $_ = util::toxml $_;
320
321 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
322
323 if ($s < $bw && $s < $bh) {
324 $pixbuf = new_pixbuf $s, $s, 0;
325 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
326 } else {
327 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config->{speed} ? INTERP_NEAREST : INTERP_TILES;
328 } 374 s{
329
330 my $linew = int ($s / 25 / $size);
331
332 # ornamental border... we have time to waste :/
333 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $s-1, $linew, 255;
334 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $linew, $s-1, 255;
335 pixbuf_rect $pixbuf,0xffcc7700, $s-$linew-1, 0, $s-1, $s-1, 255;
336 pixbuf_rect $pixbuf,0xffcc7700, 0, $s-$linew-1, $s-1, $s-1, 255;
337
338 for my $i (1 .. $size) {
339 pixbuf_rect $pixbuf, 0x44111100, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew, 192;
340 pixbuf_rect $pixbuf, 0x44111100, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew, 192;
341
342 # 38 max, but we allow a bit more
343 my $label = (qw(- A B C D E F G H J K L M N O P Q R S T U V W X Y Z
344 AA BB CC DD EE FF GG HH JJ KK LL MM NN OO PP QQ RR SS TT UU VV WW XX YY ZZ))[$i];
345
346 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
347 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
348 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
349 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
350
351 $a++;
352 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
353 }
354
355 unless ($::config->{conserve_memory}) {
356 $self->{background} = $pixbuf;
357 $pixbuf = $pixbuf->copy;
358 }
359 }
360
361 $self->{pixbuf} = $pixbuf;
362
363 # hoshi-points(!)#d#
364 # caching of empty board gfx(!)#d#
365
366 for my $x (1 .. $size) {
367 for my $y (1 .. $size) {
368 my $rand = ($x ^ $y ^ 0x5555);
369
370 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
371
372 if ($::config->{randomize}) {
373 $dx += ($rand % 7) - 3;
374 $dy += ($rand / 3 % 7) - 3;
375 }
376
377 my $shadow = $edge * 0.05;
378 my $area = [$dx, $dy, $edge + $shadow, $edge + $shadow];
379 375 (
380 my $mark = $self->{board}{board}[$x-1][$y-1];
381 my $old = $oldboard ? $oldboard->{board}[$x-1][$y-1] : 0;
382
383 if ($oldboard) {
384 next if $old == $mark; # no change
385
386 $self->{background}->copy_area (@$area, $pixbuf, $dx, $dy);
387 $expose_area = $expose_area
388 ? $expose_area->union (new Gtk2::Gdk::Rectangle @$area)
389 : new Gtk2::Gdk::Rectangle @$area;
390 }
391
392 if ($mark) {
393 my $pb = $self->create_stack($mark, $edge, $rand);
394
395 $pb->composite ($pixbuf, @$area,
396 $dx, $dy, 1, 1, $::config->{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
397
398 # labels are handled here because they are quite rare
399 if ($mark & MARK_LABEL) {
400 my $white = $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1;
401
402 if ($white) {
403 pixbuf_text $pixbuf, 0,
404 $k[$x] + $ofs * 0.1, $k[$y] + $ofs * 0.1, $ofs * 0.7,
405 $self->{board}{label}[$x-1][$y-1];
406 }
407 pixbuf_text $pixbuf, $white,
408 $k[$x], $k[$y], $ofs * 0.7,
409 $self->{board}{label}[$x-1][$y-1];
410 }
411 376 \b
412 # old pixmap&mask-way. that was fast ;( 377 (?:[bw])?
413 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 ); 378 [, ]{0,2}
414 379 [a-hj-t] # valid for upto 19x19
415 #$gc->set_clip_mask ($bm); 380 \s?
416 #$gc->set_clip_origin ($dx, $dy); 381 [1-9]?[0-9]
417 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge); 382 \b
418 } 383 )
419 } 384 }{
420 } 385 "<coord>$1</coord>";
386 }sgexi;
421 387
422 $self->{board_shown} = Storable::dclone $self->{board}; 388 $text .= $_;
423 #d# save 389 }
424 #Storable::nstore { board => $self->{board}, size => $self->{size}, path => $self->{path}}, "testboard.storable";
425 390
426 $expose_area; 391 $self->{chat}->append_text ($text);
427} 392}
428 393
429sub redraw { 394sub event_join {
430 my ($self, $area) = @_; 395 my ($self) = @_;
431 396
432 if ($area && $self->{pixbuf}) { 397 $self->SUPER::event_join (@_);
433 my ($x, $y, $w, $h) = $area->values; 398 $self->event_update_game;
434
435 $self->{canvas}->window->draw_pixbuf ($self->{canvas}->style->white_gc, $self->{pixbuf},
436 $x, $y, $x, $y, $w, $h,
437 "normal", 0, 0);
438 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0,
439 $x - 1, $y - 1, $w + 2, $h + 2) if $::DEBUG_EXPOSE;
440 }
441}
442
443sub event_update_tree {
444 my ($self) = @_;
445
446 $self->{path} = $self->get_path;
447 $self->{moveadj}->value_changed if $self->{moveadj};
448} 399}
449 400
450sub event_part { 401sub event_part {
451 my ($self) = @_; 402 my ($self) = @_;
403
452 $self->SUPER::event_part; 404 $self->SUPER::event_part;
453 delete $appwin::gamelist->{game}{$self->{channel}};
454 $self->destroy; 405 $self->destroy;
455} 406}
456 407
457sub event_move { 408sub event_move {
458 my ($self, $pass) = @_; 409 my ($self, $pass) = @_;
459 sound::play 1, $pass ? "pass" : "move"; 410 sound::play 1, $pass ? "pass" : "move";
460} 411}
461 412
413sub event_update_game {
414 my ($self) = @_;
415 $self->SUPER::event_update_game;
416
417 return unless $self->{joined};
418
419 my $title = defined $self->{channel}
420 ? $self->owner->as_string . " " . $self->opponent_string
421 : "Game Window";
422 $self->set_title("KGS Game $title");
423 $self->{title}->set_text ($title);
424
425 $self->{user}[COLOUR_BLACK] = $self->{user1};
426 $self->{user}[COLOUR_WHITE] = $self->{user2};
427
428 # show board
429 if ($self->is_inprogress) {
430 $self->{left}->add ($self->{boardbox}) unless $self->{boardbox}->parent;
431 if (my $ch = delete $self->{challenge}) {
432 (delete $_->{inlay})->clear for values %$ch;
433 }
434 }
435
436 $self->{left}->show_all;
437
438 # view text
439
440 eval { #d#
441 my @ga;
442 $ga[0] = "\nType: " . (util::toxml $gametype{$self->type})
443 . " (" . (util::toxml $gameopt{$self->option}) . ")";
444 $ga[1] = "\nFlags:";
445 $ga[1] .= " started" if $self->is_inprogress;
446 $ga[1] .= " adjourned" if $self->is_adjourned;
447 $ga[1] .= " scored" if $self->is_scored;
448 $ga[1] .= " saved" if $self->is_saved;
449
450 $ga[2] = "\nOwner: <user>" . (util::toxml $self->{user3}->as_string) . "</user>"
451 if $self->{user3}->is_inprogress;
452
453 $ga[3] = "\nPlayers: <user>" . (util::toxml $self->{user2}->as_string) . "</user>"
454 . " vs. <user>" . (util::toxml $self->{user1}->as_string) . "</user>"
455 if $self->is_inprogress;
456
457 if ($self->is_inprogress) {
458 $ga[4] = "\nHandicap: " . $self->{handicap};
459 $ga[5] = "\nKomi: " . $self->{komi};
460 $ga[6] = "\nSize: " . $self->size_string;
461 }
462
463 if ($self->is_scored) {
464 $ga[7] = "\nResult: " . $self->score_string;
465 }
466
467 $text = "\n<infoblock><header>Game Update</header>";
468 for (0..7) {
469 if ($self->{gatext}[$_] ne $ga[$_]) {
470 $text .= $ga[$_];
471 }
472 }
473 $text .= "</infoblock>";
474
475 $self->{gatext} = \@ga;
476 };
477
478 $self->{chat}->append_text ($text);
479}
480
481sub draw_rules {
482 my ($self, $inlay) = @_;
483
484 my $rules = $self->{rules};
485
486 my $text = "";
487
488 $text .= "\nRuleset: " . $ruleset{$rules->{ruleset}};
489
490 $text .= "\nTime: ";
491
492 if ($rules->{timesys} == TIMESYS_NONE) {
493 $text .= "UNLIMITED";
494 } elsif ($rules->{timesys} == TIMESYS_ABSOLUTE) {
495 $text .= util::format_time $rules->{time};
496 $text .= " ABS";
497 } elsif ($rules->{timesys} == TIMESYS_BYO_YOMI) {
498 $text .= util::format_time $rules->{time};
499 $text .= sprintf " + %s (%d) BY", util::format_time $rules->{interval}, $rules->{count};
500 } elsif ($rules->{timesys} == TIMESYS_CANADIAN) {
501 $text .= util::format_time $rules->{time};
502 $text .= sprintf " + %s/%d CAN", util::format_time $rules->{interval}, $rules->{count};
503 }
504
505 $inlay->clear;
506 $inlay->append_text ("<infoblock>$text</infoblock>");
507}
508
509sub event_update_rules {
510 my ($self, $rules) = @_;
511
512 $self->{rules} = $rules;
513
514 if ($self->{user}) {
515 $self->{userpanel}[$_]->configure ($self->{app}, $self->{user}[$_], $rules)
516 for COLOUR_BLACK, COLOUR_WHITE;
517 }
518
519 sound::play 3, "gamestart";
520
521 $self->draw_rules ($self->{rules_inlay});
522}
523
524sub inject_resign_game {
525 my ($self, $msg) = @_;
526
527 sound::play 3, "resign";
528
529 $self->{chat}->append_text ("\n<infoblock><header>Resign</header>"
530 . "\n<user>"
531 . (util::toxml $self->{user}[$msg->{player}]->as_string)
532 . "</user> resigned.</infoblock>");
533}
534
535sub inject_final_result {
536 my ($self, $msg) = @_;
537
538 $self->{chat}->append_text ("<infoblock>\n<header>Game Over</header>"
539 . "\nWhite Score " . (util::toxml $msg->{whitescore}->as_string)
540 . "\nBlack Score " . (util::toxml $msg->{blackscore}->as_string)
541 . "</infoblock>"
542 );
543}
544
545sub draw_challenge {
546 my ($self, $c) = @_;
547
548 my $inlay = $c->{inlay};
549 my $challenge = $c->{challenge};
550 my $rules = $challenge->{rules};
551
552 my $as_black = $challenge->{user1}{name} eq $self->{conn}{name};
553 my $opponent = $as_black ? $challenge->{user2} : $challenge->{user1};
554
555 $inlay->clear;
556 $inlay->append_text ("\n<challenge>Challenge to <user>" . $opponent->as_string . "</user></challenge>");
557 $inlay->append_text ("\nHandicap: $rules->{handicap}");
558
559#bless( (
560# gametype => 3,
561# user1 => bless( {
562# flags => 2633,
563# name => 'dorkusx'
564# }, 'KGS::User' ),
565# rules => bless( {
566# count => 5,
567# time => 900,
568# timesys => 2,
569# interval => 30,
570# komi => '6.5',
571# size => 19,
572# ruleset => 0,
573# handicap => 0
574# }, 'KGS::Rules' ),
575# user2 => bless( {
576# flags => 436220808,
577# name => 'Nerdamus'
578# }, 'KGS::User' )
579# ), 'KGS::Challenge' )
580}
581
582sub event_challenge {
583 my ($self, $challenge) = @_;
584
585 my $as_black = $challenge->{user1}{name} eq $self->{conn}{name};
586 my $opponent = $as_black ? $challenge->{user2} : $challenge->{user1};
587
588 my $c = $self->{challenge}{$opponent->{name}} ||= {};
589
590 $c->{inlay} ||= $self->{chat}->new_inlay;
591 $c->{challenge} = $challenge;
592
593 $self->draw_challenge ($c);
594
595# require KGS::Listener::Debug;
596# $self->{chat}->append_text ("\n".KGS::Listener::Debug::dumpval($challenge));
597}
598
4621; 5991;
463 600

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines