--- deliantra/Deliantra-Client/DC/UI.pm	2006/04/24 06:57:39	1.164
+++ deliantra/Deliantra-Client/DC/UI.pm	2006/05/03 19:56:05	1.184
@@ -26,8 +26,16 @@
                $tip = $tip->($widget) if CODE:: eq ref $tip;
                
                $TOOLTIP->set_markup ($widget->{tooltip});
-               $TOOLTIP->move ($widget->coord2global ($widget->{w}, 0));
+
                $TOOLTIP->show;
+
+               my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
+
+               if ($x + $TOOLTIP->{w} > $::WIDTH) {
+                  ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0);
+               }
+
+               $TOOLTIP->move ($x, $y);
             }
 
             return;
@@ -231,6 +239,7 @@
 
       $self->size_allocate ($w, $h);
       $self->update;
+      $self->emit (size_allocate => $w, $h);
    }
 }
 
@@ -238,6 +247,19 @@
    # nothing to be done
 }
 
+sub children {
+}
+
+# call when resolution changes etc.
+sub reconfigure {
+   my ($self) = @_;
+
+   $_->reconfigure
+      for $self->children;
+
+   $_->check_size;
+}
+
 sub set_max_size {
    my ($self, $w, $h) = @_;
 
@@ -249,6 +271,9 @@
 sub _topleft {
    my ($self, $x, $y) = @_;
 
+   $self->{parent}
+      or Carp::confess "no parent widget in _topleft\n";#d#
+
    $self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});
 }
 
@@ -494,7 +519,11 @@
 
    my $children = delete $arg{children} || [];
 
-   my $self = $class->SUPER::new (children => [], can_events => 0, %arg);
+   my $self = $class->SUPER::new (
+      children   => [],
+      can_events => 0,
+      %arg,
+   );
    $self->add ($_) for @$children;
 
    $self
@@ -513,6 +542,11 @@
    ];
 
    $child->check_size;
+   $self->update;
+}
+
+sub children {
+   @{ $_[0]{children} }
 }
 
 sub remove {
@@ -537,6 +571,9 @@
       delete $_->{parent};
       $_->hide;
    }
