--- deliantra/Deliantra-Client/DC/UI.pm 2006/05/25 16:35:42 1.235 +++ deliantra/Deliantra-Client/DC/UI.pm 2006/05/31 14:04:52 1.263 @@ -7,21 +7,48 @@ use List::Util (); use CFClient; +use CFClient::Texture; our ($FOCUS, $HOVER, $GRAB); # various widgets +our $LAYOUT; our $ROOT; our $TOOLTIP; our $BUTTON_STATE; our %WIDGET; # all widgets, weak-referenced +sub get_layout { + my $layout; + + for (grep { $_->{name} } values %WIDGET) { + my $win = $layout->{$_->{name}} = { }; + + $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/; + $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/; + $win->{w} = $_->{w} / $::WIDTH if defined $_->{w}; + $win->{h} = $_->{h} / $::HEIGHT if defined $_->{h}; + + $win->{show} = $_->{visible} && $_->{is_toplevel}; + } + + $layout +} + +sub set_layout { + my ($layout) = @_; + + $LAYOUT = $layout; +} + sub check_tooltip { if (!$GRAB) { for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { if (length $widget->{tooltip}) { if ($TOOLTIP->{owner} != $widget) { + $TOOLTIP->hide; + $TOOLTIP->{owner} = $widget; my $tip = $widget->{tooltip}; @@ -30,15 +57,6 @@ $TOOLTIP->set_tooltip_from ($widget); $TOOLTIP->show; - - my ($x, $y) = $widget->coord2global ($widget->{w}, 0); - - ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0) - if $x + $TOOLTIP->{w} > $::WIDTH; - - $TOOLTIP->move ($x, $y); - $TOOLTIP->check_size; - $TOOLTIP->update; } return; @@ -154,14 +172,19 @@ for my $widget (values %WIDGET) { if ($widget->{is_toplevel}) { - $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x}; - $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; - $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w}; - $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w}; - $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y}; - $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; - $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h}; - $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h}; + $widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; + $widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; + + $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/; + $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; + $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w}; + $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/; + $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; + $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h}; + + $widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; + $widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; + } } @@ -180,20 +203,34 @@ my $class = shift; my $self = bless { - x => 0, - y => 0, + x => "center", + y => "center", z => 0, + w => undef, + h => undef, can_events => 1, @_ }, $class; + Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); + for (keys %$self) { - if (/^connect_(.*)$/) { + if (/^on_(.*)$/) { $self->connect ($1 => delete $self->{$_}); } } - Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); + if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) { + $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x}; + $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y}; + $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w}; + $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h}; + + $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x}; + $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y}; + + $self->show if $layout->{show}; + } $self } @@ -207,38 +244,63 @@ sub show { my ($self) = @_; + return if $self->{parent}; $CFClient::UI::ROOT->add ($self); } -sub show_centered { +sub set_visible { my ($self) = @_; - return if $self->{parent}; - $self->show; + return if $self->{visible}; - $CFClient::UI::ROOT->on_post_alloc ( - "centered $self" => sub { - $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5); - }, - ); + $self->{root} = $self->{parent}{root}; + $self->{visible} = $self->{parent}{visible} + 1; + + $self->emit (visibility_change => 1); + + $self->realloc if !exists $self->{req_w}; + + $_->set_visible for $self->children; } sub set_invisible { my ($self) = @_; - # broken show/hide model + return unless $self->{visible}; + $_->set_invisible for $self->children; + + delete $self->{root}; delete $self->{visible}; undef $GRAB if $GRAB == $self; undef $HOVER if $HOVER == $self; CFClient::UI::check_tooltip - if $CFClient::UI::TOOLTIP->{owner} == $self; + if $TOOLTIP->{owner} == $self; $self->focus_out; + + $self->emit (visibility_change => 0); +} + +sub set_visibility { + my ($self, $visible) = @_; + + return if $self->{visible} == $visible; + + $visible ? $self->hide + : $self->show; +} + +sub toggle_visibility { + my ($self) = @_; + + $self->{visible} + ? $self->hide + : $self->show; } sub hide { @@ -250,11 +312,11 @@ if $self->{parent}; } -sub move { +sub move_abs { my ($self, $x, $y, $z) = @_; - $self->{x} = int $x; - $self->{y} = int $y; + $self->{x} = List::Util::max 0, int $x; + $self->{y} = List::Util::max 0, int $y; $self->{z} = $z if defined $z; $self->update; @@ -263,10 +325,10 @@ sub set_size { my ($self, $w, $h) = @_; - $self->{user_w} = $w; - $self->{user_h} = $h; + $self->{force_w} = $w; + $self->{force_h} = $h; - $self->check_size; + $self->realloc; } sub size_request { @@ -278,25 +340,30 @@ my ($self, $x, $y, $w, $h) = @_; if ($self->{aspect}) { - my $w2 = List::Util::min $w, int $h * $self->{aspect}; - my $h2 = List::Util::min $h, int $w / $self->{aspect}; + my ($ow, $oh) = ($w, $h); - # use alignment to adjust x, y + $w = List::Util::min $w, int $h * $self->{aspect}; + $h = List::Util::min $h, int $w / $self->{aspect}; - $x += int +($w - $w2) * 0.5; - $y += int +($h - $h2) * 0.5; + # use alignment to adjust x, y - ($w, $h) = ($w2, $h2); + $x += int 0.5 * ($ow - $w); + $y += int 0.5 * ($oh - $h); } - if ($self->{x} != $x || $self->{y} != $y) { + if ($self->{x} ne $x || $self->{y} ne $y) { $self->{x} = $x; $self->{y} = $y; $self->update; } - if ($self->{w} != $w || $self->{h} != $h) { - $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h]; + if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) { + return unless $self->{visible}; + + $self->{alloc_w} = $w; + $self->{alloc_h} = $h; + + $self->{root}{size_alloc}{$self+0} = $self; } } @@ -304,13 +371,6 @@ # nothing to be done } -sub reconfigure { - my ($self) = @_; - - $self->check_size (1); - $self->update; -} - sub children { } @@ -397,6 +457,76 @@ sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } +sub find_widget { + my ($self, $x, $y) = @_; + + return () unless $self->{can_events}; + + return $self + if $x >= $self->{x} && $x < $self->{x} + $self->{w} + && $y >= $self->{y} && $y < $self->{y} + $self->{h}; + + () +} + +sub set_parent { + my ($self, $parent) = @_; + + Scalar::Util::weaken ($self->{parent} = $parent); + $self->set_visible if $parent->{visible}; +} + +sub connect { + my ($self, $signal, $cb) = @_; + + push @{ $self->{signal_cb}{$signal} }, $cb; +} + +sub _emit { + my ($self, $signal, @args) = @_; + + List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []} +} + +sub emit { + my ($self, $signal, @args) = @_; + + $self->_emit ($signal, @args) + || $self->$signal (@args); +} + +sub visibility_change { + #my ($self, $visible) = @_; +} + +sub realloc { + my ($self) = @_; + + if ($self->{visible}) { + return if $self->{root}{realloc}{$self+0}; + + $self->{root}{realloc}{$self+0} = $self; + $self->{root}->update; + } else { + delete $self->{req_w}; + delete $self->{req_h}; + } +} + +sub update { + my ($self) = @_; + + $self->{parent}->update + if $self->{parent}; +} + +sub reconfigure { + my ($self) = @_; + + $self->realloc; + $self->update; +} + sub draw { my ($self) = @_; @@ -422,7 +552,7 @@ glDisable GL_BLEND; } - if ($ENV{PCLIENT_DEBUG}) { + if ($ENV{CFPLUS_DEBUG} & 1) { glPushMatrix; glColor 1, 1, 0, 1; glTranslate $self->{x} + 0.375, $self->{y} + 0.375; @@ -443,63 +573,6 @@ warn "no draw defined for $self\n"; } -sub find_widget { - my ($self, $x, $y) = @_; - - return () unless $self->{can_events}; - - return $self - if $x >= $self->{x} && $x < $self->{x} + $self->{w} - && $y >= $self->{y} && $y < $self->{y} + $self->{h}; - - () -} - -sub set_parent { - my ($self, $parent) = @_; - - Scalar::Util::weaken ($self->{parent} = $parent); - - # TODO: req_w _does_change after ->reconfigure - $self->check_size - unless exists $self->{req_w}; - - $self->show; -} - -sub check_size { - my ($self, $forced) = @_; - - $self->{force_alloc} = 1 if $forced; - $CFClient::UI::ROOT->{check_size}{$self} = $self; -} - -sub update { - my ($self) = @_; - - $self->{parent}->update - if $self->{parent}; -} - -sub connect { - my ($self, $signal, $cb) = @_; - - push @{ $self->{signal_cb}{$signal} }, $cb; -} - -sub _emit { - my ($self, $signal, @args) = @_; - - List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []} -} - -sub emit { - my ($self, $signal, @args) = @_; - - $self->_emit ($signal, @args) - || $self->$signal (@args); -} - sub DESTROY { my ($self) = @_; @@ -565,7 +638,9 @@ } sub size_request { - (0, 0) + my ($self) = @_; + + ($self->{w} + 0, $self->{h} + 0) } sub draw { } @@ -604,8 +679,7 @@ @{$self->{children}}, @widgets ]; - $self->check_size (1); - $self->update; + $self->realloc; } sub children { @@ -620,8 +694,7 @@ $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; - $self->check_size; - $self->update; + $self->realloc; } sub clear { @@ -635,8 +708,7 @@ $_->hide; } - $self->check_size; - $self->update; + $self->realloc; } sub find_widget { @@ -783,16 +855,21 @@ sub size_request { my ($self) = @_; - @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; + my ($w, $h) = @{$self->child}{qw(req_w req_h)}; + + $w = 10 if $self->{scroll_x}; + $h = 10 if $self->{scroll_y}; - @$self{qw(child_w child_h)} + ($w, $h) } sub size_allocate { my ($self, $w, $h) = @_; - $w = $self->{child_w} if $self->{scroll_x} && $self->{child_w}; - $h = $self->{child_h} if $self->{scroll_y} && $self->{child_h}; + my $child = $self->child; + + $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w}; + $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h}; $self->child->configure (0, 0, $w, $h); $self->update; @@ -855,9 +932,9 @@ my $self; my $slider = new CFClient::UI::Slider - vertical => 1, - range => [0, 0, 1, 0.01], # HACK fix - connect_changed => sub { + vertical => 1, + range => [0, 0, 1, 0.01], # HACK fix + on_changed => sub { $self->{vp}->set_offset (0, $_[1]); }, ; @@ -875,6 +952,16 @@ $self } +sub update { + my ($self) = @_; + + $self->SUPER::update; + + # todo: overwrite size_allocate of child + my $child = $self->{vp}->child; + $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); +} + sub size_allocate { my ($self, $w, $h) = @_; @@ -935,21 +1022,24 @@ use CFClient::OpenGL; -my @tex = +my $bg = + new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png", + mipmap => 1, wrap => 1; + +my @border = map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } - qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); + qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); sub new { my $class = shift; - # TODO: user_x, user_y, overwrite moveto? - my $self = $class->SUPER::new ( bg => [1, 1, 1, 1], border_bg => [1, 1, 1, 1], border => 0.6, - is_toplevel => 1, can_events => 1, + min_w => 16, + min_h => 16, @_ ); @@ -1012,10 +1102,11 @@ my $dx = $ev->{x} - $ox; my $dy = $ev->{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; + $self->{force_w} = $bw + $dx * ($mx ? -1 : 1); + $self->{force_h} = $bh + $dy * ($my ? -1 : 1); + + $self->realloc; + $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my); }; } elsif ($lr ^ $td) { @@ -1027,8 +1118,7 @@ ($x, $y) = ($ev->{x}, $ev->{y}); - $self->move ($bx + $x - $ox, $by + $y - $oy); - $self->update; + $self->move_abs ($bx + $x - $ox, $by + $y - $oy); }; } } @@ -1057,23 +1147,18 @@ my $border = $self->border; glColor @{ $self->{border_bg} }; - $tex[1]->draw_quad_alpha (0, 0, $w, $border); - $tex[3]->draw_quad_alpha (0, $border, $border, $ch); - $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); - $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); + $border[0]->draw_quad_alpha (0, 0, $w, $border); + $border[1]->draw_quad_alpha (0, $border, $border, $ch); + $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); + $border[3]->draw_quad_alpha (0, $h - $border, $w, $border); 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; + # TODO: repeat texture not scale + # solve this better(?) + $bg->{s} = $cw / $bg->{w}; + $bg->{t} = $ch / $bg->{h}; $bg->draw_quad_alpha ($border, $border, $cw, $ch); } @@ -1103,20 +1188,20 @@ ) } +sub children { + grep $_, map @$_, grep $_, @{ $_[0]{children} } +} + sub add { my ($self, $x, $y, $child) = @_; $child->set_parent ($self); $self->{children}[$y][$x] = $child; - $child->check_size; -} - -sub children { - grep $_, map @$_, grep $_, @{ $_[0]{children} } + $self->realloc; } -# TODO: move to container class maybe? send childs a signal on removal? +# TODO: move to container class maybe? send children a signal on removal? sub clear { my ($self) = @_; @@ -1128,7 +1213,7 @@ $_->hide; } - $self->update; + $self->realloc; } sub get_wh { @@ -1169,8 +1254,8 @@ my ($ws, $hs) = $self->get_wh; - my $req_w = sum @$ws; - my $req_h = sum @$hs; + my $req_w = (sum @$ws) || 1; + my $req_h = (sum @$hs) || 1; # TODO: nicer code && do row_expand my @col_expand = @{$self->{col_expand}}; @@ -1234,59 +1319,59 @@ ############################################################################# -package CFClient::UI::HBox; - -# TODO: wrap into common Box base class +package CFClient::UI::Box; our @ISA = CFClient::UI::Container::; sub size_request { my ($self) = @_; - my @alloc = map [$_->size_request], @{$self->{children}}; - - ( - (List::Util::sum map $_->[0], @alloc), - (List::Util::max map $_->[1], @alloc), - ) + $self->{vertical} + ? ( + (List::Util::max map $_->{req_w}, @{$self->{children}}), + (List::Util::sum map $_->{req_h}, @{$self->{children}}), + ) + : ( + (List::Util::sum map $_->{req_w}, @{$self->{children}}), + (List::Util::max map $_->{req_h}, @{$self->{children}}), + ) } sub size_allocate { my ($self, $w, $h) = @_; - ($h, $w) = ($w, $h); - + my $space = $self->{vertical} ? $h : $w; my $children = $self->{children}; - my @h = map $_->{req_w}, @$children; - - my $req_h = List::Util::sum @h; + my @req; - if ($req_h > $h) { - # ah well, not enough space - $_ *= $h / $req_h for @h; + if ($self->{homogeneous}) { + @req = ($space / (@$children || 1)) x @$children; } else { - my $exp = List::Util::sum map $_->{expand}, @$children; - $exp ||= 1; - - for (0 .. $#$children) { - my $child = $children->[$_]; + @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children; + my $req = List::Util::sum @req; - my $alloc_h = $h[$_]; - $alloc_h += ($h - $req_h) * $child->{expand} / $exp; - $h[$_] = $alloc_h; + if ($req > $space) { + # ah well, not enough space + $_ *= $space / $req for @req; + } else { + my $expand = (List::Util::sum map $_->{expand}, @$children) || 1; + + $space = ($space - $req) / $expand; # remaining space to give away + + $req[$_] += $space * $children->[$_]{expand} + for 0 .. $#$children; } } - CFClient::UI::harmonize \@h; + CFClient::UI::harmonize \@req; - my $y = 0; + my $pos = 0; for (0 .. $#$children) { - my $child = $children->[$_]; - my $h = $h[$_]; - $child->configure ($y, 0, $h, $w); + my $alloc = $req[$_]; + $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); - $y += $h; + $pos += $alloc; } 1 @@ -1294,60 +1379,32 @@ ############################################################################# -package CFClient::UI::VBox; - -# TODO: wrap into common Box base class +package CFClient::UI::HBox; -our @ISA = CFClient::UI::Container::; +our @ISA = CFClient::UI::Box::; -sub size_request { - my ($self) = @_; - - my @alloc = map [$_->size_request], @{$self->{children}}; +sub new { + my $class = shift; - ( - (List::Util::max map $_->[0], @alloc), - (List::Util::sum map $_->[1], @alloc), + $class->SUPER::new ( + vertical => 0, + @_, ) } -sub size_allocate { - my ($self, $w, $h) = @_; - - Carp::confess "negative size" if $w < 0 || $h < 0;#d# - - my $children = $self->{children}; - - my @h = map $_->{req_h}, @$children; - - my $req_h = List::Util::sum @h; - - if ($req_h > $h) { - # ah well, not enough space - $_ *= $h / $req_h for @h; - } else { - my $exp = List::Util::sum map $_->{expand}, @$children; - $exp ||= 1; - - for (0 .. $#$children) { - my $child = $children->[$_]; - - $h[$_] += ($h - $req_h) * $child->{expand} / $exp; - } - } +############################################################################# - CFClient::UI::harmonize \@h; +package CFClient::UI::VBox; - my $y = 0; - for (0 .. $#$children) { - my $child = $children->[$_]; - my $h = $h[$_]; - $child->configure (0, $y, $w, $h); +our @ISA = CFClient::UI::Box::; - $y += $h; - } +sub new { + my $class = shift; - 1 + $class->SUPER::new ( + vertical => 1, + @_, + ) } ############################################################################# @@ -1374,7 +1431,8 @@ fontsize => 1, align => -1, valign => -1, - padding => 2, + padding_x => 2, + padding_y => 2, can_events => 0, %arg ); @@ -1420,8 +1478,8 @@ $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; $self->{layout}->set_text ($text); + $self->realloc; $self->update; - $self->check_size; } sub set_markup { @@ -1435,8 +1493,8 @@ $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; $self->{layout}->set_markup ($markup); + $self->realloc; $self->update; - $self->check_size; } sub size_request { @@ -1460,10 +1518,7 @@ $h = List::Util::max $h, $h2; } - ( - $w + $self->{padding} * 2, - $h + $self->{padding} * 2, - ) + ($w, $h) } sub size_allocate { @@ -1478,8 +1533,7 @@ $self->{fontsize} = $fontsize; delete $self->{texture}; - $self->update; - $self->check_size; + $self->realloc; } sub _draw { @@ -1497,12 +1551,12 @@ my $tex = new_from_layout CFClient::Texture $self->{layout}; - $self->{ox} = int ($self->{align} < 0 ? $self->{padding} - : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} + $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x} + : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x} : ($self->{w} - $tex->{w}) * 0.5); - $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} - : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} + $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y} + : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y} : ($self->{h} - $tex->{h}) * 0.5); $tex @@ -1569,8 +1623,8 @@ $self->{cursor} = length $text; $self->_set_text ($text); - $self->update; - $self->check_size; + + $self->realloc; } sub get_text { @@ -1613,8 +1667,8 @@ } $self->_set_text ($text); - $self->update; - $self->check_size; + + $self->realloc; } sub focus_in { @@ -1751,7 +1805,8 @@ my $class = shift; $class->SUPER::new ( - padding => 4, + padding_x => 4, + padding_y => 4, fg => [1, 1, 1], active_fg => [0, 0, 1], can_hover => 1, @@ -1808,7 +1863,8 @@ my $class = shift; $class->SUPER::new ( - padding => 2, + padding_x => 2, + padding_y => 2, fg => [1, 1, 1], active_fg => [1, 1, 0], bg => [0, 0, 0, 0.2], @@ -1822,14 +1878,14 @@ sub size_request { my ($self) = @_; - ($self->{padding} * 2 + 6) x 2 + (6) x 2 } sub button_down { my ($self, $ev, $x, $y) = @_; - if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} - && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { + 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}); } @@ -1840,9 +1896,11 @@ $self->SUPER::_draw; - glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; + glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0; - my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; + 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} }; @@ -2117,8 +2175,8 @@ bg => [0, 0, 0, 0.2], active_bg => [1, 1, 1, 0.5], range => [0, 0, 100, 10, 0], - req_w => $::WIDTH / 80, - req_h => $::WIDTH / 80, + min_w => $::WIDTH / 80, + min_h => $::WIDTH / 80, vertical => 0, can_hover => 1, inner_pad => 0.02, @@ -2131,12 +2189,15 @@ $self } +sub changed { } + sub set_range { my ($self, $range) = @_; - $self->{range} = $range; + ($range, $self->{range}) = ($self->{range}, $range); - $self->update; + $self->update + if "@$range" ne "@{$self->{range}}"; } sub set_value { @@ -2165,10 +2226,7 @@ sub size_request { my ($self) = @_; - my $w = $self->{req_w}; - my $h = $self->{req_h}; - - $self->{vertical} ? ($h, $w) : ($w, $h) + ($self->{req_w}, $self->{req_h}) } sub button_down { @@ -2529,33 +2587,18 @@ my $class = shift; my $self = $class->SUPER::new ( - state => 0, - connect_activate => \&toggle_flopper, + state => 0, + on_activate => \&toggle_flopper, @_ ); - if ($self->{state}) { - $self->{state} = 0; - $self->toggle_flopper; - } - $self } sub toggle_flopper { my ($self) = @_; - # TODO: use animation - if ($self->{state} = !$self->{state}) { - $CFClient::UI::ROOT->add ($self->{other}); - $self->{other}->move ($self->coord2global (0, $self->{h})); - $self->_emit ("open"); - } else { - $CFClient::UI::ROOT->remove ($self->{other}); - $self->_emit ("close"); - } - - $self->_emit (changed => $self->{state}); + $self->{other}->toggle_visibility; } ############################################################################# @@ -2578,8 +2621,17 @@ sub set_tooltip_from { my ($self, $widget) = @_; + my $tooltip = $widget->{tooltip}; + + if ($ENV{CFPLUS_DEBUG} & 2) { + $tooltip .= "\n\n" . (ref $widget) . "\n" + . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" + . "req $widget->{req_w} $widget->{req_h}\n" + . "visible $widget->{visible}"; + } + $self->add (new CFClient::UI::Label - markup => $widget->{tooltip}, + markup => $tooltip, max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, fontsize => 0.8, fg => [0, 0, 0, 1], @@ -2602,6 +2654,24 @@ $self->SUPER::size_allocate ($w - 4, $h - 4); } +sub visibility_change { + my ($self, $visible) = @_; + + return unless $visible; + + $self->{root}->on_post_alloc ("move_$self" => sub { + my $widget = $self->{owner} + or return; + + my ($x, $y) = $widget->coord2global ($widget->{w}, 0); + + ($x, $y) = $widget->coord2global (-$self->{w}, 0) + if $x + $self->{w} > $::WIDTH; + + $self->move_abs ($x, $y); + }); +} + sub _draw { my ($self) = @_; @@ -2626,6 +2696,7 @@ glEnd; glTranslate 2 - 0.375, 2 - 0.375; + $self->SUPER::_draw; } @@ -2749,13 +2820,6 @@ $row++; } - -# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page]; -} - -sub size_request { - my ($self) = @_; - ($self->{req_w}, $self->{req_h}); } ############################################################################# @@ -2807,7 +2871,7 @@ $self->{button} = $ev->{button}; $self->show; - $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); + $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); } sub mouse_motion { @@ -2951,29 +3015,34 @@ sub new { my $class = shift; - $class->SUPER::new ( + my $self = $class->SUPER::new ( + visible => 1, @_, - ) -} + ); -sub configure { - my ($self, $x, $y, $w, $h) = @_; + Scalar::Util::weaken ($self->{root} = $self); - $self->{w} = $w; - $self->{h} = $h; + $self } -sub check_size { +sub size_request { my ($self) = @_; - $self->size_allocate ($self->{w}, $self->{h}) - if $self->{w}; + ($self->{w}, $self->{h}) } -sub size_request { - my ($self) = @_; +sub _to_pixel { + my ($coord, $size, $max) = @_; - ($self->{w}, $self->{h}) + $coord = + $coord eq "center" ? ($max - $size) * 0.5 + : $coord eq "max" ? $max + : $coord; + + $coord = 0 if $coord < 0; + $coord = $max - $size if $coord > $max - $size; + + int $coord + 0.5 } sub size_allocate { @@ -2982,14 +3051,11 @@ for my $child ($self->children) { my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; - $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 - if exists $child->{req_x}; - - $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 - if exists $child->{req_y}; + $X = $child->{force_x} if exists $child->{force_x}; + $Y = $child->{force_y} if exists $child->{force_y}; - $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5; - $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5; + $X = _to_pixel $X, $W, $self->{w}; + $Y = _to_pixel $Y, $H, $self->{h}; $child->configure ($X, $Y, $W, $H); } @@ -3010,26 +3076,14 @@ sub update { my ($self) = @_; - $self->check_size; $::WANT_REFRESH++; } sub add { my ($self, @children) = @_; - for (my @widgets = @children; my $w = pop @widgets; ) { - push @widgets, $w->children; - $w->{root} = $self; - $w->{visible} = 1; - } - - for my $child (@children) { - $child->{is_toplevel} = 1; - - # integerise window positions - $child->{x} = int $child->{x}; - $child->{y} = int $child->{y}; - } + $_->{is_toplevel} = 1 + for @children; $self->SUPER::add (@children); } @@ -3039,6 +3093,9 @@ $self->SUPER::remove (@children); + delete $self->{is_toplevel} + for @children; + while (@children) { my $w = pop @children; push @children, $w->children; @@ -3066,47 +3123,71 @@ for values %{delete $self->{refresh_hook}}; } - if ($self->{check_size}) { - my @queue = ([], []); + if ($self->{realloc}) { + my @queue; + + while () { + if ($self->{realloc}) { + #TODO use array-of-depth approach + + use sort 'stable'; - for (;;) { - if ($self->{check_size}) { - # heuristic: check containers last - push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ - for values %{delete $self->{check_size}} + @queue = sort { $a->{visible} <=> $b->{visible} } + @queue, values %{delete $self->{realloc}}; } - my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; + my $widget = pop @queue || last; - my ($w, $h) = $widget->{user_w} && $widget->{user_h} - ? @$widget{qw(user_w user_h)} - : $widget->size_request; - - if (delete $widget->{force_alloc} - or $w != $widget->{req_w} or $h != $widget->{req_h}) { - Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d# - + $widget->{visible} or last; # do not resize invisible widgets + + my ($w, $h) = $widget->size_request; + + $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2; + $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2; + + $w = $widget->{force_w} if exists $widget->{force_w}; + $h = $widget->{force_h} if exists $widget->{force_h}; + + if ($widget->{req_w} != $w || $widget->{req_h} != $h + || delete $widget->{force_realloc}) { $widget->{req_w} = $w; $widget->{req_h} = $h; - $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; + $self->{size_alloc}{$widget+0} = $widget; - $widget->{parent}->check_size - if $widget->{parent}; + if (my $parent = $widget->{parent}) { + $self->{realloc}{$parent+0} = $parent; + #unshift @queue, $parent; + $parent->{force_size_alloc} = 1; + $self->{size_alloc}{$parent+0} = $parent; + } } + + delete $self->{realloc}{$widget+0}; } } - while ($self->{size_alloc}) { - for (values %{delete $self->{size_alloc}}) { - my ($widget, $w, $h) = @$_; + while (my $size_alloc = delete $self->{size_alloc}) { + my @queue = sort { $b->{visible} <=> $a->{visible} } + values %$size_alloc; + + while () { + my $widget = pop @queue || last; + + my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; $w = 0 if $w < 0; $h = 0 if $h < 0; - $widget->{w} = $w; - $widget->{h} = $h; - $widget->emit (size_allocate => $w, $h); + $w = int $w + 0.5; + $h = int $h + 0.5; + + if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { + $widget->{w} = $w; + $widget->{h} = $h; + + $widget->emit (size_allocate => $w, $h); + } } } @@ -3115,6 +3196,7 @@ for values %{delete $self->{post_alloc_hook}}; } + glViewport 0, 0, $::WIDTH, $::HEIGHT; glClearColor +($::CFG->{fow_intensity}) x 3, 1; glClear GL_COLOR_BUFFER_BIT; @@ -3129,6 +3211,256 @@ } ############################################################################# + +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 +} + +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); +} + +# if $commit is true, the binding will be set after the user entered a key combo +sub ask_for_bind { + my ($self, $commit) = @_; + + 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; + }); +} + +# $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) = @_; + $self->set_binding (undef, undef, $cmds, sub { + $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2]; + }); + $self->ask_for_bind (1); +} + +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; + +our @ISA = CFClient::UI::FancyFrame::; + +sub new { + my $class = shift; + + my $self = $class->SUPER::new (binding => [], commands => [], @_); + + $self->add (new CFClient::UI::ScrolledWindow + scrolled => $self->{spellbox} = new CFClient::UI::Table); + + $self; +} + +# XXX: Do sorting? Argl... +sub add_spell { + my ($self, $spell) = @_; + $self->{spells}->{$spell->{name}} = $spell; + + $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face + face => $spell->{face}, + can_hover => 1, + can_events => 1, + tooltip => $spell->{message}); + + $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label + text => $spell->{name}, + can_hover => 1, + can_events => 1, + tooltip => $spell->{message}, + expand => 1); + + $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label + text => (sprintf "lvl: %2d sp: %2d dmg: %2d", + $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}), + expand => 1); + + $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button + text => "bind to key", + on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }); +} + +sub rebuild_spell_list { + my ($self) = @_; + $self->{tbl_idx} = 0; + $self->add_spell ($_) for values %{$self->{spells}}; +} + +sub remove_spell { + my ($self, $spell) = @_; + delete $self->{spells}->{$spell->{name}}; + $self->rebuild_spell_list; +} + +############################################################################# package CFClient::UI;