ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
(Generate patch)

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.148 by elmex, Sat Apr 22 12:14:45 2006 UTC vs.
Revision 1.153 by root, Sun Apr 23 02:14:33 2006 UTC

8use CFClient; 8use CFClient;
9 9
10our ($FOCUS, $HOVER, $GRAB); # various widgets 10our ($FOCUS, $HOVER, $GRAB); # various widgets
11 11
12our $ROOT; 12our $ROOT;
13our $TOOLTIP;
13our $BUTTON_STATE; 14our $BUTTON_STATE;
15
16sub check_tooltip {
17 if (!$GRAB) {
18 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
19 if (exists $widget->{tooltip}) {
20
21 if ($TOOLTIP->{owner} != $widget) {
22 $TOOLTIP->{owner} = $widget;
23 $TOOLTIP->set_text ($widget->{tooltip});
24 $TOOLTIP->move ($widget->coord2global ($widget->{w}, 0));
25 $TOOLTIP->show;
26 }
27
28 return;
29 }
30 }
31 }
32
33 $TOOLTIP->hide;
34 delete $TOOLTIP->{owner};
35}
14 36
15# class methods for events 37# class methods for events
16sub feed_sdl_key_down_event { 38sub feed_sdl_key_down_event {
17 $FOCUS->key_down ($_[0]) if $FOCUS; 39 $FOCUS->key_down ($_[0]) if $FOCUS;
18} 40}
28 if (!$BUTTON_STATE) { 50 if (!$BUTTON_STATE) {
29 my $widget = $ROOT->find_widget ($x, $y); 51 my $widget = $ROOT->find_widget ($x, $y);
30 52
31 $GRAB = $widget; 53 $GRAB = $widget;
32 $GRAB->update if $GRAB; 54 $GRAB->update if $GRAB;
55
56 check_tooltip;
33 } 57 }
34 58
35 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 59 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
36 60
37 $GRAB->button_down ($ev, $GRAB->coord2local ($x, $y)) if $GRAB; 61 $GRAB->button_down ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;
49 73
50 if (!$BUTTON_STATE) { 74 if (!$BUTTON_STATE) {
51 my $grab = $GRAB; undef $GRAB; 75 my $grab = $GRAB; undef $GRAB;
52 $grab->update if $grab; 76 $grab->update if $grab;
53 $GRAB->update if $GRAB; 77 $GRAB->update if $GRAB;
78
79 check_tooltip;
54 } 80 }
55} 81}
56 82
57sub feed_sdl_motion_event { 83sub feed_sdl_motion_event {
58 my ($ev) = @_; 84 my ($ev) = @_;
63 if ($widget != $HOVER) { 89 if ($widget != $HOVER) {
64 my $hover = $HOVER; $HOVER = $widget; 90 my $hover = $HOVER; $HOVER = $widget;
65 91
66 $hover->update if $hover && $hover->{can_hover}; 92 $hover->update if $hover && $hover->{can_hover};
67 $HOVER->update if $HOVER && $HOVER->{can_hover}; 93 $HOVER->update if $HOVER && $HOVER->{can_hover};
94
95 check_tooltip;
68 } 96 }
69 97
70 $HOVER->mouse_motion ($ev, $HOVER->coord2local ($x, $y)) if $HOVER; 98 $HOVER->mouse_motion ($ev, $HOVER->coord2local ($x, $y)) if $HOVER;
71} 99}
72 100
96 124
97 my $self = bless { 125 my $self = bless {
98 x => 0, 126 x => 0,
99 y => 0, 127 y => 0,
100 z => 0, 128 z => 0,
129 can_events => 1,
101 @_ 130 @_
102 }, $class; 131 }, $class;
103 132
104 for (keys %$self) { 133 for (keys %$self) {
105 if (/^connect_(.*)$/) { 134 if (/^connect_(.*)$/) {
278} 307}
279 308
280sub find_widget { 309sub find_widget {
281 my ($self, $x, $y) = @_; 310 my ($self, $x, $y) = @_;
282 311
312 return () unless $self->{can_events};
313
283 return $self 314 return $self
284 if $x >= $self->{x} && $x < $self->{x} + $self->{w} 315 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
285 && $y >= $self->{y} && $y < $self->{y} + $self->{h}; 316 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
286 317
287 () 318 ()
294} 325}
295 326
296sub check_size { 327sub check_size {
297 my ($self) = @_; 328 my ($self) = @_;
298 329
330 return unless $self->{parent};
331
299 my ($w, $h) = $self->size_request; 332 my ($w, $h) = $self->size_request;
300 333
301 if ($w != $self->{req_w} || $h != $self->{req_h}) { 334 if ($w != $self->{req_w} || $h != $self->{req_h}) {
302 $self->{req_w} = $w; 335 $self->{req_w} = $w;
303 $self->{req_h} = $h; 336 $self->{req_h} = $h;
304 337
305 $self->{parent}->check_size 338 $self->{parent}->check_size;
306 if $self->{parent};
307 } 339 }
308} 340}
309 341
310sub update { 342sub update {
311 my ($self) = @_; 343 my ($self) = @_;
378 410
379package CFClient::UI::Empty; 411package CFClient::UI::Empty;
380 412
381our @ISA = CFClient::UI::Base::; 413our @ISA = CFClient::UI::Base::;
382 414
415sub new {
416 my ($class, %arg) = @_;
417 $class->SUPER::new (can_events => 0, %arg);
418}
419
383sub size_request { 420sub size_request {
384 (0, 0) 421 (0, 0)
385} 422}
386 423
387sub draw { } 424sub draw { }
395sub new { 432sub new {
396 my ($class, %arg) = @_; 433 my ($class, %arg) = @_;
397 434
398 my $children = delete $arg{children} || []; 435 my $children = delete $arg{children} || [];
399 436
400 my $self = $class->SUPER::new (children => [], %arg); 437 my $self = $class->SUPER::new (children => [], can_events => 0, %arg);
401 $self->add ($_) for @$children; 438 $self->add ($_) for @$children;
402 439
403 $self 440 $self
404} 441}
405 442
424 delete $child->{parent}; 461 delete $child->{parent};
425 462
426 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 463 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
427 464
428 $self->check_size; 465 $self->check_size;
466 $self->update;
429} 467}
430 468
431sub find_widget { 469sub find_widget {
432 my ($self, $x, $y) = @_; 470 my ($self, $x, $y) = @_;
433 471
561sub new { die } 599sub new { die }
562 600
563sub size_request { 601sub size_request {
564 my ($self) = @_; 602 my ($self) = @_;
565 603
566 @$self{qw(child_w child_h)} = $self->child->size_request; 604 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
567 $self->child->size_allocate (0, 0, @$self{qw(child_w child_h)}); 605 $self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
568 606
569 @$self{qw(child_w child_h)} 607 @$self{qw(child_w child_h)}
570} 608}
571 609
659 697
660 my $self = $class->SUPER::new ( 698 my $self = $class->SUPER::new (
661 bg => [1, 1, 1, 1], 699 bg => [1, 1, 1, 1],
662 border_bg => [1, 1, 1, 1], 700 border_bg => [1, 1, 1, 1],
663 border => 0.8, 701 border => 0.8,
702 can_events => 1,
664 @_ 703 @_
665 ); 704 );
666 705
667 $self->{title} &&= new CFClient::UI::Label 706 $self->{title} &&= new CFClient::UI::Label
668 align => 0, 707 align => 0,
837 or next; 876 or next;
838 877
839 for my $x (0 .. $#$row) { 878 for my $x (0 .. $#$row) {
840 my $widget = $row->[$x] 879 my $widget = $row->[$x]
841 or next; 880 or next;
842 my ($w, $h) = $widget->size_request; 881 my ($w, $h) = @$widget{qw(req_w req_h)};
843 882
844 $w[$x] = max $w[$x], $w; 883 $w[$x] = max $w[$x], $w;
845 $h[$y] = max $h[$y], $h; 884 $h[$y] = max $h[$y], $h;
846 } 885 }
847 } 886 }
952 991
953 ($h, $w) = ($w, $h); 992 ($h, $w) = ($w, $h);
954 993
955 my $children = $self->{children}; 994 my $children = $self->{children};
956 995
957 my @h = map +($_->size_request)[0], @$children; 996 my @h = map $_->{req_w}, @$children;
958 997
959 my $req_h = List::Util::sum @h; 998 my $req_h = List::Util::sum @h;
960 999
961 if ($req_h > $h) { 1000 if ($req_h > $h) {
962 # ah well, not enough space 1001 # ah well, not enough space
1010sub size_allocate { 1049sub size_allocate {
1011 my ($self, $w, $h) = @_; 1050 my ($self, $w, $h) = @_;
1012 1051
1013 my $children = $self->{children}; 1052 my $children = $self->{children};
1014 1053
1015 my @h = map +($_->size_request)[1], @$children; 1054 my @h = map $_->{req_h}, @$children;
1016 1055
1017 my $req_h = List::Util::sum @h; 1056 my $req_h = List::Util::sum @h;
1018 1057
1019 if ($req_h > $h) { 1058 if ($req_h > $h) {
1020 # ah well, not enough space 1059 # ah well, not enough space
1061 text => "", 1100 text => "",
1062 align => -1, 1101 align => -1,
1063 valign => -1, 1102 valign => -1,
1064 padding => 2, 1103 padding => 2,
1065 layout => new CFClient::Layout, 1104 layout => new CFClient::Layout,
1105 can_events => 0,
1066 %arg 1106 %arg
1067 ); 1107 );
1068 1108
1069 if (exists $self->{template}) { 1109 if (exists $self->{template}) {
1070 my $layout = new CFClient::Layout; 1110 my $layout = new CFClient::Layout;
1092 my ($self, $text) = @_; 1132 my ($self, $text) = @_;
1093 1133
1094 $self->{layout}->set_text ($text); 1134 $self->{layout}->set_text ($text);
1095 1135
1096 delete $self->{texture}; 1136 delete $self->{texture};
1137 $self->check_size;
1097 $self->update; 1138 $self->update;
1098} 1139}
1099 1140
1100sub set_markup { 1141sub set_markup {
1101 my ($self, $markup) = @_; 1142 my ($self, $markup) = @_;
1102 1143
1103 $self->{layout}->set_markup ($markup); 1144 $self->{layout}->set_markup ($markup);
1104 1145
1105 delete $self->{texture}; 1146 delete $self->{texture};
1147 $self->check_size;
1106 $self->update; 1148 $self->update;
1107} 1149}
1108 1150
1109sub size_request { 1151sub size_request {
1110 my ($self) = @_; 1152 my ($self) = @_;
1137 1179
1138sub set_fontsize { 1180sub set_fontsize {
1139 my ($self, $fontsize) = @_; 1181 my ($self, $fontsize) = @_;
1140 1182
1141 $self->{fontsize} = $fontsize; 1183 $self->{fontsize} = $fontsize;
1184 delete $self->{texture};
1142 $self->check_size; 1185 $self->check_size;
1186 $self->update;
1143} 1187}
1144 1188
1145sub _draw { 1189sub _draw {
1146 my ($self) = @_; 1190 my ($self) = @_;
1147 1191
1193 active_bg => [1, 1, 1, 0.5], 1237 active_bg => [1, 1, 1, 0.5],
1194 active_fg => [0, 0, 0], 1238 active_fg => [0, 0, 0],
1195 can_hover => 1, 1239 can_hover => 1,
1196 can_focus => 1, 1240 can_focus => 1,
1197 valign => 0, 1241 valign => 0,
1242 can_events => 1,
1198 @_ 1243 @_
1199 ) 1244 )
1200} 1245}
1201 1246
1202sub _set_text { 1247sub _set_text {
1230} 1275}
1231 1276
1232sub size_allocate { 1277sub size_allocate {
1233 my ($self, $w, $h) = @_; 1278 my ($self, $w, $h) = @_;
1234 1279
1235 $self->_set_text ($self->{text}); 1280 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1236} 1281}
1237 1282
1238sub set_text { 1283sub set_text {
1239 my ($self, $text) = @_; 1284 my ($self, $text) = @_;
1240 1285
1387 bg => [1, 1, 1, 0.2], 1432 bg => [1, 1, 1, 0.2],
1388 active_fg => [0, 0, 1], 1433 active_fg => [0, 0, 1],
1389 can_hover => 1, 1434 can_hover => 1,
1390 align => 0, 1435 align => 0,
1391 valign => 0, 1436 valign => 0,
1437 can_events => 1,
1392 @_ 1438 @_
1393 ) 1439 )
1394} 1440}
1395 1441
1396sub button_up { 1442sub button_up {
1501our %loaded_images; 1547our %loaded_images;
1502 1548
1503sub new { 1549sub new {
1504 my $class = shift; 1550 my $class = shift;
1505 1551
1506 my $self = $class->SUPER::new (@_); 1552 my $self = $class->SUPER::new (can_events => 0, @_);
1507 1553
1508 $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; 1554 $self->{image} or confess "Image has 'image' not set. This is a fatal error!";
1509 1555
1510 $loaded_images{$self->{image}} ||= 1556 $loaded_images{$self->{image}} ||=
1511 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; 1557 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;
1670package CFClient::UI::Gauge; 1716package CFClient::UI::Gauge;
1671 1717
1672our @ISA = CFClient::UI::VBox::; 1718our @ISA = CFClient::UI::VBox::;
1673 1719
1674sub new { 1720sub new {
1675 my ($class, %arg) = shift; 1721 my ($class, %arg) = @_;
1676 1722
1677 my $self = $class->SUPER::new ( 1723 my $self = $class->SUPER::new (
1678 @_, 1724 tooltip => $arg{type},
1725 %arg,
1679 ); 1726 );
1680 1727
1681 $self->add ($self->{value} = new CFClient::UI::Label valign => 1, align => 0, template => "999"); 1728 $self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1682 $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1); 1729 $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1);
1683 $self->add ($self->{max} = new CFClient::UI::Label valign => 1, align => 0, template => "999"); 1730 $self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");
1684 1731
1685 $self 1732 $self
1686} 1733}
1687 1734
1688sub set_fontsize { 1735sub set_fontsize {
2054 my $class = shift; 2101 my $class = shift;
2055 2102
2056 my $self = $class->SUPER::new ( 2103 my $self = $class->SUPER::new (
2057 state => 0, 2104 state => 0,
2058 connect_activate => \&toggle_flopper, 2105 connect_activate => \&toggle_flopper,
2106 can_events => 1,
2059 @_ 2107 @_
2060 ); 2108 );
2061 2109
2062 if ($self->{state}) { 2110 if ($self->{state}) {
2063 $self->{state} = 0; 2111 $self->{state} = 0;
2083 $self->emit (changed => $self->{state}); 2131 $self->emit (changed => $self->{state});
2084} 2132}
2085 2133
2086############################################################################# 2134#############################################################################
2087 2135
2136package CFClient::UI::Tooltip;
2137
2138our @ISA = CFClient::UI::Bin::;
2139
2140use CFClient::OpenGL;
2141
2142sub new {
2143 my $class = shift;
2144
2145 $class->SUPER::new (
2146 @_,
2147 can_events => 0,
2148 )
2149}
2150
2151sub set_text {
2152 my ($self, $text) = @_;
2153
2154 $self->{label} ||= new CFClient::UI::Label fontsize => 0.8;
2155 $self->{label}->set_text ($text);
2156 $self->add ($self->{label});
2157}
2158
2159sub size_request {
2160 my ($self) = @_;
2161
2162 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2163
2164 $w = List::Util::min $::WIDTH * 0.2, $w;
2165
2166 ($w, $h)
2167}
2168
2169#############################################################################
2170
2088package CFClient::UI::Root; 2171package CFClient::UI::Root;
2089 2172
2090our @ISA = CFClient::UI::Container::; 2173our @ISA = CFClient::UI::Container::;
2091 2174
2092use CFClient::OpenGL; 2175use CFClient::OpenGL;
2093 2176
2094sub check_size { 2177sub check_size {
2095 my ($self) = @_; 2178 my ($self) = @_;
2096 2179
2097 $self->configure (0, 0, $::WITH, $::HEIGHT); 2180 $self->configure (0, 0, $::WIDTH, $::HEIGHT);
2098} 2181}
2099 2182
2100sub size_request { 2183sub size_request {
2101 ($::WIDTH, $::HEIGHT) 2184 ($::WIDTH, $::HEIGHT)
2102} 2185}
2104sub configure { 2187sub configure {
2105 my ($self, $x, $y, $w, $h) = @_; 2188 my ($self, $x, $y, $w, $h) = @_;
2106 2189
2107 $self->SUPER::configure ($x, $y, $w, $h); 2190 $self->SUPER::configure ($x, $y, $w, $h);
2108 2191
2109 $_->configure ($_->{x}, $_->{y}, $_->size_request)
2110 for @{$self->{children}}; 2192 for my $child (@{$self->{children}}) {
2193 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2194
2195 $X = List::Util::max 0, List::Util::min $w - $W, $X;
2196 $Y = List::Util::max 0, List::Util::min $h - $H, $Y;
2197 $child->configure ($X, $Y, $W,$H);
2198 }
2111} 2199}
2112 2200
2113sub _topleft { 2201sub _topleft {
2114 my ($self, $x, $y) = @_; 2202 my ($self, $x, $y) = @_;
2115 2203
2162############################################################################# 2250#############################################################################
2163 2251
2164package CFClient::UI; 2252package CFClient::UI;
2165 2253
2166$ROOT = new CFClient::UI::Root; 2254$ROOT = new CFClient::UI::Root;
2255$TOOLTIP = new CFClient::UI::Tooltip;
2167 2256
21681 22571
2169 2258

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines