[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.312 by root, Fri Jun 23 23:54:30 2006 UTC vs.
Revision 1.338 by root, Mon Jul 24 08:23:28 2006 UTC

 sub feed_sdl_key_up_event {
    $FOCUS->emit (key_up => $_[0])
       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;
       $GRAB->update if $GRAB;
       $TOOLTIP_WATCHER->cb->();
    }
    $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))
+   $GRAB->emit (button_up => $ev)
-      if $GRAB;
+      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->();
    }
 }
 sub feed_sdl_motion_event {
    my ($ev) = @_;
    my ($x, $y) = ($ev->{x}, $ev->{y});
    my $widget = $GRAB || $ROOT->find_widget ($x, $y);
-   if ($widget != $HOVER) {
+   check_hover $widget;
-      my $hover = $HOVER; $HOVER = $widget;
-      $hover->update if $hover && $hover->{can_hover};
+   $HOVER->emit (mouse_motion => $ev)
-      $HOVER->update if $HOVER && $HOVER->{can_hover};
-      $TOOLTIP_WATCHER->start;
-   }
-   $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
       if $HOVER;
 }
 # convert position array to integers
 sub harmonize {
       }
    }
    reconfigure_widgets;
+}
+#############################################################################
+package CFClient::UI::Event;
+sub xy {
+   $_[1]->coord2local ($_[0]{x}, $_[0]{y})
 }
 #############################################################################
 package CFClient::UI::Base;
    my ($self, $x, $y, $w, $h) = @_;
    if ($self->{aspect}) {
       my ($ow, $oh) = ($w, $h);
-      $w = List::Util::min $w, int $h * $self->{aspect};
+      $w = List::Util::min $w, CFClient::ceil $h * $self->{aspect};
-      $h = List::Util::min $h, int $w / $self->{aspect};
+      $h = List::Util::min $h, CFClient::ceil $w / $self->{aspect};
       # use alignment to adjust x, y
       $x += int 0.5 * ($ow - $w);
       $y += int 0.5 * ($oh - $h);
 # translate global coordinates to local coordinate system
 sub coord2local {
    my ($self, $x, $y) = @_;
+   Carp::confess unless $self->{parent};#d#
    $self->{parent}->coord2local ($x  - $self->{x}, $y - $self->{y})
 }
 # translate local coordinates to global coordinate system
 sub coord2global {
    my ($self, $x, $y) = @_;
+   Carp::confess unless $self->{parent};#d#
    $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
 }
 sub invoke_focus_in {
    my ($self) = @_;
    return if $FOCUS == $self;
    return unless $self->{can_focus};
-   my $focus = $FOCUS; $FOCUS = $self;
+   $FOCUS = $self;
-   $focus->update if $focus;
+   $self->update;
-   $FOCUS->update;
    0
 }
 sub invoke_focus_out {
    my ($self) = @_;
    return unless $FOCUS == $self;
-   my $focus = $FOCUS; undef $FOCUS;
+   undef $FOCUS;
-   $focus->update if $focus; #?
+   $self->update;
    $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
       unless $FOCUS;
    0
 }
 sub grab_focus {
    my ($self) = @_;
+   $FOCUS->emit ("focus_out") if $FOCUS;
    $self->emit ("focus_in");
 }
-sub invoke_mouse_motion { 1 }
+sub invoke_mouse_motion { 0 }
-sub invoke_button_up    { 1 }
+sub invoke_button_up    { 0 }
-sub invoke_key_down     { 1 }
+sub invoke_key_down     { 0 }
-sub invoke_key_up       { 1 }
+sub invoke_key_up       { 0 }
+sub invoke_mouse_wheel  { 0 }
 sub invoke_button_down {
    my ($self, $ev, $x, $y) = @_;
    $self->grab_focus;
-   1
+   0
 }
 sub connect {
    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
+   (List::Util::sum map $_->($self, @args, @append), @{$self->{signal_cb}{$signal} || []}) # before
-      || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args)             # closure
+      || ($self->can ("invoke_$signal") || sub { 1 })->($self, @args, @append)             # closure
-      || ($self->{parent} && $self->{parent}->emit ($signal, @args))              # parent
+      || ($self->{parent} && $self->{parent}->emit ($signal, @args))                       # parent
 }
 sub find_widget {
    my ($self, $x, $y) = @_;
 }
 sub DESTROY {
    my ($self) = @_;
+   return if CFClient::in_destruct;
    delete $WIDGET{$self+0};
    eval { $self->destroy };
    warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
 }
    $self->add (@$children)
       if $children;
    $self
