[ViewVC] Annotation of: cvs/kgsueme/bin/kgsueme

#!/usr/bin/perl

use Gtk;
use Gtk::Gdk;
use Gtk::Gdk::Pixbuf;
#use Gtk::Gdk::ImlibImage;

use KGS::Protocol;
use KGS::Listener::Debug;

use Audio::Data;
use Audio::Play;

use IO::Socket::INET;
use List::Util;
use Errno;

init Gtk;

$HACK = 1; # do NEVER enable. ;)

if ($HACK) {
   $KGS::debug = 1;
}

our $config;
our $LIBDIR = ".";
our $IMGDIR = "$LIBDIR/images";
our $SNDDIR = "$LIBDIR/sounds";

sub load_img {
   new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
#   load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
      or die "$IMGDIR/$_[0]: $!";
}

my @fontchars = ('A' .. 'Z', 0 .. 9);

our @black_img    =       load_img "b-01.png";
our @white_img    = map +(load_img "w-0$_.png"), 1,2,3,4,5;
our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w);
our @square_img   = map +(load_img "square-$_.png"), qw(b w);
our @circle_img   = map +(load_img "circle-$_.png"), qw(b w);
our $board_img    =       load_img "woodgrain-01.jpg";

our @font = (
              [map +(load_img "font/$_-black.png"), @fontchars],
              [map +(load_img "font/$_-white.png"), @fontchars],
            );
our %fontmap;
@fontmap{@fontchars} = (0..25 + 10);
@fontmap{'a' .. 'z'} = (0..25);

{
   #my $audioserver = new Audio::Play(0);
   my %sound;
   $SIG{CHLD} = 'IGNORE';

   for (qw(alarm warning move)) {
      local $/;
      open my $snd, "<", "$SNDDIR/$_"
         or die "$SNDDIR: $!";
      binmode $snd;

      $sound{$_} = new Audio::Data;
      $sound{$_}->Load($snd);
   }

   sub play_sound {
      if (fork == 0) {
         if (my $audioserver = new Audio::Play(1)) {
            $audioserver->play ($sound{$_[0]});
         }
         Gtk->_exit(0);
      }
   }
}

{
   use Storable ();
   use Scalar::Util ();

   my $staterc = "$ENV{HOME}/.kgsueme";

   my $state = -r $staterc ? Storable::retrieve($staterc) : {};
   my @widgets;

   $config = $state->{config} ||= {};

   $config{speed} = 1;#d# optimize for speed or memory?
   $config{conserve_memory} = 0;

   # grr... more gtk+ brokenness
   my %get = (
      hpane_position  => sub { ($_[0]->children)[0]->allocation->[2] },
      vpane_position  => sub { ($_[0]->children)[0]->allocation->[3] },
      window_size     => sub { [ @{$_[0]->allocation}[2,3] ] },
      #window_pos     => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
      clist_column_widths => sub {
         $_[0]{column_widths};
      },
   );

   my %set = (
      hpane_position => sub { $_[0]->set_position($_[1]) },
      vpane_position => sub { $_[0]->set_position($_[1]) },
      window_size    => sub { $_[0]->set_default_size(@{$_[1]}) },
      #window_pos     => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
      clist_column_widths => sub {
         my ($w, $v) = @_;
         $v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
         $w->{column_widths} = $v;
         $w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
      },
   );

   sub state {
      my ($widget, $class, $instance, %attr) = @_;

      while (my ($k, $v) = each %attr) {
         my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
         $v = $state->{$class}{"*"}{$get}       if exists $state->{$class}{"*"}{$get};
         $v = $state->{$class}{$instance}{$get} if exists $state->{$class}{$instance}{$get};
         $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
      }

      $widget = [$widget, $class, $instance, \%attr];
      Scalar::Util::weaken $widget->[0];

      @widgets = (grep $_->[0], @widgets, $widget);
   }

   sub save_state {
      for (@widgets) {
         if ($_->[0]) {
            my ($widget, $class, $instance, $attr) = @$_;

            $widget->realize;

            while (my ($k, $v) = each %$attr) {
               my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
               $v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);

               $state->{$class}{"*"}{$get}       = $v;
               $state->{$class}{$instance}{$get} = $v;
            }
         }
         ::status("save_state", "layout saved");
      }

      Storable::nstore($state, $staterc);
   }
}

