ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Gtk2-GoBoard/GoBoard.pm
(Generate patch)

Comparing Gtk2-GoBoard/GoBoard.pm (file contents):
Revision 1.1 by root, Sun Jun 22 16:07:01 2008 UTC vs.
Revision 1.15 by root, Fri May 6 17:36:36 2011 UTC

55Playing sounds required the L<Audio::Play> module. If it isn't installed, 55Playing sounds required the L<Audio::Play> module. If it isn't installed,
56sounds will silently not being played. The module intentionally doesn't 56sounds will silently not being played. The module intentionally doesn't
57depend on L<Audio::Play> as it isn't actively maintained anymore and fails 57depend on L<Audio::Play> as it isn't actively maintained anymore and fails
58to install cleanly. 58to install cleanly.
59 59
60Note that L<Audio::Play> is broken on 64-bit platforms, which the author
61knows about for half a decade now, but apparently can't be bothered to
62fix. The symptoms are that it cannot load the soundfile and will silently
63result in - silence.
64
60=over 4 65=over 4
61 66
62=cut 67=cut
63 68
64our $VERSION = '1.0'; 69our $VERSION = '1.02';
65 70
66no warnings; 71no warnings;
67use strict; 72use strict;
68 73
69use Scalar::Util; 74use Scalar::Util;
70use POSIX qw(ceil); 75use POSIX qw(ceil);
76use Carp ();
71use Gtk2; 77use Gtk2;
78
72use Games::Go::SimpleBoard; 79use Games::Go::SimpleBoard;
73use Carp ();
74 80
75use Glib::Object::Subclass 81use Glib::Object::Subclass
76 Gtk2::AspectFrame::, 82 Gtk2::AspectFrame::,
77 properties => [ 83 properties => [
78 Glib::ParamSpec->IV ( 84 Glib::ParamSpec->IV (
137 143
138 new_from_file Gtk2::Gdk::Pixbuf $path 144 new_from_file Gtk2::Gdk::Pixbuf $path
139 or die "$path: $!"; 145 or die "$path: $!";
140} 146}
141 147
148our ($board_img, @black_img, @white_img, $shadow_img,
149 @triangle_img, @square_img, @circle_img, @cross_img);
150
142sub load_images { 151sub load_images {
152 $board_img = load_image "woodgrain-01.jpg";
143 @::black_img = load_image "b-01.png"; 153 @black_img = load_image "b-01.png";
144 @::white_img = map +(load_image "w-0$_.png"), 1,2,3,4,5; 154 @white_img = map +(load_image "w-0$_.png"), 1 .. 5;
145 $::shadow_img = load_image "shadow.png"; 155 $shadow_img = load_image "shadow.png"; # also used to fake hoshi points
146 @::triangle_img = map +(load_image "triangle-$_.png"), qw(b w); 156 @triangle_img = map +(load_image "triangle-$_.png"), qw(b w);
147 @::square_img = map +(load_image "square-$_.png"), qw(b w); 157 @square_img = map +(load_image "square-$_.png" ), qw(b w);
148 @::circle_img = map +(load_image "circle-$_.png"), qw(b w); 158 @circle_img = map +(load_image "circle-$_.png" ), qw(b w);
149 $::board_img = load_image "woodgrain-01.jpg"; 159 @cross_img = map +(load_image "cross-$_.png" ), qw(b w);
150} 160}
151 161
152sub INIT_INSTANCE { 162sub INIT_INSTANCE {
153 my $self = shift; 163 my $self = shift;
154 164
155 @::black_img 165 @black_img
156 or load_images; 166 or load_images;
157 167
158 $self->double_buffered (0); 168 $self->double_buffered (0);
159 $self->set (border_width => 0, shadow_type => 'none', 169 $self->set (border_width => 0, shadow_type => 'none',
160 obey_child => 0, ratio => TRAD_RATIO); 170 obey_child => 0, ratio => TRAD_RATIO);
211 $self->{idle} ||= add Glib::Idle sub { 221 $self->{idle} ||= add Glib::Idle sub {
212 $self->{width} = $self->{canvas}->allocation->width; 222 $self->{width} = $self->{canvas}->allocation->width;
213 $self->{height} = $self->{canvas}->allocation->height; 223 $self->{height} = $self->{canvas}->allocation->height;
214 $self->draw_background; 224 $self->draw_background;
215 225
216 $self->draw_board (delete $self->{board}, 0) if $self->{board}; 226 $self->draw_board ({ board => delete $self->{board}, label => delete $self->{label} }, 0) if $self->{board};
217 $self->{window}->clear_area (0, 0, $self->{width}, $self->{height}); 227 $self->{window}->clear_area (0, 0, $self->{width}, $self->{height});
218 228
219 delete $self->{idle}; 229 delete $self->{idle};
220 230
221 0; 231 0;
222 }; 232 };
223 233
224 1; 234 1;
225} 235}
236
237=item $board->set_board ($games_go_simpleboard)
238
239Sets the new board position to display from the current position stored in
240the L<Games::Go::SimpleBoard> object.
241
242=cut
226 243
227sub set_board { 244sub set_board {
228 my ($self, $board) = @_; 245 my ($self, $board) = @_;
229 246
230 $self->cursor (0); 247 $self->cursor (0);
301 delete $self->{backgroundpm}; 318 delete $self->{backgroundpm};
302 delete $self->{backgroundpb}; 319 delete $self->{backgroundpb};
303 320
304 my $pixmap = new Gtk2::Gdk::Pixmap $self->window, $w, $h, -1; 321 my $pixmap = new Gtk2::Gdk::Pixmap $self->window, $w, $h, -1;
305 322
306 #my $gridcolour = 0x88444400; # black is traditional, but only with overlapping stones
307 my $gridcolour = 0x44444400; # black is traditional, but only with overlapping stones 323 my $gridcolour = 0x44444400; # black is traditional, but only with overlapping stones
308 my $labelcolour = 0x88444400; 324 my $labelcolour = 0x88444400;
309 325
310 # we leave enough space for the shadows.. I like smaller stones, and we
311 # do no need to do the nifty recursive screen updates that cgoban2 does
312 my $borderw = int ($w / ($size + 1) * 0.5); 326 my $borderw = int $w / ($size + 1) * 0.5;
313 my $borderh = $borderw; 327 my $borderh = $borderw;
314 my $w2 = $w - $borderw * 2; 328 my $w2 = $w - $borderw * 2;
315 my $h2 = $h - $borderh * 2; 329 my $h2 = $h - $borderh * 2;
316 my $edge = ceil ($w2 / ($size + 1)); 330 my $edge = ceil $w2 / ($size + 1);
317 my $ofs = $edge * 0.5; 331 my $ofs = $edge * 0.5;
318 332
319 # we need a certain minimum size, and just fudge some formula here 333 # we need a certain minimum size, and just fudge some formula here
320 return if $w < $size * 5 + 2 + $borderw 334 return if $w < $size * 5 + 2 + $borderw
321 || $h < $size * 6 + 2 + $borderh; 335 || $h < $size * 6 + 2 + $borderh;
323 my @kx = map int ($w2 * $_ / ($size+1) + $borderw + 0.5), 0 .. $size; $self->{kx} = \@kx; 337 my @kx = map int ($w2 * $_ / ($size+1) + $borderw + 0.5), 0 .. $size; $self->{kx} = \@kx;
324 my @ky = map int ($h2 * $_ / ($size+1) + $borderh + 0.5), 0 .. $size; $self->{ky} = \@ky; 338 my @ky = map int ($h2 * $_ / ($size+1) + $borderh + 0.5), 0 .. $size; $self->{ky} = \@ky;
325 339
326 my $pixbuf; 340 my $pixbuf;
327 341
328 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height); 342 my ($bw, $bh) = ($board_img->get_width, $board_img->get_height);
329 343
330 if ($w < $bw && $h < $bh) { 344 if ($w < $bw && $h < $bh) {
331 $pixbuf = new_pixbuf $w, $h, 0; 345 $pixbuf = new_pixbuf $w, $h, 0;
332 $::board_img->copy_area (0, 0, $w, $h, $pixbuf, 0, 0); 346 $board_img->copy_area (0, 0, $w, $h, $pixbuf, 0, 0);
333 } else { 347 } else {
334 $pixbuf = scale_pixbuf $::board_img, $w, $h, $::config->{speed} ? 'nearest' : 'bilinear', 0; 348 $pixbuf = scale_pixbuf $board_img, $w, $h, 'bilinear', 0; # nearest for extra speed
335 } 349 }
336 350
337 my $linew = int ($w / 40 / $size); 351 my $linew = int $w / 40 / $size;
338 352
339 # ornamental border... we have time to waste :/ 353 # ornamental border... we have time to waste :/
340 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $w-1, $linew, 255; 354 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $w-1, $linew, 255;
341 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $linew, $h-1, 255; 355 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $linew, $h-1, 255;
342 pixbuf_rect $pixbuf, 0xffcc7700, $w-$linew-1, 0, $w-1, $h-1, 255; 356 pixbuf_rect $pixbuf, 0xffcc7700, $w-$linew-1, 0, $w-1, $h-1, 255;
353 my $hs = 1 | int $edge / 4; 367 my $hs = 1 | int $edge / 4;
354 $hs = 5 if $hs < 5; 368 $hs = 5 if $hs < 5;
355 $x = $kx[$x] - $hs / 2; $y = $ky[$y] - $hs / 2; 369 $x = $kx[$x] - $hs / 2; $y = $ky[$y] - $hs / 2;
356 370
357 # we use the shadow mask... not perfect, but I want to finish this 371 # we use the shadow mask... not perfect, but I want to finish this
358 $::shadow_img->composite ($pixbuf, 372 $shadow_img->composite ($pixbuf,
359 $x, $y, ($hs + 1) x2, $x, $y, 373 $x, $y, ($hs + 1) x2, $x, $y,
360 $hs / $::shadow_img->get_width, $hs / $::shadow_img->get_height, 374 $hs / $shadow_img->get_width, $hs / $shadow_img->get_height,
361 'bilinear', 255); 375 'bilinear', 255);
362 }; 376 };
363 377
364 if ($size > 6) { 378 if ($size > 6) {
365 my $h1 = $size < 10 ? 3 : 4; # corner / edge offset 379 my $h1 = $size < 10 ? 3 : 4; # corner / edge offset
416 my %stack; 430 my %stack;
417 431
418 my $put_stack = sub { 432 my $put_stack = sub {
419 my ($x, $y, $dx, $dy, $ox, $oy) = @_; 433 my ($x, $y, $dx, $dy, $ox, $oy) = @_;
420 434
421 my $mark = $self->{board}{board}[$x-1][$y-1]; 435 my $mark = $self->{board}[$x-1][$y-1];
422 436
423 if ($mark & ~MARK_LABEL) { 437 if ($mark & ~MARK_LABEL) {
424 my $stack = $stack{$mark} ||= $self->draw_stack ($mark, $edge); 438 my $stack = $stack{$mark} ||= $self->draw_stack ($mark, $edge);
425 439
426 $stack->[($x ^ $y) % @$stack] 440 $stack->[($x ^ $y) % @$stack]
435 $self->{draw_stone} = sub { 449 $self->{draw_stone} = sub {
436 my ($x, $y) = @_; 450 my ($x, $y) = @_;
437 451
438 @area = ($kx[$x] - $ofs, $ky[$y] - $ofs, 452 @area = ($kx[$x] - $ofs, $ky[$y] - $ofs,
439 $edge + $shadow, $edge + $shadow); 453 $edge + $shadow, $edge + $shadow);
440 @areai = ((ceil $area[0]), (ceil $area[1]), 454 @areai = map +(ceil $_), @area; # area, integer
441 (int $area[2]), (int $area[3])); # area, integer
442 455
443 $pb = new_pixbuf @areai[2,3]; 456 $pb = new_pixbuf @areai[2,3];
444 $self->{backgroundpb}->copy_area (@areai, $pb, 0, 0); 457 $self->{backgroundpb}->copy_area (@areai, $pb, 0, 0);
445 458
446 $put_stack->($x-1, $y, $kx[$x-1] - $kx[$x], 0, 0, 0) if $x > 1; 459 $put_stack->($x-1, $y, $kx[$x-1] - $kx[$x], 0, 0, 0) if $x > 1;
453 $self->{backgroundpm}->draw_pixbuf ($self->style->black_gc, $pb, 466 $self->{backgroundpm}->draw_pixbuf ($self->style->black_gc, $pb,
454 0, 0, @areai, 'max', 0, 0); 467 0, 0, @areai, 'max', 0, 0);
455 468
456 # labels are handled here because they are quite rare 469 # labels are handled here because they are quite rare
457 # (and we can't draw text into pixbufs easily) 470 # (and we can't draw text into pixbufs easily)
458 my $mark = $self->{board}{board}[$x-1][$y-1]; 471 my $mark = $self->{board}[$x-1][$y-1];
459 472
460 if ($mark & MARK_LABEL) { 473 if ($mark & MARK_LABEL) {
461 my $white = $mark & MARK_W ? 0 : 0xffffff00; 474 my $white = $mark & MARK_W ? 0 : 0xffffff00;
462 475
463 if ($white) {
464 $self->center_text ($self->{backgroundpm}, 0, 476 $self->center_text ($self->{backgroundpm}, 0,
465 $areai[0] + $ofs * 1.1, $areai[1] + $ofs * 1.1, 477 $areai[0] + $ofs * 1.1, $areai[1] + $ofs * 1.1,
466 $ofs * 0.7, $self->{board}{label}[$x-1][$y-1]); 478 $ofs * 0.7, $self->{label}[$x-1][$y-1])
467 } 479 if $white;
480
468 $self->center_text ($self->{backgroundpm}, $white, 481 $self->center_text ($self->{backgroundpm}, $white,
469 $areai[0] + $ofs, $areai[1] + $ofs, 482 $areai[0] + $ofs, $areai[1] + $ofs,
470 $ofs * 0.7, $self->{board}{label}[$x-1][$y-1]); 483 $ofs * 0.7, $self->{label}[$x-1][$y-1]);
471 } 484 }
472 485
473 undef $pb; 486 undef $pb;
474 487
475 [@areai]; 488 [@areai];
483 496
484 my @stack; 497 my @stack;
485 my $csize = ceil $size; 498 my $csize = ceil $size;
486 my $shadow = $size * SHADOW; 499 my $shadow = $size * SHADOW;
487 500
488 for my $stone ($mark & MARK_W ? @::white_img : @::black_img) { 501 for my $stone ($mark & MARK_W ? @white_img : @black_img) {
489 my $base = new_pixbuf +(ceil $size + $shadow) x2, 1, 0x00000000; 502 my $base = new_pixbuf +(ceil $csize + $shadow) x2, 1, 0x00000000;
490 503
491 # zeroeth the shadow 504 # zeroeth the shadow
492 if (~$mark & MARK_GRAYED and $mark & (MARK_B | MARK_W)) { 505 if (~$mark & MARK_GRAYED and $mark & (MARK_B | MARK_W)) {
493 $::shadow_img->composite ( 506 $shadow_img->composite (
494 $base, $shadow, $shadow, $csize, $csize, $shadow, $shadow, 507 $base, ($shadow) x2, $csize, $csize, ($shadow) x2,
495 $size / $::shadow_img->get_width, $size / $::shadow_img->get_height, 508 $size / $shadow_img->get_width, $size / $shadow_img->get_height,
496 'bilinear', 128 509 'bilinear', 128
497 ); 510 );
498 } 511 }
499 512
500 for ([MARK_B, $mark & MARK_GRAYED ? 96 : 255, 1], 513 for ([MARK_B, $mark & MARK_GRAYED ? 106 : 255, 1],
501 [MARK_W, $mark & MARK_GRAYED ? 160 : 255, TRAD_SIZE_W / TRAD_SIZE_B]) { 514 [MARK_W, $mark & MARK_GRAYED ? 190 : 255, TRAD_SIZE_W / TRAD_SIZE_B]) {
502 my ($mask, $alpha, $scale) = @$_; 515 my ($mask, $alpha, $scale) = @$_;
503 if ($mark & $mask) { 516 if ($mark & $mask) {
504 $stone->composite ( 517 $stone->composite (
505 $base, 0, 0, $csize, $csize, ($size * (1 - $scale) * 0.5 ) x2, 518 $base, 0, 0, $csize, $csize, ($size * (1 - $scale) * 0.5) x2,
506 $size * $scale / $stone->get_width, $size * $scale / $stone->get_height, 519 $size * $scale / $stone->get_width, $size * $scale / $stone->get_height,
507 'bilinear', $alpha 520 'bilinear', $alpha
508 ); 521 );
509 } 522 }
510 } 523 }
511 524
512 # then the small stones (always using the first image) 525 # then the small stones (always using the first image)
513 for ([MARK_SMALL_B, $::black_img[0]], 526 for ([MARK_SMALL_B, $mark & MARK_SMALL_GRAYED ? 106 : 255, $black_img[0]],
514 [MARK_SMALL_W, $::white_img[0]]) { 527 [MARK_SMALL_W, $mark & MARK_SMALL_GRAYED ? 190 : 255, $white_img[0]]) {
515 my ($mask, $img) = @$_; 528 my ($mask, $alpha, $img) = @$_;
516 if ($mark & $mask) { 529 if ($mark & $mask) {
517 $img->composite ( 530 $img->composite (
518 $base, (int $size / 4) x2, (ceil $size / 2 + 1) x2, ($size / 4) x2, 531 $base, ($size / 4) x2, (ceil $size / 2 + 1) x2, ($size / 4) x2,
519 $size / $img->get_width / 2, $size / $img->get_height / 2, 532 $size / $img->get_width / 2, $size / $img->get_height / 2,
520 'bilinear', 255 533 'bilinear', $alpha
521 ); 534 );
522 } 535 }
523 } 536 }
524 537
525 # and lastly any markers 538 # and finally any markers
526 my $dark_bg = ! ! ($mark & MARK_B); 539 my $dark_bg = ! ! ($mark & MARK_B);
527 540
528 for ([MARK_CIRCLE, $::circle_img[$dark_bg]], 541 for ([MARK_CIRCLE, $circle_img [$dark_bg]],
529 [MARK_TRIANGLE, $::triangle_img[$dark_bg]], 542 [MARK_TRIANGLE, $triangle_img[$dark_bg]],
543 [MARK_CROSS, $cross_img [$dark_bg]],
530 [MARK_SQUARE, $::square_img[$dark_bg]], 544 [MARK_SQUARE, $square_img [$dark_bg]],
531 [MARK_KO, $::square_img[$dark_bg]]) { 545 [MARK_KO, $square_img [$dark_bg]]) {
532 my ($mask, $img) = @$_; 546 my ($mask, $img) = @$_;
533 if ($mark & $mask) { 547 if ($mark & $mask) {
534 $img->composite ( 548 $img->composite (
535 $base, 0, 0, $size, $size, 0, 0, 549 $base, 0, 0, $csize, $csize, 0, 0,
536 $size / $img->get_width, $size / $img->get_height, 550 $size / $img->get_width, $size / $img->get_height,
537 'bilinear', 176 551 'bilinear', $dark_bg ? 176 : 190
538 ); 552 );
539 } 553 }
540 } 554 }
541 555
542 push @stack, $base; 556 push @stack, $base;
543 } 557 }
544 558
545 \@stack; 559 \@stack
546} 560}
547 561
548sub draw_board { 562sub draw_board {
549 my ($self, $new, $dopaint) = @_; 563 my ($self, $new, $dopaint) = @_;
550 564
551 ($self->{board}, my $old) = ($new, $self->{board}); 565 my $newboard = $new->{board};
552 566 my $newlabel = $new->{label};
553 my $draw_stone = $self->{draw_stone};
554 567
555 if ($self->{backgroundpb}) { 568 if ($self->{backgroundpb}) {
569 my $draw_stone = $self->{draw_stone};
570
571 my $oldboard = $self->{board} ||= [];
572 my $oldlabel = $self->{label} ||= [];
573
556 my @areas; 574 my @areas;
557 575
558 my $size1 = $self->{size} - 1; 576 my $size1 = $self->{size} - 1;
559 577
560 for my $x (0 .. $size1) { 578 for my $x (0 .. $size1) {
561 my $old = $old->{board}[$x]; 579 my $old = $oldboard->[$x] ||= [];
562 my $new = $new->{board}[$x]; 580 my $new = $newboard->[$x];
563 581
564 for my $y (0 .. $size1) { 582 for my $y (0 .. $size1) {
583 next if $old->[$y] == $new->[$y];
584
585 $old -> [$y] = $new -> [$y];
586 $oldlabel->[$x][$y] = $newlabel->[$x][$y];
587
565 push @areas, $draw_stone->($x+1, $y+1) 588 push @areas, $draw_stone->($x+1, $y+1);
566 if $old->[$y] != $new->[$y];
567 } 589 }
568 } 590 }
569 591
570 if ($dopaint && @areas) { 592 if ($dopaint && @areas) {
571 # a single full clear_area is way faster than many single calls here 593 # a single full clear_area is way faster than many single calls here
578 } else { 600 } else {
579 # update all the affected rectangles 601 # update all the affected rectangles
580 $self->{window}->clear_area (@$_) for @areas; 602 $self->{window}->clear_area (@$_) for @areas;
581 } 603 }
582 } 604 }
605 } else {
606 no strict 'refs';
607
608 # straight copy
609 $self->{board} = [map [@$_], @$newboard];
610 $self->{label} = [map [@$_], @$newlabel];
583 } 611 }
584} 612}
585 613
586sub cursor { 614sub cursor {
587 my ($self, $show) = @_; 615 my ($self, $show) = @_;
590 && $self->{cursor} 618 && $self->{cursor}
591 && $self->{backgroundpb}; 619 && $self->{backgroundpb};
592 620
593 my ($x, $y) = @{$self->{cursorpos}}; 621 my ($x, $y) = @{$self->{cursorpos}};
594 622
595 my $mark = $self->{board}{board}[$x][$y]; 623 my $mark = $self->{board}[$x][$y];
596 624
597 $mark = $self->{cursor}->($mark, $x, $y) if $show; 625 $mark = $self->{cursor}->($mark, $x, $y) if $show;
598 626
599 local $self->{board}{board}[$x][$y] = $mark; 627 local $self->{board}[$x][$y] = $mark;
600 $self->{window}->clear_area (@{ $self->{draw_stone}->($x + 1, $y + 1) }); 628 $self->{window}->clear_area (@{ $self->{draw_stone}->($x + 1, $y + 1) });
601} 629}
602 630
603sub motion { 631sub motion {
604 my ($self) = @_; 632 my ($self) = @_;
612 640
613 my $x = int (($x - $self->{kx}[0]) * $size / ($self->{kx}[$size] - $self->{kx}[0]) + 0.5) - 1; 641 my $x = int (($x - $self->{kx}[0]) * $size / ($self->{kx}[$size] - $self->{kx}[0]) + 0.5) - 1;
614 my $y = int (($y - $self->{ky}[0]) * $size / ($self->{ky}[$size] - $self->{ky}[0]) + 0.5) - 1; 642 my $y = int (($y - $self->{ky}[0]) * $size / ($self->{ky}[$size] - $self->{ky}[0]) + 0.5) - 1;
615 643
616 my $pos = $self->{cursorpos}; 644 my $pos = $self->{cursorpos};
617 if ($x != $pos->[0] || $y != $pos->[1]) { 645 if ((not (defined $pos) && $x >= 0 && $x < $size && $y >= 0 && $y < $size)
646 || $x != $pos->[0]
647 || $y != $pos->[1]) {
618 648
619 $self->cursor (0); 649 $self->cursor (0);
620 650
621 if ($x >= 0 && $x < $size 651 if ($x >= 0 && $x < $size
622 && $y >= 0 && $y < $size) { 652 && $y >= 0 && $y < $size) {
673 socketpair $SOUND_SERVER, my $fh, &Socket::AF_UNIX, &Socket::SOCK_STREAM, 0 703 socketpair $SOUND_SERVER, my $fh, &Socket::AF_UNIX, &Socket::SOCK_STREAM, 0
674 or return; 704 or return;
675 705
676 my $pid = fork; 706 my $pid = fork;
677 707
678 if ($pid || !defined $pid) { 708 if ($pid) {
679 # parent 709 # parent
680 close $fh; 710 close $fh;
681 711
682 } else { 712 } elsif (defined $pid) {
683 # child 713 # child
684 close $SOUND_SERVER; 714 close $SOUND_SERVER;
685 715
716 close STDIN;
717 close STDOUT;
718 close STDERR;
719
720 # ok, this is a bit pathetic
721 POSIX::close $_ for grep $_ != fileno $fh, 3 .. 1000;
722
686 my %sound; 723 my %sound;
687 724
688 while (<$SOUND_SERVER>) { 725 while (<$fh>) {
689 chomp; 726 chomp;
690 727
691 eval { 728 eval {
692 my $sound = $sound{$_} ||= do { 729 my $sound = $sound{$_} ||= do {
693 my $path = findfile "$_.au" 730 my $path = findfile "$_.au"
702 $data->Load ($fh); 739 $data->Load ($fh);
703 740
704 $data 741 $data
705 }; 742 };
706 743
707 my $server = new Audio::Play (1); 744 my $server = new Audio::Play;
708
709 $server->play ($sound); 745 $server->play ($sound);
710 $server->flush; 746 $server->flush;
711 }; 747 };
712 } 748 }
713 749
714 kill 9, $$; # required for windows, as a mere exit 750 # required for windows, as a mere _exit kills your parent process...
751 kill 9, $$;
752 } else {
753 undef $SOUND_SERVER;
754 return;
715 } 755 }
716 } 756 }
757
758 syswrite $SOUND_SERVER, "$_[0]\n";
717} 759}
718 760
7191; 7611;
720 762
721=back 763=back
748 $game->{board}[18][1] = MARK_W; 790 $game->{board}[18][1] = MARK_W;
749 791
750 my $board = new Gtk2::GoBoard; 792 my $board = new Gtk2::GoBoard;
751 $board->set_board ($game); 793 $board->set_board ($game);
752 794
795 Gtk2::GoBoard::play_sound "gamestart"; # ping
796
753 # enable cursor for black, till click 797 # enable cursor for black, till click
754 $board->set (cursor => sub { 798 $board->set (cursor => sub {
755 my ($mark, $x, $y) = @_; 799 my ($mark, $x, $y) = @_;
756 800
757 $mark |= MARK_GRAYED | MARK_B 801 $mark |= MARK_GRAYED | MARK_B
764 $board->signal_connect (button_release => sub { 808 $board->signal_connect (button_release => sub {
765 my ($board, $button, $x, $y) = @_; 809 my ($board, $button, $x, $y) = @_;
766 810
767 $game->{board}[$x][$y] |= MARK_CIRCLE; 811 $game->{board}[$x][$y] |= MARK_CIRCLE;
768 $board->set_board ($game); # force update 812 $board->set_board ($game); # force update
813
814 Gtk2::GoBoard::play_sound "move"; # play click sound
769 815
770 $board->set (cursor => undef); # disable cursor 816 $board->set (cursor => undef); # disable cursor
771 }); 817 });
772 818
773 my $w = new Gtk2::Window "toplevel"; 819 my $w = new Gtk2::Window "toplevel";

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines