Deliantra-Client/DC/UI.pm

package Crossfire::Client::Widget;

use strict;

use Scalar::Util;

use SDL::OpenGL;
use SDL::OpenGL::Constants;

use Crossfire::Client;

# class methods for events
sub feed_sdl_key_down_event    { $::FOCUS->key_down ($_[0])    if $::FOCUS }
sub feed_sdl_key_up_event      { $::FOCUS->key_up ($_[0])      if $::FOCUS }
sub feed_sdl_button_down_event { }
sub feed_sdl_button_up_event   { }

sub new {
   my $class = shift;

   bless { @_ }, $class
}

sub move {
   my ($self, $x, $y, $z) = @_;
   $self->{x} = $x;
   $self->{y} = $y;
   $self->{z} = $z if defined $z;
}

sub needs_redraw {
   0
}

sub size_request {
   require Carp;
   Carp::confess "size_request is abtract";
}

sub size_allocate {
   my ($self, $w, $h) = @_;

   $self->{w} = $w;
   $self->{h} = $h;
}

sub focus_in {
   my ($widget) = @_;
   $::FOCUS = $widget;
}

sub focus_out {
   my ($widget) = @_;
}

sub key_down {
   my ($widget, $sdlev) = @_;
}

sub key_up {
   my ($widget, $sdlev) = @_;
}

sub button_down {
   my ($widget, $sdlev) = @_;
}

sub button_up {
   my ($widget, $sdlev) = @_;
}

sub w { $_[0]->{w} = $_[1] if $_[1]; $_[0]->{w} }
sub h { $_[0]->{h} = $_[1] if $_[1]; $_[0]->{h} }
sub x { $_[0]->{x} = $_[1] if $_[1]; $_[0]->{x} }
sub y { $_[0]->{y} = $_[1] if $_[1]; $_[0]->{y} }
sub z { $_[0]->{z} = $_[1] if $_[1]; $_[0]->{z} }

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

   glPushMatrix;
   glTranslate $self->{x}, $self->{y}, 0;
   $self->_draw;
   if ($self == $::HOVER) {
      glColor 1, 1, 1, 1;
      glBegin GL_LINES;
      glVertex 0, 0;
      glVertex $self->{w} - 1, 0;
      glVertex $self->{w} - 1, $self->{h} - 1;
      glVertex 0, $self->{h} - 1;
      glVertex 0, 0;
      glEnd;
   }
   glPopMatrix;
}

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

   warn "no draw defined for $self\n";
}

sub bbox {
   my ($self) = @_;
   my ($w, $h) = $self->size_request;
   (
     $self->{x},
     $self->{y},
     $self->{x} = $w,
     $self->{y} = $h
   )
}

sub find_widget {
   my ($self, $x, $y) = @_;

   return $self
      if $x >= $self->{x} && $x < $self->{x} + $self->{w}
          && $y >= $self->{y} && $y < $self->{y} + $self->{h};

   ()
}

sub del_parent { $_[0]->{parent} = undef }

sub set_parent {
   my ($self, $par) = @_;

   $self->{parent} = $par;
   Scalar::Util::weaken $self->{parent};
}

sub get_parent {
   $_[0]->{parent}
}

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

   $self->{parent}->update
      if $self->{parent};
}

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

   #$self->deactivate;
}

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

package Crossfire::Client::Widget::Container;

our @ISA = Crossfire::Client::Widget::;

sub new {
   my ($class, @widgets) = @_;

   my $self = $class->SUPER::new (children => []);
   $self->add ($_) for @widgets;

   $self
}

sub add {
   my ($self, $chld, $expand) = @_;

   $chld->{expand} = $expand;
   $chld->set_parent ($self);

   @{$self->{children}} =
      sort { $a->{z} <=> $b->{z} }
         @{$self->{children}}, $chld;

   $self->size_allocate ($self->{w}, $self->{h})
      if $self->{w}; #TODO: check for "realised state"
}

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

   $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];

   $self->size_allocate ($self->{w}, $self->{h});
}

sub find_widget {
   my ($self, $x, $y) = @_;

   $x -= $self->{x};
   $y -= $self->{y};

   my $res;

   for (reverse @{ $self->{children} }) {
      $res = $_->find_widget ($x, $y)
         and return $res;
   }

   $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
}

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

   $_->draw for @{$self->{children}};
}

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

package Crossfire::Client::Widget::Bin;

our @ISA = Crossfire::Client::Widget::Container::;

sub child { $_[0]->{children}[0] }

sub size_request {
   $_[0]{children}[0]->size_request if $_[0]{children}[0];
}

sub size_allocate {
   my ($self, $w, $h) = @_;

   $self->SUPER::size_allocate ($w, $h);
   $self->{children}[0]->size_allocate ($w, $h)
      if $self->{children}[0]
}

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

package Crossfire::Client::Widget::Toplevel;

our @ISA = Crossfire::Client::Widget::Container::;

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

   ::refresh ();
}

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

   $self->SUPER::add ($widget);

   $widget->size_allocate ($widget->size_request);
}

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

package Crossfire::Client::Widget::Window;

our @ISA = Crossfire::Client::Widget::Bin::;

use SDL::OpenGL;

sub new {
   my ($class, $x, $y, $z, $w, $h) = @_;

   my $self = $class->SUPER::new;

   @$self{qw(x y z w h)} = ($x, $y, $z, $w, $h);
}

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

   $self->render_chld;
   $self->SUPER::update;
}

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

   $self->{texture} =
      Crossfire::Client::Texture->new_from_opengl (
         $self->{w}, $self->{h}, sub { $self->child->draw }
      );
}

sub size_allocate {
   my ($self, $w, $h) = @_;

   $self->{w} = $w;
   $self->{h} = $h;

   $self->child->size_allocate ($w, $h);

   $self->render_chld;
}

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

   my ($w, $h) = ($self->w, $self->h);

   my $tex = $self->{texture}
      or return;

   glEnable GL_BLEND;
   glEnable GL_TEXTURE_2D;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
   glBindTexture GL_TEXTURE_2D, $tex->{name};

   glBegin GL_QUADS;
   glTexCoord 0, 0; glVertex  0,  0;
   glTexCoord 0, 1; glVertex  0, $h;
   glTexCoord 1, 1; glVertex $w, $h;
   glTexCoord 1, 0; glVertex $w,  0;
   glEnd;

   glDisable GL_BLEND;
   glDisable GL_TEXTURE_2D;
}

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