# make a clist unselectable
sub clist_autosort {
   my $w = shift;
   my ($c, $o) = (-1);
   for (0..$w->columns-1) {
      $w->signal_connect(click_column => sub {
         if ($_[1] != $c) {
            $c = $_[1];
            $o = 0;
         } else {
            $o = !$o;
         }
         $w->set_sort_column($c);
         $w->set_sort_type($o ? "descending" : "ascending");
         $w->sort;
      });
   }
   
}

{
   my $main = new kgsueme;

   my %context_id;

   sub status {
      my ($type, $text) = @_;

      $main->{status}->pop($context_id{$type}) if $context_id{$type};
      $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
   }
}

if (0) {
   use KGS::Constants;

   for (19) {
      my $board = new game size => $_;
      $board->{board} = new KGS::Game::Board;
      $board->{board}{board}[0][0] = MARK_B;
      $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
      $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
      $board->{board}{board}[1][2] = MARK_B | MARK_LABEL;
      $board->{board}{label}[1][2] = "198";
      $board->{board}{board}[0][2] = MARK_W | MARK_LABEL;
      $board->{board}{label}[0][2] = "AWA";
      $board->{window}->show_all;
   }
}

main Gtk;

#############################################################################

package kgsueme;

use base KGS::Listener;

sub new {
   my $self = shift;
   $self = $self->SUPER::new(@_);

   $self->{conn} = new KGS::Protocol;

   KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)

   $self->listen($self->{conn}, "login");

   $self->{roomlist} = new roomlist conn => $self->{conn};

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title('kgsueme');
   ::state $self->{window}, "main::window", undef, window_size => [400, 100];
   $self->{window}->signal_connect(delete_event => sub { main_quit Gtk; 1 });

   $self->{window}->add(my $vbox = new Gtk::VBox);

   $vbox->pack_start(($buttonbox = new Gtk::HButtonBox), 0, 1, 0);
   $buttonbox->set_spacing(0);

   my $button = sub {
      $buttonbox->add(my $button = new Gtk::Button $_[0]);
      signal_connect $button clicked => $_[1];
   };

   $button->("Login", sub { $self->login; });
   $button->("Roomlist", sub { $self->{roomlist}->show; });
   $button->("Save Config & Layout", sub { ::save_state });
   $button->("Quit", sub { main_quit Gtk });

   $vbox->pack_start((my $hbox = new Gtk::HBox), 0, 1, 0);

   $hbox->add(new Gtk::Label "Login");

   $hbox->add($self->{login} = new_with_max_length Gtk::Entry 12);
   $self->{login}->set_text($::config->{login});

   if ($::HACK) {
      $self->{login}->signal_connect(activate => sub {
         $self->{conn}{name} = $self->{login}->get_text;
      });
   }

   $hbox->add(new Gtk::Label "Password");
   $hbox->add($self->{password} = new Gtk::Entry);
   $self->{password}->set_visibility(0);

   $vbox->pack_start(($self->{status} = new Gtk::Statusbar), 0, 1, 0);

   $self->{window}->show_all;

   $self;
}

sub login {
   my ($self) = @_;

   $self->{conn}->disconnect;

   # initialize new socket and connection
   my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
      or die;

   $sock->blocking(1);
   $self->{conn}->handshake($sock);
   $sock->blocking(0);

   my $input; $input = input_add Gtk::Gdk fileno $sock, "read", sub {
      # this is dorked
      my $buf;
      if (0 >= sysread $sock, $buf, 16384
          and !$!{EINTR} and !$!{EAGAIN}) {
         input_remove Gtk::Gdk $input;
         $self->event_disconnect;
      }
      $self->{conn}->feed_data($buf);
   };

   # now login
   $self->{conn}->login($self->{login}->get_text, $self->{password}->get_text);
}

sub inject_login {
   my ($self, $msg) = @_;

   ::status("login", "logged in as '$self->{conn}{name}' with status '$msg->{result}'");
   $::config->{login} = $self->{conn}{name};

   if ($msg->{success}) {
      for (keys %{$::config->{rooms}}) {
         $self->{roomlist}->join_room($_);
      }
   }
}

sub event_disconnect { }

#############################################################################

package roomlist;

use base KGS::Listener::Roomlist;

