--- deliantra/Deliantra-Client/DC/UI.pm 2006/07/05 01:53:24 1.322 +++ deliantra/Deliantra-Client/DC/UI.pm 2006/07/23 16:11:12 1.334 @@ -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; - - $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; } @@ -195,6 +209,14 @@ ############################################################################# +package CFClient::UI::Event; + +sub xy { + $_[1]->coord2local ($_[0]{x}, $_[0]{y}) +} + +############################################################################# + package CFClient::UI::Base; use strict; @@ -409,6 +431,8 @@ sub coord2local { my ($self, $x, $y) = @_; + Carp::confess unless $self->{parent};#d# + $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) } @@ -416,6 +440,8 @@ sub coord2global { my ($self, $x, $y) = @_; + Carp::confess unless $self->{parent};#d# + $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) } @@ -454,32 +480,54 @@ $self->emit ("focus_in"); } -sub invoke_mouse_motion { 1 } -sub invoke_button_up { 1 } -sub invoke_key_down { 1 } -sub invoke_key_up { 1 } +sub invoke_mouse_motion { 0 } +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; - 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 - || ($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 { @@ -589,6 +637,8 @@ sub DESTROY { my ($self) = @_; + return if CFClient::in_destruct; + delete $WIDGET{$self+0}; eval { $self->destroy }; @@ -683,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) = @_; @@ -977,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, ); @@ -996,6 +1055,16 @@ $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) = @_; @@ -1082,8 +1151,8 @@ border_bg => [1, 1, 1, 1], border => 0.6, can_events => 1, - min_w => 16, - min_h => 16, + min_w => 64, + min_h => 32, %arg, ); @@ -1297,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; } @@ -1538,7 +1612,7 @@ #markup => initial narkup #max_w => maximum pixel width ellipsise => 3, # end - layout => (new CFClient::Layout 2), + layout => (new CFClient::Layout), fontsize => 1, align => -1, valign => -1, @@ -1549,7 +1623,7 @@ ); if (exists $self->{template}) { - my $layout = new CFClient::Layout 2; + my $layout = new CFClient::Layout; $layout->set_text (delete $self->{template}); $self->{template} = $layout; } @@ -1563,16 +1637,6 @@ $self } -sub escape($) { - local $_ = $_[0]; - - s/&/&/g; - s/>/>/g; - s/{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; @@ -1690,7 +1755,7 @@ $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); - $self->{size_req} + [$self->{layout}->size] }; unless (exists $self->{ox}) { @@ -1827,8 +1892,8 @@ # byte-index to char-index my $text = $self->{text}; - utf8::encode $text; - $self->{cursor} = length substr $text, 0, $idx; + utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text; + $self->{cursor} = length $text; $self->_set_text ($self->{text}); $self->update; @@ -2117,10 +2182,10 @@ @_, ); - $self->{path} - or Carp::croak "required attribute 'path' not set"; + $self->{path} || $self->{tex} + or Carp::croak "'path' or 'tex' attributes required"; - $self->{tex} = $texture_cache{$self->{path}} ||= + $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}}; @@ -2130,6 +2195,24 @@ $self } +sub STORABLE_freeze { + my ($self, $cloning) = @_; + + warn "freeze<$self>\n";#d# + + $self->{path} + or die "cannot serialise CFClient::UI::Image on non-loadable images\n"; + + $self->{path} +} + +sub STORABLE_attach { + my ($self, $cloning, $path) = @_; + warn "attach<@_>\n";#d# + + $self->new (path => $path) +} + sub size_request { my ($self) = @_; @@ -2153,7 +2236,7 @@ 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; } @@ -2450,6 +2533,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) = @_; @@ -2558,12 +2651,12 @@ my $self = $class->SUPER::new ( fontsize => 1, - can_events => 0, + can_events => 1, indent => 0, #font => default_font @_, - layout => (new CFClient::Layout 2), + layout => (new CFClient::Layout), par => [], height => 0, children => [ @@ -2610,6 +2703,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) = @_; @@ -2915,12 +3018,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; + } }); } @@ -3468,35 +3575,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; } ############################################################################# @@ -3815,6 +3942,12 @@ $w = 0 if $w < 0; $h = 0 if $h < 0; + $w = max $widget->{min_w}, $w; + $h = max $widget->{min_h}, $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;