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.1 by pcg, Sat May 31 09:46:51 2003 UTC vs.
Revision 1.2 by pcg, Sat May 31 10:58:30 2003 UTC

24 24
25 $hpane->pack1((my $vbox = new Gtk2::VBox), 1, 1); 25 $hpane->pack1((my $vbox = new Gtk2::VBox), 1, 1);
26 26
27 $vbox->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0); 27 $vbox->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0);
28 28
29 # grrr...
29 { 30 {
30 $frame->add(my $vbox = new Gtk2::VBox); 31 $frame->add(my $vbox = new Gtk2::VBox);
31 $vbox->add($self->{title} = new Gtk2::Label $title); 32 $vbox->add($self->{title} = new Gtk2::Label $title);
32 33
33 $self->{moveadj} = new Gtk2::Adjustment 0, 0, 0, 1, 10, 0; 34 $self->{moveadj} = new Gtk2::Adjustment 0, 0, 1, 0.01, 0.1, 0;
35
34 $vbox->add(my $scale = new Gtk2::HScale $self->{moveadj}); 36 $vbox->add(my $scale = new Gtk2::HScale $self->{moveadj});
35 $scale->set_draw_value (1); 37 $scale->set_draw_value (0);
36 $scale->set_digits (0);
37 $scale->set_value_pos('top');
38 38
39 $self->{moveadj}->signal_connect (value_changed => sub { 39 $self->{moveadj}->signal_connect (value_changed => sub {
40 return unless $self->{path};
41
42 my $move = int (@{$self->{path}} * $_[0]->get_value);
43
40 $self->{board} = new KGS::Game::Board $self->{size}; 44 $self->{board} = new KGS::Game::Board $self->{size};
41 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]); 45 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]);
42 46
43 my $area = $self->repaint_board; 47 $self->redraw ($self->repaint_board);
44 48
45 # force a redraw (not perfect(?))
46 $self->expose ($area);
47
48 $self->{text}->backward_delete($self->{text}->get_length);
49 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment}); 49 $self->{text}->set_text(KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
50 }); 50 });
51
52 $self->{moveadj}->upper (scalar @{$self->{path}}) if $self->{path};
53 } 51 }
54 52
55 Gtk2::Widget->push_visual (Gtk2::Gdk::Rgb->get_visual); 53 #Gtk2::Widget->push_visual (Gtk2::Gdk::Rgb->get_visual); #d# gdk_rgb_* not yet implemented(?)
56 Gtk2::Widget->push_colormap (Gtk2::Gdk::Rgb->get_cmap); 54 #Gtk2::Widget->push_colormap (Gtk2::Gdk::Rgb->get_cmap);
57 $vbox->pack_start(($self->{canvas} = new Gtk2::DrawingArea), 1, 1, 0); 55 $vbox->pack_start(($self->{canvas} = new Gtk2::DrawingArea), 1, 1, 0);
58 Gtk2::Widget->pop_colormap; 56 #Gtk2::Widget->pop_colormap;
59 Gtk2::Widget->pop_visual; 57 #Gtk2::Widget->pop_visual;
60 58
61 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); 59 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
62 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); 60 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
63 61
64 $hpane->pack2((my $vpane = new Gtk2::VPaned), 0, 0); 62 $hpane->pack2((my $vpane = new Gtk2::VPaned), 0, 0);
65 gtk::state $vpane, "game", $self->{name}, vpane_position => 80; 63 gtk::state $vpane, "game", $self->{name}, vpane_position => 80;
66 64
67 $vpane->add(my $sw = new Gtk2::ScrolledWindow); 65 $vpane->add(my $sw = new Gtk2::ScrolledWindow);
68 $sw->set_policy("automatic", "always"); 66 $sw->set_policy("automatic", "always");
69 67
68 if (0) {
70 $sw->add($self->{userlist} = new_with_titles Gtk2::ListStore "User", "Rank", "Flags"); 69 $sw->add($self->{userlist} = new_with_titles Gtk2::ListStore "User", "Rank", "Flags");
71 ::clist_autosort $self->{userlist}; 70 ::clist_autosort $self->{userlist};
72 gtk::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30]; 71 gtk::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
72 }
73 73
74 $vpane->add(my $vbox = new Gtk2::VBox); 74 $vpane->add(my $vbox = new Gtk2::VBox);
75 75
76 $vbox->pack_start((my $sw = new Gtk2::ScrolledWindow), 1, 1, 0); 76 $vbox->pack_start((my $sw = new Gtk2::ScrolledWindow), 1, 1, 0);
77 $sw->set_policy("automatic", "always"); 77 $sw->set_policy("automatic", "always");
78 78
79 $sw->add($self->{text} = new Gtk2::Text); 79 $sw->add(($self->{text} = new gtk::text)->widget);
80 80
81 $vbox->pack_start(($self->{entry} = new Gtk2::Entry), 0, 1, 0); 81 $vbox->pack_start(($self->{entry} = new Gtk2::Entry), 0, 1, 0);
82 $self->{entry}->signal_connect(activate => sub { 82 $self->{entry}->signal_connect(activate => sub {
83 my $text = $self->{entry}->get_text; 83 my $text = $self->{entry}->get_text;
84 # add message 84 # add message
107 107
108 $self->{window}->hide; 108 $self->{window}->hide;
109} 109}
110 110
111sub configure_event { 111sub configure_event {
112 my ($widget, $self, $event) = @_; 112 my ($widget, $event, $self) = @_;
113 delete $self->{stack}; 113 delete $self->{stack};
114 delete $self->{pixbuf}; 114 delete $self->{pixbuf};
115 delete $self->{board_shown}; 115 delete $self->{board_shown};
116 delete $self->{background}; 116 delete $self->{background};
117 $self->repaint_board; 117 $self->repaint_board;
118 1; 118 1;
119} 119}
120 120
121# something Gtk2 fixed
121sub INTERP_NEAREST (){ 1 } 122sub INTERP_NEAREST (){ 'nearest' }
122sub INTERP_TILES (){ 1 } 123sub INTERP_TILES (){ 'tiles' }
123sub INTERP_BILINEAR (){ 2 } 124sub INTERP_BILINEAR (){ 'bilinear' }
124sub INTERP_HYPER (){ 3 } 125sub INTERP_HYPER (){ 'hyper' }
125 126
126sub new_pixbuf { 127sub new_pixbuf {
127 my ($w, $h, $alpha, $clear) = @_; 128 my ($w, $h, $alpha, $fill) = @_;
128 129
129 my $pixbuf = new Gtk2::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h; 130 my $pixbuf = new Gtk2::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;
130 131 $pixbuf->fill ($fill) if defined $fill;
131 if ($clear) { # damn, need to clear it ourselves
132 my $row = "\x00\x00\x00\x00" x $w;
133 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1;
134 }
135 132
136 $pixbuf; 133 $pixbuf;
137} 134}
138 135
139sub scale_pixbuf { 136sub scale_pixbuf {
157 my $shadow = $size * 0.05; 154 my $shadow = $size * 0.05;
158 155
159 my $c = \$self->{stack}{$mark}; 156 my $c = \$self->{stack}{$mark};
160 unless ($$c) { 157 unless ($$c) {
161 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) { 158 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
162 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1; 159 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 0x00000000;
163 160
164 # zeroeth the shadow 161 # zeroeth the shadow
165 if ($mark & (MARK_B | MARK_W)) { 162 if ($mark & (MARK_B | MARK_W)) {
166 $::black_img[0]->composite ( 163 $::black_img[0]->composite (
167 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5, 164 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
168 $size / $stone->get_width, $size / $stone->get_height, 165 $size / $stone->get_width, $size / $stone->get_height,
169 $::config->{speed} ? INTERP_NEAREST : INTERP_TILES, 128 166 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 128
170 ); 167 );
171 } 168 }
172 169
173 # first the big stones (handicap stones different for effect) 170 # first the big stones (handicap stones different for effect)
174 for ([MARK_B, $mark & MARK_MOVE ? 255 : 192], 171 for ([MARK_B, $mark & MARK_MOVE ? 255 : 192],
178 my ($mask, $alpha) = @$_; 175 my ($mask, $alpha) = @$_;
179 if ($mark & $mask) { 176 if ($mark & $mask) {
180 $stone->composite ( 177 $stone->composite (
181 $base, 0, 0, $size, $size, -0.5, -0.5, 178 $base, 0, 0, $size, $size, -0.5, -0.5,
182 $size / $stone->get_width, $size / $stone->get_height, 179 $size / $stone->get_width, $size / $stone->get_height,
183 $::config->{speed} ? INTERP_NEAREST : INTERP_HYPER, $alpha 180 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, $alpha
184 ); 181 );
185 } 182 }
186 } 183 }
187 184
188 # then the samll stones 185 # then the samll stones
191 my ($mask, $img) = @$_; 188 my ($mask, $img) = @$_;
192 if ($mark & $mask) { 189 if ($mark & $mask) {
193 $img->composite ( 190 $img->composite (
194 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2, 191 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2,
195 $size / $img->get_width / 2, $size / $img->get_height / 2, 192 $size / $img->get_width / 2, $size / $img->get_height / 2,
196 $::config->{speed} ? INTERP_NEAREST : INTERP_HYPER, 192 193 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 192
197 ); 194 );
198 } 195 }
199 } 196 }
200 197
201 # and lastly any markers 198 # and lastly any markers
207 my ($mask, $img) = @$_; 204 my ($mask, $img) = @$_;
208 if ($mark & $mask) { 205 if ($mark & $mask) {
209 $img->composite ( 206 $img->composite (
210 $base, 0, 0, $size, $size, -0.5, -0.5, 207 $base, 0, 0, $size, $size, -0.5, -0.5,
211 $size / $img->get_width, $size / $img->get_height, 208 $size / $img->get_width, $size / $img->get_height,
212 $::config->{speed} ? INTERP_NEAREST : INTERP_HYPER, 255 209 $::config->{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255
213 ); 210 );
214 } 211 }
215 } 212 }
216 213
217 push @$$c, $base; 214 push @$$c, $base;
247 } 244 }
248} 245}
249 246
250sub pixbuf_rect { 247sub pixbuf_rect {
251 my ($pb, $colour, $x1, $y1, $x2, $y2, $alpha) = @_; 248 my ($pb, $colour, $x1, $y1, $x2, $y2, $alpha) = @_;
252 # we fake lines by... an unspeakable method :/ 249 # we fake lines by... a horrible method :/
253 my $colour_pb = new_pixbuf 1, 1, 0, 0; 250 my $colour_pb = new_pixbuf 1, 1, 0, $colour;
254 $colour_pb->put_pixels ($colour, 0, 0);
255
256 $colour_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, 1, 1, INTERP_NEAREST, $alpha); 251 $colour_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, $x2 + 1, $y2 + 1,
252 INTERP_NEAREST, $alpha);
257} 253}
258 254
259sub repaint_board { 255sub repaint_board {
260 my ($self) = @_; 256 my ($self) = @_;
261 my $canvas = $self->{canvas}; 257 my $canvas = $self->{canvas};
262 my $expose_area = undef; 258 my $expose_area = undef;
263 259
264 return $expose_area unless $self->{board}; 260 return $expose_area unless $self->{board};
265 261
266 my ($w, $h) = @{$canvas->allocation}[2,3]; 262 my ($w, $h) = ($canvas->allocation->values)[2,3];
267 263
268 my $s = $w > $h ? $h : $w; 264 my $s = $w > $h ? $h : $w;
269 265
270 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s]; 266 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
271 267
293 $expose_area = [0, 0, $s, $s]; 289 $expose_area = [0, 0, $s, $s];
294 290
295 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height); 291 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
296 292
297 if ($s < $bw && $s < $bh) { 293 if ($s < $bw && $s < $bh) {
298 $pixbuf = new_pixbuf $s, $s, $::config->{conserve_memory} ? 0 : 1, 0; 294 $pixbuf = new_pixbuf $s, $s, 0;
299 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0); 295 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
300 } else { 296 } else {
301 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config->{speed} ? INTERP_NEAREST : INTERP_TILES; 297 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config->{speed} ? INTERP_NEAREST : INTERP_TILES;
302 } 298 }
303 299
304 my $linew = int ($s / 25 / $size); 300 my $linew = int ($s / 25 / $size);
305 301
306 # ornamental border... we have time to waste :/ 302 # ornamental border... we have time to waste :/
307 pixbuf_rect $pixbuf, "\xff\xcc\x77", 0, 0, $s-1, $linew, 255; 303 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $s-1, $linew, 255;
308 pixbuf_rect $pixbuf, "\xff\xcc\x77", 0, 0, $linew, $s-1, 255; 304 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $linew, $s-1, 255;
309 pixbuf_rect $pixbuf, "\xff\xcc\x77", $s-$linew-1, 0, $s-1, $s-1, 255; 305 pixbuf_rect $pixbuf,0xffcc7700, $s-$linew-1, 0, $s-1, $s-1, 255;
310 pixbuf_rect $pixbuf, "\xff\xcc\x77", 0, $s-$linew-1, $s-1, $s-1, 255; 306 pixbuf_rect $pixbuf,0xffcc7700, 0, $s-$linew-1, $s-1, $s-1, 255;
311 307
312 for my $i (1 .. $size) { 308 for my $i (1 .. $size) {
313 pixbuf_rect $pixbuf, "\x44\x11\x11", $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew, 192; 309 pixbuf_rect $pixbuf, 0x44111100, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew, 192;
314 pixbuf_rect $pixbuf, "\x44\x11\x11", $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew, 192; 310 pixbuf_rect $pixbuf, 0x44111100, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew, 192;
315 311
316 # 38 max, but we allow a bit more 312 # 38 max, but we allow a bit more
317 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 313 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
318 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]; 314 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];
319 315
357 if ($oldboard) { 353 if ($oldboard) {
358 next if $old == $mark; # no change 354 next if $old == $mark; # no change
359 355
360 $self->{background}->copy_area (@$area, $pixbuf, $dx, $dy); 356 $self->{background}->copy_area (@$area, $pixbuf, $dx, $dy);
361 $expose_area = $expose_area 357 $expose_area = $expose_area
358 ? $expose_area->union (new Gtk2::Gdk::Rectangle @$area)
362 ? Gtk2::Gdk::Rectangle->union ($expose_area, $area) 359 : new Gtk2::Gdk::Rectangle @$area;
363 : $area;
364 } 360 }
365 361
366 if ($mark) { 362 if ($mark) {
367 my $pb = $self->create_stack($mark, $edge, $rand); 363 my $pb = $self->create_stack($mark, $edge, $rand);
368 364
398 #Storable::nstore { board => $self->{board}, size => $self->{size}, path => $self->{path}}, "testboard.storable"; 394 #Storable::nstore { board => $self->{board}, size => $self->{size}, path => $self->{path}}, "testboard.storable";
399 395
400 $expose_area; 396 $expose_area;
401} 397}
402 398
403sub expose { 399sub redraw {
404 my ($self, $area) = @_; 400 my ($self, $area) = @_;
405 401
406 if ($area && $self->{pixbuf}) { 402 if ($area && $self->{pixbuf}) {
407 my ($x, $y, $w, $h) = @$area; 403 my ($x, $y, $w, $h) = $area->values;
408 my ($ox, $oy, $s) = @{$self->{offsets}}; 404 my ($ox, $oy, $s) = @{$self->{offsets}};
409 405
410 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc, 406 $self->{canvas}->window->draw_pixbuf ($self->{canvas}->style->white_gc, $self->{pixbuf},
411 $x, $y, $x + $ox, $y + $oy, $w, $h); 407 $x, $y, $x + $ox, $y + $oy, $w, $h,
408 "normal", 0, 0);
412 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0, 409 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0,
413 $x + $ox - 1, $y + $oy - 1, $w + 2, $h + 2) if $::DEBUG_EXPOSE; 410 $x + $ox - 1, $y + $oy - 1, $w + 2, $h + 2) if $::DEBUG_EXPOSE;
414
415 #$self->{canvas}->window->draw_pixmap (
416 # $self->{canvas}->style->white_gc,
417 # $self->{pixmap},
418 # $x - $ox, $y - $oy, $x, $y, $w, $h,
419 #);
420 } 411 }
421} 412}
422 413
423sub expose_event { 414sub expose_event {
424 my ($widget, $self, $event) = @_; 415 my ($widget, $event, $self) = @_;
425 416
426 $self->{pixbuf} or return; 417 $self->{pixbuf} or return;
427 418
428 my $area = $event->{area}; 419 my $area = $event->area;
429 my ($ox, $oy, $s) = @{$self->{offsets}}; 420 my ($ox, $oy, $s) = @{$self->{offsets}};
430 421
431 $self->expose (Gtk2::Gdk::Rectangle->intersect ( 422 $self->redraw (
432 [$area->[0] - $ox, $area->[1] - $oy, $area->[2], $area->[3]], 423 (new Gtk2::Gdk::Rectangle $area->x - $ox, $area->x - $oy, $area->width, $area->height)
433 [0, 0, $s, $s], 424 ->intersect(new Gtk2::Gdk::Rectangle 0, 0, $s, $s)
434 )); 425 );
435 426
436 1; 427 1;
437} 428}
438 429
439sub event_update_tree { 430sub event_update_tree {
440 my ($self) = @_; 431 my ($self) = @_;
441 432
442 $self->{path} = $self->get_path; 433 $self->{path} = $self->get_path;
443
444 my $move = @{$self->{path}};
445 434
446 $self->{moveadj}->upper($move);
447
448 if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
449 $self->{moveadj}->value ($move);
450 $self->{moveadj}->value_changed; 435 $self->{moveadj}->value_changed ();
451 }
452} 436}
453 437
454sub event_part { 438sub event_part {
455 my ($self) = @_; 439 my ($self) = @_;
456 $self->SUPER::event_part; 440 $self->SUPER::event_part;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines