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.214 by root, Wed May 17 22:59:13 2006 UTC vs.
Revision 1.271 by root, Fri Jun 2 22:13:47 2006 UTC

… …
5 5
6use Scalar::Util (); 6use Scalar::Util ();
7use List::Util (); 7use List::Util ();
8 8
9use CFClient; 9use CFClient;
10use CFClient::Texture;
10 11
11our ($FOCUS, $HOVER, $GRAB); # various widgets 12our ($FOCUS, $HOVER, $GRAB); # various widgets
12 13
14our $LAYOUT;
13our $ROOT; 15our $ROOT;
14our $TOOLTIP; 16our $TOOLTIP;
15our $BUTTON_STATE; 17our $BUTTON_STATE;
16 18
17our %WIDGET; # all widgets, weak-referenced 19our %WIDGET; # all widgets, weak-referenced
18 20
21sub get_layout {
22 my $layout;
23
24 for (grep { $_->{name} } values %WIDGET) {
25 my $win = $layout->{$_->{name}} = { };
26
27 $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
28 $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
29 $win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
30 $win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
31
32 $win->{show} = $_->{visible} && $_->{is_toplevel};
33 }
34
35 $layout
36}
37
38sub set_layout {
39 my ($layout) = @_;
40
41 $LAYOUT = $layout;
42}
43
19sub check_tooltip { 44sub check_tooltip {
45 return if $ENV{CFPLUS_DEBUG} & 8;
46
20 if (!$GRAB) { 47 if (!$GRAB) {
21 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) { 48 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
22 if (length $widget->{tooltip}) { 49 if (length $widget->{tooltip}) {
23
24 if ($TOOLTIP->{owner} != $widget) { 50 if ($TOOLTIP->{owner} != $widget) {
51 $TOOLTIP->hide;
52
25 $TOOLTIP->{owner} = $widget; 53 $TOOLTIP->{owner} = $widget;
26 54
27 my $tip = $widget->{tooltip}; 55 my $tip = $widget->{tooltip};
28 56
29 $tip = $tip->($widget) if CODE:: eq ref $tip; 57 $tip = $tip->($widget) if CODE:: eq ref $tip;
30 58
31 $TOOLTIP->set_tooltip_from ($widget); 59 $TOOLTIP->set_tooltip_from ($widget);
32 $TOOLTIP->show; 60 $TOOLTIP->show;
33
34 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
35
36 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
37 if $x + $TOOLTIP->{w} > $::WIDTH;
38
39 $TOOLTIP->move ($x, $y);
40 $TOOLTIP->check_size;
41 $TOOLTIP->update;
42 } 61 }
43 62
44 return; 63 return;
45 } 64 }
46 } 65 }
… …
50 delete $TOOLTIP->{owner}; 69 delete $TOOLTIP->{owner};
51} 70}
52 71
53# class methods for events 72# class methods for events
54sub feed_sdl_key_down_event { 73sub feed_sdl_key_down_event {
55 $FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0]) 74 $FOCUS->emit (key_down => $_[0])
56 if $FOCUS; 75 if $FOCUS;
57} 76}
58 77
59sub feed_sdl_key_up_event { 78sub feed_sdl_key_up_event {
60 $FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0]) 79 $FOCUS->emit (key_up => $_[0])
61 if $FOCUS; 80 if $FOCUS;
62} 81}
63 82
64sub feed_sdl_button_down_event { 83sub feed_sdl_button_down_event {
65 my ($ev) = @_; 84 my ($ev) = @_;
… …
74 check_tooltip; 93 check_tooltip;
75 } 94 }
76 95
77 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 96 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
78 97
79 if ($GRAB) { 98 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
80 ($x, $y) = $GRAB->coord2local ($x, $y); 99 if $GRAB;
81 $GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
82 }
83} 100}
84 101
85sub feed_sdl_button_up_event { 102sub feed_sdl_button_up_event {
86 my ($ev) = @_; 103 my ($ev) = @_;
87 my ($x, $y) = ($ev->{x}, $ev->{y}); 104 my ($x, $y) = ($ev->{x}, $ev->{y});
88 105
89 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 106 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
90 107
91 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 108 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
92 109
93 if ($GRAB) { 110 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
94 ($x, $y) = $GRAB->coord2local ($x, $y); 111 if $GRAB;
95 $GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
96 }
97 112
98 if (!$BUTTON_STATE) { 113 if (!$BUTTON_STATE) {
99 my $grab = $GRAB; undef $GRAB; 114 my $grab = $GRAB; undef $GRAB;
100 $grab->update if $grab; 115 $grab->update if $grab;
101 $GRAB->update if $GRAB; 116 $GRAB->update if $GRAB;
… …
117 $HOVER->update if $HOVER && $HOVER->{can_hover}; 132 $HOVER->update if $HOVER && $HOVER->{can_hover};
118 133
119 check_tooltip; 134 check_tooltip;
120 } 135 }
121 136
122 if ($HOVER) {
123 ($x, $y) = $HOVER->coord2local ($x, $y);
124 $HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y); 137 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
125 } 138 if $HOVER;
126} 139}
127 140
128# convert position array to integers 141# convert position array to integers
129sub harmonize { 142sub harmonize {
130 my ($vals) = @_; 143 my ($vals) = @_;
… …
136 $rem += $_ - $i; 149 $rem += $_ - $i;
137 $_ = $i; 150 $_ = $i;
138 } 151 }
139} 152}
140 153
154sub full_refresh {
155 # make a copy, otherwise for complains about freed values.
156 my @widgets = values %WIDGET;
157
158 $_->update
159 for @widgets;
160}
161
162sub reconfigure_widgets {
163 # make a copy, otherwise C<for> complains about freed values.
164 my @widgets = values %WIDGET;
165
166 $_->reconfigure
167 for @widgets;
168}
169
141# call when resolution changes etc. 170# call when resolution changes etc.
142sub rescale_widgets { 171sub rescale_widgets {
143 my ($sx, $sy) = @_; 172 my ($sx, $sy) = @_;
144 173
145 # make a copy, otherwise for complains about freed values.
146 my @widgets = values %WIDGET; 174 for my $widget (values %WIDGET) {
147
148 for my $widget (@widgets) {
149 if ($widget->{toplevel}) { 175 if ($widget->{is_toplevel}) {
176 $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
177 $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
178
150 $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x}; 179 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
151 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 180 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
152 $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w}; 181 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
153 $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
154 $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y}; 182 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
155 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 183 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
156 $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h}; 184 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
157 $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h}; 185
186 $widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
187 $widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
188
158 } 189 }
159
160 $widget->reconfigure;
161 } 190 }
191
192 reconfigure_widgets;
162} 193}
163 194
164############################################################################# 195#############################################################################
165 196
166package CFClient::UI::Base; 197package CFClient::UI::Base;
… …
171 202
172sub new { 203sub new {
173 my $class = shift; 204 my $class = shift;
174 205
175 my $self = bless { 206 my $self = bless {
176 x => 0, 207 x => "center",
177 y => 0, 208 y => "center",
178 z => 0, 209 z => 0,
210 w => undef,
211 h => undef,
179 can_events => 1, 212 can_events => 1,
180 @_ 213 @_
181 }, $class; 214 }, $class;
182 215
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
183 for (keys %$self) { 218 for (keys %$self) {
184 if (/^connect_(.*)$/) { 219 if (/^on_(.*)$/) {
185 $self->connect ($1 => delete $self->{$_}); 220 $self->connect ($1 => delete $self->{$_});
186 } 221 }
187 } 222 }
188 223
189 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 224 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
225 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
226 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
227 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
228 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
229
230 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
231 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
232
233 $self->show if $layout->{show};
234 }
190 235
191 $self 236 $self
192} 237}
193 238
194sub destroy { 239sub destroy {
… …
204 return if $self->{parent}; 249 return if $self->{parent};
205 250
206 $CFClient::UI::ROOT->add ($self); 251 $CFClient::UI::ROOT->add ($self);
207} 252}
208 253
209sub hide { 254sub set_visible {
210 my ($self) = @_; 255 my ($self) = @_;
256
257 return if $self->{visible};
258
259 $self->{root} = $self->{parent}{root};
260 $self->{visible} = $self->{parent}{visible} + 1;
261
262 $self->emit (visibility_change => 1);
263
264 $self->realloc if !exists $self->{req_w};
265
266 $_->set_visible for $self->children;
267}
268
269sub set_invisible {
270 my ($self) = @_;
271
272 return unless $self->{visible};
273
274 $_->set_invisible for $self->children;
275
276 delete $self->{root};
277 delete $self->{visible};
211 278
212 undef $GRAB if $GRAB == $self; 279 undef $GRAB if $GRAB == $self;
213 undef $HOVER if $HOVER == $self; 280 undef $HOVER if $HOVER == $self;
214 281
282 CFClient::UI::check_tooltip
283 if $TOOLTIP->{owner} == $self;
284
285 $self->focus_out;
286
287 $self->emit (visibility_change => 0);
288}
289
290sub set_visibility {
291 my ($self, $visible) = @_;
292
293 return if $self->{visible} == $visible;
294
295 $visible ? $self->hide
296 : $self->show;
297}
298
299sub toggle_visibility {
300 my ($self) = @_;
301
302 $self->{visible}
303 ? $self->hide
304 : $self->show;
305}
306
307sub hide {
308 my ($self) = @_;
309
310 $self->set_invisible;
311
215 $self->{parent}->remove ($self) 312 $self->{parent}->remove ($self)
216 if $self->{parent}; 313 if $self->{parent};
217} 314}
218 315
219sub move { 316sub move_abs {
220 my ($self, $x, $y, $z) = @_; 317 my ($self, $x, $y, $z) = @_;
221 318
222 $self->{x} = int $x; 319 $self->{x} = List::Util::max 0, int $x;
223 $self->{y} = int $y; 320 $self->{y} = List::Util::max 0, int $y;
224 $self->{z} = $z if defined $z; 321 $self->{z} = $z if defined $z;
225 322
226 $self->update; 323 $self->update;
227} 324}
228 325
229sub set_size { 326sub set_size {
230 my ($self, $w, $h) = @_; 327 my ($self, $w, $h) = @_;
231 328
232 $self->{user_w} = $w; 329 $self->{force_w} = $w;
233 $self->{user_h} = $h; 330 $self->{force_h} = $h;
234 331
235 $self->check_size; 332 $self->realloc;
236} 333}
237 334
238sub size_request { 335sub size_request {
239 require Carp; 336 require Carp;
240 Carp::confess "size_request is abstract"; 337 Carp::confess "size_request is abstract";
… …
242 339
243sub configure { 340sub configure {
244 my ($self, $x, $y, $w, $h) = @_; 341 my ($self, $x, $y, $w, $h) = @_;
245 342
246 if ($self->{aspect}) { 343 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h);
345
247 my $w2 = List::Util::min $w, int $h * $self->{aspect}; 346 $w = List::Util::min $w, int $h * $self->{aspect};
248 my $h2 = List::Util::min $h, int $w / $self->{aspect}; 347 $h = List::Util::min $h, int $w / $self->{aspect};
249 348
250 # use alignment to adjust x, y 349 # use alignment to adjust x, y
251 350
252 $x += int +($w - $w2) * 0.5; 351 $x += int 0.5 * ($ow - $w);
253 $y += int +($h - $h2) * 0.5; 352 $y += int 0.5 * ($oh - $h);
254
255 ($w, $h) = ($w2, $h2);
256 } 353 }
257 354
258 if ($self->{x} != $x || $self->{y} != $y) { 355 if ($self->{x} ne $x || $self->{y} ne $y) {
259 $self->{x} = $x; 356 $self->{x} = $x;
260 $self->{y} = $y; 357 $self->{y} = $y;
261 $self->update; 358 $self->update;
262 } 359 }
263 360
264 if ($self->{w} != $w || $self->{h} != $h) { 361 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
265 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h]; 362 return unless $self->{visible};
363
364 $self->{alloc_w} = $w;
365 $self->{alloc_h} = $h;
366
367 $self->{root}{size_alloc}{$self+0} = $self;
266 } 368 }
267} 369}
268 370
269sub size_allocate { 371sub size_allocate {
270 # nothing to be done 372 # nothing to be done
271} 373}
272 374
273sub reconfigure {
274 my ($self) = @_;
275
276 $self->check_size (1);
277 $self->update;
278}
279
280sub children { 375sub children {
281} 376}
282 377
283sub set_max_size { 378sub set_max_size {
284 my ($self, $w, $h) = @_; 379 my ($self, $w, $h) = @_;
… …
287 delete $self->{max_h}; $self->{max_h} = $h if $h; 382 delete $self->{max_h}; $self->{max_h} = $h if $h;
288} 383}
289 384
290sub set_tooltip { 385sub set_tooltip {
291 my ($self, $tooltip) = @_; 386 my ($self, $tooltip) = @_;
387
388 $tooltip =~ s/^\s+//;
389 $tooltip =~ s/\s+$//;
390
391 return if $self->{tooltip} eq $tooltip;
292 392
293 $self->{tooltip} = $tooltip; 393 $self->{tooltip} = $tooltip;
294 394
295 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 395 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
296 delete $CFClient::UI::TOOLTIP->{owner}; 396 delete $CFClient::UI::TOOLTIP->{owner};
… …
318 return if $FOCUS == $self; 418 return if $FOCUS == $self;
319 return unless $self->{can_focus}; 419 return unless $self->{can_focus};
320 420
321 my $focus = $FOCUS; $FOCUS = $self; 421 my $focus = $FOCUS; $FOCUS = $self;
322 422
323 $self->emit (focus_in => $focus); 423 $self->_emit (focus_in => $focus);
324 424
325 $focus->update if $focus; 425 $focus->update if $focus;
326 $FOCUS->update; 426 $FOCUS->update;
327} 427}
328 428
… …
331 431
332 return unless $FOCUS == $self; 432 return unless $FOCUS == $self;
333 433
334 my $focus = $FOCUS; undef $FOCUS; 434 my $focus = $FOCUS; undef $FOCUS;
335 435
336 $self->emit (focus_out => $focus); 436 $self->_emit (focus_out => $focus);
337 437
338 $focus->update if $focus; #? 438 $focus->update if $focus; #?
339}
340 439
440 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
441 unless $FOCUS;
442}
443
341sub mouse_motion { } 444sub mouse_motion { 0 }
342sub button_up { } 445sub button_up { 0 }
343sub key_down { } 446sub key_down { 0 }
344sub key_up { } 447sub key_up { 0 }
345 448
346sub button_down { 449sub button_down {
347 my ($self, $ev, $x, $y) = @_; 450 my ($self, $ev, $x, $y) = @_;
348 451
349 $self->focus_in; 452 $self->focus_in;
350}
351 453
352sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 454 0
353sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 455}
354sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 456
355sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 457sub find_widget {
356sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 458 my ($self, $x, $y) = @_;
459
460 return () unless $self->{can_events};
461
462 return $self
463 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
464 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
465
466 ()
467}
468
469sub set_parent {
470 my ($self, $parent) = @_;
471
472 Scalar::Util::weaken ($self->{parent} = $parent);
473 $self->set_visible if $parent->{visible};
474}
475
476sub connect {
477 my ($self, $signal, $cb) = @_;
478
479 push @{ $self->{signal_cb}{$signal} }, $cb;
480}
481
482sub _emit {
483 my ($self, $signal, @args) = @_;
484
485 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
486}
487
488sub emit {
489 my ($self, $signal, @args) = @_;
490
491 $self->_emit ($signal, @args)
492 || $self->$signal (@args);
493}
494
495sub visibility_change {
496 #my ($self, $visible) = @_;
497}
498
499sub realloc {
500 my ($self) = @_;
501
502 if ($self->{visible}) {
503 return if $self->{root}{realloc}{$self+0};
504
505 $self->{root}{realloc}{$self+0} = $self;
506 $self->{root}->update;
507 } else {
508 delete $self->{req_w};
509 delete $self->{req_h};
510 }
511}
512
513sub update {
514 my ($self) = @_;
515
516 $self->{parent}->update
517 if $self->{parent};
518}
519
520sub reconfigure {
521 my ($self) = @_;
522
523 $self->realloc;
524 $self->update;
525}
526
527# using global variables seems a bit hacky, but passing through all drawing
528# functions seems pointless.
529our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
357 530
358sub draw { 531sub draw {
359 my ($self) = @_; 532 my ($self) = @_;
360 533
361 return unless $self->{h} && $self->{w}; 534 return unless $self->{h} && $self->{w};
535
536 # update screen rectangle
537 local $draw_x = $draw_x + $self->{x};
538 local $draw_y = $draw_y + $self->{y};
539 local $draw_w = $draw_x + $self->{w};
540 local $draw_h = $draw_y + $self->{h};
541
542 # skip widgets that are entirely outside the drawing area
543 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
544 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
362 545
363 glPushMatrix; 546 glPushMatrix;
364 glTranslate $self->{x}, $self->{y}, 0; 547 glTranslate $self->{x}, $self->{y}, 0;
365 $self->_draw; 548 $self->_draw;
366 glPopMatrix; 549 glPopMatrix;
… …
378 glVertex $x , $y + $self->{h}; 561 glVertex $x , $y + $self->{h};
379 glEnd; 562 glEnd;
380 glDisable GL_BLEND; 563 glDisable GL_BLEND;
381 } 564 }
382 565
383 if ($ENV{PCLIENT_DEBUG}) { 566 if ($ENV{CFPLUS_DEBUG} & 1) {
384 glPushMatrix; 567 glPushMatrix;
385 glColor 1, 1, 0, 1; 568 glColor 1, 1, 0, 1;
386 glTranslate $self->{x} + 0.375, $self->{y} + 0.375; 569 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
387 glBegin GL_LINE_LOOP; 570 glBegin GL_LINE_LOOP;
388 glVertex 0 , 0; 571 glVertex 0 , 0;
389 glVertex $self->{w}, 0; 572 glVertex $self->{w} - 1, 0;
390 glVertex $self->{w}, $self->{h}; 573 glVertex $self->{w} - 1, $self->{h} - 1;
391 glVertex 0 , $self->{h}; 574 glVertex 0 , $self->{h} - 1;
392 glEnd; 575 glEnd;
393 glPopMatrix; 576 glPopMatrix;
394 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw; 577 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
395 } 578 }
396} 579}
397 580
398sub _draw { 581sub _draw {
399 my ($self) = @_; 582 my ($self) = @_;
400 583
401 warn "no draw defined for $self\n"; 584 warn "no draw defined for $self\n";
402}
403
404sub find_widget {
405 my ($self, $x, $y) = @_;
406
407 return () unless $self->{can_events};
408
409 return $self
410 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
411 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
412
413 ()
414}
415
416sub set_parent {
417 my ($self, $parent) = @_;
418
419 Scalar::Util::weaken ($self->{parent} = $parent);
420
421 # TODO: req_w _does_change after ->reconfigure
422 $self->check_size
423 unless exists $self->{req_w};
424}
425
426sub check_size {
427 my ($self, $forced) = @_;
428
429 $self->{force_alloc} = 1 if $forced;
430 $CFClient::UI::ROOT->{check_size}{$self} = $self;
431}
432
433sub update {
434 my ($self) = @_;
435
436 $self->{parent}->update
437 if $self->{parent};
438}
439
440sub connect {
441 my ($self, $signal, $cb) = @_;
442
443 push @{ $self->{signal_cb}{$signal} }, $cb;
444}
445
446sub emit {
447 my ($self, $signal, @args) = @_;
448
449 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
450} 585}
451 586
452sub DESTROY { 587sub DESTROY {
453 my ($self) = @_; 588 my ($self) = @_;
454 589
… …
512 my ($class, %arg) = @_; 647 my ($class, %arg) = @_;
513 $class->SUPER::new (can_events => 0, %arg); 648 $class->SUPER::new (can_events => 0, %arg);
514} 649}
515 650
516sub size_request { 651sub size_request {
517 (0, 0) 652 my ($self) = @_;
653
654 ($self->{w} + 0, $self->{h} + 0)
518} 655}
519 656
520sub draw { } 657sub draw { }
521 658
522############################################################################# 659#############################################################################
… …
551 $self->{children} = [ 688 $self->{children} = [
552 sort { $a->{z} <=> $b->{z} } 689 sort { $a->{z} <=> $b->{z} }
553 @{$self->{children}}, @widgets 690 @{$self->{children}}, @widgets
554 ]; 691 ];
555 692
556 $self->check_size (1); 693 $self->realloc;
557 $self->update;
558} 694}
559 695
560sub children { 696sub children {
561 @{ $_[0]{children} } 697 @{ $_[0]{children} }
562} 698}
… …
567 delete $child->{parent}; 703 delete $child->{parent};
568 $child->hide; 704 $child->hide;
569 705
570 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 706 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
571 707
572 $self->check_size; 708 $self->realloc;
573 $self->update;
574} 709}
575 710
576sub clear { 711sub clear {
577 my ($self) = @_; 712 my ($self) = @_;
578 713
… …
582 for (@$children) { 717 for (@$children) {
583 delete $_->{parent}; 718 delete $_->{parent};
584 $_->hide; 719 $_->hide;
585 } 720 }
586 721
587 $self->check_size; 722 $self->realloc;
588 $self->update;
589} 723}
590 724
591sub find_widget { 725sub find_widget {
592 my ($self, $x, $y) = @_; 726 my ($self, $x, $y) = @_;
593 727
… …
680 $self->SUPER::size_allocate ($w, $h); 814 $self->SUPER::size_allocate ($w, $h);
681 $self->update; 815 $self->update;
682} 816}
683 817
684sub _render { 818sub _render {
819 my ($self) = @_;
820
685 $_[0]{children}[0]->draw; 821 $self->{children}[0]->draw;
686} 822}
687 823
688sub render_child { 824sub render_child {
689 my ($self) = @_; 825 my ($self) = @_;
690 826
691 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 827 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
692 glClearColor 0, 0, 0, 0; 828 glClearColor 0, 0, 0, 0;
693 glClear GL_COLOR_BUFFER_BIT; 829 glClear GL_COLOR_BUFFER_BIT;
694 830
831 {
832 package CFClient::UI::Base;
833
834 ($draw_x, $draw_y, $draw_w, $draw_h) =
835 (0, 0, $self->{w}, $self->{h});
836 }
837
695 $self->_render; 838 $self->_render;
696# glColorMask 1, 1, 1, 0;
697# glEnable GL_BLEND;
698# glBlendFunc GL_SRC_ALPHA, GL_ZERO;
699# glRasterPos 0, 0;
700# glCopyPixels 0, 0, $self->{w}, $self->{h};
701# glDisable GL_BLEND;
702# glColorMask 1, 1, 1, 1;
703 }; 839 };
704} 840}
705 841
706sub _draw { 842sub _draw {
707 my ($self) = @_; 843 my ($self) = @_;
708 844
709 my ($w, $h) = ($self->w, $self->h); 845 my ($w, $h) = @$self{qw(w h)};
710 846
711 my $tex = $self->{texture} 847 my $tex = $self->{texture}
712 or return; 848 or return;
713 849
714 glEnable GL_TEXTURE_2D; 850 glEnable GL_TEXTURE_2D;
715 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 851 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
716 glColor 0, 0, 0, 1; 852 glColor 1, 1, 1, 1;
717 853
718 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h); 854 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
719 855
720 glDisable GL_TEXTURE_2D; 856 glDisable GL_TEXTURE_2D;
721} 857}
… …
724 860
725package CFClient::UI::ViewPort; 861package CFClient::UI::ViewPort;
726 862
727our @ISA = CFClient::UI::Window::; 863our @ISA = CFClient::UI::Window::;
728 864
865sub new {
866 my $class = shift;
867
868 $class->SUPER::new (
869 scroll_x => 0,
870 scroll_y => 1,
871 @_,
872 )
873}
874
729sub size_request { 875sub size_request {
730 my ($self) = @_; 876 my ($self) = @_;
731 877
732 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)}; 878 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
733 $self->child->configure (0, 0, @$self{qw(child_w child_h)});
734 879
735 @$self{qw(child_w child_h)} 880 $w = 10 if $self->{scroll_x};
881 $h = 10 if $self->{scroll_y};
882
883 ($w, $h)
736} 884}
737 885
738sub size_allocate { 886sub size_allocate {
739 my ($self, $w, $h) = @_; 887 my ($self, $w, $h) = @_;
740 888
889 my $child = $self->child;
890
891 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
892 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
893
894 $self->child->configure (0, 0, $w, $h);
741 $self->update; 895 $self->update;
742} 896}
743 897
744sub set_offset { 898sub set_offset {
745 my ($self, $x, $y) = @_; 899 my ($self, $x, $y) = @_;
… …
779} 933}
780 934
781sub _render { 935sub _render {
782 my ($self) = @_; 936 my ($self) = @_;
783 937
938 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
939 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
940
784 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 941 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
785 942
786 $self->SUPER::_render; 943 $self->SUPER::_render;
787} 944}
788 945
… …
796 my $class = shift; 953 my $class = shift;
797 954
798 my $self; 955 my $self;
799 956
800 my $slider = new CFClient::UI::Slider 957 my $slider = new CFClient::UI::Slider
801 vertical => 1, 958 vertical => 1,
802 range => [0, 0, 1, 0.01], # HACK fix 959 range => [0, 0, 1, 0.01], # HACK fix
803 connect_changed => sub { 960 on_changed => sub {
804 $self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h})); 961 $self->{vp}->set_offset (0, $_[1]);
805 }, 962 },
806 ; 963 ;
807 964
808 $self = $class->SUPER::new ( 965 $self = $class->SUPER::new (
809 vp => (new CFClient::UI::ViewPort), 966 vp => (new CFClient::UI::ViewPort expand => 1),
810 slider => $slider, 967 slider => $slider,
811 @_, 968 @_,
812 ); 969 );
813 970
814 $self->{vp}->add ($self->{scrolled}); 971 $self->{vp}->add ($self->{scrolled});
815 $self->add ($self->{vp}); 972 $self->add ($self->{vp});
816 $self->add ($self->{slider}); 973 $self->add ($self->{slider});
817 974
818 $self 975 $self
976}
977
978sub update {
979 my ($self) = @_;
980
981 $self->SUPER::update;
982
983 # todo: overwrite size_allocate of child
984 my $child = $self->{vp}->child;
985 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
986}
987
988sub size_allocate {
989 my ($self, $w, $h) = @_;
990
991 $self->SUPER::size_allocate ($w, $h);
992
993 my $child = $self->{vp}->child;
994 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
819} 995}
820 996
821#TODO# update range on size_allocate depending on child 997#TODO# update range on size_allocate depending on child
822# update viewport offset on scroll 998# update viewport offset on scroll
823 999
… …
867 1043
868our @ISA = CFClient::UI::Bin::; 1044our @ISA = CFClient::UI::Bin::;
869 1045
870use CFClient::OpenGL; 1046use CFClient::OpenGL;
871 1047
872my @tex = 1048my $bg =
1049 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1050 mipmap => 1, wrap => 1;
1051
1052my @border =
873 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 1053 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
874 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png); 1054 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
875 1055
876sub new { 1056sub new {
877 my $class = shift; 1057 my ($class, %arg) = @_;
878 1058
879 # TODO: user_x, user_y, overwrite moveto? 1059 my $title = delete $arg{title};
880 1060
881 my $self = $class->SUPER::new ( 1061 my $self = $class->SUPER::new (
882 bg => [1, 1, 1, 1], 1062 bg => [1, 1, 1, 1],
883 border_bg => [1, 1, 1, 1], 1063 border_bg => [1, 1, 1, 1],
884 border => 0.6, 1064 border => 0.6,
885 toplevel => 1,
886 can_events => 1, 1065 can_events => 1,
887 @_ 1066 min_w => 16,
1067 min_h => 16,
1068 %arg,
888 ); 1069 );
889 1070
890 $self->{title} &&= new CFClient::UI::Label 1071 $self->{title} = new CFClient::UI::Label
891 align => 0, 1072 align => 0,
892 valign => 1, 1073 valign => 1,
893 text => $self->{title}, 1074 text => $title,
894 fontsize => $self->{border}; 1075 fontsize => $self->{border}
1076 if defined $title;
895 1077
896 $self 1078 $self
1079}
1080
1081sub add {
1082 my ($self, @widgets) = @_;
1083
1084 $self->SUPER::add (@widgets);
1085 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
897} 1086}
898 1087
899sub border { 1088sub border {
900 int $_[0]{border} * $::FONTSIZE 1089 int $_[0]{border} * $::FONTSIZE
901} 1090}
902 1091
903sub size_request { 1092sub size_request {
904 my ($self) = @_; 1093 my ($self) = @_;
1094
1095 $self->{title}->size_request
1096 if $self->{title};
905 1097
906 my ($w, $h) = $self->SUPER::size_request; 1098 my ($w, $h) = $self->SUPER::size_request;
907 1099
908 ( 1100 (
909 $w + $self->border * 2, 1101 $w + $self->border * 2,
… …
912} 1104}
913 1105
914sub size_allocate { 1106sub size_allocate {
915 my ($self, $w, $h) = @_; 1107 my ($self, $w, $h) = @_;
916 1108
1109 if ($self->{title}) {
1110 $self->{title}{w} = $w;
1111 $self->{title}{h} = $h;
1112 $self->{title}->size_allocate ($w, $h);
1113 }
1114
1115 my $border = $self->border;
1116
917 $h -= List::Util::max 0, $self->border * 2; 1117 $h -= List::Util::max 0, $border * 2;
918 $w -= List::Util::max 0, $self->border * 2; 1118 $w -= List::Util::max 0, $border * 2;
919 1119
920 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
921 if $self->{title};
922
923 $self->child->configure ($self->border, $self->border, $w, $h); 1120 $self->child->configure ($border, $border, $w, $h);
924} 1121}
925 1122
926sub button_down { 1123sub button_down {
927 my ($self, $ev, $x, $y) = @_; 1124 my ($self, $ev, $x, $y) = @_;
928 1125
… …
944 my ($ev, $x, $y) = @_; 1141 my ($ev, $x, $y) = @_;
945 1142
946 my $dx = $ev->{x} - $ox; 1143 my $dx = $ev->{x} - $ox;
947 my $dy = $ev->{y} - $oy; 1144 my $dy = $ev->{y} - $oy;
948 1145
949 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1); 1146 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
950 $self->{user_h} = $bh + $dy * ($my ? -1 : 1); 1147 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1148
1149 $self->realloc;
951 $self->move ($wx + $dx * $mx, $wy + $dy * $my); 1150 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
952 $self->check_size;
953 }; 1151 };
954 1152
955 } elsif ($lr ^ $td) { 1153 } elsif ($lr ^ $td) {
956 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1154 my ($ox, $oy) = ($ev->{x}, $ev->{y});
957 my ($bx, $by) = ($self->{x}, $self->{y}); 1155 my ($bx, $by) = ($self->{x}, $self->{y});
… …
959 $self->{motion} = sub { 1157 $self->{motion} = sub {
960 my ($ev, $x, $y) = @_; 1158 my ($ev, $x, $y) = @_;
961 1159
962 ($x, $y) = ($ev->{x}, $ev->{y}); 1160 ($x, $y) = ($ev->{x}, $ev->{y});
963 1161
964 $self->move ($bx + $x - $ox, $by + $y - $oy); 1162 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
965 $self->update;
966 }; 1163 };
1164 } else {
1165 return 0;
1166 }
1167
967 } 1168 1
968} 1169}
969 1170
970sub button_up { 1171sub button_up {
971 my ($self, $ev, $x, $y) = @_; 1172 my ($self, $ev, $x, $y) = @_;
972 1173
973 delete $self->{motion}; 1174 !!delete $self->{motion}
974} 1175}
975 1176
976sub mouse_motion { 1177sub mouse_motion {
977 my ($self, $ev, $x, $y) = @_; 1178 my ($self, $ev, $x, $y) = @_;
978 1179
979 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1180 $self->{motion}->($ev, $x, $y) if $self->{motion};
1181
1182 !!$self->{motion}
980} 1183}
981 1184
982sub _draw { 1185sub _draw {
983 my ($self) = @_; 1186 my ($self) = @_;
984 1187
1188 my $child = $self->{children}[0];
1189
985 my ($w, $h ) = ($self->{w}, $self->{h}); 1190 my ($w, $h ) = ($self->{w}, $self->{h});
986 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 1191 my ($cw, $ch) = ($child->{w}, $child->{h});
987 1192
988 glEnable GL_TEXTURE_2D; 1193 glEnable GL_TEXTURE_2D;
989 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1194 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
990 1195
991 my $border = $self->border; 1196 my $border = $self->border;
992 1197
993 glColor @{ $self->{border_bg} }; 1198 glColor @{ $self->{border_bg} };
994 $tex[1]->draw_quad_alpha (0, 0, $w, $border); 1199 $border[0]->draw_quad_alpha (0, 0, $w, $border);
995 $tex[3]->draw_quad_alpha (0, $border, $border, $ch); 1200 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
996 $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1201 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
997 $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border); 1202 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
998 1203
999 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1204 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1000 my $bg = $tex[0]; 1205 glColor @{ $self->{bg} };
1001 1206
1002 # TODO: repeat texture not scale 1207 # TODO: repeat texture not scale
1208 # solve this better(?)
1003 my $rep_x = $cw / $bg->{w}; 1209 $bg->{s} = $cw / $bg->{w};
1004 my $rep_y = $ch / $bg->{h}; 1210 $bg->{t} = $ch / $bg->{h};
1005
1006 glColor @{ $self->{bg} };
1007
1008 $bg->{s} = $rep_x;
1009 $bg->{t} = $rep_y;
1010 $bg->{wrap_mode} = 1;
1011 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1211 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1012 } 1212 }
1013 1213
1014 glDisable GL_TEXTURE_2D; 1214 glDisable GL_TEXTURE_2D;
1015 1215
1016 $self->{title}->draw if $self->{title};
1017
1018 $self->child->draw; 1216 $child->draw;
1217
1218 if ($self->{title}) {
1219 glTranslate 0, $border - $self->{h};
1220 $self->{title}->_draw;
1221 }
1019} 1222}
1020 1223
1021############################################################################# 1224#############################################################################
1022 1225
1023package CFClient::UI::Table; 1226package CFClient::UI::Table;
… …
1031sub new { 1234sub new {
1032 my $class = shift; 1235 my $class = shift;
1033 1236
1034 $class->SUPER::new ( 1237 $class->SUPER::new (
1035 col_expand => [], 1238 col_expand => [],
1036 @_ 1239 @_,
1037 ) 1240 )
1241}
1242
1243sub children {
1244 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1038} 1245}
1039 1246
1040sub add { 1247sub add {
1041 my ($self, $x, $y, $child) = @_; 1248 my ($self, $x, $y, $child) = @_;
1042 1249
1043 $child->set_parent ($self); 1250 $child->set_parent ($self);
1044 $self->{children}[$y][$x] = $child; 1251 $self->{children}[$y][$x] = $child;
1045 1252
1046 $child->check_size; 1253 $self->realloc;
1047} 1254}
1048 1255
1049sub children {
1050 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1051}
1052
1053# TODO: move to container class maybe? send childs a signal on removal? 1256# TODO: move to container class maybe? send children a signal on removal?
1054sub clear { 1257sub clear {
1055 my ($self) = @_; 1258 my ($self) = @_;
1056 1259
1057 my @children = $self->children; 1260 my @children = $self->children;
1058 delete $self->{children}; 1261 delete $self->{children};
… …
1060 for (@children) { 1263 for (@children) {
1061 delete $_->{parent}; 1264 delete $_->{parent};
1062 $_->hide; 1265 $_->hide;
1063 } 1266 }
1064 1267
1065 $self->update; 1268 $self->realloc;
1066} 1269}
1067 1270
1068sub get_wh { 1271sub get_wh {
1069 my ($self) = @_; 1272 my ($self) = @_;
1070 1273
… …
1101sub size_allocate { 1304sub size_allocate {
1102 my ($self, $w, $h) = @_; 1305 my ($self, $w, $h) = @_;
1103 1306
1104 my ($ws, $hs) = $self->get_wh; 1307 my ($ws, $hs) = $self->get_wh;
1105 1308
1106 my $req_w = sum @$ws; 1309 my $req_w = (sum @$ws) || 1;
1107 my $req_h = sum @$hs; 1310 my $req_h = (sum @$hs) || 1;
1108 1311
1109 # TODO: nicer code && do row_expand 1312 # TODO: nicer code && do row_expand
1110 my @col_expand = @{$self->{col_expand}}; 1313 my @col_expand = @{$self->{col_expand}};
1111 @col_expand = (1) x @$ws unless @col_expand; 1314 @col_expand = (1) x @$ws unless @col_expand;
1112 my $col_expand = (sum @col_expand) || 1; 1315 my $col_expand = (sum @col_expand) || 1;
… …
1166 } 1369 }
1167} 1370}
1168 1371
1169############################################################################# 1372#############################################################################
1170 1373
1171package CFClient::UI::HBox; 1374package CFClient::UI::Box;
1172
1173# TODO: wrap into common Box base class
1174 1375
1175our @ISA = CFClient::UI::Container::; 1376our @ISA = CFClient::UI::Container::;
1176 1377
1177sub size_request { 1378sub size_request {
1178 my ($self) = @_; 1379 my ($self) = @_;
1179 1380
1180 my @alloc = map [$_->size_request], @{$self->{children}}; 1381 $self->{vertical}
1181 1382 ? (
1182 ( 1383 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1183 (List::Util::sum map $_->[0], @alloc), 1384 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1184 (List::Util::max map $_->[1], @alloc), 1385 )
1185 ) 1386 : (
1387 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1388 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1389 )
1186} 1390}
1187 1391
1188sub size_allocate { 1392sub size_allocate {
1189 my ($self, $w, $h) = @_; 1393 my ($self, $w, $h) = @_;
1190 1394
1191 ($h, $w) = ($w, $h); 1395 my $space = $self->{vertical} ? $h : $w;
1192
1193 my $children = $self->{children}; 1396 my $children = $self->{children};
1194 1397
1195 my @h = map $_->{req_w}, @$children; 1398 my @req;
1196 1399
1197 my $req_h = List::Util::sum @h; 1400 if ($self->{homogeneous}) {
1198 1401 @req = ($space / (@$children || 1)) x @$children;
1199 if ($req_h > $h) {
1200 # ah well, not enough space
1201 $_ *= $h / $req_h for @h;
1202 } else { 1402 } else {
1403 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1404 my $req = List::Util::sum @req;
1405
1406 if ($req > $space) {
1407 # ah well, not enough space
1408 $_ *= $space / $req for @req;
1409 } else {
1203 my $exp = List::Util::sum map $_->{expand}, @$children; 1410 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1204 $exp ||= 1;
1205 1411
1412 $space = ($space - $req) / $expand; # remaining space to give away
1413
1414 $req[$_] += $space * $children->[$_]{expand}
1206 for (0 .. $#$children) { 1415 for 0 .. $#$children;
1207 my $child = $children->[$_];
1208
1209 my $alloc_h = $h[$_];
1210 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1211 $h[$_] = $alloc_h;
1212 } 1416 }
1213 } 1417 }
1214 1418
1215 CFClient::UI::harmonize \@h; 1419 CFClient::UI::harmonize \@req;
1216 1420
1217 my $y = 0; 1421 my $pos = 0;
1218 for (0 .. $#$children) { 1422 for (0 .. $#$children) {
1219 my $child = $children->[$_];
1220 my $h = $h[$_]; 1423 my $alloc = $req[$_];
1221 $child->configure ($y, 0, $h, $w); 1424 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1222 1425
1223 $y += $h; 1426 $pos += $alloc;
1224 } 1427 }
1225 1428
1226 1 1429 1
1227} 1430}
1228 1431
1229############################################################################# 1432#############################################################################
1230 1433
1434package CFClient::UI::HBox;
1435
1436our @ISA = CFClient::UI::Box::;
1437
1438sub new {
1439 my $class = shift;
1440
1441 $class->SUPER::new (
1442 vertical => 0,
1443 @_,
1444 )
1445}
1446
1447#############################################################################
1448
1231package CFClient::UI::VBox; 1449package CFClient::UI::VBox;
1232 1450
1233# TODO: wrap into common Box base class
1234
1235our @ISA = CFClient::UI::Container::; 1451our @ISA = CFClient::UI::Box::;
1236 1452
1237sub size_request { 1453sub new {
1238 my ($self) = @_; 1454 my $class = shift;
1239 1455
1240 my @alloc = map [$_->size_request], @{$self->{children}}; 1456 $class->SUPER::new (
1241 1457 vertical => 1,
1242 ( 1458 @_,
1243 (List::Util::max map $_->[0], @alloc),
1244 (List::Util::sum map $_->[1], @alloc),
1245 ) 1459 )
1246}
1247
1248sub size_allocate {
1249 my ($self, $w, $h) = @_;
1250
1251 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1252
1253 my $children = $self->{children};
1254
1255 my @h = map $_->{req_h}, @$children;
1256
1257 my $req_h = List::Util::sum @h;
1258
1259 if ($req_h > $h) {
1260 # ah well, not enough space
1261 $_ *= $h / $req_h for @h;
1262 } else {
1263 my $exp = List::Util::sum map $_->{expand}, @$children;
1264 $exp ||= 1;
1265
1266 for (0 .. $#$children) {
1267 my $child = $children->[$_];
1268
1269 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1270 }
1271 }
1272
1273 CFClient::UI::harmonize \@h;
1274
1275 my $y = 0;
1276 for (0 .. $#$children) {
1277 my $child = $children->[$_];
1278 my $h = $h[$_];
1279 $child->configure (0, $y, $w, $h);
1280
1281 $y += $h;
1282 }
1283
1284 1
1285} 1460}
1286 1461
1287############################################################################# 1462#############################################################################
1288 1463
1289package CFClient::UI::Label; 1464package CFClient::UI::Label;
… …
1306 ellipsise => 3, # end 1481 ellipsise => 3, # end
1307 layout => (new CFClient::Layout), 1482 layout => (new CFClient::Layout),
1308 fontsize => 1, 1483 fontsize => 1,
1309 align => -1, 1484 align => -1,
1310 valign => -1, 1485 valign => -1,
1311 padding => 2, 1486 padding_x => 2,
1487 padding_y => 2,
1312 can_events => 0, 1488 can_events => 0,
1313 %arg 1489 %arg
1314 ); 1490 );
1315 1491
1316 if (exists $self->{template}) { 1492 if (exists $self->{template}) {
… …
1352 $self->{text} = "T$text"; 1528 $self->{text} = "T$text";
1353 1529
1354 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba; 1530 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1355 $self->{layout}->set_text ($text); 1531 $self->{layout}->set_text ($text);
1356 1532
1533 $self->realloc;
1357 $self->update; 1534 $self->update;
1358 $self->check_size;
1359} 1535}
1360 1536
1361sub set_markup { 1537sub set_markup {
1362 my ($self, $markup) = @_; 1538 my ($self, $markup) = @_;
1363 1539
… …
1367 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1543 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1368 1544
1369 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba; 1545 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1370 $self->{layout}->set_markup ($markup); 1546 $self->{layout}->set_markup ($markup);
1371 1547
1548 $self->realloc;
1372 $self->update; 1549 $self->update;
1373 $self->check_size;
1374} 1550}
1375 1551
1376sub size_request { 1552sub size_request {
1377 my ($self) = @_; 1553 my ($self) = @_;
1378 1554
… …
1392 1568
1393 $w = List::Util::max $w, $w2; 1569 $w = List::Util::max $w, $w2;
1394 $h = List::Util::max $h, $h2; 1570 $h = List::Util::max $h, $h2;
1395 } 1571 }
1396 1572
1397 ( 1573 ($w, $h)
1398 $w + $self->{padding} * 2,
1399 $h + $self->{padding} * 2,
1400 )
1401} 1574}
1402 1575
1403sub size_allocate { 1576sub size_allocate {
1404 my ($self, $w, $h) = @_; 1577 my ($self, $w, $h) = @_;
1405 1578
1579 delete $self->{ox};
1580
1406 delete $self->{texture}; 1581 delete $self->{texture}
1582 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1407} 1583}
1408 1584
1409sub set_fontsize { 1585sub set_fontsize {
1410 my ($self, $fontsize) = @_; 1586 my ($self, $fontsize) = @_;
1411 1587
1412 $self->{fontsize} = $fontsize; 1588 $self->{fontsize} = $fontsize;
1413 delete $self->{texture}; 1589 delete $self->{texture};
1414 1590
1415 $self->update; 1591 $self->realloc;
1416 $self->check_size;
1417} 1592}
1418 1593
1419sub _draw { 1594sub _draw {
1420 my ($self) = @_; 1595 my ($self) = @_;
1421 1596
… …
1427 $self->{layout}->set_width ($self->{w}); 1602 $self->{layout}->set_width ($self->{w});
1428 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1603 $self->{layout}->set_ellipsise ($self->{ellipsise});
1429 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1604 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1430 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1605 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1431 1606
1432 my $tex = new_from_layout CFClient::Texture $self->{layout}; 1607 new_from_layout CFClient::Texture $self->{layout}
1608 };
1433 1609
1610 unless (exists $self->{ox}) {
1434 $self->{ox} = int ($self->{align} < 0 ? $self->{padding} 1611 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1435 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding} 1612 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1436 : ($self->{w} - $tex->{w}) * 0.5); 1613 : ($self->{w} - $tex->{w}) * 0.5);
1437 1614
1438 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding} 1615 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1439 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding} 1616 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1440 : ($self->{h} - $tex->{h}) * 0.5); 1617 : ($self->{h} - $tex->{h}) * 0.5);
1441
1442 $tex
1443 }; 1618 };
1444 1619
1445 glEnable GL_TEXTURE_2D; 1620 glEnable GL_TEXTURE_2D;
1446 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 1621 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1447 1622
… …
1473 active_fg => [0, 0, 0], 1648 active_fg => [0, 0, 0],
1474 can_hover => 1, 1649 can_hover => 1,
1475 can_focus => 1, 1650 can_focus => 1,
1476 valign => 0, 1651 valign => 0,
1477 can_events => 1, 1652 can_events => 1,
1653 #text => ...
1478 @_ 1654 @_
1479 ) 1655 )
1480} 1656}
1481 1657
1482sub _set_text { 1658sub _set_text {
… …
1492 $self->{text} = $text; 1668 $self->{text} = $text;
1493 1669
1494 $text =~ s/./*/g if $self->{hidden}; 1670 $text =~ s/./*/g if $self->{hidden};
1495 $self->{layout}->set_text ("$text "); 1671 $self->{layout}->set_text ("$text ");
1496 1672
1497 $self->emit (changed => $self->{text}); 1673 $self->_emit (changed => $self->{text});
1498} 1674}
1499 1675
1500sub set_text { 1676sub set_text {
1501 my ($self, $text) = @_; 1677 my ($self, $text) = @_;
1502 1678
1503 $self->{cursor} = length $text; 1679 $self->{cursor} = length $text;
1504 $self->_set_text ($text); 1680 $self->_set_text ($text);
1505 $self->update; 1681
1506 $self->check_size; 1682 $self->realloc;
1507} 1683}
1508 1684
1509sub get_text { 1685sub get_text {
1510 $_[0]{text} 1686 $_[0]{text}
1511} 1687}
… …
1514 my ($self) = @_; 1690 my ($self) = @_;
1515 1691
1516 my ($w, $h) = $self->SUPER::size_request; 1692 my ($w, $h) = $self->SUPER::size_request;
1517 1693
1518 ($w + 1, $h) # add 1 for cursor 1694 ($w + 1, $h) # add 1 for cursor
1519}
1520
1521sub size_allocate {
1522 my ($self, $w, $h) = @_;
1523
1524 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1525} 1695}
1526 1696
1527sub key_down { 1697sub key_down {
1528 my ($self, $ev) = @_; 1698 my ($self, $ev) = @_;
1529 1699
… …
1544 } elsif ($sym == CFClient::SDLK_HOME) { 1714 } elsif ($sym == CFClient::SDLK_HOME) {
1545 $self->{cursor} = 0; 1715 $self->{cursor} = 0;
1546 } elsif ($sym == CFClient::SDLK_END) { 1716 } elsif ($sym == CFClient::SDLK_END) {
1547 $self->{cursor} = length $text; 1717 $self->{cursor} = length $text;
1548 } elsif ($uni == 27) { 1718 } elsif ($uni == 27) {
1549 $self->emit ('escape'); 1719 $self->_emit ('escape');
1550 } elsif ($uni) { 1720 } elsif ($uni) {
1551 substr $text, $self->{cursor}++, 0, chr $uni; 1721 substr $text, $self->{cursor}++, 0, chr $uni;
1722 } else {
1723 return 0;
1552 } 1724 }
1553 1725
1554 $self->_set_text ($text); 1726 $self->_set_text ($text);
1555 $self->update; 1727
1556 $self->check_size; 1728 $self->realloc;
1729
1730 1
1557} 1731}
1558 1732
1559sub focus_in { 1733sub focus_in {
1560 my ($self) = @_; 1734 my ($self) = @_;
1561 1735
… …
1576 utf8::encode $text; 1750 utf8::encode $text;
1577 $self->{cursor} = length substr $text, 0, $idx; 1751 $self->{cursor} = length substr $text, 0, $idx;
1578 1752
1579 $self->_set_text ($self->{text}); 1753 $self->_set_text ($self->{text});
1580 $self->update; 1754 $self->update;
1755
1756 1
1581} 1757}
1582 1758
1583sub mouse_motion { 1759sub mouse_motion {
1584 my ($self, $ev, $x, $y) = @_; 1760 my ($self, $ev, $x, $y) = @_;
1585# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 1761# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1762
1763 0
1586} 1764}
1587 1765
1588sub _draw { 1766sub _draw {
1589 my ($self) = @_; 1767 my ($self) = @_;
1590 1768
… …
1641 if ($sym == 13) { 1819 if ($sym == 13) {
1642 unshift @{$self->{history}}, 1820 unshift @{$self->{history}},
1643 my $txt = $self->get_text; 1821 my $txt = $self->get_text;
1644 $self->{history_pointer} = -1; 1822 $self->{history_pointer} = -1;
1645 $self->{history_saveback} = ''; 1823 $self->{history_saveback} = '';
1646 $self->emit (activate => $txt); 1824 $self->_emit (activate => $txt);
1647 $self->update; 1825 $self->update;
1648 1826
1649 } elsif ($sym == CFClient::SDLK_UP) { 1827 } elsif ($sym == CFClient::SDLK_UP) {
1650 if ($self->{history_pointer} < 0) { 1828 if ($self->{history_pointer} < 0) {
1651 $self->{history_saveback} = $self->get_text; 1829 $self->{history_saveback} = $self->get_text;
… …
1667 } else { 1845 } else {
1668 $self->set_text ($self->{history_saveback}); 1846 $self->set_text ($self->{history_saveback});
1669 } 1847 }
1670 1848
1671 } else { 1849 } else {
1672 $self->SUPER::key_down ($ev); 1850 return $self->SUPER::key_down ($ev)
1851 }
1852
1673 } 1853 1
1674
1675} 1854}
1676 1855
1677############################################################################# 1856#############################################################################
1678 1857
1679package CFClient::UI::Button; 1858package CFClient::UI::Button;
… …
1688 1867
1689sub new { 1868sub new {
1690 my $class = shift; 1869 my $class = shift;
1691 1870
1692 $class->SUPER::new ( 1871 $class->SUPER::new (
1693 padding => 4, 1872 padding_x => 4,
1873 padding_y => 4,
1694 fg => [1, 1, 1], 1874 fg => [1, 1, 1],
1695 active_fg => [0, 0, 1], 1875 active_fg => [0, 0, 1],
1696 can_hover => 1, 1876 can_hover => 1,
1697 align => 0, 1877 align => 0,
1698 valign => 0, 1878 valign => 0,
1699 can_events => 1, 1879 can_events => 1,
1700 @_ 1880 @_
1701 ) 1881 )
1702} 1882}
1703 1883
1884sub activate { }
1885
1704sub button_up { 1886sub button_up {
1705 my ($self, $ev, $x, $y) = @_; 1887 my ($self, $ev, $x, $y) = @_;
1706 1888
1889 $self->emit ("activate")
1707 if ($x >= 0 && $x < $self->{w} 1890 if $x >= 0 && $x < $self->{w}
1708 && $y >= 0 && $y < $self->{h}) { 1891 && $y >= 0 && $y < $self->{h};
1709 $self->emit ("activate"); 1892
1710 } 1893 1
1711} 1894}
1712 1895
1713sub _draw { 1896sub _draw {
1714 my ($self) = @_; 1897 my ($self) = @_;
1715 1898
… …
1744 1927
1745sub new { 1928sub new {
1746 my $class = shift; 1929 my $class = shift;
1747 1930
1748 $class->SUPER::new ( 1931 $class->SUPER::new (
1749 padding => 2, 1932 padding_x => 2,
1933 padding_y => 2,
1750 fg => [1, 1, 1], 1934 fg => [1, 1, 1],
1751 active_fg => [1, 1, 0], 1935 active_fg => [1, 1, 0],
1752 bg => [0, 0, 0, 0.2], 1936 bg => [0, 0, 0, 0.2],
1753 active_bg => [1, 1, 1, 0.5], 1937 active_bg => [1, 1, 1, 0.5],
1754 state => 0, 1938 state => 0,
… …
1758} 1942}
1759 1943
1760sub size_request { 1944sub size_request {
1761 my ($self) = @_; 1945 my ($self) = @_;
1762 1946
1763 ($self->{padding} * 2 + 6) x 2 1947 (6) x 2
1764} 1948}
1765 1949
1766sub button_down { 1950sub button_down {
1767 my ($self, $ev, $x, $y) = @_; 1951 my ($self, $ev, $x, $y) = @_;
1768 1952
1769 if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding} 1953 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1770 && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) { 1954 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1771 $self->{state} = !$self->{state}; 1955 $self->{state} = !$self->{state};
1772 $self->emit (changed => $self->{state}); 1956 $self->_emit (changed => $self->{state});
1957 } else {
1958 return 0
1959 }
1960
1773 } 1961 1
1774} 1962}
1775 1963
1776sub _draw { 1964sub _draw {
1777 my ($self) = @_; 1965 my ($self) = @_;
1778 1966
1779 $self->SUPER::_draw; 1967 $self->SUPER::_draw;
1780 1968
1781 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0; 1969 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1782 1970
1783 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2; 1971 my ($w, $h) = @$self{qw(w h)};
1972
1973 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1784 1974
1785 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} }; 1975 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1786 1976
1787 my $tex = $self->{state} ? $tex[1] : $tex[0]; 1977 my $tex = $self->{state} ? $tex[1] : $tex[0];
1788 1978
… …
2052 my $self = $class->SUPER::new ( 2242 my $self = $class->SUPER::new (
2053 fg => [1, 1, 1], 2243 fg => [1, 1, 1],
2054 active_fg => [0, 0, 0], 2244 active_fg => [0, 0, 0],
2055 bg => [0, 0, 0, 0.2], 2245 bg => [0, 0, 0, 0.2],
2056 active_bg => [1, 1, 1, 0.5], 2246 active_bg => [1, 1, 1, 0.5],
2057 range => [0, 0, 100, 10], 2247 range => [0, 0, 100, 10, 0],
2058 req_w => $::WIDTH / 80, 2248 min_w => $::WIDTH / 80,
2059 req_h => $::WIDTH / 80, 2249 min_h => $::WIDTH / 80,
2060 vertical => 0, 2250 vertical => 0,
2061 can_hover => 1, 2251 can_hover => 1,
2062 inner_pad => .05, 2252 inner_pad => 0.02,
2063 @_ 2253 @_
2064 ); 2254 );
2065 2255
2066 $self->set_value ($self->{range}[0]); 2256 $self->set_value ($self->{range}[0]);
2067 $self->update; 2257 $self->update;
2068 2258
2069 $self 2259 $self
2070} 2260}
2071 2261
2262sub changed { }
2263
2264sub set_range {
2265 my ($self, $range) = @_;
2266
2267 ($range, $self->{range}) = ($self->{range}, $range);
2268
2269 $self->update
2270 if "@$range" ne "@{$self->{range}}";
2271}
2272
2072sub set_value { 2273sub set_value {
2073 my ($self, $value) = @_; 2274 my ($self, $value) = @_;
2074 2275
2075 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; 2276 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2076 2277
2077 $hi = $lo + 1 if $hi <= $lo; 2278 $hi = $lo + 1 if $hi <= $lo;
2078 2279
2280 $page = $hi - $lo if $page > $hi - $lo;
2281
2079 $value = $lo if $value < $lo; 2282 $value = $lo if $value < $lo;
2080 $value = $hi if $value > $hi; 2283 $value = $hi - $page if $value > $hi - $page;
2081 2284
2082 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit 2285 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2083 if $unit; 2286 if $unit;
2084 2287
2085 $page = $hi - $lo if $page > $hi - $lo;
2086
2087 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 2288 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2088 2289
2089 if ($value != $old_value) { 2290 if ($value != $old_value) {
2090 $self->emit (changed => $value); 2291 $self->_emit (changed => $value);
2091 $self->update; 2292 $self->update;
2092 } 2293 }
2093} 2294}
2094 2295
2095sub size_request { 2296sub size_request {
2096 my ($self) = @_; 2297 my ($self) = @_;
2097 2298
2098 my $w = $self->{req_w}; 2299 ($self->{req_w}, $self->{req_h})
2099 my $h = $self->{req_h};
2100
2101 $self->{vertical} ? ($h, $w) : ($w, $h)
2102} 2300}
2103 2301
2104sub button_down { 2302sub button_down {
2105 my ($self, $ev, $x, $y) = @_; 2303 my ($self, $ev, $x, $y) = @_;
2106 2304
2107 $self->SUPER::button_down ($ev, $x, $y); 2305 $self->SUPER::button_down ($ev, $x, $y);
2306
2307 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2308
2108 $self->mouse_motion ($ev, $x, $y); 2309 $self->mouse_motion ($ev, $x, $y)
2109} 2310}
2110 2311
2111sub mouse_motion { 2312sub mouse_motion {
2112 my ($self, $ev, $x, $y) = @_; 2313 my ($self, $ev, $x, $y) = @_;
2113 2314
2114 if ($GRAB == $self) { 2315 if ($GRAB == $self) {
2115 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 2316 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2116 2317
2117 my (undef, $lo, $hi, $page) = @{$self->{range}}; 2318 my (undef, $lo, $hi, $page) = @{$self->{range}};
2118 2319
2119 $x = $x / ($w * (1 - 2 * $self->{inner_pad})) - $self->{inner_pad}; 2320 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2120 2321
2121 $self->set_value ($x * ($hi - $lo) + $lo); 2322 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2323 } else {
2324 return 0;
2325 }
2326
2122 } 2327 1
2123} 2328}
2124 2329
2125sub update { 2330sub update {
2126 my ($self) = @_; 2331 my ($self) = @_;
2127 2332
2128 $CFClient::UI::ROOT->on_post_alloc ($self => sub { 2333 $CFClient::UI::ROOT->on_post_alloc ($self => sub {
2129 $self->set_value ($self->{range}[0]); 2334 $self->set_value ($self->{range}[0]);
2130 2335
2131 my ($value, $lo, $hi, $page) = @{$self->{range}}; 2336 my ($value, $lo, $hi, $page) = @{$self->{range}};
2337 my $range = ($hi - $page - $lo) || 1e-100;
2132 2338
2133 my $inner_w = 1 - 2 * $self->{inner_pad}; 2339 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2134 2340
2135 $self->{scale} = ($inner_w / ($hi - $lo)) || 1; 2341 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2342 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2136 2343
2137 $page = $self->{scale} * $page || 10 / ($self->{w} || 1); 2344 $value = ($value - $lo) / $range;
2138 $value = $self->{scale} * ($value - $lo); 2345 $value = $value * $self->{scale} + $self->{offset};
2139 2346
2140 $value = $self->{inner_pad} + ($value - $page * 0.5);
2141
2142 $value = 0 if $value < 0;
2143 $page = 1 - $value if $value + $page > 1;
2144
2145 $self->{knob_x} = $value; 2347 $self->{knob_x} = $value - $knob_w * 0.5;
2146 $self->{knob_w} = $page; 2348 $self->{knob_w} = $knob_w;
2147 }); 2349 });
2148 2350
2149 $self->SUPER::update; 2351 $self->SUPER::update;
2150} 2352}
2151 2353
… …
2175 # draw handle 2377 # draw handle
2176 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1); 2378 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2177 2379
2178 glDisable GL_TEXTURE_2D; 2380 glDisable GL_TEXTURE_2D;
2179} 2381}
2382
2383#############################################################################
2384
2385package CFClient::UI::ValSlider;
2386
2387our @ISA = CFClient::UI::HBox::;
2388
2389sub new {
2390 my ($class, %arg) = @_;
2391
2392 my $range = delete $arg{range};
2393
2394 my $self = $class->SUPER::new (
2395 slider => (new CFClient::UI::Slider expand => 1, range => $range),
2396 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
2397 to_value => sub { shift },
2398 from_value => sub { shift },
2399 %arg,
2400 );
2401
2402 $self->{slider}->connect (changed => sub {
2403 my ($self, $value) = @_;
2404 $self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
2405 $self->{parent}->emit (changed => $value);
2406 });
2407
2408# $self->{entry}->connect (changed => sub {
2409# my ($self, $value) = @_;
2410# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
2411# $self->{parent}->emit (changed => $value);
2412# });
2413
2414 $self->add ($self->{slider}, $self->{entry});
2415
2416 $self->{slider}->emit (changed => $self->{slider}{range}[0]);
2417
2418 $self
2419}
2420
2421sub set_range { shift->{slider}->set_range (@_) }
2422sub set_value { shift->{slider}->set_value (@_) }
2180 2423
2181############################################################################# 2424#############################################################################
2182 2425
2183package CFClient::UI::TextView; 2426package CFClient::UI::TextView;
2184 2427
… …
2214 2457
2215 $self->{fontsize} = $fontsize; 2458 $self->{fontsize} = $fontsize;
2216 $self->reflow; 2459 $self->reflow;
2217} 2460}
2218 2461
2219sub text_height {
2220 my ($self, $text) = @_;
2221
2222 my $layout = $self->{layout};
2223
2224 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2225 $layout->set_width ($self->{children}[0]{w});
2226 $layout->set_markup ($text);
2227
2228 ($layout->size)[1]
2229}
2230
2231sub reflow {
2232 my ($self) = @_;
2233
2234 $self->{need_reflow}++;
2235 $self->update;
2236}
2237
2238sub size_allocate { 2462sub size_allocate {
2239 my ($self, $w, $h) = @_; 2463 my ($self, $w, $h) = @_;
2240 2464
2241 $self->SUPER::size_allocate ($w, $h); 2465 $self->SUPER::size_allocate ($w, $h);
2242 2466
… …
2245 $self->{layout}->set_width ($self->{children}[0]{w}); 2469 $self->{layout}->set_width ($self->{children}[0]{w});
2246 2470
2247 $self->reflow; 2471 $self->reflow;
2248} 2472}
2249 2473
2474sub text_size {
2475 my ($self, $text, $indent) = @_;
2476
2477 my $layout = $self->{layout};
2478
2479 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2480 $layout->set_width ($self->{children}[0]{w} - $indent);
2481 $layout->set_markup ($text);
2482
2483 $layout->size
2484}
2485
2486sub reflow {
2487 my ($self) = @_;
2488
2489 $self->{need_reflow}++;
2490 $self->update;
2491}
2492
2493sub set_offset {
2494 my ($self, $offset) = @_;
2495
2496 # todo: base offset on lines or so, not on pixels
2497 $self->{children}[1]->set_value ($offset);
2498}
2499
2500sub clear {
2501 my ($self) = @_;
2502
2503 $self->{par} = [];
2504 $self->{height} = 0;
2505 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2506}
2507
2250sub add_paragraph { 2508sub add_paragraph {
2251 my ($self, $color, $text) = @_; 2509 my ($self, $color, $text, $indent) = @_;
2252 2510
2253 #TODO: intelligently "reformat" paragraph 2511 for my $line (split /\n/, $text) {
2254 2512 my ($w, $h) = $self->text_size ($line);
2255 my $height = $self->text_height ($text);
2256
2257 $self->{height} += $height; 2513 $self->{height} += $h;
2514 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2515 }
2258 2516
2259 push @{$self->{par}}, [$height, $color, $text];
2260
2261 $self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}]; 2517 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2262 $self->{children}[1]->update;
2263} 2518}
2264 2519
2265sub update { 2520sub update {
2266 my ($self) = @_; 2521 my ($self) = @_;
2267 2522
… …
2270 return unless $self->{h} > 0; 2525 return unless $self->{h} > 0;
2271 2526
2272 delete $self->{texture}; 2527 delete $self->{texture};
2273 2528
2274 $ROOT->on_post_alloc ($self, sub { 2529 $ROOT->on_post_alloc ($self, sub {
2530 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2531
2275 if (delete $self->{need_reflow}) { 2532 if (delete $self->{need_reflow}) {
2276 my $height = 0; 2533 my $height = 0;
2277 2534
2278 $height += $_->[0] = $self->text_height ($_->[2]) 2535 my $layout = $self->{layout};
2536
2537 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2538
2279 for @{$self->{par}}; 2539 for (@{$self->{par}}) {
2540 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2541 $layout->set_width ($W - $_->[3]);
2542 $layout->set_markup ($_->[4]);
2543 my ($w, $h) = $layout->size;
2544 $_->[0] = $w + $_->[3];
2545 $_->[1] = $h;
2546 }
2547
2548 $height += $_->[1];
2549 }
2280 2550
2281 $self->{height} = $height; 2551 $self->{height} = $height;
2282 2552
2283 $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}]; 2553 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2284 2554
2285 delete $self->{texture}; 2555 delete $self->{texture};
2286 } 2556 }
2287 2557
2288 $self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub { 2558 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2289 glClearColor 0, 0, 0, 0; 2559 glClearColor 0.5, 0.5, 0.5, 0;
2290 glClear GL_COLOR_BUFFER_BIT; 2560 glClear GL_COLOR_BUFFER_BIT;
2291 2561
2292 glEnable GL_TEXTURE_2D;
2293 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2294
2295 my $top = int $self->{children}[1]{range}[0]; 2562 my $top = int $self->{children}[1]{range}[0];
2296 2563
2297 my $y0 = $top; 2564 my $y0 = $top;
2298 my $y1 = $top + $self->{h}; 2565 my $y1 = $top + $H;
2299 2566
2300 my $y = 0; 2567 my $y = 0;
2301 2568
2302 my $layout = $self->{layout}; 2569 my $layout = $self->{layout};
2303 2570
2304 $layout->set_font ($self->{font}) if $self->{font}; 2571 $layout->set_font ($self->{font}) if $self->{font};
2305 2572
2573 glEnable GL_BLEND;
2574 #TODO# not correct in windows where rgba is forced off
2575 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2576
2306 for my $par (@{$self->{par}}) { 2577 for my $par (@{$self->{par}}) {
2307 my $h = $par->[0]; 2578 my $h = $par->[1];
2308 2579
2309 if ($y0 < $y + $h && $y < $y1) { 2580 if ($y0 < $y + $h && $y < $y1) {
2310 $layout->set_foreground (@{ $par->[1] }); 2581 $layout->set_foreground (@{ $par->[2] });
2582 $layout->set_width ($W - $par->[3]);
2311 $layout->set_markup ($par->[2]); 2583 $layout->set_markup ($par->[4]);
2312 2584
2313 my ($W, $H) = $layout->size; 2585 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2314 CFClient::Texture->new_from_layout ($layout)->draw_quad_alpha_premultiplied (0, $y - $y0); 2586
2587 glRasterPos $par->[3], $y - $y0;
2588 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2315 } 2589 }
2316 2590
2317 $y += $h; 2591 $y += $h;
2318 } 2592 }
2319 2593
2320 glDisable GL_TEXTURE_2D; 2594 glDisable GL_BLEND;
2321 }; 2595 };
2322 }); 2596 });
2323} 2597}
2324 2598
2325sub _draw { 2599sub _draw {
2326 my ($self) = @_; 2600 my ($self) = @_;
2327 2601
2328 glEnable GL_TEXTURE_2D; 2602 glEnable GL_TEXTURE_2D;
2329 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2603 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2330 glColor 1, 1, 1, 1; 2604 glColor 1, 1, 1, 1;
2331 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 2605 $self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2332 glDisable GL_TEXTURE_2D; 2606 glDisable GL_TEXTURE_2D;
2333 2607
2334 $self->{children}[1]->draw; 2608 $self->{children}[1]->draw;
2335 2609
2336} 2610}
… …
2385 2659
2386sub new { 2660sub new {
2387 my $class = shift; 2661 my $class = shift;
2388 2662
2389 my $self = $class->SUPER::new ( 2663 my $self = $class->SUPER::new (
2390 state => 0, 2664 state => 0,
2391 connect_activate => \&toggle_flopper, 2665 on_activate => \&toggle_flopper,
2392 @_ 2666 @_
2393 ); 2667 );
2394 2668
2395 if ($self->{state}) {
2396 $self->{state} = 0;
2397 $self->toggle_flopper;
2398 }
2399
2400 $self 2669 $self
2401} 2670}
2402 2671
2403sub toggle_flopper { 2672sub toggle_flopper {
2404 my ($self) = @_; 2673 my ($self) = @_;
2405 2674
2406 # TODO: use animation 2675 $self->{other}->toggle_visibility;
2407 if ($self->{state} = !$self->{state}) {
2408 $CFClient::UI::ROOT->add ($self->{other});
2409 $self->{other}->move ($self->coord2global (0, $self->{h}));
2410 $self->emit ("open");
2411 } else {
2412 $CFClient::UI::ROOT->remove ($self->{other});
2413 $self->emit ("close");
2414 }
2415
2416 $self->emit (changed => $self->{state});
2417} 2676}
2418 2677
2419############################################################################# 2678#############################################################################
2420 2679
2421package CFClient::UI::Tooltip; 2680package CFClient::UI::Tooltip;
… …
2434} 2693}
2435 2694
2436sub set_tooltip_from { 2695sub set_tooltip_from {
2437 my ($self, $widget) = @_; 2696 my ($self, $widget) = @_;
2438 2697
2698 my $tooltip = $widget->{tooltip};
2699
2700 if ($ENV{CFPLUS_DEBUG} & 2) {
2701 $tooltip .= "\n\n" . (ref $widget) . "\n"
2702 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2703 . "req $widget->{req_w} $widget->{req_h}\n"
2704 . "visible $widget->{visible}";
2705 }
2706
2439 $self->add (new CFClient::UI::Label 2707 $self->add (new CFClient::UI::Label
2440 markup => $widget->{tooltip}, 2708 markup => $tooltip,
2441 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 2709 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2442 fontsize => 0.8, 2710 fontsize => 0.8,
2443 fg => [0, 0, 0, 1], 2711 fg => [0, 0, 0, 1],
2444 ellipsise => 0, 2712 ellipsise => 0,
2445 font => ($widget->{tooltip_font} || $::FONT_PROP), 2713 font => ($widget->{tooltip_font} || $::FONT_PROP),
… …
2456 2724
2457sub size_allocate { 2725sub size_allocate {
2458 my ($self, $w, $h) = @_; 2726 my ($self, $w, $h) = @_;
2459 2727
2460 $self->SUPER::size_allocate ($w - 4, $h - 4); 2728 $self->SUPER::size_allocate ($w - 4, $h - 4);
2729}
2730
2731sub visibility_change {
2732 my ($self, $visible) = @_;
2733
2734 return unless $visible;
2735
2736 $self->{root}->on_post_alloc ("move_$self" => sub {
2737 my $widget = $self->{owner}
2738 or return;
2739
2740 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2741
2742 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2743 if $x + $self->{w} > $::WIDTH;
2744
2745 $self->move_abs ($x, $y);
2746 });
2461} 2747}
2462 2748
2463sub _draw { 2749sub _draw {
2464 my ($self) = @_; 2750 my ($self) = @_;
2465 2751
… …
2482 glVertex $w, $h; 2768 glVertex $w, $h;
2483 glVertex $w, 0; 2769 glVertex $w, 0;
2484 glEnd; 2770 glEnd;
2485 2771
2486 glTranslate 2 - 0.375, 2 - 0.375; 2772 glTranslate 2 - 0.375, 2 - 0.375;
2773
2487 $self->SUPER::_draw; 2774 $self->SUPER::_draw;
2488} 2775}
2489 2776
2490############################################################################# 2777#############################################################################
2491 2778
… …
2496use CFClient::OpenGL; 2783use CFClient::OpenGL;
2497 2784
2498sub new { 2785sub new {
2499 my $class = shift; 2786 my $class = shift;
2500 2787
2501 $class->SUPER::new ( 2788 my $self = $class->SUPER::new (
2502 aspect => 1, 2789 aspect => 1,
2790 can_events => 0,
2503 @_, 2791 @_,
2504 ) 2792 );
2793
2794 if ($self->{anim} && $self->{animspeed}) {
2795 Scalar::Util::weaken (my $widget = $self);
2796
2797 $self->{timer} = Event->timer (
2798 at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2799 hard => 1,
2800 interval => $self->{animspeed},
2801 cb => sub {
2802 ++$widget->{frame};
2803 $widget->update;
2804 },
2805 );
2806 }
2807
2808 $self
2505} 2809}
2506 2810
2507sub size_request { 2811sub size_request {
2508 (32, 8) 2812 (32, 8)
2509} 2813}
2510 2814
2815sub update {
2816 my ($self) = @_;
2817
2818 return unless $self->{visible};
2819
2820 $self->SUPER::update;
2821}
2822
2511sub _draw { 2823sub _draw {
2512 my ($self) = @_; 2824 my ($self) = @_;
2513 2825
2514 return unless $::CONN;#d# manage and cache textures differently 2826 return unless $::CONN;
2827
2828 my $face;
2829
2830 if ($self->{frame}) {
2831 my $anim = $::CONN->{anim}[$self->{anim}];
2832
2833 $face = $anim->[ $self->{frame} % @$anim ]
2834 if $anim && @$anim;
2835 }
2836
2515 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]]; 2837 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2516 2838
2517 # TODO animation
2518 if ($tex) { 2839 if ($tex) {
2519 glEnable GL_TEXTURE_2D; 2840 glEnable GL_TEXTURE_2D;
2520 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2841 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2521 glColor 1, 1, 1, 1; 2842 glColor 1, 1, 1, 1;
2522 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 2843 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2523 glDisable GL_TEXTURE_2D; 2844 glDisable GL_TEXTURE_2D;
2524 } 2845 }
2525} 2846}
2526 2847
2527############################################################################# 2848sub DESTROY {
2528
2529package CFClient::UI::InventoryItem;
2530
2531our @ISA = CFClient::UI::HBox::;
2532
2533sub _item_to_desc {
2534 my ($item) = @_; 2849 my ($self) = @_;
2535 2850
2536 my $desc = 2851 $self->{timer}->cancel
2537 $item->{nrof} < 2 2852 if $self->{timer};
2538 ? $item->{name}
2539 : "$item->{nrof} $item->{name_pl}";
2540 2853
2541 $item->{flags} & Crossfire::Protocol::F_OPEN 2854 $self->SUPER::DESTROY;
2542 and $desc .= " (open)";
2543 $item->{flags} & Crossfire::Protocol::F_APPLIED
2544 and $desc .= " (applied)";
2545 $item->{flags} & Crossfire::Protocol::F_UNPAID
2546 and $desc .= " (unpaid)";
2547 $item->{flags} & Crossfire::Protocol::F_MAGIC
2548 and $desc .= " (magic)";
2549 $item->{flags} & Crossfire::Protocol::F_CURSED
2550 and $desc .= " (cursed)";
2551 $item->{flags} & Crossfire::Protocol::F_DAMNED
2552 and $desc .= " (damned)";
2553 $item->{flags} & Crossfire::Protocol::F_LOCKED
2554 and $desc .= " *";
2555
2556 $desc
2557}
2558
2559sub new {
2560 my $class = shift;
2561
2562 my %args = @_;
2563
2564 my $item = delete $args{item};
2565
2566 my $desc = _item_to_desc ($item);
2567
2568 my $self = $class->SUPER::new (
2569 can_hover => 1,
2570 can_events => 1,
2571 tooltip => ((CFClient::UI::Label::escape $desc)
2572 . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
2573 connect_button_down => sub {
2574 my ($self, $ev, $x, $y) = @_;
2575
2576 # todo: maybe put examine on 1? but should just be a tooltip :(
2577 if ($ev->{button} == 1) {
2578 my $targ = $::CONN->{player}{tag};
2579
2580 if ($item->{container} == $::CONN->{player}{tag}) {
2581 $targ = $main::OPENCONT;
2582 }
2583
2584 $::CONN->send ("move $targ $item->{tag} 0");
2585 } elsif ($ev->{button} == 2) {
2586 $::CONN->send ("apply $item->{tag}");
2587 } elsif ($ev->{button} == 3) {
2588 my @menu_items = (
2589 ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2590 ["mark", sub { $::CONN->send ("mark $item->{tag}") }],
2591 ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2592 ["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2593 [
2594 $item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
2595 sub { $::CONN->send ("lock $item->{tag}") },
2596 ],
2597 );
2598
2599 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2600 }
2601
2602 1
2603 },
2604 %args
2605 );
2606
2607
2608 $self->add (new CFClient::UI::Face
2609 can_events => 0,
2610 face => $item->{face},
2611 anim => $item->{anim},
2612 animspeed => $item->{animspeed},
2613 );
2614
2615 $self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2616
2617 $self->{item} = $item;
2618
2619 $self->update_item;
2620
2621 $self
2622}
2623
2624sub update_item {
2625 my ($self) = @_;
2626
2627 my $desc = _item_to_desc ($self->{item});
2628
2629 $self->{name_lbl}->set_text ($desc);
2630}
2631
2632#############################################################################
2633
2634package CFClient::UI::Inventory;
2635
2636our @ISA = CFClient::UI::ScrolledWindow::;
2637
2638sub new {
2639 my $class = shift;
2640
2641 my $self = $class->SUPER::new (
2642 scrolled => (new CFClient::UI::VBox),
2643 @_,
2644 );
2645
2646 $self
2647}
2648
2649sub set_items {
2650 my ($self, $items) = @_;
2651
2652 $self->{scrolled}->clear;
2653 return unless $items;
2654
2655 my @items = sort {
2656 ($a->{type} <=> $b->{type})
2657 or ($a->{name} cmp $b->{name})
2658 } @$items;
2659
2660 $self->{real_items} = \@items;
2661
2662 for my $item (@items) {
2663 $item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2664 $item->update_item ();
2665 }
2666
2667 $self->{scrolled}->add (@items);
2668
2669# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2670}
2671
2672sub size_request {
2673 my ($self) = @_;
2674 ($self->{req_w}, $self->{req_h});
2675} 2855}
2676 2856
2677############################################################################# 2857#############################################################################
2678 2858
2679package CFClient::UI::Menu; 2859package CFClient::UI::Menu;
… …
2714 2894
2715# popup given the event (must be a mouse button down event currently) 2895# popup given the event (must be a mouse button down event currently)
2716sub popup { 2896sub popup {
2717 my ($self, $ev) = @_; 2897 my ($self, $ev) = @_;
2718 2898
2719 $self->emit ("popdown"); 2899 $self->_emit ("popdown");
2720 2900
2721 # maybe save $GRAB? must be careful about events... 2901 # maybe save $GRAB? must be careful about events...
2722 $GRAB = $self; 2902 $GRAB = $self;
2723 $self->{button} = $ev->{button}; 2903 $self->{button} = $ev->{button};
2724 2904
2725 $self->show; 2905 $self->show;
2726 $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5); 2906 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2727} 2907}
2728 2908
2729sub mouse_motion { 2909sub mouse_motion {
2730 my ($self, $ev, $x, $y) = @_; 2910 my ($self, $ev, $x, $y) = @_;
2731 2911
2732 # TODO: should use vbox->find_widget or so 2912 # TODO: should use vbox->find_widget or so
2733 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 2913 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2734 $self->{hover} = $self->{item}{$HOVER}; 2914 $self->{hover} = $self->{item}{$HOVER};
2915
2916 0
2735} 2917}
2736 2918
2737sub button_up { 2919sub button_up {
2738 my ($self, $ev, $x, $y) = @_; 2920 my ($self, $ev, $x, $y) = @_;
2739 2921
2740 if ($ev->{button} == $self->{button}) { 2922 if ($ev->{button} == $self->{button}) {
2741 undef $GRAB; 2923 undef $GRAB;
2742 $self->hide; 2924 $self->hide;
2743 2925
2744 $self->emit ("popdown"); 2926 $self->_emit ("popdown");
2745 $self->{hover}[1]->() if $self->{hover}; 2927 $self->{hover}[1]->() if $self->{hover};
2928 } else {
2929 return 0
2930 }
2931
2746 } 2932 1
2747} 2933}
2748 2934
2749############################################################################# 2935#############################################################################
2750 2936
2751package CFClient::UI::Statusbox; 2937package CFClient::UI::Statusbox;
… …
2811sub add { 2997sub add {
2812 my ($self, $text, %arg) = @_; 2998 my ($self, $text, %arg) = @_;
2813 2999
2814 $text =~ s/^\s+//; 3000 $text =~ s/^\s+//;
2815 $text =~ s/\s+$//; 3001 $text =~ s/\s+$//;
3002
3003 return unless $text;
2816 3004
2817 my $timeout = time + ((delete $arg{timeout}) || 60); 3005 my $timeout = time + ((delete $arg{timeout}) || 60);
2818 3006
2819 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 3007 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2820 3008
… …
2854 $self->SUPER::reconfigure; 3042 $self->SUPER::reconfigure;
2855} 3043}
2856 3044
2857############################################################################# 3045#############################################################################
2858 3046
2859package CFClient::UI::Root; 3047package CFClient::UI::Inventory;
2860 3048
2861our @ISA = CFClient::UI::Container::; 3049our @ISA = CFClient::UI::ScrolledWindow::;
2862
2863use CFClient::OpenGL;
2864 3050
2865sub new { 3051sub new {
2866 my $class = shift; 3052 my $class = shift;
2867 3053
2868 $class->SUPER::new ( 3054 my $self = $class->SUPER::new (
3055 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2869 @_, 3056 @_,
2870 ) 3057 );
2871}
2872 3058
2873sub configure { 3059 $self
3060}
3061
3062sub set_items {
3063 my ($self, $items) = @_;
3064
3065 $self->{scrolled}->clear;
3066 return unless $items;
3067
3068 my @items = sort {
3069 ($a->{type} <=> $b->{type})
3070 or ($a->{name} cmp $b->{name})
3071 } @$items;
3072
3073 $self->{real_items} = \@items;
3074
3075 my $row = 0;
3076 for my $item (@items) {
3077 CFClient::Item::update_widgets $item;
3078
3079 $self->{scrolled}->add (0, $row, $item->{face_widget});
3080 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3081 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3082
3083 $row++;
3084 }
3085}
3086
3087#############################################################################
3088
3089package CFClient::UI::BindEditor;
3090
3091our @ISA = CFClient::UI::FancyFrame::;
3092
3093sub new {
3094 my $class = shift;
3095
3096 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3097
3098 $self->add (my $vb = new CFClient::UI::VBox);
3099
3100
3101 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3102 text => "start recording",
3103 tooltip => "Start/Stops recording of actions."
3104 ."All subsequent actions after the recording started will be captured."
3105 ."The actions are displayed after the record was stopped."
3106 ."To bind the action you have to click on the 'Bind' button",
3107 on_activate => sub {
3108 unless ($self->{recording}) {
3109 $self->start;
3110 } else {
3111 $self->stop;
3112 }
3113 });
3114
3115 $vb->add (new CFClient::UI::Label text => "Actions:");
3116 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3117
3118 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3119 $vb->add (my $hb = new CFClient::UI::HBox);
3120 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3121 $hb->add (new CFClient::UI::Button
3122 text => "bind",
3123 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3124 on_activate => sub {
3125 $self->ask_for_bind;
3126 });
3127
3128 $vb->add (my $hb = new CFClient::UI::HBox);
3129 $hb->add (new CFClient::UI::Button
3130 text => "ok",
3131 expand => 1,
3132 tooltip => "This closes the binding editor and saves the binding",
3133 on_activate => sub {
3134 $self->hide;
3135 $self->commit;
3136 });
3137
3138 $hb->add (new CFClient::UI::Button
3139 text => "cancel",
3140 expand => 1,
3141 tooltip => "This closes the binding editor without saving",
3142 on_activate => sub {
3143 $self->hide;
3144 $self->{binding_cancel}->()
3145 if $self->{binding_cancel};
3146 });
3147
3148 $self->update_binding_widgets;
3149
3150 $self
3151}
3152
3153sub commit {
3154 my ($self) = @_;
3155 my ($mod, $sym, $cmds) = $self->get_binding;
3156 if ($sym != 0 && @$cmds > 0) {
3157 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3158 ."'. Don't forget 'Save Config'!");
3159 $self->{binding_change}->($mod, $sym, $cmds)
3160 if $self->{binding_change};
3161 } else {
3162 $::STATUSBOX->add ("No action bound, no key or action specified!");
3163 $self->{binding_cancel}->()
3164 if $self->{binding_cancel};
3165 }
3166}
3167
3168sub start {
3169 my ($self) = @_;
3170
3171 $self->{rec_btn}->set_text ("stop recording");
3172 $self->{recording} = 1;
3173 $self->clear_command_list;
3174 $::CONN->start_record if $::CONN;
3175}
3176
3177sub stop {
3178 my ($self) = @_;
3179
3180 $self->{rec_btn}->set_text ("start recording");
3181 $self->{recording} = 0;
3182
3183 my $rec;
3184 $rec = $::CONN->stop_record if $::CONN;
3185 return unless ref $rec eq 'ARRAY';
3186 $self->set_command_list ($rec);
3187}
3188
3189
3190sub ask_for_bind_and_commit {
3191 my ($self) = @_;
3192 $self->ask_for_bind (1);
3193}
3194
3195sub ask_for_bind {
3196 my ($self, $commit) = @_;
3197
3198 CFClient::Binder::open_binding_dialog (sub {
3199 my ($mod, $sym) = @_;
3200 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3201 $self->update_binding_widgets;
3202 $self->commit if $commit;
3203 });
3204}
3205
3206# $mod and $sym are the modifiers and key symbol
3207# $cmds is a array ref of strings (the commands)
3208# $cb is the callback that is executed on OK
3209# $ccb is the callback that is executed on CANCEL and
3210# when the binding was unsuccessful on OK
3211sub set_binding {
2874 my ($self, $x, $y, $w, $h) = @_; 3212 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
2875 3213
2876 $self->{w} = $w; 3214 $self->clear_command_list;
2877 $self->{h} = $h; 3215 $self->{recording} = 0;
2878} 3216 $self->{rec_btn}->set_text ("start recording");
2879 3217
2880sub check_size { 3218 $self->{binding} = [$mod, $sym];
3219 $self->{commands} = $cmds;
3220
3221 $self->{binding_change} = $cb;
3222 $self->{binding_cancel} = $ccb;
3223
3224 $self->update_binding_widgets;
3225}
3226
3227# this is a shortcut method that asks for a binding
3228# and then just binds it.
3229sub do_quick_binding {
2881 my ($self) = @_; 3230 my ($self, $cmds) = @_;
3231 $self->set_binding (undef, undef, $cmds, sub {
3232 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3233 });
3234 $self->ask_for_bind (1);
3235}
2882 3236
2883 $self->size_allocate ($self->{w}, $self->{h}) 3237sub update_binding_widgets {
2884 if $self->{w}; 3238 my ($self) = @_;
3239 my ($mod, $sym, $cmds) = $self->get_binding;
3240 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3241 $self->set_command_list ($cmds);
3242}
3243
3244sub get_binding {
3245 my ($self) = @_;
3246 return (
3247 $self->{binding}->[0],
3248 $self->{binding}->[1],
3249 [ grep { defined $_ } @{$self->{commands}} ]
3250 );
3251}
3252
3253sub clear_command_list {
3254 my ($self) = @_;
3255 $self->{cmdbox}->clear ();
3256}
3257
3258sub set_command_list {
3259 my ($self, $cmds) = @_;
3260
3261 $self->{cmdbox}->clear ();
3262 $self->{commands} = $cmds;
3263
3264 my $idx = 0;
3265
3266 for (@$cmds) {
3267 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3268
3269 my $i = $idx;
3270 $hb->add (new CFClient::UI::Label text => $_);
3271 $hb->add (new CFClient::UI::Button
3272 text => "delete",
3273 tooltip => "Deletes the action from the record",
3274 on_activate => sub {
3275 $self->{cmdbox}->remove ($hb);
3276 $cmds->[$i] = undef;
3277 });
3278
3279
3280 $idx++
3281 }
3282}
3283
3284#############################################################################
3285
3286package CFClient::UI::SpellList;
3287
3288our @ISA = CFClient::UI::FancyFrame::;
3289
3290sub new {
3291 my $class = shift;
3292
3293 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3294
3295 $self->add (new CFClient::UI::ScrolledWindow
3296 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3297
3298 $self;
3299}
3300
3301# XXX: Do sorting? Argl...
3302sub add_spell {
3303 my ($self, $spell) = @_;
3304 $self->{spells}->{$spell->{name}} = $spell;
3305
3306 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3307 face => $spell->{face},
3308 can_hover => 1,
3309 can_events => 1,
3310 tooltip => $spell->{message});
3311
3312 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3313 text => $spell->{name},
3314 can_hover => 1,
3315 can_events => 1,
3316 tooltip => $spell->{message},
3317 expand => 1);
3318
3319 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3320 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3321 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3322 expand => 1);
3323
3324 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3325 text => "bind to key",
3326 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3327}
3328
3329sub rebuild_spell_list {
3330 my ($self) = @_;
3331 $self->{tbl_idx} = 0;
3332 $self->add_spell ($_) for values %{$self->{spells}};
3333}
3334
3335sub remove_spell {
3336 my ($self, $spell) = @_;
3337 delete $self->{spells}->{$spell->{name}};
3338 $self->rebuild_spell_list;
3339}
3340
3341#############################################################################
3342
3343package CFClient::UI::Root;
3344
3345our @ISA = CFClient::UI::Container::;
3346
3347use CFClient::OpenGL;
3348
3349sub new {
3350 my $class = shift;
3351
3352 my $self = $class->SUPER::new (
3353 visible => 1,
3354 @_,
3355 );
3356
3357 Scalar::Util::weaken ($self->{root} = $self);
3358
3359 $self
2885} 3360}
2886 3361
2887sub size_request { 3362sub size_request {
2888 my ($self) = @_; 3363 my ($self) = @_;
2889 3364
2890 ($self->{w}, $self->{h}) 3365 ($self->{w}, $self->{h})
3366}
3367
3368sub _to_pixel {
3369 my ($coord, $size, $max) = @_;
3370
3371 $coord =
3372 $coord eq "center" ? ($max - $size) * 0.5
3373 : $coord eq "max" ? $max
3374 : $coord;
3375
3376 $coord = 0 if $coord < 0;
3377 $coord = $max - $size if $coord > $max - $size;
3378
3379 int $coord + 0.5
2891} 3380}
2892 3381
2893sub size_allocate { 3382sub size_allocate {
2894 my ($self, $w, $h) = @_; 3383 my ($self, $w, $h) = @_;
2895 3384
2896 my $old_w = $self->{old_w}; $self->{old_w} = $w;
2897 my $old_h = $self->{old_h}; $self->{old_h} = $h;
2898
2899 CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
2900 if $old_w && $old_h && ($old_w != $w || $old_h != $h);
2901
2902 for my $child ($self->children) { 3385 for my $child ($self->children) {
2903 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 3386 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2904 3387
2905 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1 3388 $X = $child->{force_x} if exists $child->{force_x};
2906 if exists $child->{req_x}; 3389 $Y = $child->{force_y} if exists $child->{force_y};
2907 3390
2908 $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1 3391 $X = _to_pixel $X, $W, $self->{w};
2909 if exists $child->{req_y}; 3392 $Y = _to_pixel $Y, $H, $self->{h};
2910
2911 $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
2912 $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
2913 3393
2914 $child->configure ($X, $Y, $W, $H); 3394 $child->configure ($X, $Y, $W, $H);
2915 } 3395 }
2916} 3396}
2917 3397
… …
2928} 3408}
2929 3409
2930sub update { 3410sub update {
2931 my ($self) = @_; 3411 my ($self) = @_;
2932 3412
2933 $self->check_size;
2934 $::WANT_REFRESH++; 3413 $::WANT_REFRESH++;
2935} 3414}
2936 3415
2937sub add { 3416sub add {
2938 my ($self, @children) = @_; 3417 my ($self, @children) = @_;
2939 3418
2940 for my $child (@children) {
2941 $child->{toplevel} = 1; 3419 $_->{is_toplevel} = 1
2942 3420 for @children;
2943 # integerise window positions
2944 $child->{x} = int $child->{x};
2945 $child->{y} = int $child->{y};
2946 }
2947 3421
2948 $self->SUPER::add (@children); 3422 $self->SUPER::add (@children);
3423}
3424
3425sub remove {
3426 my ($self, @children) = @_;
3427
3428 $self->SUPER::remove (@children);
3429
3430 delete $self->{is_toplevel}
3431 for @children;
3432
3433 while (@children) {
3434 my $w = pop @children;
3435 push @children, $w->children;
3436 $w->set_invisible;
3437 }
2949} 3438}
2950 3439
2951sub on_refresh { 3440sub on_refresh {
2952 my ($self, $id, $cb) = @_; 3441 my ($self, $id, $cb) = @_;
2953 3442
… …
2966 while ($self->{refresh_hook}) { 3455 while ($self->{refresh_hook}) {
2967 $_->() 3456 $_->()
2968 for values %{delete $self->{refresh_hook}}; 3457 for values %{delete $self->{refresh_hook}};
2969 } 3458 }
2970 3459
2971 if ($self->{check_size}) { 3460 if ($self->{realloc}) {
2972 my @queue = ([], []); 3461 my %queue;
3462 my @queue;
3463 my $widget;
2973 3464
2974 for (;;) { 3465 outer:
2975 if ($self->{check_size}) { 3466 while () {
2976 # heuristic: check containers last 3467 if (my $realloc = delete $self->{realloc}) {
2977 push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_ 3468 for $widget (values %$realloc) {
2978 for values %{delete $self->{check_size}} 3469 $widget->{visible} or next; # do not resize invisible widgets
3470
3471 $queue{$widget+0}++ and next; # duplicates are common
3472
3473 push @{ $queue[$widget->{visible}] }, $widget;
3474 }
2979 } 3475 }
2980 3476
2981 my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last; 3477 while () {
3478 @queue or last outer;
2982 3479
2983 my ($w, $h) = $widget->{user_w} && $widget->{user_h} 3480 $widget = pop @{ $queue[-1] || [] }
2984 ? @$widget{qw(user_w user_h)} 3481 and last;
2985 : $widget->size_request;
2986
2987 if (delete $widget->{force_alloc}
2988 or $w != $widget->{req_w} or $h != $widget->{req_h}) {
2989 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
2990 3482
3483 pop @queue;
3484 }
3485
3486 delete $queue{$widget+0};
3487
3488 my ($w, $h) = $widget->size_request;
3489
3490 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3491 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3492
3493 $w = $widget->{force_w} if exists $widget->{force_w};
3494 $h = $widget->{force_h} if exists $widget->{force_h};
3495
3496 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3497 || delete $widget->{force_realloc}) {
2991 $widget->{req_w} = $w; 3498 $widget->{req_w} = $w;
2992 $widget->{req_h} = $h; 3499 $widget->{req_h} = $h;
2993 3500
2994 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h]; 3501 $self->{size_alloc}{$widget+0} = $widget;
2995 3502
2996 $widget->{parent}->check_size
2997 if $widget->{parent}; 3503 if (my $parent = $widget->{parent}) {
3504 $self->{realloc}{$parent+0} = $parent
3505 unless $queue{$parent+0};
3506
3507 $parent->{force_size_alloc} = 1;
3508 $self->{size_alloc}{$parent+0} = $parent;
3509 }
2998 } 3510 }
3511
3512 delete $self->{realloc}{$widget+0};
2999 } 3513 }
3000 } 3514 }
3001 3515
3002 while ($self->{size_alloc}) { 3516 while (my $size_alloc = delete $self->{size_alloc}) {
3003 for (values %{delete $self->{size_alloc}}) { 3517 my @queue = sort { $b->{visible} <=> $a->{visible} }
3004 my ($widget, $w, $h) = @$_; 3518 values %$size_alloc;
3519
3520 while () {
3521 my $widget = pop @queue || last;
3522
3523 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3005 3524
3006 $w = 0 if $w < 0; 3525 $w = 0 if $w < 0;
3007 $h = 0 if $h < 0; 3526 $h = 0 if $h < 0;
3008 3527
3528 $w = int $w + 0.5;
3529 $h = int $h + 0.5;
3530
3531 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3532 $widget->{old_w} = $widget->{w};
3533 $widget->{old_h} = $widget->{h};
3534
3009 $widget->{w} = $w; 3535 $widget->{w} = $w;
3010 $widget->{h} = $h; 3536 $widget->{h} = $h;
3011 $widget->size_allocate ($w, $h); 3537
3012 $widget->emit (size_allocate => $w, $h); 3538 $widget->emit (size_allocate => $w, $h);
3539 }
3013 } 3540 }
3014 } 3541 }
3015 3542
3016 while ($self->{post_alloc_hook}) { 3543 while ($self->{post_alloc_hook}) {
3017 $_->() 3544 $_->()
3018 for values %{delete $self->{post_alloc_hook}}; 3545 for values %{delete $self->{post_alloc_hook}};
3019 } 3546 }
3020 3547
3548
3021 glViewport 0, 0, $::WIDTH, $::HEIGHT; 3549 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3022 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 3550 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3023 glClear GL_COLOR_BUFFER_BIT; 3551 glClear GL_COLOR_BUFFER_BIT;
3024 3552
3025 glMatrixMode GL_PROJECTION; 3553 glMatrixMode GL_PROJECTION;
3026 glLoadIdentity; 3554 glLoadIdentity;
3027 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000; 3555 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3028 glMatrixMode GL_MODELVIEW; 3556 glMatrixMode GL_MODELVIEW;
3029 glLoadIdentity; 3557 glLoadIdentity;
3030 3558
3559 {
3560 package CFClient::UI::Base;
3561
3562 ($draw_x, $draw_y, $draw_w, $draw_h) =
3563 (0, 0, $self->{w}, $self->{h});
3564 }
3565
3031 $self->_draw; 3566 $self->_draw;
3032} 3567}
3033 3568
3034############################################################################# 3569#############################################################################
3035 3570

Diff Legend

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