+}
+sub realloc {
+   my ($self) = @_;
+   $self->{force_realloc} = 1;
+   $self->{force_size_alloc} = 1;
+   $self->SUPER::realloc;
 }
 sub add {
    my ($self, @widgets) = @_;
          $self->{vp}->set_offset (0, $_[1]);
       },
    ;
    $self = $class->SUPER::new (
-      vp     => (new CFClient::UI::ViewPort expand => 1),
+      vp         => (new CFClient::UI::ViewPort expand => 1),
+      can_events => 1,
-      slider => $slider,
+      slider     => $slider,
       %arg,
    );
    $self->SUPER::add ($self->{vp}, $self->{slider});
    $self->add ($child) if $child;
    $self
 }
+#TODO# update range on size_allocate depending on child
 sub add {
    my ($self, $widget) = @_;
    $self->{vp}->add ($self->{child} = $widget);
 }
+sub invoke_mouse_wheel {
+   my ($self, $ev) = @_;
+   return 0 unless $ev->{dy}; # only vertical movements
+   $self->{slider}->emit (mouse_wheel => $ev);
+   1
+}
+sub update_slider {
+   my ($self) = @_;
+   $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
+}
 sub update {
    my ($self) = @_;
    $self->SUPER::update;
-   # todo: overwrite size_allocate of child
+   $self->update_slider;
-   my $child = $self->{vp}->child;
-   $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
 }
 sub invoke_size_allocate {
    my ($self, $w, $h) = @_;
-   my $child = $self->{vp}->child;
+   $self->update_slider;
-   $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
    $self->SUPER::invoke_size_allocate ($w, $h)
 }
-#TODO# update range on size_allocate depending on child
-# update viewport offset on scroll
 #############################################################################
 package CFClient::UI::Frame;
    my $self = $class->SUPER::new (
       bg          => [1, 1, 1, 1],
       border_bg   => [1, 1, 1, 1],
       border      => 0.6,
       can_events  => 1,
-      min_w       => 16,
+      min_w       => 64,
-      min_h       => 16,
+      min_h       => 32,
       %arg,
    );
    $self->{title_widget} = new CFClient::UI::Label
       align    => 0,
    if ($self->{has_close_button}) {
       $self->{close_button} =
          new CFClient::UI::ImageButton
             path        => 'x1_close.png',
-            on_activate => sub { $self->hide };
+            on_activate => sub { $self->emit ("delete") };
       $self->CFClient::UI::Container::add ($self->{close_button});
    }
    $self
    $self->child->configure ($border, $border, $w, $h);
    $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
       if $self->{close_button};
+   1
+}
+sub invoke_delete {
+   my ($self) = @_;
+   $self->hide;
    1
 }
 sub invoke_button_down {
    my ($self, $ev, $x, $y) = @_;
 sub children {
    grep $_, map @$_, grep $_, @{ $_[0]{children} }
 }
 sub add {
-   my ($self, $x, $y, $child) = @_;
+   my ($self) = shift;
+   while (@_) {
+      my ($x, $y, $child) = splice @_, 0, 3, ();
-   $child->set_parent ($self);
+      $child->set_parent ($self);
-   $self->{children}[$y][$x] = $child;
+      $self->{children}[$y][$x] = $child;
+   }
+   $self->{force_realloc} = 1;
+   $self->{force_size_alloc} = 1;
    $self->realloc;
 }
 sub remove {
    my ($self, $child) = @_;
    }
    $self
 }
