ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.260 by elmex, Tue May 30 14:35:09 2006 UTC vs.
Revision 1.305 by root, Sun Jun 18 17:13:12 2006 UTC

…		…
3	use utf8;	3	use utf8;
4	use strict;	4	use strict;
5		5
6	use Scalar::Util ();	6	use Scalar::Util ();
7	use List::Util ();	7	use List::Util ();
		8	use Event;
8		9
9	use CFClient;	10	use CFClient;
10	use CFClient::Texture;	11	use CFClient::Texture;
11		12
12	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
…		…
15	our $ROOT;	16	our $ROOT;
16	our $TOOLTIP;	17	our $TOOLTIP;
17	our $BUTTON_STATE;	18	our $BUTTON_STATE;
18		19
19	our %WIDGET; # all widgets, weak-referenced	20	our %WIDGET; # all widgets, weak-referenced
		21
		22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
		23	if (!$GRAB) {
		24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
		25	if (length $widget->{tooltip}) {
		26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->hide;
		28
		29	$TOOLTIP->{owner} = $widget;
		30
		31	return if $ENV{CFPLUS_DEBUG} & 8;
		32
		33	my $tip = $widget->{tooltip};
		34
		35	$tip = $tip->($widget) if CODE:: eq ref $tip;
		36
		37	$TOOLTIP->set_tooltip_from ($widget);
		38	$TOOLTIP->show;
		39	}
		40
		41	return;
		42	}
		43	}
		44	}
		45
		46	$TOOLTIP->hide;
		47	delete $TOOLTIP->{owner};
		48	});
20		49
21	sub get_layout {	50	sub get_layout {
22	my $layout;	51	my $layout;
23		52
24	for (grep { $_->{name} } values %WIDGET) {	53	for (grep { $_->{name} } values %WIDGET) {
…		…
39	my ($layout) = @_;	68	my ($layout) = @_;
40		69
41	$LAYOUT = $layout;	70	$LAYOUT = $layout;
42	}	71	}
43		72
44	sub check_tooltip {
45	if (!$GRAB) {
46	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
47	if (length $widget->{tooltip}) {
48
49	if ($TOOLTIP->{owner} != $widget) {
50	$TOOLTIP->hide;
51
52	$TOOLTIP->{owner} = $widget;
53
54	my $tip = $widget->{tooltip};
55
56	$tip = $tip->($widget) if CODE:: eq ref $tip;
57
58	$TOOLTIP->set_tooltip_from ($widget);
59	$TOOLTIP->show;
60	}
61
62	return;
63	}
64	}
65	}
66
67	$TOOLTIP->hide;
68	delete $TOOLTIP->{owner};
69	}
70
71	# class methods for events	73	# class methods for events
72	sub feed_sdl_key_down_event {	74	sub feed_sdl_key_down_event {
73	$FOCUS->emit (key_down => $_[0])	75	$FOCUS->emit (key_down => $_[0])
74	if $FOCUS;	76	if $FOCUS;
75	}	77	}
…		…
87	my $widget = $ROOT->find_widget ($x, $y);	89	my $widget = $ROOT->find_widget ($x, $y);
88		90
89	$GRAB = $widget;	91	$GRAB = $widget;
90	$GRAB->update if $GRAB;	92	$GRAB->update if $GRAB;
91		93
92	check_tooltip;	94	$TOOLTIP_WATCHER->cb->();
93	}	95	}
94		96
95	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
96		98
97	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
…		…
112	if (!$BUTTON_STATE) {	114	if (!$BUTTON_STATE) {
113	my $grab = $GRAB; undef $GRAB;	115	my $grab = $GRAB; undef $GRAB;
114	$grab->update if $grab;	116	$grab->update if $grab;
115	$GRAB->update if $GRAB;	117	$GRAB->update if $GRAB;
116		118
117	check_tooltip;	119	$TOOLTIP_WATCHER->cb->();
118	}	120	}
119	}	121	}
120		122
121	sub feed_sdl_motion_event {	123	sub feed_sdl_motion_event {
122	my ($ev) = @_;	124	my ($ev) = @_;
…		…
128	my $hover = $HOVER; $HOVER = $widget;	130	my $hover = $HOVER; $HOVER = $widget;
129		131
130	$hover->update if $hover && $hover->{can_hover};	132	$hover->update if $hover && $hover->{can_hover};
131	$HOVER->update if $HOVER && $HOVER->{can_hover};	133	$HOVER->update if $HOVER && $HOVER->{can_hover};
132		134
133	check_tooltip;	135	$TOOLTIP_WATCHER->start;
134	}	136	}
135		137
136	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))	138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
137	if $HOVER;	139	if $HOVER;
138	}	140	}
…		…
170	sub rescale_widgets {	172	sub rescale_widgets {
171	my ($sx, $sy) = @_;	173	my ($sx, $sy) = @_;
172		174
173	for my $widget (values %WIDGET) {	175	for my $widget (values %WIDGET) {
174	if ($widget->{is_toplevel}) {	176	if ($widget->{is_toplevel}) {
175	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;	177	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
176	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;	178	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
177		179
178	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;	180	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
179	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};	181	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
180	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};	182	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
181	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;	183	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
182	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	184	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
183	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};	185	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
184		186
185	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;	187	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
186	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;	188	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
187		189
188	}	190	}
189	}	191	}
190		192
191	reconfigure_widgets;	193	reconfigure_widgets;
…		…
270		272
271	return unless $self->{visible};	273	return unless $self->{visible};
272		274
273	$_->set_invisible for $self->children;	275	$_->set_invisible for $self->children;
274		276
		277	delete $self->{visible};
275	delete $self->{root};	278	delete $self->{root};
276	delete $self->{visible};
277		279
278	undef $GRAB if $GRAB == $self;	280	undef $GRAB if $GRAB == $self;
279	undef $HOVER if $HOVER == $self;	281	undef $HOVER if $HOVER == $self;
280		282
281	CFClient::UI::check_tooltip	283	$CFClient::UI::TOOLTIP_WATCHER->cb->()
282	if $TOOLTIP->{owner} == $self;	284	if $TOOLTIP->{owner} == $self;
283		285
284	$self->focus_out;	286	$self->emit ("focus_out");
285
286	$self->emit (visibility_change => 0);	287	$self->emit (visibility_change => 0);
287	}	288	}
288		289
289	sub set_visibility {	290	sub set_visibility {
290	my ($self, $visible) = @_;	291	my ($self, $visible) = @_;
…		…
313	}	314	}
314		315
315	sub move_abs {	316	sub move_abs {
316	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
317		318
318	$self->{x} = List::Util::max 0, int $x;	319	$self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
319	$self->{y} = List::Util::max 0, int $y;	320	$self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
320	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
321		322
322	$self->update;	323	$self->update;
323	}	324	}
324		325
…		…
365		366
366	$self->{root}{size_alloc}{$self+0} = $self;	367	$self->{root}{size_alloc}{$self+0} = $self;
367	}	368	}
368	}	369	}
369		370
370	sub size_allocate {
371	# nothing to be done
372	}
373
374	sub children {	371	sub children {
		372	# nop
		373	}
		374
		375	sub visible_children {
		376	$_[0]->children
375	}	377	}
376		378
377	sub set_max_size {	379	sub set_max_size {
378	my ($self, $w, $h) = @_;	380	my ($self, $w, $h) = @_;
379		381
380	delete $self->{max_w}; $self->{max_w} = $w if $w;	382	$self->{max_w} = int $w if defined $w;
381	delete $self->{max_h}; $self->{max_h} = $h if $h;	383	$self->{max_h} = int $h if defined $h;
		384
		385	$self->realloc;
382	}	386	}
383		387
384	sub set_tooltip {	388	sub set_tooltip {
385	my ($self, $tooltip) = @_;	389	my ($self, $tooltip) = @_;
386		390
…		…
391		395
392	$self->{tooltip} = $tooltip;	396	$self->{tooltip} = $tooltip;
393		397
394	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	398	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
395	delete $CFClient::UI::TOOLTIP->{owner};	399	delete $CFClient::UI::TOOLTIP->{owner};
396	CFClient::UI::check_tooltip;	400	$CFClient::UI::TOOLTIP_WATCHER->cb->();
397	}	401	}
398	}	402	}
399		403
400	# translate global coordinates to local coordinate system	404	# translate global coordinates to local coordinate system
401	sub coord2local {	405	sub coord2local {
…		…
409	my ($self, $x, $y) = @_;	413	my ($self, $x, $y) = @_;
410		414
411	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	415	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
412	}	416	}
413		417
414	sub focus_in {	418	sub invoke_focus_in {
415	my ($self) = @_;	419	my ($self) = @_;
416		420
417	return if $FOCUS == $self;	421	return if $FOCUS == $self;
418	return unless $self->{can_focus};	422	return unless $self->{can_focus};
419		423
420	my $focus = $FOCUS; $FOCUS = $self;	424	my $focus = $FOCUS; $FOCUS = $self;
421		425
422	$self->_emit (focus_in => $focus);
423
424	$focus->update if $focus;	426	$focus->update if $focus;
425	$FOCUS->update;	427	$FOCUS->update;
426	}
427		428
		429	0
		430	}
		431
428	sub focus_out {	432	sub invoke_focus_out {
429	my ($self) = @_;	433	my ($self) = @_;
430		434
431	return unless $FOCUS == $self;	435	return unless $FOCUS == $self;
432		436
433	my $focus = $FOCUS; undef $FOCUS;	437	my $focus = $FOCUS; undef $FOCUS;
434		438
435	$self->_emit (focus_out => $focus);
436
437	$focus->update if $focus; #?	439	$focus->update if $focus; #?
438		440
439	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	441	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
440	unless $FOCUS;	442	unless $FOCUS;
441	}
442		443
		444	0
		445	}
		446
		447	sub grab_focus {
		448	my ($self) = @_;
		449
		450	$self->emit ("focus_in");
		451	}
		452
443	sub mouse_motion { }	453	sub invoke_mouse_motion { 1 }
444	sub button_up { }	454	sub invoke_button_up { 1 }
445	sub key_down { }	455	sub invoke_key_down { 1 }
446	sub key_up { }	456	sub invoke_key_up { 1 }
447		457
448	sub button_down {	458	sub invoke_button_down {
449	my ($self, $ev, $x, $y) = @_;	459	my ($self, $ev, $x, $y) = @_;
450		460
451	$self->focus_in;	461	$self->grab_focus;
452	}
453		462
454	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	463	1
455	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	464	}
456	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	465
457	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	466	sub connect {
458	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	467	my ($self, $signal, $cb) = @_;
		468
		469	push @{ $self->{signal_cb}{$signal} }, $cb;
		470	}
		471
		472	sub emit {
		473	my ($self, $signal, @args) = @_;
		474
		475	(List::Util::sum +(map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}), # before
		476	($self->can ("invoke_$signal") || sub { 1 })->($self, @args)) # closure
		477	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
		478	}