sub new {
   my $self = shift;
   $self = $self->SUPER::new(@_);

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title('KGS Rooms');
   ::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];

   $self->{window}->signal_connect(delete_event => sub { $self->{window}->hide; 1 });

   $self->{window}->add(my $vbox = new Gtk::VBox);

   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
   $self->{roomlist}->set_selection_mode('multiple');
   ::clist_autosort $self->{roomlist};
   ::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];

   $self->{roomlist}->signal_connect(select_row => sub {
      my $room = $self->{roomlist}->get_row_data($_[1])
         or return;
      $self->{roomlist}->unselect_all;
      $self->join_room($room->{channel});
   });

   $self;
}

sub join_room {
   my ($self, $channel) = @_;

   $self->{room}{$channel} ||= room->new(channel => $channel, conn => $self->{conn}, users => {});
   $self->{room}{$channel}->join;
}

sub show {
   my ($self, $msg) = @_;

   $self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
   $self->{window}->show_all;
}

sub event_update_rooms {
   my ($self) = @_;

   $self->{event_update} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{roomlist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{rooms}}) {
         $l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

      delete $self->{event_update};
      0;
   });
}

#############################################################################

package room;

use base KGS::Listener::Room;

sub new {
   my $self = shift;
   $self = $self->SUPER::new(@_);

   $self->listen($self->{conn}, qw(msg_room:));

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title("KGS Room $self->{name}");
   ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];

   $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });

   $self->{window}->add(my $hpane = new Gtk::HPaned);
   ::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;

   $hpane->add(my $vpane = new Gtk::VPaned);
   ::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;

   $vpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
   ::clist_autosort $self->{gamelist};
   ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];

   $self->{gamelist}->signal_connect(select_row => sub {
      my $game = $self->{gamelist}->get_row_data($_[1])
         or return;
      $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn};
      $self->{game}{$game->{channel}}->join;
      $self->{gamelist}->unselect_all;
   });

   $vpane->add(my $vbox = new Gtk::VBox);
   
   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{text} = new Gtk::Text);

   $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
   $self->{entry}->signal_connect(activate => sub {
      my $text = $self->{entry}->get_text;
      $self->say($text) if $text =~ /\S/;
      $self->{entry}->set_text("");
   });

   $hpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
   ::clist_autosort $self->{userlist};
   ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];

   $self;
}

sub join {
   my ($self) = @_;
   $self->SUPER::join;

   $self->{window}->show_all;
}

sub part {
   my ($self) = @_;
   $self->SUPER::part;

   delete $::config->{rooms}{$self->{channel}};
   $self->{window}->hide_all;
   $self->event_update_users;
   $self->event_update_games;
}

sub inject_msg_room {
   my ($self, $msg) = @_;

   $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
}

sub event_update_users {
   my ($self) = @_;

   $self->{event_update} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{userlist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{users}}) {
         $l->append($_->{name});
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

      delete $self->{event_update};
      0;
   });
}

sub event_update_games {
   my ($self) = @_;

   $self->{event_update_games} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{gamelist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{games}}) {
         $l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

      delete $self->{event_update_games};
      0;
   });
}

sub event_join {
   my ($self) = @_;
   $self->SUPER::event_join;

   $::config->{rooms}{$self->{channel}} = 1;
}

sub event_update_roominfo {
   my ($self) = @_;

   $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
}

#############################################################################

package game;

use KGS::Constants;
use KGS::Game::Board;

use base KGS::Listener::Game;
use base KGS::Game;

sub new {
   my $self = shift;
   $self = $self->SUPER::new(@_);

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   my $title = $self->{channel} ? $self->user0." ".$self->user1 : "Game Window";
   $self->{window}->set_title("KGS Game $title");
   ::state $self->{window}, "game::window", undef, window_size => [600, 500];

   $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });

   $self->{window}->add(my $hpane = new Gtk::HPaned);
   ::state $hpane, "game::hpane", undef, hpane_position => 500;

   $hpane->pack1(my $vbox = new Gtk::VBox);

   $vbox->pack_start((my $frame = new Gtk::Frame), 0, 1, 0);

   {
      $frame->add(my $vbox = new Gtk::VBox);
      $vbox->add($self->{title} = new Gtk::Label $title);

      $self->{moveadj} = new Gtk::Adjustment 0, 0, 0, 1, 10, 0;
      $vbox->add(my $scale = new Gtk::HScale $self->{moveadj});
      $scale->set_draw_value (1);
      $scale->set_digits (0);
      $scale->set_value_pos('top');

      $self->{moveadj}->signal_connect (value_changed => sub {
         $self->{board} = new KGS::Game::Board $self->{size};
         $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]);

         $self->repaint_board;

         # force a redraw (not perfect(?))
         expose_event($self->{canvas}, $self, { area => [0, 0, @{$self->{canvas}->allocation}[2,3]] });

         $self->{text}->backward_delete($self->{text}->get_length);
         $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
      });
   }
   
   Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
   Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
   $vbox->pack_start(($self->{canvas} = new Gtk::DrawingArea), 1, 1, 0);
   Gtk::Widget->pop_colormap;
   Gtk::Widget->pop_visual;

   $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
   $self->{canvas}->signal_connect(expose_event    => \&expose_event,    $self);

   $hpane->pack2((my $vpane = new Gtk::VPaned), 0, 0);
   ::state $vpane, "game", $self->{name}, vpane_position => 80;

   $vpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
   ::clist_autosort $self->{userlist};
   ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];

   $vpane->add(my $vbox = new Gtk::VBox);
   
   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{text} = new Gtk::Text);

   $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
   $self->{entry}->signal_connect(activate => sub {
      my $text = $self->{entry}->get_text;
      # add message
      $self->{entry}->set_text("");
   });

   $self;
}