+
+   $self->check_size;
+   $self->update;
 }
 
 sub find_widget {
@@ -621,27 +658,37 @@
 sub update {
    my ($self) = @_;
 
-   # we want to do this delayed...
-   $self->render_chld;
+   $ROOT->on_refresh ($self => sub { $self->render_child });
    $self->SUPER::update;
 }
 
-sub render_chld {
-   my ($self) = @_;
+sub size_allocate {
+   my ($self, $w, $h) = @_;
 
-   $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
-      glClearColor 0, 0, 0, 1;
-      glClear GL_COLOR_BUFFER_BIT;
-      $self->child->draw;
-   };
+   $self->SUPER::size_allocate ($w, $h);
+   $self->update;
 }
 
-sub size_allocate {
-   my ($self, $w, $h) = @_;
+sub _render {
+   $_[0]{children}[0]->draw;
+}
+
+sub render_child {
+   my ($self) = @_;
 
-   $self->child->configure (0, 0, $w, $h);
+   $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
+      glClearColor 0, 0, 0, 0;
+      glClear GL_COLOR_BUFFER_BIT;
 
-   $self->render_chld;
+      $self->_render;
+#      glColorMask 1, 1, 1, 0;
+#      glEnable GL_BLEND;
+#      glBlendFunc GL_SRC_ALPHA, GL_ZERO;
+#      glRasterPos 0, 0;
+#      glCopyPixels 0, 0, $self->{w}, $self->{h};
+#      glDisable GL_BLEND;
+#      glColorMask 1, 1, 1, 1;
+   };
 }
 
 sub _draw {
@@ -653,9 +700,10 @@
       or return;
 
    glEnable GL_BLEND;
-   glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
+   glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
    glEnable GL_TEXTURE_2D;
    glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
+   glColor 0, 0, 0, 1;
 
    $tex->draw_quad (0, 0, $w, $h);
 
@@ -669,23 +717,91 @@
 
 our @ISA = CFClient::UI::Window::;
 
-sub new { die }
-
 sub size_request {
    my ($self) = @_;
 
    @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
-   $self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
+   $self->child->configure (0, 0, @$self{qw(child_w child_h)});
 
    @$self{qw(child_w child_h)}
 }
 
-sub _draw {
+sub size_allocate {
+   my ($self, $w, $h) = @_;
+
+   $self->update;
+}
+
+sub set_offset {
+   my ($self, $x, $y) = @_;
+
+   $self->{view_x} = int $x;
+   $self->{view_y} = int $y;
+
+   $self->update;
+}
+
+# hmm, this does not work for topleft of $self... but we should not aks for that
+sub _topleft {
+   my ($self, $x, $y) = @_;
+
+   $self->SUPER::_topleft ($x - $self->{view_x}, $y - $self->{view_y})
+}
+
+sub find_widget {
+   my ($self, $x, $y) = @_;
+
+   if (   $x >= $self->{x} && $x < $self->{x} + $self->{w}
+       && $y >= $self->{y} && $y < $self->{y} + $self->{h}
+   ) {
+       $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
+   } else {
+      $self->CFClient::UI::Base::find_widget ($x, $y)
+   }
+}
+
+sub _render {
    my ($self) = @_;
 
-   $self->{children}[1]->draw;
+   CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
+
+   $self->SUPER::_render;
 }
 
+#############################################################################
+
+package CFClient::UI::ScrolledWindow;
+
+our @ISA = CFClient::UI::HBox::;
+
+sub new {
+   my $class = shift;
+
+   my $self;
+
+   my $slider = new CFClient::UI::Slider
+      vertical        => 1,
+      range           => [0, 0, 1, 0.01], # HACK fix
+      connect_changed => sub {
+         $self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h}));
+      },
+   ;
+
+   $self = $class->SUPER::new (
+      vp     => (new CFClient::UI::ViewPort),
+      slider => $slider,
+      @_,
+   );
+
+   $self->{vp}->add ($self->{scrolled});
+   $self->add ($self->{vp});
+   $self->add ($self->{slider});
+
+   $self
+}
+
+#TODO# update range on size_allocate depeneing on child
+# update viewport offset on scroll
 
 #############################################################################
 
@@ -752,8 +868,8 @@
    my $self = $class->SUPER::new (
       bg         => [1, 1, 1, 1],
       border_bg  => [1, 1, 1, 1],
-      border     => 0.8,
-      can_events => 0,
+      border     => 0.6,
+      can_events => 1,
       @_
    );
 
@@ -761,7 +877,7 @@
       align    => 0,
       valign   => 1,
       text     => $self->{title},
-      fontsize => 1;
+      fontsize => $self->{border};
 
    $self
 }
@@ -796,27 +912,33 @@
 sub button_down {
    my ($self, $ev, $x, $y) = @_;
 
+   my ($w, $h) = @$self{qw(w h)};
    my $border = $self->border;
 
-   if ($x < $self->{w} && $x >= $self->{w} - $border
-       && $y < $self->{h} && $y >= $self->{h} - $border) {
+   my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
+   my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
 
+   if ($lr & $td) {
+      my ($wx, $wy) = ($self->{x}, $self->{y});
       my ($ox, $oy) = ($ev->{x}, $ev->{y});
       my ($bw, $bh) = ($self->{w}, $self->{h});
 
+      my $mx = $x < $border;
+      my $my = $y < $border;
+
       $self->{motion} = sub {
          my ($ev, $x, $y) = @_;
 
-         ($x, $y) = ($ev->{x}, $ev->{y});
+         my $dx = $ev->{x} - $ox;
+         my $dy = $ev->{y} - $oy;
 
-         $self->{user_w} = $bw + $x - $ox;
-         $self->{user_h} = $bh + $y - $oy;
+         $self->{user_w} = $bw + $dx * ($mx ? -1 : 1);
+         $self->{user_h} = $bh + $dy * ($my ? -1 : 1);
+         $self->move ($wx + $dx * $mx, $wy + $dy * $my);
          $self->check_size;
       };
 
-   } elsif ($x >= 0 && $x < $self->{w}
-            && $y >= 0 && $y < $border) {
-
+   } elsif ($lr ^ $td) {
       my ($ox, $oy) = ($ev->{x}, $ev->{y});
       my ($bx, $by) = ($self->{x}, $self->{y});
 
@@ -862,23 +984,26 @@
    $tex[2]->draw_quad ($w - $border, $border, $border, $ch);
    $tex[4]->draw_quad (0, $h - $border, $w, $border);
 
-   my $bg = $tex[0];
+   if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
+      my $bg = $tex[0];
 
-   # TODO: repeat texture not scale
-   my $rep_x = $cw / $bg->{w};
-   my $rep_y = $ch / $bg->{h};
-
-   glColor @{ $self->{bg} };
-
-   $bg->{s} = $rep_x;
-   $bg->{t} = $rep_y;
-   $bg->{wrap_mode} = 1;
-   $bg->draw_quad ($border, $border, $cw, $ch);
+      # TODO: repeat texture not scale
+      my $rep_x = $cw / $bg->{w};
+      my $rep_y = $ch / $bg->{h};
+
+      glColor @{ $self->{bg} };
+
+      $bg->{s} = $rep_x;
+      $bg->{t} = $rep_y;
+      $bg->{wrap_mode} = 1;
+      $bg->draw_quad ($border, $border, $cw, $ch);
 
-   glDisable GL_TEXTURE_2D;
-   glDisable GL_BLEND;
+      glDisable GL_TEXTURE_2D;
+      glDisable GL_BLEND;
+   }
 
    $self->{title}->draw if $self->{title};
+
    $self->child->draw;
 }
 
@@ -910,13 +1035,18 @@
    $child->check_size;
 }
 
