ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/UI.pm
Revision: 1.207
Committed: Mon May 15 18:23:33 2006 UTC (18 years ago) by elmex
Branch: MAIN
Changes since 1.206: +25 -11 lines
Log Message:
first parts of the inventory

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.141 $self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)
901     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     $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    
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     $self->check_size;
1476     $self->update;
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     }
1527    
1528     sub focus_in {
1529     my ($self) = @_;
1530    
1531     $self->{last_activity} = $::NOW;
1532    
1533     $self->SUPER::focus_in;
1534 elmex 1.31 }
1535    
1536 root 1.51 sub button_down {
1537 root 1.68 my ($self, $ev, $x, $y) = @_;
1538    
1539     $self->SUPER::button_down ($ev, $x, $y);
1540    
1541     my $idx = $self->{layout}->xy_to_index ($x, $y);
1542    
1543     # byte-index to char-index
1544 root 1.76 my $text = $self->{text};
1545 root 1.68 utf8::encode $text;
1546     $self->{cursor} = length substr $text, 0, $idx;
1547 root 1.51
1548 root 1.68 $self->_set_text ($self->{text});
1549     $self->update;
1550 root 1.51 }
1551    
1552 root 1.58 sub mouse_motion {
1553     my ($self, $ev, $x, $y) = @_;
1554 root 1.68 # printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
1555 root 1.58 }
1556    
1557 root 1.51 sub _draw {
1558     my ($self) = @_;
1559    
1560 root 1.68 local $self->{fg} = $self->{fg};
1561    
1562 root 1.51 if ($FOCUS == $self) {
1563 root 1.68 glColor @{$self->{active_bg}};
1564     $self->{fg} = $self->{active_fg};
1565 root 1.51 } else {
1566 root 1.68 glColor @{$self->{bg}};
1567 root 1.51 }
1568    
1569 root 1.76 glEnable GL_BLEND;
1570     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1571 root 1.51 glBegin GL_QUADS;
1572 root 1.68 glVertex 0 , 0;
1573     glVertex 0 , $self->{h};
1574     glVertex $self->{w}, $self->{h};
1575     glVertex $self->{w}, 0;
1576 root 1.51 glEnd;
1577 root 1.76 glDisable GL_BLEND;
1578 root 1.51
1579     $self->SUPER::_draw;
1580 root 1.68
1581     #TODO: force update every cursor change :(
1582     if ($FOCUS == $self && (($::NOW - $self->{last_activity}) & 1023) < 600) {
1583 root 1.121
1584     unless (exists $self->{cur_h}) {
1585     my $text = substr $self->{text}, 0, $self->{cursor};
1586     utf8::encode $text;
1587    
1588     @$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1589     }
1590    
1591 root 1.68 glColor @{$self->{fg}};
1592     glBegin GL_LINES;
1593 root 1.122 glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1594     glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1595 root 1.68 glEnd;
1596     }
1597     }
1598    
1599 root 1.121 package CFClient::UI::Entry;
1600 elmex 1.99
1601 root 1.121 our @ISA = CFClient::UI::EntryBase::;
1602 elmex 1.99
1603 root 1.138 use CFClient::OpenGL;
1604 elmex 1.99
1605     sub key_down {
1606     my ($self, $ev) = @_;
1607    
1608 root 1.137 my $sym = $ev->{sym};
1609 elmex 1.99
1610 root 1.136 if ($sym == 13) {
1611 elmex 1.167 unshift @{$self->{history}},
1612     my $txt = $self->get_text;
1613     $self->{history_pointer} = -1;
1614 elmex 1.169 $self->{history_saveback} = '';
1615 elmex 1.167 $self->emit (activate => $txt);
1616 elmex 1.99 $self->update;
1617    
1618 elmex 1.167 } elsif ($sym == CFClient::SDLK_UP) {
1619     if ($self->{history_pointer} < 0) {
1620     $self->{history_saveback} = $self->get_text;
1621     }
1622 elmex 1.169 if (@{$self->{history} || []} > 0) {
1623     $self->{history_pointer}++;
1624     if ($self->{history_pointer} >= @{$self->{history} || []}) {
1625     $self->{history_pointer} = @{$self->{history} || []} - 1;
1626     }
1627     $self->set_text ($self->{history}->[$self->{history_pointer}]);
1628 elmex 1.167 }
1629    
1630     } elsif ($sym == CFClient::SDLK_DOWN) {
1631     $self->{history_pointer}--;
1632     $self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1633    
1634     if ($self->{history_pointer} >= 0) {
1635     $self->set_text ($self->{history}->[$self->{history_pointer}]);
1636     } else {
1637     $self->set_text ($self->{history_saveback});
1638     }
1639    
1640 elmex 1.99 } else {
1641     $self->SUPER::key_down ($ev);
1642     }
1643    
1644     }
1645    
1646 root 1.68 #############################################################################
1647    
1648 root 1.79 package CFClient::UI::Button;
1649    
1650     our @ISA = CFClient::UI::Label::;
1651    
1652 root 1.138 use CFClient::OpenGL;
1653 root 1.79
1654 elmex 1.85 my @tex =
1655 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1656 elmex 1.85 qw(b1_button_active.png);
1657    
1658 root 1.79 sub new {
1659     my $class = shift;
1660    
1661     $class->SUPER::new (
1662 root 1.164 padding => 4,
1663     fg => [1, 1, 1],
1664     bg => [1, 1, 1, 0.2],
1665     active_fg => [0, 0, 1],
1666     can_hover => 1,
1667     align => 0,
1668     valign => 0,
1669 elmex 1.150 can_events => 1,
1670 root 1.79 @_
1671     )
1672     }
1673    
1674     sub button_up {
1675     my ($self, $ev, $x, $y) = @_;
1676    
1677     if ($x >= 0 && $x < $self->{w}
1678     && $y >= 0 && $y < $self->{h}) {
1679     $self->emit ("activate");
1680     }
1681     }
1682    
1683     sub _draw {
1684     my ($self) = @_;
1685    
1686     local $self->{fg} = $self->{fg};
1687    
1688     if ($GRAB == $self) {
1689     $self->{fg} = $self->{active_fg};
1690     }
1691    
1692 root 1.119 glEnable GL_TEXTURE_2D;
1693 elmex 1.85 glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1694 root 1.119 glColor 0, 0, 0, 1;
1695 elmex 1.85
1696 root 1.195 $tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1697 elmex 1.85
1698     glDisable GL_TEXTURE_2D;
1699 root 1.79
1700     $self->SUPER::_draw;
1701     }
1702    
1703     #############################################################################
1704    
1705 root 1.86 package CFClient::UI::CheckBox;
1706    
1707     our @ISA = CFClient::UI::DrawBG::;
1708    
1709 elmex 1.102 my @tex =
1710 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1711 elmex 1.102 qw(c1_checkbox_bg.png c1_checkbox_active.png);
1712    
1713 root 1.138 use CFClient::OpenGL;
1714 root 1.86
1715     sub new {
1716     my $class = shift;
1717    
1718     $class->SUPER::new (
1719 root 1.87 padding => 2,
1720 root 1.86 fg => [1, 1, 1],
1721     active_fg => [1, 1, 0],
1722     state => 0,
1723 root 1.97 can_hover => 1,
1724 root 1.86 @_
1725     )
1726     }
1727    
1728 root 1.87 sub size_request {
1729     my ($self) = @_;
1730    
1731     ($self->{padding} * 2 + 6) x 2
1732     }
1733    
1734 root 1.86 sub button_down {
1735     my ($self, $ev, $x, $y) = @_;
1736    
1737     if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}
1738     && $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {
1739     $self->{state} = !$self->{state};
1740 root 1.87 $self->emit (changed => $self->{state});
1741 root 1.86 }
1742     }
1743    
1744     sub _draw {
1745     my ($self) = @_;
1746    
1747 root 1.87 $self->SUPER::_draw;
1748 root 1.86
1749 root 1.87 glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;
1750 root 1.86
1751 root 1.87 my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;
1752 elmex 1.102
1753 root 1.87 glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1754 root 1.86
1755 elmex 1.102 my $tex = $self->{state} ? $tex[1] : $tex[0];
1756    
1757 root 1.197 glEnable GL_TEXTURE_2D;
1758 root 1.195 $tex->draw_quad_alpha (0, 0, $s, $s);
1759 elmex 1.102 glDisable GL_TEXTURE_2D;
1760 root 1.86 }
1761    
1762     #############################################################################
1763    
1764 elmex 1.145 package CFClient::UI::Image;
1765    
1766     our @ISA = CFClient::UI::Base::;
1767    
1768     use CFClient::OpenGL;
1769     use Carp qw/confess/;
1770    
1771     our %loaded_images;
1772    
1773     sub new {
1774     my $class = shift;
1775    
1776 elmex 1.150 my $self = $class->SUPER::new (can_events => 0, @_);
1777 elmex 1.145
1778     $self->{image} or confess "Image has 'image' not set. This is a fatal error!";
1779    
1780     $loaded_images{$self->{image}} ||=
1781     new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;
1782    
1783     my $tex = $self->{tex} = $loaded_images{$self->{image}};
1784    
1785 root 1.147 Scalar::Util::weaken $loaded_images{$self->{image}};
1786    
1787 elmex 1.145 $self->{aspect} = $tex->{w} / $tex->{h};
1788    
1789     $self
1790     }
1791    
1792     sub size_request {
1793     my ($self) = @_;
1794    
1795     ($self->{tex}->{w}, $self->{tex}->{h})
1796     }
1797    
1798     sub _draw {
1799     my ($self) = @_;
1800    
1801     my $tex = $self->{tex};
1802    
1803     my ($w, $h) = ($self->{w}, $self->{h});
1804    
1805     if ($self->{rot90}) {
1806     glRotate 90, 0, 0, 1;
1807     glTranslate 0, -$self->{w}, 0;
1808    
1809     ($w, $h) = ($h, $w);
1810     }
1811    
1812     glEnable GL_TEXTURE_2D;
1813     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1814    
1815 root 1.195 $tex->draw_quad_alpha (0, 0, $w, $h);
1816 elmex 1.145
1817     glDisable GL_TEXTURE_2D;
1818     }
1819    
1820     #############################################################################
1821    
1822 elmex 1.124 package CFClient::UI::VGauge;
1823    
1824     our @ISA = CFClient::UI::Base::;
1825    
1826 root 1.158 use List::Util qw(min max);
1827    
1828 root 1.138 use CFClient::OpenGL;
1829 elmex 1.124
1830     my %tex = (
1831     food => [
1832 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1833 elmex 1.124 qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
1834     ],
1835     grace => [
1836 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1837 root 1.158 qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
1838 elmex 1.124 ],
1839     hp => [
1840 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1841 elmex 1.124 qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
1842     ],
1843     mana => [
1844 root 1.144 map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1845 root 1.158 qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
1846 elmex 1.124 ],
1847     );
1848    
1849     # eg. VGauge->new (gauge => 'food'), default gauge: food
1850     sub new {
1851     my $class = shift;
1852    
1853 root 1.140 my $self = $class->SUPER::new (
1854 root 1.141 type => 'food',
1855 root 1.140 @_
1856     );
1857    
1858 root 1.141 $self->{aspect} = $tex{$self->{type}}[0]{w} / $tex{$self->{type}}[0]{h};
1859 elmex 1.124
1860     $self
1861     }
1862    
1863     sub size_request {
1864     my ($self) = @_;
1865    
1866 root 1.143 #my $tex = $tex{$self->{type}}[0];
1867     #@$tex{qw(w h)}
1868     (0, 0)
1869 elmex 1.124 }
1870    
1871     sub set_max {
1872     my ($self, $max) = @_;
1873 root 1.127
1874 root 1.173 return if $self->{max_val} == $max;
1875    
1876 elmex 1.124 $self->{max_val} = $max;
1877 root 1.173 $self->update;
1878 elmex 1.124 }
1879    
1880     sub set_value {
1881     my ($self, $val, $max) = @_;
1882    
1883     $self->set_max ($max)
1884     if defined $max;
1885    
1886 root 1.173 return if $self->{val} == $val;
1887    
1888 elmex 1.124 $self->{val} = $val;
1889     $self->update;
1890     }
1891    
1892     sub _draw {
1893     my ($self) = @_;
1894    
1895 root 1.141 my $tex = $tex{$self->{type}};
1896 root 1.158 my ($t1, $t2, $t3) = @$tex;
1897 elmex 1.124
1898     my ($w, $h) = ($self->{w}, $self->{h});
1899    
1900 elmex 1.142 if ($self->{vertical}) {
1901     glRotate 90, 0, 0, 1;
1902     glTranslate 0, -$self->{w}, 0;
1903    
1904     ($w, $h) = ($h, $w);
1905     }
1906    
1907 elmex 1.124 my $ycut = $self->{val} / ($self->{max_val} || 1);
1908    
1909 root 1.158 my $ycut1 = max 0, min 1, $ycut;
1910     my $ycut2 = max 0, min 1, $ycut - 1;
1911    
1912     my $h1 = $self->{h} * (1 - $ycut1);
1913     my $h2 = $self->{h} * (1 - $ycut2);
1914 elmex 1.124
1915     glEnable GL_BLEND;
1916     glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1917     glEnable GL_TEXTURE_2D;
1918     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1919    
1920 root 1.131 glBindTexture GL_TEXTURE_2D, $t1->{name};
1921     glBegin GL_QUADS;
1922 root 1.158 glTexCoord 0 , 0; glVertex 0 , 0;
1923     glTexCoord 0 , $t1->{t} * (1 - $ycut1); glVertex 0 , $h1;
1924     glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut1); glVertex $w, $h1;
1925     glTexCoord $t1->{s}, 0; glVertex $w, 0;
1926 root 1.131 glEnd;
1927 elmex 1.124
1928 root 1.158 my $ycut1 = List::Util::min 1, $ycut;
1929 root 1.131 glBindTexture GL_TEXTURE_2D, $t2->{name};
1930     glBegin GL_QUADS;
1931 root 1.158 glTexCoord 0 , $t2->{t} * (1 - $ycut1); glVertex 0 , $h1;
1932     glTexCoord 0 , $t2->{t} * (1 - $ycut2); glVertex 0 , $h2;
1933     glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut2); glVertex $w, $h2;
1934     glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut1); glVertex $w, $h1;
1935 root 1.131 glEnd;
1936 elmex 1.124
1937 root 1.158 if ($t3) {
1938     glBindTexture GL_TEXTURE_2D, $t3->{name};
1939     glBegin GL_QUADS;
1940     glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
1941     glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};
1942     glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};
1943     glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
1944     glEnd;
1945     }
1946    
1947 elmex 1.124 glDisable GL_BLEND;
1948     glDisable GL_TEXTURE_2D;
1949     }
1950    
1951     #############################################################################
1952    
1953 root 1.141 package CFClient::UI::Gauge;
1954    
1955     our @ISA = CFClient::UI::VBox::;
1956    
1957     sub new {
1958 root 1.151 my ($class, %arg) = @_;
1959 root 1.141
1960     my $self = $class->SUPER::new (
1961 root 1.171 tooltip => $arg{type},
1962     can_hover => 1,
1963     can_events => 1,
1964 root 1.151 %arg,
1965 root 1.141 );
1966    
1967 root 1.161 $self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1968     $self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
1969     $self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");
1970 root 1.141
1971     $self
1972     }
1973    
1974 elmex 1.146 sub set_fontsize {
1975     my ($self, $fsize) = @_;
1976    
1977     $self->{value}->set_fontsize ($fsize);
1978     $self->{max} ->set_fontsize ($fsize);
1979     }
1980    
1981 root 1.173 sub set_max {
1982     my ($self, $max) = @_;
1983    
1984     $self->{gauge}->set_max ($max);
1985     $self->{max}->set_text ($max);
1986     }
1987    
1988 root 1.141 sub set_value {
1989     my ($self, $val, $max) = @_;
1990    
1991     $self->set_max ($max)
1992     if defined $max;
1993    
1994     $self->{gauge}->set_value ($val, $max);
1995     $self->{value}->set_text ($val);
1996     }
1997    
1998     #############################################################################
1999    
2000 root 1.73 package CFClient::UI::Slider;
2001 root 1.68
2002     use strict;
2003    
2004 root 1.138 use CFClient::OpenGL;
2005 root 1.68
2006 root 1.73 our @ISA = CFClient::UI::DrawBG::;
2007 root 1.68
2008 elmex 1.99 my @tex =
2009     map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }
2010     qw(s1_slider.png s1_slider_bg.png);
2011    
2012 root 1.68 sub new {
2013     my $class = shift;
2014    
2015 root 1.206 # range [value, low, high, page, unit]
2016 root 1.68
2017 root 1.97 # TODO: 0-width page
2018     # TODO: req_w/h are wrong with vertical
2019     # TODO: calculations are off
2020 root 1.76 my $self = $class->SUPER::new (
2021 root 1.68 fg => [1, 1, 1],
2022     active_fg => [0, 0, 0],
2023     range => [0, 0, 100, 10],
2024 root 1.182 req_w => $::WIDTH / 80,
2025     req_h => $::WIDTH / 80,
2026 root 1.76 vertical => 0,
2027 root 1.97 can_hover => 1,
2028 root 1.206 inner_pad => .05,
2029 root 1.68 @_
2030 root 1.76 );
2031    
2032 root 1.206 $self->set_value ($self->{range}[0]);
2033     $self->update;
2034    
2035 root 1.76 $self
2036     }
2037    
2038 root 1.206 sub set_value {
2039     my ($self, $value) = @_;
2040    
2041     my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2042    
2043     $hi = $lo + 1 if $hi <= $lo;
2044    
2045     $value = $lo if $value < $lo;
2046     $value = $hi if $value > $hi;
2047    
2048     $value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2049     if $unit;
2050    
2051     $page = $hi - $lo if $page > $hi - $lo;
2052    
2053     @{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2054    
2055     if ($value != $old_value) {
2056     $self->emit (changed => $value);
2057     $self->update;
2058     }
2059     }
2060    
2061 root 1.76 sub size_request {
2062     my ($self) = @_;
2063    
2064     my $w = $self->{req_w};
2065     my $h = $self->{req_h};
2066    
2067     $self->{vertical} ? ($h, $w) : ($w, $h)
2068 root 1.68 }
2069    
2070 root 1.69 sub button_down {
2071     my ($self, $ev, $x, $y) = @_;
2072    
2073     $self->SUPER::button_down ($ev, $x, $y);
2074     $self->mouse_motion ($ev, $x, $y);
2075     }
2076    
2077     sub mouse_motion {
2078     my ($self, $ev, $x, $y) = @_;
2079    
2080     if ($GRAB == $self) {
2081 root 1.71 my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2082    
2083 root 1.206 my (undef, $lo, $hi, $page) = @{$self->{range}};
2084 elmex 1.103
2085 root 1.206 $x = $x / ($w * (1 - 2 * $self->{inner_pad})) - $self->{inner_pad};
2086 root 1.69
2087 root 1.206 $self->set_value ($x * ($hi - $lo) + $lo);
2088 root 1.69 }
2089     }
2090    
2091 root 1.206 sub update {
2092     my ($self) = @_;
2093    
2094     $CFClient::UI::ROOT->on_post_alloc ($self => sub {
2095     $self->set_value ($self->{range}[0]);
2096    
2097     my ($value, $lo, $hi, $page) = @{$self->{range}};
2098    
2099     my $inner_w = 1 - 2 * $self->{inner_pad};
2100    
2101     $self->{scale} = ($inner_w / ($hi - $lo)) || 1;
2102    
2103     $page = $self->{scale} * $page || 10 / ($self->{w} || 1);
2104     $value = $self->{scale} * ($value - $lo);
2105    
2106     $value = $self->{inner_pad} + ($value - $page * 0.5);
2107    
2108     $value = 0 if $value < 0;
2109     $page = 1 - $value if $value + $page > 1;
2110    
2111     $self->{knob_x} = $value;
2112     $self->{knob_w} = $page;
2113     });
2114    
2115     $self->SUPER::update;
2116 elmex 1.103 }
2117    
2118 root 1.68 sub _draw {
2119     my ($self) = @_;
2120    
2121     $self->SUPER::_draw ();
2122    
2123 root 1.206 glScale $self->{w}, $self->{h};
2124 root 1.68
2125     if ($self->{vertical}) {
2126     # draw a vertical slider like a rotated horizontal slider
2127    
2128     glRotate 90, 0, 0, 1;
2129 root 1.206 glTranslate 0, 1, 0;
2130 root 1.68 }
2131    
2132     my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2133     my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2134    
2135 elmex 1.99 glEnable GL_TEXTURE_2D;
2136     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2137    
2138     # draw background
2139 root 1.206 $tex[1]->draw_quad_alpha (0, 0, 1, 1);
2140 root 1.69
2141 elmex 1.99 # draw handle
2142 root 1.206 $tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2143 root 1.69
2144 elmex 1.99 glDisable GL_TEXTURE_2D;
2145 root 1.51 }
2146    
2147 root 1.39 #############################################################################
2148    
2149 root 1.97 package CFClient::UI::TextView;
2150    
2151     our @ISA = CFClient::UI::HBox::;
2152    
2153 root 1.138 use CFClient::OpenGL;
2154 root 1.97
2155     sub new {
2156     my $class = shift;
2157    
2158     my $self = $class->SUPER::new (
2159 root 1.164 fontsize => 1,
2160     can_events => 0,
2161     #font => default_font
2162 root 1.105 @_,
2163 root 1.164
2164 root 1.195 layout => (new CFClient::Layout 1),
2165 root 1.164 par => [],
2166     height => 0,
2167     children => [
2168 root 1.97 (new CFClient::UI::Empty expand => 1),
2169     (new CFClient::UI::Slider vertical => 1),
2170     ],
2171     );
2172    
2173 root 1.176 $self->{children}[1]->connect (changed => sub { $self->update });
2174 root 1.107
2175 root 1.97 $self
2176     }
2177    
2178 root 1.107 sub set_fontsize {
2179     my ($self, $fontsize) = @_;
2180    
2181     $self->{fontsize} = $fontsize;
2182     $self->reflow;
2183     }
2184    
2185 root 1.105 sub text_height {
2186     my ($self, $text) = @_;
2187    
2188     my $layout = $self->{layout};
2189    
2190 root 1.134 $layout->set_height ($self->{fontsize} * $::FONTSIZE);
2191 root 1.176 $layout->set_width ($self->{children}[0]{w});
2192 root 1.195 $layout->set_markup ($text);
2193 root 1.105
2194     ($layout->size)[1]
2195     }
2196    
2197     sub reflow {
2198     my ($self) = @_;
2199    
2200 root 1.107 $self->{need_reflow}++;
2201     $self->update;
2202 root 1.105 }
2203    
2204     sub size_allocate {
2205 root 1.128 my ($self, $w, $h) = @_;
2206 root 1.105
2207 root 1.134 $self->SUPER::size_allocate ($w, $h);
2208    
2209 root 1.157 $self->{layout}->set_font ($self->{font}) if $self->{font};
2210 root 1.134 $self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2211     $self->{layout}->set_width ($self->{children}[0]{w});
2212 root 1.105
2213     $self->reflow;
2214     }
2215    
2216 root 1.97 sub add_paragraph {
2217     my ($self, $color, $text) = @_;
2218    
2219 root 1.105 #TODO: intelligently "reformat" paragraph
2220    
2221     my $height = $self->text_height ($text);
2222    
2223     $self->{height} += $height;
2224    
2225     push @{$self->{par}}, [$height, $color, $text];
2226    
2227     $self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}];
2228 root 1.97 $self->{children}[1]->update;
2229     }
2230    
2231 root 1.105 sub update {
2232 root 1.97 my ($self) = @_;
2233    
2234 root 1.105 $self->SUPER::update;
2235    
2236     return unless $self->{h} > 0;
2237    
2238 root 1.107 delete $self->{texture};
2239    
2240 root 1.198 $ROOT->on_post_alloc ($self, sub {
2241 root 1.107 if (delete $self->{need_reflow}) {
2242     my $height = 0;
2243    
2244     $height += $_->[0] = $self->text_height ($_->[2])
2245     for @{$self->{par}};
2246    
2247     $self->{height} = $height;
2248    
2249     $self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];
2250    
2251     delete $self->{texture};
2252     }
2253    
2254 root 1.176 $self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {
2255 root 1.175 glClearColor 0, 0, 0, 0;
2256 root 1.107 glClear GL_COLOR_BUFFER_BIT;
2257    
2258     glEnable GL_TEXTURE_2D;
2259     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2260 root 1.105
2261 root 1.107 my $top = int $self->{children}[1]{range}[0];
2262 root 1.105
2263 root 1.107 my $y0 = $top;
2264     my $y1 = $top + $self->{h};
2265 root 1.105
2266 root 1.107 my $y = 0;
2267 root 1.97
2268 root 1.107 my $layout = $self->{layout};
2269 root 1.97
2270 root 1.157 $layout->set_font ($self->{font}) if $self->{font};
2271    
2272 root 1.107 for my $par (@{$self->{par}}) {
2273     my $h = $par->[0];
2274 root 1.97
2275 root 1.107 if ($y0 < $y + $h && $y < $y1) {
2276 root 1.195 $layout->set_foreground (@{ $par->[1] });
2277     $layout->set_markup ($par->[2]);
2278 root 1.105
2279 root 1.107 my ($W, $H) = $layout->size;
2280 root 1.195 CFClient::Texture->new_from_layout ($layout)->draw_quad_alpha_premultiplied (0, $y - $y0);
2281 root 1.107 }
2282    
2283     $y += $h;
2284 root 1.105 }
2285    
2286 root 1.107 glDisable GL_TEXTURE_2D;
2287     };
2288     });
2289 root 1.105 }
2290 root 1.97
2291 root 1.105 sub _draw {
2292     my ($self) = @_;
2293 root 1.97
2294 root 1.176 glEnable GL_TEXTURE_2D;
2295     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2296     glColor 1, 1, 1, 1;
2297 root 1.195 $self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2298 root 1.176 glDisable GL_TEXTURE_2D;
2299 root 1.97
2300 root 1.106 $self->{children}[1]->draw;
2301    
2302 root 1.97 }
2303    
2304     #############################################################################
2305    
2306 root 1.73 package CFClient::UI::Animator;
2307 root 1.35
2308 root 1.138 use CFClient::OpenGL;
2309 root 1.35
2310 root 1.73 our @ISA = CFClient::UI::Bin::;
2311 root 1.35
2312     sub moveto {
2313     my ($self, $x, $y) = @_;
2314    
2315     $self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
2316 root 1.56 $self->{speed} = 0.001;
2317 root 1.35 $self->{time} = 1;
2318    
2319     ::animation_start $self;
2320     }
2321    
2322     sub animate {
2323     my ($self, $interval) = @_;
2324    
2325     $self->{time} -= $interval * $self->{speed};
2326     if ($self->{time} <= 0) {
2327     $self->{time} = 0;
2328     ::animation_stop $self;
2329     }
2330    
2331     my ($x0, $y0, $x1, $y1) = @{$self->{moveto}};
2332    
2333     $self->{x} = $x0 * $self->{time} + $x1 * (1 - $self->{time});
2334     $self->{y} = $y0 * $self->{time} + $y1 * (1 - $self->{time});
2335     }
2336    
2337     sub _draw {
2338     my ($self) = @_;
2339    
2340     glPushMatrix;
2341 root 1.51 glRotate $self->{time} * 1000, 0, 1, 0;
2342 root 1.38 $self->{children}[0]->draw;
2343 root 1.35 glPopMatrix;
2344     }
2345    
2346 root 1.51 #############################################################################
2347    
2348 root 1.96 package CFClient::UI::Flopper;
2349    
2350     our @ISA = CFClient::UI::Button::;
2351    
2352     sub new {
2353     my $class = shift;
2354    
2355     my $self = $class->SUPER::new (
2356 root 1.164 state => 0,
2357 root 1.96 connect_activate => \&toggle_flopper,
2358     @_
2359     );
2360    
2361     if ($self->{state}) {
2362     $self->{state} = 0;
2363     $self->toggle_flopper;
2364     }
2365    
2366     $self
2367     }
2368    
2369     sub toggle_flopper {
2370     my ($self) = @_;
2371    
2372 root 1.97 # TODO: use animation
2373 root 1.96 if ($self->{state} = !$self->{state}) {
2374 root 1.113 $CFClient::UI::ROOT->add ($self->{other});
2375     $self->{other}->move ($self->coord2global (0, $self->{h}));
2376 root 1.114 $self->emit ("open");
2377 root 1.96 } else {
2378 root 1.113 $CFClient::UI::ROOT->remove ($self->{other});
2379 root 1.114 $self->emit ("close");
2380 root 1.96 }
2381 root 1.114
2382     $self->emit (changed => $self->{state});
2383 root 1.96 }
2384    
2385     #############################################################################
2386    
2387 root 1.153 package CFClient::UI::Tooltip;
2388    
2389     our @ISA = CFClient::UI::Bin::;
2390    
2391     use CFClient::OpenGL;
2392    
2393     sub new {
2394     my $class = shift;
2395    
2396     $class->SUPER::new (
2397     @_,
2398     can_events => 0,
2399     )
2400     }
2401    
2402 root 1.196 sub set_tooltip_from {
2403     my ($self, $widget) = @_;
2404 root 1.195
2405 root 1.197 $self->add (new CFClient::UI::Label
2406 root 1.196 markup => $widget->{tooltip},
2407     max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2408 root 1.195 fontsize => 0.8,
2409 root 1.196 fg => [0, 0, 0, 1],
2410 root 1.197 font => ($widget->{tooltip_font} || $::FONT_PROP),
2411     );
2412 root 1.153 }
2413    
2414     sub size_request {
2415     my ($self) = @_;
2416    
2417     my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2418    
2419 root 1.154 ($w + 4, $h + 4)
2420     }
2421    
2422 root 1.162 sub size_allocate {
2423     my ($self, $w, $h) = @_;
2424    
2425     $self->SUPER::size_allocate ($w - 4, $h - 4);
2426     }
2427    
2428 root 1.154 sub _draw {
2429     my ($self) = @_;
2430    
2431     glTranslate 0.375, 0.375;
2432    
2433     my ($w, $h) = @$self{qw(w h)};
2434    
2435     glColor 1, 0.8, 0.4;
2436     glBegin GL_QUADS;
2437     glVertex 0 , 0;
2438     glVertex 0 , $h;
2439     glVertex $w, $h;
2440     glVertex $w, 0;
2441     glEnd;
2442    
2443     glColor 0, 0, 0;
2444     glBegin GL_LINE_LOOP;
2445     glVertex 0 , 0;
2446     glVertex 0 , $h;
2447     glVertex $w, $h;
2448     glVertex $w, 0;
2449     glEnd;
2450    
2451 root 1.197 glTranslate 2 - 0.375, 2 - 0.375;
2452 root 1.154 $self->SUPER::_draw;
2453 root 1.153 }
2454    
2455     #############################################################################
2456    
2457 root 1.162 package CFClient::UI::Face;
2458    
2459     our @ISA = CFClient::UI::Base::;
2460    
2461     use CFClient::OpenGL;
2462    
2463     sub new {
2464     my $class = shift;
2465    
2466     $class->SUPER::new (
2467     aspect => 1,
2468     @_,
2469     )
2470     }
2471    
2472     sub size_request {
2473     (32, 8)
2474     }
2475    
2476 elmex 1.179 sub _draw {
2477 root 1.162 my ($self) = @_;
2478    
2479 root 1.185 return unless $::CONN;#d# manage and cache textures differently
2480 root 1.162 my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];
2481    
2482 root 1.178 # TODO animation
2483 root 1.162 if ($tex) {
2484     glEnable GL_TEXTURE_2D;
2485     glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2486     glColor 1, 1, 1, 1;
2487 root 1.195 $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2488 root 1.162 glDisable GL_TEXTURE_2D;
2489     }
2490     }
2491    
2492     #############################################################################
2493    
2494 root 1.186 package CFClient::UI::InventoryItem;
2495    
2496     our @ISA = CFClient::UI::HBox::;
2497    
2498     sub new {
2499     my $class = shift;
2500    
2501     my %args = @_;
2502    
2503 root 1.192 my $item = delete $args{item};
2504 root 1.186
2505     my $desc = $item->{nrof} < 2
2506     ? $item->{name}
2507     : "$item->{nrof} $item->{name_pl}";
2508    
2509 elmex 1.207 $item->{flags} & Crossfire::Protocol::F_OPEN
2510     and $desc .= " (open)";
2511     $item->{flags} & Crossfire::Protocol::F_APPLIED
2512     and $desc .= " (applied)";
2513     $item->{flags} & Crossfire::Protocol::F_UNPAID
2514     and $desc .= " (unpaid)";
2515     $item->{flags} & Crossfire::Protocol::F_MAGIC
2516     and $desc .= " (magic)";
2517     $item->{flags} & Crossfire::Protocol::F_CURSED
2518     and $desc .= " (cursed)";
2519     $item->{flags} & Crossfire::Protocol::F_DAMNED
2520     and $desc .= " (damned)";
2521     $item->{flags} & Crossfire::Protocol::F_LOCKED
2522     and $desc .= " *";
2523 root 1.186
2524     my $self = $class->SUPER::new (
2525     can_hover => 1,
2526     can_events => 1,
2527     tooltip => (CFClient::UI::Label->escape ($desc)
2528     . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
2529     connect_button_down => sub {
2530     my ($self, $ev, $x, $y) = @_;
2531    
2532     # todo: maybe put examine on 1? but should just be a tooltip :(
2533     if ($ev->{button} == 1) {
2534     $::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
2535     } elsif ($ev->{button} == 2) {
2536     $::CONN->send ("apply $item->{tag}");
2537     } elsif ($ev->{button} == 3) {
2538 elmex 1.207 my @menu_items = (
2539     ["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2540     ["mark", sub { $::CONN->send ("mark $item->{tag}") }],
2541     ["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2542     ["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2543     [
2544     $item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
2545     sub { $::CONN->send ("lock ". () ."$item->{tag}") },
2546 root 1.186 ],
2547 elmex 1.207 );
2548    
2549     CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2550 root 1.186 }
2551    
2552     1
2553     },
2554     %args
2555     );
2556 root 1.192
2557     $self->add (new CFClient::UI::Face
2558 root 1.186 can_events => 0,
2559     face => $item->{face},
2560     anim => $item->{anim},
2561 root 1.192 animspeed => $item->{animspeed},
2562     );
2563    
2564     $self->add (new CFClient::UI::Label
2565 root 1.186 can_events => 0,
2566 root 1.192 text => $desc,
2567     );
2568 root 1.186
2569     $self
2570     }
2571    
2572     #############################################################################
2573    
2574     package CFClient::UI::Inventory;
2575    
2576     our @ISA = CFClient::UI::ScrolledWindow::;
2577    
2578     sub new {
2579     my $class = shift;
2580    
2581     my $self = $class->SUPER::new (
2582     scrolled => (new CFClient::UI::VBox),
2583     @_,
2584     );
2585    
2586     $self
2587     }
2588    
2589     sub set_items {
2590     my ($self, $items) = @_;
2591    
2592     $self->{scrolled}->clear;
2593     return unless $items;
2594    
2595 root 1.201 my @items = sort {
2596     ($a->{type} <=> $b->{type})
2597     or ($a->{name} cmp $b->{name})
2598     } @$items;
2599 root 1.186
2600     $self->{real_items} = \@items;
2601    
2602     for my $item (@items) {
2603     my $desc = $item->{nrof} < 2
2604     ? $item->{name}
2605     : "$item->{nrof} $item->{name_pl}";
2606    
2607 root 1.201 $item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2608 root 1.186 }
2609    
2610 root 1.201 $self->{scrolled}->add (@items);
2611    
2612 root 1.186 # $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2613     }
2614    
2615     sub size_request {
2616     my ($self) = @_;
2617     ($self->{req_w}, $self->{req_h});
2618     }
2619    
2620     #############################################################################
2621    
2622 root 1.178 package CFClient::UI::Menu;
2623    
2624     our @ISA = CFClient::UI::FancyFrame::;
2625    
2626     use CFClient::OpenGL;
2627    
2628     sub new {
2629     my $class = shift;
2630    
2631     my $self = $class->SUPER::new (
2632     items => [],
2633     z => 100,
2634     @_,
2635     );
2636    
2637     $self->add ($self->{vbox} = new CFClient::UI::VBox);
2638    
2639     for my $item (@{ $self->{items} }) {
2640     my ($widget, $cb) = @$item;
2641    
2642     # handle various types of items, only text for now
2643     if (!ref $widget) {
2644     $widget = new CFClient::UI::Label
2645     can_hover => 1,
2646     can_events => 1,
2647     text => $widget;
2648     }
2649    
2650     $self->{item}{$widget} = $item;
2651    
2652     $self->{vbox}->add ($widget);
2653     }
2654    
2655     $self
2656     }
2657    
2658     # popup given the event (must be a mouse button down event currently)
2659     sub popup {
2660     my ($self, $ev) = @_;
2661    
2662     $self->emit ("popdown");
2663    
2664     # maybe save $GRAB? must be careful about events...
2665     $GRAB = $self;
2666     $self->{button} = $ev->{button};
2667    
2668     $self->show;
2669     $self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2670     }
2671    
2672     sub mouse_motion {
2673     my ($self, $ev, $x, $y) = @_;
2674    
2675 root 1.182 # TODO: should use vbox->find_widget or so
2676 root 1.178 $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2677     $self->{hover} = $self->{item}{$HOVER};
2678     }
2679    
2680     sub button_up {
2681     my ($self, $ev, $x, $y) = @_;
2682    
2683     if ($ev->{button} == $self->{button}) {
2684     undef $GRAB;
2685     $self->hide;
2686    
2687     $self->emit ("popdown");
2688     $self->{hover}[1]->() if $self->{hover};
2689     }
2690     }
2691    
2692     #############################################################################
2693    
2694 root 1.194 package CFClient::UI::Statusbox;
2695    
2696     our @ISA = CFClient::UI::VBox::;
2697    
2698     sub reorder {
2699     my ($self) = @_;
2700     my $NOW = time;
2701    
2702     while (my ($k, $v) = each %{ $self->{item} }) {
2703     delete $self->{item}{$k} if $v->{timeout} < $NOW;
2704     }
2705    
2706     my @widgets;
2707 root 1.197
2708     my @items = sort {
2709     $a->{pri} <=> $b->{pri}
2710     or $b->{id} <=> $a->{id}
2711     } values %{ $self->{item} };
2712    
2713 root 1.194 my $count = 10 + 1;
2714     for my $item (@items) {
2715     last unless --$count;
2716    
2717     push @widgets, $item->{label} ||= do {
2718     # TODO: doesn't handle markup well (read as: at all)
2719 root 1.197 my $short = $item->{count} > 1
2720     ? "<b>$item->{count} ×</b> $item->{text}"
2721     : $item->{text};
2722    
2723 root 1.194 for ($short) {
2724     s/^\s+//;
2725 root 1.205 s/\s+/ /g;
2726 root 1.198 my $len = int 40 / $item->{fontsize};
2727 root 1.194 substr $_, $len, length, "…" if $len < length;
2728     }
2729    
2730     new CFClient::UI::Label
2731 root 1.196 markup => $short,
2732 root 1.197 tooltip => $item->{tooltip},
2733 root 1.196 tooltip_font => $::FONT_PROP,
2734 root 1.197 tooltip_width => 0.67,
2735     fontsize => $item->{fontsize},
2736 root 1.205 fg => $item->{fg},
2737 root 1.196 can_events => 1,
2738 root 1.197 can_hover => 1
2739 root 1.194 };
2740     }
2741    
2742     $self->clear;
2743 root 1.197 $self->SUPER::add (reverse @widgets);
2744 root 1.194 }
2745    
2746     sub add {
2747     my ($self, $text, %arg) = @_;
2748    
2749 root 1.198 $text =~ s/^\s+//;
2750     $text =~ s/\s+$//;
2751    
2752 root 1.197 my $timeout = time + ((delete $arg{timeout}) || 60);
2753 root 1.194
2754 root 1.197 my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2755 root 1.194
2756 root 1.197 if (my $item = $self->{item}{$group}) {
2757     if ($item->{text} eq $text) {
2758     $item->{count}++;
2759     } else {
2760     $item->{count} = 1;
2761     $item->{text} = $item->{tooltip} = $text;
2762     }
2763 root 1.198 $item->{id} = ++$self->{id};
2764 root 1.197 $item->{timeout} = $timeout;
2765     delete $item->{label};
2766     } else {
2767     $self->{item}{$group} = {
2768     id => ++$self->{id},
2769     text => $text,
2770     timeout => $timeout,
2771     tooltip => $text,
2772     fontsize => 0.8,
2773 root 1.205 fg => [0.8, 0.8, 0.8, 0.8],
2774 root 1.197 pri => 0,
2775     count => 1,
2776     %arg,
2777     };
2778     }
2779 root 1.194
2780     $self->reorder;
2781     }
2782    
2783     #############################################################################
2784    
2785 root 1.113 package CFClient::UI::Root;
2786 root 1.51
2787 root 1.73 our @ISA = CFClient::UI::Container::;
2788 root 1.51
2789 root 1.138 use CFClient::OpenGL;
2790 root 1.107
2791 root 1.191 sub new {
2792     my $class = shift;
2793    
2794     $class->SUPER::new (
2795     @_,
2796     )
2797     }
2798    
2799     sub configure {
2800     my ($self, $x, $y, $w, $h) = @_;
2801    
2802     $self->{w} = $w;
2803     $self->{h} = $h;
2804     }
2805    
2806 root 1.125 sub check_size {
2807     my ($self) = @_;
2808    
2809 root 1.191 $self->size_allocate ($self->{w}, $self->{h})
2810     if $self->{w};
2811 root 1.125 }
2812    
2813 root 1.51 sub size_request {
2814 root 1.186 my ($self) = @_;
2815    
2816     ($self->{w}, $self->{h})
2817     }
2818    
2819     sub size_allocate {
2820     my ($self, $w, $h) = @_;
2821    
2822 root 1.202 my $old_w = $self->{old_w}; $self->{old_w} = $w;
2823     my $old_h = $self->{old_h}; $self->{old_h} = $h;
2824 root 1.186
2825 root 1.202 CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
2826     if $old_w && $old_h && ($old_w != $w || $old_h != $h);
2827 root 1.186
2828     for my $child ($self->children) {
2829 root 1.149 my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2830    
2831 root 1.205 $X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1
2832     if exists $child->{req_x};
2833    
2834     $Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1
2835     if exists $child->{req_y};
2836    
2837     $X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
2838     $Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
2839    
2840 root 1.186 $child->configure ($X, $Y, $W, $H);
2841 root 1.149 }
2842 root 1.191 }
2843    
2844     sub coord2local {
2845     my ($self, $x, $y) = @_;
2846    
2847     ($x, $y)
2848 root 1.51 }
2849    
2850 root 1.191 sub coord2global {
2851 root 1.58 my ($self, $x, $y) = @_;
2852    
2853     ($x, $y)
2854     }
2855    
2856 root 1.51 sub update {
2857     my ($self) = @_;
2858    
2859 root 1.125 $self->check_size;
2860 root 1.191 $::WANT_REFRESH++;
2861 root 1.51 }
2862    
2863     sub add {
2864 root 1.203 my ($self, @children) = @_;
2865    
2866     for my $child (@children) {
2867     $child->{toplevel} = 1;
2868 root 1.51
2869 root 1.203 # integerise window positions
2870     $child->{x} = int $child->{x};
2871     $child->{y} = int $child->{y};
2872     }
2873 elmex 1.146
2874 root 1.203 $self->SUPER::add (@children);
2875 root 1.51 }
2876    
2877 root 1.107 sub on_refresh {
2878     my ($self, $id, $cb) = @_;
2879    
2880     $self->{refresh_hook}{$id} = $cb;
2881     }
2882    
2883 root 1.198 sub on_post_alloc {
2884     my ($self, $id, $cb) = @_;
2885    
2886     $self->{post_alloc_hook}{$id} = $cb;
2887     }
2888    
2889 root 1.191 sub draw {
2890 root 1.51 my ($self) = @_;
2891    
2892 root 1.198 while ($self->{refresh_hook}) {
2893     $_->()
2894     for values %{delete $self->{refresh_hook}};
2895     }
2896    
2897 root 1.191 if ($self->{check_size}) {
2898     my @queue = ([], []);
2899    
2900     for (;;) {
2901     if ($self->{check_size}) {
2902     # heuristic: check containers last
2903     push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_
2904     for values %{delete $self->{check_size}}
2905     }
2906    
2907     my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;
2908    
2909     my ($w, $h) = $widget->{user_w} && $widget->{user_h}
2910     ? @$widget{qw(user_w user_h)}
2911     : $widget->size_request;
2912    
2913 root 1.197 if (delete $widget->{force_alloc}
2914     or $w != $widget->{req_w} or $h != $widget->{req_h}) {
2915 root 1.193 Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
2916    
2917 root 1.191 $widget->{req_w} = $w;
2918     $widget->{req_h} = $h;
2919    
2920 root 1.197 $self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];
2921 root 1.191
2922     $widget->{parent}->check_size
2923     if $widget->{parent};
2924     }
2925     }
2926     }
2927    
2928     while ($self->{size_alloc}) {
2929     for (values %{delete $self->{size_alloc}}) {
2930     my ($widget, $w, $h) = @$_;
2931    
2932 root 1.193 $w = 0 if $w < 0;
2933     $h = 0 if $h < 0;
2934    
2935 root 1.191 $widget->{w} = $w;
2936     $widget->{h} = $h;
2937     $widget->size_allocate ($w, $h);
2938     $widget->emit (size_allocate => $w, $h);
2939     }
2940     }
2941    
2942 root 1.198 while ($self->{post_alloc_hook}) {
2943 root 1.191 $_->()
2944 root 1.198 for values %{delete $self->{post_alloc_hook}};
2945 root 1.107 }
2946    
2947     glViewport 0, 0, $::WIDTH, $::HEIGHT;
2948     glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2949     glClear GL_COLOR_BUFFER_BIT;
2950    
2951     glMatrixMode GL_PROJECTION;
2952     glLoadIdentity;
2953     glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;
2954     glMatrixMode GL_MODELVIEW;
2955     glLoadIdentity;
2956    
2957 root 1.51 $self->_draw;
2958     }
2959    
2960     #############################################################################
2961    
2962 root 1.73 package CFClient::UI;
2963 root 1.51
2964 root 1.113 $ROOT = new CFClient::UI::Root;
2965 root 1.153 $TOOLTIP = new CFClient::UI::Tooltip;
2966 root 1.51
2967     1
2968 root 1.5