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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.22 by pcg, Fri May 30 11:39:56 2003 UTC vs.
Revision 1.28 by pcg, Sat May 31 04:35:39 2003 UTC

1#!/usr/bin/perl -I../lib/ 1#!/usr/bin/perl
2 2
3use Gtk; 3use Gtk;
4use Gtk::Gdk; 4use Gtk::Gdk;
5use Gtk::Gdk::Pixbuf; 5use Gtk::Gdk::Pixbuf;
6#use Gtk::Gdk::ImlibImage; 6#use Gtk::Gdk::ImlibImage;
10 10
11use Audio::Data; 11use Audio::Data;
12use Audio::Play; 12use Audio::Play;
13 13
14use IO::Socket::INET; 14use IO::Socket::INET;
15 15use List::Util;
16use Errno; 16use Errno;
17 17
18init Gtk; 18init Gtk;
19 19
20$HACK = 1; # do NEVER enable. ;) 20our $HACK = 1; # do NEVER enable. ;)
21our $DEBUG_EXPOSE = 1;
22
23if ($HACK) {
24 $KGS::debug = 1;
25}
26
27our $VERSION = "0.1";
21 28
22our $config; 29our $config;
23our $LIBDIR = "."; 30our $LIBDIR = ".";
24our $IMGDIR = "$LIBDIR/images"; 31our $IMGDIR = "$LIBDIR/images";
25our $SNDDIR = "$LIBDIR/sounds"; 32our $SNDDIR = "$LIBDIR/sounds";
50{ 57{
51 #my $audioserver = new Audio::Play(0); 58 #my $audioserver = new Audio::Play(0);
52 my %sound; 59 my %sound;
53 $SIG{CHLD} = 'IGNORE'; 60 $SIG{CHLD} = 'IGNORE';
54 61
55 for (qw(alarm warning move)) { 62 for (qw(alarm warning move pass ring connect user_unknown)) {
56 local $/; 63 local $/;
57 open my $snd, "<", "$SNDDIR/$_" 64 open my $snd, "<", "$SNDDIR/$_"
58 or die "$SNDDIR: $!"; 65 or die "$SNDDIR/$_: $!";
59 binmode $snd; 66 binmode $snd;
60 67
61 $sound{$_} = new Audio::Data; 68 $sound{$_} = new Audio::Data;
62 $sound{$_}->Load($snd); 69 $sound{$_}->Load($snd);
63 } 70 }
64 71
65 sub play_sound { 72 sub play_sound {
73 my ($annoyancy, $sound) = @_;
74 # annoyany 1 => important, annoyance 2 => useful, annoyancy 3 => not useful
66 if (fork == 0) { 75 if (fork == 0) {
67 if (my $audioserver = new Audio::Play(1)) { 76 if (my $audioserver = new Audio::Play(1)) {
68 $audioserver->play ($sound{$_[0]}); 77 $audioserver->play ($sound{$sound});
69 } 78 }
70 Gtk->_exit(0); 79 Gtk->_exit(0);
71 } 80 }
72 } 81 }
73} 82}
80 89
81 my $state = -r $staterc ? Storable::retrieve($staterc) : {}; 90 my $state = -r $staterc ? Storable::retrieve($staterc) : {};
82 my @widgets; 91 my @widgets;
83 92
84 $config = $state->{config} ||= {}; 93 $config = $state->{config} ||= {};
94
95 $config{speed} = 0;#d# optimize for speed or memory?
96 $config{conserve_memory} = 0;
85 97
86 # grr... more gtk+ brokenness 98 # grr... more gtk+ brokenness
87 my %get = ( 99 my %get = (
88 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] }, 100 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
89 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] }, 101 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
179} 191}
180 192
181if (0) { 193if (0) {
182 use KGS::Constants; 194 use KGS::Constants;
183 195
184 my $board = new game size => 5; 196 for (19) {
197 my $board = new game %{Storable::retrieve "testboard.storable"};
198
199 if (0) {
185 $board->{board} = new KGS::Game::Board; 200 $board->{board} = new KGS::Game::Board;
186 $board->{board}{board}[0][0] = MARK_B; 201 $board->{board}{board}[0][0] = MARK_B;
187 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W; 202 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
188 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE; 203 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
204 $board->{board}{board}[1][2] = MARK_B | MARK_LABEL;
205 $board->{board}{label}[1][2] = "198";
206 $board->{board}{board}[0][2] = MARK_W | MARK_LABEL;
207 $board->{board}{label}[0][2] = "AWA";
208 }
189 $board->{window}->show_all; 209 $board->{window}->show_all;
210 }
190} 211}
191 212
192main Gtk; 213main Gtk;
193 214
194############################################################################# 215#############################################################################
203 224
204 $self->{conn} = new KGS::Protocol; 225 $self->{conn} = new KGS::Protocol;
205 226
206 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :) 227 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
207 228
208 $self->listen($self->{conn}); 229 $self->listen($self->{conn}, "login");
209 230
210 $self->{roomlist} = new roomlist conn => $self->{conn}; 231 $self->{roomlist} = new roomlist conn => $self->{conn};
211 232
212 $self->{window} = new Gtk::Window 'toplevel'; 233 $self->{window} = new Gtk::Window 'toplevel';
213 $self->{window}->set_title('kgsueme'); 234 $self->{window}->set_title('kgsueme');
276 } 297 }
277 $self->{conn}->feed_data($buf); 298 $self->{conn}->feed_data($buf);
278 }; 299 };
279 300
280 # now login 301 # now login
281 $self->{conn}->login($self->{login}->get_text, $self->{password}->get_text); 302 $self->{conn}->login("kgsueme $VERSION $^O", $self->{login}->get_text, $self->{password}->get_text);
282} 303}
283 304
284sub inject_login { 305sub inject_login {
285 my ($self, $msg) = @_; 306 my ($self, $msg) = @_;
286 307
289 310
290 if ($msg->{success}) { 311 if ($msg->{success}) {
291 for (keys %{$::config->{rooms}}) { 312 for (keys %{$::config->{rooms}}) {
292 $self->{roomlist}->join_room($_); 313 $self->{roomlist}->join_room($_);
293 } 314 }
315 ::play_sound 3, "connect";
316 } elsif ($msg->{result} eq "user unknown") {
317 ::play_sound 2, "user_unknown";
318 } else {
319 ::play_sound 2, "warning";
294 } 320 }
295} 321}
296 322
297sub event_disconnect { } 323sub event_disconnect { }
298 324
380 406
381sub new { 407sub new {
382 my $self = shift; 408 my $self = shift;
383 $self = $self->SUPER::new(@_); 409 $self = $self->SUPER::new(@_);
384 410
385 $self->listen($self->{conn}); 411 $self->listen($self->{conn}, qw(msg_room:));
386 412
387 $self->{window} = new Gtk::Window 'toplevel'; 413 $self->{window} = new Gtk::Window 'toplevel';
388 $self->{window}->set_title("KGS Room $self->{name}"); 414 $self->{window}->set_title("KGS Room $self->{name}");
389 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400]; 415 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
390 416
404 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120]; 430 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
405 431
406 $self->{gamelist}->signal_connect(select_row => sub { 432 $self->{gamelist}->signal_connect(select_row => sub {
407 my $game = $self->{gamelist}->get_row_data($_[1]) 433 my $game = $self->{gamelist}->get_row_data($_[1])
408 or return; 434 or return;
409 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn}; 435 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn}, room => $self;
410 $self->{game}{$game->{channel}}->join; 436 $self->{game}{$game->{channel}}->join;
411 $self->{gamelist}->unselect_all; 437 $self->{gamelist}->unselect_all;
412 }); 438 });
413 439
414 $vpane->add(my $vbox = new Gtk::VBox); 440 $vpane->add(my $vbox = new Gtk::VBox);
433 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30]; 459 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
434 460
435 $self; 461 $self;
436} 462}
437 463
464sub join {
465 my ($self) = @_;
466 $self->SUPER::join;
467
468 $self->{window}->show_all;
469}
470
471sub part {
472 my ($self) = @_;
473 $self->SUPER::part;
474
475 delete $::config->{rooms}{$self->{channel}};
476 $self->{window}->hide_all;
477}
478
479sub inject_msg_room {
480 my ($self, $msg) = @_;
481
482 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
483}
484
438sub event_update_users { 485sub event_update_users {
439 my ($self) = @_; 486 my ($self) = @_;
440 487
441 $self->{event_update} ||= Gtk->timeout_add(200, sub { 488 $self->{event_update} ||= Gtk->timeout_add(200, sub {
442 my $l = $self->{userlist}; 489 my $l = $self->{userlist};
481 delete $self->{event_update_games}; 528 delete $self->{event_update_games};
482 0; 529 0;
483 }); 530 });
484} 531}
485 532
486sub join {
487 my ($self) = @_;
488 $self->SUPER::join;
489
490 $self->{window}->show_all;
491}
492
493sub part {
494 my ($self) = @_;
495 $self->SUPER::part;
496
497 delete $::config->{rooms}{$self->{channel}};
498 $self->{window}->hide_all;
499 $self->event_update_users;
500 $self->event_update_games;
501}
502
503sub event_join { 533sub event_join {
504 my ($self) = @_; 534 my ($self) = @_;
505 $self->SUPER::event_join; 535 $self->SUPER::event_join;
506 536
507 $::config->{rooms}{$self->{channel}} = 1; 537 $::config->{rooms}{$self->{channel}} = 1;
509 539
510sub event_update_roominfo { 540sub event_update_roominfo {
511 my ($self) = @_; 541 my ($self) = @_;
512 542
513 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n"); 543 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
514}
515
516sub inject_msg_room {
517 my ($self, $msg) = @_;
518 return unless $self->{channel} == $msg->{channel};
519
520 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
521} 544}
522 545
523############################################################################# 546#############################################################################
524 547
525package game; 548package game;
535 $self = $self->SUPER::new(@_); 558 $self = $self->SUPER::new(@_);
536 559
537 $self->listen($self->{conn}); 560 $self->listen($self->{conn});
538 561
539 $self->{window} = new Gtk::Window 'toplevel'; 562 $self->{window} = new Gtk::Window 'toplevel';
540 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1) if $self->{channel};#d# 563 my $title = $self->{channel} ? $self->user0." ".$self->user1 : "Game Window";
564 $self->{window}->set_title("KGS Game $title");
541 ::state $self->{window}, "game::window", undef, window_size => [600, 500]; 565 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
542 566
543 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 }); 567 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
544 568
545 $self->{window}->add(my $hpane = new Gtk::HPaned); 569 $self->{window}->add(my $hpane = new Gtk::HPaned);
546 ::state $hpane, "game::hpane", undef, hpane_position => 500; 570 ::state $hpane, "game::hpane", undef, hpane_position => 500;
547 571
572 $hpane->pack1(my $vbox = new Gtk::VBox);
573
574 $vbox->pack_start((my $frame = new Gtk::Frame), 0, 1, 0);
575
576 {
577 $frame->add(my $vbox = new Gtk::VBox);
578 $vbox->add($self->{title} = new Gtk::Label $title);
579
580 $self->{moveadj} = new Gtk::Adjustment 0, 0, 0, 1, 10, 0;
581 $vbox->add(my $scale = new Gtk::HScale $self->{moveadj});
582 $scale->set_draw_value (1);
583 $scale->set_digits (0);
584 $scale->set_value_pos('top');
585
586 $self->{moveadj}->signal_connect (value_changed => sub {
587 $self->{board} = new KGS::Game::Board $self->{size};
588 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]);
589
590 my $area = $self->repaint_board;
591
592 # force a redraw (not perfect(?))
593 $self->expose ($area);
594
595 $self->{text}->backward_delete($self->{text}->get_length);
596 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
597 });
598
599 $self->{moveadj}->upper (scalar @{$self->{path}}) if $self->{path};
600 }
601
548 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual); 602 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
549 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap); 603 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
550 $hpane->pack1(($self->{canvas} = new Gtk::DrawingArea), 1, 1); 604 $vbox->pack_start(($self->{canvas} = new Gtk::DrawingArea), 1, 1, 0);
551 Gtk::Widget->pop_colormap; 605 Gtk::Widget->pop_colormap;
552 Gtk::Widget->pop_visual; 606 Gtk::Widget->pop_visual;
553 607
554 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); 608 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
555 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); 609 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
602} 656}
603 657
604sub configure_event { 658sub configure_event {
605 my ($widget, $self, $event) = @_; 659 my ($widget, $self, $event) = @_;
606 delete $self->{stack}; 660 delete $self->{stack};
661 delete $self->{pixbuf};
662 delete $self->{board_shown};
607 delete $self->{background}; 663 delete $self->{background};
608 $self->repaint_board; 664 $self->repaint_board;
609 1; 665 1;
610} 666}
611 667
643 699
644# create a stack of stones 700# create a stack of stones
645sub create_stack { 701sub create_stack {
646 my ($self, $mark, $size, $rand) = @_; 702 my ($self, $mark, $size, $rand) = @_;
647 703
648 my $shadow = $size * 0.06; 704 my $shadow = $size * 0.05;
649 705
650 my $c = \$self->{stack}{$mark}; 706 my $c = \$self->{stack}{$mark};
651 unless ($$c) { 707 unless ($$c) {
652 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) { 708 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
653 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1; 709 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1;
654 710
655 # zeroeth the shadow 711 # zeroeth the shadow
712 if ($mark & (MARK_B | MARK_W)) {
656 $::black_img[0]->composite ( 713 $::black_img[0]->composite (
657 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5, 714 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
658 $size / $stone->get_width, $size / $stone->get_height, 715 $size / $stone->get_width, $size / $stone->get_height,
659 INTERP_TILES, 128 716 $::config{speed} ? INTERP_NEAREST : INTERP_TILES, 128
660 ); 717 );
718 }
661 719
662 # first the big stones 720 # first the big stones
663 for ([MARK_B, 255], 721 for ([MARK_B, 255],
664 [MARK_W, 255], 722 [MARK_W, 255],
665 [MARK_GRAY_B, 128], 723 [MARK_GRAY_B, 128],
667 my ($mask, $alpha) = @$_; 725 my ($mask, $alpha) = @$_;
668 if ($mark & $mask) { 726 if ($mark & $mask) {
669 $stone->composite ( 727 $stone->composite (
670 $base, 0, 0, $size, $size, -0.5, -0.5, 728 $base, 0, 0, $size, $size, -0.5, -0.5,
671 $size / $stone->get_width, $size / $stone->get_height, 729 $size / $stone->get_width, $size / $stone->get_height,
672 INTERP_HYPER, $alpha 730 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, $alpha
673 ); 731 );
674 } 732 }
675 } 733 }
676 734
677 # then the samll stones 735 # then the samll stones
680 my ($mask, $img) = @$_; 738 my ($mask, $img) = @$_;
681 if ($mark & $mask) { 739 if ($mark & $mask) {
682 $img->composite ( 740 $img->composite (
683 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2, 741 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2,
684 $size / $img->get_width / 2, $size / $img->get_height / 2, 742 $size / $img->get_width / 2, $size / $img->get_height / 2,
685 INTERP_HYPER, 192 743 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 192
686 ); 744 );
687 } 745 }
688 } 746 }
689 747
690 # and lastly any markers (labels NYI) 748 # and lastly any markers
691 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B)); 749 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
692 750
693 for ([MARK_CIRCLE, $::circle_img[$dark_bg]], 751 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
694 [MARK_TRIANGLE, $::triangle_img[$dark_bg]], 752 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
695 [MARK_SQUARE, $::square_img[$dark_bg]]) { 753 [MARK_SQUARE, $::square_img[$dark_bg]]) {
696 my ($mask, $img) = @$_; 754 my ($mask, $img) = @$_;
697 if ($mark & $mask) { 755 if ($mark & $mask) {
698 $img->composite ( 756 $img->composite (
699 $base, 0, 0, $size, $size, -0.5, -0.5, 757 $base, 0, 0, $size, $size, -0.5, -0.5,
700 $size / $img->get_width, $size / $img->get_height, 758 $size / $img->get_width, $size / $img->get_height,
701 INTERP_HYPER, 255 759 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 255
702 ); 760 );
703 } 761 }
704 } 762 }
705 763
706 push @$$c, $base; 764 push @$$c, $base;
711} 769}
712 770
713sub pixbuf_text { 771sub pixbuf_text {
714 my ($pixbuf, $colour, $x, $y, $height, $text) = @_; 772 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
715 773
716 my $c = $::font[$colour][$::fontmap{substr $text, 0, 1}]; 774 my @c = grep $_,
775 map $::font[$colour][$::fontmap{$_}],
776 split //, $text;
717 777
718 if ($c) { 778 if (@c) {
719 my ($w, $h) = ($c->get_width, $c->get_height); 779 my $spacing = $height * 0.1;
720 my $s = ($height-1) / ($h-1); 780 my $s = $height / List::Util::max map $_->get_height, @c;
781 my $W = List::Util::sum map $_->get_width, @c;
721 782
722 $x -= $w * $s * 0.5; 783 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5;
723 $y -= $height * 0.5; 784 $y -= $height * 0.5;
724 785
786 for (@c) {
787 my $w = $_->get_width * $s;
725 $c->composite ($pixbuf, 788 $_->composite ($pixbuf,
726 $x, $y, $w*$s+0.5, $height+0.5, $x-0.5, $y-0.5, $s, $s, 789 $x, $y, $w+0.999, $height+0.999, $x, $y, $s, $s,
727 INTERP_BILINEAR, 192); 790 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
728 791
729 } else { 792 $x += $w + $spacing;
730 warn "unable to render character '$text'"; 793 }
731 } 794 }
732} 795}
733 796
734my $black_pb; 797my $black_pb;
735 798
745} 808}
746 809
747sub repaint_board { 810sub repaint_board {
748 my ($self) = @_; 811 my ($self) = @_;
749 my $canvas = $self->{canvas}; 812 my $canvas = $self->{canvas};
813 my $expose_area = undef;
750 814
751 return unless $self->{board}; 815 return $expose_area unless $self->{board};
752 816
753 my ($w, $h) = @{$canvas->allocation}[2,3]; 817 my ($w, $h) = @{$canvas->allocation}[2,3];
754 818
755 my $s = $w > $h ? $h : $w; 819 my $s = $w > $h ? $h : $w;
756 820
757 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s]; 821 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
758 822
759 my $size = $self->{size}; 823 my $size = $self->{size};
760 824
761 my $border = int ($s / $size); 825 my $border = int ($s / ($size + 3) * 0.5);
762 my $s2 = $s - $border * 2; 826 my $s2 = $s - $border * 2;
763 my $edge = int ($s2 / $size * 0.97); 827 my $edge = int ($s2 / ($size + 1) * 0.95);
764 my $ofs = int ($edge / 2); 828 my $ofs = int ($edge / 2);
765 829
766 my @k = map int ($s2 * $_ / $size - $ofs + $border + 0.5), 0 .. $size; 830 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
767 831
768 unless ($self->{background}) {
769 my $pixbuf; 832 my $pixbuf;
833
834 my $oldboard;
835
836 if ($self->{background}) {
837 if ($oldboard = $self->{board_shown}) {
838 $pixbuf = $self->{pixbuf};
839 } else {
840 $pixbuf = $self->{background}->copy;
841 $expose_area = [0, 0, $s, $s];
842 }
843 } else {
844 $expose_area = [0, 0, $s, $s];
770 845
771 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height); 846 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
772 847
773 if ($s < $bw && $s < $bh) { 848 if ($s < $bw && $s < $bh) {
774 $pixbuf = new_pixbuf $s, $s, 1, 0; 849 $pixbuf = new_pixbuf $s, $s, $::config{conserve_memory} ? 0 : 1, 0;
775 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0); 850 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
776 } else { 851 } else {
777 $pixbuf = scale_pixbuf $::board_img, $s, $s, INTERP_TILES; 852 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES;
778 } 853 }
779 854
780 my $linew = int ($s / 500); 855 my $linew = int ($s / 25 / $size);
781 856
782 my $a = "A";
783 for my $i (1 .. $size) { 857 for my $i (1 .. $size) {
784 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew; 858 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
785 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew; 859 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;
786 860
861 # 38 max, but we allow a bit more
862 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
863 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];
864
787 pixbuf_text $pixbuf, 0, $k[$i], ($ofs +$border) / 2, $ofs, $a; 865 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
788 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border + $ofs / 2, $ofs, $a; 866 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
789 pixbuf_text $pixbuf, 0, ($ofs + $border) / 2, $k[$i], $ofs, $size - $i + 1; 867 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
790 pixbuf_text $pixbuf, 0, $s2 + $border + $ofs / 2, $k[$i], $ofs, $size - $i + 1; 868 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
791 869
792 $a++; 870 $a++;
793 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK... 871 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
794 } 872 }
795 873
874 unless ($::config->{conserve_memory}) {
796 $self->{background} = $pixbuf; 875 $self->{background} = $pixbuf;
876 $pixbuf = $pixbuf->copy;
877 }
797 } 878 }
798 879
799 my $pixbuf = $self->{pixbuf} = $self->{background}->copy; 880 $self->{pixbuf} = $pixbuf;
800 881
801 # hoshi-points(!)#d# 882 # hoshi-points(!)#d#
802 # caching of empty board gfx(!)#d# 883 # caching of empty board gfx(!)#d#
803 884
804 for my $x (1 .. $size) { 885 for my $x (1 .. $size) {
805 for my $y (1 .. $size) { 886 for my $y (1 .. $size) {
887 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
806 my $mark = $self->{board}{board}[$x-1][$y-1]; 888 my $mark = $self->{board}{board}[$x-1][$y-1];
889 my $old = $oldboard ? $oldboard->{board}[$x-1][$y-1] : 0;
890
891 if ($oldboard && $old != $mark) {
892 my $shadow = $edge * 0.05;
893 my $new_expose = [$dx, $dy, $edge + $shadow, $edge + $shadow];
894 $self->{background}->copy_area (@$new_expose, $pixbuf, $dx, $dy);
895 $expose_area = $expose_area
896 ? Gtk::Gdk::Rectangle->union ($expose_area, $new_expose)
897 : $new_expose;
898 }
807 899
808 if ($mark) { 900 if ($mark) {
809 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
810 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 ); 901 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 );
811 902
812 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height, 903 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height,
813 $dx, $dy, 1, 1, INTERP_NEAREST, 255); 904 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
905
906 # labels are handled here because they are quite rare
907 if ($mark & MARK_LABEL) {
908 my $white = $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1;
909
910 if ($white) {
911 pixbuf_text $pixbuf, 0,
912 $k[$x] + $ofs * 0.1, $k[$y] + $ofs * 0.1, $ofs * 0.7,
913 $self->{board}{label}[$x-1][$y-1];
914 }
915 pixbuf_text $pixbuf, $white,
916 $k[$x], $k[$y], $ofs * 0.7,
917 $self->{board}{label}[$x-1][$y-1];
918 }
814 919
920 # old pixmap&mask-way. that was fast ;(
815 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 ); 921 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
816 922
817 #$gc->set_clip_mask ($bm); 923 #$gc->set_clip_mask ($bm);
818 #$gc->set_clip_origin ($dx, $dy); 924 #$gc->set_clip_origin ($dx, $dy);
819 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge); 925 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
820 } 926 }
821 } 927 }
822 } 928 }
823}
824 929
930 $self->{board_shown} = Storable::dclone $self->{board};
931 #d# save
932 #Storable::nstore { board => $self->{board}, size => $self->{size}, path => $self->{path}}, "testboard.storable";
933
934 $expose_area;
935}
936
825sub expose_event { 937sub expose {
826 my ($widget, $self, $event) = @_; 938 my ($self, $area) = @_;
827 939
828 $self->{pixbuf} or return; 940 if ($area && $self->{pixbuf}) {
829 941 my ($x, $y, $w, $h) = @$area;
830 my ($ox, $oy, $s) = @{$self->{offsets}}; 942 my ($ox, $oy, $s) = @{$self->{offsets}};
831 943
832 my ($x, $y, $w, $h) =
833 @{Gtk::Gdk::Rectangle->intersect(
834 $event->{area},
835 [$ox, $oy, $s, $s]
836 )};
837
838 if (defined $x) {
839 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc, 944 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc,
840 $x - $ox, $y - $oy, $x, $y, $w, $h); 945 $x, $y, $x + $ox, $y + $oy, $w, $h);
946 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0,
947 $x + $ox - 1, $y + $oy - 1, $w + 2, $h + 2) if $::DEBUG_EXPOSE;
948
841 #$self->{canvas}->window->draw_pixmap ( 949 #$self->{canvas}->window->draw_pixmap (
842 # $self->{canvas}->style->white_gc, 950 # $self->{canvas}->style->white_gc,
843 # $self->{pixmap}, 951 # $self->{pixmap},
844 # $x - $ox, $y - $oy, $x, $y, $w, $h, 952 # $x - $ox, $y - $oy, $x, $y, $w, $h,
845 #); 953 #);
846 } 954 }
955}
956
957sub expose_event {
958 my ($widget, $self, $event) = @_;
959
960 $self->{pixbuf} or return;
961
962 my $area = $event->{area};
963 my ($ox, $oy, $s) = @{$self->{offsets}};
964
965 $self->expose (Gtk::Gdk::Rectangle->intersect (
966 [$area->[0] - $ox, $area->[1] - $oy, $area->[2], $area->[3]],
967 [0, 0, $s, $s],
968 ));
969
847 1; 970 1;
848} 971}
849 972
850sub event_update_tree { 973sub event_update_tree {
851 my ($self) = @_; 974 my ($self) = @_;
852 975
853 $self->{board} = new KGS::Game::Board $self->{size}; 976 $self->{path} = $self->get_path;
854 $self->{board}->interpret_path ($self->get_path); 977
978 my $move = @{$self->{path}};
855 979
856 $self->repaint_board; 980 $self->{moveadj}->upper($move);
857 981
858 # force a redraw (not perfect(?)) 982 if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
859 expose_event $self->{canvas}, $self, { area => $self->{canvas}->allocation }; 983 $self->{moveadj}->set_value ($move);
984 }
985}
860 986
861 $self->{text}->backward_delete($self->{text}->get_length); 987sub event_part {
862 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment}); 988 my ($self) = @_;
989 $self->SUPER::event_part;
990 (delete $self->{window})->destroy; # hmm.. why does this keep the object alive? puzzling.. ahh.. the callbacks ;)
991 delete $self->{room}{game}{$self->{channel}};
863} 992}
864 993
865sub event_move { 994sub event_move {
866 ::play_sound "move"; 995 my ($self, $pass) = @_;
996 ::play_sound 1, $pass ? "pass" : "move";
997}
998
999sub DESTROY {#d#
1000 warn "DESTROY(@_)\n";#d#
867} 1001}
868 1002
8691; 10031;
870 1004
871 1005

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines