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.267 by root, Thu Jun 1 04:10:29 2006 UTC vs.
Revision 1.477 by root, Sun Jan 11 23:50:27 2009 UTC

1package CFClient::UI; 1package DC::UI;
2 2
3use utf8; 3use utf8;
4use strict; 4use strict;
5 5
6use Scalar::Util ();
7use List::Util (); 6use List::Util ();
8 7
9use CFClient; 8use Guard ();
9
10use DC;
11use DC::Pod;
10use CFClient::Texture; 12use DC::Texture;
11 13
12our ($FOCUS, $HOVER, $GRAB); # various widgets 14our ($FOCUS, $HOVER, $GRAB); # various widgets
13 15
14our $LAYOUT; 16our $LAYOUT;
15our $ROOT; 17our $ROOT;
16our $TOOLTIP; 18our $TOOLTIP;
17our $BUTTON_STATE; 19our $BUTTON_STATE;
18 20
19our %WIDGET; # all widgets, weak-referenced 21our %WIDGET; # all widgets, weak-referenced
22
23our $TOOLTIP_WATCHER = EV::timer_ns 0, 0.03, sub {
24 $_[0]->stop;
25
26 if (!$GRAB) {
27 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
28 if (length $widget->{tooltip}) {
29 if ($TOOLTIP->{owner} != $widget) {
30 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
31 $TOOLTIP->hide;
32
33 $TOOLTIP->{owner} = $widget;
34 $TOOLTIP->{owner}->emit ("tooltip_show") if $TOOLTIP->{owner};
35
36 return if $ENV{CFPLUS_DEBUG} & 8;
37
38 $TOOLTIP->set_tooltip_from ($widget);
39 $TOOLTIP->show;
40 }
41
42 return;
43 }
44 }
45 }
46
47 $TOOLTIP->hide;
48 $TOOLTIP->{owner}->emit ("tooltip_hide") if $TOOLTIP->{owner};
49 delete $TOOLTIP->{owner};
50};
20 51
21sub get_layout { 52sub get_layout {
22 my $layout; 53 my $layout;
23 54
24 for (grep { $_->{name} } values %WIDGET) { 55 for (grep { $_->{name} } values %WIDGET) {
… …
39 my ($layout) = @_; 70 my ($layout) = @_;
40 71
41 $LAYOUT = $layout; 72 $LAYOUT = $layout;
42} 73}
43 74
44sub check_tooltip {
45 return if $ENV{CFPLUS_DEBUG} & 8;
46
47 if (!$GRAB) {
48 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
49 if (length $widget->{tooltip}) {
50 if ($TOOLTIP->{owner} != $widget) {
51 $TOOLTIP->hide;
52
53 $TOOLTIP->{owner} = $widget;
54
55 my $tip = $widget->{tooltip};
56
57 $tip = $tip->($widget) if CODE:: eq ref $tip;
58
59 $TOOLTIP->set_tooltip_from ($widget);
60 $TOOLTIP->show;
61 }
62
63 return;
64 }
65 }
66 }
67
68 $TOOLTIP->hide;
69 delete $TOOLTIP->{owner};
70}
71
72# class methods for events 75# class methods for events
73sub feed_sdl_key_down_event { 76sub feed_sdl_key_down_event {
74 $FOCUS->emit (key_down => $_[0]) 77 $FOCUS->emit (key_down => $_[0])
75 if $FOCUS; 78 if $FOCUS;
76} 79}
… …
78sub feed_sdl_key_up_event { 81sub feed_sdl_key_up_event {
79 $FOCUS->emit (key_up => $_[0]) 82 $FOCUS->emit (key_up => $_[0])
80 if $FOCUS; 83 if $FOCUS;
81} 84}
82 85
86sub check_hover {
87 my ($widget) = @_;
88
89 if ($widget != $HOVER) {
90 my $hover = $HOVER; $HOVER = $widget;
91
92 $hover->update if $hover && $hover->{can_hover};
93 $HOVER->update if $HOVER && $HOVER->{can_hover};
94
95 $TOOLTIP_WATCHER->again;
96 }
97}
98
83sub feed_sdl_button_down_event { 99sub feed_sdl_button_down_event {
84 my ($ev) = @_; 100 my ($ev) = @_;
85 my ($x, $y) = ($ev->{x}, $ev->{y}); 101 my ($x, $y) = ($ev->{x}, $ev->{y});
86 102
87 if (!$BUTTON_STATE) { 103 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
104
105 unless ($GRAB) {
88 my $widget = $ROOT->find_widget ($x, $y); 106 my $widget = $ROOT->find_widget ($x, $y);
89 107
90 $GRAB = $widget; 108 $GRAB = $widget;
91 $GRAB->update if $GRAB; 109 $GRAB->update if $GRAB;
92 110
93 check_tooltip; 111 $TOOLTIP_WATCHER->invoke;
94 } 112 }
95 113
96 $BUTTON_STATE |= 1 << ($ev->{button} - 1); 114 if ($GRAB) {
115 if ($ev->{button} == 4 || $ev->{button} == 5) {
116 # mousewheel
117 my $delta = $ev->{button} * 2 - 9;
118 my $shift = $ev->{mod} & DC::KMOD_SHIFT;
97 119
98 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y)) 120 $ev->{dx} = $shift ? $delta : 0;
99 if $GRAB; 121 $ev->{dy} = $shift ? 0 : $delta;
122
123 $GRAB->emit (mouse_wheel => $ev);
124 } else {
125 $GRAB->emit (button_down => $ev)
126 }
127 }
100} 128}
101 129
102sub feed_sdl_button_up_event { 130sub feed_sdl_button_up_event {
103 my ($ev) = @_; 131 my ($ev) = @_;
104 my ($x, $y) = ($ev->{x}, $ev->{y});
105 132
106 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 133 my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
107 134
108 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1)); 135 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
109 136
110 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y)) 137 $GRAB->emit (button_up => $ev)
111 if $GRAB; 138 if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
112 139
113 if (!$BUTTON_STATE) { 140 unless ($BUTTON_STATE) {
114 my $grab = $GRAB; undef $GRAB; 141 my $grab = $GRAB; undef $GRAB;
115 $grab->update if $grab; 142 $grab->update if $grab;
116 $GRAB->update if $GRAB; 143 $GRAB->update if $GRAB;
117 144
118 check_tooltip; 145 check_hover $widget;
146 $TOOLTIP_WATCHER->invoke;
119 } 147 }
120} 148}
121 149
122sub feed_sdl_motion_event { 150sub feed_sdl_motion_event {
123 my ($ev) = @_; 151 my ($ev) = @_;
124 my ($x, $y) = ($ev->{x}, $ev->{y}); 152 my ($x, $y) = ($ev->{x}, $ev->{y});
125 153
126 my $widget = $GRAB || $ROOT->find_widget ($x, $y); 154 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
127 155
128 if ($widget != $HOVER) { 156 check_hover $widget;
129 my $hover = $HOVER; $HOVER = $widget;
130 157
131 $hover->update if $hover && $hover->{can_hover}; 158 $HOVER->emit (mouse_motion => $ev)
132 $HOVER->update if $HOVER && $HOVER->{can_hover};
133
134 check_tooltip;
135 }
136
137 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
138 if $HOVER; 159 if $HOVER;
139} 160}
140 161
141# convert position array to integers 162# convert position array to integers
142sub harmonize { 163sub harmonize {
… …
170# call when resolution changes etc. 191# call when resolution changes etc.
171sub rescale_widgets { 192sub rescale_widgets {
172 my ($sx, $sy) = @_; 193 my ($sx, $sy) = @_;
173 194
174 for my $widget (values %WIDGET) { 195 for my $widget (values %WIDGET) {
175 if ($widget->{is_toplevel}) { 196 if ($widget->{is_toplevel} || $widget->{c_rescale}) {
176 $widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; 197 $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
177 $widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; 198 $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
178 199
179 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/; 200 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
180 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w}; 201 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
181 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w}; 202 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
182 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/; 203 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
183 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h}; 204 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
184 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h}; 205 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
185 206
186 $widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/; 207 $widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
187 $widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/; 208 $widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
188 209
189 } 210 }
190 } 211 }
191 212
192 reconfigure_widgets; 213 reconfigure_widgets;
193} 214}
194 215
195############################################################################# 216#############################################################################
196 217
218package DC::UI::Event;
219
220sub xy {
221 $_[1]->coord2local ($_[0]{x}, $_[0]{y})
222}
223
224#############################################################################
225
197package CFClient::UI::Base; 226package DC::UI::Base;
198 227
199use strict; 228use strict;
200 229
201use CFClient::OpenGL; 230use DC::OpenGL;
202 231
203sub new { 232sub new {
204 my $class = shift; 233 my $class = shift;
205 234
206 my $self = bless { 235 my $self = bless {
… …
211 h => undef, 240 h => undef,
212 can_events => 1, 241 can_events => 1,
213 @_ 242 @_
214 }, $class; 243 }, $class;
215 244
216 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self); 245 DC::weaken ($DC::UI::WIDGET{$self+0} = $self);
217 246
218 for (keys %$self) { 247 for (keys %$self) {
219 if (/^on_(.*)$/) { 248 if (/^on_(.*)$/) {
220 $self->connect ($1 => delete $self->{$_}); 249 $self->connect ($1 => delete $self->{$_});
221 } 250 }
222 } 251 }
223 252
224 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) { 253 if (my $layout = $DC::UI::LAYOUT->{$self->{name}}) {
225 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x}; 254 $self->{x} = $layout->{x} * $DC::UI::ROOT->{alloc_w} if exists $layout->{x};
226 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y}; 255 $self->{y} = $layout->{y} * $DC::UI::ROOT->{alloc_h} if exists $layout->{y};
227 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w}; 256 $self->{force_w} = $layout->{w} * $DC::UI::ROOT->{alloc_w} if exists $layout->{w};
228 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h}; 257 $self->{force_h} = $layout->{h} * $DC::UI::ROOT->{alloc_h} if exists $layout->{h};
229 258
230 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x}; 259 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
231 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y}; 260 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
232 261
233 $self->show if $layout->{show}; 262 $self->show if $layout->{show};
… …
238 267
239sub destroy { 268sub destroy {
240 my ($self) = @_; 269 my ($self) = @_;
241 270
242 $self->hide; 271 $self->hide;
272 $self->emit ("destroy");
243 %$self = (); 273 %$self = ();
244} 274}
245 275
276sub TO_JSON {
277 { "\fw" => $_[0]{s_id} }
278}
279
246sub show { 280sub show {
247 my ($self) = @_; 281 my ($self) = @_;
248 282
249 return if $self->{parent}; 283 return if $self->{parent};
250 284
251 $CFClient::UI::ROOT->add ($self); 285 $DC::UI::ROOT->add ($self);
252} 286}
253 287
254sub set_visible { 288sub set_visible {
255 my ($self) = @_; 289 my ($self) = @_;
256 290
257 return if $self->{visible}; 291 return if $self->{visible};
292
293 $self->{parent} && $self->{parent}{root}#d#
294 or return ::clienterror ("set_visible called without parent ($self->{parent}) or root\n" => 1);
258 295
259 $self->{root} = $self->{parent}{root}; 296 $self->{root} = $self->{parent}{root};
260 $self->{visible} = $self->{parent}{visible} + 1; 297 $self->{visible} = $self->{parent}{visible} + 1;
261 298
262 $self->emit (visibility_change => 1); 299 $self->emit (visibility_change => 1);
263 300
264 $self->realloc if !exists $self->{req_w}; 301 $self->realloc if !exists $self->{req_w};
265 302
266 $_->set_visible for $self->children; 303 $_->set_visible for $self->visible_children;
267} 304}
268 305
269sub set_invisible { 306sub set_invisible {
270 my ($self) = @_; 307 my ($self) = @_;
271 308
272 return unless $self->{visible}; 309 return unless $self->{visible};
273 310
274 $_->set_invisible for $self->children; 311 $_->set_invisible for $self->children;
275 312
313 delete $self->{visible};
276 delete $self->{root}; 314 delete $self->{root};
277 delete $self->{visible};
278 315
279 undef $GRAB if $GRAB == $self; 316 undef $GRAB if $GRAB == $self;
280 undef $HOVER if $HOVER == $self; 317 undef $HOVER if $HOVER == $self;
281 318
282 CFClient::UI::check_tooltip 319 $DC::UI::TOOLTIP_WATCHER->invoke
283 if $TOOLTIP->{owner} == $self; 320 if $TOOLTIP->{owner} == $self;
284 321
285 $self->focus_out; 322 $self->emit ("focus_out");
286
287 $self->emit (visibility_change => 0); 323 $self->emit (visibility_change => 0);
288} 324}
289 325
290sub set_visibility { 326sub set_visibility {
291 my ($self, $visible) = @_; 327 my ($self, $visible) = @_;
292 328
293 return if $self->{visible} == $visible; 329 return if $self->{visible} == $visible;
294 330
295 $visible ? $self->hide 331 $visible ? $self->show
296 : $self->show; 332 : $self->hide;
297} 333}
298 334
299sub toggle_visibility { 335sub toggle_visibility {
300 my ($self) = @_; 336 my ($self) = @_;
301 337
… …
307sub hide { 343sub hide {
308 my ($self) = @_; 344 my ($self) = @_;
309 345
310 $self->set_invisible; 346 $self->set_invisible;
311 347
348 # extra $parent copy for 5.8.8+ bug workaround
349 # (otherwise $_[0] in remove gets freed
350 if (my $parent = $self->{parent}) {
312 $self->{parent}->remove ($self) 351 $parent->remove ($self);
313 if $self->{parent}; 352 }
314} 353}
315 354
316sub move_abs { 355sub move_abs {
317 my ($self, $x, $y, $z) = @_; 356 my ($self, $x, $y, $z) = @_;
318 357
319 $self->{x} = List::Util::max 0, int $x; 358 $self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
320 $self->{y} = List::Util::max 0, int $y; 359 $self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
321 $self->{z} = $z if defined $z; 360 $self->{z} = $z if defined $z;
322 361
323 $self->update; 362 $self->update;
324} 363}
325 364
… …
328 367
329 $self->{force_w} = $w; 368 $self->{force_w} = $w;
330 $self->{force_h} = $h; 369 $self->{force_h} = $h;
331 370
332 $self->realloc; 371 $self->realloc;
372}
373
374# traverse the widget chain up to find the maximum "physical" size constraints
375sub get_max_wh {
376 my ($self) = @_;
377
378 my ($w, $h) = @$self{qw(max_w max_h)};
379
380 if ($w <= 0 || $h <= 0) {
381 my ($mw, $mh) = $self->{parent}
382 ? $self->{parent}->get_max_wh
383 : ($::WIDTH, $::HEIGHT);
384
385 $w = $mw if $w <= 0;
386 $h = $mh if $h <= 0;
387 }
388
389 ($w, $h)
333} 390}
334 391
335sub size_request { 392sub size_request {
336 require Carp; 393 require Carp;
337 Carp::confess "size_request is abstract"; 394 Carp::confess "size_request is abstract";
338} 395}
339 396
397sub baseline_shift {
398 0
399}
400
340sub configure { 401sub configure {
341 my ($self, $x, $y, $w, $h) = @_; 402 my ($self, $x, $y, $w, $h) = @_;
342 403
343 if ($self->{aspect}) { 404 if ($self->{aspect}) {
344 my ($ow, $oh) = ($w, $h); 405 my ($ow, $oh) = ($w, $h);
345 406
346 $w = List::Util::min $w, int $h * $self->{aspect}; 407 $w = List::Util::min $w, DC::ceil $h * $self->{aspect};
347 $h = List::Util::min $h, int $w / $self->{aspect}; 408 $h = List::Util::min $h, DC::ceil $w / $self->{aspect};
348 409
349 # use alignment to adjust x, y 410 # use alignment to adjust x, y
350 411
351 $x += int 0.5 * ($ow - $w); 412 $x += int 0.5 * ($ow - $w);
352 $y += int 0.5 * ($oh - $h); 413 $y += int 0.5 * ($oh - $h);
… …
366 427
367 $self->{root}{size_alloc}{$self+0} = $self; 428 $self->{root}{size_alloc}{$self+0} = $self;
368 } 429 }
369} 430}
370 431
371sub size_allocate {
372 # nothing to be done
373}
374
375sub children { 432sub children {
433 # nop
434}
435
436sub visible_children {
437 $_[0]->children
376} 438}
377 439
378sub set_max_size { 440sub set_max_size {
379 my ($self, $w, $h) = @_; 441 my ($self, $w, $h) = @_;
380 442
381 delete $self->{max_w}; $self->{max_w} = $w if $w; 443 $self->{max_w} = int $w if defined $w;
382 delete $self->{max_h}; $self->{max_h} = $h if $h; 444 $self->{max_h} = int $h if defined $h;
445
446 $self->realloc;
383} 447}
384 448
385sub set_tooltip { 449sub set_tooltip {
386 my ($self, $tooltip) = @_; 450 my ($self, $tooltip) = @_;
387 451
… …
390 454
391 return if $self->{tooltip} eq $tooltip; 455 return if $self->{tooltip} eq $tooltip;
392 456
393 $self->{tooltip} = $tooltip; 457 $self->{tooltip} = $tooltip;
394 458
395 if ($CFClient::UI::TOOLTIP->{owner} == $self) { 459 if ($DC::UI::TOOLTIP->{owner} == $self) {
396 delete $CFClient::UI::TOOLTIP->{owner}; 460 delete $DC::UI::TOOLTIP->{owner};
397 CFClient::UI::check_tooltip; 461 $DC::UI::TOOLTIP_WATCHER->invoke;
398 } 462 }
399} 463}
400 464
401# translate global coordinates to local coordinate system 465# translate global coordinates to local coordinate system
402sub coord2local { 466sub coord2local {
403 my ($self, $x, $y) = @_; 467 my ($self, $x, $y) = @_;
404 468
469 return (undef, undef) unless $self->{parent};
470
405 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y}) 471 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
406} 472}
407 473
408# translate local coordinates to global coordinate system 474# translate local coordinates to global coordinate system
409sub coord2global { 475sub coord2global {
410 my ($self, $x, $y) = @_; 476 my ($self, $x, $y) = @_;
411 477
478 return (undef, undef) unless $self->{parent};
479
412 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y}) 480 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
413} 481}
414 482
415sub focus_in { 483sub invoke_focus_in {
416 my ($self) = @_; 484 my ($self) = @_;
417 485
418 return if $FOCUS == $self; 486 return if $FOCUS == $self;
419 return unless $self->{can_focus}; 487 return unless $self->{can_focus};
420 488
421 my $focus = $FOCUS; $FOCUS = $self; 489 $FOCUS = $self;
422 490
423 $self->_emit (focus_in => $focus); 491 $self->update;
424 492
425 $focus->update if $focus; 493 0
426 $FOCUS->update;
427} 494}
428 495
429sub focus_out { 496sub invoke_focus_out {
430 my ($self) = @_; 497 my ($self) = @_;
431 498
432 return unless $FOCUS == $self; 499 return unless $FOCUS == $self;
433 500
434 my $focus = $FOCUS; undef $FOCUS; 501 undef $FOCUS;
435 502
436 $self->_emit (focus_out => $focus); 503 $self->update;
437 504
438 $focus->update if $focus; #?
439
440 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus 505 $::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
441 unless $FOCUS; 506 unless $FOCUS;
442}
443 507
508 0
509}
510
511sub grab_focus {
512 my ($self) = @_;
513
514 $FOCUS->emit ("focus_out") if $FOCUS;
515 $self->emit ("focus_in");
516}
517
444sub mouse_motion { } 518sub invoke_mouse_motion { 0 }
445sub button_up { } 519sub invoke_button_up { 0 }
446sub key_down { } 520sub invoke_key_down { 0 }
447sub key_up { } 521sub invoke_key_up { 0 }
522sub invoke_mouse_wheel { 0 }
448 523
449sub button_down { 524sub invoke_button_down {
450 my ($self, $ev, $x, $y) = @_; 525 my ($self, $ev, $x, $y) = @_;
451 526
452 $self->focus_in; 527 $self->grab_focus;
453}
454 528
529 0
530}
531
532sub connect {
533 my ($self, $signal, $cb) = @_;
534
535 push @{ $self->{signal_cb}{$signal} }, $cb;
536
537 defined wantarray and Guard::guard {
538 @{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
539 @{ $self->{signal_cb}{$signal} };
540 }
541}
542
543sub disconnect_all {
544 my ($self, $signal) = @_;
545
546 delete $self->{signal_cb}{$signal};
547}
548
549my %has_coords = (
550 button_down => 1,
551 button_up => 1,
552 mouse_motion => 1,
553 mouse_wheel => 1,
554);
555
556sub emit {
557 my ($self, $signal, @args) = @_;
558
559 # I do not really like this solution, but I do not like duplication
560 # and needlessly verbose code, either.
561 my @append
562 = $has_coords{$signal}
563 ? $args[0]->xy ($self)
564 : ();
565
566 #warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
567
568 for my $cb (
569 @{$self->{signal_cb}{$signal} || []}, # before
570 ($self->can ("invoke_$signal") || sub { 1 }), # closure
571 ) {
572 return $cb->($self, @args, @append) || next;
573 }
574
575 # parent
576 $self->{parent} && $self->{parent}->emit ($signal, @args)
577}
578
455sub find_widget { 579#sub find_widget {
456 my ($self, $x, $y) = @_; 580# in .xs
457
458 return () unless $self->{can_events};
459
460 return $self
461 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
462 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
463
464 ()
465}
466 581
467sub set_parent { 582sub set_parent {
468 my ($self, $parent) = @_; 583 my ($self, $parent) = @_;
469 584
470 Scalar::Util::weaken ($self->{parent} = $parent); 585 DC::weaken ($self->{parent} = $parent);
471 $self->set_visible if $parent->{visible}; 586 $self->set_visible if $parent->{visible};
472}
473
474sub connect {
475 my ($self, $signal, $cb) = @_;
476
477 push @{ $self->{signal_cb}{$signal} }, $cb;
478}
479
480sub _emit {
481 my ($self, $signal, @args) = @_;
482
483 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
484}
485
486sub emit {
487 my ($self, $signal, @args) = @_;
488
489 $self->_emit ($signal, @args)
490 || $self->$signal (@args);
491}
492
493sub visibility_change {
494 #my ($self, $visible) = @_;
495} 587}
496 588
497sub realloc { 589sub realloc {
498 my ($self) = @_; 590 my ($self) = @_;
499 591
… …
524 616
525# using global variables seems a bit hacky, but passing through all drawing 617# using global variables seems a bit hacky, but passing through all drawing
526# functions seems pointless. 618# functions seems pointless.
527our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn 619our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
528 620
529sub draw { 621#sub draw {
530 my ($self) = @_; 622#CFPlus.xs
531
532 return unless $self->{h} && $self->{w};
533
534 local $draw_x = $draw_x + $self->{x};
535 local $draw_y = $draw_y + $self->{y};
536
537 return if $draw_x + $self->{w} < 0;
538 return if $draw_x >= $draw_w;
539 return if $draw_y + $self->{h} < 0;
540 return if $draw_y >= $draw_h;
541
542 glPushMatrix;
543 glTranslate $self->{x}, $self->{y}, 0;
544 $self->_draw;
545 glPopMatrix;
546
547 if ($self == $HOVER && $self->{can_hover}) {
548 my ($x, $y) = @$self{qw(x y)};
549
550 glColor 1, 0.8, 0.5, 0.2;
551 glEnable GL_BLEND;
552 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
553 glBegin GL_QUADS;
554 glVertex $x , $y;
555 glVertex $x + $self->{w}, $y;
556 glVertex $x + $self->{w}, $y + $self->{h};
557 glVertex $x , $y + $self->{h};
558 glEnd;
559 glDisable GL_BLEND;
560 }
561
562 if ($ENV{CFPLUS_DEBUG} & 1) {
563 glPushMatrix;
564 glColor 1, 1, 0, 1;
565 glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
566 glBegin GL_LINE_LOOP;
567 glVertex 0 , 0;
568 glVertex $self->{w} - 1, 0;
569 glVertex $self->{w} - 1, $self->{h} - 1;
570 glVertex 0 , $self->{h} - 1;
571 glEnd;
572 glPopMatrix;
573 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
574 }
575}
576 623
577sub _draw { 624sub _draw {
578 my ($self) = @_; 625 my ($self) = @_;
579 626
580 warn "no draw defined for $self\n"; 627 warn "no draw defined for $self\n";
581} 628}
582 629
583sub DESTROY { 630sub DESTROY {
584 my ($self) = @_; 631 my ($self) = @_;
585 632
633 return if DC::in_destruct;
634
635 local $@;
636 eval { $self->destroy };
637 warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
638
586 delete $WIDGET{$self+0}; 639 delete $WIDGET{$self+0};
587 #$self->deactivate;
588} 640}
589 641
590############################################################################# 642#############################################################################
591 643
592package CFClient::UI::DrawBG; 644package DC::UI::DrawBG;
593 645
594our @ISA = CFClient::UI::Base::; 646our @ISA = DC::UI::Base::;
595 647
596use strict; 648use strict;
597use CFClient::OpenGL; 649use DC::OpenGL;
598 650
599sub new { 651sub new {
600 my $class = shift; 652 my $class = shift;
601
602 # range [value, low, high, page]
603 653
604 $class->SUPER::new ( 654 $class->SUPER::new (
605 #bg => [0, 0, 0, 0.2], 655 #bg => [0, 0, 0, 0.2],
606 #active_bg => [1, 1, 1, 0.5], 656 #active_bg => [1, 1, 1, 0.5],
607 @_ 657 @_
608 ) 658 )
609} 659}
610 660
661sub set_bg {
662 my ($self, $bg) = @_;
663
664 $self->{bg} = $bg;
665 $self->update;
666}
667
611sub _draw { 668sub _draw {
612 my ($self) = @_; 669 my ($self) = @_;
613 670
614 my $color = $FOCUS == $self && $self->{active_bg} 671 my $color = $FOCUS == $self && $self->{active_bg}
615 ? $self->{active_bg} 672 ? $self->{active_bg}
… …
617 674
618 if ($color && (@$color < 4 || $color->[3])) { 675 if ($color && (@$color < 4 || $color->[3])) {
619 my ($w, $h) = @$self{qw(w h)}; 676 my ($w, $h) = @$self{qw(w h)};
620 677
621 glEnable GL_BLEND; 678 glEnable GL_BLEND;
622 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 679 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
623 glColor @$color; 680 glColor_premultiply @$color;
624
625 glBegin GL_QUADS;
626 glVertex 0 , 0;
627 glVertex 0 , $h;
628 glVertex $w, $h; 681 glRect 0, 0, $w, $h;
629 glVertex $w, 0;
630 glEnd;
631
632 glDisable GL_BLEND; 682 glDisable GL_BLEND;
633 } 683 }
634} 684}
635 685
636############################################################################# 686#############################################################################
637 687
638package CFClient::UI::Empty; 688package DC::UI::Empty;
639 689
640our @ISA = CFClient::UI::Base::; 690our @ISA = DC::UI::Base::;
641 691
642sub new { 692sub new {
643 my ($class, %arg) = @_; 693 my ($class, %arg) = @_;
644 $class->SUPER::new (can_events => 0, %arg); 694 $class->SUPER::new (can_events => 0, %arg);
645} 695}
… …
652 702
653sub draw { } 703sub draw { }
654 704
655############################################################################# 705#############################################################################
656 706
657package CFClient::UI::Container; 707package DC::UI::Container;
658 708
659our @ISA = CFClient::UI::Base::; 709our @ISA = DC::UI::Base::;
660 710
661sub new { 711sub new {
662 my ($class, %arg) = @_; 712 my ($class, %arg) = @_;
663 713
664 my $children = delete $arg{children} || []; 714 my $children = delete $arg{children};
665 715
666 my $self = $class->SUPER::new ( 716 my $self = $class->SUPER::new (
667 children => [], 717 children => [],
668 can_events => 0, 718 can_events => 0,
669 %arg, 719 %arg,
670 ); 720 );
721
671 $self->add ($_) for @$children; 722 $self->add (@$children)
723 if $children && @$children;
672 724
673 $self 725 $self
726}
727
728sub realloc {
729 my ($self) = @_;
730
731 $self->{force_realloc} = 1;
732 $self->{force_size_alloc} = 1;
733 $self->SUPER::realloc;
674} 734}
675 735
676sub add { 736sub add {
677 my ($self, @widgets) = @_; 737 my ($self, @widgets) = @_;
678 738
679 $_->set_parent ($self) 739 $_->set_parent ($self)
680 for @widgets; 740 for @widgets;
681 741
742 # TODO: only do this in widgets that need it, e.g. root, fixed
682 use sort 'stable'; 743 use sort 'stable';
683 744
684 $self->{children} = [ 745 $self->{children} = [
685 sort { $a->{z} <=> $b->{z} } 746 sort { $a->{z} <=> $b->{z} }
686 @{$self->{children}}, @widgets 747 @{$self->{children}}, @widgets
687 ]; 748 ];
688 749
689 $self->realloc; 750 $self->realloc;
751
752 $self->emit (c_add => \@widgets);
753
754 map $_+0, @widgets
690} 755}
691 756
692sub children { 757sub children {
693 @{ $_[0]{children} } 758 @{ $_[0]{children} }
694} 759}
695 760
696sub remove { 761sub remove {
697 my ($self, $child) = @_; 762 my ($self, @widgets) = @_;
698 763
764 $self->emit (c_remove => \@widgets);
765
766 for my $child (@widgets) {
699 delete $child->{parent}; 767 delete $child->{parent};
700 $child->hide; 768 $child->hide;
701
702 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ]; 769 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
770 }
703 771
704 $self->realloc; 772 $self->realloc;
705} 773}
706 774
707sub clear { 775sub clear {
708 my ($self) = @_; 776 my ($self) = @_;
709 777
710 my $children = delete $self->{children}; 778 my $children = $self->{children};
711 $self->{children} = []; 779 $self->{children} = [];
712 780
713 for (@$children) { 781 for (@$children) {
714 delete $_->{parent}; 782 delete $_->{parent};
715 $_->hide; 783 $_->hide;
… …
724 $x -= $self->{x}; 792 $x -= $self->{x};
725 $y -= $self->{y}; 793 $y -= $self->{y};
726 794
727 my $res; 795 my $res;
728 796
729 for (reverse @{ $self->{children} }) { 797 for (reverse $self->visible_children) {
730 $res = $_->find_widget ($x, $y) 798 $res = $_->find_widget ($x, $y)
731 and return $res; 799 and return $res;
732 } 800 }
733 801
734 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y}) 802 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
735} 803}
736 804
737sub _draw { 805sub _draw {
738 my ($self) = @_; 806 my ($self) = @_;
739 807
740 $_->draw for @{$self->{children}}; 808 $_->draw for $self->visible_children;
741} 809}
742 810
743############################################################################# 811#############################################################################
744 812
745package CFClient::UI::Bin; 813package DC::UI::Bin;
746 814
747our @ISA = CFClient::UI::Container::; 815our @ISA = DC::UI::Container::;
748 816
749sub new { 817sub new {
750 my ($class, %arg) = @_; 818 my ($class, %arg) = @_;
751 819
752 my $child = (delete $arg{child}) || new CFClient::UI::Empty::; 820 my $child = (delete $arg{child}) || new DC::UI::Empty::;
753 821
754 $class->SUPER::new (children => [$child], %arg) 822 $class->SUPER::new (children => [$child], %arg)
755} 823}
756 824
757sub add { 825sub add {
758 my ($self, $child) = @_; 826 my ($self, $child) = @_;
759 827
760 $self->{children} = []; 828 $self->clear;
761
762 $self->SUPER::add ($child); 829 $self->SUPER::add ($child);
763} 830}
764 831
765sub remove { 832sub remove {
766 my ($self, $widget) = @_; 833 my ($self, $widget) = @_;
767 834
768 $self->SUPER::remove ($widget); 835 $self->SUPER::remove ($widget);
769 836
770 $self->{children} = [new CFClient::UI::Empty] 837 $self->{children} = [new DC::UI::Empty]
771 unless @{$self->{children}}; 838 unless @{$self->{children}};
772} 839}
773 840
774sub child { $_[0]->{children}[0] } 841sub child { $_[0]->{children}[0] }
775 842
776sub size_request { 843sub size_request {
777 $_[0]{children}[0]->size_request 844 $_[0]{children}[0]->size_request
778} 845}
779 846
780sub size_allocate { 847sub invoke_size_allocate {
781 my ($self, $w, $h) = @_; 848 my ($self, $w, $h) = @_;
782 849
783 $self->{children}[0]->configure (0, 0, $w, $h); 850 $self->{children}[0]->configure (0, 0, $w, $h);
851
852 1
784} 853}
785 854
786############################################################################# 855#############################################################################
856# back-buffered drawing area
787 857
788package CFClient::UI::Window; 858package DC::UI::Window;
789 859
790our @ISA = CFClient::UI::Bin::; 860our @ISA = DC::UI::Bin::;
791 861
792use CFClient::OpenGL; 862use DC::OpenGL;
793 863
794sub new { 864sub new {
795 my ($class, %arg) = @_; 865 my ($class, %arg) = @_;
796 866
797 my $self = $class->SUPER::new (%arg); 867 my $self = $class->SUPER::new (%arg);
… …
802 872
803 $ROOT->on_post_alloc ($self => sub { $self->render_child }); 873 $ROOT->on_post_alloc ($self => sub { $self->render_child });
804 $self->SUPER::update; 874 $self->SUPER::update;
805} 875}
806 876
807sub size_allocate { 877sub invoke_size_allocate {
808 my ($self, $w, $h) = @_; 878 my ($self, $w, $h) = @_;
809 879
810 $self->SUPER::size_allocate ($w, $h);
811 $self->update; 880 $self->update;
881
882 $self->SUPER::invoke_size_allocate ($w, $h)
812} 883}
813 884
814sub _render { 885sub _render {
815 my ($self) = @_; 886 my ($self) = @_;
816 887
… …
818} 889}
819 890
820sub render_child { 891sub render_child {
821 my ($self) = @_; 892 my ($self) = @_;
822 893
823 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub { 894 $self->{texture} = new_from_opengl DC::Texture $self->{w}, $self->{h}, sub {
824 glClearColor 0, 0, 0, 0; 895 glClearColor 0, 0, 0, 0;
825 glClear GL_COLOR_BUFFER_BIT; 896 glClear GL_COLOR_BUFFER_BIT;
826 897
827 { 898 {
828 package CFClient::UI::Base; 899 package DC::UI::Base;
829 900
830 ($draw_x, $draw_y, $draw_w, $draw_h) = 901 local ($draw_x, $draw_y, $draw_w, $draw_h) =
831 (0, 0, $self->{w}, $self->{h}); 902 (0, 0, $self->{w}, $self->{h});
903
904 $self->_render;
832 } 905 }
833
834 $self->_render;
835 }; 906 };
836} 907}
837 908
838sub _draw { 909sub _draw {
839 my ($self) = @_; 910 my ($self) = @_;
840
841 my ($w, $h) = @$self{qw(w h)};
842 911
843 my $tex = $self->{texture} 912 my $tex = $self->{texture}
844 or return; 913 or return;
845 914
846 glEnable GL_TEXTURE_2D; 915 glEnable GL_TEXTURE_2D;
847 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 916 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
848 glColor 1, 1, 1, 1; 917 glColor 0, 0, 0, 1;
849 918
850 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h); 919 $tex->draw_quad_alpha_premultiplied (0, 0);
851 920
852 glDisable GL_TEXTURE_2D; 921 glDisable GL_TEXTURE_2D;
853} 922}
854 923
855############################################################################# 924#############################################################################
856 925
857package CFClient::UI::ViewPort; 926package DC::UI::ViewPort;
858 927
928use List::Util qw(min max);
929
859our @ISA = CFClient::UI::Window::; 930our @ISA = DC::UI::Window::;
860 931
861sub new { 932sub new {
862 my $class = shift; 933 my $class = shift;
863 934
864 $class->SUPER::new ( 935 $class->SUPER::new (
… …
871sub size_request { 942sub size_request {
872 my ($self) = @_; 943 my ($self) = @_;
873 944
874 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 945 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
875 946
876 $w = 10 if $self->{scroll_x}; 947 $w = 1 if $self->{scroll_x};
877 $h = 10 if $self->{scroll_y}; 948 $h = 1 if $self->{scroll_y};
878 949
879 ($w, $h) 950 ($w, $h)
880} 951}
881 952
882sub size_allocate { 953sub invoke_size_allocate {
883 my ($self, $w, $h) = @_; 954 my ($self, $w, $h) = @_;
884 955
885 my $child = $self->child; 956 my $child = $self->child;
886 957
887 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w}; 958 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
888 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h}; 959 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
889 960
890 $self->child->configure (0, 0, $w, $h); 961 $self->child->configure (0, 0, $w, $h);
891 $self->update; 962 $self->update;
963
964 1
892} 965}
893 966
894sub set_offset { 967sub set_offset {
895 my ($self, $x, $y) = @_; 968 my ($self, $x, $y) = @_;
896 969
970 my $x = max 0, min $self->child->{w} - $self->{w}, int $x;
971 my $y = max 0, min $self->child->{h} - $self->{h}, int $y;
972
973 if ($x != $self->{view_x} or $y != $self->{view_y}) {
897 $self->{view_x} = int $x; 974 $self->{view_x} = $x;
898 $self->{view_y} = int $y; 975 $self->{view_y} = $y;
899 976
977 $self->emit (changed => $x, $y);
900 $self->update; 978 $self->update;
979 }
980}
981
982sub set_center {
983 my ($self, $x, $y) = @_;
984
985 $self->set_offset ($x - $self->{w} * .5, $y - $self->{h} * .5);
986}
987
988sub make_visible {
989 my ($self, $x, $y, $border) = @_;
990
991 if ( $x < $self->{view_x} + $self->{w} * $border
992 || $x > $self->{view_x} + $self->{w} * (1 - $border)
993 || $y < $self->{view_y} + $self->{h} * $border
994 || $y > $self->{view_y} + $self->{h} * (1 - $border)
995 ) {
996 $self->set_center ($x, $y);
997 }
901} 998}
902 999
903# hmm, this does not work for topleft of $self... but we should not ask for that 1000# hmm, this does not work for topleft of $self... but we should not ask for that
904sub coord2local { 1001sub coord2local {
905 my ($self, $x, $y) = @_; 1002 my ($self, $x, $y) = @_;
… …
920 my ($self, $x, $y) = @_; 1017 my ($self, $x, $y) = @_;
921 1018
922 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w} 1019 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
923 && $y >= $self->{y} && $y < $self->{y} + $self->{h} 1020 && $y >= $self->{y} && $y < $self->{y} + $self->{h}
924 ) { 1021 ) {
925 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y}) 1022 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
926 } else { 1023 } else {
927 $self->CFClient::UI::Base::find_widget ($x, $y) 1024 $self->DC::UI::Base::find_widget ($x, $y)
928 } 1025 }
929} 1026}
930 1027
931sub _render { 1028sub _render {
932 my ($self) = @_; 1029 my ($self) = @_;
933 1030
934 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x}; 1031 local $DC::UI::Base::draw_x = $DC::UI::Base::draw_x - $self->{view_x};
935 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y}; 1032 local $DC::UI::Base::draw_y = $DC::UI::Base::draw_y - $self->{view_y};
936 1033
937 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y}; 1034 DC::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
938 1035
939 $self->SUPER::_render; 1036 $self->SUPER::_render;
940} 1037}
941 1038
942############################################################################# 1039#############################################################################
943 1040
944package CFClient::UI::ScrolledWindow; 1041package DC::UI::ScrolledWindow;
945 1042
946our @ISA = CFClient::UI::HBox::; 1043our @ISA = DC::UI::Table::;
947 1044
948sub new { 1045sub new {
949 my $class = shift; 1046 my ($class, %arg) = @_;
1047
1048 my $child = delete $arg{child};
950 1049
951 my $self; 1050 my $self;
952 1051
953 my $slider = new CFClient::UI::Slider 1052 my $hslider = new DC::UI::Slider
1053 c_col => 0,
1054 c_row => 1,
1055 vertical => 0,
1056 range => [0, 0, 1, 0.01], # HACK fix
1057 on_changed => sub {
1058 $self->{hpos} = $_[1];
1059 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
1060 },
1061 ;
1062
1063 my $vslider = new DC::UI::Slider
1064 c_col => 1,
1065 c_row => 0,
954 vertical => 1, 1066 vertical => 1,
955 range => [0, 0, 1, 0.01], # HACK fix 1067 range => [0, 0, 1, 0.01], # HACK fix
956 on_changed => sub { 1068 on_changed => sub {
957 $self->{vp}->set_offset (0, $_[1]); 1069 $self->{vpos} = $_[1];
1070 $self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
958 }, 1071 },
959 ; 1072 ;
960 1073
961 $self = $class->SUPER::new ( 1074 $self = $class->SUPER::new (
962 vp => (new CFClient::UI::ViewPort expand => 1), 1075 scroll_x => 0,
1076 scroll_y => 1,
1077 can_events => 1,
963 slider => $slider, 1078 hslider => $hslider,
964 @_, 1079 vslider => $vslider,
1080 col_expand => [1, 0],
1081 row_expand => [1, 0],
1082 %arg,
965 ); 1083 );
966 1084
967 $self->{vp}->add ($self->{scrolled}); 1085 $self->{vp} = new DC::UI::ViewPort
1086 c_col => 0,
1087 c_row => 0,
1088 expand => 1,
1089 scroll_x => $self->{scroll_x},
1090 scroll_y => $self->{scroll_y},
1091 on_changed => sub {
1092 my ($vp, $x, $y) = @_;
1093
1094 $vp->{parent}{hslider}->set_value ($x);
1095 $vp->{parent}{vslider}->set_value ($y);
1096
1097 0
1098 },
1099 on_size_allocate => sub {
1100 my ($vp, $w, $h) = @_;
1101 $vp->{parent}->update_slider;
1102 0
1103 },
1104 ;
1105
968 $self->add ($self->{vp}); 1106 $self->SUPER::add ($self->{vp});
969 $self->add ($self->{slider}); 1107
1108 $self->add ($child) if $child;
970 1109
971 $self 1110 $self
972} 1111}
973 1112
1113sub add {
1114 my ($self, $widget) = @_;
1115
1116 $self->{vp}->add ($self->{child} = $widget);
1117}
1118
1119sub set_offset { shift->{vp}->set_offset (@_) }
1120sub set_center { shift->{vp}->set_center (@_) }
1121sub make_visible { shift->{vp}->make_visible (@_) }
1122
974sub update { 1123sub update_slider {
1124 my ($self) = @_;
1125
1126 my $child = ($self->{vp} or return)->child;
1127
1128 if ($self->{scroll_x}) {
1129 my ($w1, $w2) = ($child->{req_w}, $self->{vp}{w});
1130 $self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);
1131
1132 my $visible = $w1 > $w2;
1133 if ($visible != $self->{hslider_visible}) {
1134 $self->{hslider_visible} = $visible;
1135 $visible ? $self->SUPER::add ($self->{hslider})
1136 : $self->SUPER::remove ($self->{hslider});
1137 }
1138 }
1139
1140 if ($self->{scroll_y}) {
1141 my ($h1, $h2) = ($child->{req_h}, $self->{vp}{h});
1142 $self->{vslider}->set_range ([$self->{vslider}{range}[0], 0, $h1, $h2, 1]);
1143
1144 my $visible = $h1 > $h2;
1145 if ($visible != $self->{vslider_visible}) {
1146 $self->{vslider_visible} = $visible;
1147 $visible ? $self->SUPER::add ($self->{vslider})
1148 : $self->SUPER::remove ($self->{vslider});
1149 }
1150 }
1151}
1152
1153sub start_dragging {
975 my ($self) = @_; 1154 my ($self, $ev) = @_;
976 1155
977 $self->SUPER::update; 1156 $self->grab_focus;
978 1157
979 # todo: overwrite size_allocate of child 1158 my $ox = $self->{vp}{view_x};
980 my $child = $self->{vp}->child; 1159 my $oy = $self->{vp}{view_y};
981 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]); 1160
982} 1161 $self->{motion} = sub {
1162 my ($ev, $x, $y) = @_;
983 1163
1164 $ox -= $ev->{xrel};
1165 $oy -= $ev->{yrel};
1166
1167 $self->{vp}->set_offset ($ox, $oy);
1168 };
1169}
1170
1171sub invoke_mouse_wheel {
1172 my ($self, $ev) = @_;
1173
1174 $self->{vslider}->emit (mouse_wheel => $ev) if $self->{vslider_visible};
1175 $self->{hslider}->emit (mouse_wheel => $ev) if $self->{hslider_visible};
1176
1177 1
1178}
1179
1180sub invoke_button_down {
1181 my ($self, $ev, $x, $y) = @_;
1182
1183 if ($ev->{button} == 2) {
1184 $self->start_dragging ($ev);
1185 return 1;
1186 }
1187
1188 0
1189}
1190
1191sub invoke_button_up {
1192 my ($self, $ev, $x, $y) = @_;
1193
1194 if (delete $self->{motion}) {
1195 return 1;
1196 }
1197
1198 0
1199}
1200
1201sub invoke_mouse_motion {
1202 my ($self, $ev, $x, $y) = @_;
1203
1204 if ($self->{motion}) {
1205 $self->{motion}->($ev, $x, $y);
1206 return 1;
1207 }
1208
1209 0
1210}
1211
984sub size_allocate { 1212sub invoke_size_allocate {
985 my ($self, $w, $h) = @_; 1213 my ($self, $w, $h) = @_;
986 1214
1215 $self->update_slider;
987 $self->SUPER::size_allocate ($w, $h); 1216 $self->SUPER::invoke_size_allocate ($w, $h)
988
989 my $child = $self->{vp}->child;
990 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
991} 1217}
992
993#TODO# update range on size_allocate depending on child
994# update viewport offset on scroll
995 1218
996############################################################################# 1219#############################################################################
997 1220
998package CFClient::UI::Frame; 1221package DC::UI::Frame;
999 1222
1000our @ISA = CFClient::UI::Bin::; 1223our @ISA = DC::UI::Bin::;
1001 1224
1002use CFClient::OpenGL; 1225use DC::OpenGL;
1003 1226
1004sub new { 1227sub new {
1005 my $class = shift; 1228 my $class = shift;
1006 1229
1007 $class->SUPER::new ( 1230 $class->SUPER::new (
… …
1015 1238
1016 if ($self->{bg}) { 1239 if ($self->{bg}) {
1017 my ($w, $h) = @$self{qw(w h)}; 1240 my ($w, $h) = @$self{qw(w h)};
1018 1241
1019 glEnable GL_BLEND; 1242 glEnable GL_BLEND;
1020 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 1243 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1021 glColor @{ $self->{bg} }; 1244 glColor_premultiply @{ $self->{bg} };
1022
1023 glBegin GL_QUADS;
1024 glVertex 0 , 0;
1025 glVertex 0 , $h;
1026 glVertex $w, $h; 1245 glRect 0, 0, $w, $h;
1027 glVertex $w, 0;
1028 glEnd;
1029
1030 glDisable GL_BLEND; 1246 glDisable GL_BLEND;
1031 } 1247 }
1032 1248
1033 $self->SUPER::_draw; 1249 $self->SUPER::_draw;
1034} 1250}
1035 1251
1036############################################################################# 1252#############################################################################
1037 1253
1038package CFClient::UI::FancyFrame; 1254package DC::UI::FancyFrame;
1039 1255
1040our @ISA = CFClient::UI::Bin::; 1256our @ISA = DC::UI::Bin::;
1041 1257
1042use CFClient::OpenGL; 1258use DC::OpenGL;
1043
1044my $bg =
1045 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1046 mipmap => 1, wrap => 1;
1047
1048my @border =
1049 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1050 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1051 1259
1052sub new { 1260sub new {
1053 my $class = shift; 1261 my ($class, %arg) = @_;
1262
1263 if ((exists $arg{label}) && !ref $arg{label}) {
1264 $arg{label} = new DC::UI::Label
1265 align => 1,
1266 valign => 0.5,
1267 text => $arg{label},
1268 fontsize => ($arg{border} || 0.8) * 0.75;
1269 }
1054 1270
1055 my $self = $class->SUPER::new ( 1271 my $self = $class->SUPER::new (
1056 bg => [1, 1, 1, 1], 1272 # label => "",
1057 border_bg => [1, 1, 1, 1], 1273 fg => undef,
1058 border => 0.6, 1274 border => 0.8,
1059 can_events => 1, 1275 style => 'single',
1060 min_w => 16, 1276 %arg,
1061 min_h => 16,
1062 @_
1063 ); 1277 );
1064 1278
1065 $self->{title} &&= new CFClient::UI::Label
1066 align => 0,
1067 valign => 1,
1068 text => $self->{title},
1069 fontsize => $self->{border};
1070
1071 $self 1279 $self
1280}
1281
1282sub add {
1283 my ($self, @widgets) = @_;
1284
1285 $self->SUPER::add (@widgets);
1286 $self->DC::UI::Container::add ($self->{label}) if $self->{label};
1072} 1287}
1073 1288
1074sub border { 1289sub border {
1075 int $_[0]{border} * $::FONTSIZE 1290 int $_[0]{border} * $::FONTSIZE
1076} 1291}
1077 1292
1078sub size_request { 1293sub size_request {
1079 my ($self) = @_; 1294 my ($self) = @_;
1295
1296 ($self->{label_w}, undef) = $self->{label}->size_request
1297 if $self->{label};
1080 1298
1081 my ($w, $h) = $self->SUPER::size_request; 1299 my ($w, $h) = $self->SUPER::size_request;
1082 1300
1083 ( 1301 (
1084 $w + $self->border * 2, 1302 $w + $self->border * 2,
1085 $h + $self->border * 2, 1303 $h + $self->border * 2,
1086 ) 1304 )
1087} 1305}
1088 1306
1089sub size_allocate { 1307sub invoke_size_allocate {
1090 my ($self, $w, $h) = @_; 1308 my ($self, $w, $h) = @_;
1091 1309
1092 $h -= List::Util::max 0, $self->border * 2; 1310 my $border = $self->border;
1311
1093 $w -= List::Util::max 0, $self->border * 2; 1312 $w -= List::Util::max 0, $border * 2;
1313 $h -= List::Util::max 0, $border * 2;
1094 1314
1095 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2) 1315 if (my $label = $self->{label}) {
1096 if $self->{title}; 1316 $label->{w} = List::Util::max 0, List::Util::min $self->{label_w}, $w - $border * 2;
1317 $label->{h} = List::Util::min $h, $border;
1318 $label->invoke_size_allocate ($label->{w}, $label->{h});
1319 }
1097 1320
1098 $self->child->configure ($self->border, $self->border, $w, $h); 1321 $self->child->configure ($border, $border, $w, $h);
1099}
1100 1322
1323 1
1324}
1325
1326sub _draw {
1327 my ($self) = @_;
1328
1329 my $child = $self->{children}[0];
1330
1331 my $border = $self->border;
1332 my ($w, $h) = ($self->{w}, $self->{h});
1333
1334 $child->draw;
1335
1336 glColor @{$self->{fg} || $DC::THEME{fancyframe}};
1337 glBegin GL_LINE_STRIP;
1338 glVertex $border * 1.5 , $border * 0.5 + 0.5;
1339 glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5;
1340 glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
1341 glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
1342 glVertex $w - $border * 0.5 + 0.5, $border * 0.5 + 0.5;
1343 glVertex $self->{label} ? $border * 2 + $self->{label}{w} : $border * 1.5, $border * 0.5 + 0.5;
1344 glEnd;
1345
1346 if ($self->{label}) {
1347 glTranslate $border * 2, 0;
1348 $self->{label}->_draw;
1349 }
1350}
1351
1352#############################################################################
1353
1354package DC::UI::Toplevel;
1355
1356our @ISA = DC::UI::Bin::;
1357
1358use DC::OpenGL;
1359
1360my $bg =
1361 new_from_resource DC::Texture "d1_bg.png",
1362 mipmap => 1, wrap => 1;
1363
1364my @border =
1365 map { new_from_resource DC::Texture $_, mipmap => 1 }
1366 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1367
1368my @icon =
1369 map { new_from_resource DC::Texture $_, mipmap => 1 }
1370 qw(x1_move.png x1_resize.png);
1371
1372sub new {
1373 my ($class, %arg) = @_;
1374
1375 my $self = $class->SUPER::new (
1376 bg => [1, 1, 1, 1],
1377 border_bg => [1, 1, 1, 1],
1378 border => 0.8,
1379 can_events => 1,
1380 min_w => 64,
1381 min_h => 32,
1382 %arg,
1383 );
1384
1385 $self->{title_widget} = new DC::UI::Label
1386 align => 0.5,
1387 valign => 1,
1388 text => $self->{title},
1389 fontsize => $self->{border},
1390 if exists $self->{title};
1391
1392 if ($self->{has_close_button}) {
1393 $self->{close_button} =
1394 new DC::UI::ImageButton
1395 path => 'x1_close.png',
1396 on_activate => sub { $self->emit ("delete") };
1397
1398 $self->DC::UI::Container::add ($self->{close_button});
1399 }
1400
1401 $self
1402}
1403
1404sub add {
1405 my ($self, @widgets) = @_;
1406
1407 $self->SUPER::add (@widgets);
1408 $self->DC::UI::Container::add ($self->{close_button}) if $self->{close_button};
1409 $self->DC::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1410}
1411
1412sub border {
1413 int $_[0]{border} * $::FONTSIZE
1414}
1415
1416sub get_max_wh {
1417 my ($self) = @_;
1418
1419 return ($self->{w}, $self->{h})
1420 if $self->{visible} && $self->{w};
1421
1422 $self->SUPER::get_max_wh
1423}
1424
1425sub size_request {
1426 my ($self) = @_;
1427
1428 $self->{title_widget}->size_request
1429 if $self->{title_widget};
1430
1431 $self->{close_button}->size_request
1432 if $self->{close_button};
1433
1434 my ($w, $h) = $self->SUPER::size_request;
1435
1436 (
1437 $w + $self->border * 2,
1438 $h + $self->border * 2,
1439 )
1440}
1441
1442sub invoke_size_allocate {
1443 my ($self, $w, $h) = @_;
1444
1445 if ($self->{title_widget}) {
1446 $self->{title_widget}{w} = $w;
1447 $self->{title_widget}{h} = $h;
1448 $self->{title_widget}->invoke_size_allocate ($w, $h);
1449 }
1450
1451 my $border = $self->border;
1452
1453 $h -= List::Util::max 0, $border * 2;
1454 $w -= List::Util::max 0, $border * 2;
1455
1456 $self->child->configure ($border, $border, $w, $h);
1457
1458 $self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1459 if $self->{close_button};
1460
1461 1
1462}
1463
1464sub invoke_delete {
1465 my ($self) = @_;
1466
1467 $self->hide;
1468
1469 1
1470}
1471
1101sub button_down { 1472sub invoke_button_down {
1102 my ($self, $ev, $x, $y) = @_; 1473 my ($self, $ev, $x, $y) = @_;
1103 1474
1104 my ($w, $h) = @$self{qw(w h)}; 1475 my ($w, $h) = @$self{qw(w h)};
1105 my $border = $self->border; 1476 my $border = $self->border;
1106 1477
… …
1122 my $dy = $ev->{y} - $oy; 1493 my $dy = $ev->{y} - $oy;
1123 1494
1124 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1); 1495 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1125 $self->{force_h} = $bh + $dy * ($my ? -1 : 1); 1496 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1126 1497
1498 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1127 $self->realloc; 1499 $self->realloc;
1128 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1129 }; 1500 };
1130 1501
1131 } elsif ($lr ^ $td) { 1502 } elsif ($lr ^ $td) {
1132 my ($ox, $oy) = ($ev->{x}, $ev->{y}); 1503 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1133 my ($bx, $by) = ($self->{x}, $self->{y}); 1504 my ($bx, $by) = ($self->{x}, $self->{y});
… …
1136 my ($ev, $x, $y) = @_; 1507 my ($ev, $x, $y) = @_;
1137 1508
1138 ($x, $y) = ($ev->{x}, $ev->{y}); 1509 ($x, $y) = ($ev->{x}, $ev->{y});
1139 1510
1140 $self->move_abs ($bx + $x - $ox, $by + $y - $oy); 1511 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1512 # HACK: the next line is required to enforce placement
1513 $self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1141 }; 1514 };
1515 } else {
1516 return 0;
1517 }
1518
1142 } 1519 1
1143} 1520}
1144 1521
1145sub button_up { 1522sub invoke_button_up {
1146 my ($self, $ev, $x, $y) = @_; 1523 my ($self, $ev, $x, $y) = @_;
1147 1524
1148 delete $self->{motion}; 1525 ! ! delete $self->{motion}
1149} 1526}
1150 1527
1151sub mouse_motion { 1528sub invoke_mouse_motion {
1152 my ($self, $ev, $x, $y) = @_; 1529 my ($self, $ev, $x, $y) = @_;
1153 1530
1154 $self->{motion}->($ev, $x, $y) if $self->{motion}; 1531 $self->{motion}->($ev, $x, $y) if $self->{motion};
1532
1533 ! ! $self->{motion}
1534}
1535
1536sub invoke_visibility_change {
1537 my ($self, $visible) = @_;
1538
1539 delete $self->{motion} unless $visible;
1540
1541 0
1155} 1542}
1156 1543
1157sub _draw { 1544sub _draw {
1158 my ($self) = @_; 1545 my ($self) = @_;
1159 1546
1547 my $child = $self->{children}[0];
1548
1160 my ($w, $h ) = ($self->{w}, $self->{h}); 1549 my ($w, $h ) = ($self->{w}, $self->{h});
1161 my ($cw, $ch) = ($self->child->{w}, $self->child->{h}); 1550 my ($cw, $ch) = ($child->{w}, $child->{h});
1162 1551
1163 glEnable GL_TEXTURE_2D; 1552 glEnable GL_TEXTURE_2D;
1164 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE; 1553 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1165 1554
1166 my $border = $self->border; 1555 my $border = $self->border;
1167 1556
1557 if ($border) {
1168 glColor @{ $self->{border_bg} }; 1558 glColor @{ $self->{border_bg} };
1169 $border[0]->draw_quad_alpha (0, 0, $w, $border); 1559 $border[0]->draw_quad_alpha ( 0, 0, $w, $border);
1170 $border[1]->draw_quad_alpha (0, $border, $border, $ch); 1560 $border[1]->draw_quad_alpha ( 0, $border, $border, $ch);
1171 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch); 1561 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1172 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border); 1562 $border[3]->draw_quad_alpha ( 0, $h - $border, $w, $border);
1563
1564 # move
1565 my $w2 = ($w - $border) * .5;
1566 my $h2 = ($h - $border) * .5;
1567 $icon[0]->draw_quad_alpha ( 0, $h2, $border, $border);
1568 $icon[0]->draw_quad_alpha ($w - $border, $h2, $border, $border);
1569 $icon[0]->draw_quad_alpha ($w2 , $h - $border, $border, $border);
1570
1571 # resize
1572 $icon[1]->draw_quad_alpha ( 0, 0, $border, $border);
1573 $icon[1]->draw_quad_alpha ($w - $border, 0, $border, $border)
1574 unless $self->{has_close_button};
1575 $icon[1]->draw_quad_alpha ( 0, $h - $border, $border, $border);
1576 $icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border);
1577 }
1173 1578
1174 if (@{$self->{bg}} < 4 || $self->{bg}[3]) { 1579 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1175 glColor @{ $self->{bg} }; 1580 glColor @{ $self->{bg} };
1176 1581
1177 # TODO: repeat texture not scale 1582 # TODO: repeat texture not scale
… …
1181 $bg->draw_quad_alpha ($border, $border, $cw, $ch); 1586 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1182 } 1587 }
1183 1588
1184 glDisable GL_TEXTURE_2D; 1589 glDisable GL_TEXTURE_2D;
1185 1590
1186 $self->{title}->draw if $self->{title};
1187
1188 $self->child->draw; 1591 $child->draw;
1592
1593 if ($self->{title_widget}) {
1594 glTranslate 0, $border - $self->{h};
1595 $self->{title_widget}->_draw;
1596
1597 glTranslate 0, - ($border - $self->{h});
1598 }
1599
1600 $self->{close_button}->draw
1601 if $self->{close_button};
1189} 1602}
1190 1603
1191############################################################################# 1604#############################################################################
1192 1605
1193package CFClient::UI::Table; 1606package DC::UI::Table;
1194 1607
1195our @ISA = CFClient::UI::Base::; 1608our @ISA = DC::UI::Container::;
1196 1609
1197use List::Util qw(max sum); 1610use List::Util qw(max sum);
1198 1611
1199use CFClient::OpenGL; 1612use DC::OpenGL;
1200 1613
1201sub new { 1614sub new {
1202 my $class = shift; 1615 my $class = shift;
1203 1616
1204 $class->SUPER::new ( 1617 $class->SUPER::new (
1205 col_expand => [], 1618 col_expand => [],
1619 row_expand => [],
1206 @_, 1620 @_,
1207 ) 1621 )
1208} 1622}
1209 1623
1210sub children {
1211 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1212}
1213
1214sub add { 1624sub add {
1215 my ($self, $x, $y, $child) = @_;
1216
1217 $child->set_parent ($self);
1218 $self->{children}[$y][$x] = $child;
1219
1220 $self->realloc;
1221}
1222
1223# TODO: move to container class maybe? send children a signal on removal?
1224sub clear {
1225 my ($self) = @_; 1625 my ($self, @widgets) = @_;
1626
1627 for my $child (@widgets) {
1628 $child->{c_rowspan} ||= 1;
1629 $child->{c_colspan} ||= 1;
1630 }
1631
1632 $self->SUPER::add (@widgets);
1633}
1634
1635sub add_at {
1636 my $self = shift;
1637
1638 my @widgets;
1639
1640 while (@_) {
1641 my ($col, $row, $child) = splice @_, 0, 3, ();
1642
1643 $child->{c_row} = $row;
1644 $child->{c_col} = $col;
1645
1646 push @widgets, $child;
1647 }
1648
1649 $self->add (@widgets);
1650}
1651
1652sub get_wh {
1653 my ($self) = @_;
1654
1655 my (@w, @h);
1226 1656
1227 my @children = $self->children; 1657 my @children = $self->children;
1228 delete $self->{children}; 1658
1659 # first pass, columns
1660 for my $widget (sort { $a->{c_colspan} <=> $b->{c_colspan} } @children) {
1661 my ($c, $w, $cs) = @$widget{qw(c_col req_w c_colspan)};
1662
1663 my $sw = sum @w[$c .. $c + $cs - 1];
1664
1665 if ($w > $sw) {
1666 $_ += ($w - $sw) / ($_ ? $sw / $_ : $cs) for @w[$c .. $c + $cs - 1];
1667 }
1229 1668 }
1230 for (@children) {
1231 delete $_->{parent};
1232 $_->hide;
1233 }
1234 1669
1235 $self->realloc; 1670 # second pass, rows
1236} 1671 for my $widget (sort { $a->{c_rowspan} <=> $b->{c_rowspan} } @children) {
1237
1238sub get_wh {
1239 my ($self) = @_;
1240
1241 my (@w, @h);
1242
1243 for my $y (0 .. $#{$self->{children}}) {
1244 my $row = $self->{children}[$y]
1245 or next;
1246
1247 for my $x (0 .. $#$row) {
1248 my $widget = $row->[$x]
1249 or next;
1250 my ($w, $h) = @$widget{qw(req_w req_h)}; 1672 my ($r, $h, $rs) = @$widget{qw(c_row req_h c_rowspan)};
1251 1673
1252 $w[$x] = max $w[$x], $w; 1674 my $sh = sum @h[$r .. $r + $rs - 1];
1253 $h[$y] = max $h[$y], $h; 1675
1676 if ($h > $sh) {
1677 $_ += ($h - $sh) / ($_ ? $sh / $_ : $rs) for @h[$r .. $r + $rs - 1];
1254 } 1678 }
1255 } 1679 }
1256 1680
1257 (\@w, \@h) 1681 (\@w, \@h)
1258} 1682}
… …
1266 (sum @$ws), 1690 (sum @$ws),
1267 (sum @$hs), 1691 (sum @$hs),
1268 ) 1692 )
1269} 1693}
1270 1694
1271sub size_allocate { 1695sub invoke_size_allocate {
1272 my ($self, $w, $h) = @_; 1696 my ($self, $w, $h) = @_;
1273 1697
1274 my ($ws, $hs) = $self->get_wh; 1698 my ($ws, $hs) = $self->get_wh;
1275 1699
1276 my $req_w = (sum @$ws) || 1; 1700 my $req_w = (sum @$ws) || 1;
1277 my $req_h = (sum @$hs) || 1; 1701 my $req_h = (sum @$hs) || 1;
1278 1702
1279 # TODO: nicer code && do row_expand 1703 # now linearly scale the rows/columns to the allocated size
1280 my @col_expand = @{$self->{col_expand}}; 1704 my @col_expand = @{$self->{col_expand}};
1281 @col_expand = (1) x @$ws unless @col_expand; 1705 @col_expand = (1) x @$ws unless @col_expand;
1282 my $col_expand = (sum @col_expand) || 1; 1706 my $col_expand = (sum @col_expand) || 1;
1283 1707
1284 # linearly scale sizes
1285 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws; 1708 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1286 $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1287 1709
1288 CFClient::UI::harmonize $ws; 1710 DC::UI::harmonize $ws;
1711
1712 my @row_expand = @{$self->{row_expand}};
1713 @row_expand = (1) x @$ws unless @row_expand;
1714 my $row_expand = (sum @row_expand) || 1;
1715
1716 $hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs;
1717
1289 CFClient::UI::harmonize $hs; 1718 DC::UI::harmonize $hs;
1290 1719
1291 my $y; 1720 my @x; for (0 .. $#$ws) { $x[$_ + 1] = $x[$_] + $ws->[$_] }
1721 my @y; for (0 .. $#$hs) { $y[$_ + 1] = $y[$_] + $hs->[$_] }
1292 1722
1293 for my $r (0 .. $#{$self->{children}}) { 1723 for my $widget ($self->children) {
1294 my $row = $self->{children}[$r] 1724 my ($r, $c, $w, $h, $rs, $cs) = @$widget{qw(c_row c_col req_w req_h c_rowspan c_colspan)};
1295 or next;
1296 1725
1297 my $x = 0; 1726 $widget->configure (
1298 my $row_h = $hs->[$r]; 1727 $x[$c], $y[$r],
1728 $x[$c + $cs] - $x[$c], $y[$r + $rs] - $y[$r],
1299 1729 );
1300 for my $c (0 .. $#$row) { 1730 }
1301 my $col_w = $ws->[$c];
1302 1731
1303 if (my $widget = $row->[$c]) { 1732 1
1304 $widget->configure ($x, $y, $col_w, $row_h); 1733}
1305 }
1306 1734
1307 $x += $col_w; 1735#############################################################################
1736
1737package DC::UI::Fixed;
1738
1739use List::Util qw(min max);
1740
1741our @ISA = DC::UI::Container::;
1742
1743sub _scale($$$) {
1744 my ($rel, $val, $max) = @_;
1745
1746 $rel ? $val * $max : $val
1747}
1748
1749sub size_request {
1750 my ($self) = @_;
1751
1752 my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0);
1753
1754 # determine overall size by querying abs widgets
1755 for my $child ($self->visible_children) {
1756 unless ($child->{c_rel}) {
1757 my $x = $child->{c_x};
1758 my $y = $child->{c_y};
1759
1760 $x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
1761 $y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
1308 } 1762 }
1309
1310 $y += $row_h;
1311 } 1763 }
1312 1764
1313} 1765 my $W = $x2 - $x1;
1766 my $H = $y2 - $y1;
1314 1767
1315sub find_widget { 1768 # now layout remaining widgets
1769 for my $child ($self->visible_children) {
1770 if ($child->{c_rel}) {
1771 my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
1772 my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
1773
1774 $x1 = min $x1, $x; $x2 = max $x2, $x + $child->{req_w};
1775 $y1 = min $y1, $y; $y2 = max $y2, $y + $child->{req_h};
1776 }
1777 }
1778
1779 my $W = $x2 - $x1;
1780 my $H = $y2 - $y1;
1781
1782 ($W, $H)
1783}
1784
1785sub invoke_size_allocate {
1316 my ($self, $x, $y) = @_; 1786 my ($self, $W, $H) = @_;
1317 1787
1318 $x -= $self->{x}; 1788 for my $child ($self->visible_children) {
1319 $y -= $self->{y}; 1789 my $x = _scale $child->{c_rel}, $child->{c_x}, $W;
1790 my $y = _scale $child->{c_rel}, $child->{c_y}, $H;
1320 1791
1321 my $res; 1792 $x += $child->{c_halign} * $child->{req_w};
1793 $y += $child->{c_valign} * $child->{req_h};
1322 1794
1323 for (grep $_, map @$_, grep $_, @{ $self->{children} }) { 1795 $child->configure (int $x, int $y, $child->{req_w}, $child->{req_h});
1324 $res = $_->find_widget ($x, $y) 1796 }
1325 and return $res; 1797
1326 } 1798 1
1327
1328 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
1329}
1330
1331sub _draw {
1332 my ($self) = @_;
1333
1334 for (grep $_, @{$self->{children}}) {
1335 $_->draw for grep $_, @$_;
1336 }
1337} 1799}
1338 1800
1339############################################################################# 1801#############################################################################
1340 1802
1341package CFClient::UI::Box; 1803package DC::UI::Box;
1342 1804
1343our @ISA = CFClient::UI::Container::; 1805our @ISA = DC::UI::Container::;
1344 1806
1345sub size_request { 1807sub size_request {
1346 my ($self) = @_; 1808 my ($self) = @_;
1809
1810 my @children = $self->visible_children;
1347 1811
1348 $self->{vertical} 1812 $self->{vertical}
1349 ? ( 1813 ? (
1350 (List::Util::max map $_->{req_w}, @{$self->{children}}), 1814 (List::Util::max map $_->{req_w}, @children),
1351 (List::Util::sum map $_->{req_h}, @{$self->{children}}), 1815 (List::Util::sum map $_->{req_h}, @children),
1352 ) 1816 )
1353 : ( 1817 : (
1354 (List::Util::sum map $_->{req_w}, @{$self->{children}}), 1818 (List::Util::sum map $_->{req_w}, @children),
1355 (List::Util::max map $_->{req_h}, @{$self->{children}}), 1819 (List::Util::max map $_->{req_h}, @children),
1356 ) 1820 )
1357} 1821}
1358 1822
1359sub size_allocate { 1823sub invoke_size_allocate {
1360 my ($self, $w, $h) = @_; 1824 my ($self, $w, $h) = @_;
1361 1825
1362 my $space = $self->{vertical} ? $h : $w; 1826 my $space = $self->{vertical} ? $h : $w;
1363 my $children = $self->{children}; 1827 my @children = $self->visible_children;
1364 1828
1365 my @req; 1829 my @req;
1366 1830
1367 if ($self->{homogeneous}) { 1831 if ($self->{homogeneous}) {
1368 @req = ($space / (@$children || 1)) x @$children; 1832 @req = ($space / (@children || 1)) x @children;
1369 } else { 1833 } else {
1370 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children; 1834 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1371 my $req = List::Util::sum @req; 1835 my $req = List::Util::sum @req;
1372 1836
1373 if ($req > $space) { 1837 if ($req > $space) {
1374 # ah well, not enough space 1838 # ah well, not enough space
1375 $_ *= $space / $req for @req; 1839 $_ *= $space / $req for @req;
1376 } else { 1840 } else {
1377 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1; 1841 my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1378 1842
1379 $space = ($space - $req) / $expand; # remaining space to give away 1843 $space = ($space - $req) / $expand; # remaining space to give away
1380 1844
1381 $req[$_] += $space * $children->[$_]{expand} 1845 $req[$_] += $space * $children[$_]{expand}
1382 for 0 .. $#$children; 1846 for 0 .. $#children;
1383 } 1847 }
1384 } 1848 }
1385 1849
1386 CFClient::UI::harmonize \@req; 1850 DC::UI::harmonize \@req;
1387 1851
1388 my $pos = 0; 1852 my $pos = 0;
1389 for (0 .. $#$children) { 1853 for (0 .. $#children) {
1390 my $alloc = $req[$_]; 1854 my $alloc = $req[$_];
1391 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h)); 1855 $children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1392 1856
1393 $pos += $alloc; 1857 $pos += $alloc;
1394 } 1858 }
1395 1859
1396 1 1860 1
1397} 1861}
1398 1862
1399############################################################################# 1863#############################################################################
1400 1864
1401package CFClient::UI::HBox; 1865package DC::UI::HBox;
1402 1866
1403our @ISA = CFClient::UI::Box::; 1867our @ISA = DC::UI::Box::;
1404 1868
1405sub new { 1869sub new {
1406 my $class = shift; 1870 my $class = shift;
1407 1871
1408 $class->SUPER::new ( 1872 $class->SUPER::new (
… …
1411 ) 1875 )
1412} 1876}
1413 1877
1414############################################################################# 1878#############################################################################
1415 1879
1416package CFClient::UI::VBox; 1880package DC::UI::VBox;
1417 1881
1418our @ISA = CFClient::UI::Box::; 1882our @ISA = DC::UI::Box::;
1419 1883
1420sub new { 1884sub new {
1421 my $class = shift; 1885 my $class = shift;
1422 1886
1423 $class->SUPER::new ( 1887 $class->SUPER::new (
… …
1426 ) 1890 )
1427} 1891}
1428 1892
1429############################################################################# 1893#############################################################################
1430 1894
1431package CFClient::UI::Label; 1895package DC::UI::Label;
1432 1896
1433our @ISA = CFClient::UI::DrawBG::; 1897our @ISA = DC::UI::DrawBG::;
1434 1898
1435use CFClient::OpenGL; 1899use DC::OpenGL;
1436 1900
1437sub new { 1901sub new {
1438 my ($class, %arg) = @_; 1902 my ($class, %arg) = @_;
1439 1903
1440 my $self = $class->SUPER::new ( 1904 my $self = $class->SUPER::new (
… …
1443 #active_bg => none 1907 #active_bg => none
1444 #font => default_font 1908 #font => default_font
1445 #text => initial text 1909 #text => initial text
1446 #markup => initial narkup 1910 #markup => initial narkup
1447 #max_w => maximum pixel width 1911 #max_w => maximum pixel width
1912 #style => 0, # render flags
1448 ellipsise => 3, # end 1913 ellipsise => 3, # end
1449 layout => (new CFClient::Layout), 1914 layout => (new DC::Layout),
1450 fontsize => 1, 1915 fontsize => 1,
1451 align => -1, 1916 align => 0.5,
1452 valign => -1, 1917 valign => 0.5,
1453 padding_x => 2, 1918 padding_x => 4,
1454 padding_y => 2, 1919 padding_y => 2,
1455 can_events => 0, 1920 can_events => 0,
1456 %arg 1921 %arg
1457 ); 1922 );
1458 1923
1459 if (exists $self->{template}) { 1924 if (exists $self->{template}) {
1460 my $layout = new CFClient::Layout; 1925 my $layout = new DC::Layout;
1461 $layout->set_text (delete $self->{template}); 1926 $layout->set_text (delete $self->{template});
1462 $self->{template} = $layout; 1927 $self->{template} = $layout;
1463 } 1928 }
1464 1929
1465 if (exists $self->{markup}) { 1930 if (exists $self->{markup}) {
… …
1469 } 1934 }
1470 1935
1471 $self 1936 $self
1472} 1937}
1473 1938
1474sub escape($) {
1475 local $_ = $_[0];
1476
1477 s/&/&amp;/g;
1478 s/>/&gt;/g;
1479 s/</&lt;/g;
1480
1481 $_
1482}
1483
1484sub update { 1939sub update {
1485 my ($self) = @_; 1940 my ($self) = @_;
1486 1941
1487 delete $self->{texture}; 1942 delete $self->{texture};
1488 $self->SUPER::update; 1943 $self->SUPER::update;
1489} 1944}
1490 1945
1946sub realloc {
1947 my ($self) = @_;
1948
1949 delete $self->{ox};
1950 $self->SUPER::realloc;
1951}
1952
1953sub clear {
1954 my ($self) = @_;
1955
1956 $self->set_text ("");
1957}
1958
1491sub set_text { 1959sub set_text {
1492 my ($self, $text) = @_; 1960 my ($self, $text) = @_;
1493 1961
1494 return if $self->{text} eq "T$text"; 1962 return if $self->{text} eq "T$text";
1495 $self->{text} = "T$text"; 1963 $self->{text} = "T$text";
1496 1964
1497 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1498 $self->{layout}->set_text ($text); 1965 $self->{layout}->set_text ($text);
1499 1966
1967 delete $self->{size_req};
1500 $self->realloc; 1968 $self->realloc;
1501 $self->update; 1969 $self->update;
1502} 1970}
1503 1971
1504sub set_markup { 1972sub set_markup {
… …
1507 return if $self->{text} eq "M$markup"; 1975 return if $self->{text} eq "M$markup";
1508 $self->{text} = "M$markup"; 1976 $self->{text} = "M$markup";
1509 1977
1510 my $rgba = $markup =~ /span.*(?:foreground|background)/; 1978 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1511 1979
1512 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1513 $self->{layout}->set_markup ($markup); 1980 $self->{layout}->set_markup ($markup);
1514 1981
1982 delete $self->{size_req};
1515 $self->realloc; 1983 $self->realloc;
1516 $self->update; 1984 $self->update;
1517} 1985}
1518 1986
1519sub size_request { 1987sub size_request {
1520 my ($self) = @_; 1988 my ($self) = @_;
1521 1989
1990 $self->{size_req} ||= do {
1991 my ($max_w, $max_h) = $self->get_max_wh;
1992
1522 $self->{layout}->set_font ($self->{font}) if $self->{font}; 1993 $self->{layout}->set_font ($self->{font}) if $self->{font};
1523 $self->{layout}->set_width ($self->{max_w} || -1); 1994 $self->{layout}->set_width ($max_w);
1524 $self->{layout}->set_ellipsise ($self->{ellipsise}); 1995 $self->{layout}->set_ellipsise ($self->{ellipsise});
1525 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 1996 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1526 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 1997 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1527 1998
1528 my ($w, $h) = $self->{layout}->size; 1999 my ($w, $h) = $self->{layout}->size;
1529 2000
1530 if (exists $self->{template}) { 2001 if (exists $self->{template}) {
1531 $self->{template}->set_font ($self->{font}) if $self->{font}; 2002 $self->{template}->set_font ($self->{font}) if $self->{font};
2003 $self->{template}->set_width ($max_w);
1532 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE); 2004 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1533 2005
1534 my ($w2, $h2) = $self->{template}->size; 2006 my ($w2, $h2) = $self->{template}->size;
1535 2007
1536 $w = List::Util::max $w, $w2; 2008 $w = List::Util::max $w, $w2;
1537 $h = List::Util::max $h, $h2; 2009 $h = List::Util::max $h, $h2;
2010 }
2011
2012 [$w, $h]
1538 } 2013 };
1539 2014
1540 ($w, $h) 2015 @{ $self->{size_req} }
1541} 2016}
1542 2017
2018sub baseline_shift {
2019 $_[0]{layout}->descent
2020}
2021
1543sub size_allocate { 2022sub invoke_size_allocate {
1544 my ($self, $w, $h) = @_; 2023 my ($self, $w, $h) = @_;
2024
2025 delete $self->{ox};
1545 2026
1546 delete $self->{texture} 2027 delete $self->{texture}
1547 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w}; 2028 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
2029
2030 1
1548} 2031}
1549 2032
1550sub set_fontsize { 2033sub set_fontsize {
1551 my ($self, $fontsize) = @_; 2034 my ($self, $fontsize) = @_;
1552 2035
1553 $self->{fontsize} = $fontsize; 2036 $self->{fontsize} = $fontsize;
2037 delete $self->{size_req};
1554 delete $self->{texture}; 2038 delete $self->{texture};
1555 2039
1556 $self->realloc; 2040 $self->realloc;
1557} 2041}
1558 2042
2043sub reconfigure {
2044 my ($self) = @_;
2045
2046 delete $self->{size_req};
2047 delete $self->{texture};
2048
2049 $self->SUPER::reconfigure;
2050}
2051
1559sub _draw { 2052sub _draw {
1560 my ($self) = @_; 2053 my ($self) = @_;
1561 2054
1562 $self->SUPER::_draw; # draw background, if applicable 2055 $self->SUPER::_draw; # draw background, if applicable
1563 2056
1564 my $tex = $self->{texture} ||= do { 2057 my $size = $self->{texture} ||= do {
1565 $self->{layout}->set_foreground (@{$self->{fg}}); 2058 $self->{layout}->set_foreground (@{$self->{fg}});
1566 $self->{layout}->set_font ($self->{font}) if $self->{font}; 2059 $self->{layout}->set_font ($self->{font}) if $self->{font};
1567 $self->{layout}->set_width ($self->{w}); 2060 $self->{layout}->set_width ($self->{w});
1568 $self->{layout}->set_ellipsise ($self->{ellipsise}); 2061 $self->{layout}->set_ellipsise ($self->{ellipsise});
1569 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise}); 2062 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1570 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 2063 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1571 2064
1572 my $tex = new_from_layout CFClient::Texture $self->{layout}; 2065 [$self->{layout}->size]
1573
1574 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1575 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1576 : ($self->{w} - $tex->{w}) * 0.5);
1577
1578 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1579 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1580 : ($self->{h} - $tex->{h}) * 0.5);
1581
1582 $tex
1583 }; 2066 };
1584 2067
1585 glEnable GL_TEXTURE_2D; 2068 unless (exists $self->{ox}) {
1586 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2069 $self->{ox} = $self->{padding_x} + int $self->{align} * ($self->{w} - $size->[0] - $self->{padding_x} * 2);
2070 $self->{oy} = $self->{padding_y} + int $self->{valign} * ($self->{h} - $size->[1] - $self->{padding_y} * 2);
1587 2071
1588 if ($tex->{format} == GL_ALPHA) { 2072 $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1589 glColor @{$self->{fg}};
1590 $tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1591 } else {
1592 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1593 } 2073 };
1594 2074
1595 glDisable GL_TEXTURE_2D; 2075# unless ($self->{list}) {
2076# $self->{list} = DC::OpenGL::glGenList;
2077# DC::OpenGL::glNewList $self->{list};
2078# $self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
2079# DC::OpenGL::glEndList;
2080# }
2081#
2082# DC::OpenGL::glCallList $self->{list};
2083
2084 $self->{layout}->draw;
1596} 2085}
2086
2087#sub destroy {
2088# my ($self) = @_;
2089#
2090# DC::OpenGL::glDeleteList delete $self->{list} if $self->{list};
2091#
2092# $self->SUPER::destroy;
2093#}
1597 2094
1598############################################################################# 2095#############################################################################
1599 2096
1600package CFClient::UI::EntryBase; 2097package DC::UI::EntryBase;
1601 2098
1602our @ISA = CFClient::UI::Label::; 2099our @ISA = DC::UI::Label::;
1603 2100
1604use CFClient::OpenGL; 2101use DC::OpenGL;
1605 2102
1606sub new { 2103sub new {
1607 my $class = shift; 2104 my $class = shift;
1608 2105
1609 $class->SUPER::new ( 2106 $class->SUPER::new (
1610 fg => [1, 1, 1], 2107 fg => [1, 1, 1],
1611 bg => [0, 0, 0, 0.2], 2108 bg => [0, 0, 0, 0.2],
2109 outline => undef,
1612 active_bg => [1, 1, 1, 0.5], 2110 active_bg => [0, 0, 1, .2],
1613 active_fg => [0, 0, 0], 2111 active_fg => [1, 1, 1],
2112 active_outline => [1, 1, 0],
1614 can_hover => 1, 2113 can_hover => 1,
1615 can_focus => 1, 2114 can_focus => 1,
2115 align => 0,
1616 valign => 0, 2116 valign => 0.5,
1617 can_events => 1, 2117 can_events => 1,
2118 ellipsise => 0,
2119 padding_x => 4,
2120 padding_y => 2,
1618 #text => ... 2121 #text => ...
2122 #hidden => "*",
1619 @_ 2123 @_
1620 ) 2124 )
1621} 2125}
1622 2126
1623sub _set_text { 2127sub _set_text {
… …
1625 2129
1626 delete $self->{cur_h}; 2130 delete $self->{cur_h};
1627 2131
1628 return if $self->{text} eq $text; 2132 return if $self->{text} eq $text;
1629 2133
1630 delete $self->{texture};
1631
1632 $self->{last_activity} = $::NOW; 2134 $self->{last_activity} = $::NOW;
1633 $self->{text} = $text; 2135 $self->{text} = $text;
1634 2136
1635 $text =~ s/./*/g if $self->{hidden}; 2137 $text =~ s/./*/g if $self->{hidden};
1636 $self->{layout}->set_text ("$text "); 2138 $self->{layout}->set_text ("$text ");
2139 delete $self->{size_req};
1637 2140
1638 $self->_emit (changed => $self->{text}); 2141 $self->emit (changed => $self->{text});
2142
2143 $self->realloc;
2144 $self->update;
1639} 2145}
1640 2146
1641sub set_text { 2147sub set_text {
1642 my ($self, $text) = @_; 2148 my ($self, $text) = @_;
1643 2149
1644 $self->{cursor} = length $text; 2150 $self->{cursor} = length $text;
1645 $self->_set_text ($text); 2151 $self->_set_text ($text);
1646
1647 $self->realloc;
1648} 2152}
1649 2153
1650sub get_text { 2154sub get_text {
1651 $_[0]{text} 2155 $_[0]{text}
1652} 2156}
… …
1657 my ($w, $h) = $self->SUPER::size_request; 2161 my ($w, $h) = $self->SUPER::size_request;
1658 2162
1659 ($w + 1, $h) # add 1 for cursor 2163 ($w + 1, $h) # add 1 for cursor
1660} 2164}
1661 2165
1662sub key_down { 2166sub invoke_key_down {
1663 my ($self, $ev) = @_; 2167 my ($self, $ev) = @_;
1664 2168
1665 my $mod = $ev->{mod}; 2169 my $mod = $ev->{mod};
1666 my $sym = $ev->{sym}; 2170 my $sym = $ev->{sym};
1667 my $uni = $ev->{unicode}; 2171 my $uni = $ev->{unicode};
1668 2172
1669 my $text = $self->get_text; 2173 my $text = $self->get_text;
1670 2174
1671 if ($uni == 8) { 2175 $self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;
2176
2177 if ($sym == DC::SDLK_BACKSPACE) {
1672 substr $text, --$self->{cursor}, 1, "" if $self->{cursor}; 2178 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1673 } elsif ($uni == 127) { 2179 } elsif ($sym == DC::SDLK_DELETE) {
1674 substr $text, $self->{cursor}, 1, ""; 2180 substr $text, $self->{cursor}, 1, "";
1675 } elsif ($sym == CFClient::SDLK_LEFT) { 2181 } elsif ($sym == DC::SDLK_LEFT) {
1676 --$self->{cursor} if $self->{cursor}; 2182 --$self->{cursor} if $self->{cursor};
1677 } elsif ($sym == CFClient::SDLK_RIGHT) { 2183 } elsif ($sym == DC::SDLK_RIGHT) {
1678 ++$self->{cursor} if $self->{cursor} < length $self->{text}; 2184 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1679 } elsif ($sym == CFClient::SDLK_HOME) { 2185 } elsif ($sym == DC::SDLK_HOME) {
2186 # what a hack
2187 $self->{cursor} =
2188 (substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
2189 ? length $1
2190 : 0;
2191 } elsif ($sym == DC::SDLK_END) {
2192 # uh, again
2193 $self->{cursor} =
2194 (substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
2195 ? $self->{cursor} + length $1
2196 : length $self->{text};
2197 } elsif ($uni == 21) { # ctrl-u
2198 $text = "";
1680 $self->{cursor} = 0; 2199 $self->{cursor} = 0;
1681 } elsif ($sym == CFClient::SDLK_END) {
1682 $self->{cursor} = length $text;
1683 } elsif ($uni == 27) { 2200 } elsif ($uni == 27) {
1684 $self->_emit ('escape'); 2201 $self->emit ('escape');
1685 } elsif ($uni) { 2202 } elsif ($uni == 0x0d) {
2203 substr $text, $self->{cursor}++, 0, "\012";
2204 } elsif ($uni >= 0x20) {
1686 substr $text, $self->{cursor}++, 0, chr $uni; 2205 substr $text, $self->{cursor}++, 0, chr $uni;
2206 } else {
2207 return 0;
1687 } 2208 }
1688 2209
1689 $self->_set_text ($text); 2210 $self->_set_text ($text);
1690 2211
1691 $self->realloc; 2212 $self->realloc;
1692} 2213 $self->update;
1693 2214
2215 1
2216}
2217
1694sub focus_in { 2218sub invoke_focus_in {
1695 my ($self) = @_; 2219 my ($self) = @_;
1696 2220
1697 $self->{last_activity} = $::NOW; 2221 $self->{last_activity} = $::NOW;
1698 2222
1699 $self->SUPER::focus_in; 2223 $self->SUPER::invoke_focus_in
1700} 2224}
1701 2225
1702sub button_down { 2226sub invoke_button_down {
1703 my ($self, $ev, $x, $y) = @_; 2227 my ($self, $ev, $x, $y) = @_;
1704 2228
1705 $self->SUPER::button_down ($ev, $x, $y); 2229 $self->SUPER::invoke_button_down ($ev, $x, $y);
1706 2230
1707 my $idx = $self->{layout}->xy_to_index ($x, $y); 2231 my $idx = $self->{layout}->xy_to_index ($x, $y);
1708 2232
1709 # byte-index to char-index 2233 # byte-index to char-index
1710 my $text = $self->{text}; 2234 my $text = $self->{text};
1711 utf8::encode $text; 2235 utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1712 $self->{cursor} = length substr $text, 0, $idx; 2236 $self->{cursor} = length $text;
1713 2237
1714 $self->_set_text ($self->{text}); 2238 $self->_set_text ($self->{text});
1715 $self->update; 2239 $self->update;
2240
2241 1
1716} 2242}
1717 2243
1718sub mouse_motion { 2244sub invoke_mouse_motion {
1719 my ($self, $ev, $x, $y) = @_; 2245 my ($self, $ev, $x, $y) = @_;
1720# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d# 2246# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
2247
2248 1
1721} 2249}
1722 2250
1723sub _draw { 2251sub _draw {
1724 my ($self) = @_; 2252 my ($self) = @_;
1725 2253
1726 local $self->{fg} = $self->{fg}; 2254 local $self->{fg} = $self->{fg};
1727 2255
1728 if ($FOCUS == $self) { 2256 if ($FOCUS == $self) {
1729 glColor @{$self->{active_bg}}; 2257 glColor_premultiply @{$self->{active_bg}};
1730 $self->{fg} = $self->{active_fg}; 2258 $self->{fg} = $self->{active_fg};
1731 } else { 2259 } else {
1732 glColor @{$self->{bg}}; 2260 glColor_premultiply @{$self->{bg}};
1733 } 2261 }
1734 2262
1735 glEnable GL_BLEND; 2263 glEnable GL_BLEND;
1736 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 2264 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1737 glBegin GL_QUADS;
1738 glVertex 0 , 0;
1739 glVertex 0 , $self->{h};
1740 glVertex $self->{w}, $self->{h}; 2265 glRect 0, 0, $self->{w}, $self->{h};
1741 glVertex $self->{w}, 0;
1742 glEnd;
1743 glDisable GL_BLEND; 2266 glDisable GL_BLEND;
1744 2267
1745 $self->SUPER::_draw; 2268 $self->SUPER::_draw;
1746 2269
1747 #TODO: force update every cursor change :( 2270 #TODO: force update every cursor change :(
… …
1749 2272
1750 unless (exists $self->{cur_h}) { 2273 unless (exists $self->{cur_h}) {
1751 my $text = substr $self->{text}, 0, $self->{cursor}; 2274 my $text = substr $self->{text}, 0, $self->{cursor};
1752 utf8::encode $text; 2275 utf8::encode $text;
1753 2276
1754 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text) 2277 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text);
1755 } 2278 }
1756 2279
1757 glColor @{$self->{fg}}; 2280 glColor_premultiply @{$self->{active_fg}};
1758 glBegin GL_LINES; 2281 glBegin GL_LINES;
1759 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy}; 2282 glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy};
1760 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h}; 2283 glVertex $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1761 glEnd; 2284 glEnd;
1762 }
1763}
1764 2285
2286 glLineWidth 3;
2287 glColor @{$self->{active_outline}};
2288 glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
2289 glLineWidth 1;
2290
2291 } else {
2292 glColor @{$self->{outline} || $DC::THEME{entry_outline}};
2293 glBegin GL_LINE_STRIP;
2294 glVertex .5, $self->{h} * .5;
2295 glVertex .5, $self->{h} - 2.5;
2296 glVertex $self->{w} - .5, $self->{h} - 2.5;
2297 glVertex $self->{w} - .5, $self->{h} * .5;
2298 glEnd;
2299 }
2300}
2301
2302#############################################################################
2303
1765package CFClient::UI::Entry; 2304package DC::UI::Entry;
1766 2305
1767our @ISA = CFClient::UI::EntryBase::; 2306our @ISA = DC::UI::EntryBase::;
1768 2307
1769use CFClient::OpenGL; 2308use DC::OpenGL;
1770 2309
2310sub new {
2311 my $class = shift;
2312
2313 $class->SUPER::new (
2314 history_pointer => -1,
2315 @_
2316 )
2317}
2318
2319
1771sub key_down { 2320sub invoke_key_down {
1772 my ($self, $ev) = @_; 2321 my ($self, $ev) = @_;
1773 2322
1774 my $sym = $ev->{sym}; 2323 my $sym = $ev->{sym};
1775 2324
1776 if ($sym == 13) { 2325 if ($ev->{uni} == 0x0d || $sym == 13) {
1777 unshift @{$self->{history}}, 2326 unshift @{$self->{history}},
1778 my $txt = $self->get_text; 2327 my $txt = $self->get_text;
2328
1779 $self->{history_pointer} = -1; 2329 $self->{history_pointer} = -1;
1780 $self->{history_saveback} = ''; 2330 $self->{history_saveback} = '';
1781 $self->_emit (activate => $txt); 2331 $self->emit (activate => $txt);
1782 $self->update; 2332 $self->update;
1783 2333
1784 } elsif ($sym == CFClient::SDLK_UP) { 2334 } elsif ($sym == DC::SDLK_UP) {
1785 if ($self->{history_pointer} < 0) { 2335 if ($self->{history_pointer} < 0) {
1786 $self->{history_saveback} = $self->get_text; 2336 $self->{history_saveback} = $self->get_text;
1787 } 2337 }
1788 if (@{$self->{history} || []} > 0) { 2338 if (@{$self->{history} || []} > 0) {
1789 $self->{history_pointer}++; 2339 $self->{history_pointer}++;
… …
1791 $self->{history_pointer} = @{$self->{history} || []} - 1; 2341 $self->{history_pointer} = @{$self->{history} || []} - 1;
1792 } 2342 }
1793 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2343 $self->set_text ($self->{history}->[$self->{history_pointer}]);
1794 } 2344 }
1795 2345
1796 } elsif ($sym == CFClient::SDLK_DOWN) { 2346 } elsif ($sym == DC::SDLK_DOWN) {
1797 $self->{history_pointer}--; 2347 $self->{history_pointer}--;
1798 $self->{history_pointer} = -1 if $self->{history_pointer} < 0; 2348 $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1799 2349
1800 if ($self->{history_pointer} >= 0) { 2350 if ($self->{history_pointer} >= 0) {
1801 $self->set_text ($self->{history}->[$self->{history_pointer}]); 2351 $self->set_text ($self->{history}->[$self->{history_pointer}]);
1802 } else { 2352 } else {
2353 if (defined $self->{history_saveback}) {
1803 $self->set_text ($self->{history_saveback}); 2354 $self->set_text ($self->{history_saveback});
2355 $self->{history_saveback} = undef;
2356 }
1804 } 2357 }
1805 2358
1806 } else { 2359 } else {
1807 $self->SUPER::key_down ($ev); 2360 return $self->SUPER::invoke_key_down ($ev)
2361 }
2362
1808 } 2363 1
1809
1810} 2364}
1811 2365
1812############################################################################# 2366#############################################################################
1813 2367
1814package CFClient::UI::Button; 2368package DC::UI::TextEdit;
1815 2369
1816our @ISA = CFClient::UI::Label::; 2370our @ISA = DC::UI::EntryBase::;
1817 2371
1818use CFClient::OpenGL; 2372use DC::OpenGL;
1819
1820my @tex =
1821 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1822 qw(b1_button_active.png);
1823 2373
1824sub new { 2374sub new {
1825 my $class = shift; 2375 my $class = shift;
1826 2376
1827 $class->SUPER::new ( 2377 $class->SUPER::new (
1828 padding_x => 4,
1829 padding_y => 4, 2378 padding_y => 4,
1830 fg => [1, 1, 1], 2379
1831 active_fg => [0, 0, 1], 2380 @_
2381 )
2382}
2383
2384sub move_cursor_ver {
2385 my ($self, $dy) = @_;
2386
2387 my ($line, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
2388
2389 $line += $dy;
2390
2391 if (defined (my $index = $self->{layout}->line_x_to_index ($line, $x))) {
2392 $self->{cursor} = $index;
2393 delete $self->{cur_h};
2394 $self->update;
2395 return;
2396 }
2397}
2398
2399sub invoke_key_down {
2400 my ($self, $ev) = @_;
2401
2402 my $sym = $ev->{sym};
2403
2404 if ($sym == DC::SDLK_UP) {
2405 $self->move_cursor_ver (-1);
2406 } elsif ($sym == DC::SDLK_DOWN) {
2407 $self->move_cursor_ver (+1);
2408 } else {
2409 return $self->SUPER::invoke_key_down ($ev)
2410 }
2411
2412 1
2413}
2414
2415#############################################################################
2416
2417package DC::UI::ButtonBin;
2418
2419our @ISA = DC::UI::Bin::;
2420
2421use DC::OpenGL;
2422
2423my @tex =
2424 map { new_from_resource DC::Texture $_, mipmap => 1 }
2425 qw(b1_button_inactive.png b1_button_active.png);
2426
2427sub new {
2428 my $class = shift;
2429
2430 $class->SUPER::new (
1832 can_hover => 1, 2431 can_hover => 1,
1833 align => 0, 2432 align => 0.5,
1834 valign => 0, 2433 valign => 0.5,
1835 can_events => 1, 2434 can_events => 1,
1836 @_ 2435 @_
1837 ) 2436 )
1838} 2437}
1839 2438
1840sub activate { }
1841
1842sub button_up { 2439sub invoke_button_up {
1843 my ($self, $ev, $x, $y) = @_; 2440 my ($self, $ev, $x, $y) = @_;
1844 2441
1845 $self->emit ("activate") 2442 $self->emit ("activate")
1846 if $x >= 0 && $x < $self->{w} 2443 if $x >= 0 && $x < $self->{w}
1847 && $y >= 0 && $y < $self->{h}; 2444 && $y >= 0 && $y < $self->{h};
2445
2446 1
1848} 2447}
1849 2448
1850sub _draw { 2449sub _draw {
1851 my ($self) = @_; 2450 my ($self) = @_;
1852
1853 local $self->{fg} = $self->{fg};
1854
1855 if ($GRAB == $self) {
1856 $self->{fg} = $self->{active_fg};
1857 }
1858 2451
1859 glEnable GL_TEXTURE_2D; 2452 glEnable GL_TEXTURE_2D;
1860 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2453 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1861 glColor 0, 0, 0, 1; 2454 glColor 0, 0, 0, 1;
1862 2455
2456 my $tex = $tex[$GRAB == $self];
1863 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 2457 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1864 2458
1865 glDisable GL_TEXTURE_2D; 2459 glDisable GL_TEXTURE_2D;
1866 2460
1867 $self->SUPER::_draw; 2461 $self->SUPER::_draw;
1868} 2462}
1869 2463
1870############################################################################# 2464#############################################################################
1871 2465
1872package CFClient::UI::CheckBox; 2466package DC::UI::Button;
1873 2467
1874our @ISA = CFClient::UI::DrawBG::; 2468our @ISA = DC::UI::Label::;
2469
2470use DC::OpenGL;
1875 2471
1876my @tex = 2472my @tex =
1877 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2473 map { new_from_resource DC::Texture $_, mipmap => 1 }
1878 qw(c1_checkbox_bg.png c1_checkbox_active.png); 2474 qw(b1_button_inactive.png b1_button_active.png);
1879
1880use CFClient::OpenGL;
1881 2475
1882sub new { 2476sub new {
1883 my $class = shift; 2477 my $class = shift;
1884 2478
1885 $class->SUPER::new ( 2479 $class->SUPER::new (
2480 padding_x => 8,
2481 padding_y => 4,
2482 fg => [1.0, 1.0, 1.0],
2483 active_fg => [0.8, 0.8, 0.8],
2484 can_hover => 1,
2485 align => 0.5,
2486 valign => 0.5,
2487 can_events => 1,
2488 @_
2489 )
2490}
2491
2492sub invoke_button_up {
2493 my ($self, $ev, $x, $y) = @_;
2494
2495 $self->emit ("activate")
2496 if $x >= 0 && $x < $self->{w}
2497 && $y >= 0 && $y < $self->{h};
2498
2499 1
2500}
2501
2502sub _draw {
2503 my ($self) = @_;
2504
2505 local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
2506
2507 glEnable GL_TEXTURE_2D;
2508 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2509 glColor 0, 0, 0, 1;
2510
2511 my $tex = $tex[$GRAB == $self];
2512 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2513
2514 glDisable GL_TEXTURE_2D;
2515
2516 $self->SUPER::_draw;
2517}
2518
2519#############################################################################
2520
2521package DC::UI::CheckBox;
2522
2523our @ISA = DC::UI::DrawBG::;
2524
2525my @tex =
2526 map { new_from_resource DC::Texture $_, mipmap => 1 }
2527 qw(c1_checkbox_bg.png c1_checkbox_active.png);
2528
2529use DC::OpenGL;
2530
2531sub new {
2532 my $class = shift;
2533
2534 $class->SUPER::new (
2535 fontsize => 1,
1886 padding_x => 2, 2536 padding_x => 2,
1887 padding_y => 2, 2537 padding_y => 2,
1888 fg => [1, 1, 1], 2538 fg => [1, 1, 1],
1889 active_fg => [1, 1, 0], 2539 active_fg => [1, 1, 0],
1890 bg => [0, 0, 0, 0.2], 2540 bg => [0, 0, 0, 0.2],
… …
1896} 2546}
1897 2547
1898sub size_request { 2548sub size_request {
1899 my ($self) = @_; 2549 my ($self) = @_;
1900 2550
1901 (6) x 2 2551 ($self->{fontsize} * $::FONTSIZE) x 2
1902} 2552}
1903 2553
2554sub toggle {
2555 my ($self) = @_;
2556
2557 $self->{state} = !$self->{state};
2558 $self->emit (changed => $self->{state});
2559 $self->update;
2560}
2561
1904sub button_down { 2562sub invoke_button_down {
1905 my ($self, $ev, $x, $y) = @_; 2563 my ($self, $ev, $x, $y) = @_;
1906 2564
1907 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x} 2565 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1908 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) { 2566 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1909 $self->{state} = !$self->{state}; 2567 $self->toggle;
1910 $self->_emit (changed => $self->{state}); 2568 } else {
2569 return 0
2570 }
2571
1911 } 2572 1
1912} 2573}
1913 2574
1914sub _draw { 2575sub _draw {
1915 my ($self) = @_; 2576 my ($self) = @_;
1916 2577
1917 $self->SUPER::_draw; 2578 $self->SUPER::_draw;
1918 2579
1919 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0; 2580 glTranslate $self->{padding_x}, $self->{padding_y}, 0;
1920 2581
1921 my ($w, $h) = @$self{qw(w h)}; 2582 my ($w, $h) = @$self{qw(w h)};
1922 2583
1923 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2; 2584 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1924 2585
… …
1931 glDisable GL_TEXTURE_2D; 2592 glDisable GL_TEXTURE_2D;
1932} 2593}
1933 2594
1934############################################################################# 2595#############################################################################
1935 2596
1936package CFClient::UI::Image; 2597package DC::UI::Image;
1937 2598
1938our @ISA = CFClient::UI::Base::; 2599our @ISA = DC::UI::Base::;
1939 2600
1940use CFClient::OpenGL; 2601use DC::OpenGL;
1941use Carp qw/confess/;
1942 2602
1943our %loaded_images; 2603our %texture_cache;
1944 2604
1945sub new { 2605sub new {
1946 my $class = shift; 2606 my $class = shift;
1947 2607
1948 my $self = $class->SUPER::new (can_events => 0, @_); 2608 my $self = $class->SUPER::new (
2609 can_events => 0,
2610 scale => 1,
2611 @_,
2612 );
1949 2613
1950 $self->{image} or confess "Image has 'image' not set. This is a fatal error!"; 2614 $self->{path} || $self->{tex}
2615 or Carp::croak "'path' or 'tex' attributes required";
1951 2616
1952 $loaded_images{$self->{image}} ||= 2617 $self->{tex} ||= $texture_cache{$self->{path}} ||=
1953 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1; 2618 new_from_resource DC::Texture $self->{path}, mipmap => 1;
1954 2619
1955 my $tex = $self->{tex} = $loaded_images{$self->{image}}; 2620 DC::weaken $texture_cache{$self->{path}};
1956 2621
1957 Scalar::Util::weaken $loaded_images{$self->{image}}; 2622 $self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
1958
1959 $self->{aspect} = $tex->{w} / $tex->{h};
1960 2623
1961 $self 2624 $self
1962} 2625}
1963 2626
2627sub STORABLE_freeze {
2628 my ($self, $cloning) = @_;
2629
2630 $self->{path}
2631 or die "cannot serialise DC::UI::Image on non-loadable images\n";
2632
2633 $self->{path}
2634}
2635
2636sub STORABLE_attach {
2637 my ($self, $cloning, $path) = @_;
2638
2639 $self->new (path => $path)
2640}
2641
1964sub size_request { 2642sub size_request {
1965 my ($self) = @_; 2643 my ($self) = @_;
1966 2644
1967 ($self->{tex}->{w}, $self->{tex}->{h}) 2645 (int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
1968} 2646}
1969 2647
1970sub _draw { 2648sub _draw {
1971 my ($self) = @_; 2649 my ($self) = @_;
1972 2650
… …
1989 glDisable GL_TEXTURE_2D; 2667 glDisable GL_TEXTURE_2D;
1990} 2668}
1991 2669
1992############################################################################# 2670#############################################################################
1993 2671
2672package DC::UI::ImageButton;
2673
2674our @ISA = DC::UI::Image::;
2675
2676use DC::OpenGL;
2677
2678my %textures;
2679
2680sub new {
2681 my $class = shift;
2682
2683 my $self = $class->SUPER::new (
2684 padding_x => 4,
2685 padding_y => 4,
2686 fg => [1, 1, 1],
2687 active_fg => [0, 0, 1],
2688 can_hover => 1,
2689 align => 0.5,
2690 valign => 0.5,
2691 can_events => 1,
2692 @_
2693 );
2694}
2695
2696sub invoke_button_down {
2697 my ($self, $ev, $x, $y) = @_;
2698
2699 1
2700}
2701
2702sub invoke_button_up {
2703 my ($self, $ev, $x, $y) = @_;
2704
2705 $self->emit ("activate")
2706 if $x >= 0 && $x < $self->{w}
2707 && $y >= 0 && $y < $self->{h};
2708
2709 1
2710}
2711
2712#############################################################################
2713
1994package CFClient::UI::VGauge; 2714package DC::UI::VGauge;
1995 2715
1996our @ISA = CFClient::UI::Base::; 2716our @ISA = DC::UI::Base::;
1997 2717
1998use List::Util qw(min max); 2718use List::Util qw(min max);
1999 2719
2000use CFClient::OpenGL; 2720use DC::OpenGL;
2001 2721
2002my %tex = ( 2722my %tex = (
2003 food => [ 2723 food => [
2004 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2724 map { new_from_resource DC::Texture $_, mipmap => 1 }
2005 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/ 2725 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2006 ], 2726 ],
2007 grace => [ 2727 grace => [
2008 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2728 map { new_from_resource DC::Texture $_, mipmap => 1 }
2009 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/ 2729 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2010 ], 2730 ],
2011 hp => [ 2731 hp => [
2012 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2732 map { new_from_resource DC::Texture $_, mipmap => 1 }
2013 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/ 2733 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2014 ], 2734 ],
2015 mana => [ 2735 mana => [
2016 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 } 2736 map { new_from_resource DC::Texture $_, mipmap => 1 }
2017 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/ 2737 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2018 ], 2738 ],
2019); 2739);
2020 2740
2021# eg. VGauge->new (gauge => 'food'), default gauge: food 2741# eg. VGauge->new (gauge => 'food'), default gauge: food
… …
2081 my $ycut1 = max 0, min 1, $ycut; 2801 my $ycut1 = max 0, min 1, $ycut;
2082 my $ycut2 = max 0, min 1, $ycut - 1; 2802 my $ycut2 = max 0, min 1, $ycut - 1;
2083 2803
2084 my $h1 = $self->{h} * (1 - $ycut1); 2804 my $h1 = $self->{h} * (1 - $ycut1);
2085 my $h2 = $self->{h} * (1 - $ycut2); 2805 my $h2 = $self->{h} * (1 - $ycut2);
2806 my $h3 = $self->{h};
2807
2808 $_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2086 2809
2087 glEnable GL_BLEND; 2810 glEnable GL_BLEND;
2088 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA; 2811 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2812 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2089 glEnable GL_TEXTURE_2D; 2813 glEnable GL_TEXTURE_2D;
2090 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2814 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2091 2815
2092 glBindTexture GL_TEXTURE_2D, $t1->{name}; 2816 glBindTexture GL_TEXTURE_2D, $t1->{name};
2093 glBegin GL_QUADS; 2817 glBegin GL_QUADS;
… …
2108 2832
2109 if ($t3) { 2833 if ($t3) {
2110 glBindTexture GL_TEXTURE_2D, $t3->{name}; 2834 glBindTexture GL_TEXTURE_2D, $t3->{name};
2111 glBegin GL_QUADS; 2835 glBegin GL_QUADS;
2112 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2; 2836 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2113 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h}; 2837 glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2114 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h}; 2838 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2115 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2; 2839 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2116 glEnd; 2840 glEnd;
2117 } 2841 }
2118 2842
2119 glDisable GL_BLEND; 2843 glDisable GL_BLEND;
2120 glDisable GL_TEXTURE_2D; 2844 glDisable GL_TEXTURE_2D;
2121} 2845}
2122 2846
2123############################################################################# 2847#############################################################################
2124 2848
2849package DC::UI::Progress;
2850
2851our @ISA = DC::UI::Label::;
2852
2853use DC::OpenGL;
2854
2855sub new {
2856 my ($class, %arg) = @_;
2857
2858 my $self = $class->SUPER::new (
2859 padding_x => 2,
2860 padding_y => 2,
2861 fg => [1, 1, 1],
2862 bg => [0, 0, 1, 0.2],
2863 bar => [0.7, 0.5, 0.1, 0.8],
2864 outline => [0.4, 0.3, 0],
2865 fontsize => 0.9,
2866 valign => 0.5,
2867 align => 0.5,
2868 can_events => 1,
2869 ellipsise => 1,
2870 label => "%d%%",
2871 %arg,
2872 );
2873
2874 $self->set_value ($arg{value} || -1);
2875
2876 $self
2877}
2878
2879sub set_label {
2880 my ($self, $label) = @_;
2881
2882 return if $self->{label} eq $label;
2883 $self->{label} = $label;
2884
2885 $self->DC::UI::Progress::set_value (0 + delete $self->{value});
2886}
2887
2888sub set_value {
2889 my ($self, $value) = @_;
2890
2891 if ($self->{value} ne $value) {
2892 $self->{value} = $value;
2893
2894 if ($value < 0) {
2895 $self->set_text ("-");
2896 } else {
2897 $self->set_text (sprintf $self->{label}, $value * 100);
2898 }
2899
2900 $self->update;
2901 }
2902}
2903
2904sub _draw {
2905 my ($self) = @_;
2906
2907 glEnable GL_BLEND;
2908 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2909
2910 my $px = $self->{padding_x};
2911 my $py = $self->{padding_y};
2912
2913 if ($self->{value} >= 0) {
2914 my $s = int $px + ($self->{w} - $px * 2) * $self->{value};
2915
2916 glColor_premultiply @{$self->{bar}};
2917 glRect $px, $py, $s, $self->{h} - $py;
2918 glColor_premultiply @{$self->{bg}};
2919 glRect $s , $py, $self->{w} - $px, $self->{h} - $py;
2920 }
2921
2922 glColor_premultiply @{$self->{outline}};
2923
2924 $px -= .5;
2925 $py -= .5;
2926
2927 glRect_lineloop $px, $py, $self->{w} - $px, $self->{h} - $py;
2928
2929 glDisable GL_BLEND;
2930
2931 {
2932 local $self->{bg}; # do not draw background
2933 $self->SUPER::_draw;
2934 }
2935}
2936
2937#############################################################################
2938
2939package DC::UI::ExperienceProgress;
2940
2941our @ISA = DC::UI::Progress::;
2942
2943sub new {
2944 my ($class, %arg) = @_;
2945
2946 my $tt = exists $arg{tooltip} ? "$arg{tooltip}\n\n" : "";
2947
2948 my $self = $class->SUPER::new (
2949 %arg,
2950 tooltip => sub {
2951 my ($self) = @_;
2952
2953 sprintf "%slevel %d\n%s points\n%s next level\n%s to go, %d%% done",
2954 $tt,
2955 $self->{lvl},
2956 ::formsep ($self->{exp}),
2957 ::formsep ($self->{nxt}),
2958 ::formsep ($self->{nxt} - $self->{exp}),
2959 $self->_percent * 100,
2960 },
2961 );
2962
2963 $::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) }
2964 if $::CONN;
2965
2966 $self
2967}
2968
2969sub DESTROY {
2970 my ($self) = @_;
2971
2972 delete $::CONN->{on_exp_update}{$self+0}
2973 if $::CONN;
2974
2975 $self->SUPER::DESTROY;
2976}
2977
2978sub _percent {
2979 my ($self) = @_;
2980
2981 my $table = $::CONN && $::CONN->{exp_table}
2982 or return -1;
2983
2984 my $l0 = $table->[$self->{lvl} - 1];
2985 my $l1 = $table->[$self->{lvl}];
2986
2987 $self->{nxt} = $l1;
2988
2989 ($self->{exp} - $l0) / ($l1 - $l0)
2990}
2991
2992sub set_value {
2993 my ($self, $lvl, $exp) = @_;
2994
2995 $self->{lvl} = $lvl;
2996 $self->{exp} = $exp;
2997
2998 $self->SUPER::set_value ($self->_percent);
2999}
3000
3001#############################################################################
3002
2125package CFClient::UI::Gauge; 3003package DC::UI::Gauge;
2126 3004
2127our @ISA = CFClient::UI::VBox::; 3005our @ISA = DC::UI::VBox::;
2128 3006
2129sub new { 3007sub new {
2130 my ($class, %arg) = @_; 3008 my ($class, %arg) = @_;
2131 3009
2132 my $self = $class->SUPER::new ( 3010 my $self = $class->SUPER::new (
… …
2134 can_hover => 1, 3012 can_hover => 1,
2135 can_events => 1, 3013 can_events => 1,
2136 %arg, 3014 %arg,
2137 ); 3015 );
2138 3016
2139 $self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999"); 3017 $self->add ($self->{value} = new DC::UI::Label valign => 1, align => 0.5, template => "999");
2140 $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1); 3018 $self->add ($self->{gauge} = new DC::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2141 $self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999"); 3019 $self->add ($self->{max} = new DC::UI::Label valign => 0, align => 0.5, template => "999");
2142 3020
2143 $self 3021 $self
2144} 3022}
2145 3023
2146sub set_fontsize { 3024sub set_fontsize {
… …
2167 $self->{value}->set_text ($val); 3045 $self->{value}->set_text ($val);
2168} 3046}
2169 3047
2170############################################################################# 3048#############################################################################
2171 3049
2172package CFClient::UI::Slider; 3050package DC::UI::Slider;
2173 3051
2174use strict; 3052use strict;
2175 3053
2176use CFClient::OpenGL; 3054use DC::OpenGL;
2177 3055
2178our @ISA = CFClient::UI::DrawBG::; 3056our @ISA = DC::UI::DrawBG::;
2179 3057
2180my @tex = 3058my @tex =
2181 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ } 3059 map { new_from_resource DC::Texture $_ }
2182 qw(s1_slider.png s1_slider_bg.png); 3060 qw(s1_slider.png s1_slider_bg.png);
2183 3061
2184sub new { 3062sub new {
2185 my $class = shift; 3063 my $class = shift;
2186 3064
… …
2207 $self->update; 3085 $self->update;
2208 3086
2209 $self 3087 $self
2210} 3088}
2211 3089
2212sub changed { }
2213
2214sub set_range { 3090sub set_range {
2215 my ($self, $range) = @_; 3091 my ($self, $range) = @_;
2216 3092
2217 ($range, $self->{range}) = ($self->{range}, $range); 3093 ($range, $self->{range}) = ($self->{range}, $range);
2218 3094
2219 $self->update
2220 if "@$range" ne "@{$self->{range}}"; 3095 if ("@$range" ne "@{$self->{range}}") {
3096 $self->update;
3097 $self->set_value ($self->{range}[0]);
3098 }
2221} 3099}
2222 3100
2223sub set_value { 3101sub set_value {
2224 my ($self, $value) = @_; 3102 my ($self, $value) = @_;
2225 3103
2226 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}}; 3104 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2227 3105
2228 $hi = $lo + 1 if $hi <= $lo; 3106 $hi = $lo if $hi < $lo;
2229 3107
2230 $page = $hi - $lo if $page > $hi - $lo; 3108 $value = $hi - $page if $value > $hi - $page;
2231
2232 $value = $lo if $value < $lo; 3109 $value = $lo if $value < $lo;
2233 $value = $hi - $page if $value > $hi - $page;
2234 3110
2235 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit 3111 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2236 if $unit; 3112 if $unit;
2237 3113
2238 @{$self->{range}} = ($value, $lo, $hi, $page, $unit); 3114 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2239 3115
2240 if ($value != $old_value) { 3116 if ($value != $old_value) {
2241 $self->_emit (changed => $value); 3117 $self->emit (changed => $value);
2242 $self->update; 3118 $self->update;
2243 } 3119 }
2244} 3120}
2245 3121
2246sub size_request { 3122sub size_request {
2247 my ($self) = @_; 3123 my ($self) = @_;
2248 3124
2249 ($self->{req_w}, $self->{req_h}) 3125 ($self->{req_w}, $self->{req_h})
2250} 3126}
2251 3127
2252sub button_down { 3128sub invoke_button_down {
2253 my ($self, $ev, $x, $y) = @_; 3129 my ($self, $ev, $x, $y) = @_;
2254 3130
2255 $self->SUPER::button_down ($ev, $x, $y); 3131 $self->SUPER::invoke_button_down ($ev, $x, $y);
2256 3132
2257 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x]; 3133 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2258 3134
2259 $self->mouse_motion ($ev, $x, $y); 3135 $self->invoke_mouse_motion ($ev, $x, $y);
2260}
2261 3136
3137 1
3138}
3139
2262sub mouse_motion { 3140sub invoke_mouse_motion {
2263 my ($self, $ev, $x, $y) = @_; 3141 my ($self, $ev, $x, $y) = @_;
2264 3142
2265 if ($GRAB == $self) { 3143 if ($GRAB == $self) {
2266 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w}); 3144 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2267 3145
2268 my (undef, $lo, $hi, $page) = @{$self->{range}}; 3146 my (undef, $lo, $hi, $page) = @{$self->{range}};
2269 3147
2270 $x = ($x - $self->{click}[1]) / ($w * $self->{scale}); 3148 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2271 3149
2272 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo)); 3150 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
3151 } else {
3152 return 0;
3153 }
3154
2273 } 3155 1
3156}
3157
3158sub invoke_mouse_wheel {
3159 my ($self, $ev) = @_;
3160
3161 my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
3162
3163 my $pagepart = $ev->{mod} & DC::KMOD_SHIFT ? 1 : 0.2;
3164
3165 $self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
3166
3167 1
2274} 3168}
2275 3169
2276sub update { 3170sub update {
2277 my ($self) = @_; 3171 my ($self) = @_;
2278 3172
2279 $CFClient::UI::ROOT->on_post_alloc ($self => sub { 3173 delete $self->{knob_w};
3174 $self->SUPER::update;
3175}
3176
3177sub _draw {
3178 my ($self) = @_;
3179
3180 unless ($self->{knob_w}) {
2280 $self->set_value ($self->{range}[0]); 3181 $self->set_value ($self->{range}[0]);
2281 3182
2282 my ($value, $lo, $hi, $page) = @{$self->{range}}; 3183 my ($value, $lo, $hi, $page, $unit) = @{$self->{range}};
2283 my $range = ($hi - $page - $lo) || 1e-100; 3184 my $range = ($hi - $page - $lo) || 1e-10;
2284 3185
2285 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1; 3186 my $knob_w = List::Util::min 1, $page / (($hi - $lo) || 1e-10) || 24 / $self->{w};
2286 3187
2287 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5; 3188 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2288 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100; 3189 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2289 3190
2290 $value = ($value - $lo) / $range; 3191 $value = ($value - $lo) / $range;
2291 $value = $value * $self->{scale} + $self->{offset}; 3192 $value = $value * $self->{scale} + $self->{offset};
2292 3193
2293 $self->{knob_x} = $value - $knob_w * 0.5; 3194 $self->{knob_x} = $value - $knob_w * 0.5;
2294 $self->{knob_w} = $knob_w; 3195 $self->{knob_w} = $knob_w;
2295 }); 3196 }
2296
2297 $self->SUPER::update;
2298}
2299
2300sub _draw {
2301 my ($self) = @_;
2302 3197
2303 $self->SUPER::_draw (); 3198 $self->SUPER::_draw ();
2304 3199
2305 glScale $self->{w}, $self->{h}; 3200 glScale $self->{w}, $self->{h};
2306 3201
… …
2326 glDisable GL_TEXTURE_2D; 3221 glDisable GL_TEXTURE_2D;
2327} 3222}
2328 3223
2329############################################################################# 3224#############################################################################
2330 3225
2331package CFClient::UI::ValSlider; 3226package DC::UI::ValSlider;
2332 3227
2333our @ISA = CFClient::UI::HBox::; 3228our @ISA = DC::UI::HBox::;
2334 3229
2335sub new { 3230sub new {
2336 my ($class, %arg) = @_; 3231 my ($class, %arg) = @_;
2337 3232
2338 my $range = delete $arg{range}; 3233 my $range = delete $arg{range};
2339 3234
2340 my $self = $class->SUPER::new ( 3235 my $self = $class->SUPER::new (
2341 slider => (new CFClient::UI::Slider expand => 1, range => $range), 3236 slider => (new DC::UI::Slider expand => 1, range => $range),
2342 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}), 3237 entry => (new DC::UI::Label text => "", template => delete $arg{template}),
2343 to_value => sub { shift }, 3238 to_value => sub { shift },
2344 from_value => sub { shift }, 3239 from_value => sub { shift },
2345 %arg, 3240 %arg,
2346 ); 3241 );
2347 3242
… …
2367sub set_range { shift->{slider}->set_range (@_) } 3262sub set_range { shift->{slider}->set_range (@_) }
2368sub set_value { shift->{slider}->set_value (@_) } 3263sub set_value { shift->{slider}->set_value (@_) }
2369 3264
2370############################################################################# 3265#############################################################################
2371 3266
2372package CFClient::UI::TextView; 3267package DC::UI::TextScroller;
2373 3268
2374our @ISA = CFClient::UI::HBox::; 3269our @ISA = DC::UI::HBox::;
2375 3270
2376use CFClient::OpenGL; 3271use DC::OpenGL;
2377 3272
2378sub new { 3273sub new {
2379 my $class = shift; 3274 my $class = shift;
2380 3275
2381 my $self = $class->SUPER::new ( 3276 my $self = $class->SUPER::new (
2382 fontsize => 1, 3277 fontsize => 1,
2383 can_events => 0, 3278 can_events => 1,
3279 indent => 0,
2384 #font => default_font 3280 #font => default_font
2385 @_, 3281 @_,
2386 3282
2387 layout => (new CFClient::Layout 1), 3283 layout => (new DC::Layout),
2388 par => [], 3284 par => [],
3285 max_par => 0,
2389 height => 0, 3286 height => 0,
2390 children => [ 3287 children => [
2391 (new CFClient::UI::Empty expand => 1), 3288 (new DC::UI::Empty expand => 1),
2392 (new CFClient::UI::Slider vertical => 1), 3289 (new DC::UI::Slider vertical => 1),
2393 ], 3290 ],
2394 ); 3291 );
2395 3292
2396 $self->{children}[1]->connect (changed => sub { $self->update }); 3293 $self->{children}[1]->connect (changed => sub { $self->update });
2397 3294
… …
2403 3300
2404 $self->{fontsize} = $fontsize; 3301 $self->{fontsize} = $fontsize;
2405 $self->reflow; 3302 $self->reflow;
2406} 3303}
2407 3304
3305sub size_request {
3306 my ($self) = @_;
3307
3308 my ($empty, $slider) = $self->visible_children;
3309
3310 local $self->{children} = [$empty, $slider];
3311 $self->SUPER::size_request
3312}
3313
2408sub size_allocate { 3314sub invoke_size_allocate {
2409 my ($self, $w, $h) = @_; 3315 my ($self, $w, $h) = @_;
2410 3316
2411 $self->SUPER::size_allocate ($w, $h); 3317 my ($empty, $slider, @other) = @{ $self->{children} };
3318 $_->configure (@$_{qw(x y req_w req_h)}) for @other;
2412 3319
2413 $self->{layout}->set_font ($self->{font}) if $self->{font}; 3320 $self->{layout}->set_font ($self->{font}) if $self->{font};
2414 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE); 3321 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2415 $self->{layout}->set_width ($self->{children}[0]{w}); 3322 $self->{layout}->set_width ($empty->{w});
3323 $self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2416 3324
2417 $self->reflow; 3325 $self->reflow;
2418}
2419 3326
2420sub text_size { 3327 local $self->{children} = [$empty, $slider];
3328 $self->SUPER::invoke_size_allocate ($w, $h)
3329}
3330
3331sub invoke_mouse_wheel {
2421 my ($self, $text, $indent) = @_; 3332 my ($self, $ev) = @_;
3333
3334 return 0 unless $ev->{dy}; # only vertical movements
3335
3336 $self->{children}[1]->emit (mouse_wheel => $ev);
3337
3338 1
3339}
3340
3341sub get_layout {
3342 my ($self, $para) = @_;
2422 3343
2423 my $layout = $self->{layout}; 3344 my $layout = $self->{layout};
2424 3345
3346 $layout->set_font ($self->{font}) if $self->{font};
3347 $layout->set_foreground (@{$para->{fg}});
2425 $layout->set_height ($self->{fontsize} * $::FONTSIZE); 3348 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2426 $layout->set_width ($self->{children}[0]{w} - $indent); 3349 $layout->set_width ($self->{children}[0]{w} - $para->{indent});
3350 $layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2427 $layout->set_markup ($text); 3351 $layout->set_markup ($para->{markup});
3352
3353 $layout->set_shapes (
3354 map
3355 +(0, $_->baseline_shift + $_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
3356 @{$para->{widget}}
2428 3357 );
3358
2429 $layout->size 3359 $layout
2430} 3360}
2431 3361
2432sub reflow { 3362sub reflow {
2433 my ($self) = @_; 3363 my ($self) = @_;
2434 3364
… …
2441 3371
2442 # todo: base offset on lines or so, not on pixels 3372 # todo: base offset on lines or so, not on pixels
2443 $self->{children}[1]->set_value ($offset); 3373 $self->{children}[1]->set_value ($offset);
2444} 3374}
2445 3375
3376sub current_paragraph {
3377 my ($self) = @_;
3378
3379 $self->{top_paragraph} - 1
3380}
3381
3382sub scroll_to {
3383 my ($self, $para) = @_;
3384
3385 $para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
3386
3387 $self->{scroll_to} = $para;
3388 $self->update;
3389}
3390
2446sub clear { 3391sub clear {
2447 my ($self) = @_; 3392 my ($self) = @_;
3393
3394 my (undef, undef, @other) = @{ $self->{children} };
3395 $self->remove ($_) for @other;
2448 3396
2449 $self->{par} = []; 3397 $self->{par} = [];
2450 $self->{height} = 0; 3398 $self->{height} = 0;
2451 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]); 3399 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2452} 3400}
2453 3401
2454sub add_paragraph { 3402sub add_paragraph {
2455 my ($self, $color, $text, $indent) = @_; 3403 my $self = shift;
2456 3404
2457 for my $line (split /\n/, $text) { 3405 for my $para (@_) {
2458 my ($w, $h) = $self->text_size ($line); 3406 $para = {
3407 fg => [1, 1, 1, 1],
3408 indent => 0,
3409 markup => "",
3410 widget => [],
3411 ref $para ? %$para : (markup => $para),
3412 w => 1e10,
3413 wrapped => 1,
3414 };
3415
3416 $self->add (@{ $para->{widget} }) if @{ $para->{widget} };
3417 push @{$self->{par}}, $para;
3418 }
3419
3420 if (my $max = $self->{max_par}) {
3421 shift @{$self->{par}} while @{$self->{par}} > $max;
3422 }
3423
3424 $self->{need_reflow}++;
3425 $self->update;
3426}
3427
3428sub scroll_to_bottom {
3429 my ($self) = @_;
3430
3431 $self->{scroll_to} = $#{$self->{par}};
3432 $self->update;
3433}
3434
3435sub force_uptodate {
3436 my ($self) = @_;
3437
3438 if (delete $self->{need_reflow}) {
3439 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
3440
3441 my $height = 0;
3442
3443 for my $para (@{$self->{par}}) {
3444 if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
3445 my $layout = $self->get_layout ($para);
3446 my ($w, $h) = $layout->size;
3447
3448 $para->{w} = $w + $para->{indent};
3449 $para->{h} = $h;
3450 $para->{wrapped} = $layout->has_wrapped;
3451 }
3452
3453 $para->{y} = $height;
3454 $height += $para->{h};
3455 }
3456
2459 $self->{height} += $h; 3457 $self->{height} = $height;
2460 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line]; 3458 $self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2461 }
2462 3459
2463 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]); 3460 delete $self->{texture};
3461 }
3462
3463 if (my $paridx = delete $self->{scroll_to}) {
3464 $self->{children}[1]->set_value ($self->{par}[$paridx]{y});
3465 }
2464} 3466}
2465 3467
2466sub update { 3468sub update {
2467 my ($self) = @_; 3469 my ($self) = @_;
2468 3470
… …
2470 3472
2471 return unless $self->{h} > 0; 3473 return unless $self->{h} > 0;
2472 3474
2473 delete $self->{texture}; 3475 delete $self->{texture};
2474 3476
2475 $ROOT->on_post_alloc ($self, sub { 3477 $ROOT->on_post_alloc ($self => sub {
3478 $self->force_uptodate;
3479
2476 my ($W, $H) = @{$self->{children}[0]}{qw(w h)}; 3480 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2477 3481
2478 if (delete $self->{need_reflow}) {
2479 my $height = 0;
2480
2481 my $layout = $self->{layout};
2482
2483 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2484
2485 for (@{$self->{par}}) {
2486 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2487 $layout->set_width ($W - $_->[3]);
2488 $layout->set_markup ($_->[4]);
2489 my ($w, $h) = $layout->size;
2490 $_->[0] = $w + $_->[3];
2491 $_->[1] = $h;
2492 }
2493
2494 $height += $_->[1];
2495 }
2496
2497 $self->{height} = $height;
2498
2499 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2500
2501 delete $self->{texture};
2502 }
2503
2504 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub { 3482 $self->{texture} ||= new_from_opengl DC::Texture $W, $H, sub {
2505 glClearColor 0.5, 0.5, 0.5, 0; 3483 glClearColor 0, 0, 0, 0;
2506 glClear GL_COLOR_BUFFER_BIT; 3484 glClear GL_COLOR_BUFFER_BIT;
2507 3485
3486 package DC::UI::Base;
3487 local ($draw_x, $draw_y, $draw_w, $draw_h) =
3488 (0, 0, $self->{w}, $self->{h});
3489
3490 my $top = int $self->{children}[1]{range}[0];
3491
3492 my $paridx = 0;
3493 my $top_paragraph;
2508 my $top = int $self->{children}[1]{range}[0]; 3494 my $top = int $self->{children}[1]{range}[0];
2509 3495
2510 my $y0 = $top; 3496 my $y0 = $top;
2511 my $y1 = $top + $H; 3497 my $y1 = $top + $H;
2512 3498
2513 my $y = 0;
2514
2515 my $layout = $self->{layout};
2516
2517 $layout->set_font ($self->{font}) if $self->{font};
2518
2519 glEnable GL_BLEND;
2520 #TODO# not correct in windows where rgba is forced off
2521 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2522
2523 for my $par (@{$self->{par}}) { 3499 for my $para (@{$self->{par}}) {
2524 my $h = $par->[1]; 3500 my $h = $para->{h};
3501 my $y = $para->{y};
2525 3502
2526 if ($y0 < $y + $h && $y < $y1) { 3503 if ($y0 < $y + $h && $y < $y1) {
2527 $layout->set_foreground (@{ $par->[2] }); 3504 my $layout = $self->get_layout ($para);
2528 $layout->set_width ($W - $par->[3]);
2529 $layout->set_markup ($par->[4]);
2530 3505
2531 my ($w, $h, $data, $format, $internalformat) = $layout->render; 3506 $layout->render ($para->{indent}, $y - $y0);
3507 $layout->draw;
2532 3508
2533 glRasterPos $par->[3], $y - $y0; 3509 if (my @w = @{ $para->{widget} }) {
2534 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data; 3510 my @s = $layout->get_shapes;
3511
3512 for (@w) {
3513 my ($dx, $dy) = splice @s, 0, 2, ();
3514
3515 $_->{x} = $dx + $para->{indent};
3516 $_->{y} = $dy + $y - $y0;
3517
3518 $_->draw;
3519 }
3520 }
2535 } 3521 }
2536 3522
2537 $y += $h; 3523 $paridx++;
3524 $top_paragraph ||= $paridx if $y >= $top;
2538 } 3525 }
2539 3526
2540 glDisable GL_BLEND; 3527 $self->{top_paragraph} = $top_paragraph;
2541 }; 3528 };
2542 }); 3529 });
2543} 3530}
2544 3531
3532sub reconfigure {
3533 my ($self) = @_;
3534
3535 $self->SUPER::reconfigure;
3536
3537 $_->{w} = 1e10 for @{ $self->{par} };
3538 $self->reflow;
3539}
3540
2545sub _draw { 3541sub _draw {
2546 my ($self) = @_; 3542 my ($self) = @_;
2547 3543
2548 glEnable GL_TEXTURE_2D; 3544 glEnable GL_TEXTURE_2D;
2549 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 3545 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2550 glColor 1, 1, 1, 1; 3546 glColor 0, 0, 0, 1;
2551 $self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h}); 3547 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2552 glDisable GL_TEXTURE_2D; 3548 glDisable GL_TEXTURE_2D;
2553 3549
2554 $self->{children}[1]->draw; 3550 $self->{children}[1]->draw;
2555
2556} 3551}
2557 3552
2558############################################################################# 3553#############################################################################
2559 3554
2560package CFClient::UI::Animator; 3555package DC::UI::Animator;
2561 3556
2562use CFClient::OpenGL; 3557use DC::OpenGL;
2563 3558
2564our @ISA = CFClient::UI::Bin::; 3559our @ISA = DC::UI::Bin::;
2565 3560
2566sub moveto { 3561sub moveto {
2567 my ($self, $x, $y) = @_; 3562 my ($self, $x, $y) = @_;
2568 3563
2569 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 3564 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
… …
2597 glPopMatrix; 3592 glPopMatrix;
2598} 3593}
2599 3594
2600############################################################################# 3595#############################################################################
2601 3596
2602package CFClient::UI::Flopper; 3597package DC::UI::Flopper;
2603 3598
2604our @ISA = CFClient::UI::Button::; 3599our @ISA = DC::UI::Button::;
2605 3600
2606sub new { 3601sub new {
2607 my $class = shift; 3602 my $class = shift;
2608 3603
2609 my $self = $class->SUPER::new ( 3604 my $self = $class->SUPER::new (
… …
2621 $self->{other}->toggle_visibility; 3616 $self->{other}->toggle_visibility;
2622} 3617}
2623 3618
2624############################################################################# 3619#############################################################################
2625 3620
2626package CFClient::UI::Tooltip; 3621package DC::UI::Tooltip;
2627 3622
2628our @ISA = CFClient::UI::Bin::; 3623our @ISA = DC::UI::Bin::;
2629 3624
2630use CFClient::OpenGL; 3625use DC::OpenGL;
2631 3626
2632sub new { 3627sub new {
2633 my $class = shift; 3628 my $class = shift;
2634 3629
2635 $class->SUPER::new ( 3630 $class->SUPER::new (
… …
2639} 3634}
2640 3635
2641sub set_tooltip_from { 3636sub set_tooltip_from {
2642 my ($self, $widget) = @_; 3637 my ($self, $widget) = @_;
2643 3638
2644 my $tooltip = $widget->{tooltip}; 3639 my $tip = $widget->{tooltip};
3640 $tip = $tip->($widget) if "CODE" eq ref $tip;
3641
3642 $tip = DC::Pod::section_label tooltip => $1
3643 if $tip =~ /^#(.*)$/;
2645 3644
2646 if ($ENV{CFPLUS_DEBUG} & 2) { 3645 if ($ENV{CFPLUS_DEBUG} & 2) {
2647 $tooltip .= "\n\n" . (ref $widget) . "\n" 3646 $tip .= "\n\n" . (ref $widget) . "\n"
2648 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n" 3647 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2649 . "req $widget->{req_w} $widget->{req_h}\n" 3648 . "req $widget->{req_w} $widget->{req_h}\n"
2650 . "visible $widget->{visible}"; 3649 . "visible $widget->{visible}";
2651 } 3650 }
2652 3651
3652 $tip =~ s/^\n+//;
3653 $tip =~ s/\n+$//;
3654
2653 $self->add (new CFClient::UI::Label 3655 $self->add (new DC::UI::Label
3656 fg => $DC::THEME{tooltip_fg},
2654 markup => $tooltip, 3657 markup => $tip,
2655 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH, 3658 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
3659 align => 0,
2656 fontsize => 0.8, 3660 fontsize => 0.8,
2657 fg => [0, 0, 0, 1], 3661 style => $DC::THEME{tooltip_style}, # FLAG_INVERSE
2658 ellipsise => 0, 3662 ellipsise => 0,
2659 font => ($widget->{tooltip_font} || $::FONT_PROP), 3663 font => ($widget->{tooltip_font} || $::FONT_PROP),
2660 ); 3664 );
2661} 3665}
2662 3666
… …
2666 my ($w, $h) = @{$self->child}{qw(req_w req_h)}; 3670 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2667 3671
2668 ($w + 4, $h + 4) 3672 ($w + 4, $h + 4)
2669} 3673}
2670 3674
2671sub size_allocate { 3675sub invoke_size_allocate {
2672 my ($self, $w, $h) = @_; 3676 my ($self, $w, $h) = @_;
2673 3677
2674 $self->SUPER::size_allocate ($w - 4, $h - 4); 3678 $self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2675} 3679}
2676 3680
2677sub visibility_change { 3681sub invoke_visibility_change {
2678 my ($self, $visible) = @_; 3682 my ($self, $visible) = @_;
2679 3683
2680 return unless $visible; 3684 return unless $visible;
2681 3685
2682 $self->{root}->on_post_alloc ("move_$self" => sub { 3686 $self->{root}->on_post_alloc ("move_$self" => sub {
2683 my $widget = $self->{owner} 3687 my $widget = $self->{owner}
2684 or return; 3688 or return;
2685 3689
3690 if ($widget->{visible}) {
2686 my ($x, $y) = $widget->coord2global ($widget->{w}, 0); 3691 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2687 3692
2688 ($x, $y) = $widget->coord2global (-$self->{w}, 0) 3693 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2689 if $x + $self->{w} > $::WIDTH; 3694 if $x + $self->{w} > $self->{root}{w};
2690 3695
2691 $self->move_abs ($x, $y); 3696 $self->move_abs ($x, $y);
3697 } else {
3698 $self->hide;
3699 }
2692 }); 3700 });
2693} 3701}
2694 3702
2695sub _draw { 3703sub _draw {
2696 my ($self) = @_; 3704 my ($self) = @_;
2697 3705
2698 glTranslate 0.375, 0.375;
2699
2700 my ($w, $h) = @$self{qw(w h)}; 3706 my ($w, $h) = @$self{qw(w h)};
2701 3707
2702 glColor 1, 0.8, 0.4; 3708 glColor @{ $DC::THEME{tooltip_bg} };
2703 glBegin GL_QUADS; 3709 glRect 0, 0, $w, $h;
2704 glVertex 0 , 0;
2705 glVertex 0 , $h;
2706 glVertex $w, $h;
2707 glVertex $w, 0;
2708 glEnd;
2709 3710
2710 glColor 0, 0, 0; 3711 glColor @{ $DC::THEME{tooltip_border} };
2711 glBegin GL_LINE_LOOP; 3712 glRect_lineloop .5, .5, $w + .5, $h + .5;
2712 glVertex 0 , 0;
2713 glVertex 0 , $h;
2714 glVertex $w, $h;
2715 glVertex $w, 0;
2716 glEnd;
2717 3713
2718 glTranslate 2 - 0.375, 2 - 0.375; 3714 glTranslate 2, 2;
2719 3715
2720 $self->SUPER::_draw; 3716 $self->SUPER::_draw;
2721} 3717}
2722 3718
2723############################################################################# 3719#############################################################################
2724 3720
2725package CFClient::UI::Face; 3721package DC::UI::Face;
2726 3722
2727our @ISA = CFClient::UI::Base::; 3723our @ISA = DC::UI::DrawBG::;
2728 3724
2729use CFClient::OpenGL; 3725use DC::OpenGL;
2730 3726
2731sub new { 3727sub new {
2732 my $class = shift; 3728 my $class = shift;
2733 3729
2734 my $self = $class->SUPER::new ( 3730 my $self = $class->SUPER::new (
3731 size_w => 32,
3732 size_h => 8,
2735 aspect => 1, 3733 aspect => 1,
2736 can_events => 0, 3734 can_events => 0,
2737 @_, 3735 @_,
2738 ); 3736 );
2739 3737
2740 if ($self->{anim} && $self->{animspeed}) { 3738 $self->update_anim;
2741 Scalar::Util::weaken (my $widget = $self);
2742
2743 $self->{timer} = Event->timer (
2744 at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2745 hard => 1,
2746 interval => $self->{animspeed},
2747 cb => sub {
2748 ++$widget->{frame};
2749 $widget->update;
2750 },
2751 );
2752 }
2753 3739
2754 $self 3740 $self
2755} 3741}
2756 3742
3743sub update_timer {
3744 my ($self) = @_;
3745
3746 return unless $self->{timer};
3747
3748 if ($self->{visible}) {
3749 $self->{timer}->start;
3750 } else {
3751 $self->{timer}->stop;
3752 }
3753}
3754
3755sub update_face {
3756 my ($self) = @_;
3757
3758 if ($::CONN) {
3759 if (my $anim = $::CONN->{anim}[$self->{anim}]) {
3760 if ($anim && @$anim) {
3761 $self->{face} = $anim->[ $self->{frame} % @$anim ];
3762 delete $self->{face_change_cb};
3763
3764 if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{face}[$self->{face}]{id} ]) {
3765 unless ($tex->{name} || $tex->{loading}) {
3766 $tex->upload (sub { $self->reconfigure });
3767 }
3768 }
3769 }
3770 }
3771 }
3772}
3773
3774sub update_anim {
3775 my ($self) = @_;
3776
3777 if ($self->{anim} && $self->{animspeed}) {
3778 DC::weaken (my $widget = $self);
3779
3780 $self->{animspeed} = List::Util::max 0.05, $self->{animspeed};
3781 $self->{timer} = EV::periodic_ns 0, $self->{animspeed}, undef, sub {
3782 return unless $::CONN;
3783
3784 my $w = $widget
3785 or return;
3786
3787 ++$w->{frame};
3788 $w->update_face;
3789
3790 # somehow, $widget can go away
3791 $w->update;
3792 $w->update_timer;
3793 };
3794
3795 $self->update_face;
3796 $self->update_timer;
3797 } else {
3798 delete $self->{timer};
3799 }
3800}
3801
2757sub size_request { 3802sub size_request {
2758 (32, 8) 3803 my ($self) = @_;
3804
3805 if ($::CONN) {
3806 if (my $faceid = $::CONN->{face}[$self->{face}]{id}) {
3807 if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
3808 if ($tex->{name}) {
3809 return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
3810 } elsif (!$tex->{loading}) {
3811 $tex->upload (sub { $self->reconfigure });
3812 }
3813 }
3814
3815 $self->{face_change_cb} ||= $::CONN->on_face_change ($self->{face}, sub { $self->reconfigure });
3816 }
3817 }
3818
3819 ($self->{size_w} || 8, $self->{size_h} || 8)
2759} 3820}
2760 3821
2761sub update { 3822sub update {
2762 my ($self) = @_; 3823 my ($self) = @_;
2763 3824
2764 return unless $self->{visible}; 3825 return unless $self->{visible};
2765 3826
2766 $self->SUPER::update; 3827 $self->SUPER::update;
2767} 3828}
2768 3829
3830sub set_face {
3831 my ($self, $face) = @_;
3832
3833 $self->{face} = $face;
3834 $self->reconfigure;
3835}
3836
3837sub set_anim {
3838 my ($self, $anim) = @_;
3839
3840 $self->{anim} = $anim;
3841 $self->update_anim;
3842}
3843
3844sub set_animspeed {
3845 my ($self, $animspeed) = @_;
3846
3847 $self->{animspeed} = $animspeed;
3848 $self->update_anim;
3849}
3850
3851sub invoke_visibility_change {
3852 my ($self) = @_;
3853
3854 $self->update_timer;
3855
3856 0
3857}
3858
2769sub _draw { 3859sub _draw {
2770 my ($self) = @_; 3860 my ($self) = @_;
2771 3861
2772 return unless $::CONN; 3862 $self->SUPER::_draw;
2773 3863
2774 my $face; 3864 if (my $tex = $self->{tex}) {
2775
2776 if ($self->{frame}) {
2777 my $anim = $::CONN->{anim}[$self->{anim}];
2778
2779 $face = $anim->[ $self->{frame} % @$anim ]
2780 if $anim && @$anim;
2781 }
2782
2783 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2784
2785 if ($tex) {
2786 glEnable GL_TEXTURE_2D; 3865 glEnable GL_TEXTURE_2D;
2787 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 3866 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2788 glColor 1, 1, 1, 1; 3867 glColor 0, 0, 0, 1;
2789 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h}); 3868 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2790 glDisable GL_TEXTURE_2D; 3869 glDisable GL_TEXTURE_2D;
2791 } 3870 }
2792} 3871}
2793 3872
2794sub DESTROY { 3873sub destroy {
2795 my ($self) = @_; 3874 my ($self) = @_;
2796 3875
2797 $self->{timer}->cancel 3876 (delete $self->{timer})->cancel
2798 if $self->{timer}; 3877 if $self->{timer};
2799 3878
2800 $self->SUPER::DESTROY; 3879 $self->SUPER::destroy;
2801} 3880}
2802 3881
2803############################################################################# 3882#############################################################################
2804 3883
3884package DC::UI::Buttonbar;
3885
3886our @ISA = DC::UI::HBox::;
3887
3888# TODO: should actually wrap buttons and other goodies.
3889
3890#############################################################################
3891
2805package CFClient::UI::Menu; 3892package DC::UI::Menu;
2806 3893
2807our @ISA = CFClient::UI::FancyFrame::; 3894our @ISA = DC::UI::Toplevel::;
2808 3895
2809use CFClient::OpenGL; 3896use DC::OpenGL;
2810 3897
2811sub new { 3898sub new {
2812 my $class = shift; 3899 my $class = shift;
2813 3900
2814 my $self = $class->SUPER::new ( 3901 my $self = $class->SUPER::new (
2815 items => [], 3902 items => [],
2816 z => 100, 3903 z => 100,
2817 @_, 3904 @_,
2818 ); 3905 );
2819 3906
2820 $self->add ($self->{vbox} = new CFClient::UI::VBox); 3907 $self->add ($self->{vbox} = new DC::UI::VBox);
2821 3908
2822 for my $item (@{ $self->{items} }) { 3909 for my $item (@{ $self->{items} }) {
2823 my ($widget, $cb) = @$item; 3910 my ($widget, $cb, $tooltip) = @$item;
2824 3911
2825 # handle various types of items, only text for now 3912 # handle various types of items, only text for now
2826 if (!ref $widget) { 3913 if (!ref $widget) {
3914 if ($widget =~ /\t/) {
3915 my ($left, $right) = split /\t/, $widget, 2;
3916
2827 $widget = new CFClient::UI::Label 3917 $widget = new DC::UI::HBox
2828 can_hover => 1, 3918 can_hover => 1,
2829 can_events => 1, 3919 can_events => 1,
3920 tooltip => $tooltip,
3921 children => [
3922 (new DC::UI::Label markup => $left , align => 0, expand => 1),
3923 (new DC::UI::Label markup => $right, align => 1),
3924 ],
3925 ;
3926
3927 } else {
3928 $widget = new DC::UI::Label
3929 can_hover => 1,
3930 can_events => 1,
3931 align => 0,
2830 text => $widget; 3932 markup => $widget,
3933 tooltip => $tooltip;
3934 }
2831 } 3935 }
2832 3936
2833 $self->{item}{$widget} = $item; 3937 $self->{item}{$widget} = $item;
2834 3938
2835 $self->{vbox}->add ($widget); 3939 $self->{vbox}->add ($widget);
… …
2840 3944
2841# popup given the event (must be a mouse button down event currently) 3945# popup given the event (must be a mouse button down event currently)
2842sub popup { 3946sub popup {
2843 my ($self, $ev) = @_; 3947 my ($self, $ev) = @_;
2844 3948
2845 $self->_emit ("popdown"); 3949 $self->emit ("popdown");
2846 3950
2847 # maybe save $GRAB? must be careful about events... 3951 # maybe save $GRAB? must be careful about events...
2848 $GRAB = $self; 3952 $GRAB = $self;
2849 $self->{button} = $ev->{button}; 3953 $self->{button} = $ev->{button};
2850 3954
2851 $self->show; 3955 $self->show;
2852 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2853}
2854 3956
3957 my $x = $ev->{x};
3958 my $y = $ev->{y};
3959
3960 $self->{root}->on_post_alloc ($self => sub {
3961 $self->move_abs ($x - $self->{w} * 0.25, $y - $self->{border} * $::FONTSIZE * .5);
3962 });
3963
3964 1 # so it can be used inside event handlers
3965}
3966
2855sub mouse_motion { 3967sub invoke_mouse_motion {
2856 my ($self, $ev, $x, $y) = @_; 3968 my ($self, $ev, $x, $y) = @_;
2857 3969
2858 # TODO: should use vbox->find_widget or so 3970 # TODO: should use vbox->find_widget or so
2859 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y}); 3971 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2860 $self->{hover} = $self->{item}{$HOVER}; 3972 $self->{hover} = $self->{item}{$HOVER};
2861}
2862 3973
3974 0
3975}
3976
2863sub button_up { 3977sub invoke_button_up {
2864 my ($self, $ev, $x, $y) = @_; 3978 my ($self, $ev, $x, $y) = @_;
2865 3979
2866 if ($ev->{button} == $self->{button}) { 3980 if ($ev->{button} == $self->{button}) {
2867 undef $GRAB; 3981 undef $GRAB;
2868 $self->hide; 3982 $self->hide;
2869 3983
2870 $self->_emit ("popdown"); 3984 $self->emit ("popdown");
2871 $self->{hover}[1]->() if $self->{hover}; 3985 $self->{hover}[1]->() if $self->{hover};
3986 } else {
3987 return 0
3988 }
3989
2872 } 3990 1
2873} 3991}
2874 3992
2875############################################################################# 3993#############################################################################
2876 3994
2877package CFClient::UI::Statusbox; 3995package DC::UI::Multiplexer;
2878 3996
2879our @ISA = CFClient::UI::VBox::; 3997our @ISA = DC::UI::Container::;
2880 3998
2881sub new { 3999sub new {
2882 my $class = shift; 4000 my $class = shift;
2883 4001
2884 $class->SUPER::new ( 4002 my $self = $class->SUPER::new (
4003 @_,
4004 );
4005
4006 $self->set_current_page (0);
4007
4008 $self
4009}
4010
4011sub add {
4012 my ($self, @widgets) = @_;
4013
4014 $self->SUPER::add (@widgets);
4015
4016 $self->set_current_page (0)
4017 if @widgets == @{ $self->{children} };
4018}
4019
4020sub get_current_page {
4021 my ($self) = @_;
4022
4023 $self->{current}
4024}
4025
4026sub set_current_page {
4027 my ($self, $page_or_widget) = @_;
4028
4029 my $widget = ref $page_or_widget
4030 ? $page_or_widget
4031 : $self->{children}[$page_or_widget];
4032
4033 $self->{current}->set_invisible if $self->{current} && $self->{visible};
4034
4035 if (($self->{current} = $widget)) {
4036 $self->{current}->set_visible if $self->{current} && $self->{visible};
4037 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
4038
4039 $self->emit (page_changed => $self->{current});
4040 }
4041
4042 $self->realloc;
4043}
4044
4045sub visible_children {
4046 $_[0]{current} || ()
4047}
4048
4049sub size_request {
4050 my ($self) = @_;
4051
4052 $self->{current}
4053 ? $self->{current}->size_request
4054 : (0, 0)
4055}
4056
4057sub invoke_size_allocate {
4058 my ($self, $w, $h) = @_;
4059
4060 $self->{current}->configure (0, 0, $w, $h)
4061 if $self->{current};
4062
4063 1
4064}
4065
4066sub _draw {
4067 my ($self) = @_;
4068
4069 $self->{current}->draw
4070 if $self->{current};
4071}
4072
4073#############################################################################
4074
4075package DC::UI::Notebook;
4076
4077use DC::OpenGL;
4078
4079our @ISA = DC::UI::VBox::;
4080
4081sub new {
4082 my $class = shift;
4083
4084 my $self = $class->SUPER::new (
4085 buttonbar => (new DC::UI::Buttonbar),
4086 multiplexer => (new DC::UI::Multiplexer expand => 1),
4087 active_outline => [.7, .7, 0.2],
4088 # filter => # will be put between multiplexer and $self
4089 @_,
4090 );
4091
4092 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
4093 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
4094
4095 {
4096 Scalar::Util::weaken (my $wself = $self);
4097
4098 $self->{multiplexer}->connect (c_add => sub {
4099 my ($mplex, $widgets) = @_;
4100
4101 for my $child (@$widgets) {
4102 Scalar::Util::weaken $child;
4103 $child->{c_tab_} ||= do {
4104 my $tab =
4105 (UNIVERSAL::isa $child->{c_tab}, "DC::UI::Base")
4106 ? $child->{c_tab}
4107 : new DC::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
4108
4109 $tab->connect (activate => sub {
4110 $wself->set_current_page ($child);
4111 });
4112
4113 $tab
4114 };
4115
4116 $self->{buttonbar}->add ($child->{c_tab_});
4117 }
4118 });
4119
4120 $self->{multiplexer}->connect (c_remove => sub {
4121 my ($mplex, $widgets) = @_;
4122
4123 for my $child (@$widgets) {
4124 $wself->{buttonbar}->remove ($child->{c_tab_});
4125 }
4126 });
4127 }
4128
4129 $self
4130}
4131
4132sub add {
4133 my ($self, @widgets) = @_;
4134
4135 $self->{multiplexer}->add (@widgets)
4136}
4137
4138sub remove {
4139 my ($self, @widgets) = @_;
4140
4141 $self->{multiplexer}->remove (@widgets)
4142}
4143
4144sub pages {
4145 my ($self) = @_;
4146 $self->{multiplexer}->children
4147}
4148
4149sub page_index {
4150 my ($self, $widget) = @_;
4151
4152 my $i = 0;
4153 for ($self->pages) {
4154 if ($_ eq $widget) { return $i };
4155 $i++;
4156 }
4157
4158 undef
4159}
4160
4161sub add_tab {
4162 my ($self, $title, $widget, $tooltip) = @_;
4163
4164 $title = [$title, $tooltip] unless ref $title;
4165 $widget->{c_tab} = $title;
4166
4167 $self->add ($widget);
4168}
4169
4170sub get_current_page {
4171 my ($self) = @_;
4172
4173 $self->{multiplexer}->get_current_page
4174}
4175
4176sub set_current_page {
4177 my ($self, $page) = @_;
4178
4179 $self->{multiplexer}->set_current_page ($page);
4180 $self->emit (page_changed => $self->{multiplexer}{current});
4181}
4182
4183sub _draw {
4184 my ($self) = @_;
4185
4186 $self->SUPER::_draw ();
4187
4188 if (my $cur = $self->{multiplexer}{current}) {
4189 if ($cur = $cur->{c_tab_}) {
4190 glTranslate $self->{buttonbar}{x} + $cur->{x},
4191 $self->{buttonbar}{y} + $cur->{y};
4192 glLineWidth 3;
4193 #glEnable GL_BLEND;
4194 #glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
4195 glColor @{$self->{active_outline}};
4196 glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
4197 glLineWidth 1;
4198 #glDisable GL_BLEND;
4199 }
4200 }
4201}
4202
4203#############################################################################
4204
4205package DC::UI::Selector;
4206
4207use utf8;
4208
4209our @ISA = DC::UI::Button::;
4210
4211sub new {
4212 my $class = shift;
4213
4214 my $self = $class->SUPER::new (
4215 options => [], # [value, title, longdesc], ...
4216 value => undef,
4217 @_,
4218 );
4219
4220 $self->_set_value ($self->{value});
4221
4222 $self
4223}
4224
4225sub invoke_button_down {
4226 my ($self, $ev) = @_;
4227
4228 my @menu_items;
4229
4230 for (@{ $self->{options} }) {
4231 my ($value, $title, $tooltip) = @$_;
4232
4233 push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
4234 }
4235
4236 DC::UI::Menu->new (items => \@menu_items)->popup ($ev);
4237}
4238
4239sub _set_value {
4240 my ($self, $value) = @_;
4241
4242 my ($item) = grep $_->[0] eq $value, @{ $self->{options} };
4243 $item ||= $self->{options}[0]
4244 or return;
4245
4246 $self->{value} = $item->[0];
4247 $self->set_markup ("$item->[1] ⇓");
4248# $self->set_tooltip ($item->[2]);
4249}
4250
4251sub set_value {
4252 my ($self, $value) = @_;
4253
4254 return unless $self->{value} ne $value;
4255
4256 $self->_set_value ($value);
4257 $self->emit (changed => $value);
4258}
4259
4260sub set_options {
4261 my ($self, $options) = @_;
4262
4263 $self->{options} = $options;
4264 $self->_set_value ($self->{value});
4265}
4266
4267#############################################################################
4268
4269package DC::UI::Statusbox;
4270
4271our @ISA = DC::UI::VBox::;
4272
4273sub new {
4274 my $class = shift;
4275
4276 my $self = $class->SUPER::new (
2885 fontsize => 0.8, 4277 fontsize => 0.8,
2886 @_, 4278 @_,
2887 ) 4279 );
4280
4281 DC::weaken (my $this = $self);
4282
4283 $self->{timer} = EV::timer 1, 1, sub { $this->reorder };
4284
4285 $self
2888} 4286}
2889 4287
2890sub reorder { 4288sub reorder {
2891 my ($self) = @_; 4289 my ($self) = @_;
2892 my $NOW = time; 4290 my $NOW = EV::time;
4291
4292 # freeze display when hovering over any label
4293 return if $DC::UI::TOOLTIP->{owner}
4294 && grep $DC::UI::TOOLTIP->{owner} == $_->{label},
4295 values %{ $self->{item} };
2893 4296
2894 while (my ($k, $v) = each %{ $self->{item} }) { 4297 while (my ($k, $v) = each %{ $self->{item} }) {
2895 delete $self->{item}{$k} if $v->{timeout} < $NOW; 4298 delete $self->{item}{$k} if $v->{timeout} < $NOW;
2896 } 4299 }
4300
4301 $self->{timer}->set (1, 1);
2897 4302
2898 my @widgets; 4303 my @widgets;
2899 4304
2900 my @items = sort { 4305 my @items = sort {
2901 $a->{pri} <=> $b->{pri} 4306 $a->{pri} <=> $b->{pri}
… …
2904 4309
2905 my $count = 10 + 1; 4310 my $count = 10 + 1;
2906 for my $item (@items) { 4311 for my $item (@items) {
2907 last unless --$count; 4312 last unless --$count;
2908 4313
2909 push @widgets, $item->{label} ||= do { 4314 my $label = $item->{label} ||= do {
2910 # TODO: doesn't handle markup well (read as: at all) 4315 # TODO: doesn't handle markup well (read as: at all)
2911 my $short = $item->{count} > 1 4316 my $short = $item->{count} > 1
2912 ? "<b>$item->{count} ×</b> $item->{text}" 4317 ? "<b>$item->{count} ×</b> $item->{text}"
2913 : $item->{text}; 4318 : $item->{text};
2914 4319
2915 for ($short) { 4320 for ($short) {
2916 s/^\s+//; 4321 s/^\s+//;
2917 s/\s+/ /g; 4322 s/\s+/ /g;
2918 } 4323 }
2919 4324
2920 new CFClient::UI::Label 4325 new DC::UI::Label
2921 markup => $short, 4326 markup => $short,
2922 tooltip => $item->{tooltip}, 4327 tooltip => $item->{tooltip},
2923 tooltip_font => $::FONT_PROP, 4328 tooltip_font => $::FONT_PROP,
2924 tooltip_width => 0.67, 4329 tooltip_width => 0.67,
2925 fontsize => $item->{fontsize} || $self->{fontsize}, 4330 fontsize => $item->{fontsize} || $self->{fontsize},
2926 max_w => $::WIDTH * 0.44, 4331 max_w => $::WIDTH * 0.44,
4332 align => 0,
2927 fg => $item->{fg}, 4333 fg => [@{ $item->{fg} }],
2928 can_events => 1, 4334 can_events => 1,
2929 can_hover => 1 4335 can_hover => 1
2930 }; 4336 };
4337
4338 if ((my $diff = $item->{timeout} - $NOW) < 2) {
4339 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
4340 $label->update;
4341 $label->set_max_size (undef, $label->{req_h} * $diff)
4342 if $diff < 1;
4343 $self->{timer}->set (1/30, 1/30);
4344 } else {
4345 $label->{fg}[3] = $item->{fg}[3] || 1;
4346 }
4347
4348 push @widgets, $label;
2931 } 4349 }
4350
4351 my $hash = join ",", @widgets;
4352 return if $hash eq $self->{last_widget_hash};
4353 $self->{last_widget_hash} = $hash;
2932 4354
2933 $self->clear; 4355 $self->clear;
2934 $self->SUPER::add (reverse @widgets); 4356 $self->SUPER::add (reverse @widgets);
2935} 4357}
2936 4358
… …
2940 $text =~ s/^\s+//; 4362 $text =~ s/^\s+//;
2941 $text =~ s/\s+$//; 4363 $text =~ s/\s+$//;
2942 4364
2943 return unless $text; 4365 return unless $text;
2944 4366
2945 my $timeout = time + ((delete $arg{timeout}) || 60); 4367 my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2946 4368
2947 my $group = exists $arg{group} ? $arg{group} : ++$self->{id}; 4369 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2948 4370
2949 if (my $item = $self->{item}{$group}) { 4371 if (my $item = $self->{item}{$group}) {
2950 if ($item->{text} eq $text) { 4372 if ($item->{text} eq $text) {
2951 $item->{count}++; 4373 $item->{count}++;
2952 } else { 4374 } else {
2953 $item->{count} = 1; 4375 $item->{count} = 1;
2954 $item->{text} = $item->{tooltip} = $text; 4376 $item->{text} = $item->{tooltip} = $text;
2955 } 4377 }
2956 $item->{id} = ++$self->{id}; 4378 $item->{id} += 0.2;#d#
2957 $item->{timeout} = $timeout; 4379 $item->{timeout} = $timeout;
2958 delete $item->{label}; 4380 delete $item->{label};
2959 } else { 4381 } else {
2960 $self->{item}{$group} = { 4382 $self->{item}{$group} = {
2961 id => ++$self->{id}, 4383 id => ++$self->{id},
… …
2967 count => 1, 4389 count => 1,
2968 %arg, 4390 %arg,
2969 }; 4391 };
2970 } 4392 }
2971 4393
4394 $ROOT->on_refresh (reorder => sub {
2972 $self->reorder; 4395 $self->reorder;
4396 });
2973} 4397}
2974 4398
2975sub reconfigure { 4399sub reconfigure {
2976 my ($self) = @_; 4400 my ($self) = @_;
2977 4401
… …
2980 4404
2981 $self->reorder; 4405 $self->reorder;
2982 $self->SUPER::reconfigure; 4406 $self->SUPER::reconfigure;
2983} 4407}
2984 4408
4409sub destroy {
4410 my ($self) = @_;
4411
4412 $self->{timer}->cancel;
4413
4414 $self->SUPER::destroy;
4415}
4416
2985############################################################################# 4417#############################################################################
2986 4418
2987package CFClient::UI::Inventory;
2988
2989our @ISA = CFClient::UI::ScrolledWindow::;
2990
2991sub new {
2992 my $class = shift;
2993
2994 my $self = $class->SUPER::new (
2995 scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2996 @_,
2997 );
2998
2999 $self
3000}
3001
3002sub set_items {
3003 my ($self, $items) = @_;
3004
3005 $self->{scrolled}->clear;
3006 return unless $items;
3007
3008 my @items = sort {
3009 ($a->{type} <=> $b->{type})
3010 or ($a->{name} cmp $b->{name})
3011 } @$items;
3012
3013 $self->{real_items} = \@items;
3014
3015 my $row = 0;
3016 for my $item (@items) {
3017 CFClient::Item::update_widgets $item;
3018
3019 $self->{scrolled}->add (0, $row, $item->{face_widget});
3020 $self->{scrolled}->add (1, $row, $item->{desc_widget});
3021 $self->{scrolled}->add (2, $row, $item->{weight_widget});
3022
3023 $row++;
3024 }
3025}
3026
3027#############################################################################
3028
3029package CFClient::UI::BindEditor;
3030
3031our @ISA = CFClient::UI::FancyFrame::;
3032
3033sub new {
3034 my $class = shift;
3035
3036 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3037
3038 $self->add (my $vb = new CFClient::UI::VBox);
3039
3040
3041 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3042 text => "start recording",
3043 tooltip => "Start/Stops recording of actions."
3044 ."All subsequent actions after the recording started will be captured."
3045 ."The actions are displayed after the record was stopped."
3046 ."To bind the action you have to click on the 'Bind' button",
3047 on_activate => sub {
3048 unless ($self->{recording}) {
3049 $self->start;
3050 } else {
3051 $self->stop;
3052 }
3053 });
3054
3055 $vb->add (new CFClient::UI::Label text => "Actions:");
3056 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3057
3058 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3059 $vb->add (my $hb = new CFClient::UI::HBox);
3060 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3061 $hb->add (new CFClient::UI::Button
3062 text => "bind",
3063 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3064 on_activate => sub {
3065 $self->ask_for_bind;
3066 });
3067
3068 $vb->add (my $hb = new CFClient::UI::HBox);
3069 $hb->add (new CFClient::UI::Button
3070 text => "ok",
3071 expand => 1,
3072 tooltip => "This closes the binding editor and saves the binding",
3073 on_activate => sub {
3074 $self->hide;
3075 $self->commit;
3076 });
3077
3078 $hb->add (new CFClient::UI::Button
3079 text => "cancel",
3080 expand => 1,
3081 tooltip => "This closes the binding editor without saving",
3082 on_activate => sub {
3083 $self->hide;
3084 $self->{binding_cancel}->()
3085 if $self->{binding_cancel};
3086 });
3087
3088 $self->update_binding_widgets;
3089
3090 $self
3091}
3092
3093sub commit {
3094 my ($self) = @_;
3095 my ($mod, $sym, $cmds) = $self->get_binding;
3096 if ($sym != 0 && @$cmds > 0) {
3097 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3098 ."'. Don't forget 'Save Config'!");
3099 $self->{binding_change}->($mod, $sym, $cmds)
3100 if $self->{binding_change};
3101 } else {
3102 $::STATUSBOX->add ("No action bound, no key or action specified!");
3103 $self->{binding_cancel}->()
3104 if $self->{binding_cancel};
3105 }
3106}
3107
3108sub start {
3109 my ($self) = @_;
3110
3111 $self->{rec_btn}->set_text ("stop recording");
3112 $self->{recording} = 1;
3113 $self->clear_command_list;
3114 $::CONN->start_record if $::CONN;
3115}
3116
3117sub stop {
3118 my ($self) = @_;
3119
3120 $self->{rec_btn}->set_text ("start recording");
3121 $self->{recording} = 0;
3122
3123 my $rec;
3124 $rec = $::CONN->stop_record if $::CONN;
3125 return unless ref $rec eq 'ARRAY';
3126 $self->set_command_list ($rec);
3127}
3128
3129# if $commit is true, the binding will be set after the user entered a key combo
3130sub ask_for_bind {
3131 my ($self, $commit) = @_;
3132
3133 CFClient::Binder::open_binding_dialog (sub {
3134 my ($mod, $sym) = @_;
3135 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3136 $self->update_binding_widgets;
3137 $self->commit if $commit;
3138 });
3139}
3140
3141# $mod and $sym are the modifiers and key symbol
3142# $cmds is a array ref of strings (the commands)
3143# $cb is the callback that is executed on OK
3144# $ccb is the callback that is executed on CANCEL and
3145# when the binding was unsuccessful on OK
3146sub set_binding {
3147 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3148
3149 $self->clear_command_list;
3150 $self->{recording} = 0;
3151 $self->{rec_btn}->set_text ("start recording");
3152
3153 $self->{binding} = [$mod, $sym];
3154 $self->{commands} = $cmds;
3155
3156 $self->{binding_change} = $cb;
3157 $self->{binding_cancel} = $ccb;
3158
3159 $self->update_binding_widgets;
3160}
3161
3162# this is a shortcut method that asks for a binding
3163# and then just binds it.
3164sub do_quick_binding {
3165 my ($self, $cmds) = @_;
3166 $self->set_binding (undef, undef, $cmds, sub {
3167 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3168 });
3169 $self->ask_for_bind (1);
3170}
3171
3172sub update_binding_widgets {
3173 my ($self) = @_;
3174 my ($mod, $sym, $cmds) = $self->get_binding;
3175 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3176 $self->set_command_list ($cmds);
3177}
3178
3179sub get_binding {
3180 my ($self) = @_;
3181 return (
3182 $self->{binding}->[0],
3183 $self->{binding}->[1],
3184 [ grep { defined $_ } @{$self->{commands}} ]
3185 );
3186}
3187
3188sub clear_command_list {
3189 my ($self) = @_;
3190 $self->{cmdbox}->clear ();
3191}
3192
3193sub set_command_list {
3194 my ($self, $cmds) = @_;
3195
3196 $self->{cmdbox}->clear ();
3197 $self->{commands} = $cmds;
3198
3199 my $idx = 0;
3200
3201 for (@$cmds) {
3202 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3203
3204 my $i = $idx;
3205 $hb->add (new CFClient::UI::Label text => $_);
3206 $hb->add (new CFClient::UI::Button
3207 text => "delete",
3208 tooltip => "Deletes the action from the record",
3209 on_activate => sub {
3210 $self->{cmdbox}->remove ($hb);
3211 $cmds->[$i] = undef;
3212 });
3213
3214
3215 $idx++
3216 }
3217}
3218
3219#############################################################################
3220
3221package CFClient::UI::SpellList;
3222
3223our @ISA = CFClient::UI::FancyFrame::;
3224
3225sub new {
3226 my $class = shift;
3227
3228 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3229
3230 $self->add (new CFClient::UI::ScrolledWindow
3231 scrolled => $self->{spellbox} = new CFClient::UI::Table);
3232
3233 $self;
3234}
3235
3236# XXX: Do sorting? Argl...
3237sub add_spell {
3238 my ($self, $spell) = @_;
3239 $self->{spells}->{$spell->{name}} = $spell;
3240
3241 $self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3242 face => $spell->{face},
3243 can_hover => 1,
3244 can_events => 1,
3245 tooltip => $spell->{message});
3246
3247 $self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3248 text => $spell->{name},
3249 can_hover => 1,
3250 can_events => 1,
3251 tooltip => $spell->{message},
3252 expand => 1);
3253
3254 $self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3255 text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3256 $spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3257 expand => 1);
3258
3259 $self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3260 text => "bind to key",
3261 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3262}
3263
3264sub rebuild_spell_list {
3265 my ($self) = @_;
3266 $self->{tbl_idx} = 0;
3267 $self->add_spell ($_) for values %{$self->{spells}};
3268}
3269
3270sub remove_spell {
3271 my ($self, $spell) = @_;
3272 delete $self->{spells}->{$spell->{name}};
3273 $self->rebuild_spell_list;
3274}
3275
3276#############################################################################
3277
3278package CFClient::UI::Root; 4419package DC::UI::Root;
3279 4420
3280our @ISA = CFClient::UI::Container::; 4421our @ISA = DC::UI::Container::;
3281 4422
4423use List::Util qw(min max);
4424
3282use CFClient::OpenGL; 4425use DC::OpenGL;
3283 4426
3284sub new { 4427sub new {
3285 my $class = shift; 4428 my $class = shift;
3286 4429
3287 my $self = $class->SUPER::new ( 4430 my $self = $class->SUPER::new (
3288 visible => 1, 4431 visible => 1,
3289 @_, 4432 @_,
3290 ); 4433 );
3291 4434
3292 Scalar::Util::weaken ($self->{root} = $self); 4435 DC::weaken ($self->{root} = $self);
3293 4436
3294 $self 4437 $self
3295} 4438}
3296 4439
3297sub size_request { 4440sub size_request {
… …
3312 $coord = $max - $size if $coord > $max - $size; 4455 $coord = $max - $size if $coord > $max - $size;
3313 4456
3314 int $coord + 0.5 4457 int $coord + 0.5
3315} 4458}
3316 4459
3317sub size_allocate { 4460sub invoke_size_allocate {
3318 my ($self, $w, $h) = @_; 4461 my ($self, $w, $h) = @_;
3319 4462
3320 for my $child ($self->children) { 4463 for my $child ($self->children) {
3321 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)}; 4464 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3322 4465
… …
3326 $X = _to_pixel $X, $W, $self->{w}; 4469 $X = _to_pixel $X, $W, $self->{w};
3327 $Y = _to_pixel $Y, $H, $self->{h}; 4470 $Y = _to_pixel $Y, $H, $self->{h};
3328 4471
3329 $child->configure ($X, $Y, $W, $H); 4472 $child->configure ($X, $Y, $W, $H);
3330 } 4473 }
4474
4475 1
3331} 4476}
3332 4477
3333sub coord2local { 4478sub coord2local {
3334 my ($self, $x, $y) = @_; 4479 my ($self, $x, $y) = @_;
3335 4480
… …
3343} 4488}
3344 4489
3345sub update { 4490sub update {
3346 my ($self) = @_; 4491 my ($self) = @_;
3347 4492
3348 $::WANT_REFRESH++; 4493 $::WANT_REFRESH = 1;
3349} 4494}
3350 4495
3351sub add { 4496sub add {
3352 my ($self, @children) = @_; 4497 my ($self, @children) = @_;
3353 4498
… …
3390 while ($self->{refresh_hook}) { 4535 while ($self->{refresh_hook}) {
3391 $_->() 4536 $_->()
3392 for values %{delete $self->{refresh_hook}}; 4537 for values %{delete $self->{refresh_hook}};
3393 } 4538 }
3394 4539
3395 if ($self->{realloc}) { 4540 while ($self->{realloc}) {
3396 my %queue; 4541 my %queue;
3397 my @queue; 4542 my @queue;
3398 my $widget; 4543 my $widget;
3399 4544
3400 outer: 4545 outer:
… …
3420 4565
3421 delete $queue{$widget+0}; 4566 delete $queue{$widget+0};
3422 4567
3423 my ($w, $h) = $widget->size_request; 4568 my ($w, $h) = $widget->size_request;
3424 4569
3425 $w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2; 4570 $w += $widget->{padding_x} * 2;
3426 $h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2; 4571 $h += $widget->{padding_y} * 2;
4572
4573 $w = max $widget->{min_w}, $w;
4574 $h = max $widget->{min_h}, $h;
4575
4576 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
4577 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3427 4578
3428 $w = $widget->{force_w} if exists $widget->{force_w}; 4579 $w = $widget->{force_w} if exists $widget->{force_w};
3429 $h = $widget->{force_h} if exists $widget->{force_h}; 4580 $h = $widget->{force_h} if exists $widget->{force_h};
3430 4581
3431 if ($widget->{req_w} != $w || $widget->{req_h} != $h 4582 if ($widget->{req_w} != $w || $widget->{req_h} != $h
… …
3444 } 4595 }
3445 } 4596 }
3446 4597
3447 delete $self->{realloc}{$widget+0}; 4598 delete $self->{realloc}{$widget+0};
3448 } 4599 }
3449 }
3450 4600
3451 while (my $size_alloc = delete $self->{size_alloc}) { 4601 while (my $size_alloc = delete $self->{size_alloc}) {
3452 my @queue = sort { $b->{visible} <=> $a->{visible} } 4602 my @queue = sort { $a->{visible} <=> $b->{visible} }
3453 values %$size_alloc; 4603 values %$size_alloc;
3454 4604
3455 while () { 4605 while () {
3456 my $widget = pop @queue || last; 4606 my $widget = pop @queue || last;
3457 4607
3458 my ($w, $h) = @$widget{qw(alloc_w alloc_h)}; 4608 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3459 4609
3460 $w = 0 if $w < 0; 4610 $w = max $widget->{min_w}, $w;
3461 $h = 0 if $h < 0; 4611 $h = max $widget->{min_h}, $h;
3462 4612
4613# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
4614# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
4615
4616 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
4617 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
4618
3463 $w = int $w + 0.5; 4619 $w = int $w + 0.5;
3464 $h = int $h + 0.5; 4620 $h = int $h + 0.5;
3465 4621
3466 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) { 4622 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3467 $widget->{old_w} = $widget->{w}; 4623 $widget->{old_w} = $widget->{w};
3468 $widget->{old_h} = $widget->{h}; 4624 $widget->{old_h} = $widget->{h};
3469 4625
3470 $widget->{w} = $w; 4626 $widget->{w} = $w;
3471 $widget->{h} = $h; 4627 $widget->{h} = $h;
3472 4628
3473 $widget->emit (size_allocate => $w, $h); 4629 $widget->emit (size_allocate => $w, $h);
4630 }
3474 } 4631 }
3475 } 4632 }
3476 } 4633 }
3477 4634
3478 while ($self->{post_alloc_hook}) { 4635 while ($self->{post_alloc_hook}) {
3479 $_->() 4636 $_->()
3480 for values %{delete $self->{post_alloc_hook}}; 4637 for values %{delete $self->{post_alloc_hook}};
3481 } 4638 }
3482
3483 4639
3484 glViewport 0, 0, $::WIDTH, $::HEIGHT; 4640 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3485 glClearColor +($::CFG->{fow_intensity}) x 3, 1; 4641 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3486 glClear GL_COLOR_BUFFER_BIT; 4642 glClear GL_COLOR_BUFFER_BIT;
3487 4643
… …
3490 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000; 4646 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3491 glMatrixMode GL_MODELVIEW; 4647 glMatrixMode GL_MODELVIEW;
3492 glLoadIdentity; 4648 glLoadIdentity;
3493 4649
3494 { 4650 {
3495 package CFClient::UI::Base; 4651 package DC::UI::Base;
3496 4652
3497 ($draw_x, $draw_y, $draw_w, $draw_h) = 4653 local ($draw_x, $draw_y, $draw_w, $draw_h) =
3498 (0, 0, $self->{w}, $self->{h}); 4654 (0, 0, $self->{w}, $self->{h});
3499 }
3500 4655
3501 $self->_draw; 4656 $self->_draw;
4657 }
3502} 4658}
3503 4659
3504############################################################################# 4660#############################################################################
3505 4661
3506package CFClient::UI; 4662package DC::UI;
3507 4663
3508$ROOT = new CFClient::UI::Root; 4664$ROOT = new DC::UI::Root;
3509$TOOLTIP = new CFClient::UI::Tooltip z => 900; 4665$TOOLTIP = new DC::UI::Tooltip z => 900;
3510 4666
35111 46671
3512

Diff Legend

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