sub event_update_users {
   my ($self) = @_;

   room::event_update_users $self;
}

sub join {
   my ($self) = @_;
   $self->SUPER::join;

   $self->{window}->show_all;
}

sub part {
   my ($self) = @_;
   $self->SUPER::part;

   $self->{window}->hide;
}

sub configure_event {
   my ($widget, $self, $event) = @_;
   delete $self->{stack};
   delete $self->{background};
   $self->repaint_board;
   1;
}

sub INTERP_NEAREST  (){ 1 }
sub INTERP_TILES    (){ 1 }
sub INTERP_BILINEAR (){ 2 }
sub INTERP_HYPER    (){ 3 }

sub new_pixbuf {
   my ($w, $h, $alpha, $clear) = @_;

   my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;

   if ($clear) { # damn, need to clear it ourselves
      my $row = "\x00\x00\x00\x00" x $w;
      $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1;
   }

   $pixbuf;
}

sub scale_pixbuf {
   my ($src, $w, $h, $mode) = @_;

   my $dst = new_pixbuf $w, $h, 1;

   $src->scale(
      $dst, 0, 0, $w, $h, 0, 0,
      $w / $src->get_width, $h / $src->get_height,
      $mode,
   );

   $dst;
}

# create a stack of stones
sub create_stack {
   my ($self, $mark, $size, $rand) = @_;

   my $shadow = $size * 0.06;

   my $c = \$self->{stack}{$mark};
   unless ($$c) {
      for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
         my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1;

         # zeroeth the shadow
         if ($mark & (MARK_B | MARK_W)) {
            $::black_img[0]->composite (
               $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
               $size / $stone->get_width, $size / $stone->get_height,
               $::config{speed} ? INTERP_NEAREST : INTERP_TILES, 128
            );
         }

         # first the big stones
         for ([MARK_B,      255],
              [MARK_W,      255],
              [MARK_GRAY_B, 128],
              [MARK_GRAY_W, 128]) {
            my ($mask, $alpha) = @$_;
            if ($mark & $mask) {
               $stone->composite (
                  $base, 0, 0, $size, $size, -0.5, -0.5,
                  $size / $stone->get_width, $size / $stone->get_height,
                  $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, $alpha
               );
            }
         }

         # then the samll stones
         for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]],
              [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) {
            my ($mask, $img) = @$_;
            if ($mark & $mask) {
               $img->composite (
                  $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2,
                  $size / $img->get_width / 2, $size / $img->get_height / 2,
                  $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 192
               );
            }
         }

         # and lastly any markers (labels NYI)
         my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));

         for ([MARK_CIRCLE,   $::circle_img[$dark_bg]],
              [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
              [MARK_SQUARE,   $::square_img[$dark_bg]]) {
           my ($mask, $img) = @$_;
           if ($mark & $mask) {
              $img->composite (
                 $base, 0, 0, $size, $size, -0.5, -0.5,
                 $size / $img->get_width, $size / $img->get_height,
                 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 255
              );
           }
         }

         push @$$c, $base;
      }
   }

   $$c->[$rand % @$$c];
}