459		479
460	sub find_widget {	480	sub find_widget {
461	my ($self, $x, $y) = @_;	481	my ($self, $x, $y) = @_;
462		482
463	return () unless $self->{can_events};	483	return () unless $self->{can_events};
…		…
472	sub set_parent {	492	sub set_parent {
473	my ($self, $parent) = @_;	493	my ($self, $parent) = @_;
474		494
475	Scalar::Util::weaken ($self->{parent} = $parent);	495	Scalar::Util::weaken ($self->{parent} = $parent);
476	$self->set_visible if $parent->{visible};	496	$self->set_visible if $parent->{visible};
477	}
478
479	sub connect {
480	my ($self, $signal, $cb) = @_;
481
482	push @{ $self->{signal_cb}{$signal} }, $cb;
483	}
484
485	sub _emit {
486	my ($self, $signal, @args) = @_;
487
488	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
489	}
490
491	sub emit {
492	my ($self, $signal, @args) = @_;
493
494	$self->_emit ($signal, @args)
495	|| $self->$signal (@args);
496	}
497
498	sub visibility_change {
499	#my ($self, $visible) = @_;
500	}	497	}
501		498
502	sub realloc {	499	sub realloc {
503	my ($self) = @_;	500	my ($self) = @_;
504		501
…		…
525		522
526	$self->realloc;	523	$self->realloc;
527	$self->update;	524	$self->update;
528	}	525	}
529		526
		527	# using global variables seems a bit hacky, but passing through all drawing
		528	# functions seems pointless.
		529	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
		530
530	sub draw {	531	sub draw {
531	my ($self) = @_;	532	my ($self) = @_;
532		533
533	return unless $self->{h} && $self->{w};	534	return unless $self->{h} && $self->{w};
		535
		536	# update screen rectangle
		537	local $draw_x = $draw_x + $self->{x};
		538	local $draw_y = $draw_y + $self->{y};
		539	local $draw_w = $draw_x + $self->{w};
		540	local $draw_h = $draw_y + $self->{h};
		541
		542	# skip widgets that are entirely outside the drawing area
		543	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		544	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
534		545
535	glPushMatrix;	546	glPushMatrix;
536	glTranslate $self->{x}, $self->{y}, 0;	547	glTranslate $self->{x}, $self->{y}, 0;
537	$self->_draw;
538	glPopMatrix;
539		548
540	if ($self == $HOVER && $self->{can_hover}) {	549	if ($self == $HOVER && $self->{can_hover}) {
541	my ($x, $y) = @$self{qw(x y)};
542
543	glColor 1, 0.8, 0.5, 0.2;	550	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
544	glEnable GL_BLEND;	551	glEnable GL_BLEND;
545	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	552	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
546	glBegin GL_QUADS;	553	glBegin GL_QUADS;
547	glVertex $x , $y;	554	glVertex 0 , 0;
548	glVertex $x + $self->{w}, $y;	555	glVertex $self->{w}, 0;
549	glVertex $x + $self->{w}, $y + $self->{h};	556	glVertex $self->{w}, $self->{h};
550	glVertex $x , $y + $self->{h};	557	glVertex 0 , $self->{h};
551	glEnd;	558	glEnd;
552	glDisable GL_BLEND;	559	glDisable GL_BLEND;
553	}	560	}
554		561
555	if ($ENV{CFPLUS_DEBUG} & 1) {	562	if ($ENV{CFPLUS_DEBUG} & 1) {
556	glPushMatrix;	563	glPushMatrix;
557	glColor 1, 1, 0, 1;	564	glColor 1, 1, 0, 1;
558	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	565	glTranslate 0.375, 0.375;
559	glBegin GL_LINE_LOOP;	566	glBegin GL_LINE_LOOP;
560	glVertex 0 , 0;	567	glVertex 0 , 0;
561	glVertex $self->{w} - 1, 0;	568	glVertex $self->{w} - 1, 0;
562	glVertex $self->{w} - 1, $self->{h} - 1;	569	glVertex $self->{w} - 1, $self->{h} - 1;
563	glVertex 0 , $self->{h} - 1;	570	glVertex 0 , $self->{h} - 1;
564	glEnd;	571	glEnd;
565	glPopMatrix;	572	glPopMatrix;
566	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	573	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
567	}	574	}
		575
		576	$self->_draw;
		577	glPopMatrix;
568	}	578	}
569		579
570	sub _draw {	580	sub _draw {
571	my ($self) = @_;	581	my ($self) = @_;
572		582
…		…
575		585
576	sub DESTROY {	586	sub DESTROY {
577	my ($self) = @_;	587	my ($self) = @_;
578		588
579	delete $WIDGET{$self+0};	589	delete $WIDGET{$self+0};
580	#$self->deactivate;	590
		591	eval { $self->destroy };
		592	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
581	}	593	}
582		594
583	#############################################################################	595	#############################################################################
584		596
585	package CFClient::UI::DrawBG;	597	package CFClient::UI::DrawBG;
…		…
610		622
611	if ($color && (@$color < 4 || $color->[3])) {	623	if ($color && (@$color < 4 || $color->[3])) {
612	my ($w, $h) = @$self{qw(w h)};	624	my ($w, $h) = @$self{qw(w h)};
613		625
614	glEnable GL_BLEND;	626	glEnable GL_BLEND;
615	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	627	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
616	glColor @$color;	628	glColor_premultiply @$color;
617		629
618	glBegin GL_QUADS;	630	glBegin GL_QUADS;
619	glVertex 0 , 0;	631	glVertex 0 , 0;
620	glVertex 0 , $h;	632	glVertex 0 , $h;
621	glVertex $w, $h;	633	glVertex $w, $h;
…		…
652	our @ISA = CFClient::UI::Base::;	664	our @ISA = CFClient::UI::Base::;
653		665
654	sub new {	666	sub new {
655	my ($class, %arg) = @_;	667	my ($class, %arg) = @_;
656		668
657	my $children = delete $arg{children} || [];	669	my $children = delete $arg{children};
658		670
659	my $self = $class->SUPER::new (	671	my $self = $class->SUPER::new (
660	children => [],	672	children => [],
661	can_events => 0,	673	can_events => 0,
662	%arg,	674	%arg,
663	);	675	);
		676
664	$self->add ($_) for @$children;	677	$self->add (@$children)
		678	if $children;
665		679
666	$self	680	$self
667	}	681	}
668		682
669	sub add {	683	sub add {
…		…
717	$x -= $self->{x};	731	$x -= $self->{x};
718	$y -= $self->{y};	732	$y -= $self->{y};
719		733
720	my $res;	734	my $res;
721		735
722	for (reverse @{ $self->{children} }) {	736	for (reverse $self->visible_children) {
723	$res = $_->find_widget ($x, $y)	737	$res = $_->find_widget ($x, $y)
724	and return $res;	738	and return $res;
725	}	739	}
726		740
727	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	741	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
748	}	762	}
749		763
750	sub add {	764	sub add {
751	my ($self, $child) = @_;	765	my ($self, $child) = @_;
752		766
753	$self->{children} = [];	767	$self->SUPER::remove ($_) for @{ $self->{children} };
754
755	$self->SUPER::add ($child);	768	$self->SUPER::add ($child);
756	}	769	}
757		770
758	sub remove {	771	sub remove {
759	my ($self, $widget) = @_;	772	my ($self, $widget) = @_;
…		…
768		781
769	sub size_request {	782	sub size_request {
770	$_[0]{children}[0]->size_request	783	$_[0]{children}[0]->size_request
771	}	784	}
772		785
773	sub size_allocate {	786	sub invoke_size_allocate {
774	my ($self, $w, $h) = @_;	787	my ($self, $w, $h) = @_;
775		788
776	$self->{children}[0]->configure (0, 0, $w, $h);	789	$self->{children}[0]->configure (0, 0, $w, $h);
		790
		791	1
777	}	792	}
778		793
779	#############################################################################	794	#############################################################################
		795
		796	# back-buffered drawing area
780		797
781	package CFClient::UI::Window;	798	package CFClient::UI::Window;
782		799
783	our @ISA = CFClient::UI::Bin::;	800	our @ISA = CFClient::UI::Bin::;
784		801
…		…
795		812
796	$ROOT->on_post_alloc ($self => sub { $self->render_child });	813	$ROOT->on_post_alloc ($self => sub { $self->render_child });
797	$self->SUPER::update;	814	$self->SUPER::update;
798	}	815	}
799		816
800	sub size_allocate {	817	sub invoke_size_allocate {
801	my ($self, $w, $h) = @_;	818	my ($self, $w, $h) = @_;
802		819
803	$self->SUPER::size_allocate ($w, $h);
804	$self->update;	820	$self->update;
		821
		822	$self->SUPER::invoke_size_allocate ($w, $h)
805	}	823	}
806		824
807	sub _render {	825	sub _render {
		826	my ($self) = @_;
		827
808	$_[0]{children}[0]->draw;	828	$self->{children}[0]->draw;
809	}	829	}
810		830
811	sub render_child {	831	sub render_child {
812	my ($self) = @_;	832	my ($self) = @_;
813		833
814	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	834	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
815	glClearColor 0, 0, 0, 0;	835	glClearColor 0, 0, 0, 0;
816	glClear GL_COLOR_BUFFER_BIT;	836	glClear GL_COLOR_BUFFER_BIT;
817		837
		838	{
		839	package CFClient::UI::Base;
		840
		841	($draw_x, $draw_y, $draw_w, $draw_h) =
		842	(0, 0, $self->{w}, $self->{h});
		843	}
		844
818	$self->_render;	845	$self->_render;
819	};	846	};
820	}	847	}
821		848
822	sub _draw {	849	sub _draw {
823	my ($self) = @_;	850	my ($self) = @_;
824		851
825	my ($w, $h) = ($self->w, $self->h);	852	my ($w, $h) = @$self{qw(w h)};
826		853
827	my $tex = $self->{texture}	854	my $tex = $self->{texture}
828	or return;	855	or return;
829		856
830	glEnable GL_TEXTURE_2D;	857	glEnable GL_TEXTURE_2D;
831	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	858	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
832	glColor 1, 1, 1, 1;	859	glColor 0, 0, 0, 1;
833		860
834	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	861	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
835		862
836	glDisable GL_TEXTURE_2D;	863	glDisable GL_TEXTURE_2D;
837	}	864	}
…		…
861	$h = 10 if $self->{scroll_y};	888	$h = 10 if $self->{scroll_y};
862		889
863	($w, $h)	890	($w, $h)
864	}	891	}
865		892
866	sub size_allocate {	893	sub invoke_size_allocate {
867	my ($self, $w, $h) = @_;	894	my ($self, $w, $h) = @_;
868		895
869	my $child = $self->child;	896	my $child = $self->child;
870		897
871	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};	898	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
872	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};	899	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
873		900
874	$self->child->configure (0, 0, $w, $h);	901	$self->child->configure (0, 0, $w, $h);
875	$self->update;	902	$self->update;
		903
		904	1
876	}	905	}
877		906
878	sub set_offset {	907	sub set_offset {
879	my ($self, $x, $y) = @_;	908	my ($self, $x, $y) = @_;
880		909
…		…
913	}	942	}
914		943
915	sub _render {	944	sub _render {
916	my ($self) = @_;	945	my ($self) = @_;
917		946
		947	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		948	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		949
918	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	950	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
919		951
920	$self->SUPER::_render;	952	$self->SUPER::_render;
921	}	953	}
922		954
…		…
925	package CFClient::UI::ScrolledWindow;	957	package CFClient::UI::ScrolledWindow;
926		958
927	our @ISA = CFClient::UI::HBox::;	959	our @ISA = CFClient::UI::HBox::;
928		960
929	sub new {	961	sub new {
930	my $class = shift;	962	my ($class, %arg) = @_;
		963
		964	my $child = delete $arg{child};
931		965
932	my $self;	966	my $self;
933		967
934	my $slider = new CFClient::UI::Slider	968	my $slider = new CFClient::UI::Slider
935	vertical => 1,	969	vertical => 1,
…		…
940	;	974	;
941		975
942	$self = $class->SUPER::new (	976	$self = $class->SUPER::new (
943	vp => (new CFClient::UI::ViewPort expand => 1),	977	vp => (new CFClient::UI::ViewPort expand => 1),
944	slider => $slider,	978	slider => $slider,
945	@_,	979	%arg,
946	);	980	);
947		981
948	$self->{vp}->add ($self->{scrolled});
949	$self->add ($self->{vp});
950	$self->add ($self->{slider});	982	$self->SUPER::add ($self->{vp}, $self->{slider});
		983	$self->add ($child) if $child;
951		984
952	$self	985	$self
		986	}
		987
		988	sub add {
		989	my ($self, $widget) = @_;
		990
		991	$self->{vp}->add ($self->{child} = $widget);
953	}	992	}
954		993
955	sub update {	994	sub update {
956	my ($self) = @_;	995	my ($self) = @_;
957		996
…		…
960	# todo: overwrite size_allocate of child	999	# todo: overwrite size_allocate of child
961	my $child = $self->{vp}->child;	1000	my $child = $self->{vp}->child;
962	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1001	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
963	}	1002	}
964		1003
965	sub size_allocate {	1004	sub invoke_size_allocate {
966	my ($self, $w, $h) = @_;	1005	my ($self, $w, $h) = @_;
967
968	$self->SUPER::size_allocate ($w, $h);
969		1006
970	my $child = $self->{vp}->child;	1007	my $child = $self->{vp}->child;
971	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1008	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		1009
		1010	$self->SUPER::invoke_size_allocate ($w, $h)
972	}	1011	}
973		1012
974	#TODO# update range on size_allocate depending on child	1013	#TODO# update range on size_allocate depending on child
975	# update viewport offset on scroll	1014	# update viewport offset on scroll
976		1015
…		…
996		1035
997	if ($self->{bg}) {	1036	if ($self->{bg}) {
998	my ($w, $h) = @$self{qw(w h)};	1037	my ($w, $h) = @$self{qw(w h)};
999		1038
1000	glEnable GL_BLEND;	1039	glEnable GL_BLEND;
1001	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1040	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1002	glColor @{ $self->{bg} };	1041	glColor_premultiply @{ $self->{bg} };
1003		1042
1004	glBegin GL_QUADS;	1043	glBegin GL_QUADS;
1005	glVertex 0 , 0;	1044	glVertex 0 , 0;
1006	glVertex 0 , $h;	1045	glVertex 0 , $h;
1007	glVertex $w, $h;	1046	glVertex $w, $h;
…		…
1029	my @border =	1068	my @border =
1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1069	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1031	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1070	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1032		1071
1033	sub new {	1072	sub new {
1034	my $class = shift;	1073	my ($class, %arg) = @_;
1035		1074
1036	my $self = $class->SUPER::new (	1075	my $self = $class->SUPER::new (
1037	bg => [1, 1, 1, 1],	1076	bg => [1, 1, 1, 1],
1038	border_bg => [1, 1, 1, 1],	1077	border_bg => [1, 1, 1, 1],
1039	border => 0.6,	1078	border => 0.6,
1040	can_events => 1,	1079	can_events => 1,
1041	min_w => 16,	1080	min_w => 16,
1042	min_h => 16,	1081	min_h => 16,
1043	@_	1082	%arg,
1044	);	1083	);
1045		1084
1046	$self->{title} &&= new CFClient::UI::Label	1085	$self->{title_widget} = new CFClient::UI::Label
1047	align => 0,	1086	align => 0,
1048	valign => 1,	1087	valign => 1,
1049	text => $self->{title},	1088	text => $self->{title},
1050	fontsize => $self->{border};	1089	fontsize => $self->{border},
		1090	if exists $self->{title};
		1091
		1092	if ($self->{has_close_button}) {
		1093	$self->{close_button} =
		1094	new CFClient::UI::ImageButton
		1095	image => 'x1_close.png',
		1096	on_activate => sub { $self->hide };
		1097
		1098	$self->CFClient::UI::Container::add ($self->{close_button});
		1099	}
1051		1100
1052	$self	1101	$self
		1102	}
		1103
		1104	sub add {
		1105	my ($self, @widgets) = @_;
		1106
		1107	$self->SUPER::add (@widgets);
		1108	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
		1109	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1053	}	1110	}
1054		1111
1055	sub border {	1112	sub border {
1056	int $_[0]{border} * $::FONTSIZE	1113	int $_[0]{border} * $::FONTSIZE
1057	}	1114	}
1058		1115
1059	sub size_request {	1116	sub size_request {
1060	my ($self) = @_;	1117	my ($self) = @_;
		1118
		1119	$self->{title_widget}->size_request
		1120	if $self->{title_widget};
		1121
		1122	$self->{close_button}->size_request
		1123	if $self->{close_button};
1061		1124
1062	my ($w, $h) = $self->SUPER::size_request;	1125	my ($w, $h) = $self->SUPER::size_request;
1063		1126
1064	(	1127	(
1065	$w + $self->border * 2,	1128	$w + $self->border * 2,
1066	$h + $self->border * 2,	1129	$h + $self->border * 2,
1067	)	1130	)
1068	}	1131	}
1069		1132
1070	sub size_allocate {	1133	sub invoke_size_allocate {
1071	my ($self, $w, $h) = @_;	1134	my ($self, $w, $h) = @_;
1072		1135
		1136	if ($self->{title_widget}) {
		1137	$self->{title_widget}{w} = $w;
		1138	$self->{title_widget}{h} = $h;
		1139	$self->{title_widget}->invoke_size_allocate ($w, $h);
		1140	}
		1141
		1142	my $border = $self->border;
		1143
1073	$h -= List::Util::max 0, $self->border * 2;	1144	$h -= List::Util::max 0, $border * 2;
1074	$w -= List::Util::max 0, $self->border * 2;	1145	$w -= List::Util::max 0, $border * 2;
1075		1146
1076	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1077	if $self->{title};
1078
1079	$self->child->configure ($self->border, $self->border, $w, $h);	1147	$self->child->configure ($border, $border, $w, $h);
1080	}
1081		1148
		1149	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1150	if $self->{close_button};
		1151
		1152	1
		1153	}
		1154
1082	sub button_down {	1155	sub invoke_button_down {
1083	my ($self, $ev, $x, $y) = @_;	1156	my ($self, $ev, $x, $y) = @_;
1084		1157
1085	my ($w, $h) = @$self{qw(w h)};	1158	my ($w, $h) = @$self{qw(w h)};
1086	my $border = $self->border;	1159	my $border = $self->border;
1087		1160
…		…
1103	my $dy = $ev->{y} - $oy;	1176	my $dy = $ev->{y} - $oy;
1104		1177
1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1178	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1179	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1107		1180
		1181	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1108	$self->realloc;	1182	$self->realloc;
1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1110	};	1183	};
1111		1184
1112	} elsif ($lr ^ $td) {	1185	} elsif ($lr ^ $td) {
1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1186	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1114	my ($bx, $by) = ($self->{x}, $self->{y});	1187	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1117	my ($ev, $x, $y) = @_;	1190	my ($ev, $x, $y) = @_;
1118		1191
1119	($x, $y) = ($ev->{x}, $ev->{y});	1192	($x, $y) = ($ev->{x}, $ev->{y});
1120		1193
1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1194	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
		1195	# HACK: the next line is required to enforce placement
		1196	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1122	};	1197	};
		1198	} else {
		1199	return 0;
		1200	}
		1201
