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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.11 by pcg, Thu May 29 12:19:10 2003 UTC vs.
Revision 1.16 by pcg, Fri May 30 07:19:16 2003 UTC

1#!/usr/bin/perl -I../lib/ 1#!/usr/bin/perl -I../lib/
2
3#use PApp::Util qw(dumpval); # debug only
4 2
5use Gtk; 3use Gtk;
6use Gtk::Gdk; 4use Gtk::Gdk;
7#use Gtk::Gdk::Pixbuf; 5use Gtk::Gdk::Pixbuf;
8use Gtk::Gdk::ImlibImage; 6#use Gtk::Gdk::ImlibImage;
9
10use Gnome;
11 7
12use KGS::Protocol; 8use KGS::Protocol;
13use KGS::Listener::Debug; 9use KGS::Listener::Debug;
14 10
11use Audio::Data;
12use Audio::Play;
13
15use IO::Socket::INET; 14use IO::Socket::INET;
16 15
17use Errno; 16use Errno;
18 17
19init Gnome "kgsueme"; 18init Gtk;
20 19
21$HACK = 1; # do NEVER enable. ;) 20$HACK = 1; # do NEVER enable. ;)
22 21
23our $config; 22our $config;
23our $LIBDIR = ".";
24our $IMGDIR = "images"; 24our $IMGDIR = "$LIBDIR/images";
25our $SNDDIR = "$LIBDIR/sounds";
25 26
26sub load_img { 27sub load_img {
27# new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]" 28 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
28 load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]" 29# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
29 or die "$IMGDIR/$_[0]: $!"; 30 or die "$IMGDIR/$_[0]: $!";
30} 31}
31 32
32our @black_img = load_img "b-01.png"; 33our @black_img = load_img "b-01.png";
33our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5; 34our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5;
35our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w);
36our @square_img = map +(load_img "square-$_.png"), qw(b w);
37our @circle_img = map +(load_img "circle-$_.png"), qw(b w);
34our $board_img = load_img "woodgrain-01.jpg"; 38our $board_img = load_img "woodgrain-01.jpg";
39
40{
41 #my $audioserver = new Audio::Play(0);
42 my %sound;
43 $SIG{CHLD} = 'IGNORE';
44
45 for (qw(alarm warning move)) {
46 local $/;
47 open my $snd, "<", "$SNDDIR/$_"
48 or die "$SNDDIR: $!";
49 binmode $snd;
50
51 $sound{$_} = new Audio::Data;
52 $sound{$_}->Load($snd);
53 }
54
55 sub play_sound {
56 if (fork == 0) {
57 my $audioserver = new Audio::Play(1);
58 $audioserver->play ($sound{$_[0]});
59 Gtk->_exit(0);
60 }
61 }
62}
35 63
36{ 64{
37 use Storable (); 65 use Storable ();
38 use Scalar::Util (); 66 use Scalar::Util ();
39 67
… …
47 # grr... more gtk+ brokenness 75 # grr... more gtk+ brokenness
48 my %get = ( 76 my %get = (
49 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] }, 77 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
50 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] }, 78 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
51 window_size => sub { [ @{$_[0]->allocation}[2,3] ] }, 79 window_size => sub { [ @{$_[0]->allocation}[2,3] ] },
52 #window_pos => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] }, 80 #window_pos => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
53 clist_column_widths => sub { 81 clist_column_widths => sub {
54 $_[0]{column_widths}; 82 $_[0]{column_widths};
55 }, 83 },
56 ); 84 );
57 85
… …
137 $main->{status}->pop($context_id{$type}) if $context_id{$type}; 165 $main->{status}->pop($context_id{$type}) if $context_id{$type};
138 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text; 166 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
139 } 167 }
140} 168}
141 169
170if (0) {
171 my $board = new game size => 5;
172 $board->{window}->show_all;
173}
174
142main Gtk; 175main Gtk;
143 176
144############################################################################# 177#############################################################################
145 178
146package kgsueme; 179package kgsueme;
… …
240 if ($msg->{success}) { 273 if ($msg->{success}) {
241 for (keys %{$::config->{rooms}}) { 274 for (keys %{$::config->{rooms}}) {
242 $self->{roomlist}->join_room($_); 275 $self->{roomlist}->join_room($_);
243 } 276 }
244 } 277 }
245
246 warn PApp::Util::dumpval($::config);
247} 278}
248 279
249sub event_disconnect { } 280sub event_disconnect { }
250 281
251############################################################################# 282#############################################################################
… …
446 my ($self) = @_; 477 my ($self) = @_;
447 $self->SUPER::part; 478 $self->SUPER::part;
448 479
449 delete $::config->{rooms}{$self->{channel}}; 480 delete $::config->{rooms}{$self->{channel}};
450 $self->{window}->hide_all; 481 $self->{window}->hide_all;
451 $self->event_update; 482 $self->event_update_users;
452 $self->event_update_games; 483 $self->event_update_games;
453} 484}
454 485
455sub event_join { 486sub event_join {
456 my ($self) = @_; 487 my ($self) = @_;
… …
487 $self = $self->SUPER::new(@_); 518 $self = $self->SUPER::new(@_);
488 519
489 $self->listen($self->{conn}); 520 $self->listen($self->{conn});
490 521
491 $self->{window} = new Gtk::Window 'toplevel'; 522 $self->{window} = new Gtk::Window 'toplevel';
492 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1); 523 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1) if $self->{channel};#d#
493 ::state $self->{window}, "game::window", undef, window_size => [600, 500]; 524 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
494 525
495 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 }); 526 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
496 527
497 $self->{window}->add(my $hpane = new Gtk::HPaned); 528 $self->{window}->add(my $hpane = new Gtk::HPaned);
498 ::state $hpane, "game::hpane", undef, hpane_position => 500; 529 ::state $hpane, "game::hpane", undef, hpane_position => 500;
499 530
500 $::config{aa} = 0; 531 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
501 $self->{canvas} = $::config{aa} ? new_aa Gnome::Canvas : new Gnome::Canvas; 532 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
502 $hpane->pack1($self->{canvas}, 1, 1); 533 $hpane->pack1(($self->{canvas} = new Gtk::DrawingArea), 1, 1);
534 Gtk::Widget->pop_colormap;
535 Gtk::Widget->pop_visual;
503 536
504 { 537 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
505 my $line_colour = $::config{line_colour} || "darkbrown"; 538 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
506 my $border = 0.1;
507 my $ofs = 0.5 / $self->{size};
508
509 $self->{canvas}->set_pixels_per_unit(1000);
510 $self->{canvas}->set_scroll_region(-$border,-$border,1+$border,1+$border);
511
512 $self->{canvas}->signal_connect(size_allocate => sub {
513 my ($w, $h) = @{$_[1]}[2,3];
514
515 $self->{canvas}->set_pixels_per_unit(($w > $h ? $h : $w)/(1+$border*2));
516
517 1;
518 });
519
520 my $croot = $self->{canvas}->root;
521 my $cgroup = $croot; #->new($croot, "Gnome::CanvasGroup");
522
523 if ($::board_img) {
524 $cgroup->new($cgroup, "Gnome::CanvasImage",
525 x => -$border, y => -$border,
526 width => 1+$border*2, height => 1+$border*2,
527 image => $::board_img,
528 anchor => "nw"
529 );
530 } else {
531 $cgroup->new($cgroup, "Gnome::CanvasRect",
532 x1 => -$border, x2 => 1+$border,
533 y1 => -$border, y2 => 1+$border,
534 outline_color => "black",
535 fill_color => "brown",
536 width_pixels => 2,
537 );
538 }
539
540 my $a = "A";
541 for my $i (1 .. $self->{size}) { # one more iteration for the last lines
542 my $k = $i / $self->{size} - $ofs;
543
544 $cgroup->new($cgroup, "Gnome::CanvasLine",
545 points => [ $k,$ofs, $k,1-$ofs ],
546 fill_color => $line_colour,
547 width_pixels => 1);
548
549 $cgroup->new($cgroup, "Gnome::CanvasLine",
550 points => [ $ofs,$k, 1-$ofs,$k ],
551 fill_color => $line_colour,
552 width_pixels => 1);
553
554 for ( [$k,-$border*0.5,$a], [$k,1+$border*0.5,$a],
555 [-$border*0.5,$k,$self->{size} - $i + 1], [1+$border*0.5,$k,$self->{size} - $i + 1] ) {
556 my ($x, $y, $text) = @$_;
557
558 my $text = $cgroup->new($cgroup, "Gnome::CanvasText",
559 x => 0, y => 0, text => $text,
560 justification => "center",
561 anchor => "center",
562 font => $::config{aa} ? "-*-helvetica-medium-r-*--34-*" : "-*-helvetica-bold-r-*--17-*",
563 fill_color => $line_colour);
564
565 $text->affine_relative($border*0.015,0, 0,$border*0.015, $x,$y);
566 }
567
568 $a++;
569 $a++ if $a eq "I";
570 }
571
572 my $stones = [[]];
573
574 for my $x (1 .. $self->{size}) {
575 my $xk = $x / $self->{size} - $ofs;
576 for my $y (1 .. $self->{size}) {
577 my $yk = $y / $self->{size} - $ofs;
578
579 my $col = $stones->[$x-1][$y-1] = [];
580
581 if (1) {
582 $col->[0] =
583 $cgroup->new($cgroup, "Gnome::CanvasImage",
584 x => $xk, y => $yk,
585 width => $ofs*2, height => $ofs*2,
586 image => $::black_img[int rand @::black_img],
587 anchor => "center");
588 $col->[1] =
589 $cgroup->new($cgroup, "Gnome::CanvasImage",
590 x => $xk, y => $yk,
591 width => $ofs*2, height => $ofs*2,
592 image => $::white_img[int rand @::white_img],
593 anchor => "center");
594 } else {
595 die "need pixmaps\n";
596 # too large, scale has NO effect
597 $col->[0] =
598 $cgroup->new($cgroup, "Gnome::CanvasEllipse",
599 x1 => $xk, x2 => $xk + 0.001,
600 y1 => $yk, y2 => $yk + 0.001,
601 outline_color => "black", width_pixels => 2,
602 fill_color => "black");
603 $col->[1] =
604 $cgroup->new($cgroup, "Gnome::CanvasEllipse",
605 x1 => $xk, x2 => $xk + 0.001,
606 y1 => $yk, y2 => $yk + 0.001,
607 outline_color => "black", width_pixels => 2,
608 fill_color => "white");
609 }
610 }
611 }
612
613 $self->{board_gfx}{stones} = $stones;
614 }
615 539
616 $hpane->pack2((my $vpane = new Gtk::VPaned), 0, 0); 540 $hpane->pack2((my $vpane = new Gtk::VPaned), 0, 0);
617 ::state $vpane, "game", $self->{name}, vpane_position => 80; 541 ::state $vpane, "game", $self->{name}, vpane_position => 80;
618 542
619 $vpane->add(my $sw = new Gtk::ScrolledWindow); 543 $vpane->add(my $sw = new Gtk::ScrolledWindow);
… …
658 $self->SUPER::part; 582 $self->SUPER::part;
659 583
660 $self->{window}->hide; 584 $self->{window}->hide;
661} 585}
662 586
587sub configure_event {
588 my ($widget, $self, $event) = @_;
589 delete $self->{stack};
590 $self->repaint_board;
591 1;
592}
593
594sub expose_event {
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 }
623sub INTERP_BILINEAR (){ 2 }
624sub INTERP_HYPER (){ 3 }
625
626sub new_pixbuf {
627 my ($w, $h, $clear) = @_;
628
629 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', 1, 8, $w, $h;
630
631 if ($clear) { # damn, need to clear it ourselves
632 my $row = "\x00\x00\x00\x00" x $w;
633 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1;
634 }
635
636 $pixbuf;
637}
638
639sub scale_pixbuf {
640 my ($src, $w, $h, $mode) = @_;
641
642 my $dst = new_pixbuf $w, $h;
643
644 $src->scale(
645 $dst, 0, 0, $w, $h, 0, 0,
646 $w / $src->get_width, $h / $src->get_height,
647 $mode,
648 );
649
650 $dst;
651}
652
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
677sub create_stack {
678 my ($self, $gc, $mark, $size, $rand) = @_;
679
680 my $c = \$self->{stack}{$mark};
681 unless ($$c) {
682 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
683 my $base =
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
688 if ($mark & (MARK_GRAY_B | MARK_GRAY_W)) {
689 # make transparent by stippling :(
690 # fix this to use compositing if/when we have full compositing support
691 # in kgsueme
692 my @row = (
693 "\xff\xff\xff\xff\x00\x00\x00\x00" x ($size / 2 + 1),
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 }
699
700 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]],
701 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) {
702 my ($mask, $img) = @$_;
703 if ($mark & $mask) {
704 $img->composite (
705 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4) x 2,
706 $size / $img->get_width / 2, $size / $img->get_height / 2,
707 INTERP_HYPER, 192
708 );
709 }
710 }
711
712 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
713
714 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
715 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
716 [MARK_SQUARE, $::square_img[$dark_bg]]) {
717 my ($mask, $img) = @$_;
718 if ($mark & $mask) {
719 $img->composite (
720 $base, 0, 0, $size, $size, 0, 0,
721 ($size - 1) / ($img->get_width - 1), ($size - 1) / ($img->get_height - 1),
722 INTERP_HYPER, 255
723 );
724 }
725 }
726
727 push @$$c, [$base->render_pixmap_and_mask (128)];
728 }
729 }
730
731 @{$$c->[$rand % @$$c]};
732}
733
734sub repaint_board {
735 my ($self) = @_;
736 my $canvas = $self->{canvas};
737
738 return unless $self->{board};
739
740 %cache = ();
741
742 my ($w, $h) = @{$canvas->allocation}[2,3];
743
744 my $s = $w > $h ? $h : $w;
745
746 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
747
748 my $pixmap = $self->{pixmap} = new Gtk::Gdk::Pixmap $self->{canvas}->window, $s, $s;
749
750 {
751 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
752
753 my $bg = $s < $bw && $s < $bh ? $::board_img : scale_pixbuf $::board_img, $s, $s, INTERP_TILES;
754 $bg->render_to_drawable(
755 $pixmap, $self->{canvas}->style->white_gc,
756 0, 0, 0, 0, $s, $s,
757 0, 0, 0
758 );
759 }
760
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);
768 my $s2 = $s - $border * 2;
769 my $edge = int ($s2 / $size) | 1;
770 my $ofs = int ($edge / 2);
771
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) {
778 $pixmap->draw_line ($gc, $k[$i], $k[1], $k[$i], $k[$size]);
779 $pixmap->draw_line ($gc, $k[1], $k[$i], $k[$size], $k[$i]);
780
781 center_text $pixmap, $font, $gc, $k[$i], ($ofs +$border) / 2, $a;
782 center_text $pixmap, $font, $gc, $k[$i], $s2 + $border + $ofs / 2, $a;
783 center_text $pixmap, $font, $gc, ($ofs + $border) / 2, $k[$i], $size - $i + 1;
784 center_text $pixmap, $font, $gc, $s2 + $border + $ofs / 2, $k[$i], $size - $i + 1;
785
786 $a++;
787 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
788 }
789
790 # hoshi-points(!)#d#
791 # caching of empty board gfx(!)#d#
792
793 for my $x (1 .. $size) {
794 for my $y (1 .. $size) {
795 my $yk = $s2 * $x / $size - $ofs + $border;
796 my $mark = $self->{board}{board}[$x-1][$y-1];
797
798 if ($mark) {
799 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
800 my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
801
802 $gc->set_clip_mask ($bm);
803 $gc->set_clip_origin ($dx, $dy);
804 $pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
805 }
806 }
807 }
808}
809
663sub event_update_tree { 810sub event_update_tree {
664 my ($self) = @_; 811 my ($self) = @_;
665 812
666 my $board = new KGS::Game::Board $self->{size}; 813 $self->{board} = new KGS::Game::Board $self->{size};
667 $board->interpret_path ($self->get_path); 814 $self->{board}->interpret_path ($self->get_path);
668 815
669 for my $x (0 .. $self->{size} - 1) { 816 $self->repaint_board;
670 for my $y (0 .. $self->{size} - 1) {
671 my $v = $board->{board}[$x][$y];
672 817
673 $v & MARK_B 818 # force a redraw (not perfect(?))
674 ? $self->{board_gfx}->{stones}->[$x][$y][0]->show 819 expose_event $self->{canvas}, $self, { area => $self->{canvas}->allocation };
675 : $self->{board_gfx}->{stones}->[$x][$y][0]->hide;
676 $v & MARK_W
677 ? $self->{board_gfx}->{stones}->[$x][$y][1]->show
678 : $self->{board_gfx}->{stones}->[$x][$y][1]->hide;
679 }
680 }
681 820
682 $self->{text}->backward_delete($self->{text}->get_length); 821 $self->{text}->backward_delete($self->{text}->get_length);
683 $self->{text}->insert(undef, undef, undef, $board->{comment}.PApp::Util::dumpval([$board->{time},$board->{captures}])); 822 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
823}
824
825sub event_move {
826 ::play_sound "move";
684} 827}
685 828
6861; 8291;
687 830
688 831

Diff Legend

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