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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.24 by pcg, Fri May 30 11:59:28 2003 UTC vs.
Revision 1.25 by pcg, Fri May 30 15:50:20 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. ;) 20$HACK = 1; # do NEVER enable. ;)
21
22if ($HACK) {
23 $KGS::debug = 1;
24}
21 25
22our $config; 26our $config;
23our $LIBDIR = "."; 27our $LIBDIR = ".";
24our $IMGDIR = "$LIBDIR/images"; 28our $IMGDIR = "$LIBDIR/images";
25our $SNDDIR = "$LIBDIR/sounds"; 29our $SNDDIR = "$LIBDIR/sounds";
182} 186}
183 187
184if (0) { 188if (0) {
185 use KGS::Constants; 189 use KGS::Constants;
186 190
191 for (19) {
187 my $board = new game size => 5; 192 my $board = new game size => $_;
188 $board->{board} = new KGS::Game::Board; 193 $board->{board} = new KGS::Game::Board;
189 $board->{board}{board}[0][0] = MARK_B; 194 $board->{board}{board}[0][0] = MARK_B;
190 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W; 195 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
191 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE; 196 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
197 $board->{board}{board}[1][2] = MARK_B | MARK_LABEL;
198 $board->{board}{label}[1][2] = "198";
199 $board->{board}{board}[0][2] = MARK_W | MARK_LABEL;
200 $board->{board}{label}[0][2] = "AWA";
192 $board->{window}->show_all; 201 $board->{window}->show_all;
202 }
193} 203}
194 204
195main Gtk; 205main Gtk;
196 206
197############################################################################# 207#############################################################################
206 216
207 $self->{conn} = new KGS::Protocol; 217 $self->{conn} = new KGS::Protocol;
208 218
209 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :) 219 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
210 220
211 $self->listen($self->{conn}); 221 $self->listen($self->{conn}, "login");
212 222
213 $self->{roomlist} = new roomlist conn => $self->{conn}; 223 $self->{roomlist} = new roomlist conn => $self->{conn};
214 224
215 $self->{window} = new Gtk::Window 'toplevel'; 225 $self->{window} = new Gtk::Window 'toplevel';
216 $self->{window}->set_title('kgsueme'); 226 $self->{window}->set_title('kgsueme');
383 393
384sub new { 394sub new {
385 my $self = shift; 395 my $self = shift;
386 $self = $self->SUPER::new(@_); 396 $self = $self->SUPER::new(@_);
387 397
388 $self->listen($self->{conn}); 398 $self->listen($self->{conn}, qw(msg_room:));
389 399
390 $self->{window} = new Gtk::Window 'toplevel'; 400 $self->{window} = new Gtk::Window 'toplevel';
391 $self->{window}->set_title("KGS Room $self->{name}"); 401 $self->{window}->set_title("KGS Room $self->{name}");
392 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400]; 402 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
393 403
436 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30]; 446 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
437 447
438 $self; 448 $self;
439} 449}
440 450
451sub join {
452 my ($self) = @_;
453 $self->SUPER::join;
454
455 $self->{window}->show_all;
456}
457
458sub part {
459 my ($self) = @_;
460 $self->SUPER::part;
461
462 delete $::config->{rooms}{$self->{channel}};
463 $self->{window}->hide_all;
464 $self->event_update_users;
465 $self->event_update_games;
466}
467
468sub inject_msg_room {
469 my ($self, $msg) = @_;
470
471 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
472}
473
441sub event_update_users { 474sub event_update_users {
442 my ($self) = @_; 475 my ($self) = @_;
443 476
444 $self->{event_update} ||= Gtk->timeout_add(200, sub { 477 $self->{event_update} ||= Gtk->timeout_add(200, sub {
445 my $l = $self->{userlist}; 478 my $l = $self->{userlist};
484 delete $self->{event_update_games}; 517 delete $self->{event_update_games};
485 0; 518 0;
486 }); 519 });
487} 520}
488 521
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 { 522sub event_join {
507 my ($self) = @_; 523 my ($self) = @_;
508 $self->SUPER::event_join; 524 $self->SUPER::event_join;
509 525
510 $::config->{rooms}{$self->{channel}} = 1; 526 $::config->{rooms}{$self->{channel}} = 1;
512 528
513sub event_update_roominfo { 529sub event_update_roominfo {
514 my ($self) = @_; 530 my ($self) = @_;
515 531
516 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n"); 532 $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} 533}
525 534
526############################################################################# 535#############################################################################
527 536
528package game; 537package game;
538 $self = $self->SUPER::new(@_); 547 $self = $self->SUPER::new(@_);
539 548
540 $self->listen($self->{conn}); 549 $self->listen($self->{conn});
541 550
542 $self->{window} = new Gtk::Window 'toplevel'; 551 $self->{window} = new Gtk::Window 'toplevel';
543 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1) if $self->{channel};#d# 552 my $title = $self->{channel} ? $self->user0." ".$self->user1 : "Game Window";
553 $self->{window}->set_title("KGS Game $title");
544 ::state $self->{window}, "game::window", undef, window_size => [600, 500]; 554 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
545 555
546 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 }); 556 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
547 557
548 $self->{window}->add(my $hpane = new Gtk::HPaned); 558 $self->{window}->add(my $hpane = new Gtk::HPaned);
549 ::state $hpane, "game::hpane", undef, hpane_position => 500; 559 ::state $hpane, "game::hpane", undef, hpane_position => 500;
550 560
561 $hpane->pack1(my $vbox = new Gtk::VBox);
562
563 $vbox->pack_start((my $frame = new Gtk::Frame), 0, 1, 0);
564
565 {
566 $frame->add(my $vbox = new Gtk::VBox);
567 $vbox->add($self->{title} = new Gtk::Label $title);
568
569 $self->{moveadj} = new Gtk::Adjustment 0, 0, 0, 1, 10, 0;
570 $vbox->add(my $scale = new Gtk::HScale $self->{moveadj});
571 $scale->set_draw_value (1);
572 $scale->set_digits (0);
573 $scale->set_value_pos('top');
574
575 $self->{moveadj}->signal_connect (value_changed => sub {
576 $self->{board} = new KGS::Game::Board $self->{size};
577 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]);
578
579 $self->repaint_board;
580
581 # force a redraw (not perfect(?))
582 expose_event($self->{canvas}, $self, { area => [0, 0, @{$self->{canvas}->allocation}[2,3]] });
583
584 $self->{text}->backward_delete($self->{text}->get_length);
585 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
586 });
587 }
588
551 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual); 589 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
552 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap); 590 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
553 $hpane->pack1(($self->{canvas} = new Gtk::DrawingArea), 1, 1); 591 $vbox->pack_start(($self->{canvas} = new Gtk::DrawingArea), 1, 1, 0);
554 Gtk::Widget->pop_colormap; 592 Gtk::Widget->pop_colormap;
555 Gtk::Widget->pop_visual; 593 Gtk::Widget->pop_visual;
556 594
557 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); 595 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
558 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); 596 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
716} 754}
717 755
718sub pixbuf_text { 756sub pixbuf_text {
719 my ($pixbuf, $colour, $x, $y, $height, $text) = @_; 757 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
720 758
721 my $c = $::font[$colour][$::fontmap{substr $text, 0, 1}]; 759 my @c = grep $_,
760 map $::font[$colour][$::fontmap{$_}],
761 split //, $text;
722 762
723 if ($c) { 763 if (@c) {
724 my ($w, $h) = ($c->get_width, $c->get_height); 764 my $spacing = $height * 0.1;
725 my $s = ($height-1) / ($h-1); 765 my $s = $height / List::Util::max map $_->get_height, @c;
766 my $W = List::Util::sum map $_->get_width, @c;
726 767
727 $x -= $w * $s * 0.5; 768 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5;
728 $y -= $height * 0.5; 769 $y -= $height * 0.5;
729 770
771 for (@c) {
772 my $w = $_->get_width * $s;
730 $c->composite ($pixbuf, 773 $_->composite ($pixbuf,
731 $x, $y, $w*$s+0.5, $height+0.5, $x-0.5, $y-0.5, $s, $s, 774 $x, $y, $w+0.999, $height+0.999, $x, $y, $s, $s,
732 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 192); 775 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
733 776
734 } else { 777 $x += $w + $spacing;
735 warn "unable to render character '$text'"; 778 }
736 } 779 }
737} 780}
738 781
739my $black_pb; 782my $black_pb;
740 783
761 804
762 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s]; 805 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
763 806
764 my $size = $self->{size}; 807 my $size = $self->{size};
765 808
766 my $border = int ($s / $size); 809 my $border = int ($s / ($size + 3) * 0.5);
767 my $s2 = $s - $border * 2; 810 my $s2 = $s - $border * 2;
768 my $edge = int ($s2 / $size * 0.97); 811 my $edge = int ($s2 / ($size + 1) * 0.97);
769 my $ofs = int ($edge / 2); 812 my $ofs = int ($edge / 2);
770 813
771 my @k = map int ($s2 * $_ / $size - $ofs + $border + 0.5), 0 .. $size; 814 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
772 815
773 my $pixbuf; 816 my $pixbuf;
774 817
775 if ($self->{background}) { 818 if ($self->{background}) {
776 $pixbuf = $self->{background}->copy; 819 $pixbuf = $self->{background}->copy;
782 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0); 825 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
783 } else { 826 } else {
784 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES; 827 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES;
785 } 828 }
786 829
787 my $linew = int ($s / 500); 830 my $linew = int ($s / 25 / $size);
788 831
789 my $a = "A";
790 for my $i (1 .. $size) { 832 for my $i (1 .. $size) {
791 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew; 833 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
792 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew; 834 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;
793 835
836 # 38 max, but we allow a bit more
837 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
838 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];
839
794 pixbuf_text $pixbuf, 0, $k[$i], ($ofs +$border) / 2, $ofs, $a; 840 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
795 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border + $ofs / 2, $ofs, $a; 841 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
796 pixbuf_text $pixbuf, 0, ($ofs + $border) / 2, $k[$i], $ofs, $size - $i + 1; 842 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
797 pixbuf_text $pixbuf, 0, $s2 + $border + $ofs / 2, $k[$i], $ofs, $size - $i + 1; 843 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
798 844
799 $a++; 845 $a++;
800 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK... 846 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
801 } 847 }
802 848
819 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs); 865 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
820 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 ); 866 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 );
821 867
822 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height, 868 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height,
823 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255); 869 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
870
871 # labels are handled here because they are quite rare
872 if ($mark & MARK_LABEL) {
873 pixbuf_text $pixbuf, $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1,
874 $k[$x], $k[$y], $ofs * 0.7,
875 $self->{board}{label}[$x-1][$y-1];
876 }
824 877
825 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 ); 878 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
826 879
827 #$gc->set_clip_mask ($bm); 880 #$gc->set_clip_mask ($bm);
828 #$gc->set_clip_origin ($dx, $dy); 881 #$gc->set_clip_origin ($dx, $dy);
858} 911}
859 912
860sub event_update_tree { 913sub event_update_tree {
861 my ($self) = @_; 914 my ($self) = @_;
862 915
863 $self->{board} = new KGS::Game::Board $self->{size}; 916 $self->{path} = $self->get_path;
864 $self->{board}->interpret_path ($self->get_path); 917
918 my $move = @{$self->{path}};
865 919
866 $self->repaint_board; 920 $self->{moveadj}->upper($move);
867 921
868 # force a redraw (not perfect(?)) 922 if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
869 expose_event $self->{canvas}, $self, { area => $self->{canvas}->allocation }; 923 $self->{moveadj}->set_value ($move);
870 924 }
871 $self->{text}->backward_delete($self->{text}->get_length);
872 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
873} 925}
874 926
875sub event_move { 927sub event_move {
876 ::play_sound "move"; 928 ::play_sound "move";
877} 929}

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines