--- deliantra/Deliantra-Client/DC/UI.pm	2006/07/22 13:43:05	1.328
+++ deliantra/Deliantra-Client/DC/UI.pm	2006/07/24 04:24:43	1.337
@@ -81,13 +81,24 @@
       if $FOCUS;
 }
 
+sub check_hover {
+   my ($widget) = @_;
+
+   if ($widget != $HOVER) {
+      my $hover = $HOVER; $HOVER = $widget;
+
+      $hover->update if $hover && $hover->{can_hover};
+      $HOVER->update if $HOVER && $HOVER->{can_hover};
+
+      $TOOLTIP_WATCHER->start;
+   }
+}
+
 sub feed_sdl_button_down_event {
    my ($ev) = @_;
    my ($x, $y) = ($ev->{x}, $ev->{y});
 
-   warn "button down $ev->{button}\n";#d#
-
-   if (!$BUTTON_STATE) {
+   unless ($BUTTON_STATE) {
       my $widget = $ROOT->find_widget ($x, $y);
 
       $GRAB = $widget;
@@ -98,26 +109,34 @@
 
    $BUTTON_STATE |= 1 << ($ev->{button} - 1);
 
-   $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
-      if $GRAB;
+   if ($GRAB) {
+      if ($ev->{button} == 4 || $ev->{button} == 5) {
+         # mousewheel
+         $ev->{dx} = 0;
+         $ev->{dy} = $ev->{button} * 2 - 9;
+         $GRAB->emit (mouse_wheel => $ev);
+      } else {
+         $GRAB->emit (button_down => $ev)
+      }
+   }
 }
 
 sub feed_sdl_button_up_event {
    my ($ev) = @_;
-   my ($x, $y) = ($ev->{x}, $ev->{y});
 
-   my $widget = $GRAB || $ROOT->find_widget ($x, $y);
+   my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
 
    $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
 
-   $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
-      if $GRAB;
+   $GRAB->emit (button_up => $ev)
+      if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
 
-   if (!$BUTTON_STATE) {
+   unless ($BUTTON_STATE) {
       my $grab = $GRAB; undef $GRAB;
       $grab->update if $grab;
       $GRAB->update if $GRAB;
 
+      check_hover $widget;
       $TOOLTIP_WATCHER->cb->();
    }
 }
@@ -128,16 +147,9 @@
 
    my $widget = $GRAB || $ROOT->find_widget ($x, $y);
 
-   if ($widget != $HOVER) {
-      my $hover = $HOVER; $HOVER = $widget;
-
-      $hover->update if $hover && $hover->{can_hover};
-      $HOVER->update if $HOVER && $HOVER->{can_hover};
-
-      $TOOLTIP_WATCHER->start;
-   }
+   check_hover $widget;
 
-   $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
+   $HOVER->emit (mouse_motion => $ev)
       if $HOVER;
 }
 
@@ -197,6 +209,14 @@
 
 #############################################################################
 
+package CFClient::UI::Event;
+
+sub xy {
+   $_[1]->coord2local ($_[0]{x}, $_[0]{y})
+}
+
+#############################################################################
+
 package CFClient::UI::Base;
 
 use strict;
@@ -349,8 +369,8 @@
    if ($self->{aspect}) {
       my ($ow, $oh) = ($w, $h);
 
-      $w = List::Util::min $w, int $h * $self->{aspect};
-      $h = List::Util::min $h, int $w / $self->{aspect};
+      $w = List::Util::min $w, CFClient::ceil $h * $self->{aspect};
+      $h = List::Util::min $h, CFClient::ceil $w / $self->{aspect};
 
       # use alignment to adjust x, y
 
@@ -411,6 +431,8 @@
 sub coord2local {
    my ($self, $x, $y) = @_;
 
+   Carp::confess unless $self->{parent};#d#
+
    $self->{parent}->coord2local ($x  - $self->{x}, $y - $self->{y})
 }
 
@@ -418,6 +440,8 @@
 sub coord2global {
    my ($self, $x, $y) = @_;
 
+   Carp::confess unless $self->{parent};#d#
+
    $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
 }
 
@@ -460,14 +484,13 @@
 sub invoke_button_up    { 0 }
 sub invoke_key_down     { 0 }
 sub invoke_key_up       { 0 }
+sub invoke_mouse_wheel  { 0 }
 
 sub invoke_button_down {
    my ($self, $ev, $x, $y) = @_;
 
    $self->grab_focus;
 
-   warn "button down $ev->{button} $x $y\n";#d#
-
    0
 }
 
@@ -475,15 +498,36 @@
    my ($self, $signal, $cb) = @_;
 
    push @{ $self->{signal_cb}{$signal} }, $cb;
+
+   defined wantarray and CFClient::guard {
+      @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
+         @{ $self->{signal_cb}{$signal} };
+   }
 }
 
+my %has_coords = (
+   button_down  => 1,
+   button_up    => 1,
+   mouse_motion => 1,
+   mouse_wheel  => 1,
+);
+
 sub emit {
    my ($self, $signal, @args) = @_;
 
+   # I do not really like this solution, but I dislike duplication
+   # and needlessly verbose code, too.
+   my @append
+      = $has_coords{$signal}
+        ? $args[0]->xy ($self)
+        : ();
+
+   #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
+
    #d##TODO# stop propagating at first true, do not use sum
-   (List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before
-      || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args)             # closure
-      || ($self->{parent} && $self->{parent}->emit ($signal, @args))              # parent
+   (List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
+      || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append)             # closure
+      || ($self->{parent} && $self->{parent}->emit ($signal, @args))                       # parent
 }
 
 sub find_widget {
@@ -689,6 +733,14 @@
    $self
 }
 
+sub realloc {
+   my ($self) = @_;
+
+   $self->{force_realloc} = 1;
+   $self->{force_size_alloc} = 1;
+   $self->SUPER::realloc;
+}
+
 sub add {
    my ($self, @widgets) = @_;
 
@@ -983,8 +1035,9 @@
    ;
 
    $self = $class->SUPER::new (
-      vp     => (new CFClient::UI::ViewPort expand => 1),
-      slider => $slider,
+      vp         => (new CFClient::UI::ViewPort expand => 1),
+      can_events => 1,
+      slider     => $slider,
       %arg,
    );
 
@@ -1002,12 +1055,14 @@
    $self->{vp}->add ($self->{child} = $widget);
 }
 
-sub invoke_button_down {
+sub invoke_mouse_wheel {
    my ($self, $ev) = @_;
 
-   warn "button down $ev->{button}\n";#d#
-   
-   0
+   return 0 unless $ev->{dy}; # only vertical movements
+
+   $self->{slider}->emit (mouse_wheel => $ev);
+
+   1
 }
 
 sub update_slider {
@@ -1311,11 +1366,16 @@
 }
 
 sub add {
-   my ($self, $x, $y, $child) = @_;
+   my ($self) = shift;
 
-   $child->set_parent ($self);
-   $self->{children}[$y][$x] = $child;
+   while (@_) {
+      my ($x, $y, $child) = splice @_, 0, 3, ();
+      $child->set_parent ($self);
+      $self->{children}[$y][$x] = $child;
+   }
 
+   $self->{force_realloc} = 1;
+   $self->{force_size_alloc} = 1;
    $self->realloc;
 }
 
@@ -1577,16 +1637,6 @@
    $self
 }
 
-sub escape($) {
-   local $_ = $_[0];
-
-   s/&/&amp;/g;
-   s/>/&gt;/g;
-   s/</&lt;/g;
-
-   $_
-}
-
 sub update {
    my ($self) = @_;
 
@@ -2005,42 +2055,6 @@
 
 #############################################################################
 
-package CFClient::UI::ImageButton;
-
-our @ISA = CFClient::UI::Image::;
-
-use CFClient::OpenGL;
-
-my %textures;
-
-sub new {
-   my $class = shift;
-
-   my $self = $class->SUPER::new (
-      padding_x  => 4,
-      padding_y  => 4,
-      fg         => [1, 1, 1],
-      active_fg  => [0, 0, 1],
-      can_hover  => 1,
-      align      => 0,
-      valign     => 0,
-      can_events => 1,
-      @_
-   );
-}
-
-sub invoke_button_up {
-   my ($self, $ev, $x, $y) = @_;
-
-   $self->emit ("activate")
-      if $x >= 0 && $x < $self->{w}
-         && $y >= 0 && $y < $self->{h};
-
-   1
-}
-
-#############################################################################
-
 package CFClient::UI::CheckBox;
 
 our @ISA = CFClient::UI::DrawBG::;
@@ -2145,6 +2159,21 @@
    $self
 }
 
+sub STORABLE_freeze {
+   my ($self, $cloning) = @_;
+
+   $self->{path}
+      or die "cannot serialise CFClient::UI::Image on non-loadable images\n";
+
+   $self->{path}
+}
+
+sub STORABLE_attach {
+   my ($self, $cloning, $path) = @_;
+
+   $self->new (path => $path)
+}
+
 sub size_request {
    my ($self) = @_;
 
@@ -2168,13 +2197,49 @@
    glEnable GL_TEXTURE_2D;
    glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
 
-   $tex->draw_quad_alpha (0, 0, $w, $h);
+   $tex->draw_quad (0, 0, $w, $h);
 
    glDisable GL_TEXTURE_2D;
 }
 
 #############################################################################
 
+package CFClient::UI::ImageButton;
+
+our @ISA = CFClient::UI::Image::;
+
+use CFClient::OpenGL;
+
+my %textures;
+
+sub new {
+   my $class = shift;
+
+   my $self = $class->SUPER::new (
+      padding_x  => 4,
+      padding_y  => 4,
+      fg         => [1, 1, 1],
+      active_fg  => [0, 0, 1],
+      can_hover  => 1,
+      align      => 0,
+      valign     => 0,
+      can_events => 1,
+      @_
+   );
+}
+
+sub invoke_button_up {
+   my ($self, $ev, $x, $y) = @_;
+
+   $self->emit ("activate")
+      if $x >= 0 && $x < $self->{w}
+         && $y >= 0 && $y < $self->{h};
+
+   1
+}
+
+#############################################################################
+
 package CFClient::UI::VGauge;
 
 our @ISA = CFClient::UI::Base::;
@@ -2465,6 +2530,16 @@
    1
 }
 
+sub invoke_mouse_wheel {
+   my ($self, $ev) = @_;
+
+   my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
+
+   $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * 0.2);
+
+   ! ! $delta
+}
+
 sub update {
    my ($self) = @_;
 
@@ -2573,7 +2648,7 @@
 
    my $self = $class->SUPER::new (
       fontsize   => 1,
-      can_events => 0,
+      can_events => 1,
       indent     => 0,
       #font      => default_font
       @_,
@@ -2625,6 +2700,16 @@
    $self->SUPER::invoke_size_allocate ($w, $h)
 }
 
+sub invoke_mouse_wheel {
+   my ($self, $ev) = @_;
+
+   return 0 unless $ev->{dy}; # only vertical movements
+
+   $self->{children}[1]->emit (mouse_wheel => $ev);
+
+   1
+}
+
 sub get_layout {
    my ($self, $para) = @_;
 
@@ -2930,12 +3015,16 @@
       my $widget = $self->{owner}
          or return;
 
-      my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
+      if ($widget->{visible}) {
+         my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
 
-      ($x, $y) = $widget->coord2global (-$self->{w}, 0)
-         if $x + $self->{w} > $self->{root}{w};
+         ($x, $y) = $widget->coord2global (-$self->{w}, 0)
+            if $x + $self->{w} > $self->{root}{w};
 
-      $self->move_abs ($x, $y);
+         $self->move_abs ($x, $y);
+      } else {
+         $self->hide;
+      }
    });
 }
 