-sub escape($) {
-   local $_ = $_[0];
-   s/&/&amp;/g;
-   s/>/&gt;/g;
-   s/</&lt;/g;
-   $_
-}
 sub update {
    my ($self) = @_;
    delete $self->{texture};
    $self->SUPER::update;
    my ($self, $text) = @_;
    return if $self->{text} eq "T$text";
    $self->{text} = "T$text";
-   $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
    $self->{layout}->set_text ($text);
    delete $self->{size_req};
    $self->realloc;
    $self->update;
    return if $self->{text} eq "M$markup";
    $self->{text} = "M$markup";
    my $rgba = $markup =~ /span.*(?:foreground|background)/;
-   $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
    $self->{layout}->set_markup ($markup);
    delete $self->{size_req};
    $self->realloc;
    $self->update;
       my ($w, $h) = $self->{layout}->size;
       if (exists $self->{template}) {
          $self->{template}->set_font ($self->{font}) if $self->{font};
+         $self->{template}->set_width ($self->{max_w} || -1);
          $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
          my ($w2, $h2) = $self->{template}->size;
          $w = List::Util::max $w, $w2;
 sub set_fontsize {
    my ($self, $fontsize) = @_;
    $self->{fontsize} = $fontsize;
+   delete $self->{size_req};
    delete $self->{texture};
    $self->realloc;
 }
 sub reconfigure {
    my ($self) = @_;
    delete $self->{size_req};
+   delete $self->{texture};
    $self->SUPER::reconfigure;
 }
 sub _draw {
    my ($self) = @_;
    $self->SUPER::_draw; # draw background, if applicable
-   my $tex = $self->{texture} ||= do {
+   my $size = $self->{texture} ||= do {
       $self->{layout}->set_foreground (@{$self->{fg}});
       $self->{layout}->set_font ($self->{font}) if $self->{font};
       $self->{layout}->set_width ($self->{w});
       $self->{layout}->set_ellipsise ($self->{ellipsise});
       $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
       $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
-      new_from_layout CFClient::Texture $self->{layout}
+      [$self->{layout}->size]
    };
    unless (exists $self->{ox}) {
       $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
-                       : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
+                       : $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
-                       :                      ($self->{w} - $tex->{w}) * 0.5);
+                       :                      ($self->{w} - $size->[0]) * 0.5);
       $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
-                       : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
+                       : $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
-                       :                       ($self->{h} - $tex->{h}) * 0.5);
+                       :                       ($self->{h} - $size->[1]) * 0.5);
    };
-   glEnable GL_TEXTURE_2D;
-   my $w = List::Util::min $self->{w} + 4, $tex->{w};
+   my $w = List::Util::min $self->{w} + 4, $size->[0];
-   my $h = List::Util::min $self->{h} + 2, $tex->{h};
+   my $h = List::Util::min $self->{h} + 2, $size->[1];
-   if ($tex->{format} == GL_ALPHA) {
+   $self->{layout}->render ($self->{ox}, $self->{oy});
-      glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
-      glColor @{$self->{fg}};
-      $tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
-   } else {
-      glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
-      $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
-   }
-   glDisable GL_TEXTURE_2D;
 }
 #############################################################################
 package CFClient::UI::EntryBase;
    my $idx = $self->{layout}->xy_to_index ($x, $y);
    # byte-index to char-index
    my $text = $self->{text};
-   utf8::encode $text;
+   utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
-   $self->{cursor} = length substr $text, 0, $idx;
+   $self->{cursor} = length $text;
    $self->_set_text ($self->{text});
    $self->update;
    1
    $self->SUPER::_draw;
 }
 #############################################################################