1123	}	1202	1
1124	}	1203	}
1125		1204
1126	sub button_up {	1205	sub invoke_button_up {
1127	my ($self, $ev, $x, $y) = @_;	1206	my ($self, $ev, $x, $y) = @_;
1128		1207
1129	delete $self->{motion};	1208	! ! delete $self->{motion}
1130	}	1209	}
1131		1210
1132	sub mouse_motion {	1211	sub invoke_mouse_motion {
1133	my ($self, $ev, $x, $y) = @_;	1212	my ($self, $ev, $x, $y) = @_;
1134		1213
1135	$self->{motion}->($ev, $x, $y) if $self->{motion};	1214	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1215
		1216	! ! $self->{motion}
1136	}	1217	}
1137		1218
1138	sub _draw {	1219	sub _draw {
1139	my ($self) = @_;	1220	my ($self) = @_;
1140		1221
		1222	my $child = $self->{children}[0];
		1223
1141	my ($w, $h ) = ($self->{w}, $self->{h});	1224	my ($w, $h ) = ($self->{w}, $self->{h});
1142	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1225	my ($cw, $ch) = ($child->{w}, $child->{h});
1143		1226
1144	glEnable GL_TEXTURE_2D;	1227	glEnable GL_TEXTURE_2D;
1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1228	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1146		1229
1147	my $border = $self->border;	1230	my $border = $self->border;
…		…
1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1245	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1163	}	1246	}
1164		1247
1165	glDisable GL_TEXTURE_2D;	1248	glDisable GL_TEXTURE_2D;
1166		1249
1167	$self->{title}->draw if $self->{title};
1168
1169	$self->child->draw;	1250	$child->draw;
		1251
		1252	if ($self->{title_widget}) {
		1253	glTranslate 0, $border - $self->{h};
		1254	$self->{title_widget}->_draw;
		1255
		1256	glTranslate 0, - ($border - $self->{h});
		1257	}
		1258
		1259	$self->{close_button}->draw
		1260	if $self->{close_button};
1170	}	1261	}
1171		1262
1172	#############################################################################	1263	#############################################################################
1173		1264
1174	package CFClient::UI::Table;	1265	package CFClient::UI::Table;
…		…
1197		1288
1198	$child->set_parent ($self);	1289	$child->set_parent ($self);
1199	$self->{children}[$y][$x] = $child;	1290	$self->{children}[$y][$x] = $child;
1200		1291
1201	$self->realloc;	1292	$self->realloc;
		1293	}
		1294
		1295	sub remove {
		1296	my ($self, $child) = @_;
		1297
		1298	# TODO: not yet implemented
1202	}	1299	}
1203		1300
1204	# TODO: move to container class maybe? send children a signal on removal?	1301	# TODO: move to container class maybe? send children a signal on removal?
1205	sub clear {	1302	sub clear {
1206	my ($self) = @_;	1303	my ($self) = @_;
…		…
1247	(sum @$ws),	1344	(sum @$ws),
1248	(sum @$hs),	1345	(sum @$hs),
1249	)	1346	)
1250	}	1347	}
1251		1348
1252	sub size_allocate {	1349	sub invoke_size_allocate {
1253	my ($self, $w, $h) = @_;	1350	my ($self, $w, $h) = @_;
1254		1351
1255	my ($ws, $hs) = $self->get_wh;	1352	my ($ws, $hs) = $self->get_wh;
1256		1353
1257	my $req_w = (sum @$ws) || 1;	1354	my $req_w = (sum @$ws) || 1;
…		…
1289	}	1386	}
1290		1387
1291	$y += $row_h;	1388	$y += $row_h;
1292	}	1389	}
1293		1390
		1391	1
1294	}	1392	}
1295		1393
1296	sub find_widget {	1394	sub find_widget {
1297	my ($self, $x, $y) = @_;	1395	my ($self, $x, $y) = @_;
1298		1396
…		…
1335	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1433	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1336	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1434	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1337	)	1435	)
1338	}	1436	}
1339		1437
1340	sub size_allocate {	1438	sub invoke_size_allocate {
1341	my ($self, $w, $h) = @_;	1439	my ($self, $w, $h) = @_;
1342		1440
1343	my $space = $self->{vertical} ? $h : $w;	1441	my $space = $self->{vertical} ? $h : $w;
1344	my $children = $self->{children};	1442	my $children = $self->{children};
1345		1443
…		…
1467		1565
1468	delete $self->{texture};	1566	delete $self->{texture};
1469	$self->SUPER::update;	1567	$self->SUPER::update;
1470	}	1568	}
1471		1569
		1570	sub realloc {
		1571	my ($self) = @_;
		1572
		1573	delete $self->{ox};
		1574	$self->SUPER::realloc;
		1575	}
		1576
1472	sub set_text {	1577	sub set_text {
1473	my ($self, $text) = @_;	1578	my ($self, $text) = @_;
1474		1579
1475	return if $self->{text} eq "T$text";	1580	return if $self->{text} eq "T$text";
1476	$self->{text} = "T$text";	1581	$self->{text} = "T$text";
1477		1582
1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1583	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1479	$self->{layout}->set_text ($text);	1584	$self->{layout}->set_text ($text);
1480		1585
		1586	delete $self->{size_req};
1481	$self->realloc;	1587	$self->realloc;
1482	$self->update;	1588	$self->update;
1483	}	1589	}
1484		1590
1485	sub set_markup {	1591	sub set_markup {
…		…
1491	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1597	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1492		1598
1493	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1599	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1494	$self->{layout}->set_markup ($markup);	1600	$self->{layout}->set_markup ($markup);
1495		1601
		1602	delete $self->{size_req};
1496	$self->realloc;	1603	$self->realloc;
1497	$self->update;	1604	$self->update;
1498	}	1605	}
1499		1606
1500	sub size_request {	1607	sub size_request {
1501	my ($self) = @_;	1608	my ($self) = @_;
1502		1609
		1610	$self->{size_req} ||= do {
1503	$self->{layout}->set_font ($self->{font}) if $self->{font};	1611	$self->{layout}->set_font ($self->{font}) if $self->{font};
1504	$self->{layout}->set_width ($self->{max_w} || -1);	1612	$self->{layout}->set_width ($self->{max_w} || -1);
1505	$self->{layout}->set_ellipsise ($self->{ellipsise});	1613	$self->{layout}->set_ellipsise ($self->{ellipsise});
1506	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1614	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1507	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1615	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1508		1616
1509	my ($w, $h) = $self->{layout}->size;	1617	my ($w, $h) = $self->{layout}->size;
1510		1618
1511	if (exists $self->{template}) {	1619	if (exists $self->{template}) {
1512	$self->{template}->set_font ($self->{font}) if $self->{font};	1620	$self->{template}->set_font ($self->{font}) if $self->{font};
1513	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1621	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1514		1622
1515	my ($w2, $h2) = $self->{template}->size;	1623	my ($w2, $h2) = $self->{template}->size;
1516		1624
1517	$w = List::Util::max $w, $w2;	1625	$w = List::Util::max $w, $w2;
1518	$h = List::Util::max $h, $h2;	1626	$h = List::Util::max $h, $h2;
		1627	}
		1628
		1629	[$w, $h]
1519	}	1630	};
1520		1631
1521	($w, $h)	1632	@{ $self->{size_req} }
1522	}	1633	}
1523		1634
1524	sub size_allocate {	1635	sub invoke_size_allocate {
1525	my ($self, $w, $h) = @_;	1636	my ($self, $w, $h) = @_;
1526		1637
		1638	delete $self->{ox};
		1639
1527	delete $self->{texture};	1640	delete $self->{texture}
		1641	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1642
		1643	1
1528	}	1644	}
1529		1645
1530	sub set_fontsize {	1646	sub set_fontsize {
1531	my ($self, $fontsize) = @_;	1647	my ($self, $fontsize) = @_;
1532		1648
1533	$self->{fontsize} = $fontsize;	1649	$self->{fontsize} = $fontsize;
1534	delete $self->{texture};	1650	delete $self->{texture};
1535		1651
1536	$self->realloc;	1652	$self->realloc;
		1653	}
		1654
		1655	sub reconfigure {
		1656	my ($self) = @_;
		1657
		1658	delete $self->{size_req};
		1659
		1660	$self->SUPER::reconfigure;
1537	}	1661	}
1538		1662
1539	sub _draw {	1663	sub _draw {
1540	my ($self) = @_;	1664	my ($self) = @_;
1541		1665
…		…
1547	$self->{layout}->set_width ($self->{w});	1671	$self->{layout}->set_width ($self->{w});
1548	$self->{layout}->set_ellipsise ($self->{ellipsise});	1672	$self->{layout}->set_ellipsise ($self->{ellipsise});
1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1673	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1674	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1551		1675
1552	my $tex = new_from_layout CFClient::Texture $self->{layout};	1676	new_from_layout CFClient::Texture $self->{layout}
		1677	};
1553		1678
		1679	unless (exists $self->{ox}) {
1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1680	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1681	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1556	: ($self->{w} - $tex->{w}) * 0.5);	1682	: ($self->{w} - $tex->{w}) * 0.5);
1557		1683
1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1684	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1685	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1560	: ($self->{h} - $tex->{h}) * 0.5);	1686	: ($self->{h} - $tex->{h}) * 0.5);
1561
1562	$tex
1563	};	1687	};
1564		1688
1565	glEnable GL_TEXTURE_2D;	1689	glEnable GL_TEXTURE_2D;
1566	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1690
		1691	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1692	my $h = List::Util::min $self->{h} + 2, $tex->{h};