sub pixbuf_text {
   my ($pixbuf, $colour, $x, $y, $height, $text) = @_;

   my @c = grep $_,
              map $::font[$colour][$::fontmap{$_}],
                 split //, $text;

   if (@c) {
      my $spacing = $height * 0.1;
      my $s = $height / List::Util::max map $_->get_height, @c;
      my $W = List::Util::sum map $_->get_width, @c;

      $x -= ($W * $s + $spacing * (@c - 1)) * 0.5;
      $y -= $height * 0.5;

      for (@c) {
         my $w = $_->get_width * $s;
         $_->composite ($pixbuf,
               $x, $y, $w+0.999, $height+0.999, $x, $y, $s, $s,
               $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);

         $x += $w + $spacing;
      }
   }
}

my $black_pb;

sub pixbuf_rect {
   my ($pb, $x1, $y1, $x2, $y2) = @_;
   # we fake lines by... an unspeakable method :/
   unless ($black_pb) {
      $black_pb = new_pixbuf 1, 1, 0, 0;
      $black_pb->put_pixels ("\x44\x11\x11", 0, 0);
   }

   $black_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, 1, 1, INTERP_NEAREST, 192);
}

sub repaint_board {
   my ($self) = @_;
   my $canvas = $self->{canvas};

   return unless $self->{board};

   my ($w, $h) = @{$canvas->allocation}[2,3];
   
   my $s = $w > $h ? $h : $w;
   
   $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];

   my $size = $self->{size};

   my $border = int ($s / ($size + 3) * 0.5);
   my $s2     = $s - $border * 2;
   my $edge   = int ($s2 / ($size + 1) * 0.97);
   my $ofs    = int ($edge / 2);

   my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;

   my $pixbuf;

   if ($self->{background}) {
      $pixbuf = $self->{background}->copy;
   } else {
      my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);

      if ($s < $bw && $s < $bh) {
         $pixbuf = new_pixbuf $s, $s, $::config{conserve_memory} ? 0 : 1, 0;
         $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
      } else {
         $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES;
      }

      my $linew = int ($s / 25 / $size);

      for my $i (1 .. $size) {
         pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
         pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;

         # 38 max, but we allow a bit more
         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
                           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];

         pixbuf_text $pixbuf, 0, $k[$i], $border,       $ofs, $label;
         pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
         pixbuf_text $pixbuf, 0, $border, $k[$i],       $ofs, $size - $i + 1;
         pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;

         $a++;
         $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
      }

      unless ($::config->{conserve_memory}) {
         $self->{background} = $pixbuf;
         $pixbuf = $pixbuf->copy;
      }
   }

   $self->{pixbuf} = $pixbuf;

   # hoshi-points(!)#d#
   # caching of empty board gfx(!)#d#

   for my $x (1 .. $size) {
      for my $y (1 .. $size) {
         my $mark = $self->{board}{board}[$x-1][$y-1];

         if ($mark) {
            my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
            my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 );

            $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height,
                            $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);

            # labels are handled here because they are quite rare
            if ($mark & MARK_LABEL) {
               pixbuf_text $pixbuf, $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1,
                           $k[$x], $k[$y], $ofs * 0.7,
                           $self->{board}{label}[$x-1][$y-1];
            }
            
            #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );

            #$gc->set_clip_mask ($bm);
            #$gc->set_clip_origin ($dx, $dy);
            #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
         }
      }
   }
}

sub expose_event {
   my ($widget, $self, $event) = @_;

   $self->{pixbuf} or return;

   my ($ox, $oy, $s) = @{$self->{offsets}};

   my ($x, $y, $w, $h) =
      @{Gtk::Gdk::Rectangle->intersect(
          $event->{area},
          [$ox, $oy, $s, $s]
      )};

   if (defined $x) {
      $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc,
            $x - $ox, $y - $oy, $x, $y, $w, $h);
      #$self->{canvas}->window->draw_pixmap (
      #   $self->{canvas}->style->white_gc,
      #   $self->{pixmap},
      #   $x - $ox, $y - $oy, $x, $y, $w, $h,
      #);
   }
   1;
}

sub event_update_tree {
   my ($self) = @_;

   $self->{path} = $self->get_path;
   
   my $move = @{$self->{path}};

   $self->{moveadj}->upper($move);

   if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
      $self->{moveadj}->set_value ($move);
   }
}

sub event_move {
   ::play_sound "move";
}

1;


Revision:	1.25
Committed:	Fri May 30 15:50:20 2003 UTC (20 years, 11 months ago) by pcg
Branch:	MAIN
Changes since 1.24:	+116 -64 lines
Log Message:	* empty log message *