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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.16 by pcg, Fri May 30 07:19:16 2003 UTC vs.
Revision 1.27 by pcg, Sat May 31 03:47:26 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";
… …
27sub load_img { 34sub load_img {
28 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]" 35 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
29# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]" 36# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
30 or die "$IMGDIR/$_[0]: $!"; 37 or die "$IMGDIR/$_[0]: $!";
31} 38}
39
40my @fontchars = ('A' .. 'Z', 0 .. 9);
32 41
33our @black_img = load_img "b-01.png"; 42our @black_img = load_img "b-01.png";
34our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5; 43our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5;
35our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w); 44our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w);
36our @square_img = map +(load_img "square-$_.png"), qw(b w); 45our @square_img = map +(load_img "square-$_.png"), qw(b w);
37our @circle_img = map +(load_img "circle-$_.png"), qw(b w); 46our @circle_img = map +(load_img "circle-$_.png"), qw(b w);
38our $board_img = load_img "woodgrain-01.jpg"; 47our $board_img = load_img "woodgrain-01.jpg";
39 48
49our @font = (
50 [map +(load_img "font/$_-black.png"), @fontchars],
51 [map +(load_img "font/$_-white.png"), @fontchars],
52 );
53our %fontmap;
54@fontmap{@fontchars} = (0..25 + 10);
55@fontmap{'a' .. 'z'} = (0..25);
56
40{ 57{
41 #my $audioserver = new Audio::Play(0); 58 #my $audioserver = new Audio::Play(0);
42 my %sound; 59 my %sound;
43 $SIG{CHLD} = 'IGNORE'; 60 $SIG{CHLD} = 'IGNORE';
44 61
… …
52 $sound{$_}->Load($snd); 69 $sound{$_}->Load($snd);
53 } 70 }
54 71
55 sub play_sound { 72 sub play_sound {
56 if (fork == 0) { 73 if (fork == 0) {
57 my $audioserver = new Audio::Play(1); 74 if (my $audioserver = new Audio::Play(1)) {
58 $audioserver->play ($sound{$_[0]}); 75 $audioserver->play ($sound{$_[0]});
76 }
59 Gtk->_exit(0); 77 Gtk->_exit(0);
60 } 78 }
61 } 79 }
62} 80}
63 81
… …
69 87
70 my $state = -r $staterc ? Storable::retrieve($staterc) : {}; 88 my $state = -r $staterc ? Storable::retrieve($staterc) : {};
71 my @widgets; 89 my @widgets;
72 90
73 $config = $state->{config} ||= {}; 91 $config = $state->{config} ||= {};
92
93 $config{speed} = 0;#d# optimize for speed or memory?
94 $config{conserve_memory} = 0;
74 95
75 # grr... more gtk+ brokenness 96 # grr... more gtk+ brokenness
76 my %get = ( 97 my %get = (
77 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] }, 98 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
78 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] }, 99 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
… …
166 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text; 187 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
167 } 188 }
168} 189}
169 190
170if (0) { 191if (0) {
171 my $board = new game size => 5; 192 use KGS::Constants;
193
194 for (19) {
195 my $board = new game %{Storable::retrieve "testboard.storable"};
196
197 if (0) {
198 $board->{board} = new KGS::Game::Board;
199 $board->{board}{board}[0][0] = MARK_B;
200 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
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 }
172 $board->{window}->show_all; 207 $board->{window}->show_all;
208 }
173} 209}
174 210
175main Gtk; 211main Gtk;
176 212
177############################################################################# 213#############################################################################
… …
186 222
187 $self->{conn} = new KGS::Protocol; 223 $self->{conn} = new KGS::Protocol;
188 224
189 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :) 225 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
190 226
191 $self->listen($self->{conn}); 227 $self->listen($self->{conn}, "login");
192 228
193 $self->{roomlist} = new roomlist conn => $self->{conn}; 229 $self->{roomlist} = new roomlist conn => $self->{conn};
194 230
195 $self->{window} = new Gtk::Window 'toplevel'; 231 $self->{window} = new Gtk::Window 'toplevel';
196 $self->{window}->set_title('kgsueme'); 232 $self->{window}->set_title('kgsueme');
… …
259 } 295 }
260 $self->{conn}->feed_data($buf); 296 $self->{conn}->feed_data($buf);
261 }; 297 };
262 298
263 # now login 299 # now login
264 $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);
265} 301}
266 302
267sub inject_login { 303sub inject_login {
268 my ($self, $msg) = @_; 304 my ($self, $msg) = @_;
269 305
… …
363 399
364sub new { 400sub new {
365 my $self = shift; 401 my $self = shift;
366 $self = $self->SUPER::new(@_); 402 $self = $self->SUPER::new(@_);
367 403
368 $self->listen($self->{conn}); 404 $self->listen($self->{conn}, qw(msg_room:));
369 405
370 $self->{window} = new Gtk::Window 'toplevel'; 406 $self->{window} = new Gtk::Window 'toplevel';
371 $self->{window}->set_title("KGS Room $self->{name}"); 407 $self->{window}->set_title("KGS Room $self->{name}");
372 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400]; 408 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
373 409
… …
387 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120]; 423 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
388 424
389 $self->{gamelist}->signal_connect(select_row => sub { 425 $self->{gamelist}->signal_connect(select_row => sub {
390 my $game = $self->{gamelist}->get_row_data($_[1]) 426 my $game = $self->{gamelist}->get_row_data($_[1])
391 or return; 427 or return;
392 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn}; 428 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn}, room => $self;
393 $self->{game}{$game->{channel}}->join; 429 $self->{game}{$game->{channel}}->join;
394 $self->{gamelist}->unselect_all; 430 $self->{gamelist}->unselect_all;
395 }); 431 });
396 432
397 $vpane->add(my $vbox = new Gtk::VBox); 433 $vpane->add(my $vbox = new Gtk::VBox);
… …
416 ::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];
417 453
418 $self; 454 $self;
419} 455}
420 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}
471
472sub inject_msg_room {
473 my ($self, $msg) = @_;
474
475 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
476}
477
421sub event_update_users { 478sub event_update_users {
422 my ($self) = @_; 479 my ($self) = @_;
423 480
424 $self->{event_update} ||= Gtk->timeout_add(200, sub { 481 $self->{event_update} ||= Gtk->timeout_add(200, sub {
425 my $l = $self->{userlist}; 482 my $l = $self->{userlist};
… …
464 delete $self->{event_update_games}; 521 delete $self->{event_update_games};
465 0; 522 0;
466 }); 523 });
467} 524}
468 525
469sub join {
470 my ($self) = @_;
471 $self->SUPER::join;
472
473 $self->{window}->show_all;
474}
475
476sub part {
477 my ($self) = @_;
478 $self->SUPER::part;
479
480 delete $::config->{rooms}{$self->{channel}};
481 $self->{window}->hide_all;
482 $self->event_update_users;
483 $self->event_update_games;
484}
485
486sub event_join { 526sub event_join {
487 my ($self) = @_; 527 my ($self) = @_;
488 $self->SUPER::event_join; 528 $self->SUPER::event_join;
489 529
490 $::config->{rooms}{$self->{channel}} = 1; 530 $::config->{rooms}{$self->{channel}} = 1;
… …
492 532
493sub event_update_roominfo { 533sub event_update_roominfo {
494 my ($self) = @_; 534 my ($self) = @_;
495 535
496 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n"); 536 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
497}
498
499sub inject_msg_room {
500 my ($self, $msg) = @_;
501 return unless $self->{channel} == $msg->{channel};
502
503 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
504} 537}
505 538
506############################################################################# 539#############################################################################
507 540
508package game; 541package game;
… …
518 $self = $self->SUPER::new(@_); 551 $self = $self->SUPER::new(@_);
519 552
520 $self->listen($self->{conn}); 553 $self->listen($self->{conn});
521 554
522 $self->{window} = new Gtk::Window 'toplevel'; 555 $self->{window} = new Gtk::Window 'toplevel';
523 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1) if $self->{channel};#d# 556 my $title = $self->{channel} ? $self->user0." ".$self->user1 : "Game Window";
557 $self->{window}->set_title("KGS Game $title");
524 ::state $self->{window}, "game::window", undef, window_size => [600, 500]; 558 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
525 559
526 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 }); 560 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
527 561
528 $self->{window}->add(my $hpane = new Gtk::HPaned); 562 $self->{window}->add(my $hpane = new Gtk::HPaned);
529 ::state $hpane, "game::hpane", undef, hpane_position => 500; 563 ::state $hpane, "game::hpane", undef, hpane_position => 500;
530 564
565 $hpane->pack1(my $vbox = new Gtk::VBox);
566
567 $vbox->pack_start((my $frame = new Gtk::Frame), 0, 1, 0);
568
569 {
570 $frame->add(my $vbox = new Gtk::VBox);
571 $vbox->add($self->{title} = new Gtk::Label $title);
572
573 $self->{moveadj} = new Gtk::Adjustment 0, 0, 0, 1, 10, 0;
574 $vbox->add(my $scale = new Gtk::HScale $self->{moveadj});
575 $scale->set_draw_value (1);
576 $scale->set_digits (0);
577 $scale->set_value_pos('top');
578
579 $self->{moveadj}->signal_connect (value_changed => sub {
580 $self->{board} = new KGS::Game::Board $self->{size};
581 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]);
582
583 my $area = $self->repaint_board;
584
585 # force a redraw (not perfect(?))
586 $self->expose ($area);
587
588 $self->{text}->backward_delete($self->{text}->get_length);
589 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
590 });
591
592 $self->{moveadj}->upper (scalar @{$self->{path}}) if $self->{path};
593 }
594
531 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual); 595 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
532 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap); 596 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
533 $hpane->pack1(($self->{canvas} = new Gtk::DrawingArea), 1, 1); 597 $vbox->pack_start(($self->{canvas} = new Gtk::DrawingArea), 1, 1, 0);
534 Gtk::Widget->pop_colormap; 598 Gtk::Widget->pop_colormap;
535 Gtk::Widget->pop_visual; 599 Gtk::Widget->pop_visual;
536 600
537 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); 601 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
538 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); 602 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
… …
585} 649}
586 650
587sub configure_event { 651sub configure_event {
588 my ($widget, $self, $event) = @_; 652 my ($widget, $self, $event) = @_;
589 delete $self->{stack}; 653 delete $self->{stack};
654 delete $self->{pixbuf};
655 delete $self->{board_shown};
656 delete $self->{background};
590 $self->repaint_board; 657 $self->repaint_board;
591 1; 658 1;
592} 659}
593 660
594sub expose_event { 661sub INTERP_NEAREST (){ 1 }
595 my ($widget, $self, $event) = @_;
596
597 $self->{pixmap} or return;
598
599 my ($ox, $oy, $s) = @{$self->{offsets}};
600
601 my ($x, $y, $w, $h) =
602 @{Gtk::Gdk::Rectangle->intersect(
603 $event->{area},
604 [$ox, $oy, $s, $s]
605 )};
606
607 $self->{canvas}->window->draw_pixmap (
608 $self->{canvas}->style->white_gc,
609 $self->{pixmap},
610 $x - $ox, $y - $oy, $x, $y, $w, $h,
611 );
612 1;
613}
614
615# create new, _transparent_ pixbuf
616sub new_pixbuf {
617 my ($w, $h) = @_;
618
619 $pixbuf;
620}
621
622sub INTERP_TILES (){ 1 } 662sub INTERP_TILES (){ 1 }
623sub INTERP_BILINEAR (){ 2 } 663sub INTERP_BILINEAR (){ 2 }
624sub INTERP_HYPER (){ 3 } 664sub INTERP_HYPER (){ 3 }
625 665
626sub new_pixbuf { 666sub new_pixbuf {
627 my ($w, $h, $clear) = @_; 667 my ($w, $h, $alpha, $clear) = @_;
628 668
629 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', 1, 8, $w, $h; 669 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;
630 670
631 if ($clear) { # damn, need to clear it ourselves 671 if ($clear) { # damn, need to clear it ourselves
632 my $row = "\x00\x00\x00\x00" x $w; 672 my $row = "\x00\x00\x00\x00" x $w;
633 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1; 673 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1;
634 } 674 }
… …
637} 677}
638 678
639sub scale_pixbuf { 679sub scale_pixbuf {
640 my ($src, $w, $h, $mode) = @_; 680 my ($src, $w, $h, $mode) = @_;
641 681
642 my $dst = new_pixbuf $w, $h; 682 my $dst = new_pixbuf $w, $h, 1;
643 683
644 $src->scale( 684 $src->scale(
645 $dst, 0, 0, $w, $h, 0, 0, 685 $dst, 0, 0, $w, $h, 0, 0,
646 $w / $src->get_width, $h / $src->get_height, 686 $w / $src->get_width, $h / $src->get_height,
647 $mode, 687 $mode,
648 ); 688 );
649 689
650 $dst; 690 $dst;
651} 691}
652 692
653sub label_font {
654 my ($size) = @_;
655
656 $size = int $size;
657 $size = 34 if $size > 34;
658
659 # I am soo incapable
660 for (8, 10, 11, 12, 14, 17, 18, 20, 24, 25, 34) {
661 next unless $size <= $_;
662 my $font = Gtk::Gdk::Font->fontset_load ("-*-helvetica-bold-r-*--$_-*");
663 return $font if $font;
664 }
665
666 return Gtk::Gdk::Font->fontset_load ("-*-helvetica-bold-r-*--8-*");
667}
668
669sub center_text {
670 my ($drawable, $font, $gc, $x, $y, $t) = @_;
671 my $w = $font->string_width ($t);
672 my $h = $font->string_height($t) - $font->descent;
673 $drawable->draw_text ($font, $gc, $x - $w*0.5, $y + $h * 0.5, $t, length $t);
674}
675
676# create a stack of stones 693# create a stack of stones
677sub create_stack { 694sub create_stack {
678 my ($self, $gc, $mark, $size, $rand) = @_; 695 my ($self, $mark, $size, $rand) = @_;
696
697 my $shadow = $size * 0.05;
679 698
680 my $c = \$self->{stack}{$mark}; 699 my $c = \$self->{stack}{$mark};
681 unless ($$c) { 700 unless ($$c) {
682 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) { 701 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
683 my $base = 702 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1;
684 $mark & (MARK_B | MARK_GRAY_B | MARK_W | MARK_GRAY_W)
685 ? scale_pixbuf $stone, $size, $size, INTERP_HYPER
686 : new_pixbuf $size, $size, 1;
687 703
704 # zeroeth the shadow
688 if ($mark & (MARK_GRAY_B | MARK_GRAY_W)) { 705 if ($mark & (MARK_B | MARK_W)) {
689 # make transparent by stippling :( 706 $::black_img[0]->composite (
690 # fix this to use compositing if/when we have full compositing support 707 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
691 # in kgsueme 708 $size / $stone->get_width, $size / $stone->get_height,
692 my @row = ( 709 $::config{speed} ? INTERP_NEAREST : INTERP_TILES, 128
693 "\xff\xff\xff\xff\x00\x00\x00\x00" x ($size / 2 + 1), 710 );
694 "\x00\x00\x00\x00\xff\xff\xff\xff" x ($size / 2 + 1),
695 );
696 $base->put_pixels ($base->get_pixels ($_) & $row[$_ & 1], $_, 0)
697 for 0 .. $size - 1;
698 } 711 }
699 712
713 # first the big stones
714 for ([MARK_B, 255],
715 [MARK_W, 255],
716 [MARK_GRAY_B, 128],
717 [MARK_GRAY_W, 128]) {
718 my ($mask, $alpha) = @$_;
719 if ($mark & $mask) {
720 $stone->composite (
721 $base, 0, 0, $size, $size, -0.5, -0.5,
722 $size / $stone->get_width, $size / $stone->get_height,
723 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, $alpha
724 );
725 }
726 }
727
728 # then the samll stones
700 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]], 729 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]],
701 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) { 730 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) {
702 my ($mask, $img) = @$_; 731 my ($mask, $img) = @$_;
703 if ($mark & $mask) { 732 if ($mark & $mask) {
704 $img->composite ( 733 $img->composite (
705 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4) x 2, 734 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2,
706 $size / $img->get_width / 2, $size / $img->get_height / 2, 735 $size / $img->get_width / 2, $size / $img->get_height / 2,
707 INTERP_HYPER, 192 736 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 192
708 ); 737 );
709 } 738 }
710 } 739 }
711 740
741 # and lastly any markers
712 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B)); 742 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
713 743
714 for ([MARK_CIRCLE, $::circle_img[$dark_bg]], 744 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
715 [MARK_TRIANGLE, $::triangle_img[$dark_bg]], 745 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
716 [MARK_SQUARE, $::square_img[$dark_bg]]) { 746 [MARK_SQUARE, $::square_img[$dark_bg]]) {
717 my ($mask, $img) = @$_; 747 my ($mask, $img) = @$_;
718 if ($mark & $mask) { 748 if ($mark & $mask) {
719 $img->composite ( 749 $img->composite (
720 $base, 0, 0, $size, $size, 0, 0, 750 $base, 0, 0, $size, $size, -0.5, -0.5,
721 ($size - 1) / ($img->get_width - 1), ($size - 1) / ($img->get_height - 1), 751 $size / $img->get_width, $size / $img->get_height,
722 INTERP_HYPER, 255 752 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 255
723 ); 753 );
724 } 754 }
725 } 755 }
726 756
727 push @$$c, [$base->render_pixmap_and_mask (128)]; 757 push @$$c, $base;
728 } 758 }
729 } 759 }
730 760
731 @{$$c->[$rand % @$$c]}; 761 $$c->[$rand % @$$c];
762}
763
764sub pixbuf_text {
765 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
766
767 my @c = grep $_,
768 map $::font[$colour][$::fontmap{$_}],
769 split //, $text;
770
771 if (@c) {
772 my $spacing = $height * 0.1;
773 my $s = $height / List::Util::max map $_->get_height, @c;
774 my $W = List::Util::sum map $_->get_width, @c;
775
776 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5;
777 $y -= $height * 0.5;
778
779 for (@c) {
780 my $w = $_->get_width * $s;
781 $_->composite ($pixbuf,
782 $x, $y, $w+0.999, $height+0.999, $x, $y, $s, $s,
783 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
784
785 $x += $w + $spacing;
786 }
787 }
788}
789
790my $black_pb;
791
792sub pixbuf_rect {
793 my ($pb, $x1, $y1, $x2, $y2) = @_;
794 # we fake lines by... an unspeakable method :/
795 unless ($black_pb) {
796 $black_pb = new_pixbuf 1, 1, 0, 0;
797 $black_pb->put_pixels ("\x44\x11\x11", 0, 0);
798 }
799
800 $black_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, 1, 1, INTERP_NEAREST, 192);
732} 801}
733 802
734sub repaint_board { 803sub repaint_board {
735 my ($self) = @_; 804 my ($self) = @_;
736 my $canvas = $self->{canvas}; 805 my $canvas = $self->{canvas};
806 my $expose_area = undef;
737 807
738 return unless $self->{board}; 808 return $expose_area unless $self->{board};
739
740 %cache = ();
741 809
742 my ($w, $h) = @{$canvas->allocation}[2,3]; 810 my ($w, $h) = @{$canvas->allocation}[2,3];
743 811
744 my $s = $w > $h ? $h : $w; 812 my $s = $w > $h ? $h : $w;
745 813
746 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s]; 814 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
747 815
748 my $pixmap = $self->{pixmap} = new Gtk::Gdk::Pixmap $self->{canvas}->window, $s, $s; 816 my $size = $self->{size};
749 817
750 { 818 my $border = int ($s / ($size + 3) * 0.5);
819 my $s2 = $s - $border * 2;
820 my $edge = int ($s2 / ($size + 1) * 0.95);
821 my $ofs = int ($edge / 2);
822
823 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
824
825 my $pixbuf;
826
827 my $oldboard;
828
829 if ($self->{background}) {
830 if ($oldboard = $self->{board_shown}) {
831 $pixbuf = $self->{pixbuf};
832 } else {
833 $pixbuf = $self->{background}->copy;
834 $expose_area = [0, 0, $s, $s];
835 }
836 } else {
837 $expose_area = [0, 0, $s, $s];
838
751 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height); 839 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
752 840
753 my $bg = $s < $bw && $s < $bh ? $::board_img : scale_pixbuf $::board_img, $s, $s, INTERP_TILES; 841 if ($s < $bw && $s < $bh) {
754 $bg->render_to_drawable( 842 $pixbuf = new_pixbuf $s, $s, $::config{conserve_memory} ? 0 : 1, 0;
755 $pixmap, $self->{canvas}->style->white_gc, 843 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
756 0, 0, 0, 0, $s, $s, 844 } else {
757 0, 0, 0 845 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES;
758 ); 846 }
759 }
760 847
761 my $gc = Gtk::Gdk::GC->new ($pixmap);
762
763 $gc->rgb_gc_set_foreground($line_colour);
764 $gc->set_line_attributes (int ($s / 300) + 1, 'solid', 'projecting', 'miter');
765
766 my $size = $self->{size};
767 my $border = int ($s / $size); 848 my $linew = int ($s / 25 / $size);
768 my $s2 = $s - $border * 2;
769 my $edge = int ($s2 / $size) | 1;
770 my $ofs = int ($edge / 2);
771 849
772 my $font = label_font $ofs;
773
774 my @k = map int ($s2 * $_ / $size - $ofs + $border + 0.5), 0 .. $size;
775
776 my $a = "A";
777 for my $i (1 .. $size) { 850 for my $i (1 .. $size) {
778 $pixmap->draw_line ($gc, $k[$i], $k[1], $k[$i], $k[$size]); 851 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
779 $pixmap->draw_line ($gc, $k[1], $k[$i], $k[$size], $k[$i]); 852 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;
780 853
781 center_text $pixmap, $font, $gc, $k[$i], ($ofs +$border) / 2, $a; 854 # 38 max, but we allow a bit more
782 center_text $pixmap, $font, $gc, $k[$i], $s2 + $border + $ofs / 2, $a; 855 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
783 center_text $pixmap, $font, $gc, ($ofs + $border) / 2, $k[$i], $size - $i + 1; 856 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];
784 center_text $pixmap, $font, $gc, $s2 + $border + $ofs / 2, $k[$i], $size - $i + 1;
785 857
858 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
859 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
860 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
861 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
862
786 $a++; 863 $a++;
787 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK... 864 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
865 }
866
867 unless ($::config->{conserve_memory}) {
868 $self->{background} = $pixbuf;
869 $pixbuf = $pixbuf->copy;
870 }
788 } 871 }
872
873 $self->{pixbuf} = $pixbuf;
789 874
790 # hoshi-points(!)#d# 875 # hoshi-points(!)#d#
791 # caching of empty board gfx(!)#d# 876 # caching of empty board gfx(!)#d#
792 877
793 for my $x (1 .. $size) { 878 for my $x (1 .. $size) {
794 for my $y (1 .. $size) { 879 for my $y (1 .. $size) {
795 my $yk = $s2 * $x / $size - $ofs + $border; 880 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
796 my $mark = $self->{board}{board}[$x-1][$y-1]; 881 my $mark = $self->{board}{board}[$x-1][$y-1];
882 my $old = $oldboard ? $oldboard->{board}[$x-1][$y-1] : 0;
883
884 if ($oldboard && $old != $mark) {
885 my $shadow = $edge * 0.05;
886 my $new_expose = [$dx, $dy, $edge + $shadow, $edge + $shadow];
887 $self->{background}->copy_area (@$new_expose, $pixbuf, $dx, $dy);
888 $expose_area = $expose_area
889 ? Gtk::Gdk::Rectangle->union ($expose_area, $new_expose)
890 : $new_expose;
891 }
797 892
798 if ($mark) { 893 if ($mark) {
799 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs); 894 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 );
895
896 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height,
897 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
898
899 # labels are handled here because they are quite rare
900 if ($mark & MARK_LABEL) {
901 my $white = $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1;
902
903 if ($white) {
904 pixbuf_text $pixbuf, 0,
905 $k[$x] + $ofs * 0.1, $k[$y] + $ofs * 0.1, $ofs * 0.7,
906 $self->{board}{label}[$x-1][$y-1];
907 }
908 pixbuf_text $pixbuf, $white,
909 $k[$x], $k[$y], $ofs * 0.7,
910 $self->{board}{label}[$x-1][$y-1];
911 }
912
913 # old pixmap&mask-way. that was fast ;(
800 my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 ); 914 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
801 915
802 $gc->set_clip_mask ($bm); 916 #$gc->set_clip_mask ($bm);
803 $gc->set_clip_origin ($dx, $dy); 917 #$gc->set_clip_origin ($dx, $dy);
804 $pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge); 918 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
805 } 919 }
806 } 920 }
807 } 921 }
922
923 $self->{board_shown} = Storable::dclone $self->{board};
924 #d# save
925 #Storable::nstore { board => $self->{board}, size => $self->{size}, path => $self->{path}}, "testboard.storable";
926
927 $expose_area;
928}
929
930sub expose {
931 my ($self, $area) = @_;
932
933 if ($area && $self->{pixbuf}) {
934 my ($x, $y, $w, $h) = @$area;
935 my ($ox, $oy, $s) = @{$self->{offsets}};
936
937 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc,
938 $x, $y, $x + $ox, $y + $oy, $w, $h);
939 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0,
940 $x + $ox - 1, $y + $oy - 1, $w + 2, $h + 2) if $::DEBUG_EXPOSE;
941
942 #$self->{canvas}->window->draw_pixmap (
943 # $self->{canvas}->style->white_gc,
944 # $self->{pixmap},
945 # $x - $ox, $y - $oy, $x, $y, $w, $h,
946 #);
947 }
948}
949
950sub expose_event {
951 my ($widget, $self, $event) = @_;
952
953 $self->{pixbuf} or return;
954
955 my $area = $event->{area};
956 my ($ox, $oy, $s) = @{$self->{offsets}};
957
958 $self->expose (Gtk::Gdk::Rectangle->intersect (
959 [$area->[0] - $ox, $area->[1] - $oy, $area->[2], $area->[3]],
960 [0, 0, $s, $s],
961 ));
962
963 1;
808} 964}
809 965
810sub event_update_tree { 966sub event_update_tree {
811 my ($self) = @_; 967 my ($self) = @_;
812 968
813 $self->{board} = new KGS::Game::Board $self->{size}; 969 $self->{path} = $self->get_path;
814 $self->{board}->interpret_path ($self->get_path); 970
971 my $move = @{$self->{path}};
815 972
816 $self->repaint_board; 973 $self->{moveadj}->upper($move);
817 974
818 # force a redraw (not perfect(?)) 975 if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
819 expose_event $self->{canvas}, $self, { area => $self->{canvas}->allocation }; 976 $self->{moveadj}->set_value ($move);
977 }
978}
820 979
821 $self->{text}->backward_delete($self->{text}->get_length); 980sub event_part {
822 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment}); 981 my ($self) = @_;
982 $self->SUPER::event_part;
983 $self->{window}->destroy; # hmm.. why does this keep the object alive? puzzling.. ahh.. callback ;)
984 delete $self->{room}{game}{$self->{channel}};
823} 985}
824 986
825sub event_move { 987sub event_move {
826 ::play_sound "move"; 988 my ($self, $pass) = @_;
989 ::play_sound $pass ? "pass" : "move";
990}
991
992sub DESTROY {#d#
993 warn "DESTROY(@_)\n";#d#
827} 994}
828 995
8291; 9961;
830 997
831 998

Diff Legend

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