1567		1693
1568	if ($tex->{format} == GL_ALPHA) {	1694	if ($tex->{format} == GL_ALPHA) {
		1695	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1569	glColor @{$self->{fg}};	1696	glColor @{$self->{fg}};
1570	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1697	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1571	} else {	1698	} else {
		1699	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1572	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1700	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1573	}	1701	}
1574		1702
1575	glDisable GL_TEXTURE_2D;	1703	glDisable GL_TEXTURE_2D;
1576	}	1704	}
1577		1705
…		…
1594	can_hover => 1,	1722	can_hover => 1,
1595	can_focus => 1,	1723	can_focus => 1,
1596	valign => 0,	1724	valign => 0,
1597	can_events => 1,	1725	can_events => 1,
1598	#text => ...	1726	#text => ...
		1727	#hidden => "*",
1599	@_	1728	@_
1600	)	1729	)
1601	}	1730	}
1602		1731
1603	sub _set_text {	1732	sub _set_text {
…		…
1605		1734
1606	delete $self->{cur_h};	1735	delete $self->{cur_h};
1607		1736
1608	return if $self->{text} eq $text;	1737	return if $self->{text} eq $text;
1609		1738
1610	delete $self->{texture};
1611
1612	$self->{last_activity} = $::NOW;	1739	$self->{last_activity} = $::NOW;
1613	$self->{text} = $text;	1740	$self->{text} = $text;
1614		1741
1615	$text =~ s/./*/g if $self->{hidden};	1742	$text =~ s/./*/g if $self->{hidden};
1616	$self->{layout}->set_text ("$text ");	1743	$self->{layout}->set_text ("$text ");
		1744	delete $self->{size_req};
1617		1745
1618	$self->_emit (changed => $self->{text});	1746	$self->emit (changed => $self->{text});
		1747
		1748	$self->realloc;
		1749	$self->update;
1619	}	1750	}
1620		1751
1621	sub set_text {	1752	sub set_text {
1622	my ($self, $text) = @_;	1753	my ($self, $text) = @_;
1623		1754
1624	$self->{cursor} = length $text;	1755	$self->{cursor} = length $text;
1625	$self->_set_text ($text);	1756	$self->_set_text ($text);
1626
1627	$self->realloc;
1628	}	1757	}
1629		1758
1630	sub get_text {	1759	sub get_text {
1631	$_[0]{text}	1760	$_[0]{text}
1632	}	1761	}
…		…
1637	my ($w, $h) = $self->SUPER::size_request;	1766	my ($w, $h) = $self->SUPER::size_request;
1638		1767
1639	($w + 1, $h) # add 1 for cursor	1768	($w + 1, $h) # add 1 for cursor
1640	}	1769	}
1641		1770
1642	sub key_down {	1771	sub invoke_key_down {
1643	my ($self, $ev) = @_;	1772	my ($self, $ev) = @_;
1644		1773
1645	my $mod = $ev->{mod};	1774	my $mod = $ev->{mod};
1646	my $sym = $ev->{sym};	1775	my $sym = $ev->{sym};
1647	my $uni = $ev->{unicode};	1776	my $uni = $ev->{unicode};
…		…
1659	} elsif ($sym == CFClient::SDLK_HOME) {	1788	} elsif ($sym == CFClient::SDLK_HOME) {
1660	$self->{cursor} = 0;	1789	$self->{cursor} = 0;
1661	} elsif ($sym == CFClient::SDLK_END) {	1790	} elsif ($sym == CFClient::SDLK_END) {
1662	$self->{cursor} = length $text;	1791	$self->{cursor} = length $text;
1663	} elsif ($uni == 27) {	1792	} elsif ($uni == 27) {
1664	$self->_emit ('escape');	1793	$self->emit ('escape');
1665	} elsif ($uni) {	1794	} elsif ($uni) {
1666	substr $text, $self->{cursor}++, 0, chr $uni;	1795	substr $text, $self->{cursor}++, 0, chr $uni;
		1796	} else {
		1797	return 0;
1667	}	1798	}
1668		1799
1669	$self->_set_text ($text);	1800	$self->_set_text ($text);
1670		1801
1671	$self->realloc;	1802	$self->realloc;
1672	}
1673		1803
		1804	1
		1805	}
		1806