package Crossfire::Client::Widget::Frame;

our @ISA = Crossfire::Client::Widget::Bin::;

use SDL::OpenGL;

sub size_request {
   my ($self) = @_;
   my $chld = $self->child
      or return (0, 0);

   $chld->move (2, 2);

   map { $_ + 4 } $chld->size_request;
}

sub size_allocate {
   my ($self, $w, $h) = @_;
   
   $self->{w} = $w;
   $self->{h} = $h;

   $self->child->size_allocate ($w - 4, $h - 4);
   $self->child->move (2, 2);
}

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

   my $chld = $self->child;

   my ($w, $h) = $chld->size_request;

   glBegin GL_QUADS;
   glColor 0, 0, 0;
   glTexCoord 0, 0; glVertex 0      , 0;
   glTexCoord 0, 1; glVertex 0      , $h + 4;
   glTexCoord 1, 1; glVertex $w + 4 , $h + 4;
   glTexCoord 1, 0; glVertex $w + 4 , 0;
   glEnd;

   $chld->draw;
}

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

package Crossfire::Client::Widget::FancyFrame;

our @ISA = Crossfire::Client::Widget::Bin::;

use SDL::OpenGL;

my @tex = 
      map { new_from_file Crossfire::Client::Texture Crossfire::Client::find_rcfile $_ }
         qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);

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

   my ($w, $h) = $self->SUPER::size_request;

   $h += $tex[1]->{height};
   $h += $tex[4]->{height};
   $w += $tex[2]->{width};
   $w += $tex[3]->{width};

   ($w, $h)
}

sub size_allocate {
   my ($self, $w, $h) = @_;

   $self->SUPER::size_allocate ($w, $h);

   $h -= $tex[1]->{height};
   $h -= $tex[4]->{height};
   $w -= $tex[2]->{width};
   $w -= $tex[3]->{width};

   $h = $h < 0 ? 0 : $h;
   $w = $w < 0 ? 0 : $w;

   $self->child->size_allocate ($w, $h);
   $self->child->move ($tex[3]->{width}, $tex[1]->{height});
}

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

   my ($w, $h) = ($self->{w}, $self->{h});
   my ($cw, $ch) = ($self->child->{w}, $self->child->{h});

   glEnable GL_BLEND;
   glEnable GL_TEXTURE_2D;
   glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;

   my $top = $tex[1];
   glBindTexture GL_TEXTURE_2D, $top->{name};

   glBegin GL_QUADS;
   glTexCoord 0, 0; glVertex 0            , 0;
   glTexCoord 0, 1; glVertex 0            , $top->{height};
   glTexCoord 1, 1; glVertex $w           , $top->{height};
   glTexCoord 1, 0; glVertex $w           , 0;
   glEnd;

   my $left = $tex[3];
   glBindTexture GL_TEXTURE_2D, $left->{name};

   glBegin GL_QUADS;
   glTexCoord 0, 0; glVertex 0            ,  $top->{height};
   glTexCoord 0, 1; glVertex 0            ,  $top->{height} + $ch;
   glTexCoord 1, 1; glVertex $left->{width}, $top->{height} + $ch;
   glTexCoord 1, 0; glVertex $left->{width}, $top->{height};
   glEnd;

   my $right = $tex[2];
   glBindTexture GL_TEXTURE_2D, $right->{name};

   glBegin GL_QUADS;
   glTexCoord 0, 0; glVertex $w - $right->{width}, $top->{height};
   glTexCoord 0, 1; glVertex $w - $right->{width}, $top->{height} + $ch;
   glTexCoord 1, 1; glVertex $w                  , $top->{height} + $ch;
   glTexCoord 1, 0; glVertex $w                  , $top->{height};
   glEnd;

   my $bottom = $tex[4];
   glBindTexture GL_TEXTURE_2D, $bottom->{name};

   glBegin GL_QUADS;
   glTexCoord 0, 0; glVertex 0            , $h - $bottom->{height};
   glTexCoord 0, 1; glVertex 0            , $h;
   glTexCoord 1, 1; glVertex $w           , $h;
   glTexCoord 1, 0; glVertex $w           , $h - $bottom->{height};
   glEnd;

   my $bg = $tex[0];
   glBindTexture GL_TEXTURE_2D, $bg->{name};
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
   glTexParameter  GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
   glTexParameter  GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;

   my $rep_x = $cw / $bg->{width};
   my $rep_y = $ch / $bg->{height};

   glBegin GL_QUADS;
   glTexCoord 0, 0; glVertex $left->{width}, $top->{height};
   glTexCoord 0, $rep_y; glVertex $left->{width}, $top->{height} + $ch;
   glTexCoord $rep_x, $rep_y; glVertex $left->{width} + $cw , $top->{height} + $ch;
   glTexCoord $rep_x, 0; glVertex $left->{width} + $cw , $top->{height};
   glEnd;

   glDisable GL_BLEND;
   glDisable GL_TEXTURE_2D;

   $self->child->draw;

}

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

package Crossfire::Client::Widget::Table;

our @ISA = Crossfire::Client::Widget::Bin::;

use SDL::OpenGL;

sub add {
   my ($self, $x, $y, $chld) = @_;
   my $old_chld = $self->{children}[$y][$x];

   $self->{children}[$y][$x] = $chld;
   $chld->set_parent ($self);
   $self->update;
}

sub max_row_height {
   my ($self, $row) = @_;

   my $hs = 0;
   for (my $xi = 0; $xi <= $#{$self->{children}->[$row] || []}; $xi++) {
      my $c = $self->{children}->[$row]->[$xi];
      if ($c) {
         my ($w, $h) = $c->size_request;
         if ($hs < $h) { $hs = $h }
      }
   }
   return $hs;
}