+package CFClient::UI::CheckBox;
+our @ISA = CFClient::UI::DrawBG::;
+my @tex =
+      map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
+         qw(c1_checkbox_bg.png c1_checkbox_active.png);
+use CFClient::OpenGL;
+sub new {
+   my $class = shift;
+   $class->SUPER::new (
+      padding_x => 2,
+      padding_y => 2,
+      fg        => [1, 1, 1],
+      active_fg => [1, 1, 0],
+      bg        => [0, 0, 0, 0.2],
+      active_bg => [1, 1, 1, 0.5],
+      state     => 0,
+      can_hover => 1,
+      @_
+   )
+}
+sub size_request {
+   my ($self) = @_;
+   (6) x 2
+}
+sub toggle {
+   my ($self) = @_;
+   $self->{state} = !$self->{state};
+   $self->emit (changed => $self->{state});
+   $self->update;
+}
+sub invoke_button_down {
+   my ($self, $ev, $x, $y) = @_;
+   if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
+       && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
+      $self->toggle;
+   } else {
+      return 0
+   }
+   1
+}
+sub _draw {
+   my ($self) = @_;
+   $self->SUPER::_draw;
+   glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
+   my ($w, $h) = @$self{qw(w h)};
+   my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
+   glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
+   my $tex = $self->{state} ? $tex[1] : $tex[0];
+   glEnable GL_TEXTURE_2D;
+   $tex->draw_quad_alpha (0, 0, $s, $s);
+   glDisable GL_TEXTURE_2D;
+}
+#############################################################################
+package CFClient::UI::Image;
+our @ISA = CFClient::UI::Base::;
+use CFClient::OpenGL;
+our %texture_cache;
+sub new {
+   my $class = shift;
+   my $self = $class->SUPER::new (
+      can_events => 0,
+      @_,
+   );
+   $self->{path} || $self->{tex}
+      or Carp::croak "'path' or 'tex' attributes required";
+   $self->{tex} ||= $texture_cache{$self->{path}} ||=
+      new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
+   Scalar::Util::weaken $texture_cache{$self->{path}};
+   $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
+   $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) = @_;
+   ($self->{tex}{w}, $self->{tex}{h})
+}
+sub _draw {
+   my ($self) = @_;
+   my $tex = $self->{tex};
+   my ($w, $h) = ($self->{w}, $self->{h});
+   if ($self->{rot90}) {
+      glRotate 90, 0, 0, 1;
+      glTranslate 0, -$self->{w}, 0;
+      ($w, $h) = ($h, $w);
+   }
+   glEnable GL_TEXTURE_2D;
+   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
+   $tex->draw_quad (0, 0, $w, $h);
+   glDisable GL_TEXTURE_2D;
+}
+#############################################################################
 package CFClient::UI::ImageButton;
 our @ISA = CFClient::UI::Image::;
 use CFClient::OpenGL;
    $self->emit ("activate")
       if $x >= 0 && $x < $self->{w}
          && $y >= 0 && $y < $self->{h};
    1