+sub children {
+   grep $_, map @$_, grep $_, @{ $_[0]{children} }
+}
+
 # TODO: move to container class maybe? send childs a signal on removal?
 sub clear {
    my ($self) = @_;
 
-   my $children = delete $self->{children};
+   my @children = $self->children;
+   delete $self->{children};
    
-   for (grep $_, map @$_, grep $_, @$children) {
+   for (@children) {
       delete $_->{parent};
       $_->hide;
    }
@@ -1187,24 +1317,43 @@
    $_[1]
 }
 
+sub update {
+   my ($self) = @_;
+
+   delete $self->{texture};
+   $self->SUPER::update;
+}
+
+sub reconfigure {
+   my ($self) = @_;
+
+   delete $self->{texture};
+}
+
 sub set_text {
    my ($self, $text) = @_;
 
+   return if $self->{text} eq "T$text";
+   $self->{text} = "T$text";
+
    $self->{layout}->set_text ($text);
 
    delete $self->{texture};
-   $self->check_size;
    $self->update;
+   $self->check_size;
 }
 
 sub set_markup {
    my ($self, $markup) = @_;
 
+   return if $self->{text} eq "M$markup";
+   $self->{text} = "M$markup";
+
    $self->{layout}->set_markup ($markup);
 
    delete $self->{texture};
-   $self->check_size;
    $self->update;
+   $self->check_size;
 }
 
 sub size_request {
@@ -1464,9 +1613,35 @@
    my $sym = $ev->{sym};
 
    if ($sym == 13) {
-      $self->emit (activate => $self->get_text);
+      unshift @{$self->{history}},
+         my $txt = $self->get_text;
+      $self->{history_pointer} = -1;
+      $self->{history_saveback} = '';
+      $self->emit (activate => $txt);
       $self->update;
 
+   } elsif ($sym == CFClient::SDLK_UP) {
+      if ($self->{history_pointer} < 0) {
+         $self->{history_saveback} = $self->get_text;
+      }
+      if (@{$self->{history} || []} > 0) {
+         $self->{history_pointer}++;
+         if ($self->{history_pointer} >= @{$self->{history} || []}) {
+            $self->{history_pointer} = @{$self->{history} || []} - 1;
+         }
+         $self->set_text ($self->{history}->[$self->{history_pointer}]);
+      }
+
+   } elsif ($sym == CFClient::SDLK_DOWN) {
+      $self->{history_pointer}--;
+      $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
+
+      if ($self->{history_pointer} >= 0) {
+         $self->set_text ($self->{history}->[$self->{history_pointer}]);
+      } else {
+         $self->set_text ($self->{history_saveback});
+      }
+
    } else {
       $self->SUPER::key_down ($ev);
    }
@@ -1712,7 +1887,10 @@
 sub set_max {
    my ($self, $max) = @_;
 
+   return if $self->{max_val} == $max;
+
    $self->{max_val} = $max;
+   $self->update;
 }
 
 sub set_value {
@@ -1721,9 +1899,9 @@
    $self->set_max ($max)
       if defined $max;
 
-   $max = $self->{max_val};
-   $self->{val} = $val;
+   return if $self->{val} == $val;
 
+   $self->{val} = $val;
    $self->update;
 }
 
@@ -1796,8 +1974,9 @@
    my ($class, %arg) = @_;
 
    my $self = $class->SUPER::new (
-      tooltip   => $arg{type},
-      can_hover => 1,
+      tooltip    => $arg{type},
+      can_hover  => 1,
+      can_events => 1,
       %arg,
    );
 
@@ -1815,6 +1994,13 @@
    $self->{max}  ->set_fontsize ($fsize);
 }
 
+sub set_max {
+   my ($self, $max) = @_;
+
+   $self->{gauge}->set_max ($max);
+   $self->{max}->set_text ($max);
+}
+
 sub set_value {
    my ($self, $val, $max) = @_;
 
@@ -1825,13 +2011,6 @@
    $self->{value}->set_text ($val);
 }
 
-sub set_max {
-   my ($self, $max) = @_;
-
-   $self->{gauge}->set_max ($max);
-   $self->{max}->set_text ($max);
-}
-
 #############################################################################
 
 package CFClient::UI::Slider;
@@ -1858,8 +2037,8 @@
       fg        => [1, 1, 1],
       active_fg => [0, 0, 0],
       range     => [0, 0, 100, 10],
-      req_w     => 20,
-      req_h     => 20,
+      req_w     => $::WIDTH / 80,
+      req_h     => $::WIDTH / 80,
       vertical  => 0,
       can_hover => 1,
       inner_pad => 5,
@@ -1993,9 +2172,7 @@
       ],
    );
 
-   $self->{children}[1]->connect (changed => sub {
-      $self->update;
-   });
+   $self->{children}[1]->connect (changed => sub { $self->update });
 
    $self
 }
@@ -2013,7 +2190,7 @@
    my $layout = $self->{layout};
 
    $layout->set_height ($self->{fontsize} * $::FONTSIZE);
-   $layout->set_width ($self->{w});
+   $layout->set_width ($self->{children}[0]{w});
    $layout->set_text ($text);
    
    ($layout->size)[1]
@@ -2076,8 +2253,8 @@
          delete $self->{texture};
       }
 
-      $self->{texture} ||= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
-         glClearColor 0, 0, 0, 1;
+      $self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {
+         glClearColor 0, 0, 0, 0;
          glClear GL_COLOR_BUFFER_BIT;
 
          glEnable GL_BLEND;
@@ -2119,12 +2296,14 @@
 sub _draw {
    my ($self) = @_;
 
-   if ($self->{texture}) {
-      glEnable GL_TEXTURE_2D;
-      glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
-      $self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});
-      glDisable GL_TEXTURE_2D;
-   }
+   glEnable GL_BLEND;
+   glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
+   glEnable GL_TEXTURE_2D;
+   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
+   glColor 1, 1, 1, 1;
+   $self->{texture}->draw_quad (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
+   glDisable GL_TEXTURE_2D;
+   glDisable GL_BLEND;
 
    $self->{children}[1]->draw;
 
@@ -2303,11 +2482,12 @@
    (32, 8)
 }
 
