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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.23 by pcg, Fri May 30 11:53:24 2003 UTC vs.
Revision 1.26 by pcg, Sat May 31 03:11:58 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";
… …
81 my $state = -r $staterc ? Storable::retrieve($staterc) : {}; 88 my $state = -r $staterc ? Storable::retrieve($staterc) : {};
82 my @widgets; 89 my @widgets;
83 90
84 $config = $state->{config} ||= {}; 91 $config = $state->{config} ||= {};
85 92
86 $config{speed} = 1;#d# optimize for speed or memory? 93 $config{speed} = 0;#d# optimize for speed or memory?
87 $config{conserve_memory} = 0; 94 $config{conserve_memory} = 0;
88 95
89 # grr... more gtk+ brokenness 96 # grr... more gtk+ brokenness
90 my %get = ( 97 my %get = (
91 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] }, 98 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
… …
182} 189}
183 190
184if (0) { 191if (0) {
185 use KGS::Constants; 192 use KGS::Constants;
186 193
187 my $board = new game size => 5; 194 for (19) {
195 my $board = new game %{Storable::retrieve "testboard.storable"};
196
197 if (0) {
188 $board->{board} = new KGS::Game::Board; 198 $board->{board} = new KGS::Game::Board;
189 $board->{board}{board}[0][0] = MARK_B; 199 $board->{board}{board}[0][0] = MARK_B;
190 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W; 200 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
191 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE; 201 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
202 $board->{board}{board}[1][2] = MARK_B | MARK_LABEL;
203 $board->{board}{label}[1][2] = "198";
204 $board->{board}{board}[0][2] = MARK_W | MARK_LABEL;
205 $board->{board}{label}[0][2] = "AWA";
206 }
192 $board->{window}->show_all; 207 $board->{window}->show_all;
208 }
193} 209}
194 210
195main Gtk; 211main Gtk;
196 212
197############################################################################# 213#############################################################################
… …
206 222
207 $self->{conn} = new KGS::Protocol; 223 $self->{conn} = new KGS::Protocol;
208 224
209 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :) 225 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
210 226
211 $self->listen($self->{conn}); 227 $self->listen($self->{conn}, "login");
212 228
213 $self->{roomlist} = new roomlist conn => $self->{conn}; 229 $self->{roomlist} = new roomlist conn => $self->{conn};
214 230
215 $self->{window} = new Gtk::Window 'toplevel'; 231 $self->{window} = new Gtk::Window 'toplevel';
216 $self->{window}->set_title('kgsueme'); 232 $self->{window}->set_title('kgsueme');
… …
279 } 295 }
280 $self->{conn}->feed_data($buf); 296 $self->{conn}->feed_data($buf);
281 }; 297 };
282 298
283 # now login 299 # now login
284 $self->{conn}->login($self->{login}->get_text, $self->{password}->get_text); 300 $self->{conn}->login("kgsueme $VERSION $^O", $self->{login}->get_text, $self->{password}->get_text);
285} 301}
286 302
287sub inject_login { 303sub inject_login {
288 my ($self, $msg) = @_; 304 my ($self, $msg) = @_;
289 305
… …
383 399
384sub new { 400sub new {
385 my $self = shift; 401 my $self = shift;
386 $self = $self->SUPER::new(@_); 402 $self = $self->SUPER::new(@_);
387 403
388 $self->listen($self->{conn}); 404 $self->listen($self->{conn}, qw(msg_room:));
389 405
390 $self->{window} = new Gtk::Window 'toplevel'; 406 $self->{window} = new Gtk::Window 'toplevel';
391 $self->{window}->set_title("KGS Room $self->{name}"); 407 $self->{window}->set_title("KGS Room $self->{name}");
392 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400]; 408 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
393 409
… …
436 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30]; 452 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
437 453
438 $self; 454 $self;
439} 455}
440 456
457sub join {
458 my ($self) = @_;
459 $self->SUPER::join;
460
461 $self->{window}->show_all;
462}
463
464sub part {
465 my ($self) = @_;
466 $self->SUPER::part;
467
468 delete $::config->{rooms}{$self->{channel}};
469 $self->{window}->hide_all;
470 $self->event_update_users;
471 $self->event_update_games;
472}
473
474sub inject_msg_room {
475 my ($self, $msg) = @_;
476
477 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
478}
479
441sub event_update_users { 480sub event_update_users {
442 my ($self) = @_; 481 my ($self) = @_;
443 482
444 $self->{event_update} ||= Gtk->timeout_add(200, sub { 483 $self->{event_update} ||= Gtk->timeout_add(200, sub {
445 my $l = $self->{userlist}; 484 my $l = $self->{userlist};
… …
484 delete $self->{event_update_games}; 523 delete $self->{event_update_games};
485 0; 524 0;
486 }); 525 });
487} 526}
488 527
489sub join {
490 my ($self) = @_;
491 $self->SUPER::join;
492
493 $self->{window}->show_all;
494}
495
496sub part {
497 my ($self) = @_;
498 $self->SUPER::part;
499
500 delete $::config->{rooms}{$self->{channel}};
501 $self->{window}->hide_all;
502 $self->event_update_users;
503 $self->event_update_games;
504}
505
506sub event_join { 528sub event_join {
507 my ($self) = @_; 529 my ($self) = @_;
508 $self->SUPER::event_join; 530 $self->SUPER::event_join;
509 531
510 $::config->{rooms}{$self->{channel}} = 1; 532 $::config->{rooms}{$self->{channel}} = 1;
… …
512 534
513sub event_update_roominfo { 535sub event_update_roominfo {
514 my ($self) = @_; 536 my ($self) = @_;
515 537
516 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n"); 538 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
517}
518
519sub inject_msg_room {
520 my ($self, $msg) = @_;
521 return unless $self->{channel} == $msg->{channel};
522
523 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
524} 539}
525 540
526############################################################################# 541#############################################################################
527 542
528package game; 543package game;
… …
538 $self = $self->SUPER::new(@_); 553 $self = $self->SUPER::new(@_);
539 554
540 $self->listen($self->{conn}); 555 $self->listen($self->{conn});
541 556
542 $self->{window} = new Gtk::Window 'toplevel'; 557 $self->{window} = new Gtk::Window 'toplevel';
543 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1) if $self->{channel};#d# 558 my $title = $self->{channel} ? $self->user0." ".$self->user1 : "Game Window";
559 $self->{window}->set_title("KGS Game $title");
544 ::state $self->{window}, "game::window", undef, window_size => [600, 500]; 560 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
545 561
546 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 }); 562 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
547 563
548 $self->{window}->add(my $hpane = new Gtk::HPaned); 564 $self->{window}->add(my $hpane = new Gtk::HPaned);
549 ::state $hpane, "game::hpane", undef, hpane_position => 500; 565 ::state $hpane, "game::hpane", undef, hpane_position => 500;
550 566
567 $hpane->pack1(my $vbox = new Gtk::VBox);
568
569 $vbox->pack_start((my $frame = new Gtk::Frame), 0, 1, 0);
570
571 {
572 $frame->add(my $vbox = new Gtk::VBox);
573 $vbox->add($self->{title} = new Gtk::Label $title);
574
575 $self->{moveadj} = new Gtk::Adjustment 0, 0, 0, 1, 10, 0;
576 $vbox->add(my $scale = new Gtk::HScale $self->{moveadj});
577 $scale->set_draw_value (1);
578 $scale->set_digits (0);
579 $scale->set_value_pos('top');
580
581 $self->{moveadj}->signal_connect (value_changed => sub {
582 $self->{board} = new KGS::Game::Board $self->{size};
583 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]);
584
585 my $area = $self->repaint_board;
586
587 # force a redraw (not perfect(?))
588 $self->expose ($area);
589
590 $self->{text}->backward_delete($self->{text}->get_length);
591 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
592 });
593
594 $self->{moveadj}->upper (scalar @{$self->{path}}) if $self->{path};
595 }
596
551 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual); 597 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
552 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap); 598 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
553 $hpane->pack1(($self->{canvas} = new Gtk::DrawingArea), 1, 1); 599 $vbox->pack_start(($self->{canvas} = new Gtk::DrawingArea), 1, 1, 0);
554 Gtk::Widget->pop_colormap; 600 Gtk::Widget->pop_colormap;
555 Gtk::Widget->pop_visual; 601 Gtk::Widget->pop_visual;
556 602
557 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); 603 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
558 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); 604 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
… …
605} 651}
606 652
607sub configure_event { 653sub configure_event {
608 my ($widget, $self, $event) = @_; 654 my ($widget, $self, $event) = @_;
609 delete $self->{stack}; 655 delete $self->{stack};
656 delete $self->{pixbuf};
657 delete $self->{board_shown};
610 delete $self->{background}; 658 delete $self->{background};
611 $self->repaint_board; 659 $self->repaint_board;
612 1; 660 1;
613} 661}
614 662
… …
646 694
647# create a stack of stones 695# create a stack of stones
648sub create_stack { 696sub create_stack {
649 my ($self, $mark, $size, $rand) = @_; 697 my ($self, $mark, $size, $rand) = @_;
650 698
651 my $shadow = $size * 0.06; 699 my $shadow = $size * 0.05;
652 700
653 my $c = \$self->{stack}{$mark}; 701 my $c = \$self->{stack}{$mark};
654 unless ($$c) { 702 unless ($$c) {
655 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) { 703 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
656 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1; 704 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1;
657 705
658 # zeroeth the shadow 706 # zeroeth the shadow
707 if ($mark & (MARK_B | MARK_W)) {
659 $::black_img[0]->composite ( 708 $::black_img[0]->composite (
660 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5, 709 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
661 $size / $stone->get_width, $size / $stone->get_height, 710 $size / $stone->get_width, $size / $stone->get_height,
662 $::config{speed} ? INTERP_NEAREST : INTERP_TILES, 128 711 $::config{speed} ? INTERP_NEAREST : INTERP_TILES, 128
663 ); 712 );
713 }
664 714
665 # first the big stones 715 # first the big stones
666 for ([MARK_B, 255], 716 for ([MARK_B, 255],
667 [MARK_W, 255], 717 [MARK_W, 255],
668 [MARK_GRAY_B, 128], 718 [MARK_GRAY_B, 128],
… …
688 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 192 738 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 192
689 ); 739 );
690 } 740 }
691 } 741 }
692 742
693 # and lastly any markers (labels NYI) 743 # and lastly any markers
694 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B)); 744 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
695 745
696 for ([MARK_CIRCLE, $::circle_img[$dark_bg]], 746 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
697 [MARK_TRIANGLE, $::triangle_img[$dark_bg]], 747 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
698 [MARK_SQUARE, $::square_img[$dark_bg]]) { 748 [MARK_SQUARE, $::square_img[$dark_bg]]) {
… …
714} 764}
715 765
716sub pixbuf_text { 766sub pixbuf_text {
717 my ($pixbuf, $colour, $x, $y, $height, $text) = @_; 767 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
718 768
719 my $c = $::font[$colour][$::fontmap{substr $text, 0, 1}]; 769 my @c = grep $_,
770 map $::font[$colour][$::fontmap{$_}],
771 split //, $text;
720 772
721 if ($c) { 773 if (@c) {
722 my ($w, $h) = ($c->get_width, $c->get_height); 774 my $spacing = $height * 0.1;
723 my $s = ($height-1) / ($h-1); 775 my $s = $height / List::Util::max map $_->get_height, @c;
776 my $W = List::Util::sum map $_->get_width, @c;
724 777
725 $x -= $w * $s * 0.5; 778 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5;
726 $y -= $height * 0.5; 779 $y -= $height * 0.5;
727 780
781 for (@c) {
782 my $w = $_->get_width * $s;
728 $c->composite ($pixbuf, 783 $_->composite ($pixbuf,
729 $x, $y, $w*$s+0.5, $height+0.5, $x-0.5, $y-0.5, $s, $s, 784 $x, $y, $w+0.999, $height+0.999, $x, $y, $s, $s,
730 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 192); 785 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
731 786
732 } else { 787 $x += $w + $spacing;
733 warn "unable to render character '$text'"; 788 }
734 } 789 }
735} 790}
736 791
737my $black_pb; 792my $black_pb;
738 793
… …
748} 803}
749 804
750sub repaint_board { 805sub repaint_board {
751 my ($self) = @_; 806 my ($self) = @_;
752 my $canvas = $self->{canvas}; 807 my $canvas = $self->{canvas};
808 my $expose_area = undef;
753 809
754 return unless $self->{board}; 810 return $expose_area unless $self->{board};
755 811
756 my ($w, $h) = @{$canvas->allocation}[2,3]; 812 my ($w, $h) = @{$canvas->allocation}[2,3];
757 813
758 my $s = $w > $h ? $h : $w; 814 my $s = $w > $h ? $h : $w;
759 815
760 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s]; 816 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
761 817
762 my $size = $self->{size}; 818 my $size = $self->{size};
763 819
764 my $border = int ($s / $size); 820 my $border = int ($s / ($size + 3) * 0.5);
765 my $s2 = $s - $border * 2; 821 my $s2 = $s - $border * 2;
766 my $edge = int ($s2 / $size * 0.97); 822 my $edge = int ($s2 / ($size + 1) * 0.95);
767 my $ofs = int ($edge / 2); 823 my $ofs = int ($edge / 2);
768 824
769 my @k = map int ($s2 * $_ / $size - $ofs + $border + 0.5), 0 .. $size; 825 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
770 826
771 my $pixbuf; 827 my $pixbuf;
772 828
829 my $oldboard;
830
773 if ($self->{background}) { 831 if ($self->{background}) {
832 if ($oldboard = $self->{board_shown}) {
833 $pixbuf = $self->{pixbuf};
834 } else {
774 $pixbuf = $self->{background}->copy; 835 $pixbuf = $self->{background}->copy;
836 $expose_area = [0, 0, $s, $s];
837 }
775 } else { 838 } else {
839 $expose_area = [0, 0, $s, $s];
840
776 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height); 841 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
777 842
778 if ($s < $bw && $s < $bh) { 843 if ($s < $bw && $s < $bh) {
779 $pixbuf = new_pixbuf $s, $s, $::config{conserve_memory} ? 0 : 1, 0; 844 $pixbuf = new_pixbuf $s, $s, $::config{conserve_memory} ? 0 : 1, 0;
780 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0); 845 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
781 } else { 846 } else {
782 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES; 847 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES;
783 } 848 }
784 849
785 my $linew = int ($s / 500); 850 my $linew = int ($s / 25 / $size);
786 851
787 my $a = "A";
788 for my $i (1 .. $size) { 852 for my $i (1 .. $size) {
789 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew; 853 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
790 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew; 854 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;
791 855
856 # 38 max, but we allow a bit more
857 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
858 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];
859
792 pixbuf_text $pixbuf, 0, $k[$i], ($ofs +$border) / 2, $ofs, $a; 860 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
793 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border + $ofs / 2, $ofs, $a; 861 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
794 pixbuf_text $pixbuf, 0, ($ofs + $border) / 2, $k[$i], $ofs, $size - $i + 1; 862 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
795 pixbuf_text $pixbuf, 0, $s2 + $border + $ofs / 2, $k[$i], $ofs, $size - $i + 1; 863 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
796 864
797 $a++; 865 $a++;
798 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK... 866 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
799 } 867 }
800 868
… …
809 # hoshi-points(!)#d# 877 # hoshi-points(!)#d#
810 # caching of empty board gfx(!)#d# 878 # caching of empty board gfx(!)#d#
811 879
812 for my $x (1 .. $size) { 880 for my $x (1 .. $size) {
813 for my $y (1 .. $size) { 881 for my $y (1 .. $size) {
882 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
814 my $mark = $self->{board}{board}[$x-1][$y-1]; 883 my $mark = $self->{board}{board}[$x-1][$y-1];
884 my $old = $oldboard ? $oldboard->{board}[$x-1][$y-1] : 0;
885
886 if ($oldboard && $old != $mark) {
887 my $shadow = $edge * 0.05;
888 my $new_expose = [$dx, $dy, $edge + $shadow, $edge + $shadow];
889 $self->{background}->copy_area (@$new_expose, $pixbuf, $dx, $dy);
890 $expose_area = $expose_area
891 ? Gtk::Gdk::Rectangle->union ($expose_area, $new_expose)
892 : $new_expose;
893 }
815 894
816 if ($mark) { 895 if ($mark) {
817 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
818 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 ); 896 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 );
819 897
820 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height, 898 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height,
821 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255); 899 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
900
901 # labels are handled here because they are quite rare
902 if ($mark & MARK_LABEL) {
903 my $white = $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1;
904
905 if ($white) {
906 pixbuf_text $pixbuf, 0,
907 $k[$x] + $ofs * 0.1, $k[$y] + $ofs * 0.1, $ofs * 0.7,
908 $self->{board}{label}[$x-1][$y-1];
909 }
910 pixbuf_text $pixbuf, $white,
911 $k[$x], $k[$y], $ofs * 0.7,
912 $self->{board}{label}[$x-1][$y-1];
913 }
822 914
915 # old pixmap&mask-way. that was fast ;(
823 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 ); 916 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
824 917
825 #$gc->set_clip_mask ($bm); 918 #$gc->set_clip_mask ($bm);
826 #$gc->set_clip_origin ($dx, $dy); 919 #$gc->set_clip_origin ($dx, $dy);
827 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge); 920 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
828 } 921 }
829 } 922 }
830 } 923 }
831}
832 924
925 $self->{board_shown} = Storable::dclone $self->{board};
926 #d# save
927 #Storable::nstore { board => $self->{board}, size => $self->{size}, path => $self->{path}}, "testboard.storable";
928
929 $expose_area;
930}
931
833sub expose_event { 932sub expose {
834 my ($widget, $self, $event) = @_; 933 my ($self, $area) = @_;
835 934
836 $self->{pixbuf} or return; 935 if ($area && $self->{pixbuf}) {
837 936 my ($x, $y, $w, $h) = @$area;
838 my ($ox, $oy, $s) = @{$self->{offsets}}; 937 my ($ox, $oy, $s) = @{$self->{offsets}};
839 938
840 my ($x, $y, $w, $h) =
841 @{Gtk::Gdk::Rectangle->intersect(
842 $event->{area},
843 [$ox, $oy, $s, $s]
844 )};
845
846 if (defined $x) {
847 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc, 939 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc,
848 $x - $ox, $y - $oy, $x, $y, $w, $h); 940 $x, $y, $x + $ox, $y + $oy, $w, $h);
941 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0,
942 $x + $ox, $y + $oy, $w, $h) if $::DEBUG_EXPOSE;
943
849 #$self->{canvas}->window->draw_pixmap ( 944 #$self->{canvas}->window->draw_pixmap (
850 # $self->{canvas}->style->white_gc, 945 # $self->{canvas}->style->white_gc,
851 # $self->{pixmap}, 946 # $self->{pixmap},
852 # $x - $ox, $y - $oy, $x, $y, $w, $h, 947 # $x - $ox, $y - $oy, $x, $y, $w, $h,
853 #); 948 #);
854 } 949 }
950}
951
952sub expose_event {
953 my ($widget, $self, $event) = @_;
954
955 $self->{pixbuf} or return;
956
957 my $area = $event->{area};
958 my ($ox, $oy, $s) = @{$self->{offsets}};
959
960 $self->expose (Gtk::Gdk::Rectangle->intersect (
961 [$area->[0] - $ox, $area->[1] - $oy, $area->[2], $area->[3]],
962 [0, 0, $s, $s],
963 ));
964
855 1; 965 1;
856} 966}
857 967
858sub event_update_tree { 968sub event_update_tree {
859 my ($self) = @_; 969 my ($self) = @_;
860 970
861 $self->{board} = new KGS::Game::Board $self->{size}; 971 $self->{path} = $self->get_path;
862 $self->{board}->interpret_path ($self->get_path); 972
973 my $move = @{$self->{path}};
863 974
864 $self->repaint_board; 975 $self->{moveadj}->upper($move);
865 976
866 # force a redraw (not perfect(?)) 977 if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
867 expose_event $self->{canvas}, $self, { area => $self->{canvas}->allocation }; 978 $self->{moveadj}->set_value ($move);
868 979 }
869 $self->{text}->backward_delete($self->{text}->get_length);
870 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
871} 980}
872 981
873sub event_move { 982sub event_move {
874 ::play_sound "move"; 983 ::play_sound "move";
875} 984}

Diff Legend

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