-}
-#############################################################################
-package CFClient::UI::CheckBox;
-our @ISA = CFClient::UI::DrawBG::;
-my @tex =
-      map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
-         qw(c1_checkbox_bg.png c1_checkbox_active.png);
-use CFClient::OpenGL;
-sub new {
-   my $class = shift;
-   $class->SUPER::new (
-      padding_x => 2,
-      padding_y => 2,
-      fg        => [1, 1, 1],
-      active_fg => [1, 1, 0],
-      bg        => [0, 0, 0, 0.2],
-      active_bg => [1, 1, 1, 0.5],
-      state     => 0,
-      can_hover => 1,
-      @_
-   )
-}
-sub size_request {
-   my ($self) = @_;
-   (6) x 2
-}
-sub invoke_button_down {
-   my ($self, $ev, $x, $y) = @_;
-   if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
-       && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
-      $self->{state} = !$self->{state};
-      $self->emit (changed => $self->{state});
-   } else {
-      return 0
-   }
-   1
-}
-sub _draw {
-   my ($self) = @_;
-   $self->SUPER::_draw;
-   glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
-   my ($w, $h) = @$self{qw(w h)};
-   my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
-   glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
-   my $tex = $self->{state} ? $tex[1] : $tex[0];
-   glEnable GL_TEXTURE_2D;
-   $tex->draw_quad_alpha (0, 0, $s, $s);
-   glDisable GL_TEXTURE_2D;
-}
-#############################################################################
-package CFClient::UI::Image;
-our @ISA = CFClient::UI::Base::;
-use CFClient::OpenGL;
-our %texture_cache;
-sub new {
-   my $class = shift;
-   my $self = $class->SUPER::new (
-      can_events => 0,
-      @_,
-   );
-   $self->{path}
-      or Carp::croak "required attribute 'path' not set";
-   $self->{tex} = $texture_cache{$self->{path}} ||=
-      new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
-   Scalar::Util::weaken $texture_cache{$self->{path}};
-   $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
-   $self
-}
-sub size_request {
-   my ($self) = @_;
-   ($self->{tex}{w}, $self->{tex}{h})
-}
-sub _draw {
-   my ($self) = @_;
-   my $tex = $self->{tex};
-   my ($w, $h) = ($self->{w}, $self->{h});
-   if ($self->{rot90}) {
-      glRotate 90, 0, 0, 1;
-      glTranslate 0, -$self->{w}, 0;
-      ($w, $h) = ($h, $w);
-   }
-   glEnable GL_TEXTURE_2D;
-   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
-   $tex->draw_quad_alpha (0, 0, $w, $h);
-   glDisable GL_TEXTURE_2D;
 }
 #############################################################################
 package CFClient::UI::VGauge;
    my $ycut1 = max 0, min 1, $ycut;
    my $ycut2 = max 0, min 1, $ycut - 1;
    my $h1 = $self->{h} * (1 - $ycut1);
    my $h2 = $self->{h} * (1 - $ycut2);
