--- deliantra/Deliantra-Client/DC/UI.pm	2006/07/23 02:44:06	1.329
+++ deliantra/Deliantra-Client/DC/UI.pm	2006/07/23 04:37:51	1.330
@@ -81,11 +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});
 
-   if (!$BUTTON_STATE) {
+   unless ($BUTTON_STATE) {
       my $widget = $ROOT->find_widget ($x, $y);
 
       $GRAB = $widget;
@@ -96,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->();
    }
 }
@@ -126,16 +147,9 @@
 
    my $widget = $GRAB || $ROOT->find_widget ($x, $y);
 
-   if ($widget != $HOVER) {
-      my $hover = $HOVER; $HOVER = $widget;
+   check_hover $widget;
 
-      $hover->update if $hover && $hover->{can_hover};
-      $HOVER->update if $HOVER && $HOVER->{can_hover};
-
-      $TOOLTIP_WATCHER->start;
-   }
-
-   $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
+   $HOVER->emit (mouse_motion => $ev)
       if $HOVER;
 }
 
@@ -195,6 +209,14 @@
 
 #############################################################################
 
+package CFClient::UI::Event;
+
+sub xy {
+   $_[1]->coord2local ($_[0]{x}, $_[0]{y})
+}
+
+#############################################################################
+
 package CFClient::UI::Base;
 
 use strict;
@@ -458,6 +480,7 @@
 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) = @_;
@@ -476,12 +499,17 @@
 sub emit {
    my ($self, $signal, @args) = @_;
 
+   my @append
+      = ref $args[0] && $args[0]->isa ("CFClient::UI::Event")
+        ? $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 {
@@ -981,8 +1009,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,
    );
 
@@ -1000,12 +1029,14 @@
    $self->{vp}->add ($self->{child} = $widget);
 }
 
-sub invoke_button_up {
+sub invoke_mouse_wheel {
    my ($self, $ev) = @_;
 
-   warn "button up $ev->{button}\n";#d#
-   
-   0
+   return 0 unless $ev->{dy}; # only vertical movements
+
+   $self->{slider}->emit (mouse_wheel => $ev);
+
+   1
 }
 
 sub update_slider {
@@ -2463,6 +2494,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.1);
+
+   ! ! $delta
+}
+
 sub update {
    my ($self) = @_;
 
@@ -2571,7 +2612,7 @@
 
    my $self = $class->SUPER::new (
       fontsize   => 1,
-      can_events => 0,
+      can_events => 1,
       indent     => 0,
       #font      => default_font
       @_,
@@ -2623,6 +2664,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) = @_;