@@ -2971,7 +3060,7 @@
 
 package CFClient::UI::Face;
 
-our @ISA = CFClient::UI::Base::;
+our @ISA = CFClient::UI::DrawBG::;
 
 use CFClient::OpenGL;
 
@@ -3018,6 +3107,8 @@
 
    return unless $::CONN;
 
+   $self->SUPER::_draw;
+
    my $face;
 
    if ($self->{frame}) {
@@ -3273,7 +3364,7 @@
 
 #############################################################################
 
-package CFClient::UI::Combobox;
+package CFClient::UI::Selector;
 
 use utf8;
 
@@ -3483,35 +3574,55 @@
 
    my $self = $class->SUPER::new (
       col_expand => [0, 1, 0],
+      items      => [],
       @_,
    );
 
+   $self->set_sort_order (undef);
+
    $self
 }
 
-sub set_items {
-   my ($self, $items) = @_;
+sub update_items {
+   my ($self) = @_;
 
    $self->clear;
-   return unless $items;
-
-   my @items = sort {
-      ($a->{type} <=> $b->{type})
-         or ($a->{name} cmp $b->{name})
-   } values %$items;
 
-   $self->{real_items} = \@items;
+   my @item = $self->{sort}->(@{ $self->{items} });
 
+   my @adds;
    my $row = 0;
-   for my $item (@items) {
+   for my $item ($self->{sort}->(@{ $self->{items} })) {
       CFClient::Item::update_widgets $item;
 
-      $self->add (0, $row, $item->{face_widget});
-      $self->add (1, $row, $item->{desc_widget});
-      $self->add (2, $row, $item->{weight_widget});
+      push @adds, 0, $row, $item->{face_widget};
+      push @adds, 1, $row, $item->{desc_widget};
+      push @adds, 2, $row, $item->{weight_widget};
 
       $row++;
    }
+
+   $self->add (@adds);
+}
+
+sub set_sort_order {
+   my ($self, $order) = @_;
+
+   $self->{sort} = $order ||= sub {
+      sort {
+         $a->{type} <=> $b->{type}
+            or $a->{name} cmp $b->{name}
+      } @_
+   };
+
+   $self->update_items;
+}
+
+sub set_items {
+   my ($self, $items) = @_;
+
+   $self->{items} = [$items ? values %$items : ()];
+   $self->update_items;
 }
 
 #############################################################################
@@ -3833,6 +3944,9 @@
          $w = max $widget->{min_w}, $w;
          $h = max $widget->{min_h}, $h;
 
+#         $w = min $self->{w} - $widget->{x}, $w if $self->{w};
+#         $h = min $self->{h} - $widget->{y}, $h if $self->{h};
+
          $w = min $widget->{max_w}, $w if exists $widget->{max_w};
          $h = min $widget->{max_h}, $h if exists $widget->{max_h};