1674	sub focus_in {	1807	sub invoke_focus_in {
1675	my ($self) = @_;	1808	my ($self) = @_;
1676		1809
1677	$self->{last_activity} = $::NOW;	1810	$self->{last_activity} = $::NOW;
1678		1811
1679	$self->SUPER::focus_in;	1812	$self->SUPER::invoke_focus_in
1680	}	1813	}
1681		1814
1682	sub button_down {	1815	sub invoke_button_down {
1683	my ($self, $ev, $x, $y) = @_;	1816	my ($self, $ev, $x, $y) = @_;
1684		1817
1685	$self->SUPER::button_down ($ev, $x, $y);	1818	$self->SUPER::invoke_button_down ($ev, $x, $y);
1686		1819
1687	my $idx = $self->{layout}->xy_to_index ($x, $y);	1820	my $idx = $self->{layout}->xy_to_index ($x, $y);
1688		1821
1689	# byte-index to char-index	1822	# byte-index to char-index
1690	my $text = $self->{text};	1823	my $text = $self->{text};
1691	utf8::encode $text;	1824	utf8::encode $text;
1692	$self->{cursor} = length substr $text, 0, $idx;	1825	$self->{cursor} = length substr $text, 0, $idx;
1693		1826
1694	$self->_set_text ($self->{text});	1827	$self->_set_text ($self->{text});
1695	$self->update;	1828	$self->update;
		1829
		1830	1
1696	}	1831	}
1697		1832
1698	sub mouse_motion {	1833	sub invoke_mouse_motion {
1699	my ($self, $ev, $x, $y) = @_;	1834	my ($self, $ev, $x, $y) = @_;
1700	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1835	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1836
		1837	1
1701	}	1838	}
1702		1839
1703	sub _draw {	1840	sub _draw {
1704	my ($self) = @_;	1841	my ($self) = @_;
1705		1842
1706	local $self->{fg} = $self->{fg};	1843	local $self->{fg} = $self->{fg};
1707		1844
1708	if ($FOCUS == $self) {	1845	if ($FOCUS == $self) {
1709	glColor @{$self->{active_bg}};	1846	glColor_premultiply @{$self->{active_bg}};
1710	$self->{fg} = $self->{active_fg};	1847	$self->{fg} = $self->{active_fg};
1711	} else {	1848	} else {
1712	glColor @{$self->{bg}};	1849	glColor_premultiply @{$self->{bg}};
1713	}	1850	}
1714		1851
1715	glEnable GL_BLEND;	1852	glEnable GL_BLEND;
1716	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1853	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1717	glBegin GL_QUADS;	1854	glBegin GL_QUADS;
1718	glVertex 0 , 0;	1855	glVertex 0 , 0;
1719	glVertex 0 , $self->{h};	1856	glVertex 0 , $self->{h};
1720	glVertex $self->{w}, $self->{h};	1857	glVertex $self->{w}, $self->{h};
1721	glVertex $self->{w}, 0;	1858	glVertex $self->{w}, 0;
…		…
1746		1883
1747	our @ISA = CFClient::UI::EntryBase::;	1884	our @ISA = CFClient::UI::EntryBase::;
1748		1885
1749	use CFClient::OpenGL;	1886	use CFClient::OpenGL;
1750		1887
1751	sub key_down {	1888	sub invoke_key_down {
1752	my ($self, $ev) = @_;	1889	my ($self, $ev) = @_;
1753		1890
1754	my $sym = $ev->{sym};	1891	my $sym = $ev->{sym};
1755		1892
1756	if ($sym == 13) {	1893	if ($sym == 13) {
1757	unshift @{$self->{history}},	1894	unshift @{$self->{history}},
1758	my $txt = $self->get_text;	1895	my $txt = $self->get_text;
1759	$self->{history_pointer} = -1;	1896	$self->{history_pointer} = -1;
1760	$self->{history_saveback} = '';	1897	$self->{history_saveback} = '';
1761	$self->_emit (activate => $txt);	1898	$self->emit (activate => $txt);
1762	$self->update;	1899	$self->update;
1763		1900
1764	} elsif ($sym == CFClient::SDLK_UP) {	1901	} elsif ($sym == CFClient::SDLK_UP) {
1765	if ($self->{history_pointer} < 0) {	1902	if ($self->{history_pointer} < 0) {
1766	$self->{history_saveback} = $self->get_text;	1903	$self->{history_saveback} = $self->get_text;
…		…
1782	} else {	1919	} else {
1783	$self->set_text ($self->{history_saveback});	1920	$self->set_text ($self->{history_saveback});
1784	}	1921	}
1785		1922
1786	} else {	1923	} else {
1787	$self->SUPER::key_down ($ev);	1924	return $self->SUPER::invoke_key_down ($ev)
		1925	}
		1926
1788	}	1927	1
1789
1790	}	1928	}
1791		1929
1792	#############################################################################	1930	#############################################################################
1793		1931
1794	package CFClient::UI::Button;	1932	package CFClient::UI::Button;
…		…
1815	can_events => 1,	1953	can_events => 1,
1816	@_	1954	@_
1817	)	1955	)
1818	}	1956	}
1819		1957
1820	sub activate { }
1821
1822	sub button_up {	1958	sub invoke_button_up {
1823	my ($self, $ev, $x, $y) = @_;	1959	my ($self, $ev, $x, $y) = @_;
1824		1960
1825	$self->emit ("activate")	1961	$self->emit ("activate")
1826	if $x >= 0 && $x < $self->{w}	1962	if $x >= 0 && $x < $self->{w}
1827	&& $y >= 0 && $y < $self->{h};	1963	&& $y >= 0 && $y < $self->{h};
		1964
		1965	1
1828	}	1966	}
1829		1967
1830	sub _draw {	1968	sub _draw {
1831	my ($self) = @_;	1969	my ($self) = @_;
1832		1970
1833	local $self->{fg} = $self->{fg};	1971	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1834
1835	if ($GRAB == $self) {
1836	$self->{fg} = $self->{active_fg};
1837	}
1838		1972
1839	glEnable GL_TEXTURE_2D;	1973	glEnable GL_TEXTURE_2D;
1840	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1974	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1841	glColor 0, 0, 0, 1;	1975	glColor 0, 0, 0, 1;
1842		1976
1843	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	1977	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1844		1978
1845	glDisable GL_TEXTURE_2D;	1979	glDisable GL_TEXTURE_2D;
1846		1980
1847	$self->SUPER::_draw;	1981	$self->SUPER::_draw;
		1982	}
		1983
		1984	#############################################################################
		1985
		1986	package CFClient::UI::ImageButton;
		1987
		1988	our @ISA = CFClient::UI::Image::;
		1989
		1990	use CFClient::OpenGL;
		1991
		1992	my %textures;
		1993
		1994	sub new {
		1995	my $class = shift;
		1996
		1997	my $self = $class->SUPER::new (
		1998	padding_x => 4,
		1999	padding_y => 4,
		2000	fg => [1, 1, 1],
		2001	active_fg => [0, 0, 1],
		2002	can_hover => 1,
		2003	align => 0,
		2004	valign => 0,
		2005	can_events => 1,
		2006	@_
		2007	);
		2008	}
		2009
		2010	sub invoke_button_up {
		2011	my ($self, $ev, $x, $y) = @_;
		2012
		2013	$self->emit ("activate")
		2014	if $x >= 0 && $x < $self->{w}
		2015	&& $y >= 0 && $y < $self->{h};
		2016
		2017	1
1848	}	2018	}
1849		2019
1850	#############################################################################	2020	#############################################################################
1851		2021
1852	package CFClient::UI::CheckBox;	2022	package CFClient::UI::CheckBox;
…		…
1879	my ($self) = @_;	2049	my ($self) = @_;
1880		2050
1881	(6) x 2	2051	(6) x 2
1882	}	2052	}
1883		2053
1884	sub button_down {	2054	sub invoke_button_down {
1885	my ($self, $ev, $x, $y) = @_;	2055	my ($self, $ev, $x, $y) = @_;
1886		2056
1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2057	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2058	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1889	$self->{state} = !$self->{state};	2059	$self->{state} = !$self->{state};
1890	$self->_emit (changed => $self->{state});	2060	$self->emit (changed => $self->{state});
		2061	} else {
		2062	return 0
		2063	}
		2064
1891	}	2065	1
1892	}	2066	}
1893		2067
1894	sub _draw {	2068	sub _draw {
1895	my ($self) = @_;	2069	my ($self) = @_;
1896		2070
…		…
2063		2237
2064	my $h1 = $self->{h} * (1 - $ycut1);	2238	my $h1 = $self->{h} * (1 - $ycut1);
2065	my $h2 = $self->{h} * (1 - $ycut2);	2239	my $h2 = $self->{h} * (1 - $ycut2);
2066		2240
2067	glEnable GL_BLEND;	2241	glEnable GL_BLEND;
2068	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2242	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2243	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2069	glEnable GL_TEXTURE_2D;	2244	glEnable GL_TEXTURE_2D;
2070	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2245	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2071		2246
2072	glBindTexture GL_TEXTURE_2D, $t1->{name};	2247	glBindTexture GL_TEXTURE_2D, $t1->{name};
2073	glBegin GL_QUADS;	2248	glBegin GL_QUADS;
…		…
2187	$self->update;	2362	$self->update;
2188		2363
2189	$self	2364	$self
2190	}	2365	}
2191		2366
2192	sub changed { }
2193
2194	sub set_range {	2367	sub set_range {
2195	my ($self, $range) = @_;	2368	my ($self, $range) = @_;
2196		2369
2197	($range, $self->{range}) = ($self->{range}, $range);	2370	($range, $self->{range}) = ($self->{range}, $range);
2198		2371
2199	$self->update
2200	if "@$range" ne "@{$self->{range}}";	2372	if ("@$range" ne "@{$self->{range}}") {
		2373	$self->update;
		2374	$self->set_value ($self->{range}[0]);
		2375	}
2201	}	2376	}
2202		2377
2203	sub set_value {	2378	sub set_value {
2204	my ($self, $value) = @_;	2379	my ($self, $value) = @_;
2205		2380
…		…
2216	if $unit;	2391	if $unit;
2217		2392
2218	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2393	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2219		2394
2220	if ($value != $old_value) {	2395	if ($value != $old_value) {
2221	$self->_emit (changed => $value);	2396	$self->emit (changed => $value);
2222	$self->update;	2397	$self->update;
2223	}	2398	}
2224	}	2399	}
2225		2400
2226	sub size_request {	2401	sub size_request {
2227	my ($self) = @_;	2402	my ($self) = @_;
2228		2403
2229	($self->{req_w}, $self->{req_h})	2404	($self->{req_w}, $self->{req_h})
2230	}	2405	}
2231		2406
2232	sub button_down {	2407	sub invoke_button_down {
2233	my ($self, $ev, $x, $y) = @_;	2408	my ($self, $ev, $x, $y) = @_;
2234		2409
2235	$self->SUPER::button_down ($ev, $x, $y);	2410	$self->SUPER::invoke_button_down ($ev, $x, $y);
2236		2411
2237	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2412	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2238		2413
2239	$self->mouse_motion ($ev, $x, $y);	2414	$self->mouse_motion ($ev, $x, $y)
2240	}	2415	}
2241		2416
2242	sub mouse_motion {	2417	sub invoke_mouse_motion {
2243	my ($self, $ev, $x, $y) = @_;	2418	my ($self, $ev, $x, $y) = @_;
2244		2419
2245	if ($GRAB == $self) {	2420	if ($GRAB == $self) {
2246	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2421	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2247		2422
2248	my (undef, $lo, $hi, $page) = @{$self->{range}};	2423	my (undef, $lo, $hi, $page) = @{$self->{range}};
2249		2424
2250	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2425	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2251		2426
2252	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2427	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2428	} else {
		2429	return 0;
		2430	}
		2431
2253	}	2432	1
2254	}	2433	}
2255		2434
2256	sub update {	2435	sub update {
2257	my ($self) = @_;	2436	my ($self) = @_;
2258		2437
2259	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2438	delete $self->{knob_w};
		2439	$self->SUPER::update;
		2440	}
		2441
		2442	sub _draw {
		2443	my ($self) = @_;
		2444
		2445	unless ($self->{knob_w}) {
2260	$self->set_value ($self->{range}[0]);	2446	$self->set_value ($self->{range}[0]);
2261		2447
2262	my ($value, $lo, $hi, $page) = @{$self->{range}};	2448	my ($value, $lo, $hi, $page) = @{$self->{range}};
2263	my $range = ($hi - $page - $lo) || 1e-100;	2449	my $range = ($hi - $page - $lo) || 1e-100;
2264		2450
…		…
2270	$value = ($value - $lo) / $range;	2456	$value = ($value - $lo) / $range;
2271	$value = $value * $self->{scale} + $self->{offset};	2457	$value = $value * $self->{scale} + $self->{offset};
2272		2458
2273	$self->{knob_x} = $value - $knob_w * 0.5;	2459	$self->{knob_x} = $value - $knob_w * 0.5;
2274	$self->{knob_w} = $knob_w;	2460	$self->{knob_w} = $knob_w;
2275	});	2461	}
2276
2277	$self->SUPER::update;
2278	}
2279
2280	sub _draw {
2281	my ($self) = @_;
2282		2462
2283	$self->SUPER::_draw ();	2463	$self->SUPER::_draw ();
2284		2464
2285	glScale $self->{w}, $self->{h};	2465	glScale $self->{w}, $self->{h};
2286		2466
…		…
2347	sub set_range { shift->{slider}->set_range (@_) }	2527	sub set_range { shift->{slider}->set_range (@_) }
2348	sub set_value { shift->{slider}->set_value (@_) }	2528	sub set_value { shift->{slider}->set_value (@_) }
2349		2529
2350	#############################################################################	2530	#############################################################################
2351		2531
2352	package CFClient::UI::TextView;	2532	package CFClient::UI::TextScroller;
2353		2533
2354	our @ISA = CFClient::UI::HBox::;	2534	our @ISA = CFClient::UI::HBox::;
2355		2535
2356	use CFClient::OpenGL;	2536	use CFClient::OpenGL;
2357		2537
…		…
2359	my $class = shift;	2539	my $class = shift;
2360		2540
2361	my $self = $class->SUPER::new (	2541	my $self = $class->SUPER::new (
2362	fontsize => 1,	2542	fontsize => 1,
2363	can_events => 0,	2543	can_events => 0,
		2544	indent => 0,
2364	#font => default_font	2545	#font => default_font
2365	@_,	2546	@_,
2366		2547
2367	layout => (new CFClient::Layout 1),	2548	layout => (new CFClient::Layout 1),
2368	par => [],	2549	par => [],
…		…
2383		2564
2384	$self->{fontsize} = $fontsize;	2565	$self->{fontsize} = $fontsize;
2385	$self->reflow;	2566	$self->reflow;
2386	}	2567	}
2387		2568
2388	sub size_allocate {	2569	sub invoke_size_allocate {
2389	my ($self, $w, $h) = @_;	2570	my ($self, $w, $h) = @_;
2390
2391	$self->SUPER::size_allocate ($w, $h);
2392		2571
2393	$self->{layout}->set_font ($self->{font}) if $self->{font};	2572	$self->{layout}->set_font ($self->{font}) if $self->{font};
2394	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2573	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2395	$self->{layout}->set_width ($self->{children}[0]{w});	2574	$self->{layout}->set_width ($self->{children}[0]{w});
		2575	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2396		2576
2397	$self->reflow;	2577	$self->reflow;
		2578
		2579	$self->SUPER::invoke_size_allocate ($w, $h)
2398	}	2580	}
2399		2581
2400	sub text_size {	2582	sub text_size {
2401	my ($self, $text, $indent) = @_;	2583	my ($self, $text, $indent) = @_;
2402		2584
2403	my $layout = $self->{layout};	2585	my $layout = $self->{layout};
2404		2586
2405	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2587	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2406	$layout->set_width ($self->{children}[0]{w} - $indent);	2588	$layout->set_width ($self->{children}[0]{w} - $indent);
		2589	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2407	$layout->set_markup ($text);	2590	$layout->set_markup ($text);
2408		2591
2409	$layout->size	2592	$layout->size
2410	}	2593	}
2411		2594
…		…
2450		2633
2451	return unless $self->{h} > 0;	2634	return unless $self->{h} > 0;
2452		2635
2453	delete $self->{texture};	2636	delete $self->{texture};
2454		2637
2455	$ROOT->on_post_alloc ($self, sub {	2638	$ROOT->on_post_alloc ($self => sub {
2456	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2639	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2457		2640
2458	if (delete $self->{need_reflow}) {	2641	if (delete $self->{need_reflow}) {
2459	my $height = 0;	2642	my $height = 0;
2460		2643
…		…
2463	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2646	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2464		2647
2465	for (@{$self->{par}}) {	2648	for (@{$self->{par}}) {
2466	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2649	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2467	$layout->set_width ($W - $_->[3]);	2650	$layout->set_width ($W - $_->[3]);
		2651	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2468	$layout->set_markup ($_->[4]);	2652	$layout->set_markup ($_->[4]);
2469	my ($w, $h) = $layout->size;	2653	my ($w, $h) = $layout->size;
2470	$_->[0] = $w + $_->[3];	2654	$_->[0] = $w + $_->[3];
2471	$_->[1] = $h;	2655	$_->[1] = $h;
2472	}	2656	}
…		…
2475	}	2659	}
2476		2660
2477	$self->{height} = $height;	2661	$self->{height} = $height;
2478		2662
2479	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2663	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2480		2664
2481	delete $self->{texture};	2665	delete $self->{texture};
2482	}	2666	}
2483		2667
2484	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2668	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2485	glClearColor 0.5, 0.5, 0.5, 0;	2669	glClearColor 0, 0, 0, 0;
2486	glClear GL_COLOR_BUFFER_BIT;	2670	glClear GL_COLOR_BUFFER_BIT;
2487		2671
2488	my $top = int $self->{children}[1]{range}[0];	2672	my $top = int $self->{children}[1]{range}[0];
2489		2673
2490	my $y0 = $top;	2674	my $y0 = $top;
…		…
2504	my $h = $par->[1];	2688	my $h = $par->[1];
2505		2689
2506	if ($y0 < $y + $h && $y < $y1) {	2690	if ($y0 < $y + $h && $y < $y1) {
2507	$layout->set_foreground (@{ $par->[2] });	2691	$layout->set_foreground (@{ $par->[2] });
2508	$layout->set_width ($W - $par->[3]);	2692	$layout->set_width ($W - $par->[3]);
		2693	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2509	$layout->set_markup ($par->[4]);	2694	$layout->set_markup ($par->[4]);
2510		2695
2511	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2696	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2512		2697
2513	glRasterPos $par->[3], $y - $y0;	2698	glRasterPos $par->[3], $y - $y0;
…		…
2525	sub _draw {	2710	sub _draw {
2526	my ($self) = @_;	2711	my ($self) = @_;
2527		2712
2528	glEnable GL_TEXTURE_2D;	2713	glEnable GL_TEXTURE_2D;
2529	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2714	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2530	glColor 1, 1, 1, 1;	2715	glColor 0, 0, 0, 1;
2531	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2716	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2532	glDisable GL_TEXTURE_2D;	2717	glDisable GL_TEXTURE_2D;
2533		2718
2534	$self->{children}[1]->draw;	2719	$self->{children}[1]->draw;
2535		2720
2536	}	2721	}
…		…
2627	$tooltip .= "\n\n" . (ref $widget) . "\n"	2812	$tooltip .= "\n\n" . (ref $widget) . "\n"
2628	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	2813	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2629	. "req $widget->{req_w} $widget->{req_h}\n"	2814	. "req $widget->{req_w} $widget->{req_h}\n"
2630	. "visible $widget->{visible}";	2815	. "visible $widget->{visible}";
2631	}	2816	}
		2817
		2818	$tooltip =~ s/^\n+//;
		2819	$tooltip =~ s/\n+$//;
2632		2820
2633	$self->add (new CFClient::UI::Label	2821	$self->add (new CFClient::UI::Label
2634	markup => $tooltip,	2822	markup => $tooltip,
2635	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2823	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2636	fontsize => 0.8,	2824	fontsize => 0.8,
…		…
2646	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2834	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2647		2835
2648	($w + 4, $h + 4)	2836	($w + 4, $h + 4)
2649	}	2837	}
2650		2838
2651	sub size_allocate {	2839	sub invoke_size_allocate {
2652	my ($self, $w, $h) = @_;	2840	my ($self, $w, $h) = @_;
2653		2841
2654	$self->SUPER::size_allocate ($w - 4, $h - 4);	2842	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2655	}	2843	}
2656		2844
2657	sub visibility_change {	2845	sub invoke_visibility_change {
2658	my ($self, $visible) = @_;	2846	my ($self, $visible) = @_;
2659		2847
2660	return unless $visible;	2848	return unless $visible;
2661		2849
2662	$self->{root}->on_post_alloc ("move_$self" => sub {	2850	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
2664	or return;	2852	or return;
2665		2853
2666	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2854	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2667		2855
2668	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2856	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2669	if $x + $self->{w} > $::WIDTH;	2857	if $x + $self->{w} > $self->{root}{w};
2670		2858
2671	$self->move_abs ($x, $y);	2859	$self->move_abs ($x, $y);
2672	});	2860	});
2673	}	2861	}
2674		2862
…		…
2763	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2951	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2764		2952
2765	if ($tex) {	2953	if ($tex) {
2766	glEnable GL_TEXTURE_2D;	2954	glEnable GL_TEXTURE_2D;
2767	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2955	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2768	glColor 1, 1, 1, 1;	2956	glColor 0, 0, 0, 1;
2769	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2957	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2770	glDisable GL_TEXTURE_2D;	2958	glDisable GL_TEXTURE_2D;
2771	}	2959	}
2772	}	2960	}
2773		2961
2774	sub DESTROY {	2962	sub destroy {
2775	my ($self) = @_;	2963	my ($self) = @_;
2776		2964
2777	$self->{timer}->cancel	2965	$self->{timer}->cancel
2778	if $self->{timer};	2966	if $self->{timer};
2779		2967
2780	$self->SUPER::DESTROY;	2968	$self->SUPER::destroy;
2781	}	2969	}
2782		2970
2783	#############################################################################	2971	#############################################################################
2784		2972
2785	package CFClient::UI::Inventory;	2973	package CFClient::UI::Buttonbar;
2786		2974
2787	our @ISA = CFClient::UI::ScrolledWindow::;	2975	our @ISA = CFClient::UI::HBox::;
2788		2976
2789	sub new {	2977	# TODO: should actualyl wrap buttons and other goodies.
2790	my $class = shift;
2791
2792	my $self = $class->SUPER::new (
2793	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2794	@_,
2795	);
2796
2797	$self
2798	}
2799
2800	sub set_items {
2801	my ($self, $items) = @_;
2802
2803	$self->{scrolled}->clear;
2804	return unless $items;
2805
2806	my @items = sort {
2807	($a->{type} <=> $b->{type})
2808	or ($a->{name} cmp $b->{name})
2809	} @$items;
2810
2811	$self->{real_items} = \@items;
2812
2813	my $row = 0;
2814	for my $item (@items) {
2815	CFClient::Item::update_widgets $item;
2816
2817	$self->{scrolled}->add (0, $row, $item->{face_widget});
2818	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2819	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2820
2821	$row++;
2822	}
2823	}
2824		2978
2825	#############################################################################	2979	#############################################################################
2826		2980
2827	package CFClient::UI::Menu;	2981	package CFClient::UI::Menu;
2828		2982
…		…
2840	);	2994	);
2841		2995
2842	$self->add ($self->{vbox} = new CFClient::UI::VBox);	2996	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2843		2997
2844	for my $item (@{ $self->{items} }) {	2998	for my $item (@{ $self->{items} }) {
2845	my ($widget, $cb) = @$item;	2999	my ($widget, $cb, $tooltip) = @$item;
2846		3000
2847	# handle various types of items, only text for now	3001	# handle various types of items, only text for now
2848	if (!ref $widget) {	3002	if (!ref $widget) {
2849	$widget = new CFClient::UI::Label	3003	$widget = new CFClient::UI::Label
2850	can_hover => 1,	3004	can_hover => 1,
2851	can_events => 1,	3005	can_events => 1,
2852	text => $widget;	3006	markup => $widget,
		3007	tooltip => $tooltip
2853	}	3008	}
2854		3009
2855	$self->{item}{$widget} = $item;	3010	$self->{item}{$widget} = $item;
2856		3011
2857	$self->{vbox}->add ($widget);	3012	$self->{vbox}->add ($widget);
…		…
2862		3017
2863	# popup given the event (must be a mouse button down event currently)	3018	# popup given the event (must be a mouse button down event currently)
2864	sub popup {	3019	sub popup {
2865	my ($self, $ev) = @_;	3020	my ($self, $ev) = @_;
2866		3021
2867	$self->_emit ("popdown");	3022	$self->emit ("popdown");
2868		3023
2869	# maybe save $GRAB? must be careful about events...	3024	# maybe save $GRAB? must be careful about events...
2870	$GRAB = $self;	3025	$GRAB = $self;
2871	$self->{button} = $ev->{button};	3026	$self->{button} = $ev->{button};
2872		3027
2873	$self->show;	3028	$self->show;
2874	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3029	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2875	}	3030	}
2876		3031
2877	sub mouse_motion {	3032	sub invoke_mouse_motion {
2878	my ($self, $ev, $x, $y) = @_;	3033	my ($self, $ev, $x, $y) = @_;
2879		3034
2880	# TODO: should use vbox->find_widget or so	3035	# TODO: should use vbox->find_widget or so
2881	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3036	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2882	$self->{hover} = $self->{item}{$HOVER};	3037	$self->{hover} = $self->{item}{$HOVER};
2883	}
2884		3038
		3039	0
		3040	}
		3041
2885	sub button_up {	3042	sub invoke_button_up {
2886	my ($self, $ev, $x, $y) = @_;	3043	my ($self, $ev, $x, $y) = @_;
2887		3044
2888	if ($ev->{button} == $self->{button}) {	3045	if ($ev->{button} == $self->{button}) {
2889	undef $GRAB;	3046	undef $GRAB;
2890	$self->hide;	3047	$self->hide;
2891		3048
2892	$self->_emit ("popdown");	3049	$self->emit ("popdown");
2893	$self->{hover}[1]->() if $self->{hover};	3050	$self->{hover}[1]->() if $self->{hover};
		3051	} else {
		3052	return 0
		3053	}
		3054
2894	}	3055	1
2895	}	3056	}
2896		3057
2897	#############################################################################	3058	#############################################################################
2898		3059
2899	package CFClient::UI::Statusbox;	3060	package CFClient::UI::Multiplexer;
2900		3061
2901	our @ISA = CFClient::UI::VBox::;	3062	our @ISA = CFClient::UI::Container::;
2902		3063
2903	sub new {	3064	sub new {
2904	my $class = shift;	3065	my $class = shift;
2905		3066
2906	$class->SUPER::new (	3067	my $self = $class->SUPER::new (
		3068	@_,
		3069	);
		3070
		3071	$self->{current} = $self->{children}[0]
		3072	if @{ $self->{children} };
		3073
		3074	$self
		3075	}
		3076
		3077	sub add {
		3078	my ($self, @widgets) = @_;
		3079
		3080	$self->SUPER::add (@widgets);
		3081
		3082	$self->{current} = $self->{children}[0]
		3083	if @{ $self->{children} };
		3084	}
		3085
		3086	sub set_current_page {
		3087	my ($self, $page_or_widget) = @_;
		3088
		3089	my $widget = ref $page_or_widget
		3090	? $page_or_widget
		3091	: $self->{children}[$page_or_widget];
		3092
		3093	$self->{current} = $widget;
		3094	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3095
		3096	$self->emit (page_changed => $self->{current});
		3097
		3098	$self->realloc;
		3099	}
		3100
		3101	sub visible_children {
		3102	$_[0]{current}
		3103	}
		3104
		3105	sub size_request {
		3106	my ($self) = @_;
		3107
		3108	$self->{current}->size_request
		3109	}
		3110
		3111	sub invoke_size_allocate {
		3112	my ($self, $w, $h) = @_;
		3113
		3114	$self->{current}->configure (0, 0, $w, $h);
		3115
		3116	1
		3117	}
		3118
		3119	sub _draw {
		3120	my ($self) = @_;
		3121
		3122	$self->{current}->draw;
		3123	}
		3124
		3125	#############################################################################
		3126
		3127	package CFClient::UI::Notebook;
		3128
		3129	our @ISA = CFClient::UI::VBox::;
		3130
		3131	sub new {
		3132	my $class = shift;
		3133
		3134	my $self = $class->SUPER::new (
		3135	buttonbar => (new CFClient::UI::Buttonbar),
		3136	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3137	# filter => # will be put between multiplexer and $self
		3138	@_,
		3139	);
		3140
		3141	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3142	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3143
		3144	$self
		3145	}
		3146
		3147	sub add {
		3148	my ($self, $title, $widget, $tooltip) = @_;
		3149
		3150	Scalar::Util::weaken $self;
		3151
		3152	$self->{buttonbar}->add (new CFClient::UI::Button
		3153	markup => $title,
		3154	tooltip => $tooltip,
		3155	on_activate => sub { $self->set_current_page ($widget) },
		3156	);
		3157
		3158	$self->{multiplexer}->add ($widget);
		3159	}
		3160
		3161	sub set_current_page {
		3162	my ($self, $page) = @_;
		3163
		3164	$self->{multiplexer}->set_current_page ($page);
		3165	$self->emit (page_changed => $self->{multiplexer}{current});
		3166	}
		3167
		3168	#############################################################################
		3169
		3170	package CFClient::UI::Combobox;
		3171
		3172	use utf8;
		3173
		3174	our @ISA = CFClient::UI::Button::;
		3175
		3176	sub new {
		3177	my $class = shift;
		3178
		3179	my $self = $class->SUPER::new (
		3180	options => [], # [value, title, longdesc], ...
		3181	value => undef,
		3182	@_,
		3183	);
		3184
		3185	$self->_set_value ($self->{value});
		3186
		3187	$self
		3188	}
		3189
		3190	sub invoke_button_down {
		3191	my ($self, $ev) = @_;
		3192
		3193	my @menu_items;
		3194
		3195	for (@{ $self->{options} }) {
		3196	my ($value, $title, $tooltip) = @$_;
		3197
		3198	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3199	}
		3200
		3201	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3202	}
		3203
		3204	sub _set_value {
		3205	my ($self, $value) = @_;
		3206
		3207	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3208	or return;
		3209
		3210	$self->{value} = $item->[0];
		3211	$self->set_markup ("$item->[1] ⇓");
		3212	$self->set_tooltip ($item->[2]);
		3213	}
		3214
		3215	sub set_value {
		3216	my ($self, $value) = @_;
		3217
		3218	return unless $self->{value} ne $value;
		3219
		3220	$self->_set_value ($value);
		3221	$self->emit (changed => $value);
		3222	}
		3223
		3224	#############################################################################
		3225
		3226	package CFClient::UI::Statusbox;
		3227
		3228	our @ISA = CFClient::UI::VBox::;
		3229
		3230	sub new {
		3231	my $class = shift;
		3232
		3233	my $self = $class->SUPER::new (
2907	fontsize => 0.8,	3234	fontsize => 0.8,
2908	@_,	3235	@_,
2909	)	3236	);
		3237
		3238	Scalar::Util::weaken (my $this = $self);
		3239
		3240	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3241
		3242	$self
2910	}	3243	}
2911		3244
2912	sub reorder {	3245	sub reorder {
2913	my ($self) = @_;	3246	my ($self) = @_;
2914	my $NOW = time;	3247	my $NOW = Time::HiRes::time;
		3248
		3249	# freeze display when hovering over any label
		3250	return if $CFClient::UI::TOOLTIP->{owner}
		3251	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3252	values %{ $self->{item} };
2915		3253
2916	while (my ($k, $v) = each %{ $self->{item} }) {	3254	while (my ($k, $v) = each %{ $self->{item} }) {
2917	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3255	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2918	}	3256	}
2919		3257
…		…
2922	my @items = sort {	3260	my @items = sort {
2923	$a->{pri} <=> $b->{pri}	3261	$a->{pri} <=> $b->{pri}
2924	or $b->{id} <=> $a->{id}	3262	or $b->{id} <=> $a->{id}
2925	} values %{ $self->{item} };	3263	} values %{ $self->{item} };
2926		3264
		3265	$self->{timer}->interval (1);
		3266
2927	my $count = 10 + 1;	3267	my $count = 10 + 1;
2928	for my $item (@items) {	3268	for my $item (@items) {
2929	last unless --$count;	3269	last unless --$count;
2930		3270
2931	push @widgets, $item->{label} ||= do {	3271	my $label = $item->{label} ||= do {
2932	# TODO: doesn't handle markup well (read as: at all)	3272	# TODO: doesn't handle markup well (read as: at all)
2933	my $short = $item->{count} > 1	3273	my $short = $item->{count} > 1
2934	? "<b>$item->{count} ×</b> $item->{text}"	3274	? "<b>$item->{count} ×</b> $item->{text}"
2935	: $item->{text};	3275	: $item->{text};
2936		3276
…		…
2944	tooltip => $item->{tooltip},	3284	tooltip => $item->{tooltip},
2945	tooltip_font => $::FONT_PROP,	3285	tooltip_font => $::FONT_PROP,
2946	tooltip_width => 0.67,	3286	tooltip_width => 0.67,
2947	fontsize => $item->{fontsize} || $self->{fontsize},	3287	fontsize => $item->{fontsize} || $self->{fontsize},
2948	max_w => $::WIDTH * 0.44,	3288	max_w => $::WIDTH * 0.44,
2949	fg => $item->{fg},	3289	fg => [@{ $item->{fg} }],
2950	can_events => 1,	3290	can_events => 1,
2951	can_hover => 1	3291	can_hover => 1
2952	};	3292	};
		3293
		3294	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3295	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3296	$label->update;
		3297	$label->set_max_size (undef, $label->{req_h} * $diff)
		3298	if $diff < 1;
		3299	$self->{timer}->interval (1/30);
		3300	} else {
		3301	$label->{fg}[3] = $item->{fg}[3] || 1;
		3302	}
		3303
		3304	push @widgets, $label;
2953	}	3305	}
2954		3306
2955	$self->clear;	3307	$self->clear;
2956	$self->SUPER::add (reverse @widgets);	3308	$self->SUPER::add (reverse @widgets);
2957	}	3309	}
…		…
2962	$text =~ s/^\s+//;	3314	$text =~ s/^\s+//;
2963	$text =~ s/\s+$//;	3315	$text =~ s/\s+$//;
2964		3316
2965	return unless $text;	3317	return unless $text;
2966		3318
2967	my $timeout = time + ((delete $arg{timeout}) || 60);	3319	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2968		3320
2969	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3321	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2970		3322
2971	if (my $item = $self->{item}{$group}) {	3323	if (my $item = $self->{item}{$group}) {
2972	if ($item->{text} eq $text) {	3324	if ($item->{text} eq $text) {
2973	$item->{count}++;	3325	$item->{count}++;
2974	} else {	3326	} else {
2975	$item->{count} = 1;	3327	$item->{count} = 1;
2976	$item->{text} = $item->{tooltip} = $text;	3328	$item->{text} = $item->{tooltip} = $text;
2977	}	3329	}
2978	$item->{id} = ++$self->{id};	3330	$item->{id} += 0.2;#d#
2979	$item->{timeout} = $timeout;	3331	$item->{timeout} = $timeout;
2980	delete $item->{label};	3332	delete $item->{label};
2981	} else {	3333	} else {
2982	$self->{item}{$group} = {	3334	$self->{item}{$group} = {
2983	id => ++$self->{id},	3335	id => ++$self->{id},
…		…
3002		3354
3003	$self->reorder;	3355	$self->reorder;
3004	$self->SUPER::reconfigure;	3356	$self->SUPER::reconfigure;
3005	}	3357	}
3006		3358
		3359	sub destroy {
		3360	my ($self) = @_;
		3361
		3362	$self->{timer}->cancel;
		3363
		3364	$self->SUPER::destroy;
		3365	}
		3366
3007	#############################################################################	3367	#############################################################################
3008		3368
3009	package CFClient::UI::Root;	3369	package CFClient::UI::Inventory;
3010		3370
3011	our @ISA = CFClient::UI::Container::;	3371	our @ISA = CFClient::UI::ScrolledWindow::;
3012
3013	use CFClient::OpenGL;
3014		3372
3015	sub new {	3373	sub new {
3016	my $class = shift;	3374	my $class = shift;
3017		3375
3018	my $self = $class->SUPER::new (	3376	my $self = $class->SUPER::new (
3019	visible => 1,	3377	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3020	@_,	3378	@_,
3021	);	3379	);
3022		3380
3023	Scalar::Util::weaken ($self->{root} = $self);
3024
3025	$self	3381	$self
3026	}	3382	}
3027		3383
3028	sub size_request {	3384	sub set_items {
3029	my ($self) = @_;	3385	my ($self, $items) = @_;
3030		3386
3031	($self->{w}, $self->{h})	3387	$self->{child}->clear;
3032	}	3388	return unless $items;
3033		3389
3034	sub _to_pixel {	3390	my @items = sort {
3035	my ($coord, $size, $max) = @_;	3391	($a->{type} <=> $b->{type})
		3392	or ($a->{name} cmp $b->{name})
		3393	} @$items;
3036		3394
3037	$coord =	3395	$self->{real_items} = \@items;
3038	$coord eq "center" ? ($max - $size) * 0.5
3039	: $coord eq "max" ? $max
3040	: $coord;
3041		3396
3042	$coord = 0 if $coord < 0;	3397	my $row = 0;
3043	$coord = $max - $size if $coord > $max - $size;	3398	for my $item (@items) {
		3399	CFClient::Item::update_widgets $item;
3044		3400
3045	int $coord + 0.5	3401	$self->{child}->add (0, $row, $item->{face_widget});
3046	}	3402	$self->{child}->add (1, $row, $item->{desc_widget});
		3403	$self->{child}->add (2, $row, $item->{weight_widget});
3047		3404
3048	sub size_allocate {	3405	$row++;
3049	my ($self, $w, $h) = @_;
3050
3051	for my $child ($self->children) {
3052	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3053
3054	$X = $child->{force_x} if exists $child->{force_x};
3055	$Y = $child->{force_y} if exists $child->{force_y};
3056
3057	$X = _to_pixel $X, $W, $self->{w};
3058	$Y = _to_pixel $Y, $H, $self->{h};
3059
3060	$child->configure ($X, $Y, $W, $H);
3061	}	3406	}
3062	}
3063
3064	sub coord2local {
3065	my ($self, $x, $y) = @_;
3066
3067	($x, $y)
3068	}
3069
3070	sub coord2global {
3071	my ($self, $x, $y) = @_;
3072
3073	($x, $y)
3074	}
3075
3076	sub update {
3077	my ($self) = @_;
3078
3079	$::WANT_REFRESH++;
3080	}
3081
3082	sub add {
3083	my ($self, @children) = @_;
3084
3085	$_->{is_toplevel} = 1
3086	for @children;
3087
3088	$self->SUPER::add (@children);
3089	}
3090
3091	sub remove {
3092	my ($self, @children) = @_;
3093
3094	$self->SUPER::remove (@children);
3095
3096	delete $self->{is_toplevel}
3097	for @children;
3098
3099	while (@children) {
3100	my $w = pop @children;
3101	push @children, $w->children;
3102	$w->set_invisible;
3103	}
3104	}
3105
3106	sub on_refresh {
3107	my ($self, $id, $cb) = @_;
3108
3109	$self->{refresh_hook}{$id} = $cb;
3110	}
3111
3112	sub on_post_alloc {
3113	my ($self, $id, $cb) = @_;
3114
3115	$self->{post_alloc_hook}{$id} = $cb;
3116	}
3117
3118	sub draw {
3119	my ($self) = @_;
3120
3121	while ($self->{refresh_hook}) {
3122	$_->()
3123	for values %{delete $self->{refresh_hook}};
3124	}
3125
3126	if ($self->{realloc}) {
3127	my @queue;
3128
3129	while () {
3130	if ($self->{realloc}) {
3131	#TODO use array-of-depth approach
3132
3133	use sort 'stable';
3134
3135	@queue = sort { $a->{visible} <=> $b->{visible} }
3136	@queue, values %{delete $self->{realloc}};
3137	}
3138
3139	my $widget = pop @queue || last;
3140
3141	$widget->{visible} or last; # do not resize invisible widgets
3142
3143	my ($w, $h) = $widget->size_request;
3144
3145	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3146	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3147
3148	$w = $widget->{force_w} if exists $widget->{force_w};
3149	$h = $widget->{force_h} if exists $widget->{force_h};
3150
3151	if ($widget->{req_w} != $w || $widget->{req_h} != $h
3152	|| delete $widget->{force_realloc}) {
3153	$widget->{req_w} = $w;
3154	$widget->{req_h} = $h;
3155
3156	$self->{size_alloc}{$widget+0} = $widget;
3157
3158	if (my $parent = $widget->{parent}) {
3159	$self->{realloc}{$parent+0} = $parent;
3160	#unshift @queue, $parent;
3161	$parent->{force_size_alloc} = 1;
3162	$self->{size_alloc}{$parent+0} = $parent;
3163	}
3164	}
3165
3166	delete $self->{realloc}{$widget+0};
3167	}
3168	}
3169
3170	while (my $size_alloc = delete $self->{size_alloc}) {
3171	my @queue = sort { $b->{visible} <=> $a->{visible} }
3172	values %$size_alloc;
3173
3174	while () {
3175	my $widget = pop @queue || last;
3176
3177	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3178
3179	$w = 0 if $w < 0;
3180	$h = 0 if $h < 0;
3181
3182	$w = int $w + 0.5;
3183	$h = int $h + 0.5;
3184
3185	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3186	$widget->{w} = $w;
3187	$widget->{h} = $h;
3188
3189	$widget->emit (size_allocate => $w, $h);
3190	}
3191	}
3192	}
3193
3194	while ($self->{post_alloc_hook}) {
3195	$_->()
3196	for values %{delete $self->{post_alloc_hook}};
3197	}
3198
3199
3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3202	glClear GL_COLOR_BUFFER_BIT;
3203
3204	glMatrixMode GL_PROJECTION;
3205	glLoadIdentity;
3206	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3207	glMatrixMode GL_MODELVIEW;
3208	glLoadIdentity;
3209
3210	$self->_draw;
3211	}	3407	}
3212		3408
3213	#############################################################################	3409	#############################################################################
3214		3410
3215	package CFClient::UI::BindEditor;	3411	package CFClient::UI::BindEditor;
…		…
3221		3417
3222	my $self = $class->SUPER::new (binding => [], commands => [], @_);	3418	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3223		3419
3224	$self->add (my $vb = new CFClient::UI::VBox);	3420	$self->add (my $vb = new CFClient::UI::VBox);
3225		3421
3226	$vb->add (my $hb = new CFClient::UI::HBox);
3227	$hb->add (new CFClient::UI::Label text => "Key: ");
3228	$hb->add ($self->{keylbl} = new CFClient::UI::Label);
3229	$hb->add (new CFClient::UI::Button
3230	text => "bind",
3231	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3232	on_activate => sub {
3233	$self->ask_for_bind;
3234	});
3235		3422
3236	$vb->add (new CFClient::UI::Label text => "Actions:");
3237	$vb->add ($self->{rec_btn} = new CFClient::UI::Button	3423	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3238	text => "start recording",	3424	text => "start recording",
3239	tooltip => "Start/Stops recording of actions."	3425	tooltip => "Start/Stops recording of actions."
3240	."All subsequent actions after the recording started will be captured."	3426	."All subsequent actions after the recording started will be captured."
3241	."The actions are displayed after the record was stopped."	3427	."The actions are displayed after the record was stopped."
…		…
3246	} else {	3432	} else {
3247	$self->stop;	3433	$self->stop;
3248	}	3434	}
3249	});	3435	});
3250		3436
		3437	$vb->add (new CFClient::UI::Label text => "Actions:");
