--- deliantra/Deliantra-Client/DC/UI.pm 2006/05/25 16:35:42 1.235 +++ deliantra/Deliantra-Client/DC/UI.pm 2006/05/28 01:16:04 1.247 @@ -7,15 +7,35 @@ 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 { + for (grep { $_->{name} } values %WIDGET) { + $LAYOUT->{$_->{name}} = { + x => $_->{x} / $::WIDTH, + y => $_->{y} / $::HEIGHT, + w => $_->{w} / $::WIDTH, + h => $_->{h} / $::HEIGHT + }; + } + + return $LAYOUT; +} + +sub set_layout { + my ($layout) = @_; + $LAYOUT = $layout; +} + sub check_tooltip { if (!$GRAB) { for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { @@ -157,11 +177,9 @@ $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}; } } @@ -188,16 +206,33 @@ }, $class; 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->{req_x} = $layout->{x} * $::WIDTH; + $self->{req_y} = $layout->{y} * $::HEIGHT; + $self->{def_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH; + $self->{def_h} = ($layout->{h} != 0 ? $layout->{h} : 1) * $::HEIGHT; + } + $self } +sub toggle_visibility { + my ($self) = @_; + + if ($self->{visible}) { + $self->hide; + } else { + $self->show; + } +} + sub destroy { my ($self) = @_; @@ -212,24 +247,37 @@ $CFClient::UI::ROOT->add ($self); } -sub show_centered { +sub center { my ($self) = @_; - return if $self->{parent}; - - $self->show; $CFClient::UI::ROOT->on_post_alloc ( - "centered $self" => sub { + "center_$self" => sub { $self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5); }, ); + + $self->update; +} + +sub set_visible { + my ($self) = @_; + + return if $self->{visible}; + + $self->{root} = $self->{parent}{root}; + $self->{visible} = $self->{parent}{visible} + 1; + + $self->emit (visibility_change => 1) } sub set_invisible { my ($self) = @_; + return unless $self->{visible}; + # broken show/hide model + delete $self->{root}; delete $self->{visible}; undef $GRAB if $GRAB == $self; @@ -239,6 +287,8 @@ if $CFClient::UI::TOOLTIP->{owner} == $self; $self->focus_out; + + $self->emit (visibility_change => 0); } sub hide { @@ -263,8 +313,8 @@ sub set_size { my ($self, $w, $h) = @_; - $self->{user_w} = $w; - $self->{user_h} = $h; + $self->{def_w} = $w; + $self->{def_h} = $h; $self->check_size; } @@ -460,11 +510,9 @@ Scalar::Util::weaken ($self->{parent} = $parent); - # TODO: req_w _does_change after ->reconfigure - $self->check_size - unless exists $self->{req_w}; + $self->set_visible; #TODO why breakssssss borked damn if $parent->{visible}; - $self->show; + $self->check_size; } sub check_size { @@ -500,6 +548,10 @@ || $self->$signal (@args); } +sub visibility_change { + #my ($self, $visible) = @_; +} + sub DESTROY { my ($self) = @_; @@ -620,7 +672,7 @@ $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; - $self->check_size; + $self->check_size (1); $self->update; } @@ -783,9 +835,12 @@ sub size_request { my ($self) = @_; - @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; + my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; - @$self{qw(child_w child_h)} + $w = 10 if $self->{scroll_x}; + $h = 10 if $self->{scroll_y}; + + ($w, $h) } sub size_allocate { @@ -855,9 +910,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 +930,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) = @_; @@ -942,8 +1007,6 @@ 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], @@ -1012,9 +1075,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->{user_x} = $wx + $dx * $mx; + $self->{user_y} = $wy + $dy * $my; + $self->{def_w} = $bw + $dx * ($mx ? -1 : 1); + $self->{def_h} = $bh + $dy * ($my ? -1 : 1); + $self->move ($self->{user_x}, $self->{user_y}); $self->check_size; }; @@ -1027,7 +1092,10 @@ ($x, $y) = ($ev->{x}, $ev->{y}); - $self->move ($bx + $x - $ox, $by + $y - $oy); + $self->{user_x} = $bx + $x - $ox; + $self->{user_y} = $by + $y - $oy; + + $self->move ($self->{user_x}, $self->{user_y}); $self->update; }; } @@ -1103,20 +1171,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->check_size (1); } -# 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,6 +1196,7 @@ $_->hide; } + $self->check_size (1); $self->update; } @@ -1169,8 +1238,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 +1303,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; - my $req_h = List::Util::sum @h; - - 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; + + 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 - my $alloc_h = $h[$_]; - $alloc_h += ($h - $req_h) * $child->{expand} / $exp; - $h[$_] = $alloc_h; + $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 +1363,32 @@ ############################################################################# -package CFClient::UI::VBox; - -# TODO: wrap into common Box base class - -our @ISA = CFClient::UI::Container::; +package CFClient::UI::HBox; -sub size_request { - my ($self) = @_; +our @ISA = CFClient::UI::Box::; - 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; - } - } +package CFClient::UI::VBox; - CFClient::UI::harmonize \@h; +our @ISA = CFClient::UI::Box::; - my $y = 0; - for (0 .. $#$children) { - my $child = $children->[$_]; - my $h = $h[$_]; - $child->configure (0, $y, $w, $h); - - $y += $h; - } +sub new { + my $class = shift; - 1 + $class->SUPER::new ( + vertical => 1, + @_, + ) } ############################################################################# @@ -2134,9 +2175,10 @@ 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 { @@ -2529,33 +2571,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; } ############################################################################# @@ -2749,13 +2776,6 @@ $row++; } - -# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page]; -} - -sub size_request { - my ($self) = @_; - ($self->{req_w}, $self->{req_h}); } ############################################################################# @@ -2952,6 +2972,7 @@ my $class = shift; $class->SUPER::new ( + visible => 1, @_, ) } @@ -2988,6 +3009,8 @@ $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 if exists $child->{req_y}; + delete @$child{qw(req_x req_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; @@ -3017,12 +3040,6 @@ 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; @@ -3032,6 +3049,12 @@ } $self->SUPER::add (@children); + + for (my @widgets = @children; my $w = pop @widgets; ) { + push @widgets, $w->children; + $w->set_visible; + } + } sub remove { @@ -3067,19 +3090,22 @@ } if ($self->{check_size}) { - my @queue = ([], []); + my @queue; for (;;) { if ($self->{check_size}) { - # heuristic: check containers last - push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ - for values %{delete $self->{check_size}} + #TODO use array-of-depth approach + + @queue = sort { $a->{visible} <=> $b->{visible} } + @queue, values %{delete $self->{check_size}}; } - my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; + my $widget = pop @queue || last; + + defined $widget->{visible} or last; # do not resize invisible widgets - my ($w, $h) = $widget->{user_w} && $widget->{user_h} - ? @$widget{qw(user_w user_h)} + my ($w, $h) = $widget->{def_w} && $widget->{def_h} + ? @$widget{qw(def_w def_h)} : $widget->size_request; if (delete $widget->{force_alloc}