ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.208
Committed: Mon May 15 22:52:17 2006 UTC (18 years ago) by root
Branch: MAIN
Changes since 1.207: +10 -9 lines
Log Message:
fix label offset, fix entry resize

File Contents

# User Rev Content
1 root 1.73 package CFClient::UI;
2 root 1.8
3 root 1.194 use utf8;
4 elmex 1.1 use strict;
5 root 1.18
6 root 1.74 use Scalar::Util ();
7     use List::Util ();
8 root 1.18
9 root 1.60 use CFClient;
10 root 1.41
11 root 1.51 our ($FOCUS, $HOVER, $GRAB); # various widgets
12    
13 root 1.113 our $ROOT;
14 root 1.151 our $TOOLTIP;
15 root 1.51 our $BUTTON_STATE;
16    
17 root 1.202 our %WIDGET; # all widgets, weak-referenced
18    
19 root 1.151 sub check_tooltip {
20     if (!$GRAB) {
21     for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
22 root 1.160 if (length $widget->{tooltip}) {
23 root 1.151
24     if ($TOOLTIP->{owner} != $widget) {
25     $TOOLTIP->{owner} = $widget;
26 root 1.155
27     my $tip = $widget->{tooltip};
28    
29     $tip = $tip->($widget) if CODE:: eq ref $tip;
30    
31 root 1.196 $TOOLTIP->set_tooltip_from ($widget);
32 root 1.151 $TOOLTIP->show;
33 root 1.174
34     my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
35    
36 root 1.204 ($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
37     if $x + $TOOLTIP->{w} > $::WIDTH;
38 root 1.174
39     $TOOLTIP->move ($x, $y);
40 root 1.197 $TOOLTIP->check_size;
41     $TOOLTIP->update;
42 root 1.151 }
43    
44     return;
45     }
46     }
47     }
48    
49     $TOOLTIP->hide;
50     delete $TOOLTIP->{owner};
51     }
52    
53 elmex 1.1 # class methods for events
54 root 1.51 sub feed_sdl_key_down_event {
55 root 1.163 $FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0])
56     if $FOCUS;
57 root 1.51 }
58    
59     sub feed_sdl_key_up_event {
60 root 1.163 $FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0])
61     if $FOCUS;
62 root 1.51 }
63    
64     sub feed_sdl_button_down_event {
65     my ($ev) = @_;
66 root 1.137 my ($x, $y) = ($ev->{x}, $ev->{y});
67 root 1.51
68     if (!$BUTTON_STATE) {
69 root 1.113 my $widget = $ROOT->find_widget ($x, $y);
70 root 1.51
71     $GRAB = $widget;
72     $GRAB->update if $GRAB;
73 root 1.151
74     check_tooltip;
75 root 1.51 }
76    
77 root 1.137 $BUTTON_STATE |= 1 << ($ev->{button} - 1);
78 root 1.51
79 root 1.163 if ($GRAB) {
80     ($x, $y) = $GRAB->coord2local ($x, $y);
81     $GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
82     }
83 root 1.51 }
84    
85     sub feed_sdl_button_up_event {
86     my ($ev) = @_;
87 root 1.137 my ($x, $y) = ($ev->{x}, $ev->{y});
88 root 1.51
89 root 1.113 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
90 root 1.51
91 root 1.137 $BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
92 root 1.51
93 root 1.163 if ($GRAB) {
94     ($x, $y) = $GRAB->coord2local ($x, $y);
95     $GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
96     }
97 root 1.58
98 root 1.51 if (!$BUTTON_STATE) {
99     my $grab = $GRAB; undef $GRAB;
100     $grab->update if $grab;
101     $GRAB->update if $GRAB;
102 root 1.151
103     check_tooltip;
104 root 1.51 }
105     }
106    
107     sub feed_sdl_motion_event {
108     my ($ev) = @_;
109 root 1.137 my ($x, $y) = ($ev->{x}, $ev->{y});
110 root 1.51
111 root 1.113 my $widget = $GRAB || $ROOT->find_widget ($x, $y);
112 root 1.51
113     if ($widget != $HOVER) {
114     my $hover = $HOVER; $HOVER = $widget;
115    
116 root 1.105 $hover->update if $hover && $hover->{can_hover};
117     $HOVER->update if $HOVER && $HOVER->{can_hover};
118 root 1.151
119     check_tooltip;
120 root 1.51 }
121    
122 root 1.163 if ($HOVER) {
123     ($x, $y) = $HOVER->coord2local ($x, $y);
124     $HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y);
125     }
126 root 1.51 }
127 elmex 1.1
128 root 1.112 # convert position array to integers
129     sub harmonize {
130     my ($vals) = @_;
131    
132     my $rem = 0;
133    
134 root 1.116 for (@$vals) {
135 root 1.112 my $i = int $_ + $rem;
136     $rem += $_ - $i;
137     $_ = $i;
138     }
139     }
140    
141 root 1.202 # call when resolution changes etc.
142     sub rescale_widgets {
143     my ($sx, $sy) = @_;
144    
145     for my $widget (values %WIDGET) {
146     if ($widget->{toplevel}) {
147     $widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};
148     $widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
149     $widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};
150     $widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
151     $widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};
152     $widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
153     $widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};
154     $widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h};
155     }
156    
157     $widget->reconfigure;
158     }
159     }
160    
161 root 1.73 #############################################################################
162    
163     package CFClient::UI::Base;
164    
165     use strict;
166    
167 root 1.138 use CFClient::OpenGL;
168 root 1.73
169 elmex 1.1 sub new {
170     my $class = shift;
171 root 1.10
172 root 1.79 my $self = bless {
173 root 1.164 x => 0,
174     y => 0,
175     z => 0,
176 elmex 1.150 can_events => 1,
177 root 1.65 @_
178 root 1.79 }, $class;
179    
180     for (keys %$self) {
181     if (/^connect_(.*)$/) {
182     $self->connect ($1 => delete $self->{$_});
183     }
184     }
185    
186 root 1.202 Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
187    
188 root 1.79 $self
189 elmex 1.1 }
190    
191 root 1.159 sub destroy {
192     my ($self) = @_;
193    
194     $self->hide;
195     %$self = ();
196     }
197    
198 root 1.134 sub show {
199     my ($self) = @_;
200    
201     return if $self->{parent};
202    
203     $CFClient::UI::ROOT->add ($self);
204     }
205    
206     sub hide {
207     my ($self) = @_;
208    
209 root 1.163 undef $GRAB if $GRAB == $self;
210     undef $HOVER if $HOVER == $self;
211 root 1.134
212 root 1.163 $self->{parent}->remove ($self)
213     if $self->{parent};
214 root 1.134 }
215    
216 root 1.18 sub move {
217     my ($self, $x, $y, $z) = @_;
218 root 1.128
219 root 1.117 $self->{x} = int $x;
220     $self->{y} = int $y;
221 root 1.18 $self->{z} = $z if defined $z;
222 root 1.128
223     $self->update;
224 root 1.18 }
225    
226 root 1.158 sub set_size {
227     my ($self, $w, $h) = @_;
228    
229     $self->{user_w} = $w;
230     $self->{user_h} = $h;
231    
232     $self->check_size;
233 elmex 1.20 }
234    
235 root 1.14 sub size_request {
236 elmex 1.36 require Carp;
237 root 1.147 Carp::confess "size_request is abstract";
238 elmex 1.36 }
239    
240 root 1.128 sub configure {
241 root 1.75 my ($self, $x, $y, $w, $h) = @_;
242    
243 root 1.141 if ($self->{aspect}) {
244     my $w2 = List::Util::min $w, int $h * $self->{aspect};
245     my $h2 = List::Util::min $h, int $w / $self->{aspect};
246    
247     # use alignment to adjust x, y
248 root 1.75
249 root 1.147 $x += int +($w - $w2) * 0.5;
250     $y += int +($h - $h2) * 0.5;
251 root 1.141
252     ($w, $h) = ($w2, $h2);
253 root 1.140 }
254    
255 root 1.141 if ($self->{x} != $x || $self->{y} != $y) {
256     $self->{x} = $x;
257     $self->{y} = $y;
258     $self->update;
259     }
260 root 1.40
261 root 1.141 if ($self->{w} != $w || $self->{h} != $h) {
262 root 1.191 $CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h];
263 root 1.141 }
264 root 1.75 }
265    
266     sub size_allocate {
267 root 1.128 # nothing to be done
268 root 1.14 }
269    
270 root 1.173 sub reconfigure {
271     my ($self) = @_;
272    
273 root 1.198 $self->check_size (1);
274 root 1.186 $self->update;
275 root 1.173 }
276    
277 root 1.202 sub children {
278     }
279    
280 root 1.157 sub set_max_size {
281     my ($self, $w, $h) = @_;
282    
283     delete $self->{max_w}; $self->{max_w} = $w if $w;
284     delete $self->{max_h}; $self->{max_h} = $h if $h;
285     }
286    
287 root 1.82 # translate global coordinates to local coordinate system
288 root 1.113 sub coord2local {
289 root 1.58 my ($self, $x, $y) = @_;
290    
291 root 1.191 $self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
292 root 1.113 }
293    
294     # translate local coordinates to global coordinate system
295     sub coord2global {
296     my ($self, $x, $y) = @_;
297    
298 root 1.191 $self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
299 root 1.58 }
300    
301 elmex 1.1 sub focus_in {
302 root 1.51 my ($self) = @_;
303    
304 root 1.68 return if $FOCUS == $self;
305 root 1.97 return unless $self->{can_focus};
306 root 1.68
307 root 1.51 my $focus = $FOCUS; $FOCUS = $self;
308 elmex 1.120
309     $self->emit (focus_in => $focus);
310    
311 root 1.51 $focus->update if $focus;
312     $FOCUS->update;
313 elmex 1.1 }
314 root 1.4
315 elmex 1.1 sub focus_out {
316 root 1.51 my ($self) = @_;
317 root 1.4
318 root 1.51 return unless $FOCUS == $self;
319 root 1.4
320 root 1.51 my $focus = $FOCUS; undef $FOCUS;
321 elmex 1.120
322     $self->emit (focus_out => $focus);
323    
324 root 1.51 $focus->update if $focus; #?
325 elmex 1.1 }
326 root 1.4
327 root 1.51 sub mouse_motion { }
328     sub button_up { }
329     sub key_down { }
330     sub key_up { }
331    
332 root 1.68 sub button_down {
333     my ($self, $ev, $x, $y) = @_;
334    
335     $self->focus_in;
336     }
337    
338 root 1.51 sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
339     sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
340     sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
341     sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
342     sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
343 elmex 1.11
344 elmex 1.1 sub draw {
345 elmex 1.11 my ($self) = @_;
346    
347 root 1.68 return unless $self->{h} && $self->{w};
348    
349 elmex 1.11 glPushMatrix;
350 root 1.12 glTranslate $self->{x}, $self->{y}, 0;
351 elmex 1.11 $self->_draw;
352 root 1.72 glPopMatrix;
353    
354 root 1.97 if ($self == $HOVER && $self->{can_hover}) {
355 root 1.73 my ($x, $y) = @$self{qw(x y)};
356 root 1.72
357 root 1.122 glColor 1, 0.8, 0.5, 0.2;
358 root 1.50 glEnable GL_BLEND;
359 root 1.74 glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
360 root 1.48 glBegin GL_QUADS;
361 root 1.72 glVertex $x , $y;
362     glVertex $x + $self->{w}, $y;
363     glVertex $x + $self->{w}, $y + $self->{h};
364     glVertex $x , $y + $self->{h};
365 root 1.47 glEnd;
366 root 1.50 glDisable GL_BLEND;
367 root 1.47 }
368 root 1.162
369     if ($ENV{PCLIENT_DEBUG}) {
370     glPushMatrix;
371     glColor 1, 1, 0, 1;
372     glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
373     glBegin GL_LINE_LOOP;
374     glVertex 0 , 0;
375     glVertex $self->{w}, 0;
376     glVertex $self->{w}, $self->{h};
377     glVertex 0 , $self->{h};
378     glEnd;
379     glPopMatrix;
380 root 1.205 #CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
381 root 1.162 }
382 elmex 1.11 }
383    
384     sub _draw {
385 root 1.38 my ($self) = @_;
386    
387     warn "no draw defined for $self\n";
388 elmex 1.1 }
389 root 1.4
390 root 1.38 sub find_widget {
391     my ($self, $x, $y) = @_;
392    
393 elmex 1.150 return () unless $self->{can_events};
394    
395 root 1.38 return $self
396     if $x >= $self->{x} && $x < $self->{x} + $self->{w}
397     && $y >= $self->{y} && $y < $self->{y} + $self->{h};
398    
399     ()
400     }
401    
402 elmex 1.32 sub set_parent {
403 root 1.113 my ($self, $parent) = @_;
404 elmex 1.32
405 root 1.113 Scalar::Util::weaken ($self->{parent} = $parent);
406 root 1.193
407 root 1.198 # TODO: req_w _does_change after ->reconfigure
408 root 1.193 $self->check_size
409     unless exists $self->{req_w};
410 elmex 1.32 }
411    
412 root 1.125 sub check_size {
413 root 1.197 my ($self, $forced) = @_;
414 root 1.125
415 root 1.197 $self->{force_alloc} = 1 if $forced;
416 root 1.191 $CFClient::UI::ROOT->{check_size}{$self} = $self;
417 root 1.125 }
418    
419 elmex 1.32 sub update {
420     my ($self) = @_;
421    
422 root 1.191 $self->{parent}->update
423     if $self->{parent};
424 elmex 1.1 }
425 elmex 1.2
426 root 1.72 sub connect {
427     my ($self, $signal, $cb) = @_;
428    
429 root 1.133 push @{ $self->{signal_cb}{$signal} }, $cb;
430 root 1.72 }
431    
432     sub emit {
433     my ($self, $signal, @args) = @_;
434    
435 root 1.163 List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
436 root 1.72 }
437    
438 root 1.18 sub DESTROY {
439     my ($self) = @_;
440    
441 root 1.202 delete $WIDGET{$self+0};
442 elmex 1.32 #$self->deactivate;
443 root 1.18 }
444    
445 root 1.39 #############################################################################
446    
447 root 1.73 package CFClient::UI::DrawBG;
448 root 1.68
449 root 1.73 our @ISA = CFClient::UI::Base::;
450 root 1.68
451     use strict;
452 root 1.138 use CFClient::OpenGL;
453 root 1.68
454     sub new {
455     my $class = shift;
456    
457     # range [value, low, high, page]
458    
459     $class->SUPER::new (
460 root 1.76 bg => [0, 0, 0, 0.2],
461 root 1.79 active_bg => [1, 1, 1, 0.5],
462 root 1.68 @_
463     )
464     }
465    
466     sub _draw {
467     my ($self) = @_;
468    
469     my ($w, $h) = @$self{qw(w h)};
470    
471 root 1.76 glEnable GL_BLEND;
472     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
473 root 1.68 glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };
474 root 1.76
475 root 1.68 glBegin GL_QUADS;
476     glVertex 0 , 0;
477     glVertex 0 , $h;
478     glVertex $w, $h;
479     glVertex $w, 0;
480     glEnd;
481 root 1.76
482     glDisable GL_BLEND;
483 root 1.68 }
484    
485     #############################################################################
486    
487 root 1.73 package CFClient::UI::Empty;
488 root 1.66
489 root 1.73 our @ISA = CFClient::UI::Base::;
490 root 1.66
491 elmex 1.150 sub new {
492     my ($class, %arg) = @_;
493     $class->SUPER::new (can_events => 0, %arg);
494     }
495    
496 root 1.66 sub size_request {
497     (0, 0)
498     }
499    
500 root 1.67 sub draw { }
501 root 1.66
502     #############################################################################
503    
504 root 1.73 package CFClient::UI::Container;
505 elmex 1.15
506 root 1.73 our @ISA = CFClient::UI::Base::;
507 elmex 1.15
508 root 1.38 sub new {
509 root 1.64 my ($class, %arg) = @_;
510    
511     my $children = delete $arg{children} || [];
512 root 1.38
513 root 1.166 my $self = $class->SUPER::new (
514     children => [],
515     can_events => 0,
516     %arg,
517     );
518 root 1.64 $self->add ($_) for @$children;
519 root 1.38
520     $self
521     }
522    
523     sub add {
524 root 1.188 my ($self, @widgets) = @_;
525 root 1.113
526 root 1.188 $_->set_parent ($self)
527     for @widgets;
528 root 1.38
529 root 1.113 use sort 'stable';
530 root 1.38
531 root 1.66 $self->{children} = [
532 root 1.38 sort { $a->{z} <=> $b->{z} }
533 root 1.188 @{$self->{children}}, @widgets
534 root 1.66 ];
535 root 1.38
536 root 1.197 $self->check_size (1);
537 root 1.182 $self->update;
538 root 1.38 }
539 root 1.35
540 root 1.172 sub children {
541     @{ $_[0]{children} }
542     }
543    
544 elmex 1.32 sub remove {
545 root 1.134 my ($self, $child) = @_;
546    
547     delete $child->{parent};
548 root 1.163 $child->hide;
549 root 1.38
550 root 1.134 $self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
551 root 1.38
552 root 1.125 $self->check_size;
553 root 1.151 $self->update;
554 root 1.38 }
555    
556 root 1.162 sub clear {
557     my ($self) = @_;
558    
559 root 1.163 my $children = delete $self->{children};
560     $self->{children} = [];
561 root 1.162
562 root 1.163 for (@$children) {
563     delete $_->{parent};
564     $_->hide;
565     }
566 root 1.182
567     $self->check_size;
568     $self->update;
569 root 1.162 }
570    
571 root 1.38 sub find_widget {
572     my ($self, $x, $y) = @_;
573    
574 root 1.45 $x -= $self->{x};
575     $y -= $self->{y};
576    
577 root 1.38 my $res;
578    
579 root 1.46 for (reverse @{ $self->{children} }) {
580 root 1.45 $res = $_->find_widget ($x, $y)
581 root 1.38 and return $res;
582     }
583    
584 root 1.46 $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
585 elmex 1.32 }
586 elmex 1.15
587 root 1.35 sub _draw {
588     my ($self) = @_;
589    
590 root 1.38 $_->draw for @{$self->{children}};
591 root 1.35 }
592 elmex 1.15
593 root 1.39 #############################################################################
594    
595 root 1.73 package CFClient::UI::Bin;
596 elmex 1.32
597 root 1.73 our @ISA = CFClient::UI::Container::;
598 elmex 1.32
599 root 1.66 sub new {
600     my ($class, %arg) = @_;
601    
602 root 1.73 my $child = (delete $arg{child}) || new CFClient::UI::Empty::;
603 root 1.66
604     $class->SUPER::new (children => [$child], %arg)
605     }
606    
607     sub add {
608 root 1.134 my ($self, $child) = @_;
609 root 1.66
610     $self->{children} = [];
611    
612 root 1.134 $self->SUPER::add ($child);
613 root 1.66 }
614    
615     sub remove {
616     my ($self, $widget) = @_;
617    
618     $self->SUPER::remove ($widget);
619    
620 root 1.73 $self->{children} = [new CFClient::UI::Empty]
621 root 1.66 unless @{$self->{children}};
622     }
623    
624 root 1.39 sub child { $_[0]->{children}[0] }
625 elmex 1.32
626 root 1.38 sub size_request {
627 root 1.68 $_[0]{children}[0]->size_request
628 root 1.38 }
629 elmex 1.32
630 root 1.38 sub size_allocate {
631 root 1.128 my ($self, $w, $h) = @_;
632 root 1.42
633 root 1.128 $self->{children}[0]->configure (0, 0, $w, $h);
634 root 1.38 }
635 elmex 1.32
636 root 1.39 #############################################################################
637    
638 root 1.73 package CFClient::UI::Window;
639 elmex 1.20
640 root 1.73 our @ISA = CFClient::UI::Bin::;
641 elmex 1.20
642 root 1.138 use CFClient::OpenGL;
643 elmex 1.20
644 root 1.42 sub new {
645 root 1.64 my ($class, %arg) = @_;
646 elmex 1.32
647 root 1.64 my $self = $class->SUPER::new (%arg);
648 elmex 1.32 }
649    
650     sub update {
651     my ($self) = @_;
652 root 1.42
653 root 1.198 $ROOT->on_post_alloc ($self => sub { $self->render_child });
654 root 1.42 $self->SUPER::update;
655 elmex 1.20 }
656    
657 root 1.174 sub size_allocate {
658     my ($self, $w, $h) = @_;
659    
660     $self->SUPER::size_allocate ($w, $h);
661     $self->update;
662     }
663    
664 root 1.182 sub _render {
665     $_[0]{children}[0]->draw;
666     }
667    
668 root 1.174 sub render_child {
669 elmex 1.20 my ($self) = @_;
670    
671 root 1.105 $self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
672 root 1.174 glClearColor 0, 0, 0, 0;
673 root 1.105 glClear GL_COLOR_BUFFER_BIT;
674 root 1.182
675     $self->_render;
676 root 1.175 # glColorMask 1, 1, 1, 0;
677     # glEnable GL_BLEND;
678     # glBlendFunc GL_SRC_ALPHA, GL_ZERO;
679     # glRasterPos 0, 0;
680     # glCopyPixels 0, 0, $self->{w}, $self->{h};
681     # glDisable GL_BLEND;
682     # glColorMask 1, 1, 1, 1;
683 root 1.105 };
684 elmex 1.36 }
685    
686 elmex 1.20 sub _draw {
687     my ($self) = @_;
688    
689 elmex 1.36 my ($w, $h) = ($self->w, $self->h);
690 root 1.29
691 elmex 1.20 my $tex = $self->{texture}
692     or return;
693    
694     glEnable GL_TEXTURE_2D;
695 root 1.35 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
696 root 1.174 glColor 0, 0, 0, 1;
697 elmex 1.20
698 root 1.194 $tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
699 elmex 1.20
700     glDisable GL_TEXTURE_2D;
701     }
702    
703 root 1.39 #############################################################################
704    
705 root 1.125 package CFClient::UI::ViewPort;
706    
707     our @ISA = CFClient::UI::Window::;
708    
709     sub size_request {
710     my ($self) = @_;
711    
712 root 1.149 @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
713 root 1.182 $self->child->configure (0, 0, @$self{qw(child_w child_h)});
714 root 1.125
715     @$self{qw(child_w child_h)}
716     }
717    
718 root 1.182 sub size_allocate {
719     my ($self, $w, $h) = @_;
720    
721     $self->update;
722     }
723    
724     sub set_offset {
725     my ($self, $x, $y) = @_;
726    
727     $self->{view_x} = int $x;
728     $self->{view_y} = int $y;
729    
730     $self->update;
731     }
732    
733 root 1.191 # hmm, this does not work for topleft of $self... but we should not ask for that
734     sub coord2local {
735     my ($self, $x, $y) = @_;
736    
737     $self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
738     }
739    
740     sub coord2global {
741 root 1.184 my ($self, $x, $y) = @_;
742    
743 root 1.191 $x = List::Util::min $self->{w}, $x - $self->{view_x};
744     $y = List::Util::min $self->{h}, $y - $self->{view_y};
745    
746     $self->SUPER::coord2global ($x, $y)
747 root 1.184 }
748    
749     sub find_widget {
750     my ($self, $x, $y) = @_;
751    
752     if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
753     && $y >= $self->{y} && $y < $self->{y} + $self->{h}
754     ) {
755     $self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
756     } else {
757     $self->CFClient::UI::Base::find_widget ($x, $y)
758     }
759     }
760    
761 root 1.182 sub _render {
762 root 1.125 my ($self) = @_;
763    
764 root 1.182 CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
765    
766     $self->SUPER::_render;
767     }
768    
769     #############################################################################
770    
771     package CFClient::UI::ScrolledWindow;
772    
773     our @ISA = CFClient::UI::HBox::;
774    
775     sub new {
776     my $class = shift;
777    
778     my $self;
779    
780     my $slider = new CFClient::UI::Slider
781     vertical => 1,
782     range => [0, 0, 1, 0.01], # HACK fix
783     connect_changed => sub {
784     $self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h}));
785     },
786     ;
787    
788     $self = $class->SUPER::new (
789     vp => (new CFClient::UI::ViewPort),
790     slider => $slider,
791     @_,
792     );
793    
794     $self->{vp}->add ($self->{scrolled});
795     $self->add ($self->{vp});
796     $self->add ($self->{slider});
797    
798     $self
799 root 1.125 }
800    
801 root 1.199 #TODO# update range on size_allocate depending on child
802 root 1.182 # update viewport offset on scroll
803 root 1.125
804     #############################################################################
805    
806 root 1.73 package CFClient::UI::Frame;
807 elmex 1.15
808 root 1.73 our @ISA = CFClient::UI::Bin::;
809 elmex 1.15
810 root 1.138 use CFClient::OpenGL;
811 elmex 1.15
812 root 1.199 sub new {
813     my $class = shift;
814    
815     $class->SUPER::new (
816     bg => undef,
817     @_,
818     )
819     }
820    
821     sub _draw {
822     my ($self) = @_;
823    
824     if ($self->{bg}) {
825     my ($w, $h) = @$self{qw(w h)};
826    
827     glEnable GL_BLEND;
828     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
829     glColor @{ $self->{bg} };
830    
831     glBegin GL_QUADS;
832     glVertex 0 , 0;
833     glVertex 0 , $h;
834     glVertex $w, $h;
835     glVertex $w, 0;
836     glEnd;
837    
838     glDisable GL_BLEND;
839     }
840    
841     $self->SUPER::_draw;
842     }
843    
844 root 1.39 #############################################################################
845    
846 root 1.73 package CFClient::UI::FancyFrame;
847 elmex 1.31
848 root 1.73 our @ISA = CFClient::UI::Bin::;
849 elmex 1.31
850 root 1.138 use CFClient::OpenGL;
851 elmex 1.31
852 root 1.41 my @tex =
853 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
854 root 1.41 qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
855 elmex 1.34
856 root 1.97 sub new {
857     my $class = shift;
858    
859     # TODO: user_x, user_y, overwrite moveto?
860    
861 root 1.141 my $self = $class->SUPER::new (
862 root 1.164 bg => [1, 1, 1, 1],
863     border_bg => [1, 1, 1, 1],
864 root 1.176 border => 0.6,
865 root 1.202 toplevel => 1,
866 root 1.166 can_events => 1,
867 root 1.97 @_
868 root 1.141 );
869    
870     $self->{title} &&= new CFClient::UI::Label
871     align => 0,
872     valign => 1,
873     text => $self->{title},
874 root 1.176 fontsize => $self->{border};
875 root 1.141
876     $self
877 root 1.97 }
878    
879 root 1.134 sub border {
880     int $_[0]{border} * $::FONTSIZE
881     }
882    
883 elmex 1.34 sub size_request {
884     my ($self) = @_;
885 root 1.39
886 root 1.78 my ($w, $h) = $self->SUPER::size_request;
887 elmex 1.34
888 root 1.97 (
889 root 1.134 $w + $self->border * 2,
890     $h + $self->border * 2,
891 root 1.97 )
892 elmex 1.36 }
893    
894     sub size_allocate {
895 root 1.128 my ($self, $w, $h) = @_;
896 root 1.40
897 root 1.134 $h -= List::Util::max 0, $self->border * 2;
898     $w -= List::Util::max 0, $self->border * 2;
899 elmex 1.36
900 root 1.208 $self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
901 root 1.141 if $self->{title};
902    
903 root 1.134 $self->child->configure ($self->border, $self->border, $w, $h);
904 elmex 1.34 }
905    
906 root 1.77 sub button_down {
907     my ($self, $ev, $x, $y) = @_;
908    
909 root 1.176 my ($w, $h) = @$self{qw(w h)};
910 root 1.134 my $border = $self->border;
911    
912 root 1.176 my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
913     my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
914 root 1.77
915 root 1.176 if ($lr & $td) {
916     my ($wx, $wy) = ($self->{x}, $self->{y});
917 root 1.139 my ($ox, $oy) = ($ev->{x}, $ev->{y});
918 root 1.77 my ($bw, $bh) = ($self->{w}, $self->{h});
919    
920 root 1.176 my $mx = $x < $border;
921     my $my = $y < $border;
922    
923 root 1.77 $self->{motion} = sub {
924     my ($ev, $x, $y) = @_;
925    
926 root 1.176 my $dx = $ev->{x} - $ox;
927     my $dy = $ev->{y} - $oy;
928 root 1.77
929 root 1.176 $self->{user_w} = $bw + $dx * ($mx ? -1 : 1);
930     $self->{user_h} = $bh + $dy * ($my ? -1 : 1);
931     $self->move ($wx + $dx * $mx, $wy + $dy * $my);
932 root 1.128 $self->check_size;
933 root 1.77 };
934    
935 root 1.176 } elsif ($lr ^ $td) {
936 root 1.139 my ($ox, $oy) = ($ev->{x}, $ev->{y});
937 root 1.77 my ($bx, $by) = ($self->{x}, $self->{y});
938    
939     $self->{motion} = sub {
940     my ($ev, $x, $y) = @_;
941    
942 root 1.139 ($x, $y) = ($ev->{x}, $ev->{y});
943 root 1.77
944     $self->move ($bx + $x - $ox, $by + $y - $oy);
945     $self->update;
946     };
947     }
948     }
949    
950     sub button_up {
951     my ($self, $ev, $x, $y) = @_;
952    
953     delete $self->{motion};
954     }
955    
956     sub mouse_motion {
957     my ($self, $ev, $x, $y) = @_;
958    
959     $self->{motion}->($ev, $x, $y) if $self->{motion};
960     }
961    
962 elmex 1.34 sub _draw {
963     my ($self) = @_;
964    
965 root 1.97 my ($w, $h ) = ($self->{w}, $self->{h});
966 root 1.43 my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
967 elmex 1.34
968     glEnable GL_TEXTURE_2D;
969 root 1.97 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
970 elmex 1.34
971 root 1.134 my $border = $self->border;
972    
973 root 1.97 glColor @{ $self->{border_bg} };
974 root 1.197 $tex[1]->draw_quad_alpha (0, 0, $w, $border);
975     $tex[3]->draw_quad_alpha (0, $border, $border, $ch);
976     $tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
977     $tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);
978 elmex 1.34
979 root 1.177 if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
980     my $bg = $tex[0];
981 root 1.76
982 root 1.177 # TODO: repeat texture not scale
983     my $rep_x = $cw / $bg->{w};
984     my $rep_y = $ch / $bg->{h};
985    
986     glColor @{ $self->{bg} };
987    
988     $bg->{s} = $rep_x;
989     $bg->{t} = $rep_y;
990     $bg->{wrap_mode} = 1;
991 root 1.197 $bg->draw_quad_alpha ($border, $border, $cw, $ch);
992     }
993 elmex 1.34
994 root 1.197 glDisable GL_TEXTURE_2D;
995 elmex 1.36
996 root 1.141 $self->{title}->draw if $self->{title};
997 root 1.177
998 root 1.39 $self->child->draw;
999 elmex 1.34 }
1000 elmex 1.31
1001 root 1.39 #############################################################################
1002    
1003 root 1.73 package CFClient::UI::Table;
1004 elmex 1.15
1005 root 1.73 our @ISA = CFClient::UI::Base::;
1006 elmex 1.15
1007 root 1.75 use List::Util qw(max sum);
1008    
1009 root 1.138 use CFClient::OpenGL;
1010 elmex 1.15
1011 root 1.78 sub new {
1012     my $class = shift;
1013    
1014     $class->SUPER::new (
1015     col_expand => [],
1016     @_
1017     )
1018     }
1019    
1020 elmex 1.15 sub add {
1021 root 1.113 my ($self, $x, $y, $child) = @_;
1022 elmex 1.32
1023 root 1.113 $child->set_parent ($self);
1024     $self->{children}[$y][$x] = $child;
1025 root 1.75
1026 root 1.126 $child->check_size;
1027 elmex 1.15 }
1028    
1029 root 1.172 sub children {
1030     grep $_, map @$_, grep $_, @{ $_[0]{children} }
1031     }
1032    
1033 root 1.115 # TODO: move to container class maybe? send childs a signal on removal?
1034     sub clear {
1035     my ($self) = @_;
1036    
1037 root 1.172 my @children = $self->children;
1038     delete $self->{children};
1039 root 1.163
1040 root 1.172 for (@children) {
1041 root 1.163 delete $_->{parent};
1042     $_->hide;
1043     }
1044    
1045 root 1.115 $self->update;
1046     }
1047    
1048 root 1.75 sub get_wh {
1049     my ($self) = @_;
1050    
1051     my (@w, @h);
1052 elmex 1.15
1053 root 1.75 for my $y (0 .. $#{$self->{children}}) {
1054     my $row = $self->{children}[$y]
1055     or next;
1056 elmex 1.15
1057 root 1.75 for my $x (0 .. $#$row) {
1058     my $widget = $row->[$x]
1059     or next;
1060 root 1.149 my ($w, $h) = @$widget{qw(req_w req_h)};
1061 elmex 1.15
1062 root 1.75 $w[$x] = max $w[$x], $w;
1063     $h[$y] = max $h[$y], $h;
1064 elmex 1.17 }
1065 elmex 1.15 }
1066 root 1.75
1067     (\@w, \@h)
1068 elmex 1.15 }
1069    
1070     sub size_request {
1071     my ($self) = @_;
1072    
1073 root 1.75 my ($ws, $hs) = $self->get_wh;
1074 elmex 1.15
1075 root 1.75 (
1076 root 1.78 (sum @$ws),
1077     (sum @$hs),
1078 root 1.75 )
1079     }
1080    
1081     sub size_allocate {
1082 root 1.128 my ($self, $w, $h) = @_;
1083 root 1.75
1084     my ($ws, $hs) = $self->get_wh;
1085    
1086 root 1.78 my $req_w = sum @$ws;
1087     my $req_h = sum @$hs;
1088    
1089     # TODO: nicer code && do row_expand
1090     my @col_expand = @{$self->{col_expand}};
1091     @col_expand = (1) x @$ws unless @col_expand;
1092     my $col_expand = (sum @col_expand) || 1;
1093 elmex 1.15
1094 root 1.75 # linearly scale sizes
1095 root 1.78 $ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1096     $hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1097 elmex 1.15
1098 root 1.112 CFClient::UI::harmonize $ws;
1099     CFClient::UI::harmonize $hs;
1100 root 1.106
1101 root 1.75 my $y;
1102 elmex 1.15
1103 root 1.75 for my $r (0 .. $#{$self->{children}}) {
1104     my $row = $self->{children}[$r]
1105     or next;
1106 elmex 1.15
1107     my $x = 0;
1108 root 1.75 my $row_h = $hs->[$r];
1109    
1110     for my $c (0 .. $#$row) {
1111     my $col_w = $ws->[$c];
1112 elmex 1.15
1113 root 1.83 if (my $widget = $row->[$c]) {
1114 root 1.128 $widget->configure ($x, $y, $col_w, $row_h);
1115 root 1.83 }
1116 elmex 1.15
1117 root 1.75 $x += $col_w;
1118 elmex 1.15 }
1119    
1120 root 1.75 $y += $row_h;
1121     }
1122    
1123     }
1124    
1125 root 1.76 sub find_widget {
1126     my ($self, $x, $y) = @_;
1127    
1128     $x -= $self->{x};
1129     $y -= $self->{y};
1130    
1131     my $res;
1132    
1133     for (grep $_, map @$_, grep $_, @{ $self->{children} }) {
1134     $res = $_->find_widget ($x, $y)
1135     and return $res;
1136     }
1137    
1138     $self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
1139     }
1140    
1141 root 1.75 sub _draw {
1142     my ($self) = @_;
1143    
1144     for (grep $_, @{$self->{children}}) {
1145     $_->draw for grep $_, @$_;
1146 elmex 1.15 }
1147     }
1148    
1149 root 1.39 #############################################################################
1150    
1151 root 1.76 package CFClient::UI::HBox;
1152    
1153     # TODO: wrap into common Box base class
1154    
1155     our @ISA = CFClient::UI::Container::;
1156    
1157     sub size_request {
1158     my ($self) = @_;
1159    
1160     my @alloc = map [$_->size_request], @{$self->{children}};
1161    
1162     (
1163     (List::Util::sum map $_->[0], @alloc),
1164     (List::Util::max map $_->[1], @alloc),
1165     )
1166     }
1167    
1168     sub size_allocate {
1169 root 1.128 my ($self, $w, $h) = @_;
1170 root 1.76
1171     ($h, $w) = ($w, $h);
1172    
1173     my $children = $self->{children};
1174    
1175 root 1.149 my @h = map $_->{req_w}, @$children;
1176 root 1.76
1177     my $req_h = List::Util::sum @h;
1178    
1179     if ($req_h > $h) {
1180     # ah well, not enough space
1181 root 1.78 $_ *= $h / $req_h for @h;
1182 root 1.76 } else {
1183 root 1.77 my $exp = List::Util::sum map $_->{expand}, @$children;
1184     $exp ||= 1;
1185 root 1.76
1186     for (0 .. $#$children) {
1187     my $child = $children->[$_];
1188    
1189     my $alloc_h = $h[$_];
1190 root 1.77 $alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1191 root 1.76 $h[$_] = $alloc_h;
1192     }
1193     }
1194    
1195 root 1.112 CFClient::UI::harmonize \@h;
1196    
1197 root 1.76 my $y = 0;
1198     for (0 .. $#$children) {
1199     my $child = $children->[$_];
1200 root 1.112 my $h = $h[$_];
1201 root 1.128 $child->configure ($y, 0, $h, $w);
1202 root 1.76
1203     $y += $h;
1204     }
1205 root 1.125
1206     1
1207 root 1.76 }
1208    
1209     #############################################################################
1210    
1211 root 1.73 package CFClient::UI::VBox;
1212 elmex 1.15
1213 root 1.76 # TODO: wrap into common Box base class
1214    
1215 root 1.73 our @ISA = CFClient::UI::Container::;
1216 elmex 1.15
1217 root 1.43 sub size_request {
1218     my ($self) = @_;
1219    
1220     my @alloc = map [$_->size_request], @{$self->{children}};
1221    
1222     (
1223     (List::Util::max map $_->[0], @alloc),
1224     (List::Util::sum map $_->[1], @alloc),
1225     )
1226     }
1227    
1228 elmex 1.36 sub size_allocate {
1229 root 1.128 my ($self, $w, $h) = @_;
1230 root 1.68
1231 root 1.193 Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1232    
1233 root 1.68 my $children = $self->{children};
1234    
1235 root 1.149 my @h = map $_->{req_h}, @$children;
1236 root 1.68
1237     my $req_h = List::Util::sum @h;
1238    
1239     if ($req_h > $h) {
1240     # ah well, not enough space
1241 root 1.78 $_ *= $h / $req_h for @h;
1242 root 1.68 } else {
1243 root 1.77 my $exp = List::Util::sum map $_->{expand}, @$children;
1244     $exp ||= 1;
1245 root 1.68
1246     for (0 .. $#$children) {
1247     my $child = $children->[$_];
1248 elmex 1.36
1249 root 1.77 $h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1250 root 1.68 }
1251 elmex 1.36 }
1252    
1253 root 1.112 CFClient::UI::harmonize \@h;
1254    
1255 elmex 1.36 my $y = 0;
1256 root 1.68 for (0 .. $#$children) {
1257     my $child = $children->[$_];
1258 root 1.112 my $h = $h[$_];
1259 root 1.128 $child->configure (0, $y, $w, $h);
1260 elmex 1.36
1261 root 1.68 $y += $h;
1262 elmex 1.36 }
1263 root 1.125
1264     1
1265 elmex 1.36 }
1266    
1267 root 1.39 #############################################################################
1268    
1269 root 1.73 package CFClient::UI::Label;
1270 root 1.10
1271 root 1.73 our @ISA = CFClient::UI::Base::;
1272 root 1.12
1273 root 1.138 use CFClient::OpenGL;
1274 root 1.10
1275     sub new {
1276 root 1.64 my ($class, %arg) = @_;
1277 root 1.51
1278 root 1.59 my $self = $class->SUPER::new (
1279 root 1.164 fg => [1, 1, 1],
1280     #font => default_font
1281 root 1.194 #text => initial text
1282     #markup => initial narkup
1283     layout => (new CFClient::Layout),
1284 root 1.164 fontsize => 1,
1285     align => -1,
1286     valign => -1,
1287     padding => 2,
1288 elmex 1.150 can_events => 0,
1289 root 1.64 %arg
1290 root 1.59 );
1291 root 1.10
1292 root 1.141 if (exists $self->{template}) {
1293     my $layout = new CFClient::Layout;
1294     $layout->set_text (delete $self->{template});
1295     $self->{template} = $layout;
1296     }
1297 root 1.121
1298 root 1.194 if (exists $self->{markup}) {
1299     $self->set_markup (delete $self->{markup});
1300     } else {
1301     $self->set_text (delete $self->{text});
1302     }
1303 root 1.10
1304     $self
1305     }
1306    
1307 root 1.162 sub escape {
1308 root 1.68 local $_ = $_[1];
1309    
1310     s/&/&amp;/g;
1311     s/>/&gt;/g;
1312     s/</&lt;/g;
1313    
1314     $_[1]
1315     }
1316    
1317 root 1.173 sub update {
1318     my ($self) = @_;
1319    
1320     delete $self->{texture};
1321     $self->SUPER::update;
1322     }
1323    
1324 elmex 1.15 sub set_text {
1325     my ($self, $text) = @_;
1326 root 1.28
1327 root 1.173 return if $self->{text} eq "T$text";
1328     $self->{text} = "T$text";
1329    
1330 root 1.194 $self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1331 root 1.121 $self->{layout}->set_text ($text);
1332 root 1.28
1333 root 1.173 $self->update;
1334 root 1.149 $self->check_size;
1335 elmex 1.15 }
1336    
1337 root 1.121 sub set_markup {
1338     my ($self, $markup) = @_;
1339    
1340 root 1.173 return if $self->{text} eq "M$markup";
1341     $self->{text} = "M$markup";
1342    
1343 root 1.194 my $rgba = $markup =~ /span.*(?:foreground|background)/;
1344    
1345     $self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1346 root 1.121 $self->{layout}->set_markup ($markup);
1347 root 1.28
1348 root 1.173 $self->update;
1349 root 1.149 $self->check_size;
1350 elmex 1.15 }
1351    
1352 root 1.14 sub size_request {
1353     my ($self) = @_;
1354    
1355 root 1.157 $self->{layout}->set_font ($self->{font}) if $self->{font};
1356     $self->{layout}->set_width ($self->{max_w} || -1);
1357 root 1.134 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1358 root 1.121
1359 root 1.76 my ($w, $h) = $self->{layout}->size;
1360    
1361 root 1.141 if (exists $self->{template}) {
1362 root 1.157 $self->{template}->set_font ($self->{font}) if $self->{font};
1363 root 1.141 $self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1364    
1365     my ($w2, $h2) = $self->{template}->size;
1366    
1367     $w = List::Util::max $w, $w2;
1368     $h = List::Util::max $h, $h2;
1369     }
1370    
1371 root 1.76 (
1372     $w + $self->{padding} * 2,
1373     $h + $self->{padding} * 2,
1374     )
1375 root 1.59 }
1376 root 1.51
1377 root 1.59 sub size_allocate {
1378 root 1.128 my ($self, $w, $h) = @_;
1379 root 1.68
1380 root 1.59 delete $self->{texture};
1381 root 1.14 }
1382    
1383 elmex 1.146 sub set_fontsize {
1384     my ($self, $fontsize) = @_;
1385    
1386     $self->{fontsize} = $fontsize;
1387 root 1.152 delete $self->{texture};
1388 root 1.186
1389     $self->update;
1390 root 1.147 $self->check_size;
1391 elmex 1.146 }
1392    
1393 elmex 1.11 sub _draw {
1394 root 1.10 my ($self) = @_;
1395    
1396 root 1.59 my $tex = $self->{texture} ||= do {
1397 root 1.194 $self->{layout}->set_foreground (@{$self->{fg}});
1398 root 1.157 $self->{layout}->set_font ($self->{font}) if $self->{font};
1399 root 1.59 $self->{layout}->set_width ($self->{w});
1400 root 1.134 $self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);
1401 root 1.194
1402     my $tex = new_from_layout CFClient::Texture $self->{layout};
1403    
1404 root 1.208 $self->{ox} = int ($self->{align} < 0 ? $self->{padding}
1405     : $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1406     : ($self->{w} - $tex->{w}) * 0.5);
1407    
1408     $self->{oy} = int ($self->{valign} < 0 ? $self->{padding}
1409     : $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1410     : ($self->{h} - $tex->{h}) * 0.5);
1411 root 1.194
1412     $tex
1413 root 1.59 };
1414 root 1.10
1415     glEnable GL_TEXTURE_2D;
1416 root 1.105 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1417 root 1.10
1418 root 1.194 if ($tex->{format} == GL_ALPHA) {
1419     glColor @{$self->{fg}};
1420     $tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1421     } else {
1422     $tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1423     }
1424 root 1.10
1425 root 1.74 glDisable GL_TEXTURE_2D;
1426 root 1.10 }
1427    
1428 root 1.39 #############################################################################
1429    
1430 root 1.121 package CFClient::UI::EntryBase;
1431 elmex 1.31
1432 root 1.73 our @ISA = CFClient::UI::Label::;
1433 elmex 1.31
1434 root 1.138 use CFClient::OpenGL;
1435 elmex 1.31
1436 root 1.68 sub new {
1437     my $class = shift;
1438    
1439     $class->SUPER::new (
1440 root 1.164 fg => [1, 1, 1],
1441     bg => [0, 0, 0, 0.2],
1442     active_bg => [1, 1, 1, 0.5],
1443     active_fg => [0, 0, 0],
1444     can_hover => 1,
1445     can_focus => 1,
1446     valign => 0,
1447 elmex 1.150 can_events => 1,
1448 root 1.68 @_
1449     )
1450     }
1451    
1452     sub _set_text {
1453     my ($self, $text) = @_;
1454    
1455 root 1.121 delete $self->{cur_h};
1456    
1457     return if $self->{text} eq $text;
1458 elmex 1.100
1459 root 1.134 delete $self->{texture};
1460    
1461 root 1.68 $self->{last_activity} = $::NOW;
1462     $self->{text} = $text;
1463 root 1.72
1464     $text =~ s/./*/g if $self->{hidden};
1465 root 1.121 $self->{layout}->set_text ("$text ");
1466 root 1.72
1467 root 1.121 $self->emit (changed => $self->{text});
1468     }
1469 root 1.68
1470 root 1.194 sub set_text {
1471     my ($self, $text) = @_;
1472    
1473     $self->{cursor} = length $text;
1474     $self->_set_text ($text);
1475 root 1.208 $self->update;
1476 root 1.194 $self->check_size;
1477     }
1478    
1479 root 1.121 sub get_text {
1480     $_[0]{text}
1481 root 1.68 }
1482    
1483     sub size_request {
1484     my ($self) = @_;
1485    
1486     my ($w, $h) = $self->SUPER::size_request;
1487    
1488     ($w + 1, $h) # add 1 for cursor
1489     }
1490    
1491     sub size_allocate {
1492 root 1.128 my ($self, $w, $h) = @_;
1493 root 1.68
1494 root 1.149 $self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1495 root 1.68 }
1496    
1497 elmex 1.31 sub key_down {
1498     my ($self, $ev) = @_;
1499    
1500 root 1.137 my $mod = $ev->{mod};
1501     my $sym = $ev->{sym};
1502     my $uni = $ev->{unicode};
1503 elmex 1.31
1504     my $text = $self->get_text;
1505    
1506 root 1.200 if ($uni == 8) {
1507 root 1.68 substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1508 root 1.200 } elsif ($uni == 127) {
1509 root 1.68 substr $text, $self->{cursor}, 1, "";
1510 root 1.136 } elsif ($sym == CFClient::SDLK_LEFT) {
1511 root 1.68 --$self->{cursor} if $self->{cursor};
1512 root 1.136 } elsif ($sym == CFClient::SDLK_RIGHT) {
1513 root 1.68 ++$self->{cursor} if $self->{cursor} < length $self->{text};
1514 root 1.136 } elsif ($sym == CFClient::SDLK_HOME) {
1515 root 1.76 $self->{cursor} = 0;
1516 root 1.136 } elsif ($sym == CFClient::SDLK_END) {
1517 root 1.76 $self->{cursor} = length $text;
1518 root 1.200 } elsif ($uni == 27) {
1519 elmex 1.101 $self->emit ('escape');
1520 elmex 1.31 } elsif ($uni) {
1521 root 1.68 substr $text, $self->{cursor}++, 0, chr $uni;
1522 elmex 1.31 }
1523 root 1.51
1524 root 1.68 $self->_set_text ($text);
1525     $self->update;
1526 root 1.208 $self->check_size;
1527 root 1.68 }
1528    
1529     sub focus_in {
1530     my ($self) = @_;
1531    
1532     $self->{last_activity} = $::NOW;
1533    
1534     $self->SUPER::focus_in;
1535 elmex 1.31 }
1536    
1537 root 1.51 sub button_down {
1538 root 1.68 my ($self, $ev, $x, $y) = @_;
1539    
1540     $self->SUPER::button_down ($ev, $x, $y);
1541    
1542     my $idx = $self->{layout}->xy_to_index ($x, $y);
1543    
1544     # byte-index to char-index
1545 root 1.76 my $text = $self->{text};
1546 root 1.68 utf8::encode $text;
1547     $self->{cursor} = length substr $text, 0, $idx;
1548 root 1.51
1549 root 1.68 $self->_set_text ($self->{text});
1550     $self->update;
1551 root 1.51 }
1552    
1553 root 1.58 sub mouse_motion {
1554     my ($self, $ev, $x, $y) = @_;
1555 root 1.68 # printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1556 root 1.58 }
1557    
1558 root 1.51 sub _draw {
1559     my ($self) = @_;
1560    
1561 root 1.68 local $self->{fg} = $self->{fg};
1562    
1563 root 1.51 if ($FOCUS == $self) {
1564 root 1.68 glColor @{$self->{active_bg}};
1565     $self->{fg} = $self->{active_fg};
1566 root 1.51 } else {
1567 root 1.68 glColor @{$self->{bg}};
1568 root 1.51 }
1569    
1570 root 1.76 glEnable GL_BLEND;
1571     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1572 root 1.51 glBegin GL_QUADS;
1573 root 1.68 glVertex 0 , 0;
1574     glVertex 0 , $self->{h};
1575     glVertex $self->{w}, $self->{h};
1576     glVertex $self->{w}, 0;
1577 root 1.51 glEnd;
1578 root 1.76 glDisable GL_BLEND;
1579 root 1.51
1580     $self->SUPER::_draw;
1581 root 1.68
1582     #TODO: force update every cursor change :(
1583     if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
1584 root 1.121
1585     unless (exists $self->{cur_h}) {
1586     my $text = substr $self->{text}, 0, $self->{cursor};
1587     utf8::encode $text;
1588    
1589     @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1590     }
1591    
1592 root 1.68 glColor @{$self->{fg}};
1593     glBegin GL_LINES;
1594 root 1.122 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1595     glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1596 root 1.68 glEnd;
1597     }
1598     }
1599    
1600 root 1.121 package CFClient::UI::Entry;
1601 elmex 1.99
1602 root 1.121 our @ISA = CFClient::UI::EntryBase::;
1603 elmex 1.99
1604 root 1.138 use CFClient::OpenGL;
1605 elmex 1.99
1606     sub key_down {
1607     my ($self, $ev) = @_;
1608    
1609 root 1.137 my $sym = $ev->{sym};
1610 elmex 1.99
1611 root 1.136 if ($sym == 13) {
1612 elmex 1.167 unshift @{$self->{history}},
1613     my $txt = $self->get_text;
1614     $self->{history_pointer} = -1;
1615 elmex 1.169 $self->{history_saveback} = '';
1616 elmex 1.167 $self->emit (activate => $txt);
1617 elmex 1.99 $self->update;
1618    
1619 elmex 1.167 } elsif ($sym == CFClient::SDLK_UP) {
1620     if ($self->{history_pointer} < 0) {
1621     $self->{history_saveback} = $self->get_text;
1622     }
1623 elmex 1.169 if (@{$self->{history} || []} > 0) {
1624     $self->{history_pointer}++;
1625     if ($self->{history_pointer} >= @{$self->{history} || []}) {
1626     $self->{history_pointer} = @{$self->{history} || []} - 1;
1627     }
1628     $self->set_text ($self->{history}->[$self->{history_pointer}]);
1629 elmex 1.167 }
1630    
1631     } elsif ($sym == CFClient::SDLK_DOWN) {
1632     $self->{history_pointer}--;
1633     $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1634    
1635     if ($self->{history_pointer} >= 0) {
1636     $self->set_text ($self->{history}->[$self->{history_pointer}]);
1637     } else {
1638     $self->set_text ($self->{history_saveback});
1639     }
1640    
1641 elmex 1.99 } else {
1642     $self->SUPER::key_down ($ev);
1643     }
1644    
1645     }
1646    
1647 root 1.68 #############################################################################
1648    
1649 root 1.79 package CFClient::UI::Button;
1650    
1651     our @ISA = CFClient::UI::Label::;
1652    
1653 root 1.138 use CFClient::OpenGL;
1654 root 1.79
1655 elmex 1.85 my @tex =
1656 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1657 elmex 1.85 qw(b1_button_active.png);
1658    
1659 root 1.79 sub new {
1660     my $class = shift;
1661    
1662     $class->SUPER::new (
1663 root 1.164 padding => 4,
1664     fg => [1, 1, 1],
1665     bg => [1, 1, 1, 0.2],
1666     active_fg => [0, 0, 1],
1667     can_hover => 1,
1668     align => 0,
1669     valign => 0,
1670 elmex 1.150 can_events => 1,
1671 root 1.79 @_
1672     )
1673     }
1674    
1675     sub button_up {
1676     my ($self, $ev, $x, $y) = @_;
1677    
1678     if ($x >= 0 && $x < $self->{w}
1679     && $y >= 0 && $y < $self->{h}) {
1680     $self->emit ("activate");
1681     }
1682     }
1683    
1684     sub _draw {
1685     my ($self) = @_;
1686    
1687     local $self->{fg} = $self->{fg};
1688    
1689     if ($GRAB == $self) {
1690     $self->{fg} = $self->{active_fg};
1691     }
1692    
1693 root 1.119 glEnable GL_TEXTURE_2D;
1694 elmex 1.85 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1695 root 1.119 glColor 0, 0, 0, 1;
1696 elmex 1.85
1697 root 1.195 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1698 elmex 1.85
1699     glDisable GL_TEXTURE_2D;
1700 root 1.79
1701     $self->SUPER::_draw;
1702     }
1703    
1704     #############################################################################
1705    
1706 root 1.86 package CFClient::UI::CheckBox;
1707    
1708     our @ISA = CFClient::UI::DrawBG::;
1709    
1710 elmex 1.102 my @tex =
1711 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1712 elmex 1.102 qw(c1_checkbox_bg.png c1_checkbox_active.png);
1713    
1714 root 1.138 use CFClient::OpenGL;
1715 root 1.86
1716     sub new {
1717     my $class = shift;
1718    
1719     $class->SUPER::new (
1720 root 1.87 padding => 2,
1721 root 1.86 fg => [1, 1, 1],
1722     active_fg => [1, 1, 0],
1723     state => 0,
1724 root 1.97 can_hover => 1,
1725 root 1.86 @_
1726     )
1727     }
1728    
1729 root 1.87 sub size_request {
1730     my ($self) = @_;
1731    
1732     ($self->{padding} * 2 + 6) x 2
1733     }
1734    
1735 root 1.86 sub button_down {
1736     my ($self, $ev, $x, $y) = @_;
1737    
1738     if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}
1739     && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {
1740     $self->{state} = !$self->{state};
1741 root 1.87 $self->emit (changed => $self->{state});
1742 root 1.86 }
1743     }
1744    
1745     sub _draw {
1746     my ($self) = @_;
1747    
1748 root 1.87 $self->SUPER::_draw;
1749 root 1.86
1750 root 1.87 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;
1751 root 1.86
1752 root 1.87 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;
1753 elmex 1.102
1754 root 1.87 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1755 root 1.86
1756 elmex 1.102 my $tex = $self->{state} ? $tex[1] : $tex[0];
1757    
1758 root 1.197 glEnable GL_TEXTURE_2D;
1759 root 1.195 $tex->draw_quad_alpha (0, 0, $s, $s);
1760 elmex 1.102 glDisable GL_TEXTURE_2D;
1761 root 1.86 }
1762    
1763     #############################################################################
1764    
1765 elmex 1.145 package CFClient::UI::Image;
1766    
1767     our @ISA = CFClient::UI::Base::;
1768    
1769     use CFClient::OpenGL;
1770     use Carp qw/confess/;
1771    
1772     our %loaded_images;
1773    
1774     sub new {
1775     my $class = shift;
1776    
1777 elmex 1.150 my $self = $class->SUPER::new (can_events => 0, @_);
1778 elmex 1.145
1779     $self->{image} or confess "Image has 'image' not set. This is a fatal error!";
1780    
1781     $loaded_images{$self->{image}} ||=
1782     new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;
1783    
1784     my $tex = $self->{tex} = $loaded_images{$self->{image}};
1785    
1786 root 1.147 Scalar::Util::weaken $loaded_images{$self->{image}};
1787    
1788 elmex 1.145 $self->{aspect} = $tex->{w} / $tex->{h};
1789    
1790     $self
1791     }
1792    
1793     sub size_request {
1794     my ($self) = @_;
1795    
1796     ($self->{tex}->{w}, $self->{tex}->{h})
1797     }
1798    
1799     sub _draw {
1800     my ($self) = @_;
1801    
1802     my $tex = $self->{tex};
1803    
1804     my ($w, $h) = ($self->{w}, $self->{h});
1805    
1806     if ($self->{rot90}) {
1807     glRotate 90, 0, 0, 1;
1808     glTranslate 0, -$self->{w}, 0;
1809    
1810     ($w, $h) = ($h, $w);
1811     }
1812    
1813     glEnable GL_TEXTURE_2D;
1814     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1815    
1816 root 1.195 $tex->draw_quad_alpha (0, 0, $w, $h);
1817 elmex 1.145
1818     glDisable GL_TEXTURE_2D;
1819     }
1820    
1821     #############################################################################
1822    
1823 elmex 1.124 package CFClient::UI::VGauge;
1824    
1825     our @ISA = CFClient::UI::Base::;
1826    
1827 root 1.158 use List::Util qw(min max);
1828    
1829 root 1.138 use CFClient::OpenGL;
1830 elmex 1.124
1831     my %tex = (
1832     food => [
1833 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1834 elmex 1.124 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
1835     ],
1836     grace => [
1837 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1838 root 1.158 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
1839 elmex 1.124 ],
1840     hp => [
1841 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1842 elmex 1.124 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
1843     ],
1844     mana => [
1845 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1846 root 1.158 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
1847 elmex 1.124 ],
1848     );
1849    
1850     # eg. VGauge->new (gauge => 'food'), default gauge: food
1851     sub new {
1852     my $class = shift;
1853    
1854 root 1.140 my $self = $class->SUPER::new (
1855 root 1.141 type => 'food',
1856 root 1.140 @_
1857     );
1858    
1859 root 1.141 $self->{aspect} = $tex{$self->{type}}[0]{w} / $tex{$self->{type}}[0]{h};
1860 elmex 1.124
1861     $self
1862     }
1863    
1864     sub size_request {
1865     my ($self) = @_;
1866    
1867 root 1.143 #my $tex = $tex{$self->{type}}[0];
1868     #@$tex{qw(w h)}
1869     (0, 0)
1870 elmex 1.124 }
1871    
1872     sub set_max {
1873     my ($self, $max) = @_;
1874 root 1.127
1875 root 1.173 return if $self->{max_val} == $max;
1876    
1877 elmex 1.124 $self->{max_val} = $max;
1878 root 1.173 $self->update;
1879 elmex 1.124 }
1880    
1881     sub set_value {
1882     my ($self, $val, $max) = @_;
1883    
1884     $self->set_max ($max)
1885     if defined $max;
1886    
1887 root 1.173 return if $self->{val} == $val;
1888    
1889 elmex 1.124 $self->{val} = $val;
1890     $self->update;
1891     }
1892    
1893     sub _draw {
1894     my ($self) = @_;
1895    
1896 root 1.141 my $tex = $tex{$self->{type}};
1897 root 1.158 my ($t1, $t2, $t3) = @$tex;
1898 elmex 1.124
1899     my ($w, $h) = ($self->{w}, $self->{h});
1900    
1901 elmex 1.142 if ($self->{vertical}) {
1902     glRotate 90, 0, 0, 1;
1903     glTranslate 0, -$self->{w}, 0;
1904    
1905     ($w, $h) = ($h, $w);
1906     }
1907    
1908 elmex 1.124 my $ycut = $self->{val} / ($self->{max_val} || 1);
1909    
1910 root 1.158 my $ycut1 = max 0, min 1, $ycut;
1911     my $ycut2 = max 0, min 1, $ycut - 1;
1912    
1913     my $h1 = $self->{h} * (1 - $ycut1);
1914     my $h2 = $self->{h} * (1 - $ycut2);
1915 elmex 1.124
1916     glEnable GL_BLEND;
1917     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1918     glEnable GL_TEXTURE_2D;
1919     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1920    
1921 root 1.131 glBindTexture GL_TEXTURE_2D, $t1->{name};
1922     glBegin GL_QUADS;
1923 root 1.158 glTexCoord 0 , 0; glVertex 0 , 0;
1924     glTexCoord 0 , $t1->{t} * (1 - $ycut1); glVertex 0 , $h1;
1925     glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut1); glVertex $w, $h1;
1926     glTexCoord $t1->{s}, 0; glVertex $w, 0;
1927 root 1.131 glEnd;
1928 elmex 1.124
1929 root 1.158 my $ycut1 = List::Util::min 1, $ycut;
1930 root 1.131 glBindTexture GL_TEXTURE_2D, $t2->{name};
1931     glBegin GL_QUADS;
1932 root 1.158 glTexCoord 0 , $t2->{t} * (1 - $ycut1); glVertex 0 , $h1;
1933     glTexCoord 0 , $t2->{t} * (1 - $ycut2); glVertex 0 , $h2;
1934     glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut2); glVertex $w, $h2;
1935     glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut1); glVertex $w, $h1;
1936 root 1.131 glEnd;
1937 elmex 1.124
1938 root 1.158 if ($t3) {
1939     glBindTexture GL_TEXTURE_2D, $t3->{name};
1940     glBegin GL_QUADS;
1941     glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
1942     glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};
1943     glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};
1944     glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
1945     glEnd;
1946     }
1947    
1948 elmex 1.124 glDisable GL_BLEND;
1949     glDisable GL_TEXTURE_2D;
1950     }
1951    
1952     #############################################################################
1953    
1954 root 1.141 package CFClient::UI::Gauge;
1955    
1956     our @ISA = CFClient::UI::VBox::;
1957    
1958     sub new {
1959 root 1.151 my ($class, %arg) = @_;
1960 root 1.141
1961     my $self = $class->SUPER::new (
1962 root 1.171 tooltip => $arg{type},
1963     can_hover => 1,
1964     can_events => 1,
1965 root 1.151 %arg,
1966 root 1.141 );
1967    
1968 root 1.161 $self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1969     $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
1970     $self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");
1971 root 1.141
1972     $self
1973     }
1974    
1975 elmex 1.146 sub set_fontsize {
1976     my ($self, $fsize) = @_;
1977    
1978     $self->{value}->set_fontsize ($fsize);
1979     $self->{max} ->set_fontsize ($fsize);
1980     }
1981    
1982 root 1.173 sub set_max {
1983     my ($self, $max) = @_;
1984    
1985     $self->{gauge}->set_max ($max);
1986     $self->{max}->set_text ($max);
1987     }
1988    
1989 root 1.141 sub set_value {
1990     my ($self, $val, $max) = @_;
1991    
1992     $self->set_max ($max)
1993     if defined $max;
1994    
1995     $self->{gauge}->set_value ($val, $max);
1996     $self->{value}->set_text ($val);
1997     }
1998    
1999     #############################################################################
2000    
2001 root 1.73 package CFClient::UI::Slider;
2002 root 1.68
2003     use strict;
2004    
2005 root 1.138 use CFClient::OpenGL;
2006 root 1.68
2007 root 1.73 our @ISA = CFClient::UI::DrawBG::;
2008 root 1.68
2009 elmex 1.99 my @tex =
2010     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
2011     qw(s1_slider.png s1_slider_bg.png);
2012    
2013 root 1.68 sub new {
2014     my $class = shift;
2015    
2016 root 1.206 # range [value, low, high, page, unit]
2017 root 1.68
2018 root 1.97 # TODO: 0-width page
2019     # TODO: req_w/h are wrong with vertical
2020     # TODO: calculations are off
2021 root 1.76 my $self = $class->SUPER::new (
2022 root 1.68 fg => [1, 1, 1],
2023     active_fg => [0, 0, 0],
2024     range => [0, 0, 100, 10],
2025 root 1.182 req_w => $::WIDTH / 80,
2026     req_h => $::WIDTH / 80,
2027 root 1.76 vertical => 0,
2028 root 1.97 can_hover => 1,
2029 root 1.206 inner_pad => .05,
2030 root 1.68 @_
2031 root 1.76 );
2032    
2033 root 1.206 $self->set_value ($self->{range}[0]);
2034     $self->update;
2035    
2036 root 1.76 $self
2037     }
2038    
2039 root 1.206 sub set_value {
2040     my ($self, $value) = @_;
2041    
2042     my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2043    
2044     $hi = $lo + 1 if $hi <= $lo;
2045    
2046     $value = $lo if $value < $lo;
2047     $value = $hi if $value > $hi;
2048    
2049     $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2050     if $unit;
2051    
2052     $page = $hi - $lo if $page > $hi - $lo;
2053    
2054     @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2055    
2056     if ($value != $old_value) {
2057     $self->emit (changed => $value);
2058     $self->update;
2059     }
2060     }
2061    
2062 root 1.76 sub size_request {
2063     my ($self) = @_;
2064    
2065     my $w = $self->{req_w};
2066     my $h = $self->{req_h};
2067    
2068     $self->{vertical} ? ($h, $w) : ($w, $h)
2069 root 1.68 }
2070    
2071 root 1.69 sub button_down {
2072     my ($self, $ev, $x, $y) = @_;
2073    
2074     $self->SUPER::button_down ($ev, $x, $y);
2075     $self->mouse_motion ($ev, $x, $y);
2076     }
2077    
2078     sub mouse_motion {
2079     my ($self, $ev, $x, $y) = @_;
2080    
2081     if ($GRAB == $self) {
2082 root 1.71 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2083    
2084 root 1.206 my (undef, $lo, $hi, $page) = @{$self->{range}};
2085 elmex 1.103
2086 root 1.206 $x = $x / ($w * (1 - 2 * $self->{inner_pad})) - $self->{inner_pad};
2087 root 1.69
2088 root 1.206 $self->set_value ($x * ($hi - $lo) + $lo);
2089 root 1.69 }
2090     }
2091    
2092 root 1.206 sub update {
2093     my ($self) = @_;
2094    
2095     $CFClient::UI::ROOT->on_post_alloc ($self => sub {
2096     $self->set_value ($self->{range}[0]);
2097    
2098     my ($value, $lo, $hi, $page) = @{$self->{range}};
2099    
2100     my $inner_w = 1 - 2 * $self->{inner_pad};
2101    
2102     $self->{scale} = ($inner_w / ($hi - $lo)) || 1;
2103    
2104     $page = $self->{scale} * $page || 10 / ($self->{w} || 1);
2105     $value = $self->{scale} * ($value - $lo);
2106    
2107     $value = $self->{inner_pad} + ($value - $page * 0.5);
2108    
2109     $value = 0 if $value < 0;
2110     $page = 1 - $value if $value + $page > 1;
2111    
2112     $self->{knob_x} = $value;
2113     $self->{knob_w} = $page;
2114     });
2115    
2116     $self->SUPER::update;
2117 elmex 1.103 }
2118    
2119 root 1.68 sub _draw {
2120     my ($self) = @_;
2121    
2122     $self->SUPER::_draw ();
2123    
2124 root 1.206 glScale $self->{w}, $self->{h};
2125 root 1.68
2126     if ($self->{vertical}) {
2127     # draw a vertical slider like a rotated horizontal slider
2128    
2129     glRotate 90, 0, 0, 1;
2130 root 1.206 glTranslate 0, 1, 0;
2131 root 1.68 }
2132    
2133     my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2134     my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2135    
2136 elmex 1.99 glEnable GL_TEXTURE_2D;
2137     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2138    
2139     # draw background
2140 root 1.206 $tex[1]->draw_quad_alpha (0, 0, 1, 1);
2141 root 1.69
2142 elmex 1.99 # draw handle
2143 root 1.206 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2144 root 1.69
2145 elmex 1.99 glDisable GL_TEXTURE_2D;
2146 root 1.51 }
2147    
2148 root 1.39 #############################################################################
2149    
2150 root 1.97 package CFClient::UI::TextView;
2151    
2152     our @ISA = CFClient::UI::HBox::;
2153    
2154 root 1.138 use CFClient::OpenGL;
2155 root 1.97
2156     sub new {
2157     my $class = shift;
2158    
2159     my $self = $class->SUPER::new (
2160 root 1.164 fontsize => 1,
2161     can_events => 0,
2162     #font => default_font
2163 root 1.105 @_,
2164 root 1.164
2165 root 1.195 layout => (new CFClient::Layout 1),
2166 root 1.164 par => [],
2167     height => 0,
2168     children => [
2169 root 1.97 (new CFClient::UI::Empty expand => 1),
2170     (new CFClient::UI::Slider vertical => 1),
2171     ],
2172     );
2173    
2174 root 1.176 $self->{children}[1]->connect (changed => sub { $self->update });
2175 root 1.107
2176 root 1.97 $self
2177     }
2178    
2179 root 1.107 sub set_fontsize {
2180     my ($self, $fontsize) = @_;
2181    
2182     $self->{fontsize} = $fontsize;
2183     $self->reflow;
2184     }
2185    
2186 root 1.105 sub text_height {
2187     my ($self, $text) = @_;
2188    
2189     my $layout = $self->{layout};
2190    
2191 root 1.134 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2192 root 1.176 $layout->set_width ($self->{children}[0]{w});
2193 root 1.195 $layout->set_markup ($text);
2194 root 1.105
2195     ($layout->size)[1]
2196     }
2197    
2198     sub reflow {
2199     my ($self) = @_;
2200    
2201 root 1.107 $self->{need_reflow}++;
2202     $self->update;
2203 root 1.105 }
2204    
2205     sub size_allocate {
2206 root 1.128 my ($self, $w, $h) = @_;
2207 root 1.105
2208 root 1.134 $self->SUPER::size_allocate ($w, $h);
2209    
2210 root 1.157 $self->{layout}->set_font ($self->{font}) if $self->{font};
2211 root 1.134 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2212     $self->{layout}->set_width ($self->{children}[0]{w});
2213 root 1.105
2214     $self->reflow;
2215     }
2216    
2217 root 1.97 sub add_paragraph {
2218     my ($self, $color, $text) = @_;
2219    
2220 root 1.105 #TODO: intelligently "reformat" paragraph
2221    
2222     my $height = $self->text_height ($text);
2223    
2224     $self->{height} += $height;
2225    
2226     push @{$self->{par}}, [$height, $color, $text];
2227    
2228     $self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}];
2229 root 1.97 $self->{children}[1]->update;
2230     }
2231    
2232 root 1.105 sub update {
2233 root 1.97 my ($self) = @_;
2234    
2235 root 1.105 $self->SUPER::update;
2236    
2237     return unless $self->{h} > 0;
2238    
2239 root 1.107 delete $self->{texture};
2240    
2241 root 1.198 $ROOT->on_post_alloc ($self, sub {
2242 root 1.107 if (delete $self->{need_reflow}) {
2243     my $height = 0;
2244    
2245     $height += $_->[0] = $self->text_height ($_->[2])
2246     for @{$self->{par}};
2247    
2248     $self->{height} = $height;
2249    
2250     $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];
2251    
2252     delete $self->{texture};
2253     }
2254    
2255 root 1.176 $self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {
2256 root 1.175 glClearColor 0, 0, 0, 0;
2257 root 1.107 glClear GL_COLOR_BUFFER_BIT;
2258    
2259     glEnable GL_TEXTURE_2D;
2260     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2261 root 1.105
2262 root 1.107 my $top = int $self->{children}[1]{range}[0];
2263 root 1.105
2264 root 1.107 my $y0 = $top;
2265     my $y1 = $top + $self->{h};
2266 root 1.105
2267 root 1.107 my $y = 0;
2268 root 1.97
2269 root 1.107 my $layout = $self->{layout};
2270 root 1.97
2271 root 1.157 $layout->set_font ($self->{font}) if $self->{font};
2272    
2273 root 1.107 for my $par (@{$self->{par}}) {
2274     my $h = $par->[0];
2275 root 1.97
2276 root 1.107 if ($y0 < $y + $h && $y < $y1) {
2277 root 1.195 $layout->set_foreground (@{ $par->[1] });
2278     $layout->set_markup ($par->[2]);
2279 root 1.105
2280 root 1.107 my ($W, $H) = $layout->size;
2281 root 1.195 CFClient::Texture->new_from_layout ($layout)->draw_quad_alpha_premultiplied (0, $y - $y0);
2282 root 1.107 }
2283    
2284     $y += $h;
2285 root 1.105 }
2286    
2287 root 1.107 glDisable GL_TEXTURE_2D;
2288     };
2289     });
2290 root 1.105 }
2291 root 1.97
2292 root 1.105 sub _draw {
2293     my ($self) = @_;
2294 root 1.97
2295 root 1.176 glEnable GL_TEXTURE_2D;
2296     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2297     glColor 1, 1, 1, 1;
2298 root 1.195 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2299 root 1.176 glDisable GL_TEXTURE_2D;
2300 root 1.97
2301 root 1.106 $self->{children}[1]->draw;
2302    
2303 root 1.97 }
2304    
2305     #############################################################################
2306    
2307 root 1.73 package CFClient::UI::Animator;
2308 root 1.35
2309 root 1.138 use CFClient::OpenGL;
2310 root 1.35
2311 root 1.73 our @ISA = CFClient::UI::Bin::;
2312 root 1.35
2313     sub moveto {
2314     my ($self, $x, $y) = @_;
2315    
2316     $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
2317 root 1.56 $self->{speed} = 0.001;
2318 root 1.35 $self->{time} = 1;
2319    
2320     ::animation_start $self;
2321     }
2322    
2323     sub animate {
2324     my ($self, $interval) = @_;
2325    
2326     $self->{time} -= $interval * $self->{speed};
2327     if ($self->{time} <= 0) {
2328     $self->{time} = 0;
2329     ::animation_stop $self;
2330     }
2331    
2332     my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
2333    
2334     $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
2335     $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
2336     }
2337    
2338     sub _draw {
2339     my ($self) = @_;
2340    
2341     glPushMatrix;
2342 root 1.51 glRotate $self->{time} * 1000, 0, 1, 0;
2343 root 1.38 $self->{children}[0]->draw;
2344 root 1.35 glPopMatrix;
2345     }
2346    
2347 root 1.51 #############################################################################
2348    
2349 root 1.96 package CFClient::UI::Flopper;
2350    
2351     our @ISA = CFClient::UI::Button::;
2352    
2353     sub new {
2354     my $class = shift;
2355    
2356     my $self = $class->SUPER::new (
2357 root 1.164 state => 0,
2358 root 1.96 connect_activate => \&toggle_flopper,
2359     @_
2360     );
2361    
2362     if ($self->{state}) {
2363     $self->{state} = 0;
2364     $self->toggle_flopper;
2365     }
2366    
2367     $self
2368     }
2369    
2370     sub toggle_flopper {
2371     my ($self) = @_;
2372    
2373 root 1.97 # TODO: use animation
2374 root 1.96 if ($self->{state} = !$self->{state}) {
2375 root 1.113 $CFClient::UI::ROOT->add ($self->{other});
2376     $self->{other}->move ($self->coord2global (0, $self->{h}));
2377 root 1.114 $self->emit ("open");
2378 root 1.96 } else {
2379 root 1.113 $CFClient::UI::ROOT->remove ($self->{other});
2380 root 1.114 $self->emit ("close");
2381 root 1.96 }
2382 root 1.114
2383     $self->emit (changed => $self->{state});
2384 root 1.96 }
2385    
2386     #############################################################################
2387    
2388 root 1.153 package CFClient::UI::Tooltip;
2389    
2390     our @ISA = CFClient::UI::Bin::;
2391    
2392     use CFClient::OpenGL;
2393    
2394     sub new {
2395     my $class = shift;
2396    
2397     $class->SUPER::new (
2398     @_,
2399     can_events => 0,
2400     )
2401     }
2402    
2403 root 1.196 sub set_tooltip_from {
2404     my ($self, $widget) = @_;
2405 root 1.195
2406 root 1.197 $self->add (new CFClient::UI::Label
2407 root 1.196 markup => $widget->{tooltip},
2408     max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2409 root 1.195 fontsize => 0.8,
2410 root 1.196 fg => [0, 0, 0, 1],
2411 root 1.197 font => ($widget->{tooltip_font} || $::FONT_PROP),
2412     );
2413 root 1.153 }
2414    
2415     sub size_request {
2416     my ($self) = @_;
2417    
2418     my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2419    
2420 root 1.154 ($w + 4, $h + 4)
2421     }
2422    
2423 root 1.162 sub size_allocate {
2424     my ($self, $w, $h) = @_;
2425    
2426     $self->SUPER::size_allocate ($w - 4, $h - 4);
2427     }
2428    
2429 root 1.154 sub _draw {
2430     my ($self) = @_;
2431    
2432     glTranslate 0.375, 0.375;
2433    
2434     my ($w, $h) = @$self{qw(w h)};
2435    
2436     glColor 1, 0.8, 0.4;
2437     glBegin GL_QUADS;
2438     glVertex 0 , 0;
2439     glVertex 0 , $h;
2440     glVertex $w, $h;
2441     glVertex $w, 0;
2442     glEnd;
2443    
2444     glColor 0, 0, 0;
2445     glBegin GL_LINE_LOOP;
2446     glVertex 0 , 0;
2447     glVertex 0 , $h;
2448     glVertex $w, $h;
2449     glVertex $w, 0;
2450     glEnd;
2451    
2452 root 1.197 glTranslate 2 - 0.375, 2 - 0.375;
2453 root 1.154 $self->SUPER::_draw;
2454 root 1.153 }
2455    
2456     #############################################################################
2457    
2458 root 1.162 package CFClient::UI::Face;
2459    
2460     our @ISA = CFClient::UI::Base::;
2461    
2462     use CFClient::OpenGL;
2463    
2464     sub new {
2465     my $class = shift;
2466    
2467     $class->SUPER::new (
2468     aspect => 1,
2469     @_,
2470     )
2471     }
2472    
2473     sub size_request {
2474     (32, 8)
2475     }
2476    
2477 elmex 1.179 sub _draw {
2478 root 1.162 my ($self) = @_;
2479    
2480 root 1.185 return unless $::CONN;#d# manage and cache textures differently
2481 root 1.162 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];
2482    
2483 root 1.178 # TODO animation
2484 root 1.162 if ($tex) {
2485     glEnable GL_TEXTURE_2D;
2486     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2487     glColor 1, 1, 1, 1;
2488 root 1.195 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2489 root 1.162 glDisable GL_TEXTURE_2D;
2490     }
2491     }
2492    
2493     #############################################################################
2494    
2495 root 1.186 package CFClient::UI::InventoryItem;
2496    
2497     our @ISA = CFClient::UI::HBox::;
2498    
2499     sub new {
2500     my $class = shift;
2501    
2502     my %args = @_;
2503    
2504 root 1.192 my $item = delete $args{item};
2505 root 1.186
2506     my $desc = $item->{nrof} < 2
2507     ? $item->{name}
2508     : "$item->{nrof} $item->{name_pl}";
2509    
2510 elmex 1.207 $item->{flags} & Crossfire::Protocol::F_OPEN
2511     and $desc .= " (open)";
2512     $item->{flags} & Crossfire::Protocol::F_APPLIED
2513     and $desc .= " (applied)";
2514     $item->{flags} & Crossfire::Protocol::F_UNPAID
2515     and $desc .= " (unpaid)";
2516     $item->{flags} & Crossfire::Protocol::F_MAGIC
2517     and $desc .= " (magic)";
2518     $item->{flags} & Crossfire::Protocol::F_CURSED
2519     and $desc .= " (cursed)";
2520     $item->{flags} & Crossfire::Protocol::F_DAMNED
2521     and $desc .= " (damned)";
2522     $item->{flags} & Crossfire::Protocol::F_LOCKED
2523     and $desc .= " *";
2524 root 1.186
2525     my $self = $class->SUPER::new (
2526     can_hover => 1,
2527     can_events => 1,
2528     tooltip => (CFClient::UI::Label->escape ($desc)
2529     . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
2530     connect_button_down => sub {
2531     my ($self, $ev, $x, $y) = @_;
2532    
2533     # todo: maybe put examine on 1? but should just be a tooltip :(
2534     if ($ev->{button} == 1) {
2535     $::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
2536     } elsif ($ev->{button} == 2) {
2537     $::CONN->send ("apply $item->{tag}");
2538     } elsif ($ev->{button} == 3) {
2539 elmex 1.207 my @menu_items = (
2540     ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2541     ["mark", sub { $::CONN->send ("mark $item->{tag}") }],
2542     ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2543     ["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2544     [
2545     $item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
2546     sub { $::CONN->send ("lock ". () ."$item->{tag}") },
2547 root 1.186 ],
2548 elmex 1.207 );
2549    
2550     CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2551 root 1.186 }
2552    
2553     1
2554     },
2555     %args
2556     );
2557 root 1.192
2558     $self->add (new CFClient::UI::Face
2559 root 1.186 can_events => 0,
2560     face => $item->{face},
2561     anim => $item->{anim},
2562 root 1.192 animspeed => $item->{animspeed},
2563     );
2564    
2565     $self->add (new CFClient::UI::Label
2566 root 1.186 can_events => 0,
2567 root 1.192 text => $desc,
2568     );
2569 root 1.186
2570     $self
2571     }
2572    
2573     #############################################################################
2574    
2575     package CFClient::UI::Inventory;
2576    
2577     our @ISA = CFClient::UI::ScrolledWindow::;
2578    
2579     sub new {
2580     my $class = shift;
2581    
2582     my $self = $class->SUPER::new (
2583     scrolled => (new CFClient::UI::VBox),
2584     @_,
2585     );
2586    
2587     $self
2588     }
2589    
2590     sub set_items {
2591     my ($self, $items) = @_;
2592    
2593     $self->{scrolled}->clear;
2594     return unless $items;
2595    
2596 root 1.201 my @items = sort {
2597     ($a->{type} <=> $b->{type})
2598     or ($a->{name} cmp $b->{name})
2599     } @$items;
2600 root 1.186
2601     $self->{real_items} = \@items;
2602    
2603     for my $item (@items) {
2604     my $desc = $item->{nrof} < 2
2605     ? $item->{name}
2606     : "$item->{nrof} $item->{name_pl}";
2607    
2608 root 1.201 $item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2609 root 1.186 }
2610    
2611 root 1.201 $self->{scrolled}->add (@items);
2612    
2613 root 1.186 # $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2614     }
2615    
2616     sub size_request {
2617     my ($self) = @_;
2618     ($self->{req_w}, $self->{req_h});
2619     }
2620    
2621     #############################################################################
2622    
2623 root 1.178 package CFClient::UI::Menu;
2624    
2625     our @ISA = CFClient::UI::FancyFrame::;
2626    
2627     use CFClient::OpenGL;
2628    
2629     sub new {
2630     my $class = shift;
2631    
2632     my $self = $class->SUPER::new (
2633     items => [],
2634     z => 100,
2635     @_,
2636     );
2637    
2638     $self->add ($self->{vbox} = new CFClient::UI::VBox);
2639    
2640     for my $item (@{ $self->{items} }) {
2641     my ($widget, $cb) = @$item;
2642    
2643     # handle various types of items, only text for now
2644     if (!ref $widget) {
2645     $widget = new CFClient::UI::Label
2646     can_hover => 1,
2647     can_events => 1,
2648     text => $widget;
2649     }
2650    
2651     $self->{item}{$widget} = $item;
2652    
2653     $self->{vbox}->add ($widget);
2654     }
2655    
2656     $self
2657     }
2658    
2659     # popup given the event (must be a mouse button down event currently)
2660     sub popup {
2661     my ($self, $ev) = @_;
2662    
2663     $self->emit ("popdown");
2664    
2665     # maybe save $GRAB? must be careful about events...
2666     $GRAB = $self;
2667     $self->{button} = $ev->{button};
2668    
2669     $self->show;
2670     $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2671     }
2672    
2673     sub mouse_motion {
2674     my ($self, $ev, $x, $y) = @_;
2675    
2676 root 1.182 # TODO: should use vbox->find_widget or so
2677 root 1.178 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2678     $self->{hover} = $self->{item}{$HOVER};
2679     }
2680    
2681     sub button_up {
2682     my ($self, $ev, $x, $y) = @_;
2683    
2684     if ($ev->{button} == $self->{button}) {
2685     undef $GRAB;
2686     $self->hide;
2687    
2688     $self->emit ("popdown");
2689     $self->{hover}[1]->() if $self->{hover};
2690     }
2691     }
2692    
2693     #############################################################################
2694    
2695 root 1.194 package CFClient::UI::Statusbox;
2696    
2697     our @ISA = CFClient::UI::VBox::;
2698    
2699     sub reorder {
2700     my ($self) = @_;
2701     my $NOW = time;
2702    
2703     while (my ($k, $v) = each %{ $self->{item} }) {
2704     delete $self->{item}{$k} if $v->{timeout} < $NOW;
2705     }
2706    
2707     my @widgets;
2708 root 1.197
2709     my @items = sort {
2710     $a->{pri} <=> $b->{pri}
2711     or $b->{id} <=> $a->{id}
2712     } values %{ $self->{item} };
2713    
2714 root 1.194 my $count = 10 + 1;
2715     for my $item (@items) {
2716     last unless --$count;
2717    
2718     push @widgets, $item->{label} ||= do {
2719     # TODO: doesn't handle markup well (read as: at all)
2720 root 1.197 my $short = $item->{count} > 1
2721     ? "<b>$item->{count} ×</b> $item->{text}"
2722     : $item->{text};
2723    
2724 root 1.194 for ($short) {
2725     s/^\s+//;
2726 root 1.205 s/\s+/ /g;
2727 root 1.198 my $len = int 40 / $item->{fontsize};
2728 root 1.194 substr $_, $len, length, "…" if $len < length;
2729     }
2730    
2731     new CFClient::UI::Label
2732 root 1.196 markup => $short,
2733 root 1.197 tooltip => $item->{tooltip},
2734 root 1.196 tooltip_font => $::FONT_PROP,
2735 root 1.197 tooltip_width => 0.67,
2736     fontsize => $item->{fontsize},
2737 root 1.205 fg => $item->{fg},
2738 root 1.196 can_events => 1,
2739 root 1.197 can_hover => 1
2740 root 1.194 };
2741     }
2742    
2743     $self->clear;
2744 root 1.197 $self->SUPER::add (reverse @widgets);
2745 root 1.194 }
2746    
2747     sub add {
2748     my ($self, $text, %arg) = @_;
2749    
2750 root 1.198 $text =~ s/^\s+//;
2751     $text =~ s/\s+$//;
2752    
2753 root 1.197 my $timeout = time + ((delete $arg{timeout}) || 60);
2754 root 1.194
2755 root 1.197 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2756 root 1.194
2757 root 1.197 if (my $item = $self->{item}{$group}) {
2758     if ($item->{text} eq $text) {
2759     $item->{count}++;
2760     } else {
2761     $item->{count} = 1;
2762     $item->{text} = $item->{tooltip} = $text;
2763     }
2764 root 1.198 $item->{id} = ++$self->{id};
2765 root 1.197 $item->{timeout} = $timeout;
2766     delete $item->{label};
2767     } else {
2768     $self->{item}{$group} = {
2769     id => ++$self->{id},
2770     text => $text,
2771     timeout => $timeout,
2772     tooltip => $text,
2773     fontsize => 0.8,
2774 root 1.205 fg => [0.8, 0.8, 0.8, 0.8],
2775 root 1.197 pri => 0,
2776     count => 1,
2777     %arg,
2778     };
2779     }
2780 root 1.194
2781     $self->reorder;
2782     }
2783    
2784     #############################################################################
2785    
2786 root 1.113 package CFClient::UI::Root;
2787 root 1.51
2788 root 1.73 our @ISA = CFClient::UI::Container::;
2789 root 1.51
2790 root 1.138 use CFClient::OpenGL;
2791 root 1.107
2792 root 1.191 sub new {
2793     my $class = shift;
2794    
2795     $class->SUPER::new (
2796     @_,
2797     )
2798     }
2799    
2800     sub configure {
2801     my ($self, $x, $y, $w, $h) = @_;
2802    
2803     $self->{w} = $w;
2804     $self->{h} = $h;
2805     }
2806    
2807 root 1.125 sub check_size {
2808     my ($self) = @_;
2809    
2810 root 1.191 $self->size_allocate ($self->{w}, $self->{h})
2811     if $self->{w};
2812 root 1.125 }
2813    
2814 root 1.51 sub size_request {
2815 root 1.186 my ($self) = @_;
2816    
2817     ($self->{w}, $self->{h})
2818     }
2819    
2820     sub size_allocate {
2821     my ($self, $w, $h) = @_;
2822    
2823 root 1.202 my $old_w = $self->{old_w}; $self->{old_w} = $w;
2824     my $old_h = $self->{old_h}; $self->{old_h} = $h;
2825 root 1.186
2826 root 1.202 CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
2827     if $old_w && $old_h && ($old_w != $w || $old_h != $h);
2828 root 1.186
2829     for my $child ($self->children) {
2830 root 1.149 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2831    
2832 root 1.205 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1
2833     if exists $child->{req_x};
2834    
2835     $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1
2836     if exists $child->{req_y};
2837    
2838     $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
2839     $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
2840    
2841 root 1.186 $child->configure ($X, $Y, $W, $H);
2842 root 1.149 }
2843 root 1.191 }
2844    
2845     sub coord2local {
2846     my ($self, $x, $y) = @_;
2847    
2848     ($x, $y)
2849 root 1.51 }
2850    
2851 root 1.191 sub coord2global {
2852 root 1.58 my ($self, $x, $y) = @_;
2853    
2854     ($x, $y)
2855     }
2856    
2857 root 1.51 sub update {
2858     my ($self) = @_;
2859    
2860 root 1.125 $self->check_size;
2861 root 1.191 $::WANT_REFRESH++;
2862 root 1.51 }
2863    
2864     sub add {
2865 root 1.203 my ($self, @children) = @_;
2866    
2867     for my $child (@children) {
2868     $child->{toplevel} = 1;
2869 root 1.51
2870 root 1.203 # integerise window positions
2871     $child->{x} = int $child->{x};
2872     $child->{y} = int $child->{y};
2873     }
2874 elmex 1.146
2875 root 1.203 $self->SUPER::add (@children);
2876 root 1.51 }
2877    
2878 root 1.107 sub on_refresh {
2879     my ($self, $id, $cb) = @_;
2880    
2881     $self->{refresh_hook}{$id} = $cb;
2882     }
2883    
2884 root 1.198 sub on_post_alloc {
2885     my ($self, $id, $cb) = @_;
2886    
2887     $self->{post_alloc_hook}{$id} = $cb;
2888     }
2889    
2890 root 1.191 sub draw {
2891 root 1.51 my ($self) = @_;
2892    
2893 root 1.198 while ($self->{refresh_hook}) {
2894     $_->()
2895     for values %{delete $self->{refresh_hook}};
2896     }
2897    
2898 root 1.191 if ($self->{check_size}) {
2899     my @queue = ([], []);
2900    
2901     for (;;) {
2902     if ($self->{check_size}) {
2903     # heuristic: check containers last
2904     push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_
2905     for values %{delete $self->{check_size}}
2906     }
2907    
2908     my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;
2909    
2910     my ($w, $h) = $widget->{user_w} && $widget->{user_h}
2911     ? @$widget{qw(user_w user_h)}
2912     : $widget->size_request;
2913    
2914 root 1.197 if (delete $widget->{force_alloc}
2915     or $w != $widget->{req_w} or $h != $widget->{req_h}) {
2916 root 1.193 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
2917    
2918 root 1.191 $widget->{req_w} = $w;
2919     $widget->{req_h} = $h;
2920    
2921 root 1.197 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];
2922 root 1.191
2923     $widget->{parent}->check_size
2924     if $widget->{parent};
2925     }
2926     }
2927     }
2928    
2929     while ($self->{size_alloc}) {
2930     for (values %{delete $self->{size_alloc}}) {
2931     my ($widget, $w, $h) = @$_;
2932    
2933 root 1.193 $w = 0 if $w < 0;
2934     $h = 0 if $h < 0;
2935    
2936 root 1.191 $widget->{w} = $w;
2937     $widget->{h} = $h;
2938     $widget->size_allocate ($w, $h);
2939     $widget->emit (size_allocate => $w, $h);
2940     }
2941     }
2942    
2943 root 1.198 while ($self->{post_alloc_hook}) {
2944 root 1.191 $_->()
2945 root 1.198 for values %{delete $self->{post_alloc_hook}};
2946 root 1.107 }
2947    
2948     glViewport 0, 0, $::WIDTH, $::HEIGHT;
2949     glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2950     glClear GL_COLOR_BUFFER_BIT;
2951    
2952     glMatrixMode GL_PROJECTION;
2953     glLoadIdentity;
2954     glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;
2955     glMatrixMode GL_MODELVIEW;
2956     glLoadIdentity;
2957    
2958 root 1.51 $self->_draw;
2959     }
2960    
2961     #############################################################################
2962    
2963 root 1.73 package CFClient::UI;
2964 root 1.51
2965 root 1.113 $ROOT = new CFClient::UI::Root;
2966 root 1.153 $TOOLTIP = new CFClient::UI::Tooltip;
2967 root 1.51
2968     1
2969 root 1.5