3251	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);	3438	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3439
		3440	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3441	$vb->add (my $hb = new CFClient::UI::HBox);
		3442	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3443	$hb->add (new CFClient::UI::Button
		3444	text => "bind",
		3445	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3446	on_activate => sub {
		3447	$self->ask_for_bind;
		3448	});
3252		3449
3253	$vb->add (my $hb = new CFClient::UI::HBox);	3450	$vb->add (my $hb = new CFClient::UI::HBox);
3254	$hb->add (new CFClient::UI::Button	3451	$hb->add (new CFClient::UI::Button
3255	text => "ok",	3452	text => "ok",
		3453	expand => 1,
3256	tooltip => "This closes the binding editor and saves the binding",	3454	tooltip => "This closes the binding editor and saves the binding",
3257	on_activate => sub {	3455	on_activate => sub {
3258	$self->hide;	3456	$self->hide;
3259	$self->commit;	3457	$self->commit;
3260	});	3458	});
3261		3459
3262	$hb->add (new CFClient::UI::Button	3460	$hb->add (new CFClient::UI::Button
3263	text => "cancel",	3461	text => "cancel",
		3462	expand => 1,
3264	tooltip => "This closes the binding editor without saving",	3463	tooltip => "This closes the binding editor without saving",
3265	on_activate => sub {	3464	on_activate => sub {
3266	$self->hide;	3465	$self->hide;
3267	$self->{binding_cancel}->()	3466	$self->{binding_cancel}->()
3268	if $self->{binding_cancel};	3467	if $self->{binding_cancel};
…		…
3280	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)	3479	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3281	."'. Don't forget 'Save Config'!");	3480	."'. Don't forget 'Save Config'!");
3282	$self->{binding_change}->($mod, $sym, $cmds)	3481	$self->{binding_change}->($mod, $sym, $cmds)
3283	if $self->{binding_change};	3482	if $self->{binding_change};
3284	} else {	3483	} else {
3285	$::STATUSBOX->add ("No action bound, no keys specified!");	3484	$::STATUSBOX->add ("No action bound, no key or action specified!");
3286	$self->{binding_cancel}->()	3485	$self->{binding_cancel}->()
3287	if $self->{binding_cancel};	3486	if $self->{binding_cancel};
3288	}	3487	}
3289	}	3488	}
3290		3489
…		…
3307	$rec = $::CONN->stop_record if $::CONN;	3506	$rec = $::CONN->stop_record if $::CONN;
3308	return unless ref $rec eq 'ARRAY';	3507	return unless ref $rec eq 'ARRAY';
3309	$self->set_command_list ($rec);	3508	$self->set_command_list ($rec);
3310	}	3509	}
3311		3510
		3511
		3512	sub ask_for_bind_and_commit {
		3513	my ($self) = @_;
		3514	$self->ask_for_bind (1);
		3515	}
		3516