-sub draw {
+sub _draw {
    my ($self) = @_;
 
    my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];
 
+   # TODO animation
    if ($tex) {
       glEnable GL_BLEND;
       glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
@@ -2322,6 +2502,78 @@
 
 #############################################################################
 
+package CFClient::UI::Menu;
+
+our @ISA = CFClient::UI::FancyFrame::;
+
+use CFClient::OpenGL;
+
+sub new {
+   my $class = shift;
+
+   my $self = $class->SUPER::new (
+      items => [],
+      z     => 100,
+      @_,
+   );
+
+   $self->add ($self->{vbox} = new CFClient::UI::VBox);
+
+   for my $item (@{ $self->{items} }) {
+      my ($widget, $cb) = @$item;
+
+      # handle various types of items, only text for now
+      if (!ref $widget) {
+         $widget = new CFClient::UI::Label
+            can_hover  => 1,
+            can_events => 1,
+            text       => $widget;
+      }
+
+      $self->{item}{$widget} = $item;
+
+      $self->{vbox}->add ($widget);
+   }
+
+   $self
+}
+
+# popup given the event (must be a mouse button down event currently)
+sub popup {
+   my ($self, $ev) = @_;
+
+   $self->emit ("popdown");
+
+   # maybe save $GRAB? must be careful about events...
+   $GRAB = $self;
+   $self->{button} = $ev->{button};
+
+   $self->show;
+   $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
+}
+
+sub mouse_motion {
+   my ($self, $ev, $x, $y) = @_;
+
+   # TODO: should use vbox->find_widget or so
+   $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
+   $self->{hover} = $self->{item}{$HOVER};
+}
+
+sub button_up {
+   my ($self, $ev, $x, $y) = @_;
+
+   if ($ev->{button} == $self->{button}) {
+      undef $GRAB;
+      $self->hide;
+
+      $self->emit ("popdown");
+      $self->{hover}[1]->() if $self->{hover};
+   }
+}
+
+#############################################################################
+
 package CFClient::UI::Root;
 
 our @ISA = CFClient::UI::Container::;
@@ -2402,6 +2654,111 @@
 }
 
 #############################################################################
+
+package CFClient::UI::InventoryItem;
+
+our @ISA = CFClient::UI::HBox::;
+
+sub new {
+   my $class = shift;
+
+   my %args = @_;
+
+   my $item = $args{item};
+
+   my $desc = $item->{nrof} < 2
+      ? $item->{name}
+      : "$item->{nrof} $item->{name_pl}";
+
+
+   my $self = $class->SUPER::new (
+      can_hover => 1,
+      can_events => 1,
+      tooltip => (CFClient::UI::Label->escape ($desc)
+                 . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
+      connect_button_down => sub {
+         my ($self, $ev, $x, $y) = @_;
+
+         # todo: maybe put examine on 1? but should just be a tooltip :(
+         if ($ev->{button} == 1) {
+            $::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
+         } elsif ($ev->{button} == 2) {
+            $::CONN->send ("apply $item->{tag}");
+         } elsif ($ev->{button} == 3) {
+            CFClient::UI::Menu->new (
+               items => [
+                  ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
+                  [
+                     $item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
+                     sub { $::CONN->send ("lock $item->{tag}") },
+                  ],
+                  ["mark", sub { $::CONN->send ("mark $item->{tag}") }],
+                  ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
+                  ["drop", sub { $::CONN->send ("move 0 $item->{tag} 0") }],
+               ],
+            )->popup ($ev);
+         }
+
+         1
+      },
+      %args
+   );
+   $self->add(new CFClient::UI::Face
+      can_events => 0,
+      face       => $item->{face},
+      anim       => $item->{anim},
+      animspeed  => $item->{animspeed});
+   $self->add(new CFClient::UI::Label
+      can_events => 0,
+      text => $desc);
+
+   $self
+}
+
+#############################################################################
+
+package CFClient::UI::Inventory;
+
+our @ISA = CFClient::UI::ScrolledWindow::;
+
+sub new {
+   my $class = shift;
+
+   my $self = $class->SUPER::new (
+      scrolled => (new CFClient::UI::VBox),
+      @_,
+   );
+
+   $self
+}
+
+sub set_items {
+   my ($self, $items) = @_;
+
+   $self->{scrolled}->clear;
+   return unless $items;
+
+   my @items = sort { $a->{type} <=> $b->{type} } @$items;
+
+   $self->{real_items} = \@items;
+
+   for my $item (@items) {
+      my $desc = $item->{nrof} < 2
+                     ? $item->{name}
+                     : "$item->{nrof} $item->{name_pl}";
+
+      $self->{scrolled}->add (new CFClient::UI::InventoryItem item => $item);
+   }
+
+#   $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
+}
+
+sub size_request {
+   my ($self) = @_;
+   ($self->{req_w}, $self->{req_h});
+}
+
+#############################################################################
 
 package CFClient::UI;