sub max_col_width {
   my ($self, $col) = @_;

   my $ws = 0;
   for (my $yi = 0; $yi <= $#{$self->{children} || []}; $yi++) {
      my $c = ($self->{children}->[$yi] || [])->[$col];
      if ($c) {
         my ($w, $h) = $c->size_request;
         if ($ws < $w) { $ws = $w }
      }
   }
   return $ws;
}

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

   my ($hs, $ws) = (0, 0);

   for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
      $hs += $self->max_row_height ($yi);
   }

   for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
      my $wm = 0;
      for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
         $wm += $self->max_col_width ($xi)
      }
      if ($ws < $wm) { $ws = $wm }
   }

   return ($ws, $hs);
}

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

   my $y = 0;
   for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
      my $x = 0;

      for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {

         my $c = $self->{children}->[$yi]->[$xi];
         if ($c) {
            $c->move ($x, $y, 0); #TODO: Move to size_request
            $c->draw if $c;
         }

         $x += $self->max_col_width ($xi);
      }

      $y += $self->max_row_height ($yi);
   }
}

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

package Crossfire::Client::Widget::VBox;

our @ISA = Crossfire::Client::Widget::Container::;

use SDL::OpenGL;

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

   my @alloc = map [$_->size_request], @{$self->{children}};

   (
      (List::Util::max map $_->[0], @alloc),
      (List::Util::sum map $_->[1], @alloc),
   )
}

sub size_allocate {
   my ($self, $w, $h) = @_;

   $self->w ($w);
   $self->h ($h);

   my $exp;
   my @oth;
   # find expand widget
   for (@{$self->{children}}) {
      if ($_->{expand}) {
         $exp = $_;
         last;
      }
      push @oth, $_;
   }

   my ($ow, $oh);

   # get sizes of other widgets
   for (@oth) {
      my ($w, $h) = $_->size_request;
      $oh += $h;
      if ($ow < $w) { $ow = $w }
   }

   my $y = 0;
   for (@{$self->{children}}) {
      $_->move (0, $y);

      if ($_ == $exp) {
         $_->size_allocate ($w, $h - $oh);
         $y += $h - $oh;
      } else {
         my ($cw, $h) = $_->size_request;
         $_->size_allocate ($w, $h);
         $y += $h;
      }
   }
}

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

package Crossfire::Client::Widget::Label;

our @ISA = Crossfire::Client::Widget::;

use SDL::OpenGL;

sub new {
   my ($class, $x, $y, $z, $height, $text) = @_;

   # TODO: color, and make height, xyz etc. optional
   my $self = $class->SUPER::new (x => $x, y => $y, z => $z, height => $height);

   $self->set_text ($text);

   $self
}

sub set_text {
   my ($self, $text) = @_;

   $self->{text} = $text;
   $self->{texture} = new_from_text Crossfire::Client::Texture $text, $self->{height};

   $self->update;
}

sub get_text {
   my ($self, $text) = @_;

   $self->{text}
}

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

   (
      $self->{texture}{width},
      $self->{texture}{height},
   )
}

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

   my $tex = $self->{texture};

   glEnable GL_BLEND;
   glEnable GL_TEXTURE_2D;
   glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
   glBindTexture GL_TEXTURE_2D, $tex->{name};

   glColor 1, 0, 0, 1; # TODO color

   glBegin GL_QUADS;
   glTexCoord 0, 0; glVertex 0            , 0;
   glTexCoord 0, 1; glVertex 0            , $tex->{height};
   glTexCoord 1, 1; glVertex $tex->{width}, $tex->{height};
   glTexCoord 1, 0; glVertex $tex->{width}, 0;
   glEnd;

   glDisable GL_BLEND;
   glDisable GL_TEXTURE_2D;
}

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

package Crossfire::Client::Widget::TextEntry;

our @ISA = Crossfire::Client::Widget::Label::;

use SDL;
use SDL::OpenGL;

sub key_down {
   my ($self, $ev) = @_;

   my $mod = $ev->key_mod;
   my $sym = $ev->key_sym;

   $ev->set_unicode (1);
   my $uni = $ev->key_unicode;

   my $text = $self->get_text;

   if ($sym == SDLK_BACKSPACE) {
      substr $text, -1, 1, '';

   } elsif ($uni) {
      $text .= chr $uni;
   }
   $self->set_text ($text);
}

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

package Crossfire::Client::Widget::MapWidget;

use strict;

use List::Util qw(min max);

use SDL;
use SDL::OpenGL;
use SDL::OpenGL::Constants;

our @ISA = Crossfire::Client::Widget::;

sub key_down {
   print "MAPKEYDOWN\n";
}

sub key_up {
}

sub size_request {

}

sub size_allocate {
}

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

   my $mx = $::CONN->{mapx};
   my $my = $::CONN->{mapy};

   my $map = $::CONN->{map};

   my ($xofs, $yofs);

   my $sw = 1 + int $::WIDTH  / 32;
   my $sh = 1 + int $::HEIGHT / 32;

   if ($::CONN->{mapw} > $sw) {
      $xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
   } else {
      $xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
   }

   if ($::CONN->{maph} > $sh) {
      $yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
   } else {
      $yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
   }

   glEnable GL_TEXTURE_2D;
   glEnable GL_BLEND;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;

   my $sw4 = ($sw + 3) & ~3;
   my $lighting = "\x00" x ($sw4 * $sh);

   for my $x (0 .. $sw - 1) {
      for my $y (0 .. $sh - 1) {

         my $cell = $map->[$x + $xofs][$y + $yofs]
            or next;

         my $darkness = $cell->[0] * (1 / 255);
         if ($darkness < 0) {
            $darkness = 0.15;
         }
         substr $lighting, $y * $sw4 + $x, 1, chr 255 - $darkness * 255;

         for my $num (grep $_, @$cell[1,2,3]) {
            my $tex = $::CONN->{face}[$num]{texture} || next;

            glBindTexture GL_TEXTURE_2D, $tex->{name};

            my $w = $tex->{width};
            my $h = $tex->{height};

            my $px = ($x + 1) * 32 - $w;
            my $py = ($y + 1) * 32 - $h;

            glBegin GL_QUADS;
            glTexCoord 0, 0; glVertex $px     , $py;
            glTexCoord 0, 1; glVertex $px     , $py + $h;
            glTexCoord 1, 1; glVertex $px + $w, $py + $h;
            glTexCoord 1, 0; glVertex $px + $w, $py;
            glEnd;
         }
      }
   }