3312	sub ask_for_bind {	3517	sub ask_for_bind {
3313	my ($self, $commit) = @_;	3518	my ($self, $commit, $end_cb) = @_;
3314		3519
3315	CFClient::Binder::open_binding_dialog (sub {	3520	CFClient::Binder::open_binding_dialog (sub {
3316	my ($mod, $sym) = @_;	3521	my ($mod, $sym) = @_;
3317	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?	3522	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3318	$self->update_binding_widgets;	3523	$self->update_binding_widgets;
3319	$self->commit if $commit;	3524	$self->commit if $commit;
		3525	$end_cb->() if $end_cb;
3320	});	3526	});
3321	}	3527	}
3322		3528
		3529	# $mod and $sym are the modifiers and key symbol
		3530	# $cmds is a array ref of strings (the commands)
		3531	# $cb is the callback that is executed on OK
		3532	# $ccb is the callback that is executed on CANCEL and
		3533	# when the binding was unsuccessful on OK
3323	sub set_binding {	3534	sub set_binding {
3324	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;	3535	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3325		3536
3326	$self->clear_command_list;	3537	$self->clear_command_list;
3327	$self->{recording} = 0;	3538	$self->{recording} = 0;
…		…
3332		3543
3333	$self->{binding_change} = $cb;	3544	$self->{binding_change} = $cb;
3334	$self->{binding_cancel} = $ccb;	3545	$self->{binding_cancel} = $ccb;
3335		3546
3336	$self->update_binding_widgets;	3547	$self->update_binding_widgets;
		3548	}
		3549
		3550	# this is a shortcut method that asks for a binding
		3551	# and then just binds it.
		3552	sub do_quick_binding {
		3553	my ($self, $cmds, $end_cb) = @_;
		3554	$self->set_binding (undef, undef, $cmds, sub {
		3555	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3556	});
		3557	$self->ask_for_bind (1, $end_cb);
3337	}	3558	}
3338		3559
3339	sub update_binding_widgets {	3560	sub update_binding_widgets {
3340	my ($self) = @_;	3561	my ($self) = @_;
3341	my ($mod, $sym, $cmds) = $self->get_binding;	3562	my ($mod, $sym, $cmds) = $self->get_binding;
…		…
3367		3588
3368	for (@$cmds) {	3589	for (@$cmds) {
3369	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);	3590	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3370		3591
3371	my $i = $idx;	3592	my $i = $idx;
		3593	$hb->add (new CFClient::UI::Label text => $_);
3372	$hb->add (new CFClient::UI::Button	3594	$hb->add (new CFClient::UI::Button
3373	text => "delete",	3595	text => "delete",
3374	tooltip => "Deletes the action from the record",	3596	tooltip => "Deletes the action from the record",
3375	on_activate => sub {	3597	on_activate => sub {
3376	$self->{cmdbox}->remove ($hb);	3598	$self->{cmdbox}->remove ($hb);
3377	$cmds->[$i] = undef;	3599	$cmds->[$i] = undef;
3378	});	3600	});
3379		3601
3380	$hb->add (new CFClient::UI::Label text => $_);
3381		3602
3382	$idx++	3603	$idx++
3383	}	3604	}
3384	}	3605	}
3385		3606
		3607	#############################################################################
		3608
		3609	package CFClient::UI::SpellList;
		3610
		3611	our @ISA = CFClient::UI::Table::;
		3612
		3613	sub new {
		3614	my $class = shift;
		3615
		3616	my $self = $class->SUPER::new (
		3617	binding => [],
		3618	commands => [],
		3619	@_,
		3620	)
		3621	}
		3622
		3623	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3624
		3625	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3626	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3627	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3628	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3629	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3630	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3631	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3632	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3633	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3634	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3635
		3636	sub rebuild_spell_list {
		3637	my ($self) = @_;
		3638
		3639	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3640	$self->clear;
		3641
		3642	return unless $::CONN;
		3643
		3644	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3645	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3646	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3647	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3648	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3649
		3650	my $row = 0;
		3651
		3652	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3653	my $spell = $self->{spell}{$_};
		3654
		3655	$row++;
		3656
		3657	my $spell_cb = sub {
		3658	my ($widget, $ev) = @_;
		3659
		3660	if ($ev->{button} == 1) {
		3661	$::CONN->user_send ("cast $spell->{name}");
		3662	} elsif ($ev->{button} == 2) {
		3663	$::CONN->user_send ("invoke $spell->{name}");
		3664	} elsif ($ev->{button} == 3) {
		3665	(new CFClient::UI::Menu
		3666	items => [
		3667	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3668	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3669	],
		3670	)->popup ($ev);
		3671	} else {
		3672	return 0;
		3673	}
		3674
		3675	1
		3676	};
		3677
		3678	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3679
		3680	#TODO: add path info to tooltip
		3681	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3682
		3683	$self->add (0, $row, new CFClient::UI::Face
		3684	face => $spell->{face},
		3685	can_hover => 1,
		3686	can_events => 1,
		3687	tooltip => $tooltip,
		3688	on_button_down => $spell_cb,
		3689	);
		3690
		3691	$self->add (1, $row, new CFClient::UI::Label
		3692	expand => 1,
		3693	text => $spell->{name},
		3694	can_hover => 1,
		3695	can_events => 1,
		3696	tooltip => $tooltip,
		3697	on_button_down => $spell_cb,
		3698	);
		3699
		3700	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3701	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3702	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3703	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3704	}
		3705	});
		3706	}
		3707
		3708	sub add_spell {
		3709	my ($self, $spell) = @_;
		3710
		3711	$self->{spell}->{$spell->{name}} = $spell;
		3712	$self->rebuild_spell_list;
		3713	}
		3714
		3715	sub remove_spell {
		3716	my ($self, $spell) = @_;
		3717
		3718	delete $self->{spell}->{$spell->{name}};
		3719	$self->rebuild_spell_list;
		3720	}
		3721
		3722	sub clear_spells {
		3723	my ($self) = @_;
		3724
		3725	$self->{spell} = {};
		3726	$self->rebuild_spell_list;
		3727	}
		3728
		3729	#############################################################################
		3730
		3731	package CFClient::UI::Root;
		3732
		3733	our @ISA = CFClient::UI::Container::;
		3734
		3735	use List::Util qw(min max);
		3736
		3737	use CFClient::OpenGL;
		3738
		3739	sub new {
		3740	my $class = shift;
		3741
		3742	my $self = $class->SUPER::new (
		3743	visible => 1,
		3744	@_,
		3745	);
		3746
		3747	Scalar::Util::weaken ($self->{root} = $self);
		3748
		3749	$self
		3750	}
		3751
		3752	sub size_request {
		3753	my ($self) = @_;
		3754
		3755	($self->{w}, $self->{h})
		3756	}
		3757
		3758	sub _to_pixel {
		3759	my ($coord, $size, $max) = @_;
		3760
		3761	$coord =
		3762	$coord eq "center" ? ($max - $size) * 0.5
		3763	: $coord eq "max" ? $max
		3764	: $coord;
		3765
		3766	$coord = 0 if $coord < 0;
		3767	$coord = $max - $size if $coord > $max - $size;
		3768
		3769	int $coord + 0.5
		3770	}
		3771
		3772	sub invoke_size_allocate {
		3773	my ($self, $w, $h) = @_;
		3774
		3775	for my $child ($self->children) {
		3776	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
		3777
		3778	$X = $child->{force_x} if exists $child->{force_x};
		3779	$Y = $child->{force_y} if exists $child->{force_y};
		3780
		3781	$X = _to_pixel $X, $W, $self->{w};
		3782	$Y = _to_pixel $Y, $H, $self->{h};
		3783
		3784	$child->configure ($X, $Y, $W, $H);
		3785	}
		3786
		3787	1
		3788	}
		3789
		3790	sub coord2local {
		3791	my ($self, $x, $y) = @_;
		3792
		3793	($x, $y)
		3794	}
		3795
		3796	sub coord2global {
		3797	my ($self, $x, $y) = @_;
		3798
		3799	($x, $y)
		3800	}
		3801
		3802	sub update {
		3803	my ($self) = @_;
		3804
		3805	$::WANT_REFRESH++;
		3806	}
		3807
		3808	sub add {
		3809	my ($self, @children) = @_;
		3810
		3811	$_->{is_toplevel} = 1
		3812	for @children;
		3813
		3814	$self->SUPER::add (@children);
		3815	}
		3816
		3817	sub remove {
		3818	my ($self, @children) = @_;
		3819
		3820	$self->SUPER::remove (@children);
		3821
		3822	delete $self->{is_toplevel}
		3823	for @children;
		3824
		3825	while (@children) {
		3826	my $w = pop @children;
		3827	push @children, $w->children;
		3828	$w->set_invisible;
		3829	}
		3830	}
		3831
		3832	sub on_refresh {
		3833	my ($self, $id, $cb) = @_;
		3834
		3835	$self->{refresh_hook}{$id} = $cb;
		3836	}
		3837
		3838	sub on_post_alloc {
		3839	my ($self, $id, $cb) = @_;
		3840
		3841	$self->{post_alloc_hook}{$id} = $cb;
		3842	}
		3843
		3844	sub draw {
		3845	my ($self) = @_;
		3846
		3847	while ($self->{refresh_hook}) {
		3848	$_->()
		3849	for values %{delete $self->{refresh_hook}};
		3850	}
		3851
		3852	if ($self->{realloc}) {
		3853	my %queue;
		3854	my @queue;
		3855	my $widget;
		3856
		3857	outer:
		3858	while () {
		3859	if (my $realloc = delete $self->{realloc}) {
		3860	for $widget (values %$realloc) {
		3861	$widget->{visible} or next; # do not resize invisible widgets
		3862
		3863	$queue{$widget+0}++ and next; # duplicates are common
		3864
		3865	push @{ $queue[$widget->{visible}] }, $widget;
		3866	}
		3867	}
		3868
		3869	while () {
		3870	@queue or last outer;
		3871
		3872	$widget = pop @{ $queue[-1] || [] }
		3873	and last;
		3874
		3875	pop @queue;
		3876	}
		3877
		3878	delete $queue{$widget+0};
		3879
		3880	my ($w, $h) = $widget->size_request;
		3881
		3882	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3883	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3884
		3885	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3886	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3887
		3888	$w = $widget->{force_w} if exists $widget->{force_w};
		3889	$h = $widget->{force_h} if exists $widget->{force_h};
		3890
		3891	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3892	|| delete $widget->{force_realloc}) {
		3893	$widget->{req_w} = $w;
		3894	$widget->{req_h} = $h;
		3895
		3896	$self->{size_alloc}{$widget+0} = $widget;
		3897
		3898	if (my $parent = $widget->{parent}) {
		3899	$self->{realloc}{$parent+0} = $parent
		3900	unless $queue{$parent+0};
		3901
		3902	$parent->{force_size_alloc} = 1;
		3903	$self->{size_alloc}{$parent+0} = $parent;
		3904	}
		3905	}
		3906
		3907	delete $self->{realloc}{$widget+0};
		3908	}
		3909	}
		3910
		3911	while (my $size_alloc = delete $self->{size_alloc}) {
		3912	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3913	values %$size_alloc;
		3914
		3915	while () {
		3916	my $widget = pop @queue || last;
		3917
		3918	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
		3919
		3920	$w = 0 if $w < 0;
		3921	$h = 0 if $h < 0;
		3922
		3923	$w = int $w + 0.5;
		3924	$h = int $h + 0.5;
		3925
		3926	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3927	$widget->{old_w} = $widget->{w};
		3928	$widget->{old_h} = $widget->{h};
		3929
		3930	$widget->{w} = $w;
		3931	$widget->{h} = $h;
		3932
		3933	$widget->emit (size_allocate => $w, $h);
		3934	}
		3935	}
		3936	}
		3937
		3938	while ($self->{post_alloc_hook}) {
		3939	$_->()
		3940	for values %{delete $self->{post_alloc_hook}};
		3941	}
		3942
		3943
		3944	glViewport 0, 0, $::WIDTH, $::HEIGHT;
		3945	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
		3946	glClear GL_COLOR_BUFFER_BIT;
		3947
		3948	glMatrixMode GL_PROJECTION;
		3949	glLoadIdentity;
		3950	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
		3951	glMatrixMode GL_MODELVIEW;
		3952	glLoadIdentity;
		3953
		3954	{
		3955	package CFClient::UI::Base;
		3956
		3957	($draw_x, $draw_y, $draw_w, $draw_h) =
		3958	(0, 0, $self->{w}, $self->{h});
		3959	}
		3960
		3961	$self->_draw;
		3962	}
3386		3963
3387	#############################################################################	3964	#############################################################################
3388		3965
3389	package CFClient::UI;	3966	package CFClient::UI;
3390		3967

Diff Legend

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