+   my $h3 = $self->{h};
+   $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
    glEnable GL_BLEND;
    glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
                        GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
    glEnable GL_TEXTURE_2D;
    if ($t3) {
       glBindTexture GL_TEXTURE_2D, $t3->{name};
       glBegin GL_QUADS;
       glTexCoord 0       , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
-      glTexCoord 0       , $t3->{t};                glVertex 0 , $self->{h};
+      glTexCoord 0       , $t3->{t};                glVertex 0 , $h3;
-      glTexCoord $t3->{s}, $t3->{t};                glVertex $w, $self->{h};
+      glTexCoord $t3->{s}, $t3->{t};                glVertex $w, $h3;
       glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
       glEnd;
    }
    glDisable GL_BLEND;
    }
    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) = @_;
    delete $self->{knob_w};
    $self->SUPER::update;
 sub new {
    my $class = shift;
    my $self = $class->SUPER::new (
       fontsize   => 1,
-      can_events => 0,
+      can_events => 1,
       indent     => 0,
       #font      => default_font
       @_,
-      layout     => (new CFClient::Layout 1),
+      layout     => (new CFClient::Layout),
       par        => [],
       height     => 0,
       children   => [
          (new CFClient::UI::Empty expand => 1),
          (new CFClient::UI::Slider vertical => 1),
    local $self->{children} = [$empty, $slider];
    $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) = @_;
    my $layout = $self->{layout};
    $self->{height} = 0;
    $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
 }
 sub add_paragraph {
-   my ($self, $color, $para, $indent) = @_;
+   my $self = shift;
-   my ($text, @w) = ref $para ? @$para : $para;
+   for my $para (@_) {
-   $para = {
+      $para = {
+         fg      => [1, 1, 1, 1],
+         indent  => 0,
+         markup  => "",
+         widget  => [],
+         ref $para ? %$para : (markup => $para),
-      w       => 1e10,
+         w       => 1e10,
-      wrapped => 1,
+         wrapped => 1,
-      fg      => $color,
-      indent  => $indent,
-      markup  => $text,
-      widget  => \@w,
-   };
+      };
-   $self->add (@w) if @w;
+      $self->add (@{ $para->{widget} }) if @{ $para->{widget} };
-   push @{$self->{par}}, $para;
+      push @{$self->{par}}, $para;
+   }
    $self->{need_reflow}++;
    $self->update;
 }
          my $y0 = $top;
          my $y1 = $top + $H;
          my $y = 0;
-         glEnable GL_BLEND;
-         #TODO# not correct in windows where rgba is forced off
-         glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
          for my $para (@{$self->{par}}) {
             my $h = $para->{h};
             if ($y0 < $y + $h && $y < $y1) {
                my $layout = $self->get_layout ($para);
-               my ($w, $h, $data, $format, $internalformat) = $layout->render;
-               glRasterPos $para->{indent}, $y - $y0;
+               $layout->render ($para->{indent}, $y - $y0);
-               glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
                if (my @w = @{ $para->{widget} }) {
                   my @s = $layout->get_shapes;
                   for (@w) {
                }
             }
             $y += $h;
          }
-         glDisable GL_BLEND;
       };
    });
 }
 sub reconfigure {
    $self->{root}->on_post_alloc ("move_$self" => sub {
       my $widget = $self->{owner}
          or return;
+      if ($widget->{visible}) {
-      my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
+         my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
-      ($x, $y) = $widget->coord2global (-$self->{w}, 0)
+         ($x, $y) = $widget->coord2global (-$self->{w}, 0)
-         if $x + $self->{w} > $self->{root}{w};
+            if $x + $self->{w} > $self->{root}{w};
-      $self->move_abs ($x, $y);
+         $self->move_abs ($x, $y);
+      } else {
+         $self->hide;
+      }
    });
 }
 sub _draw {
    my ($self) = @_;
 #############################################################################
 package CFClient::UI::Face;
-our @ISA = CFClient::UI::Base::;
+our @ISA = CFClient::UI::DrawBG::;
 use CFClient::OpenGL;
 sub new {
    my $class = shift;
 sub _draw {
    my ($self) = @_;
    return unless $::CONN;
+   $self->SUPER::_draw;
    my $face;
    if ($self->{frame}) {
       my $anim = $::CONN->{anim}[$self->{anim}];
    for my $item (@{ $self->{items} }) {
       my ($widget, $cb, $tooltip) = @$item;
       # handle various types of items, only text for now
       if (!ref $widget) {
+         if ($widget =~ /\t/) {
+            my ($left, $right) = split /\t/, $widget, 2;
+            $widget = new CFClient::UI::HBox
+               can_hover  => 1,
+               can_events => 1,
+               tooltip    => $tooltip,
+               children   => [
+                  (new CFClient::UI::Label markup => $left, expand => 1),
+                  (new CFClient::UI::Label markup => $right, align => +1),
+               ],
+            ;
+         } else {
-         $widget = new CFClient::UI::Label
+            $widget = new CFClient::UI::Label
-            can_hover  => 1,
+               can_hover  => 1,
-            can_events => 1,
+               can_events => 1,
-            markup     => $widget,
+               markup     => $widget,
-            tooltip    => $tooltip
+               tooltip    => $tooltip;
+         }
       }
       $self->{item}{$widget} = $item;
       $self->{vbox}->add ($widget);
    $self->SUPER::add (@widgets);
    $self->{current} = $self->{children}[0]
       if @{ $self->{children} };
+}
+sub get_current_page {
+   my ($self) = @_;
+   $self->{current}
 }
 sub set_current_page {
    my ($self, $page_or_widget) = @_;
    );
    $self->{multiplexer}->add ($widget);
 }
+sub get_current_page {
+   my ($self) = @_;
+   $self->{multiplexer}->get_current_page
+}
 sub set_current_page {
    my ($self, $page) = @_;
    $self->{multiplexer}->set_current_page ($page);
    $self->emit (page_changed => $self->{multiplexer}{current});
 }
 #############################################################################
-package CFClient::UI::Combobox;
+package CFClient::UI::Selector;
 use utf8;
 our @ISA = CFClient::UI::Button::;
          count    => 1,
          %arg,
       };
    }
+   $ROOT->on_refresh (reorder => sub {
-   $self->reorder;
+      $self->reorder;
+   });
 }
 sub reconfigure {
    my ($self) = @_;
 #############################################################################
 package CFClient::UI::Inventory;
-our @ISA = CFClient::UI::ScrolledWindow::;
+our @ISA = CFClient::UI::Table::;
 sub new {
    my $class = shift;
    my $self = $class->SUPER::new (
-      child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
+      col_expand => [0, 1, 0],
+      items      => [],
       @_,
    );
+   $self->set_sort_order (undef);
    $self
+}
+sub update_items {
+   my ($self) = @_;
+   $self->clear;
+   my @item = $self->{sort}->(@{ $self->{items} });
+   my @adds;
+   my $row = 0;
+   for my $item ($self->{sort}->(@{ $self->{items} })) {
+      CFClient::Item::update_widgets $item;
+      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->{child}->clear;
+   $self->{items} = [$items ? values %$items : ()];
-   return unless $items;
-   my @items = sort {
-      ($a->{type} <=> $b->{type})
-         or ($a->{name} cmp $b->{name})
-   } @$items;
-   $self->{real_items} = \@items;
-   my $row = 0;
-   for my $item (@items) {
-      CFClient::Item::update_widgets $item;
-      $self->{child}->add (0, $row, $item->{face_widget});
-      $self->{child}->add (1, $row, $item->{desc_widget});
-      $self->{child}->add (2, $row, $item->{weight_widget});
-      $row++;
-   }
-}
-#############################################################################
-package CFClient::UI::BindEditor;
-our @ISA = CFClient::UI::FancyFrame::;
-sub new {
-   my $class = shift;
-   my $self = $class->SUPER::new (binding => [], commands => [], @_);
-   $self->add (my $vb = new CFClient::UI::VBox);
-   $vb->add ($self->{rec_btn} = new CFClient::UI::Button
-      text => "start recording",
-      tooltip => "Start/Stops recording of actions."
-                ."All subsequent actions after the recording started will be captured."
-                ."The actions are displayed after the record was stopped."
-                ."To bind the action you have to click on the 'Bind' button",
-      on_activate => sub {
-         unless ($self->{recording}) {
-            $self->start;
-         } else {
-            $self->stop;
-         }
-      });
-   $vb->add (new CFClient::UI::Label text => "Actions:");
-   $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
-   $vb->add (new CFClient::UI::Label text => "Bound to: ");
-   $vb->add (my $hb = new CFClient::UI::HBox);
-   $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
-   $hb->add (new CFClient::UI::Button
-      text => "bind",
-      tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
-      on_activate => sub {
-         $self->ask_for_bind;
-      });
-   $vb->add (my $hb = new CFClient::UI::HBox);
-   $hb->add (new CFClient::UI::Button
-      text => "ok",
-      expand => 1,
-      tooltip => "This closes the binding editor and saves the binding",
-      on_activate => sub {
-         $self->hide;
-         $self->commit;
-      });
-   $hb->add (new CFClient::UI::Button
-      text => "cancel",
-      expand => 1,
-      tooltip => "This closes the binding editor without saving",
-      on_activate => sub {
-         $self->hide;
-         $self->{binding_cancel}->()
-            if $self->{binding_cancel};
-      });
-   $self->update_binding_widgets;
+   $self->update_items;
-   $self
-}
-sub cfg_bind {
-   my ($self, $mod, $sym, $cmds) = @_;
-   $::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
-   ::update_bindings ();
-}
-sub cfg_unbind {
-   my ($self, $mod, $sym, $cmds) = @_;
-   delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
-   ::update_bindings ();
-}
-sub commit {
-   my ($self) = @_;
-   my ($mod, $sym, $cmds) = $self->get_binding;
-   if ($sym != 0 && @$cmds > 0) {
-      $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
-                        ."'. Don't forget 'Save Config'!");
-      $self->{binding_change}->($mod, $sym, $cmds)
-         if $self->{binding_change};
-   } else {
-      $::STATUSBOX->add ("No action bound, no key or action specified!");
-      $self->{binding_cancel}->()
-         if $self->{binding_cancel};
-   }
-}
-sub start {
-   my ($self) = @_;
-   $self->{rec_btn}->set_text ("stop recording");
-   $self->{recording} = 1;
-   $self->clear_command_list;
-   $::CONN->start_record if $::CONN;
-}
-sub stop {
-   my ($self) = @_;
-   $self->{rec_btn}->set_text ("start recording");
-   $self->{recording} = 0;
-   my $rec;
-   $rec = $::CONN->stop_record if $::CONN;
-   return unless ref $rec eq 'ARRAY';
-   $self->set_command_list ($rec);
-}
-sub ask_for_bind_and_commit {
-   my ($self) = @_;
-   $self->ask_for_bind (1);
-}
-sub ask_for_bind {
-   my ($self, $commit, $end_cb) = @_;
-   CFClient::Binder::open_binding_dialog (sub {
-      my ($mod, $sym) = @_;
-      $self->{binding} = [$mod, $sym];  # XXX: how to stop that memleak?
-      $self->update_binding_widgets;
-      $self->commit if $commit;
-      $end_cb->() if $end_cb;
-   });
-}
-# $mod and $sym are the modifiers and key symbol
-# $cmds is a array ref of strings (the commands)
-# $cb is the callback that is executed on OK
-# $ccb is the callback that is executed on CANCEL and
-# when the binding was unsuccessful on OK
-sub set_binding {
-   my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
-   $self->clear_command_list;
-   $self->{recording} = 0;
-   $self->{rec_btn}->set_text ("start recording");
-   $self->{binding} = [$mod, $sym];
-   $self->{commands} = $cmds;
-   $self->{binding_change} = $cb;
-   $self->{binding_cancel} = $ccb;
-   $self->update_binding_widgets;
-}
-# this is a shortcut method that asks for a binding
-# and then just binds it.
-sub do_quick_binding {
-   my ($self, $cmds, $end_cb) = @_;
-   $self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
-   $self->ask_for_bind (1, $end_cb);
-}
-sub update_binding_widgets {
-   my ($self) = @_;
-   my ($mod, $sym, $cmds) = $self->get_binding;
-   $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
-   $self->set_command_list ($cmds);
-}
-sub get_binding {
-   my ($self) = @_;
-   return (
-      $self->{binding}->[0],
-      $self->{binding}->[1],
-      [ grep { defined $_ } @{$self->{commands}} ]
-   );
-}
-sub clear_command_list {
-   my ($self) = @_;
-   $self->{cmdbox}->clear ();
-}
-sub set_command_list {
-   my ($self, $cmds) = @_;
-   $self->{cmdbox}->clear ();
-   $self->{commands} = $cmds;
-   my $idx = 0;
-   for (@$cmds) {
-      $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
-      my $i = $idx;
-      $hb->add (new CFClient::UI::Label text => $_);
-      $hb->add (new CFClient::UI::Button
-         text => "delete",
-         tooltip => "Deletes the action from the record",
-         on_activate => sub {
-            $self->{cmdbox}->remove ($hb);
-            $cmds->[$i] = undef;
-         });
-      $idx++
-   }
 }
 #############################################################################
 package CFClient::UI::SpellList;
             } elsif ($ev->{button} == 2) {
                $::CONN->user_send ("invoke $spell->{name}");
             } elsif ($ev->{button} == 3) {
                (new CFClient::UI::Menu
                   items => [
-                     ["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
+                     ["bind <i>cast $spell->{name}</i> to a key"   => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
                      ["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
                   ],
                )->popup ($ev);
             } else {
                return 0;
          my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
          $w = 0 if $w < 0;
          $h = 0 if $h < 0;
+         $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};
          $w = int $w + 0.5;
          $h = int $h + 0.5;
          if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
             $widget->{old_w} = $widget->{w};

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.312 by root, Fri Jun 23 23:54:30 2006 UTC vs. Revision 1.338 by root, Mon Jul 24 08:23:28 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.312 by root, Fri Jun 23 23:54:30 2006 UTC vs.
Revision 1.338 by root, Mon Jul 24 08:23:28 2006 UTC