#   if (1) { # higher quality darkness
#      $lighting =~ s/(.)/$1$1$1/gs;
#      my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
#
#      $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear");
#
#      $lighting = $pb->get_pixels;
#      $lighting =~ s/(.)../$1/gs;
#   }

   $lighting = new Crossfire::Client::Texture
      width          => $sw4,
      height         => $sh,
      data           => $lighting,
      internalformat => GL_ALPHA4,
      format         => GL_ALPHA;

   glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
   glColor 0, 0, 0, 0.75;
   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
   glBindTexture GL_TEXTURE_2D, $lighting->{name};
   glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
   glBegin GL_QUADS;
   glTexCoord 0, 0; glVertex 0        , 0;
   glTexCoord 0, 1; glVertex 0        , $sh * 32;
   glTexCoord 1, 1; glVertex $sw4 * 32, $sh * 32;
   glTexCoord 1, 0; glVertex $sw4 * 32, 0;
   glEnd;

   glDisable GL_TEXTURE_2D;
   glDisable GL_BLEND;
}

my %DIR = (
   SDLK_KP8, [1, "north"],
   SDLK_KP9, [2, "northeast"],
   SDLK_KP6, [3, "east"],
   SDLK_KP3, [4, "southeast"],
   SDLK_KP2, [5, "south"],
   SDLK_KP1, [6, "southwest"],
   SDLK_KP4, [7, "west"],
   SDLK_KP7, [8, "northwest"],

   SDLK_UP,    [1, "north"],
   SDLK_RIGHT, [3, "east"],
   SDLK_DOWN,  [5, "south"],
   SDLK_LEFT,  [7, "west"],
);

sub key_down {
   my ($self, $ev) = @_;

   my $mod = $ev->key_mod;
   my $sym = $ev->key_sym;

   if ($sym == SDLK_KP5) {
      $::CONN->send ("command stay fire");
   } elsif (exists $DIR{$sym}) {
      if ($mod & KMOD_SHIFT) {
         $self->{shft}++;
         $::CONN->send ("command fire $DIR{$sym}[0]");
      } elsif ($mod & KMOD_CTRL) {
         $self->{ctrl}++;
         $::CONN->send ("command run $DIR{$sym}[0]");
      } else {
         $::CONN->send ("command $DIR{$sym}[1]");
      }
   }
}

sub key_up {
   my ($self, $ev) = @_;

   my $mod = $ev->key_mod;
   my $sym = $ev->key_sym;

   if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
      $::CONN->send ("command fire_stop");
   }
   if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
      $::CONN->send ("command run_stop");
   }
}

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

package Crossfire::Client::Widget::Animator;

use SDL::OpenGL;

our @ISA = Crossfire::Client::Widget::Bin::;

sub moveto {
   my ($self, $x, $y) = @_;

   $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
   $self->{speed}  = 0.2;
   $self->{time}   = 1;
   
   ::animation_start $self;
}

sub animate {
   my ($self, $interval) = @_;

   $self->{time} -= $interval * $self->{speed};
   if ($self->{time} <= 0) {
      $self->{time} = 0;
      ::animation_stop $self;
   }

   my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
      
   $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
   $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
}

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

   glPushMatrix;
   glRotate $self->{time} * 10000, 0, 1, 0;
   $self->{children}[0]->draw;
   glPopMatrix;
}

1;

Revision:	1.47
Committed:	Sun Apr 9 22:24:43 2006 UTC (18 years, 2 months ago) by root
Branch:	MAIN
Changes since 1.46:	+13 -5 lines
Log Message:	* empty log message *
#	Content
1	package Crossfire::Client::Widget;
2
3	use strict;
4
5	use Scalar::Util;
6
7	use SDL::OpenGL;
8	use SDL::OpenGL::Constants;
9
10	use Crossfire::Client;
11
12	# class methods for events
13	sub feed_sdl_key_down_event { $::FOCUS->key_down ($_[0]) if $::FOCUS }
14	sub feed_sdl_key_up_event { $::FOCUS->key_up ($_[0]) if $::FOCUS }
15	sub feed_sdl_button_down_event { }
16	sub feed_sdl_button_up_event { }
17
18	sub new {
19	my $class = shift;
20
21	bless { @_ }, $class
22	}
23
24	sub move {
25	my ($self, $x, $y, $z) = @_;
26	$self->{x} = $x;
27	$self->{y} = $y;
28	$self->{z} = $z if defined $z;
29	}
30
31	sub needs_redraw {
32	0
33	}
34
35	sub size_request {
36	require Carp;
37	Carp::confess "size_request is abtract";
38	}
39
40	sub size_allocate {
41	my ($self, $w, $h) = @_;
42
43	$self->{w} = $w;
44	$self->{h} = $h;
45	}
46
47	sub focus_in {
48	my ($widget) = @_;
49	$::FOCUS = $widget;
50	}
51
52	sub focus_out {
53	my ($widget) = @_;
54	}
55
56	sub key_down {
57	my ($widget, $sdlev) = @_;
58	}
59
60	sub key_up {
61	my ($widget, $sdlev) = @_;
62	}
63
64	sub button_down {
65	my ($widget, $sdlev) = @_;
66	}
67
68	sub button_up {
69	my ($widget, $sdlev) = @_;
70	}
71
72	sub w { $_[0]->{w} = $_[1] if $_[1]; $_[0]->{w} }
73	sub h { $_[0]->{h} = $_[1] if $_[1]; $_[0]->{h} }
74	sub x { $_[0]->{x} = $_[1] if $_[1]; $_[0]->{x} }
75	sub y { $_[0]->{y} = $_[1] if $_[1]; $_[0]->{y} }
76	sub z { $_[0]->{z} = $_[1] if $_[1]; $_[0]->{z} }
77
78	sub draw {
79	my ($self) = @_;
80
81	glPushMatrix;
82	glTranslate $self->{x}, $self->{y}, 0;
83	$self->_draw;
84	if ($self == $::HOVER) {
85	glColor 1, 1, 1, 1;
86	glBegin GL_LINES;
87	glVertex 0, 0;
88	glVertex $self->{w} - 1, 0;
89	glVertex $self->{w} - 1, $self->{h} - 1;
90	glVertex 0, $self->{h} - 1;
91	glVertex 0, 0;
92	glEnd;
93	}
94	glPopMatrix;
95	}
96
97	sub _draw {
98	my ($self) = @_;
99
100	warn "no draw defined for $self\n";
101	}
102
103	sub bbox {
104	my ($self) = @_;
105	my ($w, $h) = $self->size_request;
106	(
107	$self->{x},
108	$self->{y},
109	$self->{x} = $w,
110	$self->{y} = $h
111	)
112	}
113
114	sub find_widget {
115	my ($self, $x, $y) = @_;
116
117	return $self
118	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
119	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
120
121	()
122	}
123
124	sub del_parent { $_[0]->{parent} = undef }
125
126	sub set_parent {
127	my ($self, $par) = @_;
128
129	$self->{parent} = $par;
130	Scalar::Util::weaken $self->{parent};
131	}
132
133	sub get_parent {
134	$_[0]->{parent}
135	}
136
137	sub update {
138	my ($self) = @_;
139
140	$self->{parent}->update
141	if $self->{parent};
142	}
143
144	sub DESTROY {
145	my ($self) = @_;
146
147	#$self->deactivate;
148	}
149
150	#############################################################################
151
152	package Crossfire::Client::Widget::Container;
153
154	our @ISA = Crossfire::Client::Widget::;
155
156	sub new {
157	my ($class, @widgets) = @_;
158
159	my $self = $class->SUPER::new (children => []);
160	$self->add ($_) for @widgets;
161
162	$self
163	}
164
165	sub add {
166	my ($self, $chld, $expand) = @_;
167
168	$chld->{expand} = $expand;
169	$chld->set_parent ($self);
170
171	@{$self->{children}} =
172	sort { $a->{z} <=> $b->{z} }
173	@{$self->{children}}, $chld;
174
175	$self->size_allocate ($self->{w}, $self->{h})
176	if $self->{w}; #TODO: check for "realised state"
177	}
178
179	sub remove {
180	my ($self, $widget) = @_;
181
182	$self->{children} = [ grep $_ != $widget, @{ $self->{children} } ];
183
184	$self->size_allocate ($self->{w}, $self->{h});
185	}
186
187	sub find_widget {
188	my ($self, $x, $y) = @_;
189
190	$x -= $self->{x};
191	$y -= $self->{y};
192
193	my $res;
194
195	for (reverse @{ $self->{children} }) {
196	$res = $_->find_widget ($x, $y)
197	and return $res;
198	}
199
200	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
201	}
202
203	sub _draw {
204	my ($self) = @_;
205
206	$_->draw for @{$self->{children}};
207	}
208
209	#############################################################################
210
211	package Crossfire::Client::Widget::Bin;
212
213	our @ISA = Crossfire::Client::Widget::Container::;
214
215	sub child { $_[0]->{children}[0] }
216
217	sub size_request {
218	$_[0]{children}[0]->size_request if $_[0]{children}[0];
219	}
220
221	sub size_allocate {
222	my ($self, $w, $h) = @_;
223
224	$self->SUPER::size_allocate ($w, $h);
225	$self->{children}[0]->size_allocate ($w, $h)
226	if $self->{children}[0]
227	}
228
229	#############################################################################
230
231	package Crossfire::Client::Widget::Toplevel;
232
233	our @ISA = Crossfire::Client::Widget::Container::;
234
235	sub update {
236	my ($self) = @_;
237
238	::refresh ();
239	}
240
241	sub add {
242	my ($self, $widget) = @_;
243
244	$self->SUPER::add ($widget);
245
246	$widget->size_allocate ($widget->size_request);
247	}
248
249	#############################################################################
250
251	package Crossfire::Client::Widget::Window;
252
253	our @ISA = Crossfire::Client::Widget::Bin::;
254
255	use SDL::OpenGL;
256
257	sub new {
258	my ($class, $x, $y, $z, $w, $h) = @_;
259
260	my $self = $class->SUPER::new;
261
262	@$self{qw(x y z w h)} = ($x, $y, $z, $w, $h);
263	}
264
265	sub update {
266	my ($self) = @_;
267
268	$self->render_chld;
269	$self->SUPER::update;
270	}
271
272	sub render_chld {
273	my ($self) = @_;
274
275	$self->{texture} =
276	Crossfire::Client::Texture->new_from_opengl (
277	$self->{w}, $self->{h}, sub { $self->child->draw }
278	);
279	}
280
281	sub size_allocate {
282	my ($self, $w, $h) = @_;
283
284	$self->{w} = $w;
285	$self->{h} = $h;
286
287	$self->child->size_allocate ($w, $h);
288
289	$self->render_chld;
290	}
291
292	sub _draw {
293	my ($self) = @_;
294
295	my ($w, $h) = ($self->w, $self->h);
296
297	my $tex = $self->{texture}
298	or return;
299
300	glEnable GL_BLEND;
301	glEnable GL_TEXTURE_2D;
302	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
303	glBindTexture GL_TEXTURE_2D, $tex->{name};
304
305	glBegin GL_QUADS;
306	glTexCoord 0, 0; glVertex 0, 0;
307	glTexCoord 0, 1; glVertex 0, $h;
308	glTexCoord 1, 1; glVertex $w, $h;
309	glTexCoord 1, 0; glVertex $w, 0;
310	glEnd;
311
312	glDisable GL_BLEND;
313	glDisable GL_TEXTURE_2D;
314	}
315
316	#############################################################################
317
318	package Crossfire::Client::Widget::Frame;
319
320	our @ISA = Crossfire::Client::Widget::Bin::;
321
322	use SDL::OpenGL;
323
324	sub size_request {
325	my ($self) = @_;
326	my $chld = $self->child
327	or return (0, 0);
328
329	$chld->move (2, 2);
330
331	map { $_ + 4 } $chld->size_request;
332	}
333
334	sub size_allocate {
335	my ($self, $w, $h) = @_;
336
337	$self->{w} = $w;
338	$self->{h} = $h;
339
340	$self->child->size_allocate ($w - 4, $h - 4);
341	$self->child->move (2, 2);
342	}
343
344	sub _draw {
345	my ($self) = @_;
346
347	my $chld = $self->child;
348
349	my ($w, $h) = $chld->size_request;
350
351	glBegin GL_QUADS;
352	glColor 0, 0, 0;
353	glTexCoord 0, 0; glVertex 0 , 0;
354	glTexCoord 0, 1; glVertex 0 , $h + 4;
355	glTexCoord 1, 1; glVertex $w + 4 , $h + 4;
356	glTexCoord 1, 0; glVertex $w + 4 , 0;
357	glEnd;
358
359	$chld->draw;
360	}
361
362	#############################################################################
363
364	package Crossfire::Client::Widget::FancyFrame;
365
366	our @ISA = Crossfire::Client::Widget::Bin::;
367
368	use SDL::OpenGL;
369
370	my @tex =
371	map { new_from_file Crossfire::Client::Texture Crossfire::Client::find_rcfile $_ }
372	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
373
374	sub size_request {
375	my ($self) = @_;
376
377	my ($w, $h) = $self->SUPER::size_request;
378
379	$h += $tex[1]->{height};
380	$h += $tex[4]->{height};
381	$w += $tex[2]->{width};
382	$w += $tex[3]->{width};
383
384	($w, $h)
385	}
386
387	sub size_allocate {
388	my ($self, $w, $h) = @_;
389
390	$self->SUPER::size_allocate ($w, $h);
391
392	$h -= $tex[1]->{height};
393	$h -= $tex[4]->{height};
394	$w -= $tex[2]->{width};
395	$w -= $tex[3]->{width};
396
397	$h = $h < 0 ? 0 : $h;
398	$w = $w < 0 ? 0 : $w;
399
400	$self->child->size_allocate ($w, $h);
401	$self->child->move ($tex[3]->{width}, $tex[1]->{height});
402	}
403
404	sub _draw {
405	my ($self) = @_;
406
407	my ($w, $h) = ($self->{w}, $self->{h});
408	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
409
410	glEnable GL_BLEND;
411	glEnable GL_TEXTURE_2D;
412	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
413	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
414
415	my $top = $tex[1];
416	glBindTexture GL_TEXTURE_2D, $top->{name};
417
418	glBegin GL_QUADS;
419	glTexCoord 0, 0; glVertex 0 , 0;
420	glTexCoord 0, 1; glVertex 0 , $top->{height};
421	glTexCoord 1, 1; glVertex $w , $top->{height};
422	glTexCoord 1, 0; glVertex $w , 0;
423	glEnd;
424
425	my $left = $tex[3];
426	glBindTexture GL_TEXTURE_2D, $left->{name};
427
428	glBegin GL_QUADS;
429	glTexCoord 0, 0; glVertex 0 , $top->{height};
430	glTexCoord 0, 1; glVertex 0 , $top->{height} + $ch;
431	glTexCoord 1, 1; glVertex $left->{width}, $top->{height} + $ch;
432	glTexCoord 1, 0; glVertex $left->{width}, $top->{height};
433	glEnd;
434
435	my $right = $tex[2];
436	glBindTexture GL_TEXTURE_2D, $right->{name};
437
438	glBegin GL_QUADS;
439	glTexCoord 0, 0; glVertex $w - $right->{width}, $top->{height};
440	glTexCoord 0, 1; glVertex $w - $right->{width}, $top->{height} + $ch;
441	glTexCoord 1, 1; glVertex $w , $top->{height} + $ch;
442	glTexCoord 1, 0; glVertex $w , $top->{height};
443	glEnd;
444
445	my $bottom = $tex[4];
446	glBindTexture GL_TEXTURE_2D, $bottom->{name};
447
448	glBegin GL_QUADS;
449	glTexCoord 0, 0; glVertex 0 , $h - $bottom->{height};
450	glTexCoord 0, 1; glVertex 0 , $h;
451	glTexCoord 1, 1; glVertex $w , $h;
452	glTexCoord 1, 0; glVertex $w , $h - $bottom->{height};
453	glEnd;
454
455	my $bg = $tex[0];
456	glBindTexture GL_TEXTURE_2D, $bg->{name};
457	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
458	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
459	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
460
461	my $rep_x = $cw / $bg->{width};
462	my $rep_y = $ch / $bg->{height};
463
464	glBegin GL_QUADS;
465	glTexCoord 0, 0; glVertex $left->{width}, $top->{height};
466	glTexCoord 0, $rep_y; glVertex $left->{width}, $top->{height} + $ch;
467	glTexCoord $rep_x, $rep_y; glVertex $left->{width} + $cw , $top->{height} + $ch;
468	glTexCoord $rep_x, 0; glVertex $left->{width} + $cw , $top->{height};
469	glEnd;
470
471	glDisable GL_BLEND;
472	glDisable GL_TEXTURE_2D;
473
474	$self->child->draw;
475
476	}
477
478	#############################################################################
479
480	package Crossfire::Client::Widget::Table;
481
482	our @ISA = Crossfire::Client::Widget::Bin::;
483
484	use SDL::OpenGL;
485
486	sub add {
487	my ($self, $x, $y, $chld) = @_;
488	my $old_chld = $self->{children}[$y][$x];
489
490	$self->{children}[$y][$x] = $chld;
491	$chld->set_parent ($self);
492	$self->update;
493	}
494
495	sub max_row_height {
496	my ($self, $row) = @_;
497
498	my $hs = 0;
499	for (my $xi = 0; $xi <= $#{$self->{children}->[$row] \|\| []}; $xi++) {
500	my $c = $self->{children}->[$row]->[$xi];
501	if ($c) {
502	my ($w, $h) = $c->size_request;
503	if ($hs < $h) { $hs = $h }
504	}
505	}
506	return $hs;
507	}
508
509	sub max_col_width {
510	my ($self, $col) = @_;
511
512	my $ws = 0;
513	for (my $yi = 0; $yi <= $#{$self->{children} \|\| []}; $yi++) {
514	my $c = ($self->{children}->[$yi] \|\| [])->[$col];
515	if ($c) {
516	my ($w, $h) = $c->size_request;
517	if ($ws < $w) { $ws = $w }
518	}
519	}
520	return $ws;
521	}
522
523	sub size_request {
524	my ($self) = @_;
525
526	my ($hs, $ws) = (0, 0);
527
528	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
529	$hs += $self->max_row_height ($yi);
530	}
531
532	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
533	my $wm = 0;
534	for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
535	$wm += $self->max_col_width ($xi)
536	}
537	if ($ws < $wm) { $ws = $wm }
538	}
539
540	return ($ws, $hs);
541	}
542
543	sub _draw {
544	my ($self) = @_;
545
546	my $y = 0;
547	for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
548	my $x = 0;
549
550	for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
551
552	my $c = $self->{children}->[$yi]->[$xi];
553	if ($c) {
554	$c->move ($x, $y, 0); #TODO: Move to size_request
555	$c->draw if $c;
556	}
557
558	$x += $self->max_col_width ($xi);
559	}
560
561	$y += $self->max_row_height ($yi);
562	}
563	}
564
565	#############################################################################
566
567	package Crossfire::Client::Widget::VBox;
568
569	our @ISA = Crossfire::Client::Widget::Container::;
570
571	use SDL::OpenGL;
572
573	sub size_request {
574	my ($self) = @_;
575
576	my @alloc = map [$_->size_request], @{$self->{children}};
577
578	(
579	(List::Util::max map $_->[0], @alloc),
580	(List::Util::sum map $_->[1], @alloc),
581	)
582	}
583
584	sub size_allocate {
585	my ($self, $w, $h) = @_;
586
587	$self->w ($w);
588	$self->h ($h);
589
590	my $exp;
591	my @oth;
592	# find expand widget
593	for (@{$self->{children}}) {
594	if ($_->{expand}) {
595	$exp = $_;
596	last;
597	}
598	push @oth, $_;
599	}
600
601	my ($ow, $oh);
602
603	# get sizes of other widgets
604	for (@oth) {
605	my ($w, $h) = $_->size_request;
606	$oh += $h;
607	if ($ow < $w) { $ow = $w }
608	}
609
610	my $y = 0;
611	for (@{$self->{children}}) {
612	$_->move (0, $y);
613
614	if ($_ == $exp) {
615	$_->size_allocate ($w, $h - $oh);
616	$y += $h - $oh;
617	} else {
618	my ($cw, $h) = $_->size_request;
619	$_->size_allocate ($w, $h);
620	$y += $h;
621	}
622	}
623	}
624
625	#############################################################################
626
627	package Crossfire::Client::Widget::Label;
628
629	our @ISA = Crossfire::Client::Widget::;
630
631	use SDL::OpenGL;
632
633	sub new {
634	my ($class, $x, $y, $z, $height, $text) = @_;
635
636	# TODO: color, and make height, xyz etc. optional
637	my $self = $class->SUPER::new (x => $x, y => $y, z => $z, height => $height);
638
639	$self->set_text ($text);
640
641	$self
642	}
643
644	sub set_text {
645	my ($self, $text) = @_;
646
647	$self->{text} = $text;
648	$self->{texture} = new_from_text Crossfire::Client::Texture $text, $self->{height};
649
650	$self->update;
651	}
652
653	sub get_text {
654	my ($self, $text) = @_;
655
656	$self->{text}
657	}
658
659	sub size_request {
660	my ($self) = @_;
661
662	(
663	$self->{texture}{width},
664	$self->{texture}{height},
665	)
666	}
667
668	sub _draw {
669	my ($self) = @_;
670
671	my $tex = $self->{texture};
672
673	glEnable GL_BLEND;
674	glEnable GL_TEXTURE_2D;
675	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
676	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
677	glBindTexture GL_TEXTURE_2D, $tex->{name};
678
679	glColor 1, 0, 0, 1; # TODO color
680
681	glBegin GL_QUADS;
682	glTexCoord 0, 0; glVertex 0 , 0;
683	glTexCoord 0, 1; glVertex 0 , $tex->{height};
684	glTexCoord 1, 1; glVertex $tex->{width}, $tex->{height};
685	glTexCoord 1, 0; glVertex $tex->{width}, 0;
686	glEnd;
687
688	glDisable GL_BLEND;
689	glDisable GL_TEXTURE_2D;
690	}
691
692	#############################################################################
693
694	package Crossfire::Client::Widget::TextEntry;
695
696	our @ISA = Crossfire::Client::Widget::Label::;
697
698	use SDL;
699	use SDL::OpenGL;
700
701	sub key_down {
702	my ($self, $ev) = @_;
703
704	my $mod = $ev->key_mod;
705	my $sym = $ev->key_sym;
706
707	$ev->set_unicode (1);
708	my $uni = $ev->key_unicode;
709
710	my $text = $self->get_text;
711
712	if ($sym == SDLK_BACKSPACE) {
713	substr $text, -1, 1, '';
714
715	} elsif ($uni) {
716	$text .= chr $uni;
717	}
718	$self->set_text ($text);
719	}
720
721	#############################################################################
722
723	package Crossfire::Client::Widget::MapWidget;
724
725	use strict;
726
727	use List::Util qw(min max);
728
729	use SDL;
730	use SDL::OpenGL;
731	use SDL::OpenGL::Constants;
732
733	our @ISA = Crossfire::Client::Widget::;
734
735	sub key_down {
736	print "MAPKEYDOWN\n";
737	}
738
739	sub key_up {
740	}
741
742	sub size_request {
743
744	}
745
746	sub size_allocate {
747	}
748
749	sub _draw {
750	my ($self) = @_;
751
752	my $mx = $::CONN->{mapx};
753	my $my = $::CONN->{mapy};
754
755	my $map = $::CONN->{map};
756
757	my ($xofs, $yofs);
758
759	my $sw = 1 + int $::WIDTH / 32;
760	my $sh = 1 + int $::HEIGHT / 32;
761
762	if ($::CONN->{mapw} > $sw) {
763	$xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
764	} else {
765	$xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
766	}
767
768	if ($::CONN->{maph} > $sh) {
769	$yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
770	} else {
771	$yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
772	}
773
774	glEnable GL_TEXTURE_2D;
775	glEnable GL_BLEND;
776	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
777
778	my $sw4 = ($sw + 3) & ~3;
779	my $lighting = "\x00" x ($sw4 * $sh);
780
781	for my $x (0 .. $sw - 1) {
782	for my $y (0 .. $sh - 1) {
783
784	my $cell = $map->[$x + $xofs][$y + $yofs]
785	or next;
786
787	my $darkness = $cell->[0] * (1 / 255);
788	if ($darkness < 0) {
789	$darkness = 0.15;
790	}
791	substr $lighting, $y * $sw4 + $x, 1, chr 255 - $darkness * 255;
792
793	for my $num (grep $_, @$cell[1,2,3]) {
794	my $tex = $::CONN->{face}[$num]{texture} \|\| next;
795
796	glBindTexture GL_TEXTURE_2D, $tex->{name};
797
798	my $w = $tex->{width};
799	my $h = $tex->{height};
800
801	my $px = ($x + 1) * 32 - $w;
802	my $py = ($y + 1) * 32 - $h;
803
804	glBegin GL_QUADS;
805	glTexCoord 0, 0; glVertex $px , $py;
806	glTexCoord 0, 1; glVertex $px , $py + $h;
807	glTexCoord 1, 1; glVertex $px + $w, $py + $h;
808	glTexCoord 1, 0; glVertex $px + $w, $py;
809	glEnd;
810	}
811	}
812	}
813
814	# if (1) { # higher quality darkness
815	# $lighting =~ s/(.)/$1$1$1/gs;
816	# my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
817	#
818	# $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear");
819	#
820	# $lighting = $pb->get_pixels;
821	# $lighting =~ s/(.)../$1/gs;
822	# }
823
824	$lighting = new Crossfire::Client::Texture
825	width => $sw4,
826	height => $sh,
827	data => $lighting,
828	internalformat => GL_ALPHA4,
829	format => GL_ALPHA;
830
831	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
832	glColor 0, 0, 0, 0.75;
833	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
834	glBindTexture GL_TEXTURE_2D, $lighting->{name};
835	glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
836	glBegin GL_QUADS;
837	glTexCoord 0, 0; glVertex 0 , 0;
838	glTexCoord 0, 1; glVertex 0 , $sh * 32;
839	glTexCoord 1, 1; glVertex $sw4 * 32, $sh * 32;
840	glTexCoord 1, 0; glVertex $sw4 * 32, 0;
841	glEnd;
842
843	glDisable GL_TEXTURE_2D;
844	glDisable GL_BLEND;
845	}
846
847	my %DIR = (
848	SDLK_KP8, [1, "north"],
849	SDLK_KP9, [2, "northeast"],
850	SDLK_KP6, [3, "east"],
851	SDLK_KP3, [4, "southeast"],
852	SDLK_KP2, [5, "south"],
853	SDLK_KP1, [6, "southwest"],
854	SDLK_KP4, [7, "west"],
855	SDLK_KP7, [8, "northwest"],
856
857	SDLK_UP, [1, "north"],
858	SDLK_RIGHT, [3, "east"],
859	SDLK_DOWN, [5, "south"],
860	SDLK_LEFT, [7, "west"],
861	);
862
863	sub key_down {
864	my ($self, $ev) = @_;
865
866	my $mod = $ev->key_mod;
867	my $sym = $ev->key_sym;
868
869	if ($sym == SDLK_KP5) {
870	$::CONN->send ("command stay fire");
871	} elsif (exists $DIR{$sym}) {
872	if ($mod & KMOD_SHIFT) {
873	$self->{shft}++;
874	$::CONN->send ("command fire $DIR{$sym}[0]");
875	} elsif ($mod & KMOD_CTRL) {
876	$self->{ctrl}++;
877	$::CONN->send ("command run $DIR{$sym}[0]");
878	} else {
879	$::CONN->send ("command $DIR{$sym}[1]");
880	}
881	}
882	}
883
884	sub key_up {
885	my ($self, $ev) = @_;
886
887	my $mod = $ev->key_mod;
888	my $sym = $ev->key_sym;
889
890	if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
891	$::CONN->send ("command fire_stop");
892	}
893	if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
894	$::CONN->send ("command run_stop");
895	}
896	}
897
898	#############################################################################
899
900	package Crossfire::Client::Widget::Animator;
901
902	use SDL::OpenGL;
903
904	our @ISA = Crossfire::Client::Widget::Bin::;
905
906	sub moveto {
907	my ($self, $x, $y) = @_;
908
909	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
910	$self->{speed} = 0.2;
911	$self->{time} = 1;
912
913	::animation_start $self;
914	}
915
916	sub animate {
917	my ($self, $interval) = @_;
918
919	$self->{time} -= $interval * $self->{speed};
920	if ($self->{time} <= 0) {
921	$self->{time} = 0;
922	::animation_stop $self;
923	}
924
925	my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
926
927	$self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
928	$self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
929	}
930
931	sub _draw {
932	my ($self) = @_;
933
934	glPushMatrix;
935	glRotate $self->{time} * 10000, 0, 1, 0;
936	$self->{children}[0]->draw;
937	glPopMatrix;
938	}
939
940	1;
941