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.67 by root, Tue Apr 11 14:36:59 2006 UTC vs.
Revision 1.292 by root, Tue Jun 6 03:02:15 2006 UTC

1package CFClient::Widget; 1package CFClient::UI;
2 2
3use utf8;
3use strict; 4use strict;
4 5
5use Scalar::Util; 6use Scalar::Util ();
6 7use List::Util ();
7use SDL::OpenGL; 8use Event;
8use SDL::OpenGL::Constants;
9 9
10use CFClient; 10use CFClient;
11use CFClient::Texture;
11 12
12our ($FOCUS, $HOVER, $GRAB); # various widgets 13our ($FOCUS, $HOVER, $GRAB); # various widgets
13 14
14our $TOPLEVEL; 15our $LAYOUT;
16our $ROOT;
17our $TOOLTIP;
15our $BUTTON_STATE; 18our $BUTTON_STATE;
19
20our %WIDGET; # all widgets, weak-referenced
21
22our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
23 if (!$GRAB) {
24 for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
25 if (length $widget->{tooltip}) {
26 if ($TOOLTIP->{owner} != $widget) {
27 $TOOLTIP->hide;
28
29 $TOOLTIP->{owner} = $widget;
30
31 return if $ENV{CFPLUS_DEBUG} & 8;
32
33 my $tip = $widget->{tooltip};
34
35 $tip = $tip->($widget) if CODE:: eq ref $tip;
36
37 $TOOLTIP->set_tooltip_from ($widget);
38 $TOOLTIP->show;
39 }
40
41 return;
42 }
43 }
44 }
45
46 $TOOLTIP->hide;
47 delete $TOOLTIP->{owner};
48});
49
50sub get_layout {
51 my $layout;
52
53 for (grep { $_->{name} } values %WIDGET) {
54 my $win = $layout->{$_->{name}} = { };
55
56 $win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
57 $win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
58 $win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
59 $win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
60
61 $win->{show} = $_->{visible} && $_->{is_toplevel};
62 }
63
64 $layout
65}
66
67sub set_layout {
68 my ($layout) = @_;
69
70 $LAYOUT = $layout;
71}
16 72
17# class methods for events 73# class methods for events
18sub feed_sdl_key_down_event { 74sub feed_sdl_key_down_event {
19 $FOCUS->key_down ($_[0]) if $FOCUS; 75 $FOCUS->emit (key_down => $_[0])
76 if $FOCUS;
20} 77}
21 78
22sub feed_sdl_key_up_event { 79sub feed_sdl_key_up_event {
23 $FOCUS->key_up ($_[0]) if $FOCUS; 80 $FOCUS->emit (key_up => $_[0])
81 if $FOCUS;
24} 82}
25 83
26sub feed_sdl_button_down_event { 84sub feed_sdl_button_down_event {
27 my ($ev) = @_; 85 my ($ev) = @_;
28 my ($x, $y) = ($ev->motion_x, $ev->motion_y); 86 my ($x, $y) = ($ev->{x}, $ev->{y});
29 87
30 if (!$BUTTON_STATE) { 88 if (!$BUTTON_STATE) {
31 my $widget = $TOPLEVEL->find_widget ($x, $y); 89 my $widget = $ROOT->find_widget ($x, $y);
32 90
33 $GRAB = $widget; 91 $GRAB = $widget;
34 $GRAB->update if $GRAB; 92 $GRAB->update if $GRAB;
35 }
36 93
94 $TOOLTIP_WATCHER->cb->();
95 }
96
37 $BUTTON_STATE |= 1 << ($ev->button - 1); 97 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
38 98
39 $GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB; 99 $GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
100 if $GRAB;
40} 101}
41 102
42sub feed_sdl_button_up_event { 103sub feed_sdl_button_up_event {
43 my ($ev) = @_; 104 my ($ev) = @_;
44 my ($x, $y) = ($ev->motion_x, $ev->motion_y); 105 my ($x, $y) = ($ev->{x}, $ev->{y});
45 106
46 my $widget = $GRAB || $TOPLEVEL->find_widget ($x, $y); 107 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
47 108
48 $BUTTON_STATE &= ~(1 << ($ev->button - 1)); 109 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
49 110
50 $GRAB->button_down ($ev, $GRAB->translate ($x, $y)) if $GRAB; 111 $GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
112 if $GRAB;
51 113
52 if (!$BUTTON_STATE) { 114 if (!$BUTTON_STATE) {
53 my $grab = $GRAB; undef $GRAB; 115 my $grab = $GRAB; undef $GRAB;
54 $grab->update if $grab; 116 $grab->update if $grab;
55 $GRAB->update if $GRAB; 117 $GRAB->update if $GRAB;
118
119 $TOOLTIP_WATCHER->cb->();
56 } 120 }
57} 121}
58 122
59sub feed_sdl_motion_event { 123sub feed_sdl_motion_event {
60 my ($ev) = @_; 124 my ($ev) = @_;
61 my ($x, $y) = ($ev->motion_x, $ev->motion_y); 125 my ($x, $y) = ($ev->{x}, $ev->{y});
62 126
63 my $widget = $GRAB || $TOPLEVEL->find_widget ($x, $y); 127 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
64 128
65 if ($widget != $HOVER) { 129 if ($widget != $HOVER) {
66 my $hover = $HOVER; $HOVER = $widget; 130 my $hover = $HOVER; $HOVER = $widget;
67 131
68 $hover->update if $hover; 132 $hover->update if $hover && $hover->{can_hover};
69 $HOVER->update if $HOVER; 133 $HOVER->update if $HOVER && $HOVER->{can_hover};
70 }
71 134
72 $HOVER->mouse_motion ($ev, $HOVER->translate ($x, $y)) if $HOVER; 135 $TOOLTIP_WATCHER->start;
136 }
137
138 $HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
139 if $HOVER;
73} 140}
141
142# convert position array to integers
143sub harmonize {
144 my ($vals) = @_;
145
146 my $rem = 0;
147
148 for (@$vals) {
149 my $i = int $_ + $rem;
150 $rem += $_ - $i;
151 $_ = $i;
152 }
153}
154
155sub full_refresh {
156 # make a copy, otherwise for complains about freed values.
157 my @widgets = values %WIDGET;
158
159 $_->update
160 for @widgets;
161}
162
163sub reconfigure_widgets {
164 # make a copy, otherwise C<for> complains about freed values.
165 my @widgets = values %WIDGET;
166
167 $_->reconfigure
168 for @widgets;
169}
170
171# call when resolution changes etc.
172sub rescale_widgets {
173 my ($sx, $sy) = @_;
174
175 for my $widget (values %WIDGET) {
176 if ($widget->{is_toplevel}) {
177 $widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
178 $widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
179
180 $widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
181 $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
182 $widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
183 $widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
184 $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
185 $widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
186
187 $widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
188 $widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
189
190 }
191 }
192
193 reconfigure_widgets;
194}
195
196#############################################################################
197
198package CFClient::UI::Base;
199
200use strict;
201
202use CFClient::OpenGL;
74 203
75sub new { 204sub new {
76 my $class = shift; 205 my $class = shift;
77 206
78 bless { 207 my $self = bless {
79 x => 0, 208 x => "center",
80 y => 0, 209 y => "center",
81 z => 0, 210 z => 0,
211 w => undef,
212 h => undef,
213 can_events => 1,
82 @_ 214 @_
83 }, $class 215 }, $class;
84}
85 216
217 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
218
219 for (keys %$self) {
220 if (/^on_(.*)$/) {
221 $self->connect ($1 => delete $self->{$_});
222 }
223 }
224
225 if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
226 $self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
227 $self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
228 $self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
229 $self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
230
231 $self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
232 $self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
233
234 $self->show if $layout->{show};
235 }
236
237 $self
238}
239
240sub destroy {
241 my ($self) = @_;
242
243 $self->hide;
244 %$self = ();
245}
246
247sub show {
248 my ($self) = @_;
249
250 return if $self->{parent};
251
252 $CFClient::UI::ROOT->add ($self);
253}
254
255sub set_visible {
256 my ($self) = @_;
257
258 return if $self->{visible};
259
260 $self->{root} = $self->{parent}{root};
261 $self->{visible} = $self->{parent}{visible} + 1;
262
263 $self->emit (visibility_change => 1);
264
265 $self->realloc if !exists $self->{req_w};
266
267 $_->set_visible for $self->children;
268}
269
270sub set_invisible {
271 my ($self) = @_;
272
273 return unless $self->{visible};
274
275 $_->set_invisible for $self->children;
276
277 delete $self->{root};
278 delete $self->{visible};
279
280 undef $GRAB if $GRAB == $self;
281 undef $HOVER if $HOVER == $self;
282
283 $CFClient::UI::TOOLTIP_WATCHER->cb->()
284 if $TOOLTIP->{owner} == $self;
285
286 $self->focus_out;
287
288 $self->emit (visibility_change => 0);
289}
290
291sub set_visibility {
292 my ($self, $visible) = @_;
293
294 return if $self->{visible} == $visible;
295
296 $visible ? $self->hide
297 : $self->show;
298}
299
300sub toggle_visibility {
301 my ($self) = @_;
302
303 $self->{visible}
304 ? $self->hide
305 : $self->show;
306}
307
308sub hide {
309 my ($self) = @_;
310
311 $self->set_invisible;
312
313 $self->{parent}->remove ($self)
314 if $self->{parent};
315}
316
86sub move { 317sub move_abs {
87 my ($self, $x, $y, $z) = @_; 318 my ($self, $x, $y, $z) = @_;
88 $self->{x} = $x; 319
89 $self->{y} = $y; 320 $self->{x} = List::Util::max 0, int $x;
321 $self->{y} = List::Util::max 0, int $y;
90 $self->{z} = $z if defined $z; 322 $self->{z} = $z if defined $z;
91}
92 323
93sub needs_redraw { 324 $self->update;
94 0 325}
326
327sub set_size {
328 my ($self, $w, $h) = @_;
329
330 $self->{force_w} = $w;
331 $self->{force_h} = $h;
332
333 $self->realloc;
95} 334}
96 335
97sub size_request { 336sub size_request {
98 require Carp; 337 require Carp;
99 Carp::confess "size_request is abtract"; 338 Carp::confess "size_request is abstract";
339}
340
341sub configure {
342 my ($self, $x, $y, $w, $h) = @_;
343
344 if ($self->{aspect}) {
345 my ($ow, $oh) = ($w, $h);
346
347 $w = List::Util::min $w, int $h * $self->{aspect};
348 $h = List::Util::min $h, int $w / $self->{aspect};
349
350 # use alignment to adjust x, y
351
352 $x += int 0.5 * ($ow - $w);
353 $y += int 0.5 * ($oh - $h);
354 }
355
356 if ($self->{x} ne $x || $self->{y} ne $y) {
357 $self->{x} = $x;
358 $self->{y} = $y;
359 $self->update;
360 }
361
362 if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
363 return unless $self->{visible};
364
365 $self->{alloc_w} = $w;
366 $self->{alloc_h} = $h;
367
368 $self->{root}{size_alloc}{$self+0} = $self;
369 }
100} 370}
101 371
102sub size_allocate { 372sub size_allocate {
373 # nothing to be done
374}
375
376sub children {
377 # nop
378}
379
380sub visible_children {
381 $_[0]->children
382}
383
384sub set_max_size {
103 my ($self, $w, $h) = @_; 385 my ($self, $w, $h) = @_;
104 386
105 $self->{w} = $w; 387 $self->{max_w} = int $w if defined $w;
106 $self->{h} = $h; 388 $self->{max_h} = int $h if defined $h;
107}
108 389
390 $self->realloc;
391}
392
393sub set_tooltip {
394 my ($self, $tooltip) = @_;
395
396 $tooltip =~ s/^\s+//;
397 $tooltip =~ s/\s+$//;
398
399 return if $self->{tooltip} eq $tooltip;
400
401 $self->{tooltip} = $tooltip;
402
403 if ($CFClient::UI::TOOLTIP->{owner} == $self) {
404 delete $CFClient::UI::TOOLTIP->{owner};
405 $CFClient::UI::TOOLTIP_WATCHER->cb->();
406 }
407}
408
109# translate global koordinates to local coordinate system 409# translate global coordinates to local coordinate system
110sub translate { 410sub coord2local {
111 my ($self, $x, $y) = @_; 411 my ($self, $x, $y) = @_;
112 412
113 $self->{parent}->translate ($x - $self->{x}, $y - $self->{y}); 413 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
414}
415
416# translate local coordinates to global coordinate system
417sub coord2global {
418 my ($self, $x, $y) = @_;
419
420 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
114} 421}
115 422
116sub focus_in { 423sub focus_in {
117 my ($self) = @_; 424 my ($self) = @_;
118 425
426 return if $FOCUS == $self;
427 return unless $self->{can_focus};
428
119 my $focus = $FOCUS; $FOCUS = $self; 429 my $focus = $FOCUS; $FOCUS = $self;
430
431 $self->_emit (focus_in => $focus);
432
120 $focus->update if $focus; 433 $focus->update if $focus;
121 $FOCUS->update; 434 $FOCUS->update;
122} 435}
123 436
124sub focus_out { 437sub focus_out {
125 my ($self) = @_; 438 my ($self) = @_;
126 439
127 return unless $FOCUS == $self; 440 return unless $FOCUS == $self;
128 441
129 my $focus = $FOCUS; undef $FOCUS; 442 my $focus = $FOCUS; undef $FOCUS;
443
444 $self->_emit (focus_out => $focus);
445
130 $focus->update if $focus; #? 446 $focus->update if $focus; #?
131}
132 447
448 $::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
449 unless $FOCUS;
450}
451
133sub mouse_motion { } 452sub mouse_motion { 0 }
134sub button_up { } 453sub button_up { 0 }
454sub key_down { 0 }
455sub key_up { 0 }
456
135sub button_down { } 457sub button_down {
136sub key_down { } 458 my ($self, $ev, $x, $y) = @_;
137sub key_up { }
138 459
139sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} } 460 $self->focus_in;
140sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} } 461
141sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} } 462 0
142sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} } 463}
143sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} } 464
465sub find_widget {
466 my ($self, $x, $y) = @_;
467
468 return () unless $self->{can_events};
469
470 return $self
471 if $x >= $self->{x} && $x < $self->{x} + $self->{w}
472 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
473
474 ()
475}
476
477sub set_parent {
478 my ($self, $parent) = @_;
479
480 Scalar::Util::weaken ($self->{parent} = $parent);
481 $self->set_visible if $parent->{visible};
482}
483
484sub connect {
485 my ($self, $signal, $cb) = @_;
486
487 push @{ $self->{signal_cb}{$signal} }, $cb;
488}
489
490sub _emit {
491 my ($self, $signal, @args) = @_;
492
493 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
494}
495
496sub emit {
497 my ($self, $signal, @args) = @_;
498
499 $self->_emit ($signal, @args)
500 || $self->$signal (@args);
501}
502
503sub visibility_change {
504 #my ($self, $visible) = @_;
505}
506
507sub realloc {
508 my ($self) = @_;
509
510 if ($self->{visible}) {
511 return if $self->{root}{realloc}{$self+0};
512
513 $self->{root}{realloc}{$self+0} = $self;
514 $self->{root}->update;
515 } else {
516 delete $self->{req_w};
517 delete $self->{req_h};
518 }
519}
520
521sub update {
522 my ($self) = @_;
523
524 $self->{parent}->update
525 if $self->{parent};
526}
527
528sub reconfigure {
529 my ($self) = @_;
530
531 $self->realloc;
532 $self->update;
533}
534
535# using global variables seems a bit hacky, but passing through all drawing
536# functions seems pointless.
537our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
144 538
145sub draw { 539sub draw {
146 my ($self) = @_; 540 my ($self) = @_;
541
542 return unless $self->{h} && $self->{w};
543
544 # update screen rectangle
545 local $draw_x = $draw_x + $self->{x};
546 local $draw_y = $draw_y + $self->{y};
547 local $draw_w = $draw_x + $self->{w};
548 local $draw_h = $draw_y + $self->{h};
549
550 # skip widgets that are entirely outside the drawing area
551 return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
552 || ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
147 553
148 glPushMatrix; 554 glPushMatrix;
149 glTranslate $self->{x}, $self->{y}, 0; 555 glTranslate $self->{x}, $self->{y}, 0;
150 $self->_draw; 556
151 if ($self == $HOVER) { 557 if ($self == $HOVER && $self->{can_hover}) {
152 glColor 1, 1, 1, 0.4; 558 glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
153 glEnable GL_BLEND; 559 glEnable GL_BLEND;
560 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
154 glBegin GL_QUADS; 561 glBegin GL_QUADS;
155 glVertex 0 , 0; 562 glVertex 0 , 0;
156 glVertex $self->{w}, 0; 563 glVertex $self->{w}, 0;
157 glVertex $self->{w}, $self->{h}; 564 glVertex $self->{w}, $self->{h};
158 glVertex 0 , $self->{h}; 565 glVertex 0 , $self->{h};
159 glEnd; 566 glEnd;
160 glDisable GL_BLEND; 567 glDisable GL_BLEND;
161 } 568 }
569
570 if ($ENV{CFPLUS_DEBUG} & 1) {
571 glPushMatrix;
572 glColor 1, 1, 0, 1;
573 glTranslate 0.375, 0.375;
574 glBegin GL_LINE_LOOP;
575 glVertex 0 , 0;
576 glVertex $self->{w} - 1, 0;
577 glVertex $self->{w} - 1, $self->{h} - 1;
578 glVertex 0 , $self->{h} - 1;
579 glEnd;
580 glPopMatrix;
581 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
582 }
583
584 $self->_draw;
162 glPopMatrix; 585 glPopMatrix;
163} 586}
164 587
165sub _draw { 588sub _draw {
166 my ($self) = @_; 589 my ($self) = @_;
167 590
168 warn "no draw defined for $self\n"; 591 warn "no draw defined for $self\n";
169} 592}
170 593
171sub bbox { 594sub DESTROY {
172 my ($self) = @_; 595 my ($self) = @_;
173 my ($w, $h) = $self->size_request; 596
174 ( 597 delete $WIDGET{$self+0};
175 $self->{x}, 598 #$self->deactivate;
176 $self->{y}, 599}
177 $self->{x} = $w, 600
178 $self->{y} = $h 601#############################################################################
602
603package CFClient::UI::DrawBG;
604
605our @ISA = CFClient::UI::Base::;
606
607use strict;
608use CFClient::OpenGL;
609
610sub new {
611 my $class = shift;
612
613 # range [value, low, high, page]
614
615 $class->SUPER::new (
616 #bg => [0, 0, 0, 0.2],
617 #active_bg => [1, 1, 1, 0.5],
618 @_
179 ) 619 )
620}
621
622sub _draw {
623 my ($self) = @_;
624
625 my $color = $FOCUS == $self && $self->{active_bg}
626 ? $self->{active_bg}
627 : $self->{bg};
628
629 if ($color && (@$color < 4 || $color->[3])) {
630 my ($w, $h) = @$self{qw(w h)};
631
632 glEnable GL_BLEND;
633 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
634 glColor_premultiply @$color;
635
636 glBegin GL_QUADS;
637 glVertex 0 , 0;
638 glVertex 0 , $h;
639 glVertex $w, $h;
640 glVertex $w, 0;
641 glEnd;
642
643 glDisable GL_BLEND;
644 }
645}
646
647#############################################################################
648
649package CFClient::UI::Empty;
650
651our @ISA = CFClient::UI::Base::;
652
653sub new {
654 my ($class, %arg) = @_;
655 $class->SUPER::new (can_events => 0, %arg);
656}
657
658sub size_request {
659 my ($self) = @_;
660
661 ($self->{w} + 0, $self->{h} + 0)
662}
663
664sub draw { }
665
666#############################################################################
667
668package CFClient::UI::Container;
669
670our @ISA = CFClient::UI::Base::;
671
672sub new {
673 my ($class, %arg) = @_;
674
675 my $children = delete $arg{children};
676
677 my $self = $class->SUPER::new (
678 children => [],
679 can_events => 0,
680 %arg,
681 );
682
683 $self->add (@$children)
684 if $children;
685
686 $self
687}
688
689sub add {
690 my ($self, @widgets) = @_;
691
692 $_->set_parent ($self)
693 for @widgets;
694
695 use sort 'stable';
696
697 $self->{children} = [
698 sort { $a->{z} <=> $b->{z} }
699 @{$self->{children}}, @widgets
700 ];
701
702 $self->realloc;
703}
704
705sub children {
706 @{ $_[0]{children} }
707}
708
709sub remove {
710 my ($self, $child) = @_;
711
712 delete $child->{parent};
713 $child->hide;
714
715 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
716
717 $self->realloc;
718}
719
720sub clear {
721 my ($self) = @_;
722
723 my $children = delete $self->{children};
724 $self->{children} = [];
725
726 for (@$children) {
727 delete $_->{parent};
728 $_->hide;
729 }
730
731 $self->realloc;
180} 732}
181 733
182sub find_widget { 734sub find_widget {
183 my ($self, $x, $y) = @_; 735 my ($self, $x, $y) = @_;
184 736
185 return $self 737 $x -= $self->{x};
186 if $x >= $self->{x} && $x < $self->{x} + $self->{w} 738 $y -= $self->{y};
187 && $y >= $self->{y} && $y < $self->{y} + $self->{h};
188 739
189 () 740 my $res;
190}
191 741
192sub del_parent { $_[0]->{parent} = undef } 742 for (reverse $self->visible_children) {
743 $res = $_->find_widget ($x, $y)
744 and return $res;
745 }
193 746
194sub set_parent { 747 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
748}
749
750sub _draw {
195 my ($self, $par) = @_; 751 my ($self) = @_;
196 752
197 $self->{parent} = $par; 753 $_->draw for @{$self->{children}};
198 Scalar::Util::weaken $self->{parent};
199}
200
201sub get_parent {
202 $_[0]->{parent}
203}
204
205sub update {
206 my ($self) = @_;
207
208 $self->{parent}->update
209 if $self->{parent};
210}
211
212sub DESTROY {
213 my ($self) = @_;
214
215 #$self->deactivate;
216} 754}
217 755
218############################################################################# 756#############################################################################
219 757
220package CFClient::Widget::Empty; 758package CFClient::UI::Bin;
221 759
222our @ISA = CFClient::Widget::; 760our @ISA = CFClient::UI::Container::;
223
224sub size_request {
225 (0, 0)
226}
227
228sub draw { }
229
230#############################################################################
231
232package CFClient::Widget::Container;
233
234our @ISA = CFClient::Widget::;
235 761
236sub new { 762sub new {
237 my ($class, %arg) = @_; 763 my ($class, %arg) = @_;
238 764
239 my $children = delete $arg{children} || []; 765 my $child = (delete $arg{child}) || new CFClient::UI::Empty::;
240 766
241 my $self = $class->SUPER::new (children => [], %arg); 767 $class->SUPER::new (children => [$child], %arg)
242 $self->add ($_) for @$children;
243
244 $self
245} 768}
246 769
247sub add { 770sub add {
248 my ($self, $chld, $expand) = @_; 771 my ($self, $child) = @_;
249 772
250 $chld->{expand} = $expand;
251 $chld->set_parent ($self);
252
253 $self->{children} = [ 773 $self->{children} = [];
254 sort { $a->{z} <=> $b->{z} }
255 @{$self->{children}}, $chld
256 ]; 774
257 775 $self->SUPER::add ($child);
258 $self->size_allocate ($self->{w}, $self->{h})
259 if $self->{w}; #TODO: check for "realised state"
260} 776}
261 777
262sub remove { 778sub remove {
263 my ($self, $widget) = @_; 779 my ($self, $widget) = @_;
264 780
265 $self->{children} = [ grep $_ != $widget, @{ $self->{children} } ]; 781 $self->SUPER::remove ($widget);
266 782
267 $self->size_allocate ($self->{w}, $self->{h}); 783 $self->{children} = [new CFClient::UI::Empty]
784 unless @{$self->{children}};
785}
786
787sub child { $_[0]->{children}[0] }
788
789sub size_request {
790 $_[0]{children}[0]->size_request
791}
792
793sub size_allocate {
794 my ($self, $w, $h) = @_;
795
796 $self->{children}[0]->configure (0, 0, $w, $h);
797}
798
799#############################################################################
800
801# back-buffered drawing area
802
803package CFClient::UI::Window;
804
805our @ISA = CFClient::UI::Bin::;
806
807use CFClient::OpenGL;
808
809sub new {
810 my ($class, %arg) = @_;
811
812 my $self = $class->SUPER::new (%arg);
813}
814
815sub update {
816 my ($self) = @_;
817
818 $ROOT->on_post_alloc ($self => sub { $self->render_child });
819 $self->SUPER::update;
820}
821
822sub size_allocate {
823 my ($self, $w, $h) = @_;
824
825 $self->SUPER::size_allocate ($w, $h);
826 $self->update;
827}
828
829sub _render {
830 my ($self) = @_;
831
832 $self->{children}[0]->draw;
833}
834
835sub render_child {
836 my ($self) = @_;
837
838 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
839 glClearColor 0, 0, 0, 0;
840 glClear GL_COLOR_BUFFER_BIT;
841
842 {
843 package CFClient::UI::Base;
844
845 ($draw_x, $draw_y, $draw_w, $draw_h) =
846 (0, 0, $self->{w}, $self->{h});
847 }
848
849 $self->_render;
850 };
851}
852
853sub _draw {
854 my ($self) = @_;
855
856 my ($w, $h) = @$self{qw(w h)};
857
858 my $tex = $self->{texture}
859 or return;
860
861 glEnable GL_TEXTURE_2D;
862 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
863 glColor 0, 0, 0, 1;
864
865 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
866
867 glDisable GL_TEXTURE_2D;
868}
869
870#############################################################################
871
872package CFClient::UI::ViewPort;
873
874our @ISA = CFClient::UI::Window::;
875
876sub new {
877 my $class = shift;
878
879 $class->SUPER::new (
880 scroll_x => 0,
881 scroll_y => 1,
882 @_,
883 )
884}
885
886sub size_request {
887 my ($self) = @_;
888
889 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
890
891 $w = 10 if $self->{scroll_x};
892 $h = 10 if $self->{scroll_y};
893
894 ($w, $h)
895}
896
897sub size_allocate {
898 my ($self, $w, $h) = @_;
899
900 my $child = $self->child;
901
902 $w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
903 $h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
904
905 $self->child->configure (0, 0, $w, $h);
906 $self->update;
907}
908
909sub set_offset {
910 my ($self, $x, $y) = @_;
911
912 $self->{view_x} = int $x;
913 $self->{view_y} = int $y;
914
915 $self->update;
916}
917
918# hmm, this does not work for topleft of $self... but we should not ask for that
919sub coord2local {
920 my ($self, $x, $y) = @_;
921
922 $self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
923}
924
925sub coord2global {
926 my ($self, $x, $y) = @_;
927
928 $x = List::Util::min $self->{w}, $x - $self->{view_x};
929 $y = List::Util::min $self->{h}, $y - $self->{view_y};
930
931 $self->SUPER::coord2global ($x, $y)
268} 932}
269 933
270sub find_widget { 934sub find_widget {
271 my ($self, $x, $y) = @_; 935 my ($self, $x, $y) = @_;
272 936
937 if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
938 && $y >= $self->{y} && $y < $self->{y} + $self->{h}
939 ) {
940 $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
941 } else {
942 $self->CFClient::UI::Base::find_widget ($x, $y)
943 }
944}
945
946sub _render {
947 my ($self) = @_;
948
949 local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
950 local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
951
952 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
953
954 $self->SUPER::_render;
955}
956
957#############################################################################
958
959package CFClient::UI::ScrolledWindow;
960
961our @ISA = CFClient::UI::HBox::;
962
963sub new {
964 my ($class, %arg) = @_;
965
966 my $child = delete $arg{child};
967
968 my $self;
969
970 my $slider = new CFClient::UI::Slider
971 vertical => 1,
972 range => [0, 0, 1, 0.01], # HACK fix
973 on_changed => sub {
974 $self->{vp}->set_offset (0, $_[1]);
975 },
976 ;
977
978 $self = $class->SUPER::new (
979 vp => (new CFClient::UI::ViewPort expand => 1),
980 slider => $slider,
981 %arg,
982 );
983
984 $self->SUPER::add ($self->{vp}, $self->{slider});
985 $self->add ($child) if $child;
986
987 $self
988}
989
990sub add {
991 my ($self, $widget) = @_;
992
993 $self->{vp}->add ($self->{child} = $widget);
994}
995
996sub update {
997 my ($self) = @_;
998
999 $self->SUPER::update;
1000
1001 # todo: overwrite size_allocate of child
1002 my $child = $self->{vp}->child;
1003 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1004}
1005
1006sub size_allocate {
1007 my ($self, $w, $h) = @_;
1008
1009 $self->SUPER::size_allocate ($w, $h);
1010
1011 my $child = $self->{vp}->child;
1012 $self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1013}
1014
1015#TODO# update range on size_allocate depending on child
1016# update viewport offset on scroll
1017
1018#############################################################################
1019
1020package CFClient::UI::Frame;
1021
1022our @ISA = CFClient::UI::Bin::;
1023
1024use CFClient::OpenGL;
1025
1026sub new {
1027 my $class = shift;
1028
1029 $class->SUPER::new (
1030 bg => undef,
1031 @_,
1032 )
1033}
1034
1035sub _draw {
1036 my ($self) = @_;
1037
1038 if ($self->{bg}) {
1039 my ($w, $h) = @$self{qw(w h)};
1040
1041 glEnable GL_BLEND;
1042 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1043 glColor_premultiply @{ $self->{bg} };
1044
1045 glBegin GL_QUADS;
1046 glVertex 0 , 0;
1047 glVertex 0 , $h;
1048 glVertex $w, $h;
1049 glVertex $w, 0;
1050 glEnd;
1051
1052 glDisable GL_BLEND;
1053 }
1054
1055 $self->SUPER::_draw;
1056}
1057
1058#############################################################################
1059
1060package CFClient::UI::FancyFrame;
1061
1062our @ISA = CFClient::UI::Bin::;
1063
1064use CFClient::OpenGL;
1065
1066my $bg =
1067 new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
1068 mipmap => 1, wrap => 1;
1069
1070my @border =
1071 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1072 qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1073
1074sub new {
1075 my ($class, %arg) = @_;
1076
1077 my $title = delete $arg{title};
1078
1079 my $self = $class->SUPER::new (
1080 bg => [1, 1, 1, 1],
1081 border_bg => [1, 1, 1, 1],
1082 border => 0.6,
1083 can_events => 1,
1084 min_w => 16,
1085 min_h => 16,
1086 %arg,
1087 );
1088
1089 $self->{title} = new CFClient::UI::Label
1090 align => 0,
1091 valign => 1,
1092 text => $title,
1093 fontsize => $self->{border}
1094 if defined $title;
1095
1096 $self
1097}
1098
1099sub add {
1100 my ($self, @widgets) = @_;
1101
1102 $self->SUPER::add (@widgets);
1103 $self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
1104}
1105
1106sub border {
1107 int $_[0]{border} * $::FONTSIZE
1108}
1109
1110sub size_request {
1111 my ($self) = @_;
1112
1113 $self->{title}->size_request
1114 if $self->{title};
1115
1116 my ($w, $h) = $self->SUPER::size_request;
1117
1118 (
1119 $w + $self->border * 2,
1120 $h + $self->border * 2,
1121 )
1122}
1123
1124sub size_allocate {
1125 my ($self, $w, $h) = @_;
1126
1127 if ($self->{title}) {
1128 $self->{title}{w} = $w;
1129 $self->{title}{h} = $h;
1130 $self->{title}->size_allocate ($w, $h);
1131 }
1132
1133 my $border = $self->border;
1134
1135 $h -= List::Util::max 0, $border * 2;
1136 $w -= List::Util::max 0, $border * 2;
1137
1138 $self->child->configure ($border, $border, $w, $h);
1139}
1140
1141sub button_down {
1142 my ($self, $ev, $x, $y) = @_;
1143
1144 my ($w, $h) = @$self{qw(w h)};
1145 my $border = $self->border;
1146
1147 my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
1148 my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
1149
1150 if ($lr & $td) {
1151 my ($wx, $wy) = ($self->{x}, $self->{y});
1152 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1153 my ($bw, $bh) = ($self->{w}, $self->{h});
1154
1155 my $mx = $x < $border;
1156 my $my = $y < $border;
1157
1158 $self->{motion} = sub {
1159 my ($ev, $x, $y) = @_;
1160
1161 my $dx = $ev->{x} - $ox;
1162 my $dy = $ev->{y} - $oy;
1163
1164 $self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1165 $self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1166
1167 $self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1168 $self->realloc;
1169 };
1170
1171 } elsif ($lr ^ $td) {
1172 my ($ox, $oy) = ($ev->{x}, $ev->{y});
1173 my ($bx, $by) = ($self->{x}, $self->{y});
1174
1175 $self->{motion} = sub {
1176 my ($ev, $x, $y) = @_;
1177
1178 ($x, $y) = ($ev->{x}, $ev->{y});
1179
1180 $self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1181 # HACK: the next line is required to enforce placement
1182 $self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
1183 };
1184 } else {
1185 return 0;
1186 }
1187
1188 1
1189}
1190
1191sub button_up {
1192 my ($self, $ev, $x, $y) = @_;
1193
1194 !!delete $self->{motion}
1195}
1196
1197sub mouse_motion {
1198 my ($self, $ev, $x, $y) = @_;
1199
1200 $self->{motion}->($ev, $x, $y) if $self->{motion};
1201
1202 !!$self->{motion}
1203}
1204
1205sub _draw {
1206 my ($self) = @_;
1207
1208 my $child = $self->{children}[0];
1209
1210 my ($w, $h ) = ($self->{w}, $self->{h});
1211 my ($cw, $ch) = ($child->{w}, $child->{h});
1212
1213 glEnable GL_TEXTURE_2D;
1214 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1215
1216 my $border = $self->border;
1217
1218 glColor @{ $self->{border_bg} };
1219 $border[0]->draw_quad_alpha (0, 0, $w, $border);
1220 $border[1]->draw_quad_alpha (0, $border, $border, $ch);
1221 $border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1222 $border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1223
1224 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1225 glColor @{ $self->{bg} };
1226
1227 # TODO: repeat texture not scale
1228 # solve this better(?)
1229 $bg->{s} = $cw / $bg->{w};
1230 $bg->{t} = $ch / $bg->{h};
1231 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
1232 }
1233
1234 glDisable GL_TEXTURE_2D;
1235
1236 $child->draw;
1237
1238 if ($self->{title}) {
1239 glTranslate 0, $border - $self->{h};
1240 $self->{title}->_draw;
1241 }
1242}
1243
1244#############################################################################
1245
1246package CFClient::UI::Table;
1247
1248our @ISA = CFClient::UI::Base::;
1249
1250use List::Util qw(max sum);
1251
1252use CFClient::OpenGL;
1253
1254sub new {
1255 my $class = shift;
1256
1257 $class->SUPER::new (
1258 col_expand => [],
1259 @_,
1260 )
1261}
1262
1263sub children {
1264 grep $_, map @$_, grep $_, @{ $_[0]{children} }
1265}
1266
1267sub add {
1268 my ($self, $x, $y, $child) = @_;
1269
1270 $child->set_parent ($self);
1271 $self->{children}[$y][$x] = $child;
1272
1273 $self->realloc;
1274}
1275
1276# TODO: move to container class maybe? send children a signal on removal?
1277sub clear {
1278 my ($self) = @_;
1279
1280 my @children = $self->children;
1281 delete $self->{children};
1282
1283 for (@children) {
1284 delete $_->{parent};
1285 $_->hide;
1286 }
1287
1288 $self->realloc;
1289}
1290
1291sub get_wh {
1292 my ($self) = @_;
1293
1294 my (@w, @h);
1295
1296 for my $y (0 .. $#{$self->{children}}) {
1297 my $row = $self->{children}[$y]
1298 or next;
1299
1300 for my $x (0 .. $#$row) {
1301 my $widget = $row->[$x]
1302 or next;
1303 my ($w, $h) = @$widget{qw(req_w req_h)};
1304
1305 $w[$x] = max $w[$x], $w;
1306 $h[$y] = max $h[$y], $h;
1307 }
1308 }
1309
1310 (\@w, \@h)
1311}
1312
1313sub size_request {
1314 my ($self) = @_;
1315
1316 my ($ws, $hs) = $self->get_wh;
1317
1318 (
1319 (sum @$ws),
1320 (sum @$hs),
1321 )
1322}
1323
1324sub size_allocate {
1325 my ($self, $w, $h) = @_;
1326
1327 my ($ws, $hs) = $self->get_wh;
1328
1329 my $req_w = (sum @$ws) || 1;
1330 my $req_h = (sum @$hs) || 1;
1331
1332 # TODO: nicer code && do row_expand
1333 my @col_expand = @{$self->{col_expand}};
1334 @col_expand = (1) x @$ws unless @col_expand;
1335 my $col_expand = (sum @col_expand) || 1;
1336
1337 # linearly scale sizes
1338 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1339 $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1340
1341 CFClient::UI::harmonize $ws;
1342 CFClient::UI::harmonize $hs;
1343
1344 my $y;
1345
1346 for my $r (0 .. $#{$self->{children}}) {
1347 my $row = $self->{children}[$r]
1348 or next;
1349
1350 my $x = 0;
1351 my $row_h = $hs->[$r];
1352
1353 for my $c (0 .. $#$row) {
1354 my $col_w = $ws->[$c];
1355
1356 if (my $widget = $row->[$c]) {
1357 $widget->configure ($x, $y, $col_w, $row_h);
1358 }
1359
1360 $x += $col_w;
1361 }
1362
1363 $y += $row_h;
1364 }
1365
1366}
1367
1368sub find_widget {
1369 my ($self, $x, $y) = @_;
1370
273 $x -= $self->{x}; 1371 $x -= $self->{x};
274 $y -= $self->{y}; 1372 $y -= $self->{y};
275 1373
276 my $res; 1374 my $res;
277 1375
278 for (reverse @{ $self->{children} }) { 1376 for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
279 $res = $_->find_widget ($x, $y) 1377 $res = $_->find_widget ($x, $y)
280 and return $res; 1378 and return $res;
281 } 1379 }
282 1380
283 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y}) 1381 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
284} 1382}
285 1383
286sub _draw { 1384sub _draw {
287 my ($self) = @_; 1385 my ($self) = @_;
288 1386
289 $_->draw for @{$self->{children}}; 1387 for (grep $_, @{$self->{children}}) {
1388 $_->draw for grep $_, @$_;
1389 }
290} 1390}
291 1391
292############################################################################# 1392#############################################################################
293 1393
294package CFClient::Widget::Bin; 1394package CFClient::UI::Box;
295 1395
296our @ISA = CFClient::Widget::Container::; 1396our @ISA = CFClient::UI::Container::;
1397
1398sub size_request {
1399 my ($self) = @_;
1400
1401 $self->{vertical}
1402 ? (
1403 (List::Util::max map $_->{req_w}, @{$self->{children}}),
1404 (List::Util::sum map $_->{req_h}, @{$self->{children}}),
1405 )
1406 : (
1407 (List::Util::sum map $_->{req_w}, @{$self->{children}}),
1408 (List::Util::max map $_->{req_h}, @{$self->{children}}),
1409 )
1410}
1411
1412sub size_allocate {
1413 my ($self, $w, $h) = @_;
1414
1415 my $space = $self->{vertical} ? $h : $w;
1416 my $children = $self->{children};
1417
1418 my @req;
1419
1420 if ($self->{homogeneous}) {
1421 @req = ($space / (@$children || 1)) x @$children;
1422 } else {
1423 @req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
1424 my $req = List::Util::sum @req;
1425
1426 if ($req > $space) {
1427 # ah well, not enough space
1428 $_ *= $space / $req for @req;
1429 } else {
1430 my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1431
1432 $space = ($space - $req) / $expand; # remaining space to give away
1433
1434 $req[$_] += $space * $children->[$_]{expand}
1435 for 0 .. $#$children;
1436 }
1437 }
1438
1439 CFClient::UI::harmonize \@req;
1440
1441 my $pos = 0;
1442 for (0 .. $#$children) {
1443 my $alloc = $req[$_];
1444 $children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1445
1446 $pos += $alloc;
1447 }
1448
1449 1
1450}
1451
1452#############################################################################
1453
1454package CFClient::UI::HBox;
1455
1456our @ISA = CFClient::UI::Box::;
1457
1458sub new {
1459 my $class = shift;
1460
1461 $class->SUPER::new (
1462 vertical => 0,
1463 @_,
1464 )
1465}
1466
1467#############################################################################
1468
1469package CFClient::UI::VBox;
1470
1471our @ISA = CFClient::UI::Box::;
1472
1473sub new {
1474 my $class = shift;
1475
1476 $class->SUPER::new (
1477 vertical => 1,
1478 @_,
1479 )
1480}
1481
1482#############################################################################
1483
1484package CFClient::UI::Label;
1485
1486our @ISA = CFClient::UI::DrawBG::;
1487
1488use CFClient::OpenGL;
297 1489
298sub new { 1490sub new {
299 my ($class, %arg) = @_; 1491 my ($class, %arg) = @_;
300 1492
301 my $child = (delete $arg{child}) || new CFClient::Widget::Empty::; 1493 my $self = $class->SUPER::new (
1494 fg => [1, 1, 1],
1495 #bg => none
1496 #active_bg => none
1497 #font => default_font
1498 #text => initial text
1499 #markup => initial narkup
1500 #max_w => maximum pixel width
1501 ellipsise => 3, # end
1502 layout => (new CFClient::Layout),
1503 fontsize => 1,
1504 align => -1,
1505 valign => -1,
1506 padding_x => 2,
1507 padding_y => 2,
1508 can_events => 0,
1509 %arg
1510 );
302 1511
303 $class->SUPER::new (children => [$child], %arg) 1512 if (exists $self->{template}) {
304} 1513 my $layout = new CFClient::Layout;
1514 $layout->set_text (delete $self->{template});
1515 $self->{template} = $layout;
1516 }
305 1517
306sub add { 1518 if (exists $self->{markup}) {
1519 $self->set_markup (delete $self->{markup});
1520 } else {
1521 $self->set_text (delete $self->{text});
1522 }
1523
1524 $self
1525}
1526
1527sub escape($) {
1528 local $_ = $_[0];
1529
1530 s/&/&amp;/g;
1531 s/>/&gt;/g;
1532 s/</&lt;/g;
1533
1534 $_
1535}
1536
1537sub update {
1538 my ($self) = @_;
1539
1540 delete $self->{texture};
1541 $self->SUPER::update;
1542}
1543
1544sub realloc {
1545 my ($self) = @_;
1546
1547 delete $self->{ox};
1548 $self->SUPER::realloc;
1549}
1550
1551sub set_text {
307 my ($self, $widget) = @_; 1552 my ($self, $text) = @_;
308 1553
309 $self->{children} = []; 1554 return if $self->{text} eq "T$text";
310 1555 $self->{text} = "T$text";
311 $self->SUPER::add ($widget);
312}
313 1556
314sub remove { 1557 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1558 $self->{layout}->set_text ($text);
1559
1560 delete $self->{size_req};
1561 $self->realloc;
1562 $self->update;
1563}
1564
1565sub set_markup {
315 my ($self, $widget) = @_; 1566 my ($self, $markup) = @_;
316 1567
317 $self->SUPER::remove ($widget); 1568 return if $self->{text} eq "M$markup";
1569 $self->{text} = "M$markup";
318 1570
319 $self->{children} = [new CFClient::Widget::Empty] 1571 my $rgba = $markup =~ /span.*(?:foreground|background)/;
320 unless @{$self->{children}};
321}
322 1572
323sub child { $_[0]->{children}[0] } 1573 $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1574 $self->{layout}->set_markup ($markup);
1575
1576 delete $self->{size_req};
1577 $self->realloc;
1578 $self->update;
1579}
324 1580
325sub size_request { 1581sub size_request {
326 $_[0]{children}[0]->size_request if $_[0]{children}[0]; 1582 my ($self) = @_;
1583
1584 $self->{size_req} ||= do {
1585 $self->{layout}->set_font ($self->{font}) if $self->{font};
1586 $self->{layout}->set_width ($self->{max_w} || -1);
1587 $self->{layout}->set_ellipsise ($self->{ellipsise});
1588 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1589 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1590
1591 my ($w, $h) = $self->{layout}->size;
1592
1593 if (exists $self->{template}) {
1594 $self->{template}->set_font ($self->{font}) if $self->{font};
1595 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1596
1597 my ($w2, $h2) = $self->{template}->size;
1598
1599 $w = List::Util::max $w, $w2;
1600 $h = List::Util::max $h, $h2;
1601 }
1602
1603 [$w, $h]
1604 };
1605
1606 @{ $self->{size_req} }
327} 1607}
328 1608
329sub size_allocate { 1609sub size_allocate {
330 my ($self, $w, $h) = @_; 1610 my ($self, $w, $h) = @_;
331 1611
332 $self->SUPER::size_allocate ($w, $h); 1612 delete $self->{ox};
333 $self->{children}[0]->size_allocate ($w, $h) 1613
334 if $self->{children}[0] 1614 delete $self->{texture}
1615 unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1616}
1617
1618sub set_fontsize {
1619 my ($self, $fontsize) = @_;
1620
1621 $self->{fontsize} = $fontsize;
1622 delete $self->{texture};
1623
1624 $self->realloc;
1625}
1626
1627sub reconfigure {
1628 my ($self) = @_;
1629
1630 delete $self->{size_req};
1631
1632 $self->SUPER::reconfigure;
1633}
1634
1635sub _draw {
1636 my ($self) = @_;
1637
1638 $self->SUPER::_draw; # draw background, if applicable
1639
1640 my $tex = $self->{texture} ||= do {
1641 $self->{layout}->set_foreground (@{$self->{fg}});
1642 $self->{layout}->set_font ($self->{font}) if $self->{font};
1643 $self->{layout}->set_width ($self->{w});
1644 $self->{layout}->set_ellipsise ($self->{ellipsise});
1645 $self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1646 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1647
1648 new_from_layout CFClient::Texture $self->{layout}
1649 };
1650
1651 unless (exists $self->{ox}) {
1652 $self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1653 : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1654 : ($self->{w} - $tex->{w}) * 0.5);
1655
1656 $self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1657 : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1658 : ($self->{h} - $tex->{h}) * 0.5);
1659 };
1660
1661 glEnable GL_TEXTURE_2D;
1662
1663 if ($tex->{format} == GL_ALPHA) {
1664 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1665 glColor @{$self->{fg}};
1666 $tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1667 } else {
1668 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1669 $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1670 }
1671
1672 glDisable GL_TEXTURE_2D;
335} 1673}
336 1674
337############################################################################# 1675#############################################################################
338 1676
339package CFClient::Widget::Window; 1677package CFClient::UI::EntryBase;
340 1678
1679our @ISA = CFClient::UI::Label::;
1680
1681use CFClient::OpenGL;
1682
1683sub new {
1684 my $class = shift;
1685
1686 $class->SUPER::new (
1687 fg => [1, 1, 1],
1688 bg => [0, 0, 0, 0.2],
1689 active_bg => [1, 1, 1, 0.5],
1690 active_fg => [0, 0, 0],
1691 can_hover => 1,
1692 can_focus => 1,
1693 valign => 0,
1694 can_events => 1,
1695 #text => ...
1696 #hidden => "*",
1697 @_
1698 )
1699}
1700
1701sub _set_text {
1702 my ($self, $text) = @_;
1703
1704 delete $self->{cur_h};
1705
1706 return if $self->{text} eq $text;
1707
1708 $self->{last_activity} = $::NOW;
1709 $self->{text} = $text;
1710
1711 $text =~ s/./*/g if $self->{hidden};
1712 $self->{layout}->set_text ("$text ");
1713 delete $self->{size_req};
1714
1715 $self->_emit (changed => $self->{text});
1716
1717 $self->realloc;
1718 $self->update;
1719}
1720
1721sub set_text {
1722 my ($self, $text) = @_;
1723
1724 $self->{cursor} = length $text;
1725 $self->_set_text ($text);
1726}
1727
1728sub get_text {
1729 $_[0]{text}
1730}
1731
1732sub size_request {
1733 my ($self) = @_;
1734
1735 my ($w, $h) = $self->SUPER::size_request;
1736
1737 ($w + 1, $h) # add 1 for cursor
1738}
1739
1740sub key_down {
1741 my ($self, $ev) = @_;
1742
1743 my $mod = $ev->{mod};
1744 my $sym = $ev->{sym};
1745 my $uni = $ev->{unicode};
1746
1747 my $text = $self->get_text;
1748
1749 if ($uni == 8) {
1750 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1751 } elsif ($uni == 127) {
1752 substr $text, $self->{cursor}, 1, "";
1753 } elsif ($sym == CFClient::SDLK_LEFT) {
1754 --$self->{cursor} if $self->{cursor};
1755 } elsif ($sym == CFClient::SDLK_RIGHT) {
1756 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1757 } elsif ($sym == CFClient::SDLK_HOME) {
1758 $self->{cursor} = 0;
1759 } elsif ($sym == CFClient::SDLK_END) {
1760 $self->{cursor} = length $text;
1761 } elsif ($uni == 27) {
1762 $self->_emit ('escape');
1763 } elsif ($uni) {
1764 substr $text, $self->{cursor}++, 0, chr $uni;
1765 } else {
1766 return 0;
1767 }
1768
1769 $self->_set_text ($text);
1770
1771 $self->realloc;
1772
1773 1
1774}
1775
1776sub focus_in {
1777 my ($self) = @_;
1778
1779 $self->{last_activity} = $::NOW;
1780
1781 $self->SUPER::focus_in;
1782}
1783
1784sub button_down {
1785 my ($self, $ev, $x, $y) = @_;
1786
1787 $self->SUPER::button_down ($ev, $x, $y);
1788
1789 my $idx = $self->{layout}->xy_to_index ($x, $y);
1790
1791 # byte-index to char-index
1792 my $text = $self->{text};
1793 utf8::encode $text;
1794 $self->{cursor} = length substr $text, 0, $idx;
1795
1796 $self->_set_text ($self->{text});
1797 $self->update;
1798
1799 1
1800}
1801
1802sub mouse_motion {
1803 my ($self, $ev, $x, $y) = @_;
1804# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1805
1806 0
1807}
1808
1809sub _draw {
1810 my ($self) = @_;
1811
1812 local $self->{fg} = $self->{fg};
1813
1814 if ($FOCUS == $self) {
1815 glColor_premultiply @{$self->{active_bg}};
1816 $self->{fg} = $self->{active_fg};
1817 } else {
1818 glColor_premultiply @{$self->{bg}};
1819 }
1820
1821 glEnable GL_BLEND;
1822 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1823 glBegin GL_QUADS;
1824 glVertex 0 , 0;
1825 glVertex 0 , $self->{h};
1826 glVertex $self->{w}, $self->{h};
1827 glVertex $self->{w}, 0;
1828 glEnd;
1829 glDisable GL_BLEND;
1830
1831 $self->SUPER::_draw;
1832
1833 #TODO: force update every cursor change :(
1834 if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
1835
1836 unless (exists $self->{cur_h}) {
1837 my $text = substr $self->{text}, 0, $self->{cursor};
1838 utf8::encode $text;
1839
1840 @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1841 }
1842
1843 glColor @{$self->{fg}};
1844 glBegin GL_LINES;
1845 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1846 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1847 glEnd;
1848 }
1849}
1850
1851package CFClient::UI::Entry;
1852
1853our @ISA = CFClient::UI::EntryBase::;
1854
1855use CFClient::OpenGL;
1856
1857sub key_down {
1858 my ($self, $ev) = @_;
1859
1860 my $sym = $ev->{sym};
1861
1862 if ($sym == 13) {
1863 unshift @{$self->{history}},
1864 my $txt = $self->get_text;
1865 $self->{history_pointer} = -1;
1866 $self->{history_saveback} = '';
1867 $self->_emit (activate => $txt);
1868 $self->update;
1869
1870 } elsif ($sym == CFClient::SDLK_UP) {
1871 if ($self->{history_pointer} < 0) {
1872 $self->{history_saveback} = $self->get_text;
1873 }
1874 if (@{$self->{history} || []} > 0) {
1875 $self->{history_pointer}++;
1876 if ($self->{history_pointer} >= @{$self->{history} || []}) {
1877 $self->{history_pointer} = @{$self->{history} || []} - 1;
1878 }
1879 $self->set_text ($self->{history}->[$self->{history_pointer}]);
1880 }
1881
1882 } elsif ($sym == CFClient::SDLK_DOWN) {
1883 $self->{history_pointer}--;
1884 $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1885
1886 if ($self->{history_pointer} >= 0) {
1887 $self->set_text ($self->{history}->[$self->{history_pointer}]);
1888 } else {
1889 $self->set_text ($self->{history_saveback});
1890 }
1891
1892 } else {
1893 return $self->SUPER::key_down ($ev)
1894 }
1895
1896 1
1897}
1898
1899#############################################################################
1900
1901package CFClient::UI::Button;
1902
1903our @ISA = CFClient::UI::Label::;
1904
1905use CFClient::OpenGL;
1906
1907my @tex =
1908 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1909 qw(b1_button_active.png);
1910
1911sub new {
1912 my $class = shift;
1913
1914 $class->SUPER::new (
1915 padding_x => 4,
1916 padding_y => 4,
1917 fg => [1, 1, 1],
1918 active_fg => [0, 0, 1],
1919 can_hover => 1,
1920 align => 0,
1921 valign => 0,
1922 can_events => 1,
1923 @_
1924 )
1925}
1926
1927sub activate { }
1928
1929sub button_up {
1930 my ($self, $ev, $x, $y) = @_;
1931
1932 $self->emit ("activate")
1933 if $x >= 0 && $x < $self->{w}
1934 && $y >= 0 && $y < $self->{h};
1935
1936 1
1937}
1938
1939sub _draw {
1940 my ($self) = @_;
1941
1942 local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1943
1944 glEnable GL_TEXTURE_2D;
1945 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1946 glColor 0, 0, 0, 1;
1947
1948 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1949
1950 glDisable GL_TEXTURE_2D;
1951
1952 $self->SUPER::_draw;
1953}
1954
1955#############################################################################
1956
1957package CFClient::UI::CheckBox;
1958
1959our @ISA = CFClient::UI::DrawBG::;
1960
1961my @tex =
1962 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1963 qw(c1_checkbox_bg.png c1_checkbox_active.png);
1964
1965use CFClient::OpenGL;
1966
1967sub new {
1968 my $class = shift;
1969
1970 $class->SUPER::new (
1971 padding_x => 2,
1972 padding_y => 2,
1973 fg => [1, 1, 1],
1974 active_fg => [1, 1, 0],
1975 bg => [0, 0, 0, 0.2],
1976 active_bg => [1, 1, 1, 0.5],
1977 state => 0,
1978 can_hover => 1,
1979 @_
1980 )
1981}
1982
1983sub size_request {
1984 my ($self) = @_;
1985
1986 (6) x 2
1987}
1988
1989sub button_down {
1990 my ($self, $ev, $x, $y) = @_;
1991
1992 if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1993 && $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1994 $self->{state} = !$self->{state};
1995 $self->_emit (changed => $self->{state});
1996 } else {
1997 return 0
1998 }
1999
2000 1
2001}
2002
2003sub _draw {
2004 my ($self) = @_;
2005
2006 $self->SUPER::_draw;
2007
2008 glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
2009
2010 my ($w, $h) = @$self{qw(w h)};
2011
2012 my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2013
2014 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
2015
2016 my $tex = $self->{state} ? $tex[1] : $tex[0];
2017
2018 glEnable GL_TEXTURE_2D;
2019 $tex->draw_quad_alpha (0, 0, $s, $s);
2020 glDisable GL_TEXTURE_2D;
2021}
2022
2023#############################################################################
2024
2025package CFClient::UI::Image;
2026
341our @ISA = CFClient::Widget::Bin::; 2027our @ISA = CFClient::UI::Base::;
342 2028
343use SDL::OpenGL; 2029use CFClient::OpenGL;
2030use Carp qw/confess/;
2031
2032our %loaded_images;
2033
2034sub new {
2035 my $class = shift;
2036
2037 my $self = $class->SUPER::new (can_events => 0, @_);
2038
2039 $self->{image} or confess "Image has 'image' not set. This is a fatal error!";
2040
2041 $loaded_images{$self->{image}} ||=
2042 new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;
2043
2044 my $tex = $self->{tex} = $loaded_images{$self->{image}};
2045
2046 Scalar::Util::weaken $loaded_images{$self->{image}};
2047
2048 $self->{aspect} = $tex->{w} / $tex->{h};
2049
2050 $self
2051}
2052
2053sub size_request {
2054 my ($self) = @_;
2055
2056 ($self->{tex}->{w}, $self->{tex}->{h})
2057}
2058
2059sub _draw {
2060 my ($self) = @_;
2061
2062 my $tex = $self->{tex};
2063
2064 my ($w, $h) = ($self->{w}, $self->{h});
2065
2066 if ($self->{rot90}) {
2067 glRotate 90, 0, 0, 1;
2068 glTranslate 0, -$self->{w}, 0;
2069
2070 ($w, $h) = ($h, $w);
2071 }
2072
2073 glEnable GL_TEXTURE_2D;
2074 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2075
2076 $tex->draw_quad_alpha (0, 0, $w, $h);
2077
2078 glDisable GL_TEXTURE_2D;
2079}
2080
2081#############################################################################
2082
2083package CFClient::UI::VGauge;
2084
2085our @ISA = CFClient::UI::Base::;
2086
2087use List::Util qw(min max);
2088
2089use CFClient::OpenGL;
2090
2091my %tex = (
2092 food => [
2093 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2094 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2095 ],
2096 grace => [
2097 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2098 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2099 ],
2100 hp => [
2101 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2102 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2103 ],
2104 mana => [
2105 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2106 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2107 ],
2108);
2109
2110# eg. VGauge->new (gauge => 'food'), default gauge: food
2111sub new {
2112 my $class = shift;
2113
2114 my $self = $class->SUPER::new (
2115 type => 'food',
2116 @_
2117 );
2118
2119 $self->{aspect} = $tex{$self->{type}}[0]{w} / $tex{$self->{type}}[0]{h};
2120
2121 $self
2122}
2123
2124sub size_request {
2125 my ($self) = @_;
2126
2127 #my $tex = $tex{$self->{type}}[0];
2128 #@$tex{qw(w h)}
2129 (0, 0)
2130}
2131
2132sub set_max {
2133 my ($self, $max) = @_;
2134
2135 return if $self->{max_val} == $max;
2136
2137 $self->{max_val} = $max;
2138 $self->update;
2139}
2140
2141sub set_value {
2142 my ($self, $val, $max) = @_;
2143
2144 $self->set_max ($max)
2145 if defined $max;
2146
2147 return if $self->{val} == $val;
2148
2149 $self->{val} = $val;
2150 $self->update;
2151}
2152
2153sub _draw {
2154 my ($self) = @_;
2155
2156 my $tex = $tex{$self->{type}};
2157 my ($t1, $t2, $t3) = @$tex;
2158
2159 my ($w, $h) = ($self->{w}, $self->{h});
2160
2161 if ($self->{vertical}) {
2162 glRotate 90, 0, 0, 1;
2163 glTranslate 0, -$self->{w}, 0;
2164
2165 ($w, $h) = ($h, $w);
2166 }
2167
2168 my $ycut = $self->{val} / ($self->{max_val} || 1);
2169
2170 my $ycut1 = max 0, min 1, $ycut;
2171 my $ycut2 = max 0, min 1, $ycut - 1;
2172
2173 my $h1 = $self->{h} * (1 - $ycut1);
2174 my $h2 = $self->{h} * (1 - $ycut2);
2175
2176 glEnable GL_BLEND;
2177 glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2178 GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2179 glEnable GL_TEXTURE_2D;
2180 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2181
2182 glBindTexture GL_TEXTURE_2D, $t1->{name};
2183 glBegin GL_QUADS;
2184 glTexCoord 0 , 0; glVertex 0 , 0;
2185 glTexCoord 0 , $t1->{t} * (1 - $ycut1); glVertex 0 , $h1;
2186 glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut1); glVertex $w, $h1;
2187 glTexCoord $t1->{s}, 0; glVertex $w, 0;
2188 glEnd;
2189
2190 my $ycut1 = List::Util::min 1, $ycut;
2191 glBindTexture GL_TEXTURE_2D, $t2->{name};
2192 glBegin GL_QUADS;
2193 glTexCoord 0 , $t2->{t} * (1 - $ycut1); glVertex 0 , $h1;
2194 glTexCoord 0 , $t2->{t} * (1 - $ycut2); glVertex 0 , $h2;
2195 glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut2); glVertex $w, $h2;
2196 glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut1); glVertex $w, $h1;
2197 glEnd;
2198
2199 if ($t3) {
2200 glBindTexture GL_TEXTURE_2D, $t3->{name};
2201 glBegin GL_QUADS;
2202 glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2203 glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};
2204 glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};
2205 glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2206 glEnd;
2207 }
2208
2209 glDisable GL_BLEND;
2210 glDisable GL_TEXTURE_2D;
2211}
2212
2213#############################################################################
2214
2215package CFClient::UI::Gauge;
2216
2217our @ISA = CFClient::UI::VBox::;
344 2218
345sub new { 2219sub new {
346 my ($class, %arg) = @_; 2220 my ($class, %arg) = @_;
347 2221
348 my $self = $class->SUPER::new (%arg); 2222 my $self = $class->SUPER::new (
2223 tooltip => $arg{type},
2224 can_hover => 1,
2225 can_events => 1,
2226 %arg,
2227 );
2228
2229 $self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
2230 $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2231 $self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");
2232
2233 $self
2234}
2235
2236sub set_fontsize {
2237 my ($self, $fsize) = @_;
2238
2239 $self->{value}->set_fontsize ($fsize);
2240 $self->{max} ->set_fontsize ($fsize);
2241}
2242
2243sub set_max {
2244 my ($self, $max) = @_;
2245
2246 $self->{gauge}->set_max ($max);
2247 $self->{max}->set_text ($max);
2248}
2249
2250sub set_value {
2251 my ($self, $val, $max) = @_;
2252
2253 $self->set_max ($max)
2254 if defined $max;
2255
2256 $self->{gauge}->set_value ($val, $max);
2257 $self->{value}->set_text ($val);
2258}
2259
2260#############################################################################
2261
2262package CFClient::UI::Slider;
2263
2264use strict;
2265
2266use CFClient::OpenGL;
2267
2268our @ISA = CFClient::UI::DrawBG::;
2269
2270my @tex =
2271 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
2272 qw(s1_slider.png s1_slider_bg.png);
2273
2274sub new {
2275 my $class = shift;
2276
2277 # range [value, low, high, page, unit]
2278
2279 # TODO: 0-width page
2280 # TODO: req_w/h are wrong with vertical
2281 # TODO: calculations are off
2282 my $self = $class->SUPER::new (
2283 fg => [1, 1, 1],
2284 active_fg => [0, 0, 0],
2285 bg => [0, 0, 0, 0.2],
2286 active_bg => [1, 1, 1, 0.5],
2287 range => [0, 0, 100, 10, 0],
2288 min_w => $::WIDTH / 80,
2289 min_h => $::WIDTH / 80,
2290 vertical => 0,
2291 can_hover => 1,
2292 inner_pad => 0.02,
2293 @_
2294 );
2295
2296 $self->set_value ($self->{range}[0]);
2297 $self->update;
2298
2299 $self
2300}
2301
2302sub changed { }
2303
2304sub set_range {
2305 my ($self, $range) = @_;
2306
2307 ($range, $self->{range}) = ($self->{range}, $range);
2308
2309 $self->update
2310 if "@$range" ne "@{$self->{range}}";
2311}
2312
2313sub set_value {
2314 my ($self, $value) = @_;
2315
2316 my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2317
2318 $hi = $lo + 1 if $hi <= $lo;
2319
2320 $page = $hi - $lo if $page > $hi - $lo;
2321
2322 $value = $lo if $value < $lo;
2323 $value = $hi - $page if $value > $hi - $page;
2324
2325 $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2326 if $unit;
2327
2328 @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2329
2330 if ($value != $old_value) {
2331 $self->_emit (changed => $value);
2332 $self->update;
2333 }
2334}
2335
2336sub size_request {
2337 my ($self) = @_;
2338
2339 ($self->{req_w}, $self->{req_h})
2340}
2341
2342sub button_down {
2343 my ($self, $ev, $x, $y) = @_;
2344
2345 $self->SUPER::button_down ($ev, $x, $y);
2346
2347 $self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2348
2349 $self->mouse_motion ($ev, $x, $y)
2350}
2351
2352sub mouse_motion {
2353 my ($self, $ev, $x, $y) = @_;
2354
2355 if ($GRAB == $self) {
2356 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2357
2358 my (undef, $lo, $hi, $page) = @{$self->{range}};
2359
2360 $x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2361
2362 $self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
2363 } else {
2364 return 0;
2365 }
2366
2367 1
349} 2368}
350 2369
351sub update { 2370sub update {
352 my ($self) = @_; 2371 my ($self) = @_;
353 2372
354 # we want to do this delayed... 2373 delete $self->{knob_w};
355 $self->render_chld;
356 $self->SUPER::update; 2374 $self->SUPER::update;
357} 2375}
358 2376
359sub render_chld { 2377sub _draw {
2378 my ($self) = @_;
2379
2380 unless ($self->{knob_w}) {
2381 $self->set_value ($self->{range}[0]);
2382
2383 my ($value, $lo, $hi, $page) = @{$self->{range}};
2384 my $range = ($hi - $page - $lo) || 1e-100;
2385
2386 my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2387
2388 $self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2389 $self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2390
2391 $value = ($value - $lo) / $range;
2392 $value = $value * $self->{scale} + $self->{offset};
2393
2394 $self->{knob_x} = $value - $knob_w * 0.5;
2395 $self->{knob_w} = $knob_w;
2396 }
2397
2398 $self->SUPER::_draw ();
2399
2400 glScale $self->{w}, $self->{h};
2401
2402 if ($self->{vertical}) {
2403 # draw a vertical slider like a rotated horizontal slider
2404
2405 glTranslate 1, 0, 0;
2406 glRotate 90, 0, 0, 1;
2407 }
2408
2409 my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2410 my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2411
2412 glEnable GL_TEXTURE_2D;
2413 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2414
2415 # draw background
2416 $tex[1]->draw_quad_alpha (0, 0, 1, 1);
2417
2418 # draw handle
2419 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2420
2421 glDisable GL_TEXTURE_2D;
2422}
2423
2424#############################################################################
2425
2426package CFClient::UI::ValSlider;
2427
2428our @ISA = CFClient::UI::HBox::;
2429
2430sub new {
2431 my ($class, %arg) = @_;
2432
2433 my $range = delete $arg{range};
2434
2435 my $self = $class->SUPER::new (
2436 slider => (new CFClient::UI::Slider expand => 1, range => $range),
2437 entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
2438 to_value => sub { shift },
2439 from_value => sub { shift },
2440 %arg,
2441 );
2442
2443 $self->{slider}->connect (changed => sub {
360 my ($self) = @_; 2444 my ($self, $value) = @_;
2445 $self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
2446 $self->{parent}->emit (changed => $value);
2447 });
361 2448
362 $self->{texture} = 2449# $self->{entry}->connect (changed => sub {
363 CFClient::Texture->new_from_opengl ( 2450# my ($self, $value) = @_;
364 $self->{w}, $self->{h}, sub { $self->child->draw } 2451# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
2452# $self->{parent}->emit (changed => $value);
2453# });
2454
2455 $self->add ($self->{slider}, $self->{entry});
2456
2457 $self->{slider}->emit (changed => $self->{slider}{range}[0]);
2458
2459 $self
2460}
2461
2462sub set_range { shift->{slider}->set_range (@_) }
2463sub set_value { shift->{slider}->set_value (@_) }
2464
2465#############################################################################
2466
2467package CFClient::UI::TextView;
2468
2469our @ISA = CFClient::UI::HBox::;
2470
2471use CFClient::OpenGL;
2472
2473sub new {
2474 my $class = shift;
2475
2476 my $self = $class->SUPER::new (
2477 fontsize => 1,
2478 can_events => 0,
2479 #font => default_font
2480 @_,
2481
2482 layout => (new CFClient::Layout 1),
2483 par => [],
2484 height => 0,
2485 children => [
2486 (new CFClient::UI::Empty expand => 1),
2487 (new CFClient::UI::Slider vertical => 1),
2488 ],
365 ); 2489 );
2490
2491 $self->{children}[1]->connect (changed => sub { $self->update });
2492
2493 $self
2494}
2495
2496sub set_fontsize {
2497 my ($self, $fontsize) = @_;
2498
2499 $self->{fontsize} = $fontsize;
2500 $self->reflow;
366} 2501}
367 2502
368sub size_allocate { 2503sub size_allocate {
369 my ($self, $w, $h) = @_; 2504 my ($self, $w, $h) = @_;
370 2505
371 $self->{w} = $w;
372 $self->{h} = $h;
373
374 $self->child->size_allocate ($w, $h); 2506 $self->SUPER::size_allocate ($w, $h);
375 2507
376 $self->render_chld; 2508 $self->{layout}->set_font ($self->{font}) if $self->{font};
2509 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2510 $self->{layout}->set_width ($self->{children}[0]{w});
2511 $self->{layout}->set_indent (-$self->{fontsize} * $::FONTSIZE * 4);
2512
2513 $self->reflow;
2514}
2515
2516sub text_size {
2517 my ($self, $text, $indent) = @_;
2518
2519 my $layout = $self->{layout};
2520
2521 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2522 $layout->set_width ($self->{children}[0]{w} - $indent);
2523 $layout->set_indent (-$self->{fontsize} * $::FONTSIZE * 4);
2524 $layout->set_markup ($text);
2525
2526 $layout->size
2527}
2528
2529sub reflow {
2530 my ($self) = @_;
2531
2532 $self->{need_reflow}++;
2533 $self->update;
2534}
2535
2536sub set_offset {
2537 my ($self, $offset) = @_;
2538
2539 # todo: base offset on lines or so, not on pixels
2540 $self->{children}[1]->set_value ($offset);
2541}
2542
2543sub clear {
2544 my ($self) = @_;
2545
2546 $self->{par} = [];
2547 $self->{height} = 0;
2548 $self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2549}
2550
2551sub add_paragraph {
2552 my ($self, $color, $text, $indent) = @_;
2553
2554 for my $line (split /\n/, $text) {
2555 my ($w, $h) = $self->text_size ($line);
2556 $self->{height} += $h;
2557 push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2558 }
2559
2560 $self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2561}
2562
2563sub update {
2564 my ($self) = @_;
2565
2566 $self->SUPER::update;
2567
2568 return unless $self->{h} > 0;
2569
2570 delete $self->{texture};
2571
2572 $ROOT->on_post_alloc ($self, sub {
2573 my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2574
2575 if (delete $self->{need_reflow}) {
2576 my $height = 0;
2577
2578 my $layout = $self->{layout};
2579
2580 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2581
2582 for (@{$self->{par}}) {
2583 if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2584 $layout->set_width ($W - $_->[3]);
2585 $layout->set_indent (-$self->{fontsize} * $::FONTSIZE * 4);
2586 $layout->set_markup ($_->[4]);
2587 my ($w, $h) = $layout->size;
2588 $_->[0] = $w + $_->[3];
2589 $_->[1] = $h;
2590 }
2591
2592 $height += $_->[1];
2593 }
2594
2595 $self->{height} = $height;
2596
2597 $self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2598
2599 delete $self->{texture};
2600 }
2601
2602 $self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2603 glClearColor 0, 0, 0, 0;
2604 glClear GL_COLOR_BUFFER_BIT;
2605
2606 my $top = int $self->{children}[1]{range}[0];
2607
2608 my $y0 = $top;
2609 my $y1 = $top + $H;
2610
2611 my $y = 0;
2612
2613 my $layout = $self->{layout};
2614
2615 $layout->set_font ($self->{font}) if $self->{font};
2616
2617 glEnable GL_BLEND;
2618 #TODO# not correct in windows where rgba is forced off
2619 glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2620
2621 for my $par (@{$self->{par}}) {
2622 my $h = $par->[1];
2623
2624 if ($y0 < $y + $h && $y < $y1) {
2625 $layout->set_foreground (@{ $par->[2] });
2626 $layout->set_width ($W - $par->[3]);
2627 $layout->set_indent (-$self->{fontsize} * $::FONTSIZE * 4);
2628 $layout->set_markup ($par->[4]);
2629
2630 my ($w, $h, $data, $format, $internalformat) = $layout->render;
2631
2632 glRasterPos $par->[3], $y - $y0;
2633 glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2634 }
2635
2636 $y += $h;
2637 }
2638
2639 glDisable GL_BLEND;
2640 };
2641 });
377} 2642}
378 2643
379sub _draw { 2644sub _draw {
380 my ($self) = @_; 2645 my ($self) = @_;
381 2646
382 my ($w, $h) = ($self->w, $self->h);
383
384 my $tex = $self->{texture}
385 or return;
386
387 glEnable GL_BLEND;
388 glEnable GL_TEXTURE_2D; 2647 glEnable GL_TEXTURE_2D;
389 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE; 2648 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
390 2649 glColor 0, 0, 0, 1;
391 $tex->draw_quad (0, 0, $w, $h); 2650 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
392
393 glDisable GL_BLEND;
394 glDisable GL_TEXTURE_2D; 2651 glDisable GL_TEXTURE_2D;
2652
2653 $self->{children}[1]->draw;
2654
395} 2655}
396 2656
397############################################################################# 2657#############################################################################
398 2658
399package CFClient::Widget::Frame;
400
401our @ISA = CFClient::Widget::Bin::;
402
403use SDL::OpenGL;
404
405sub size_request {
406 my ($self) = @_;
407 my $chld = $self->child
408 or return (0, 0);
409
410 $chld->move (2, 2);
411
412 map { $_ + 4 } $chld->size_request;
413}
414
415sub size_allocate {
416 my ($self, $w, $h) = @_;
417
418 $self->{w} = $w;
419 $self->{h} = $h;
420
421 $self->child->size_allocate ($w - 4, $h - 4);
422 $self->child->move (2, 2);
423}
424
425sub _draw {
426 my ($self) = @_;
427
428 my $chld = $self->child;
429
430 my ($w, $h) = $chld->size_request;
431
432 glBegin GL_QUADS;
433 glColor 0, 0, 0;
434 glVertex 0 , 0;
435 glVertex 0 , $h + 4;
436 glVertex $w + 4 , $h + 4;
437 glVertex $w + 4 , 0;
438 glEnd;
439
440 $chld->draw;
441}
442
443#############################################################################
444
445package CFClient::Widget::FancyFrame;
446
447our @ISA = CFClient::Widget::Bin::;
448
449use SDL::OpenGL;
450
451my @tex =
452 map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
453 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
454
455sub size_request {
456 my ($self) = @_;
457
458 my ($w, $h) = $self->SUPER::size_request;
459
460 $h += $tex[1]->{height};
461 $h += $tex[4]->{height};
462 $w += $tex[2]->{width};
463 $w += $tex[3]->{width};
464
465 ($w, $h)
466}
467
468sub size_allocate {
469 my ($self, $w, $h) = @_;
470
471 $self->SUPER::size_allocate ($w, $h);
472
473 $h -= $tex[1]->{height};
474 $h -= $tex[4]->{height};
475 $w -= $tex[2]->{width};
476 $w -= $tex[3]->{width};
477
478 $h = $h < 0 ? 0 : $h;
479 $w = $w < 0 ? 0 : $w;
480
481 my $child = $self->child;
482
483 $child->size_allocate ($w, $h);
484 $child->move ($tex[3]->{width}, $tex[1]->{height});
485}
486
487sub _draw {
488 my ($self) = @_;
489
490 my ($w, $h) = ($self->{w}, $self->{h});
491 my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
492
493 glEnable GL_BLEND;
494 glEnable GL_TEXTURE_2D;
495 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
496 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
497
498 my $top = $tex[1];
499 $top->draw_quad (0, 0, $w, $top->{height});
500
501 my $left = $tex[3];
502 $left->draw_quad (0, $top->{height}, $left->{width}, $ch);
503
504 my $right = $tex[2];
505 $right->draw_quad ($w - $right->{width}, $top->{height}, $right->{width}, $ch);
506
507 my $bottom = $tex[4];
508 $bottom->draw_quad (0, $h - $bottom->{height}, $w, $bottom->{height});
509
510 my $bg = $tex[0];
511 glBindTexture GL_TEXTURE_2D, $bg->{name};
512 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
513 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
514 glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
515
516 my $rep_x = $cw / $bg->{width};
517 my $rep_y = $ch / $bg->{height};
518
519 $bg->draw_quad ($left->{width}, $top->{height}, $cw, $ch);
520
521 glDisable GL_BLEND;
522 glDisable GL_TEXTURE_2D;
523
524 $self->child->draw;
525
526}
527
528#############################################################################
529
530package CFClient::Widget::Table;
531
532our @ISA = CFClient::Widget::Bin::;
533
534use SDL::OpenGL;
535
536sub add {
537 my ($self, $x, $y, $chld) = @_;
538 my $old_chld = $self->{children}[$y][$x];
539
540 $self->{children}[$y][$x] = $chld;
541 $chld->set_parent ($self);
542 $self->update;
543}
544
545sub max_row_height {
546 my ($self, $row) = @_;
547
548 my $hs = 0;
549 for (my $xi = 0; $xi <= $#{$self->{children}->[$row] || []}; $xi++) {
550 my $c = $self->{children}->[$row]->[$xi];
551 if ($c) {
552 my ($w, $h) = $c->size_request;
553 if ($hs < $h) { $hs = $h }
554 }
555 }
556 return $hs;
557}
558
559sub max_col_width {
560 my ($self, $col) = @_;
561
562 my $ws = 0;
563 for (my $yi = 0; $yi <= $#{$self->{children} || []}; $yi++) {
564 my $c = ($self->{children}->[$yi] || [])->[$col];
565 if ($c) {
566 my ($w, $h) = $c->size_request;
567 if ($ws < $w) { $ws = $w }
568 }
569 }
570 return $ws;
571}
572
573sub size_request {
574 my ($self) = @_;
575
576 my ($hs, $ws) = (0, 0);
577
578 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
579 $hs += $self->max_row_height ($yi);
580 }
581
582 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
583 my $wm = 0;
584 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
585 $wm += $self->max_col_width ($xi)
586 }
587 if ($ws < $wm) { $ws = $wm }
588 }
589
590 return ($ws, $hs);
591}
592
593sub _draw {
594 my ($self) = @_;
595
596 my $y = 0;
597 for (my $yi = 0; $yi <= $#{$self->{children}}; $yi++) {
598 my $x = 0;
599
600 for (my $xi = 0; $xi <= $#{$self->{children}->[$yi]}; $xi++) {
601
602 my $c = $self->{children}->[$yi]->[$xi];
603 if ($c) {
604 $c->move ($x, $y, 0); #TODO: Move to size_request
605 $c->draw if $c;
606 }
607
608 $x += $self->max_col_width ($xi);
609 }
610
611 $y += $self->max_row_height ($yi);
612 }
613}
614
615#############################################################################
616
617package CFClient::Widget::VBox;
618
619our @ISA = CFClient::Widget::Container::;
620
621use SDL::OpenGL;
622
623sub size_request {
624 my ($self) = @_;
625
626 my @alloc = map [$_->size_request], @{$self->{children}};
627
628 (
629 (List::Util::max map $_->[0], @alloc),
630 (List::Util::sum map $_->[1], @alloc),
631 )
632}
633
634sub size_allocate {
635 my ($self, $w, $h) = @_;
636
637 $self->w ($w);
638 $self->h ($h);
639
640 my $exp;
641 my @oth;
642 # find expand widget
643 for (@{$self->{children}}) {
644 if ($_->{expand}) {
645 $exp = $_;
646 last;
647 }
648 push @oth, $_;
649 }
650
651 my ($ow, $oh);
652
653 # get sizes of other widgets
654 for (@oth) {
655 my ($w, $h) = $_->size_request;
656 $oh += $h;
657 if ($ow < $w) { $ow = $w }
658 }
659
660 my $y = 0;
661 for (@{$self->{children}}) {
662 $_->move (0, $y);
663
664 if ($_ == $exp) {
665 $_->size_allocate ($w, $h - $oh);
666 $y += $h - $oh;
667 } else {
668 my ($cw, $h) = $_->size_request;
669 $_->size_allocate ($w, $h);
670 $y += $h;
671 }
672 }
673}
674
675#############################################################################
676
677package CFClient::Widget::Label;
678
679our @ISA = CFClient::Widget::;
680
681use SDL::OpenGL;
682
683sub new {
684 my ($class, %arg) = @_;
685
686 # TODO: color, and make height, xyz etc. optional
687 my $self = $class->SUPER::new (
688 color => [1, 1, 1],
689 height => $::FONTSIZE,
690 text => "",
691 layout => new CFClient::Layout,
692 %arg
693 );
694
695 $self->set_text ($self->{text});
696
697 $self
698}
699
700sub set_text {
701 my ($self, $text) = @_;
702
703 $self->{text} = $text;
704 $self->{layout}->set_markup ($text);
705
706 delete $self->{texture};
707}
708
709sub get_text {
710 my ($self, $text) = @_;
711
712 $self->{text}
713}
714
715sub size_request {
716 my ($self) = @_;
717
718 $self->{layout}->set_width;
719 $self->{layout}->set_height ($self->{height});
720 $self->{layout}->size
721# if ($self->{texture}{width} > 1 && $self->{texture}{height} > 1) { #TODO: hack
722# (
723# $self->{texture}{width},
724# $self->{texture}{height},
725# )
726# } else {
727# my ($w, $h, $data) = CFClient::font_render "Yy", $self->{height};
728#
729# ($w, $h)
730# }
731}
732
733sub size_allocate {
734 my ($self, $w, $h) = @_;
735
736 $self->SUPER::size_allocate ($w, $h);
737 delete $self->{texture};
738}
739
740sub _draw {
741 my ($self) = @_;
742
743 my $tex = $self->{texture} ||= do {
744 $self->{layout}->set_width ($self->{w});
745 new_from_layout CFClient::Texture $self->{layout};
746 };
747
748 glEnable GL_BLEND;
749 glEnable GL_TEXTURE_2D;
750 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
751 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
752
753 glColor @{$self->{color}};
754
755 $tex->draw_quad (0, 0);
756
757 glDisable GL_BLEND;
758 glDisable GL_TEXTURE_2D;
759}
760
761#############################################################################
762
763package CFClient::Widget::Entry;
764
765our @ISA = CFClient::Widget::Label::;
766
767use SDL;
768use SDL::OpenGL;
769
770sub key_down {
771 my ($self, $ev) = @_;
772
773 my $mod = $ev->key_mod;
774 my $sym = $ev->key_sym;
775
776 my $uni = $ev->key_unicode;
777
778 my $text = $self->get_text;
779
780 if ($sym == SDLK_BACKSPACE) {
781 substr $text, -1, 1, '';
782 } elsif ($uni) {
783 $text .= chr $uni;
784 }
785
786 $self->set_text ($text);
787}
788
789sub button_down {
790 my ($self, $ev) = @_;
791
792 $self->focus_in;
793}
794
795sub mouse_motion {
796 my ($self, $ev, $x, $y) = @_;
797 printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
798}
799
800sub _draw {
801 my ($self) = @_;
802
803 if ($FOCUS == $self) {
804 glColor 1, 1, 1;
805 } else {
806 glColor 0.7, 0.7, 0.7;
807 }
808
809 glBegin GL_QUADS;
810 glVertex 0 , 0;
811 glVertex 0 , $self->{h} - 1;
812 glVertex $self->{w} - 1, $self->{h} - 1;
813 glVertex $self->{w} - 1, 0;
814 glEnd;
815
816 $self->SUPER::_draw;
817}
818
819#############################################################################
820
821package CFClient::Widget::MapWidget;
822
823use strict;
824
825use List::Util qw(min max);
826
827use SDL;
828use SDL::OpenGL;
829use SDL::OpenGL::Constants;
830
831our @ISA = CFClient::Widget::;
832
833sub new {
834 my $class = shift;
835
836 $class->SUPER::new (
837 z => -1,
838 list => (glGenLists 1),
839 @_
840 )
841}
842
843sub key_down {
844 print "MAPKEYDOWN\n";
845}
846
847sub key_up {
848}
849
850sub size_request {
851 (
852 1 + int $::WIDTH / 32,
853 1 + int $::HEIGHT / 32,
854 )
855}
856
857sub update {
858 my ($self) = @_;
859
860 $self->{need_update} = 1;
861}
862
863sub _draw {
864 my ($self) = @_;
865
866 if (delete $self->{need_update}) {
867 glNewList $self->{list}, GL_COMPILE;
868
869 my $mx = $::CONN->{mapx};
870 my $my = $::CONN->{mapy};
871
872 my $map = $::CONN->{map};
873
874 my ($xofs, $yofs);
875
876 my $sw = 1 + int $::WIDTH / 32;
877 my $sh = 1 + int $::HEIGHT / 32;
878
879 if ($::CONN->{mapw} > $sw) {
880 $xofs = $mx + ($::CONN->{mapw} - $sw) * 0.5;
881 } else {
882 $xofs = $self->{xofs} = min $mx, max $mx + $::CONN->{mapw} - $sw + 1, $self->{xofs};
883 }
884
885 if ($::CONN->{maph} > $sh) {
886 $yofs = $my + ($::CONN->{maph} - $sh) * 0.5;
887 } else {
888 $yofs = $self->{yofs} = min $my, max $my + $::CONN->{maph} - $sh + 1, $self->{yofs};
889 }
890
891 glEnable GL_TEXTURE_2D;
892 glEnable GL_BLEND;
893 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
894
895 my $sw4 = ($sw + 3) & ~3;
896 my $darkness = "\x00" x ($sw4 * $sh);
897
898 for my $x (0 .. $sw - 1) {
899 my $row = $map->[$x + $xofs];
900 for my $y (0 .. $sh - 1) {
901
902 my $cell = $row->[$y + $yofs]
903 or next;
904
905 my $dark = $cell->[0];
906 if ($dark < 0) {
907 substr $darkness, $y * $sw4 + $x, 1, chr 224;
908 } else {
909 substr $darkness, $y * $sw4 + $x, 1, chr 255 - $dark;
910 }
911
912 for my $num (grep $_, @$cell[1,2,3]) {
913 my $tex = $::CONN->{face}[$num]{texture} || next;
914
915 my $w = $tex->{width};
916 my $h = $tex->{height};
917
918 $tex->draw_quad (($x + 1) * 32 - $w, ($y + 1) * 32 - $h, $w, $h);
919 }
920 }
921 }
922
923# if (1) { # higher quality darkness
924# $lighting =~ s/(.)/$1$1$1/gs;
925# my $pb = new_from_data Gtk2::Gdk::Pixbuf $lighting, "rgb", 0, 8, $sw4, $sh, $sw4 * 3;
926#
927# $pb = $pb->scale_simple ($sw4 * 0.5, $sh * 0.5, "bilinear");
928#
929# $lighting = $pb->get_pixels;
930# $lighting =~ s/(.)../$1/gs;
931# }
932
933 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
934 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
935
936 $darkness = new CFClient::Texture
937 width => $sw4,
938 height => $sh,
939 data => $darkness,
940 internalformat => GL_ALPHA,
941 format => GL_ALPHA;
942
943 glColor 0.45, 0.45, 0.45, 1;
944 $darkness->draw_quad (0, 0, $sw4 * 32, $sh * 32);
945
946 glDisable GL_TEXTURE_2D;
947 glDisable GL_BLEND;
948
949 glEndList;
950 }
951
952 glCallList $self->{list};
953}
954
955my %DIR = (
956 SDLK_KP8, [1, "north"],
957 SDLK_KP9, [2, "northeast"],
958 SDLK_KP6, [3, "east"],
959 SDLK_KP3, [4, "southeast"],
960 SDLK_KP2, [5, "south"],
961 SDLK_KP1, [6, "southwest"],
962 SDLK_KP4, [7, "west"],
963 SDLK_KP7, [8, "northwest"],
964
965 SDLK_UP, [1, "north"],
966 SDLK_RIGHT, [3, "east"],
967 SDLK_DOWN, [5, "south"],
968 SDLK_LEFT, [7, "west"],
969);
970
971sub key_down {
972 my ($self, $ev) = @_;
973
974 my $mod = $ev->key_mod;
975 my $sym = $ev->key_sym;
976
977 if ($sym == SDLK_KP5) {
978 $::CONN->send ("command stay fire");
979 } elsif (exists $DIR{$sym}) {
980 if ($mod & KMOD_SHIFT) {
981 $self->{shft}++;
982 $::CONN->send ("command fire $DIR{$sym}[0]");
983 } elsif ($mod & KMOD_CTRL) {
984 $self->{ctrl}++;
985 $::CONN->send ("command run $DIR{$sym}[0]");
986 } else {
987 $::CONN->send ("command $DIR{$sym}[1]");
988 }
989 }
990}
991
992sub key_up {
993 my ($self, $ev) = @_;
994
995 my $mod = $ev->key_mod;
996 my $sym = $ev->key_sym;
997
998 if (!($mod & KMOD_SHIFT) && delete $self->{shft}) {
999 $::CONN->send ("command fire_stop");
1000 }
1001 if (!($mod & KMOD_CTRL ) && delete $self->{ctrl}) {
1002 $::CONN->send ("command run_stop");
1003 }
1004}
1005
1006#############################################################################
1007
1008package CFClient::Widget::Animator; 2659package CFClient::UI::Animator;
1009 2660
1010use SDL::OpenGL; 2661use CFClient::OpenGL;
1011 2662
1012our @ISA = CFClient::Widget::Bin::; 2663our @ISA = CFClient::UI::Bin::;
1013 2664
1014sub moveto { 2665sub moveto {
1015 my ($self, $x, $y) = @_; 2666 my ($self, $x, $y) = @_;
1016 2667
1017 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y]; 2668 $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
… …
1045 glPopMatrix; 2696 glPopMatrix;
1046} 2697}
1047 2698
1048############################################################################# 2699#############################################################################
1049 2700
1050package CFClient::Widget::Toplevel; 2701package CFClient::UI::Flopper;
1051 2702
2703our @ISA = CFClient::UI::Button::;
2704
2705sub new {
2706 my $class = shift;
2707
2708 my $self = $class->SUPER::new (
2709 state => 0,
2710 on_activate => \&toggle_flopper,
2711 @_
2712 );
2713
2714 $self
2715}
2716
2717sub toggle_flopper {
2718 my ($self) = @_;
2719
2720 $self->{other}->toggle_visibility;
2721}
2722
2723#############################################################################
2724
2725package CFClient::UI::Tooltip;
2726
1052our @ISA = CFClient::Widget::Container::; 2727our @ISA = CFClient::UI::Bin::;
2728
2729use CFClient::OpenGL;
2730
2731sub new {
2732 my $class = shift;
2733
2734 $class->SUPER::new (
2735 @_,
2736 can_events => 0,
2737 )
2738}
2739
2740sub set_tooltip_from {
2741 my ($self, $widget) = @_;
2742
2743 my $tooltip = $widget->{tooltip};
2744
2745 if ($ENV{CFPLUS_DEBUG} & 2) {
2746 $tooltip .= "\n\n" . (ref $widget) . "\n"
2747 . "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2748 . "req $widget->{req_w} $widget->{req_h}\n"
2749 . "visible $widget->{visible}";
2750 }
2751
2752 $self->add (new CFClient::UI::Label
2753 markup => $tooltip,
2754 max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2755 fontsize => 0.8,
2756 fg => [0, 0, 0, 1],
2757 ellipsise => 0,
2758 font => ($widget->{tooltip_font} || $::FONT_PROP),
2759 );
2760}
1053 2761
1054sub size_request { 2762sub size_request {
1055 ($::WIDTH, $::HEIGHT) 2763 my ($self) = @_;
2764
2765 my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2766
2767 ($w + 4, $h + 4)
1056} 2768}
1057 2769
1058sub size_allocate { 2770sub size_allocate {
1059 my ($self, $w, $h) = @_; 2771 my ($self, $w, $h) = @_;
1060 2772
1061 $self->SUPER::size_allocate ($w, $h); 2773 $self->SUPER::size_allocate ($w - 4, $h - 4);
2774}
1062 2775
1063 $_->size_allocate ($_->size_request) 2776sub visibility_change {
2777 my ($self, $visible) = @_;
2778
2779 return unless $visible;
2780
2781 $self->{root}->on_post_alloc ("move_$self" => sub {
2782 my $widget = $self->{owner}
2783 or return;
2784
2785 my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2786
2787 ($x, $y) = $widget->coord2global (-$self->{w}, 0)
2788 if $x + $self->{w} > $::WIDTH;
2789
2790 $self->move_abs ($x, $y);
2791 });
2792}
2793
2794sub _draw {
2795 my ($self) = @_;
2796
2797 glTranslate 0.375, 0.375;
2798
2799 my ($w, $h) = @$self{qw(w h)};
2800
2801 glColor 1, 0.8, 0.4;
2802 glBegin GL_QUADS;
2803 glVertex 0 , 0;
2804 glVertex 0 , $h;
2805 glVertex $w, $h;
2806 glVertex $w, 0;
2807 glEnd;
2808
2809 glColor 0, 0, 0;
2810 glBegin GL_LINE_LOOP;
2811 glVertex 0 , 0;
2812 glVertex 0 , $h;
2813 glVertex $w, $h;
2814 glVertex $w, 0;
2815 glEnd;
2816
2817 glTranslate 2 - 0.375, 2 - 0.375;
2818
2819 $self->SUPER::_draw;
2820}
2821
2822#############################################################################
2823
2824package CFClient::UI::Face;
2825
2826our @ISA = CFClient::UI::Base::;
2827
2828use CFClient::OpenGL;
2829
2830sub new {
2831 my $class = shift;
2832
2833 my $self = $class->SUPER::new (
2834 aspect => 1,
2835 can_events => 0,
2836 @_,
2837 );
2838
2839 if ($self->{anim} && $self->{animspeed}) {
2840 Scalar::Util::weaken (my $widget = $self);
2841
2842 $self->{timer} = Event->timer (
2843 at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2844 hard => 1,
2845 interval => $self->{animspeed},
2846 cb => sub {
2847 ++$widget->{frame};
2848 $widget->update;
2849 },
2850 );
2851 }
2852
2853 $self
2854}
2855
2856sub size_request {
2857 (32, 8)
2858}
2859
2860sub update {
2861 my ($self) = @_;
2862
2863 return unless $self->{visible};
2864
2865 $self->SUPER::update;
2866}
2867
2868sub _draw {
2869 my ($self) = @_;
2870
2871 return unless $::CONN;
2872
2873 my $face;
2874
2875 if ($self->{frame}) {
2876 my $anim = $::CONN->{anim}[$self->{anim}];
2877
2878 $face = $anim->[ $self->{frame} % @$anim ]
2879 if $anim && @$anim;
2880 }
2881
2882 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2883
2884 if ($tex) {
2885 glEnable GL_TEXTURE_2D;
2886 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2887 glColor 0, 0, 0, 1;
2888 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2889 glDisable GL_TEXTURE_2D;
2890 }
2891}
2892
2893sub DESTROY {
2894 my ($self) = @_;
2895
2896 $self->{timer}->cancel
2897 if $self->{timer};
2898
2899 $self->SUPER::DESTROY;
2900}
2901
2902#############################################################################
2903
2904package CFClient::UI::Buttonbar;
2905
2906our @ISA = CFClient::UI::HBox::;
2907
2908# TODO: should actualyl wrap buttons and other goodies.
2909
2910#############################################################################
2911
2912package CFClient::UI::Menu;
2913
2914our @ISA = CFClient::UI::FancyFrame::;
2915
2916use CFClient::OpenGL;
2917
2918sub new {
2919 my $class = shift;
2920
2921 my $self = $class->SUPER::new (
2922 items => [],
2923 z => 100,
2924 @_,
2925 );
2926
2927 $self->add ($self->{vbox} = new CFClient::UI::VBox);
2928
2929 for my $item (@{ $self->{items} }) {
2930 my ($widget, $cb, $tooltip) = @$item;
2931
2932 # handle various types of items, only text for now
2933 if (!ref $widget) {
2934 $widget = new CFClient::UI::Label
2935 can_hover => 1,
2936 can_events => 1,
2937 text => $widget,
2938 tooltip => $tooltip
2939 }
2940
2941 $self->{item}{$widget} = $item;
2942
2943 $self->{vbox}->add ($widget);
2944 }
2945
2946 $self
2947}
2948
2949# popup given the event (must be a mouse button down event currently)
2950sub popup {
2951 my ($self, $ev) = @_;
2952
2953 $self->_emit ("popdown");
2954
2955 # maybe save $GRAB? must be careful about events...
2956 $GRAB = $self;
2957 $self->{button} = $ev->{button};
2958
2959 $self->show;
2960 $self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2961}
2962
2963sub mouse_motion {
2964 my ($self, $ev, $x, $y) = @_;
2965
2966 # TODO: should use vbox->find_widget or so
2967 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2968 $self->{hover} = $self->{item}{$HOVER};
2969
2970 0
2971}
2972
2973sub button_up {
2974 my ($self, $ev, $x, $y) = @_;
2975
2976 if ($ev->{button} == $self->{button}) {
2977 undef $GRAB;
2978 $self->hide;
2979
2980 $self->_emit ("popdown");
2981 $self->{hover}[1]->() if $self->{hover};
2982 } else {
2983 return 0
2984 }
2985
2986 1
2987}
2988
2989#############################################################################
2990
2991package CFClient::UI::Multiplexer;
2992
2993our @ISA = CFClient::UI::Container::;
2994
2995sub new {
2996 my $class = shift;
2997
2998 my $self = $class->SUPER::new (
2999 @_,
3000 );
3001
3002 $self->{current} = $self->{children}[0]
1064 for @{$self->{children}}; 3003 if @{ $self->{children} };
1065}
1066 3004
1067sub translate { 3005 $self
3006}
3007
3008sub add {
3009 my ($self, @widgets) = @_;
3010
3011 $self->SUPER::add (@widgets);
3012
3013 $self->{current} = $self->{children}[0]
3014 if @{ $self->{children} };
3015}
3016
3017sub set_current_page {
3018 my ($self, $page_or_widget) = @_;
3019
3020 my $widget = ref $page_or_widget
3021 ? $page_or_widget
3022 : $self->{children}[$page_or_widget];
3023
3024 $self->{current} = $widget;
3025 $self->{current}->configure (0, 0, $self->{w}, $self->{h});
3026
3027 $self->_emit (page_changed => $self->{current});
3028
3029 $self->realloc;
3030}
3031
3032sub visible_children {
3033 $_[0]{current}
3034}
3035
3036sub size_request {
3037 my ($self) = @_;
3038
3039 $self->{current}->size_request
3040}
3041
3042sub size_allocate {
3043 my ($self, $w, $h) = @_;
3044
3045 $self->{current}->configure (0, 0, $w, $h);
3046}
3047
3048sub _draw {
3049 my ($self) = @_;
3050
3051 $self->{current}->draw;
3052}
3053
3054#############################################################################
3055
3056package CFClient::UI::Notebook;
3057
3058our @ISA = CFClient::UI::VBox::;
3059
3060sub new {
3061 my $class = shift;
3062
3063 my $self = $class->SUPER::new (
3064 buttonbar => (new CFClient::UI::Buttonbar),
3065 multiplexer => (new CFClient::UI::Multiplexer expand => 1),
3066 # filter => # will be put between multiplexer and $self
3067 @_,
3068 );
3069
3070 $self->{filter}->add ($self->{multiplexer}) if $self->{filter};
3071 $self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
3072
3073 $self
3074}
3075
3076sub add {
3077 my ($self, $title, $widget, $tooltip) = @_;
3078
3079 Scalar::Util::weaken $self;
3080
3081 $self->{buttonbar}->add (new CFClient::UI::Button
3082 markup => $title,
3083 tooltip => $tooltip,
3084 on_activate => sub { $self->set_current_page ($widget) },
3085 );
3086
3087 $self->{multiplexer}->add ($widget);
3088}
3089
3090sub set_current_page {
3091 my ($self, $page) = @_;
3092
3093 $self->{multiplexer}->set_current_page ($page);
3094 $self->_emit (page_changed => $self->{multiplexer}{current});
3095}
3096
3097#############################################################################
3098
3099package CFClient::UI::Combobox;
3100
3101use utf8;
3102
3103our @ISA = CFClient::UI::Button::;
3104
3105sub new {
3106 my $class = shift;
3107
3108 my $self = $class->SUPER::new (
3109 options => [], # [title, value, tooltip], ...
3110 value => undef,
3111 @_,
3112 );
3113
3114 $self->_set_value ($self->{value});
3115
3116 $self
3117}
3118
3119sub button_down {
3120 my ($self, $ev) = @_;
3121
3122 my @menu_items;
3123
3124 for (@{ $self->{options} }) {
3125 my ($title, $value, $tooltip) = @$_;
3126
3127 push @menu_items, [$tooltip, sub { $self->set_value ($value) }];
3128 }
3129
3130 CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
3131}
3132
3133sub _set_value {
3134 my ($self, $value) = @_;
3135
3136 my ($item) = grep $_->[1] eq $value, @{ $self->{options} }
3137 or return;
3138
3139 $self->{value} = $item->[1];
3140 $self->set_markup ("$item->[0] ⇓");
3141 $self->set_tooltip ($item->[2]);
3142}
3143
3144sub set_value {
3145 my ($self, $value) = @_;
3146
3147 return unless $self->{value} ne $value;
3148
3149 $self->_set_value ($value);
3150 $self->_emit (changed => $value);
3151}
3152
3153#############################################################################
3154
3155package CFClient::UI::Statusbox;
3156
3157our @ISA = CFClient::UI::VBox::;
3158
3159sub new {
3160 my $class = shift;
3161
3162 my $self = $class->SUPER::new (
3163 fontsize => 0.8,
3164 @_,
3165 );
3166
3167 Scalar::Util::weaken (my $this = $self);
3168
3169 $self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
3170
3171 $self
3172}
3173
3174sub reorder {
3175 my ($self) = @_;
3176 my $NOW = Time::HiRes::time;
3177
3178 # freeze display when hovering over any label
3179 return if $CFClient::UI::TOOLTIP->{owner}
3180 && grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
3181 values %{ $self->{item} };
3182
3183 while (my ($k, $v) = each %{ $self->{item} }) {
3184 delete $self->{item}{$k} if $v->{timeout} < $NOW;
3185 }
3186
3187 my @widgets;
3188
3189 my @items = sort {
3190 $a->{pri} <=> $b->{pri}
3191 or $b->{id} <=> $a->{id}
3192 } values %{ $self->{item} };
3193
3194 $self->{timer}->interval (1);
3195
3196 my $count = 10 + 1;
3197 for my $item (@items) {
3198 last unless --$count;
3199
3200 my $label = $item->{label} ||= do {
3201 # TODO: doesn't handle markup well (read as: at all)
3202 my $short = $item->{count} > 1
3203 ? "<b>$item->{count} ×</b> $item->{text}"
3204 : $item->{text};
3205
3206 for ($short) {
3207 s/^\s+//;
3208 s/\s+/ /g;
3209 }
3210
3211 new CFClient::UI::Label
3212 markup => $short,
3213 tooltip => $item->{tooltip},
3214 tooltip_font => $::FONT_PROP,
3215 tooltip_width => 0.67,
3216 fontsize => $item->{fontsize} || $self->{fontsize},
3217 max_w => $::WIDTH * 0.44,
3218 fg => [@{ $item->{fg} }],
3219 can_events => 1,
3220 can_hover => 1
3221 };
3222
3223 if ((my $diff = $item->{timeout} - $NOW) < 2) {
3224 $label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
3225 $label->update;
3226 $label->set_max_size (undef, $label->{req_h} * $diff)
3227 if $diff < 1;
3228 $self->{timer}->interval (1/30);
3229 } else {
3230 $label->{fg}[3] = $item->{fg}[3] || 1;
3231 }
3232
3233 push @widgets, $label;
3234 }
3235
3236 $self->clear;
3237 $self->SUPER::add (reverse @widgets);
3238}
3239
3240sub add {
3241 my ($self, $text, %arg) = @_;
3242
3243 $text =~ s/^\s+//;
3244 $text =~ s/\s+$//;
3245
3246 return unless $text;
3247
3248 my $timeout = (int time) + ((delete $arg{timeout}) || 60);
3249
3250 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
3251
3252 if (my $item = $self->{item}{$group}) {
3253 if ($item->{text} eq $text) {
3254 $item->{count}++;
3255 } else {
3256 $item->{count} = 1;
3257 $item->{text} = $item->{tooltip} = $text;
3258 }
3259 $item->{id} = ++$self->{id};
3260 $item->{timeout} = $timeout;
3261 delete $item->{label};
3262 } else {
3263 $self->{item}{$group} = {
3264 id => ++$self->{id},
3265 text => $text,
3266 timeout => $timeout,
3267 tooltip => $text,
3268 fg => [0.8, 0.8, 0.8, 0.8],
3269 pri => 0,
3270 count => 1,
3271 %arg,
3272 };
3273 }
3274
3275 $self->reorder;
3276}
3277
3278sub reconfigure {
3279 my ($self) = @_;
3280
3281 delete $_->{label}
3282 for values %{ $self->{item} || {} };
3283
3284 $self->reorder;
3285 $self->SUPER::reconfigure;
3286}
3287
3288sub DESTROY {
3289 my ($self) = @_;
3290
3291 $self->{timer}->cancel;
3292
3293 $self->SUPER::DESTROY;
3294}
3295
3296#############################################################################
3297
3298package CFClient::UI::Inventory;
3299
3300our @ISA = CFClient::UI::ScrolledWindow::;
3301
3302sub new {
3303 my $class = shift;
3304
3305 my $self = $class->SUPER::new (
3306 child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3307 @_,
3308 );
3309
3310 $self
3311}
3312
3313sub set_items {
3314 my ($self, $items) = @_;
3315
3316 $self->{child}->clear;
3317 return unless $items;
3318
3319 my @items = sort {
3320 ($a->{type} <=> $b->{type})
3321 or ($a->{name} cmp $b->{name})
3322 } @$items;
3323
3324 $self->{real_items} = \@items;
3325
3326 my $row = 0;
3327 for my $item (@items) {
3328 CFClient::Item::update_widgets $item;
3329
3330 $self->{child}->add (0, $row, $item->{face_widget});
3331 $self->{child}->add (1, $row, $item->{desc_widget});
3332 $self->{child}->add (2, $row, $item->{weight_widget});
3333
3334 $row++;
3335 }
3336}
3337
3338#############################################################################
3339
3340package CFClient::UI::BindEditor;
3341
3342our @ISA = CFClient::UI::FancyFrame::;
3343
3344sub new {
3345 my $class = shift;
3346
3347 my $self = $class->SUPER::new (binding => [], commands => [], @_);
3348
3349 $self->add (my $vb = new CFClient::UI::VBox);
3350
3351
3352 $vb->add ($self->{rec_btn} = new CFClient::UI::Button
3353 text => "start recording",
3354 tooltip => "Start/Stops recording of actions."
3355 ."All subsequent actions after the recording started will be captured."
3356 ."The actions are displayed after the record was stopped."
3357 ."To bind the action you have to click on the 'Bind' button",
3358 on_activate => sub {
3359 unless ($self->{recording}) {
3360 $self->start;
3361 } else {
3362 $self->stop;
3363 }
3364 });
3365
3366 $vb->add (new CFClient::UI::Label text => "Actions:");
3367 $vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3368
3369 $vb->add (new CFClient::UI::Label text => "Bound to: ");
3370 $vb->add (my $hb = new CFClient::UI::HBox);
3371 $hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3372 $hb->add (new CFClient::UI::Button
3373 text => "bind",
3374 tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3375 on_activate => sub {
3376 $self->ask_for_bind;
3377 });
3378
3379 $vb->add (my $hb = new CFClient::UI::HBox);
3380 $hb->add (new CFClient::UI::Button
3381 text => "ok",
3382 expand => 1,
3383 tooltip => "This closes the binding editor and saves the binding",
3384 on_activate => sub {
3385 $self->hide;
3386 $self->commit;
3387 });
3388
3389 $hb->add (new CFClient::UI::Button
3390 text => "cancel",
3391 expand => 1,
3392 tooltip => "This closes the binding editor without saving",
3393 on_activate => sub {
3394 $self->hide;
3395 $self->{binding_cancel}->()
3396 if $self->{binding_cancel};
3397 });
3398
3399 $self->update_binding_widgets;
3400
3401 $self
3402}
3403
3404sub commit {
3405 my ($self) = @_;
3406 my ($mod, $sym, $cmds) = $self->get_binding;
3407 if ($sym != 0 && @$cmds > 0) {
3408 $::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3409 ."'. Don't forget 'Save Config'!");
3410 $self->{binding_change}->($mod, $sym, $cmds)
3411 if $self->{binding_change};
3412 } else {
3413 $::STATUSBOX->add ("No action bound, no key or action specified!");
3414 $self->{binding_cancel}->()
3415 if $self->{binding_cancel};
3416 }
3417}
3418
3419sub start {
3420 my ($self) = @_;
3421
3422 $self->{rec_btn}->set_text ("stop recording");
3423 $self->{recording} = 1;
3424 $self->clear_command_list;
3425 $::CONN->start_record if $::CONN;
3426}
3427
3428sub stop {
3429 my ($self) = @_;
3430
3431 $self->{rec_btn}->set_text ("start recording");
3432 $self->{recording} = 0;
3433
3434 my $rec;
3435 $rec = $::CONN->stop_record if $::CONN;
3436 return unless ref $rec eq 'ARRAY';
3437 $self->set_command_list ($rec);
3438}
3439
3440
3441sub ask_for_bind_and_commit {
3442 my ($self) = @_;
3443 $self->ask_for_bind (1);
3444}
3445
3446sub ask_for_bind {
3447 my ($self, $commit) = @_;
3448
3449 CFClient::Binder::open_binding_dialog (sub {
3450 my ($mod, $sym) = @_;
3451 $self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3452 $self->update_binding_widgets;
3453 $self->commit if $commit;
3454 });
3455}
3456
3457# $mod and $sym are the modifiers and key symbol
3458# $cmds is a array ref of strings (the commands)
3459# $cb is the callback that is executed on OK
3460# $ccb is the callback that is executed on CANCEL and
3461# when the binding was unsuccessful on OK
3462sub set_binding {
3463 my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3464
3465 $self->clear_command_list;
3466 $self->{recording} = 0;
3467 $self->{rec_btn}->set_text ("start recording");
3468
3469 $self->{binding} = [$mod, $sym];
3470 $self->{commands} = $cmds;
3471
3472 $self->{binding_change} = $cb;
3473 $self->{binding_cancel} = $ccb;
3474
3475 $self->update_binding_widgets;
3476}
3477
3478# this is a shortcut method that asks for a binding
3479# and then just binds it.
3480sub do_quick_binding {
3481 my ($self, $cmds) = @_;
3482 $self->set_binding (undef, undef, $cmds, sub {
3483 $::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3484 });
3485 $self->ask_for_bind (1);
3486}
3487
3488sub update_binding_widgets {
3489 my ($self) = @_;
3490 my ($mod, $sym, $cmds) = $self->get_binding;
3491 $self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3492 $self->set_command_list ($cmds);
3493}
3494
3495sub get_binding {
3496 my ($self) = @_;
3497 return (
3498 $self->{binding}->[0],
3499 $self->{binding}->[1],
3500 [ grep { defined $_ } @{$self->{commands}} ]
3501 );
3502}
3503
3504sub clear_command_list {
3505 my ($self) = @_;
3506 $self->{cmdbox}->clear ();
3507}
3508
3509sub set_command_list {
3510 my ($self, $cmds) = @_;
3511
3512 $self->{cmdbox}->clear ();
3513 $self->{commands} = $cmds;
3514
3515 my $idx = 0;
3516
3517 for (@$cmds) {
3518 $self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3519
3520 my $i = $idx;
3521 $hb->add (new CFClient::UI::Label text => $_);
3522 $hb->add (new CFClient::UI::Button
3523 text => "delete",
3524 tooltip => "Deletes the action from the record",
3525 on_activate => sub {
3526 $self->{cmdbox}->remove ($hb);
3527 $cmds->[$i] = undef;
3528 });
3529
3530
3531 $idx++
3532 }
3533}
3534
3535#############################################################################
3536
3537package CFClient::UI::SpellList;
3538
3539our @ISA = CFClient::UI::Table::;
3540
3541sub new {
3542 my $class = shift;
3543
3544 my $self = $class->SUPER::new (
3545 binding => [],
3546 commands => [],
3547 @_,
3548 )
3549}
3550
3551my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3552 "<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.");
3553my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3554 "<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.");
3555my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3556 "<b>Damage</b>. The amount of damage the spell deals when it hits.");
3557
3558sub rebuild_spell_list {
3559 my ($self) = @_;
3560
3561 $CFClient::UI::ROOT->on_refresh ($self => sub {
3562 $self->clear;
3563
3564 $self->add (1, 0, new CFClient::UI::Label text => "Spell Name");
3565 $self->add (2, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3566 $self->add (3, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3567 $self->add (4, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3568
3569 my $row = 0;
3570
3571 for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3572 my $spell = $self->{spell}{$_};
3573
3574 $row++;
3575
3576 $self->add (0, $row, new CFClient::UI::Face
3577 face => $spell->{face},
3578 can_hover => 1,
3579 can_events => 1,
3580 tooltip => $spell->{message},
3581 );
3582
3583 $self->add (1, $row, new CFClient::UI::Label
3584 expand => 1,
3585 text => $spell->{name},
3586 can_hover => 1,
3587 can_events => 1,
3588 tooltip => $spell->{message},
3589 );
3590
3591 $self->add (2, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3592 $self->add (3, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3593 $self->add (4, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3594
3595 # TODO: should be done via popup
3596 $self->add (5, $row, new CFClient::UI::Button
3597 text => "bind",
3598 tooltip => "bind spell readying (cast command) to key",
3599 on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) },
3600 );
3601 }
3602 });
3603}
3604
3605sub add_spell {
3606 my ($self, $spell) = @_;
3607
3608 $self->{spell}->{$spell->{name}} = $spell;
3609 $self->rebuild_spell_list;
3610}
3611
3612sub remove_spell {
3613 my ($self, $spell) = @_;
3614
3615 delete $self->{spell}->{$spell->{name}};
3616 $self->rebuild_spell_list;
3617}
3618
3619#############################################################################
3620
3621package CFClient::UI::Root;
3622
3623our @ISA = CFClient::UI::Container::;
3624
3625use List::Util qw(min max);
3626
3627use CFClient::OpenGL;
3628
3629sub new {
3630 my $class = shift;
3631
3632 my $self = $class->SUPER::new (
3633 visible => 1,
3634 @_,
3635 );
3636
3637 Scalar::Util::weaken ($self->{root} = $self);
3638
3639 $self
3640}
3641
3642sub size_request {
3643 my ($self) = @_;
3644
3645 ($self->{w}, $self->{h})
3646}
3647
3648sub _to_pixel {
3649 my ($coord, $size, $max) = @_;
3650
3651 $coord =
3652 $coord eq "center" ? ($max - $size) * 0.5
3653 : $coord eq "max" ? $max
3654 : $coord;
3655
3656 $coord = 0 if $coord < 0;
3657 $coord = $max - $size if $coord > $max - $size;
3658
3659 int $coord + 0.5
3660}
3661
3662sub size_allocate {
3663 my ($self, $w, $h) = @_;
3664
3665 for my $child ($self->children) {
3666 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3667
3668 $X = $child->{force_x} if exists $child->{force_x};
3669 $Y = $child->{force_y} if exists $child->{force_y};
3670
3671 $X = _to_pixel $X, $W, $self->{w};
3672 $Y = _to_pixel $Y, $H, $self->{h};
3673
3674 $child->configure ($X, $Y, $W, $H);
3675 }
3676}
3677
3678sub coord2local {
1068 my ($self, $x, $y) = @_; 3679 my ($self, $x, $y) = @_;
1069 3680
1070 ($x, $y) 3681 ($x, $y)
1071} 3682}
1072 3683
3684sub coord2global {
3685 my ($self, $x, $y) = @_;
3686
3687 ($x, $y)
3688}
3689
1073sub update { 3690sub update {
1074 my ($self) = @_; 3691 my ($self) = @_;
1075 3692
1076 $self->size_allocate ($self->size_request); 3693 $::WANT_REFRESH++;
1077 ::refresh ();
1078} 3694}
1079 3695
1080sub add { 3696sub add {
1081 my ($self, $widget) = @_; 3697 my ($self, @children) = @_;
1082 3698
3699 $_->{is_toplevel} = 1
3700 for @children;
3701
1083 $self->SUPER::add ($widget); 3702 $self->SUPER::add (@children);
1084
1085 $widget->size_allocate ($widget->size_request);
1086} 3703}
1087 3704
3705sub remove {
3706 my ($self, @children) = @_;
3707
3708 $self->SUPER::remove (@children);
3709
3710 delete $self->{is_toplevel}
3711 for @children;
3712
3713 while (@children) {
3714 my $w = pop @children;
3715 push @children, $w->children;
3716 $w->set_invisible;
3717 }
3718}
3719
3720sub on_refresh {
3721 my ($self, $id, $cb) = @_;
3722
3723 $self->{refresh_hook}{$id} = $cb;
3724}
3725
3726sub on_post_alloc {
3727 my ($self, $id, $cb) = @_;
3728
3729 $self->{post_alloc_hook}{$id} = $cb;
3730}
3731
1088sub draw { 3732sub draw {
1089 my ($self) = @_; 3733 my ($self) = @_;
3734
3735 while ($self->{refresh_hook}) {
3736 $_->()
3737 for values %{delete $self->{refresh_hook}};
3738 }
3739
3740 if ($self->{realloc}) {
3741 my %queue;
3742 my @queue;
3743 my $widget;
3744
3745 outer:
3746 while () {
3747 if (my $realloc = delete $self->{realloc}) {
3748 for $widget (values %$realloc) {
3749 $widget->{visible} or next; # do not resize invisible widgets
3750
3751 $queue{$widget+0}++ and next; # duplicates are common
3752
3753 push @{ $queue[$widget->{visible}] }, $widget;
3754 }
3755 }
3756
3757 while () {
3758 @queue or last outer;
3759
3760 $widget = pop @{ $queue[-1] || [] }
3761 and last;
3762
3763 pop @queue;
3764 }
3765
3766 delete $queue{$widget+0};
3767
3768 my ($w, $h) = $widget->size_request;
3769
3770 $w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3771 $h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3772
3773 $w = min $widget->{max_w}, $w if exists $widget->{max_w};
3774 $h = min $widget->{max_h}, $h if exists $widget->{max_h};
3775
3776 $w = $widget->{force_w} if exists $widget->{force_w};
3777 $h = $widget->{force_h} if exists $widget->{force_h};
3778
3779 if ($widget->{req_w} != $w || $widget->{req_h} != $h
3780 || delete $widget->{force_realloc}) {
3781 $widget->{req_w} = $w;
3782 $widget->{req_h} = $h;
3783
3784 $self->{size_alloc}{$widget+0} = $widget;
3785
3786 if (my $parent = $widget->{parent}) {
3787 $self->{realloc}{$parent+0} = $parent
3788 unless $queue{$parent+0};
3789
3790 $parent->{force_size_alloc} = 1;
3791 $self->{size_alloc}{$parent+0} = $parent;
3792 }
3793 }
3794
3795 delete $self->{realloc}{$widget+0};
3796 }
3797 }
3798
3799 while (my $size_alloc = delete $self->{size_alloc}) {
3800 my @queue = sort { $b->{visible} <=> $a->{visible} }
3801 values %$size_alloc;
3802
3803 while () {
3804 my $widget = pop @queue || last;
3805
3806 my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3807
3808 $w = 0 if $w < 0;
3809 $h = 0 if $h < 0;
3810
3811 $w = int $w + 0.5;
3812 $h = int $h + 0.5;
3813
3814 if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3815 $widget->{old_w} = $widget->{w};
3816 $widget->{old_h} = $widget->{h};
3817
3818 $widget->{w} = $w;
3819 $widget->{h} = $h;
3820
3821 $widget->emit (size_allocate => $w, $h);
3822 }
3823 }
3824 }
3825
3826 while ($self->{post_alloc_hook}) {
3827 $_->()
3828 for values %{delete $self->{post_alloc_hook}};
3829 }
3830
3831
3832 glViewport 0, 0, $::WIDTH, $::HEIGHT;
3833 glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3834 glClear GL_COLOR_BUFFER_BIT;
3835
3836 glMatrixMode GL_PROJECTION;
3837 glLoadIdentity;
3838 glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3839 glMatrixMode GL_MODELVIEW;
3840 glLoadIdentity;
3841
3842 {
3843 package CFClient::UI::Base;
3844
3845 ($draw_x, $draw_y, $draw_w, $draw_h) =
3846 (0, 0, $self->{w}, $self->{h});
3847 }
1090 3848
1091 $self->_draw; 3849 $self->_draw;
1092} 3850}
1093 3851
1094############################################################################# 3852#############################################################################
1095 3853
1096package CFClient::Widget; 3854package CFClient::UI;
1097 3855
1098$TOPLEVEL = new CFClient::Widget::Toplevel; 3856$ROOT = new CFClient::UI::Root;
3857$TOOLTIP = new CFClient::UI::Tooltip z => 900;
1099 3858
11001 38591
1101 3860

Diff Legend

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