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.9 by root, Wed Jun 25 21:25:03 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;
… …
313 delete $self->{backgroundpm}; 318 delete $self->{backgroundpm};
314 delete $self->{backgroundpb}; 319 delete $self->{backgroundpb};
315 320
316 my $pixmap = new Gtk2::Gdk::Pixmap $self->window, $w, $h, -1; 321 my $pixmap = new Gtk2::Gdk::Pixmap $self->window, $w, $h, -1;
317 322
318 #my $gridcolour = 0x88444400; # black is traditional, but only with overlapping stones
319 my $gridcolour = 0x44444400; # black is traditional, but only with overlapping stones 323 my $gridcolour = 0x44444400; # black is traditional, but only with overlapping stones
320 my $labelcolour = 0x88444400; 324 my $labelcolour = 0x88444400;
321 325
322 # we leave enough space for the shadows.. I like smaller stones, and we
323 # do no need to do the nifty recursive screen updates that cgoban2 does
324 my $borderw = int ($w / ($size + 1) * 0.5); 326 my $borderw = int $w / ($size + 1) * 0.5;
325 my $borderh = $borderw; 327 my $borderh = $borderw;
326 my $w2 = $w - $borderw * 2; 328 my $w2 = $w - $borderw * 2;
327 my $h2 = $h - $borderh * 2; 329 my $h2 = $h - $borderh * 2;
328 my $edge = ceil ($w2 / ($size + 1)); 330 my $edge = ceil $w2 / ($size + 1);
329 my $ofs = $edge * 0.5; 331 my $ofs = $edge * 0.5;
330 332
331 # 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
332 return if $w < $size * 5 + 2 + $borderw 334 return if $w < $size * 5 + 2 + $borderw
333 || $h < $size * 6 + 2 + $borderh; 335 || $h < $size * 6 + 2 + $borderh;
… …
344 $board_img->copy_area (0, 0, $w, $h, $pixbuf, 0, 0); 346 $board_img->copy_area (0, 0, $w, $h, $pixbuf, 0, 0);
345 } else { 347 } else {
346 $pixbuf = scale_pixbuf $board_img, $w, $h, 'bilinear', 0; # nearest for extra speed 348 $pixbuf = scale_pixbuf $board_img, $w, $h, 'bilinear', 0; # nearest for extra speed
347 } 349 }
348 350
349 my $linew = int ($w / 40 / $size); 351 my $linew = int $w / 40 / $size;
350 352
351 # ornamental border... we have time to waste :/ 353 # ornamental border... we have time to waste :/
352 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $w-1, $linew, 255; 354 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $w-1, $linew, 255;
353 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $linew, $h-1, 255; 355 pixbuf_rect $pixbuf, 0xffcc7700, 0, 0, $linew, $h-1, 255;
354 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;
… …
519 ); 521 );
520 } 522 }
521 } 523 }
522 524
523 # then the small stones (always using the first image) 525 # then the small stones (always using the first image)
524 for ([MARK_SMALL_B, $black_img[0]], 526 for ([MARK_SMALL_B, $mark & MARK_SMALL_GRAYED ? 106 : 255, $black_img[0]],
525 [MARK_SMALL_W, $white_img[0]]) { 527 [MARK_SMALL_W, $mark & MARK_SMALL_GRAYED ? 190 : 255, $white_img[0]]) {
526 my ($mask, $img) = @$_; 528 my ($mask, $alpha, $img) = @$_;
527 if ($mark & $mask) { 529 if ($mark & $mask) {
528 $img->composite ( 530 $img->composite (
529 $base, ($size / 4) x2, (ceil $size / 2 + 1) x2, ($size / 4) x2, 531 $base, ($size / 4) x2, (ceil $size / 2 + 1) x2, ($size / 4) x2,
530 $size / $img->get_width / 2, $size / $img->get_height / 2, 532 $size / $img->get_width / 2, $size / $img->get_height / 2,
531 'bilinear', 255 533 'bilinear', $alpha
532 ); 534 );
533 } 535 }
534 } 536 }
535 537
536 # and finally any markers 538 # and finally any markers
… …
638 640
639 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;
640 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;
641 643
642 my $pos = $self->{cursorpos}; 644 my $pos = $self->{cursorpos};
643 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]) {
644 648
645 $self->cursor (0); 649 $self->cursor (0);
646 650
647 if ($x >= 0 && $x < $size 651 if ($x >= 0 && $x < $size
648 && $y >= 0 && $y < $size) { 652 && $y >= 0 && $y < $size) {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines