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.241 by root, Fri May 26 20:50:35 2006 UTC vs.
Revision 1.262 by elmex, Wed May 31 13:44:26 2006 UTC

…		…
9	use CFClient;	9	use CFClient;
10	use CFClient::Texture;	10	use CFClient::Texture;
11		11
12	our ($FOCUS, $HOVER, $GRAB); # various widgets	12	our ($FOCUS, $HOVER, $GRAB); # various widgets
13		13
		14	our $LAYOUT;
14	our $ROOT;	15	our $ROOT;
15	our $TOOLTIP;	16	our $TOOLTIP;
16	our $BUTTON_STATE;	17	our $BUTTON_STATE;
17		18
18	our %WIDGET; # all widgets, weak-referenced	19	our %WIDGET; # all widgets, weak-referenced
		20
		21	sub get_layout {
		22	my $layout;
		23
		24	for (grep { $_->{name} } values %WIDGET) {
		25	my $win = $layout->{$_->{name}} = { };
		26
		27	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
		28	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
		29	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
		30	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
		31
		32	$win->{show} = $_->{visible} && $_->{is_toplevel};
		33	}
		34
		35	$layout
		36	}
		37
		38	sub set_layout {
		39	my ($layout) = @_;
		40
		41	$LAYOUT = $layout;
		42	}
19		43
20	sub check_tooltip {	44	sub check_tooltip {
21	if (!$GRAB) {	45	if (!$GRAB) {
22	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	46	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
23	if (length $widget->{tooltip}) {	47	if (length $widget->{tooltip}) {
24		48
25	if ($TOOLTIP->{owner} != $widget) {	49	if ($TOOLTIP->{owner} != $widget) {
		50	$TOOLTIP->hide;
		51
26	$TOOLTIP->{owner} = $widget;	52	$TOOLTIP->{owner} = $widget;
27		53
28	my $tip = $widget->{tooltip};	54	my $tip = $widget->{tooltip};
29		55
30	$tip = $tip->($widget) if CODE:: eq ref $tip;	56	$tip = $tip->($widget) if CODE:: eq ref $tip;
31		57
32	$TOOLTIP->set_tooltip_from ($widget);	58	$TOOLTIP->set_tooltip_from ($widget);
33	$TOOLTIP->show;	59	$TOOLTIP->show;
34
35	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
36
37	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
38	if $x + $TOOLTIP->{w} > $::WIDTH;
39
40	$TOOLTIP->move ($x, $y);
41	$TOOLTIP->check_size;
42	$TOOLTIP->update;
43	}	60	}
44		61
45	return;	62	return;
46	}	63	}
47	}	64	}
…		…
153	sub rescale_widgets {	170	sub rescale_widgets {
154	my ($sx, $sy) = @_;	171	my ($sx, $sy) = @_;
155		172
156	for my $widget (values %WIDGET) {	173	for my $widget (values %WIDGET) {
157	if ($widget->{is_toplevel}) {	174	if ($widget->{is_toplevel}) {
		175	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		176	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		177
158	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};	178	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
159	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};	179	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
160	$widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};	180	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
161	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
162	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};	181	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
163	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	182	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
164	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};	183	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
165	$widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h};	184
		185	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		186	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		187
166	}	188	}
167	}	189	}
168		190
169	reconfigure_widgets;	191	reconfigure_widgets;
170	}	192	}
…		…
179		201
180	sub new {	202	sub new {
181	my $class = shift;	203	my $class = shift;
182		204
183	my $self = bless {	205	my $self = bless {
184	x => 0,	206	x => "center",
185	y => 0,	207	y => "center",
186	z => 0,	208	z => 0,
		209	w => undef,
		210	h => undef,
187	can_events => 1,	211	can_events => 1,
188	@_	212	@_
189	}, $class;	213	}, $class;
190		214
		215	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		216
191	for (keys %$self) {	217	for (keys %$self) {
192	if (/^connect_(.*)$/) {	218	if (/^on_(.*)$/) {
193	$self->connect ($1 => delete $self->{$_});	219	$self->connect ($1 => delete $self->{$_});
194	}	220	}
195	}	221	}
196		222
197	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	223	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		224	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		225	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		226	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		227	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		228
		229	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		230	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		231
		232	$self->show if $layout->{show};
		233	}
198		234
199	$self	235	$self
200	}	236	}
201		237
202	sub destroy {	238	sub destroy {
…		…
206	%$self = ();	242	%$self = ();
207	}	243	}
208		244
209	sub show {	245	sub show {
210	my ($self) = @_;	246	my ($self) = @_;
		247
211	return if $self->{parent};	248	return if $self->{parent};
212		249
213	$CFClient::UI::ROOT->add ($self);	250	$CFClient::UI::ROOT->add ($self);
214	}	251	}
215		252
216	sub show_centered {	253	sub set_visible {
217	my ($self) = @_;	254	my ($self) = @_;
		255
218	return if $self->{parent};	256	return if $self->{visible};
219		257
220	$self->show;	258	$self->{root} = $self->{parent}{root};
		259	$self->{visible} = $self->{parent}{visible} + 1;
221		260
222	$CFClient::UI::ROOT->on_post_alloc (	261	$self->emit (visibility_change => 1);
223	"centered $self" => sub {	262
224	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);	263	$self->realloc if !exists $self->{req_w};
225	},	264
226	);	265	$_->set_visible for $self->children;
227	}	266	}
228		267
229	sub set_invisible {	268	sub set_invisible {
230	my ($self) = @_;	269	my ($self) = @_;
231		270
232	# broken show/hide model	271	return unless $self->{visible};
		272
		273	$_->set_invisible for $self->children;
233		274
234	delete $self->{root};	275	delete $self->{root};
235	delete $self->{visible};	276	delete $self->{visible};
236		277
237	undef $GRAB if $GRAB == $self;	278	undef $GRAB if $GRAB == $self;
238	undef $HOVER if $HOVER == $self;	279	undef $HOVER if $HOVER == $self;
239		280
240	CFClient::UI::check_tooltip	281	CFClient::UI::check_tooltip
241	if $CFClient::UI::TOOLTIP->{owner} == $self;	282	if $TOOLTIP->{owner} == $self;
242		283
243	$self->focus_out;	284	$self->focus_out;
		285
		286	$self->emit (visibility_change => 0);
		287	}
		288
		289	sub set_visibility {
		290	my ($self, $visible) = @_;
		291
		292	return if $self->{visible} == $visible;
		293
		294	$visible ? $self->hide
		295	: $self->show;
		296	}
		297
		298	sub toggle_visibility {
		299	my ($self) = @_;
		300
		301	$self->{visible}
		302	? $self->hide
		303	: $self->show;
244	}	304	}
245		305
246	sub hide {	306	sub hide {
247	my ($self) = @_;	307	my ($self) = @_;
248		308
…		…
250		310
251	$self->{parent}->remove ($self)	311	$self->{parent}->remove ($self)
252	if $self->{parent};	312	if $self->{parent};
253	}	313	}
254		314
255	sub move {	315	sub move_abs {
256	my ($self, $x, $y, $z) = @_;	316	my ($self, $x, $y, $z) = @_;
257		317
258	$self->{x} = int $x;	318	$self->{x} = List::Util::max 0, int $x;
259	$self->{y} = int $y;	319	$self->{y} = List::Util::max 0, int $y;
260	$self->{z} = $z if defined $z;	320	$self->{z} = $z if defined $z;
261		321
262	$self->update;	322	$self->update;
263	}	323	}
264		324
265	sub set_size {	325	sub set_size {
266	my ($self, $w, $h) = @_;	326	my ($self, $w, $h) = @_;
267		327
268	$self->{user_w} = $w;	328	$self->{force_w} = $w;
269	$self->{user_h} = $h;	329	$self->{force_h} = $h;
270		330
271	$self->check_size;	331	$self->realloc;
272	}	332	}
273		333
274	sub size_request {	334	sub size_request {
275	require Carp;	335	require Carp;
276	Carp::confess "size_request is abstract";	336	Carp::confess "size_request is abstract";
…		…
278		338
279	sub configure {	339	sub configure {
280	my ($self, $x, $y, $w, $h) = @_;	340	my ($self, $x, $y, $w, $h) = @_;
281		341
282	if ($self->{aspect}) {	342	if ($self->{aspect}) {
		343	my ($ow, $oh) = ($w, $h);
		344
283	my $w2 = List::Util::min $w, int $h * $self->{aspect};	345	$w = List::Util::min $w, int $h * $self->{aspect};
284	my $h2 = List::Util::min $h, int $w / $self->{aspect};	346	$h = List::Util::min $h, int $w / $self->{aspect};
285		347
286	# use alignment to adjust x, y	348	# use alignment to adjust x, y
287		349
288	$x += int +($w - $w2) * 0.5;	350	$x += int 0.5 * ($ow - $w);
289	$y += int +($h - $h2) * 0.5;	351	$y += int 0.5 * ($oh - $h);
290
291	($w, $h) = ($w2, $h2);
292	}	352	}
293		353
294	if ($self->{x} != $x || $self->{y} != $y) {	354	if ($self->{x} ne $x || $self->{y} ne $y) {
295	$self->{x} = $x;	355	$self->{x} = $x;
296	$self->{y} = $y;	356	$self->{y} = $y;
297	$self->update;	357	$self->update;
298	}	358	}
299		359
300	if ($self->{w} != $w || $self->{h} != $h) {	360	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
301	$CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h];	361	return unless $self->{visible};
		362
		363	$self->{alloc_w} = $w;
		364	$self->{alloc_h} = $h;
		365
		366	$self->{root}{size_alloc}{$self+0} = $self;
302	}	367	}
303	}	368	}
304		369
305	sub size_allocate {	370	sub size_allocate {
306	# nothing to be done	371	# nothing to be done
307	}
308
309	sub reconfigure {
310	my ($self) = @_;
311
312	$self->check_size (1);
313	$self->update;
314	}	372	}
315		373
316	sub children {	374	sub children {
317	}	375	}
318		376
…		…
396	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	454	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
397	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	455	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
398	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	456	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
399	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	457	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
400	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	458	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
		459
		460	sub find_widget {
		461	my ($self, $x, $y) = @_;
		462
		463	return () unless $self->{can_events};
		464
		465	return $self
		466	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		467	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		468
		469	()
		470	}
		471
		472	sub set_parent {
		473	my ($self, $parent) = @_;
		474
		475	Scalar::Util::weaken ($self->{parent} = $parent);
		476	$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	}
		501
		502	sub realloc {
		503	my ($self) = @_;
		504
		505	if ($self->{visible}) {
		506	return if $self->{root}{realloc}{$self+0};
		507
		508	$self->{root}{realloc}{$self+0} = $self;
		509	$self->{root}->update;
		510	} else {
		511	delete $self->{req_w};
		512	delete $self->{req_h};
		513	}
		514	}
		515
		516	sub update {
		517	my ($self) = @_;
		518
		519	$self->{parent}->update
		520	if $self->{parent};
		521	}
		522
		523	sub reconfigure {
		524	my ($self) = @_;
		525
		526	$self->realloc;
		527	$self->update;
		528	}
401		529
402	sub draw {	530	sub draw {
403	my ($self) = @_;	531	my ($self) = @_;
404		532
405	return unless $self->{h} && $self->{w};	533	return unless $self->{h} && $self->{w};
…		…
422	glVertex $x , $y + $self->{h};	550	glVertex $x , $y + $self->{h};
423	glEnd;	551	glEnd;
424	glDisable GL_BLEND;	552	glDisable GL_BLEND;
425	}	553	}
426		554
427	if ($ENV{PCLIENT_DEBUG}) {	555	if ($ENV{CFPLUS_DEBUG} & 1) {
428	glPushMatrix;	556	glPushMatrix;
429	glColor 1, 1, 0, 1;	557	glColor 1, 1, 0, 1;
430	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	558	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
431	glBegin GL_LINE_LOOP;	559	glBegin GL_LINE_LOOP;
432	glVertex 0 , 0;	560	glVertex 0 , 0;
…		…
443	my ($self) = @_;	571	my ($self) = @_;
444		572
445	warn "no draw defined for $self\n";	573	warn "no draw defined for $self\n";
446	}	574	}
447		575
448	sub find_widget {
449	my ($self, $x, $y) = @_;
450
451	return () unless $self->{can_events};
452
453	return $self
454	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
455	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
456
457	()
458	}
459
460	sub set_parent {
461	my ($self, $parent) = @_;
462
463	Scalar::Util::weaken ($self->{parent} = $parent);
464
465	$self->{root} = $parent->{root};
466	$self->{visible} = $parent->{visible} + 1;
467
468	# TODO: req_w _does_change after ->reconfigure
469	$self->check_size
470	unless exists $self->{req_w};
471
472	$self->show;
473	}
474
475	sub check_size {
476	my ($self, $forced) = @_;
477
478	$self->{force_alloc} = 1 if $forced;
479	$CFClient::UI::ROOT->{check_size}{$self} = $self;
480	}
481
482	sub update {
483	my ($self) = @_;
484
485	$self->{parent}->update
486	if $self->{parent};
487	}
488
489	sub connect {
490	my ($self, $signal, $cb) = @_;
491
492	push @{ $self->{signal_cb}{$signal} }, $cb;
493	}
494
495	sub _emit {
496	my ($self, $signal, @args) = @_;
497
498	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
499	}
500
501	sub emit {
502	my ($self, $signal, @args) = @_;
503
504	$self->_emit ($signal, @args)
505	|| $self->$signal (@args);
506	}
507
508	sub DESTROY {	576	sub DESTROY {
509	my ($self) = @_;	577	my ($self) = @_;
510		578
511	delete $WIDGET{$self+0};	579	delete $WIDGET{$self+0};
512	#$self->deactivate;	580	#$self->deactivate;
…		…
568	my ($class, %arg) = @_;	636	my ($class, %arg) = @_;
569	$class->SUPER::new (can_events => 0, %arg);	637	$class->SUPER::new (can_events => 0, %arg);
570	}	638	}
571		639
572	sub size_request {	640	sub size_request {
573	(0, 0)	641	my ($self) = @_;
		642
		643	($self->{w} + 0, $self->{h} + 0)
574	}	644	}
575		645
576	sub draw { }	646	sub draw { }
577		647
578	#############################################################################	648	#############################################################################
…		…
607	$self->{children} = [	677	$self->{children} = [
608	sort { $a->{z} <=> $b->{z} }	678	sort { $a->{z} <=> $b->{z} }
609	@{$self->{children}}, @widgets	679	@{$self->{children}}, @widgets
610	];	680	];
611		681
612	$self->check_size (1);	682	$self->realloc;
613	$self->update;
614	}	683	}
615		684
616	sub children {	685	sub children {
617	@{ $_[0]{children} }	686	@{ $_[0]{children} }
618	}	687	}
…		…
623	delete $child->{parent};	692	delete $child->{parent};
624	$child->hide;	693	$child->hide;
625		694
626	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	695	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
627		696
628	$self->check_size (1);	697	$self->realloc;
629	$self->update;
630	}	698	}
631		699
632	sub clear {	700	sub clear {
633	my ($self) = @_;	701	my ($self) = @_;
634		702
…		…
638	for (@$children) {	706	for (@$children) {
639	delete $_->{parent};	707	delete $_->{parent};
640	$_->hide;	708	$_->hide;
641	}	709	}
642		710
643	$self->check_size;	711	$self->realloc;
644	$self->update;
645	}	712	}
646		713
647	sub find_widget {	714	sub find_widget {
648	my ($self, $x, $y) = @_;	715	my ($self, $x, $y) = @_;
649		716
…		…
786	}	853	}
787		854
788	sub size_request {	855	sub size_request {
789	my ($self) = @_;	856	my ($self) = @_;
790		857
791	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	858	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
792		859
793	@$self{qw(child_w child_h)}	860	$w = 10 if $self->{scroll_x};
		861	$h = 10 if $self->{scroll_y};
		862
		863	($w, $h)
794	}	864	}
795		865
796	sub size_allocate {	866	sub size_allocate {
797	my ($self, $w, $h) = @_;	867	my ($self, $w, $h) = @_;
798		868
		869	my $child = $self->child;
		870
799	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	871	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
800	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	872	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
801		873
802	$self->child->configure (0, 0, $w, $h);	874	$self->child->configure (0, 0, $w, $h);
803	$self->update;	875	$self->update;
804	}	876	}
805		877
…		…
858	my $class = shift;	930	my $class = shift;
859		931
860	my $self;	932	my $self;
861		933
862	my $slider = new CFClient::UI::Slider	934	my $slider = new CFClient::UI::Slider
863	vertical => 1,	935	vertical => 1,
864	range => [0, 0, 1, 0.01], # HACK fix	936	range => [0, 0, 1, 0.01], # HACK fix
865	connect_changed => sub {	937	on_changed => sub {
866	$self->{vp}->set_offset (0, $_[1]);	938	$self->{vp}->set_offset (0, $_[1]);
867	},	939	},
868	;	940	;
869		941
870	$self = $class->SUPER::new (	942	$self = $class->SUPER::new (
…		…
948		1020
949	our @ISA = CFClient::UI::Bin::;	1021	our @ISA = CFClient::UI::Bin::;
950		1022
951	use CFClient::OpenGL;	1023	use CFClient::OpenGL;
952		1024
953	my @tex =	1025	my $bg =
		1026	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1027	mipmap => 1, wrap => 1;
		1028
		1029	my @border =
954	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
955	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1031	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
956		1032
957	sub new {	1033	sub new {
958	my $class = shift;	1034	my $class = shift;
959
960	# TODO: user_x, user_y, overwrite moveto?
961		1035
962	my $self = $class->SUPER::new (	1036	my $self = $class->SUPER::new (
963	bg => [1, 1, 1, 1],	1037	bg => [1, 1, 1, 1],
964	border_bg => [1, 1, 1, 1],	1038	border_bg => [1, 1, 1, 1],
965	border => 0.6,	1039	border => 0.6,
966	is_toplevel => 1,
967	can_events => 1,	1040	can_events => 1,
		1041	min_w => 16,
		1042	min_h => 16,
968	@_	1043	@_
969	);	1044	);
970		1045
971	$self->{title} &&= new CFClient::UI::Label	1046	$self->{title} &&= new CFClient::UI::Label
972	align => 0,	1047	align => 0,
…		…
1025	my ($ev, $x, $y) = @_;	1100	my ($ev, $x, $y) = @_;
1026		1101
1027	my $dx = $ev->{x} - $ox;	1102	my $dx = $ev->{x} - $ox;
1028	my $dy = $ev->{y} - $oy;	1103	my $dy = $ev->{y} - $oy;
1029		1104
1030	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1031	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1107
		1108	$self->realloc;
1032	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1033	$self->check_size;
1034	};	1110	};
1035		1111
1036	} elsif ($lr ^ $td) {	1112	} elsif ($lr ^ $td) {
1037	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1038	my ($bx, $by) = ($self->{x}, $self->{y});	1114	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1040	$self->{motion} = sub {	1116	$self->{motion} = sub {
1041	my ($ev, $x, $y) = @_;	1117	my ($ev, $x, $y) = @_;
1042		1118
1043	($x, $y) = ($ev->{x}, $ev->{y});	1119	($x, $y) = ($ev->{x}, $ev->{y});
1044		1120
1045	$self->move ($bx + $x - $ox, $by + $y - $oy);	1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1046	$self->update;
1047	};	1122	};
1048	}	1123	}
1049	}	1124	}
1050		1125
1051	sub button_up {	1126	sub button_up {
…		…
1070	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1071		1146
1072	my $border = $self->border;	1147	my $border = $self->border;
1073		1148
1074	glColor @{ $self->{border_bg} };	1149	glColor @{ $self->{border_bg} };
1075	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1150	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1076	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1151	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1077	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1152	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1078	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1153	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1079		1154
1080	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1155	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1081	my $bg = $tex[0];	1156	glColor @{ $self->{bg} };
1082		1157
1083	# TODO: repeat texture not scale	1158	# TODO: repeat texture not scale
		1159	# solve this better(?)
1084	my $rep_x = $cw / $bg->{w};	1160	$bg->{s} = $cw / $bg->{w};
1085	my $rep_y = $ch / $bg->{h};	1161	$bg->{t} = $ch / $bg->{h};
1086
1087	glColor @{ $self->{bg} };
1088
1089	$bg->{s} = $rep_x;
1090	$bg->{t} = $rep_y;
1091	$bg->{wrap_mode} = 1;
1092	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1093	}	1163	}
1094		1164
1095	glDisable GL_TEXTURE_2D;	1165	glDisable GL_TEXTURE_2D;
1096		1166
…		…
1126	my ($self, $x, $y, $child) = @_;	1196	my ($self, $x, $y, $child) = @_;
1127		1197
1128	$child->set_parent ($self);	1198	$child->set_parent ($self);
1129	$self->{children}[$y][$x] = $child;	1199	$self->{children}[$y][$x] = $child;
1130		1200
1131	$self->check_size (1);	1201	$self->realloc;
1132	}	1202	}
1133		1203
1134	# TODO: move to container class maybe? send children a signal on removal?	1204	# TODO: move to container class maybe? send children a signal on removal?
1135	sub clear {	1205	sub clear {
1136	my ($self) = @_;	1206	my ($self) = @_;
…		…
1141	for (@children) {	1211	for (@children) {
1142	delete $_->{parent};	1212	delete $_->{parent};
1143	$_->hide;	1213	$_->hide;
1144	}	1214	}
1145		1215
1146	$self->check_size (1);	1216	$self->realloc;
1147	$self->update;
1148	}	1217	}
1149		1218
1150	sub get_wh {	1219	sub get_wh {
1151	my ($self) = @_;	1220	my ($self) = @_;
1152		1221
…		…
1248	}	1317	}
1249	}	1318	}
1250		1319
1251	#############################################################################	1320	#############################################################################
1252		1321
1253	package CFClient::UI::HBox;	1322	package CFClient::UI::Box;
1254
1255	# TODO: wrap into common Box base class
1256		1323
1257	our @ISA = CFClient::UI::Container::;	1324	our @ISA = CFClient::UI::Container::;
1258		1325
1259	sub size_request {	1326	sub size_request {
1260	my ($self) = @_;	1327	my ($self) = @_;
1261		1328
1262	my @alloc = map [$_->size_request], @{$self->{children}};	1329	$self->{vertical}
1263		1330	? (
1264	(	1331	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1265	(List::Util::sum map $_->[0], @alloc),	1332	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1266	(List::Util::max map $_->[1], @alloc),	1333	)
1267	)	1334	: (
		1335	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1336	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1337	)
1268	}	1338	}
1269		1339
1270	sub size_allocate {	1340	sub size_allocate {
1271	my ($self, $w, $h) = @_;	1341	my ($self, $w, $h) = @_;
1272		1342
1273	($h, $w) = ($w, $h);	1343	my $space = $self->{vertical} ? $h : $w;
1274
1275	my $children = $self->{children};	1344	my $children = $self->{children};
1276		1345
1277	my @h = map $_->{req_w}, @$children;	1346	my @req;
1278		1347
1279	my $req_h = List::Util::sum @h;	1348	if ($self->{homogeneous}) {
1280		1349	@req = ($space / (@$children || 1)) x @$children;
1281	if ($req_h > $h) {
1282	# ah well, not enough space
1283	$_ *= $h / $req_h for @h;
1284	} else {	1350	} else {
		1351	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
		1352	my $req = List::Util::sum @req;
		1353
		1354	if ($req > $space) {
		1355	# ah well, not enough space
		1356	$_ *= $space / $req for @req;
		1357	} else {
1285	my $exp = List::Util::sum map $_->{expand}, @$children;	1358	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1286	$exp ||= 1;
1287		1359
		1360	$space = ($space - $req) / $expand; # remaining space to give away
		1361
		1362	$req[$_] += $space * $children->[$_]{expand}
1288	for (0 .. $#$children) {	1363	for 0 .. $#$children;
1289	my $child = $children->[$_];
1290
1291	my $alloc_h = $h[$_];
1292	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1293	$h[$_] = $alloc_h;
1294	}	1364	}
1295	}	1365	}
1296		1366
1297	CFClient::UI::harmonize \@h;	1367	CFClient::UI::harmonize \@req;
1298		1368
1299	my $y = 0;	1369	my $pos = 0;
1300	for (0 .. $#$children) {	1370	for (0 .. $#$children) {
1301	my $child = $children->[$_];
1302	my $h = $h[$_];	1371	my $alloc = $req[$_];
1303	$child->configure ($y, 0, $h, $w);	1372	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1304		1373
1305	$y += $h;	1374	$pos += $alloc;
1306	}	1375	}
1307		1376
1308	1	1377	1
1309	}	1378	}
1310		1379
1311	#############################################################################	1380	#############################################################################
1312		1381
		1382	package CFClient::UI::HBox;
		1383
		1384	our @ISA = CFClient::UI::Box::;
		1385
		1386	sub new {
		1387	my $class = shift;
		1388
		1389	$class->SUPER::new (
		1390	vertical => 0,
		1391	@_,
		1392	)
		1393	}
		1394
		1395	#############################################################################
		1396
1313	package CFClient::UI::VBox;	1397	package CFClient::UI::VBox;
1314		1398
1315	# TODO: wrap into common Box base class
1316
1317	our @ISA = CFClient::UI::Container::;	1399	our @ISA = CFClient::UI::Box::;
1318		1400
1319	sub size_request {	1401	sub new {
1320	my ($self) = @_;	1402	my $class = shift;
1321		1403
1322	my @alloc = map [$_->size_request], @{$self->{children}};	1404	$class->SUPER::new (
1323		1405	vertical => 1,
1324	(	1406	@_,
1325	(List::Util::max map $_->[0], @alloc),
1326	(List::Util::sum map $_->[1], @alloc),
1327	)	1407	)
1328	}
1329
1330	sub size_allocate {
1331	my ($self, $w, $h) = @_;
1332
1333	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1334
1335	my $children = $self->{children};
1336
1337	my @h = map $_->{req_h}, @$children;
1338
1339	my $req_h = List::Util::sum @h;
1340
1341	if ($req_h > $h) {
1342	# ah well, not enough space
1343	$_ *= $h / $req_h for @h;
1344	} else {
1345	my $exp = List::Util::sum map $_->{expand}, @$children;
1346	$exp ||= 1;
1347
1348	for (0 .. $#$children) {
1349	my $child = $children->[$_];
1350
1351	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1352	}
1353	}
1354
1355	CFClient::UI::harmonize \@h;
1356
1357	my $y = 0;
1358	for (0 .. $#$children) {
1359	my $child = $children->[$_];
1360	my $h = $h[$_];
1361	$child->configure (0, $y, $w, $h);
1362
1363	$y += $h;
1364	}
1365
1366	1
1367	}	1408	}
1368		1409
1369	#############################################################################	1410	#############################################################################
1370		1411
1371	package CFClient::UI::Label;	1412	package CFClient::UI::Label;
…		…
1388	ellipsise => 3, # end	1429	ellipsise => 3, # end
1389	layout => (new CFClient::Layout),	1430	layout => (new CFClient::Layout),
1390	fontsize => 1,	1431	fontsize => 1,
1391	align => -1,	1432	align => -1,
1392	valign => -1,	1433	valign => -1,
1393	padding => 2,	1434	padding_x => 2,
		1435	padding_y => 2,
1394	can_events => 0,	1436	can_events => 0,
1395	%arg	1437	%arg
1396	);	1438	);
1397		1439
1398	if (exists $self->{template}) {	1440	if (exists $self->{template}) {
…		…
1434	$self->{text} = "T$text";	1476	$self->{text} = "T$text";
1435		1477
1436	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1437	$self->{layout}->set_text ($text);	1479	$self->{layout}->set_text ($text);
1438		1480
		1481	$self->realloc;
1439	$self->update;	1482	$self->update;
1440	$self->check_size;
1441	}	1483	}
1442		1484
1443	sub set_markup {	1485	sub set_markup {
1444	my ($self, $markup) = @_;	1486	my ($self, $markup) = @_;
1445		1487
…		…
1449	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1491	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1450		1492
1451	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1493	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1452	$self->{layout}->set_markup ($markup);	1494	$self->{layout}->set_markup ($markup);
1453		1495
		1496	$self->realloc;
1454	$self->update;	1497	$self->update;
1455	$self->check_size;
1456	}	1498	}
1457		1499
1458	sub size_request {	1500	sub size_request {
1459	my ($self) = @_;	1501	my ($self) = @_;
1460		1502
…		…
1474		1516
1475	$w = List::Util::max $w, $w2;	1517	$w = List::Util::max $w, $w2;
1476	$h = List::Util::max $h, $h2;	1518	$h = List::Util::max $h, $h2;
1477	}	1519	}
1478		1520
1479	(	1521	($w, $h)
1480	$w + $self->{padding} * 2,
1481	$h + $self->{padding} * 2,
1482	)
1483	}	1522	}
1484		1523
1485	sub size_allocate {	1524	sub size_allocate {
1486	my ($self, $w, $h) = @_;	1525	my ($self, $w, $h) = @_;
1487		1526
…		…
1492	my ($self, $fontsize) = @_;	1531	my ($self, $fontsize) = @_;
1493		1532
1494	$self->{fontsize} = $fontsize;	1533	$self->{fontsize} = $fontsize;
1495	delete $self->{texture};	1534	delete $self->{texture};
1496		1535
1497	$self->update;	1536	$self->realloc;
1498	$self->check_size;
1499	}	1537	}
1500		1538
1501	sub _draw {	1539	sub _draw {
1502	my ($self) = @_;	1540	my ($self) = @_;
1503		1541
…		…
1511	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1512	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1513		1551
1514	my $tex = new_from_layout CFClient::Texture $self->{layout};	1552	my $tex = new_from_layout CFClient::Texture $self->{layout};
1515		1553
1516	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1517	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1518	: ($self->{w} - $tex->{w}) * 0.5);	1556	: ($self->{w} - $tex->{w}) * 0.5);
1519		1557
1520	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1521	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1522	: ($self->{h} - $tex->{h}) * 0.5);	1560	: ($self->{h} - $tex->{h}) * 0.5);
1523		1561
1524	$tex	1562	$tex
1525	};	1563	};
1526		1564
…		…
1583	sub set_text {	1621	sub set_text {
1584	my ($self, $text) = @_;	1622	my ($self, $text) = @_;
1585		1623
1586	$self->{cursor} = length $text;	1624	$self->{cursor} = length $text;
1587	$self->_set_text ($text);	1625	$self->_set_text ($text);
1588	$self->update;	1626
1589	$self->check_size;	1627	$self->realloc;
1590	}	1628	}
1591		1629
1592	sub get_text {	1630	sub get_text {
1593	$_[0]{text}	1631	$_[0]{text}
1594	}	1632	}
…		…
1627	} elsif ($uni) {	1665	} elsif ($uni) {
1628	substr $text, $self->{cursor}++, 0, chr $uni;	1666	substr $text, $self->{cursor}++, 0, chr $uni;
1629	}	1667	}
1630		1668
1631	$self->_set_text ($text);	1669	$self->_set_text ($text);
1632	$self->update;	1670
1633	$self->check_size;	1671	$self->realloc;
1634	}	1672	}
1635		1673
1636	sub focus_in {	1674	sub focus_in {
1637	my ($self) = @_;	1675	my ($self) = @_;
1638		1676
…		…
1765		1803
1766	sub new {	1804	sub new {
1767	my $class = shift;	1805	my $class = shift;
1768		1806
1769	$class->SUPER::new (	1807	$class->SUPER::new (
1770	padding => 4,	1808	padding_x => 4,
		1809	padding_y => 4,
1771	fg => [1, 1, 1],	1810	fg => [1, 1, 1],
1772	active_fg => [0, 0, 1],	1811	active_fg => [0, 0, 1],
1773	can_hover => 1,	1812	can_hover => 1,
1774	align => 0,	1813	align => 0,
1775	valign => 0,	1814	valign => 0,
…		…
1822		1861
1823	sub new {	1862	sub new {
1824	my $class = shift;	1863	my $class = shift;
1825		1864
1826	$class->SUPER::new (	1865	$class->SUPER::new (
1827	padding => 2,	1866	padding_x => 2,
		1867	padding_y => 2,
1828	fg => [1, 1, 1],	1868	fg => [1, 1, 1],
1829	active_fg => [1, 1, 0],	1869	active_fg => [1, 1, 0],
1830	bg => [0, 0, 0, 0.2],	1870	bg => [0, 0, 0, 0.2],
1831	active_bg => [1, 1, 1, 0.5],	1871	active_bg => [1, 1, 1, 0.5],
1832	state => 0,	1872	state => 0,
…		…
1836	}	1876	}
1837		1877
1838	sub size_request {	1878	sub size_request {
1839	my ($self) = @_;	1879	my ($self) = @_;
1840		1880
1841	($self->{padding} * 2 + 6) x 2	1881	(6) x 2
1842	}	1882	}
1843		1883
1844	sub button_down {	1884	sub button_down {
1845	my ($self, $ev, $x, $y) = @_;	1885	my ($self, $ev, $x, $y) = @_;
1846		1886
1847	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1848	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1849	$self->{state} = !$self->{state};	1889	$self->{state} = !$self->{state};
1850	$self->_emit (changed => $self->{state});	1890	$self->_emit (changed => $self->{state});
1851	}	1891	}
1852	}	1892	}
1853		1893
1854	sub _draw {	1894	sub _draw {
1855	my ($self) = @_;	1895	my ($self) = @_;
1856		1896
1857	$self->SUPER::_draw;	1897	$self->SUPER::_draw;
1858		1898
1859	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1899	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1860		1900
1861	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1901	my ($w, $h) = @$self{qw(w h)};
		1902
		1903	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1862		1904
1863	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1905	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1864		1906
1865	my $tex = $self->{state} ? $tex[1] : $tex[0];	1907	my $tex = $self->{state} ? $tex[1] : $tex[0];
1866		1908
…		…
2131	fg => [1, 1, 1],	2173	fg => [1, 1, 1],
2132	active_fg => [0, 0, 0],	2174	active_fg => [0, 0, 0],
2133	bg => [0, 0, 0, 0.2],	2175	bg => [0, 0, 0, 0.2],
2134	active_bg => [1, 1, 1, 0.5],	2176	active_bg => [1, 1, 1, 0.5],
2135	range => [0, 0, 100, 10, 0],	2177	range => [0, 0, 100, 10, 0],
2136	req_w => $::WIDTH / 80,	2178	min_w => $::WIDTH / 80,
2137	req_h => $::WIDTH / 80,	2179	min_h => $::WIDTH / 80,
2138	vertical => 0,	2180	vertical => 0,
2139	can_hover => 1,	2181	can_hover => 1,
2140	inner_pad => 0.02,	2182	inner_pad => 0.02,
2141	@_	2183	@_
2142	);	2184	);
…		…
2145	$self->update;	2187	$self->update;
2146		2188
2147	$self	2189	$self
2148	}	2190	}
2149		2191
		2192	sub changed { }
		2193
2150	sub set_range {	2194	sub set_range {
2151	my ($self, $range) = @_;	2195	my ($self, $range) = @_;
2152		2196
2153	($range, $self->{range}) = ($self->{range}, $range);	2197	($range, $self->{range}) = ($self->{range}, $range);
2154		2198
…		…
2180	}	2224	}
2181		2225
2182	sub size_request {	2226	sub size_request {
2183	my ($self) = @_;	2227	my ($self) = @_;
2184		2228
2185	my $w = $self->{req_w};	2229	($self->{req_w}, $self->{req_h})
2186	my $h = $self->{req_h};
2187
2188	$self->{vertical} ? ($h, $w) : ($w, $h)
2189	}	2230	}
2190		2231
2191	sub button_down {	2232	sub button_down {
2192	my ($self, $ev, $x, $y) = @_;	2233	my ($self, $ev, $x, $y) = @_;
2193		2234
…		…
2544		2585
2545	sub new {	2586	sub new {
2546	my $class = shift;	2587	my $class = shift;
2547		2588
2548	my $self = $class->SUPER::new (	2589	my $self = $class->SUPER::new (
2549	state => 0,	2590	state => 0,
2550	connect_activate => \&toggle_flopper,	2591	on_activate => \&toggle_flopper,
2551	@_	2592	@_
2552	);	2593	);
2553		2594
2554	if ($self->{state}) {
2555	$self->{state} = 0;
2556	$self->toggle_flopper;
2557	}
2558
2559	$self	2595	$self
2560	}	2596	}
2561		2597
2562	sub toggle_flopper {	2598	sub toggle_flopper {
2563	my ($self) = @_;	2599	my ($self) = @_;
2564		2600
2565	# TODO: use animation	2601	$self->{other}->toggle_visibility;
2566	if ($self->{state} = !$self->{state}) {
2567	$CFClient::UI::ROOT->add ($self->{other});
2568	$self->{other}->move ($self->coord2global (0, $self->{h}));
2569	$self->_emit ("open");
2570	} else {
2571	$CFClient::UI::ROOT->remove ($self->{other});
2572	$self->_emit ("close");
2573	}
2574
2575	$self->_emit (changed => $self->{state});
2576	}	2602	}
2577		2603
2578	#############################################################################	2604	#############################################################################
2579		2605
2580	package CFClient::UI::Tooltip;	2606	package CFClient::UI::Tooltip;
…		…
2593	}	2619	}
2594		2620
2595	sub set_tooltip_from {	2621	sub set_tooltip_from {
2596	my ($self, $widget) = @_;	2622	my ($self, $widget) = @_;
2597		2623
		2624	my $tooltip = $widget->{tooltip};
		2625
		2626	if ($ENV{CFPLUS_DEBUG} & 2) {
		2627	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2628	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2629	. "req $widget->{req_w} $widget->{req_h}\n"
		2630	. "visible $widget->{visible}";
		2631	}
		2632
2598	$self->add (new CFClient::UI::Label	2633	$self->add (new CFClient::UI::Label
2599	markup => $widget->{tooltip},	2634	markup => $tooltip,
2600	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2635	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2601	fontsize => 0.8,	2636	fontsize => 0.8,
2602	fg => [0, 0, 0, 1],	2637	fg => [0, 0, 0, 1],
2603	ellipsise => 0,	2638	ellipsise => 0,
2604	font => ($widget->{tooltip_font} || $::FONT_PROP),	2639	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2615		2650
2616	sub size_allocate {	2651	sub size_allocate {
2617	my ($self, $w, $h) = @_;	2652	my ($self, $w, $h) = @_;
2618		2653
2619	$self->SUPER::size_allocate ($w - 4, $h - 4);	2654	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2655	}
		2656
		2657	sub visibility_change {
		2658	my ($self, $visible) = @_;
		2659
		2660	return unless $visible;
		2661
		2662	$self->{root}->on_post_alloc ("move_$self" => sub {
		2663	my $widget = $self->{owner}
		2664	or return;
		2665
		2666	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2667
		2668	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2669	if $x + $self->{w} > $::WIDTH;
		2670
		2671	$self->move_abs ($x, $y);
		2672	});
2620	}	2673	}
2621		2674
2622	sub _draw {	2675	sub _draw {
2623	my ($self) = @_;	2676	my ($self) = @_;
2624		2677
…		…
2641	glVertex $w, $h;	2694	glVertex $w, $h;
2642	glVertex $w, 0;	2695	glVertex $w, 0;
2643	glEnd;	2696	glEnd;
2644		2697
2645	glTranslate 2 - 0.375, 2 - 0.375;	2698	glTranslate 2 - 0.375, 2 - 0.375;
		2699
2646	$self->SUPER::_draw;	2700	$self->SUPER::_draw;
2647	}	2701	}
2648		2702
2649	#############################################################################	2703	#############################################################################
2650		2704
…		…
2766		2820
2767	$row++;	2821	$row++;
2768	}	2822	}
2769	}	2823	}
2770		2824
2771	sub size_request {
2772	my ($self) = @_;
2773	($self->{req_w}, $self->{req_h});
2774	}
2775
2776	#############################################################################	2825	#############################################################################
2777		2826
2778	package CFClient::UI::Menu;	2827	package CFClient::UI::Menu;
2779		2828
2780	our @ISA = CFClient::UI::FancyFrame::;	2829	our @ISA = CFClient::UI::FancyFrame::;
…		…
2820	# maybe save $GRAB? must be careful about events...	2869	# maybe save $GRAB? must be careful about events...
2821	$GRAB = $self;	2870	$GRAB = $self;
2822	$self->{button} = $ev->{button};	2871	$self->{button} = $ev->{button};
2823		2872
2824	$self->show;	2873	$self->show;
2825	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2874	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2826	}	2875	}
2827		2876
2828	sub mouse_motion {	2877	sub mouse_motion {
2829	my ($self, $ev, $x, $y) = @_;	2878	my ($self, $ev, $x, $y) = @_;
2830		2879
…		…
2964	use CFClient::OpenGL;	3013	use CFClient::OpenGL;
2965		3014
2966	sub new {	3015	sub new {
2967	my $class = shift;	3016	my $class = shift;
2968		3017
2969	$class->SUPER::new (	3018	my $self = $class->SUPER::new (
2970	visible => 1,	3019	visible => 1,
2971	@_,	3020	@_,
2972	)	3021	);
2973	}
2974		3022
2975	sub configure {	3023	Scalar::Util::weaken ($self->{root} = $self);
2976	my ($self, $x, $y, $w, $h) = @_;
2977		3024
2978	$self->{w} = $w;	3025	$self
2979	$self->{h} = $h;
2980	}
2981
2982	sub check_size {
2983	my ($self) = @_;
2984
2985	$self->size_allocate ($self->{w}, $self->{h})
2986	if $self->{w};
2987	}	3026	}
2988		3027
2989	sub size_request {	3028	sub size_request {
2990	my ($self) = @_;	3029	my ($self) = @_;
2991		3030
2992	($self->{w}, $self->{h})	3031	($self->{w}, $self->{h})
		3032	}
		3033
		3034	sub _to_pixel {
		3035	my ($coord, $size, $max) = @_;
		3036
		3037	$coord =
		3038	$coord eq "center" ? ($max - $size) * 0.5
		3039	: $coord eq "max" ? $max
		3040	: $coord;
		3041
		3042	$coord = 0 if $coord < 0;
		3043	$coord = $max - $size if $coord > $max - $size;
		3044
		3045	int $coord + 0.5
2993	}	3046	}
2994		3047
2995	sub size_allocate {	3048	sub size_allocate {
2996	my ($self, $w, $h) = @_;	3049	my ($self, $w, $h) = @_;
2997		3050
2998	for my $child ($self->children) {	3051	for my $child ($self->children) {
2999	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3052	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3000		3053
3001	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3054	$X = $child->{force_x} if exists $child->{force_x};
3002	if exists $child->{req_x};	3055	$Y = $child->{force_y} if exists $child->{force_y};
3003		3056
3004	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3057	$X = _to_pixel $X, $W, $self->{w};
3005	if exists $child->{req_y};	3058	$Y = _to_pixel $Y, $H, $self->{h};
3006
3007	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3008	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3009		3059
3010	$child->configure ($X, $Y, $W, $H);	3060	$child->configure ($X, $Y, $W, $H);
3011	}	3061	}
3012	}	3062	}
3013		3063
…		…
3024	}	3074	}
3025		3075
3026	sub update {	3076	sub update {
3027	my ($self) = @_;	3077	my ($self) = @_;
3028		3078
3029	$self->check_size;
3030	$::WANT_REFRESH++;	3079	$::WANT_REFRESH++;
3031	}	3080	}
3032		3081
3033	sub add {	3082	sub add {
3034	my ($self, @children) = @_;	3083	my ($self, @children) = @_;
3035		3084
3036	for (my @widgets = @children; my $w = pop @widgets; ) {
3037	push @widgets, $w->children;
3038	$w->{root} = $self;
3039	$w->{visible} = $self->{visible} + 1;
3040	}
3041
3042	for my $child (@children) {
3043	$child->{is_toplevel} = 1;	3085	$_->{is_toplevel} = 1
3044		3086	for @children;
3045	# integerise window positions
3046	$child->{x} = int $child->{x};
3047	$child->{y} = int $child->{y};
3048	}
3049		3087
3050	$self->SUPER::add (@children);	3088	$self->SUPER::add (@children);
3051	}	3089	}
3052		3090
3053	sub remove {	3091	sub remove {
3054	my ($self, @children) = @_;	3092	my ($self, @children) = @_;
3055		3093
3056	$self->SUPER::remove (@children);	3094	$self->SUPER::remove (@children);
		3095
		3096	delete $self->{is_toplevel}
		3097	for @children;
3057		3098
3058	while (@children) {	3099	while (@children) {
3059	my $w = pop @children;	3100	my $w = pop @children;
3060	push @children, $w->children;	3101	push @children, $w->children;
3061	$w->set_invisible;	3102	$w->set_invisible;
…		…
3080	while ($self->{refresh_hook}) {	3121	while ($self->{refresh_hook}) {
3081	$_->()	3122	$_->()
3082	for values %{delete $self->{refresh_hook}};	3123	for values %{delete $self->{refresh_hook}};
3083	}	3124	}
3084		3125
3085	if ($self->{check_size}) {	3126	if ($self->{realloc}) {
3086	my @queue = ([], []);	3127	my @queue;
3087		3128
3088	for (;;) {	3129	while () {
3089	if ($self->{check_size}) {	3130	if ($self->{realloc}) {
3090	# heuristic: check containers last	3131	#TODO use array-of-depth approach
3091	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3132
3092	for values %{delete $self->{check_size}}	3133	use sort 'stable';
		3134
		3135	@queue = sort { $a->{visible} <=> $b->{visible} }
		3136	@queue, values %{delete $self->{realloc}};
3093	}	3137	}
3094		3138
3095	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3139	my $widget = pop @queue || last;
3096		3140
3097	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3141	$widget->{visible} or last; # do not resize invisible widgets
3098	? @$widget{qw(user_w user_h)}	3142
3099	: $widget->size_request;	3143	my ($w, $h) = $widget->size_request;
3100		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
3101	if (delete $widget->{force_alloc}	3152	|| delete $widget->{force_realloc}) {
3102	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3103	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3104
3105	$widget->{req_w} = $w;	3153	$widget->{req_w} = $w;
3106	$widget->{req_h} = $h;	3154	$widget->{req_h} = $h;
3107		3155
3108	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3156	$self->{size_alloc}{$widget+0} = $widget;
3109		3157
3110	$widget->{parent}->check_size
3111	if $widget->{parent};	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	}
3112	}	3164	}
		3165
		3166	delete $self->{realloc}{$widget+0};
3113	}	3167	}
3114	}	3168	}
3115		3169
3116	while ($self->{size_alloc}) {	3170	while (my $size_alloc = delete $self->{size_alloc}) {
3117	for (values %{delete $self->{size_alloc}}) {	3171	my @queue = sort { $b->{visible} <=> $a->{visible} }
3118	my ($widget, $w, $h) = @$_;	3172	values %$size_alloc;
		3173
		3174	while () {
		3175	my $widget = pop @queue || last;
		3176
		3177	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3119		3178
3120	$w = 0 if $w < 0;	3179	$w = 0 if $w < 0;
3121	$h = 0 if $h < 0;	3180	$h = 0 if $h < 0;
3122		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}) {
3123	$widget->{w} = $w;	3186	$widget->{w} = $w;
3124	$widget->{h} = $h;	3187	$widget->{h} = $h;
		3188
3125	$widget->emit (size_allocate => $w, $h);	3189	$widget->emit (size_allocate => $w, $h);
		3190	}
3126	}	3191	}
3127	}	3192	}
3128		3193
3129	while ($self->{post_alloc_hook}) {	3194	while ($self->{post_alloc_hook}) {
3130	$_->()	3195	$_->()
3131	for values %{delete $self->{post_alloc_hook}};	3196	for values %{delete $self->{post_alloc_hook}};
3132	}	3197	}
		3198
3133		3199
3134	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3135	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3136	glClear GL_COLOR_BUFFER_BIT;	3202	glClear GL_COLOR_BUFFER_BIT;
3137		3203
…		…
3144	$self->_draw;	3210	$self->_draw;
3145	}	3211	}
3146		3212
3147	#############################################################################	3213	#############################################################################
3148		3214
		3215	package CFClient::UI::BindEditor;
		3216
		3217	our @ISA = CFClient::UI::FancyFrame::;
		3218
		3219	sub new {
		3220	my $class = shift;
		3221
		3222	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3223
		3224	$self->add (my $vb = new CFClient::UI::VBox);
		3225
		3226
		3227	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3228	text => "start recording",
		3229	tooltip => "Start/Stops recording of actions."
		3230	."All subsequent actions after the recording started will be captured."
		3231	."The actions are displayed after the record was stopped."
		3232	."To bind the action you have to click on the 'Bind' button",
		3233	on_activate => sub {
		3234	unless ($self->{recording}) {
		3235	$self->start;
		3236	} else {
		3237	$self->stop;
		3238	}
		3239	});
		3240
		3241	$vb->add (new CFClient::UI::Label text => "Actions:");
		3242	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3243
		3244	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3245	$vb->add (my $hb = new CFClient::UI::HBox);
		3246	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3247	$hb->add (new CFClient::UI::Button
		3248	text => "bind",
		3249	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3250	on_activate => sub {
		3251	$self->ask_for_bind;
		3252	});
		3253
		3254	$vb->add (my $hb = new CFClient::UI::HBox);
		3255	$hb->add (new CFClient::UI::Button
		3256	text => "ok",
		3257	expand => 1,
		3258	tooltip => "This closes the binding editor and saves the binding",
		3259	on_activate => sub {
		3260	$self->hide;
		3261	$self->commit;
		3262	});
		3263
		3264	$hb->add (new CFClient::UI::Button
		3265	text => "cancel",
		3266	expand => 1,
		3267	tooltip => "This closes the binding editor without saving",
		3268	on_activate => sub {
		3269	$self->hide;
		3270	$self->{binding_cancel}->()
		3271	if $self->{binding_cancel};
		3272	});
		3273
		3274	$self->update_binding_widgets;
		3275
		3276	$self
		3277	}
		3278
		3279	sub commit {
		3280	my ($self) = @_;
		3281	my ($mod, $sym, $cmds) = $self->get_binding;
		3282	if ($sym != 0 && @$cmds > 0) {
		3283	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3284	."'. Don't forget 'Save Config'!");
		3285	$self->{binding_change}->($mod, $sym, $cmds)
		3286	if $self->{binding_change};
		3287	} else {
		3288	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3289	$self->{binding_cancel}->()
		3290	if $self->{binding_cancel};
		3291	}
		3292	}
		3293
		3294	sub start {
		3295	my ($self) = @_;
		3296
		3297	$self->{rec_btn}->set_text ("stop recording");
		3298	$self->{recording} = 1;
		3299	$self->clear_command_list;
		3300	$::CONN->start_record if $::CONN;
		3301	}
		3302
		3303	sub stop {
		3304	my ($self) = @_;
		3305
		3306	$self->{rec_btn}->set_text ("start recording");
		3307	$self->{recording} = 0;
		3308
		3309	my $rec;
		3310	$rec = $::CONN->stop_record if $::CONN;
		3311	return unless ref $rec eq 'ARRAY';
		3312	$self->set_command_list ($rec);
		3313	}
		3314
		3315	# if $commit is true, the binding will be set after the user entered a key combo
		3316	sub ask_for_bind {
		3317	my ($self, $commit) = @_;
		3318
		3319	CFClient::Binder::open_binding_dialog (sub {
		3320	my ($mod, $sym) = @_;
		3321	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3322	$self->update_binding_widgets;
		3323	$self->commit if $commit;
		3324	});
		3325	}
		3326
		3327	# $mod and $sym are the modifiers and key symbol
		3328	# $cmds is a array ref of strings (the commands)
		3329	# $cb is the callback that is executed on OK
		3330	# $ccb is the callback that is executed on CANCEL and
		3331	# when the binding was unsuccessful on OK
		3332	sub set_binding {
		3333	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3334
		3335	$self->clear_command_list;
		3336	$self->{recording} = 0;
		3337	$self->{rec_btn}->set_text ("start recording");
		3338
		3339	$self->{binding} = [$mod, $sym];
		3340	$self->{commands} = $cmds;
		3341
		3342	$self->{binding_change} = $cb;
		3343	$self->{binding_cancel} = $ccb;
		3344
		3345	$self->update_binding_widgets;
		3346	}
		3347
		3348	# this is a shortcut method that asks for a binding
		3349	# and then just binds it.
		3350	sub do_quick_binding {
		3351	my ($self, $cmds) = @_;
		3352	$self->set_binding (undef, undef, $cmds, sub {
		3353	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3354	});
		3355	$self->ask_for_bind (1);
		3356	}
		3357
		3358	sub update_binding_widgets {
		3359	my ($self) = @_;
		3360	my ($mod, $sym, $cmds) = $self->get_binding;
		3361	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3362	$self->set_command_list ($cmds);
		3363	}
		3364
		3365	sub get_binding {
		3366	my ($self) = @_;
		3367	return (
		3368	$self->{binding}->[0],
		3369	$self->{binding}->[1],
		3370	[ grep { defined $_ } @{$self->{commands}} ]
		3371	);
		3372	}
		3373
		3374	sub clear_command_list {
		3375	my ($self) = @_;
		3376	$self->{cmdbox}->clear ();
		3377	}
		3378
		3379	sub set_command_list {
		3380	my ($self, $cmds) = @_;
		3381
		3382	$self->{cmdbox}->clear ();
		3383	$self->{commands} = $cmds;
		3384
		3385	my $idx = 0;
		3386
		3387	for (@$cmds) {
		3388	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3389
		3390	my $i = $idx;
		3391	$hb->add (new CFClient::UI::Button
		3392	text => "delete",
		3393	tooltip => "Deletes the action from the record",
		3394	on_activate => sub {
		3395	$self->{cmdbox}->remove ($hb);
		3396	$cmds->[$i] = undef;
		3397	});
		3398
		3399	$hb->add (new CFClient::UI::Label text => $_);
		3400
		3401	$idx++
		3402	}
		3403	}
		3404
		3405
		3406	#############################################################################
		3407
		3408	package CFClient::UI::SpellList;
		3409
		3410	our @ISA = CFClient::UI::FancyFrame::;
		3411
		3412	sub new {
		3413	my $class = shift;
		3414
		3415	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3416
		3417	$self->add (new CFClient::UI::ScrolledWindow
		3418	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3419
		3420	$self;
		3421	}
		3422
		3423	# XXX: Do sorting? Argl...
		3424	sub add_spell {
		3425	my ($self, $spell) = @_;
		3426	$self->{spells}->{$spell->{name}} = $spell;
		3427
		3428	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3429	face => $spell->{face},
		3430	can_hover => 1,
		3431	can_events => 1,
		3432	tooltip => $spell->{message});
		3433
		3434	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3435	text => $spell->{name},
		3436	can_hover => 1,
		3437	can_events => 1,
		3438	tooltip => $spell->{message},
		3439	expand => 1);
		3440	$self->{spellbox}->add (2, $self->{tbl_idx}++, new CFClient::UI::Button
		3441	text => "bind to key",
		3442	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3443	}
		3444
		3445	sub rebuild_spell_list {
		3446	my ($self) = @_;
		3447	$self->{tbl_idx} = 0;
		3448	$self->add_spell ($_) for values %{$self->{spells}};
		3449	}
		3450
		3451	sub remove_spell {
		3452	my ($self, $spell) = @_;
		3453	delete $self->{spells}->{$spell->{name}};
		3454	$self->rebuild_spell_list;
		3455	}
		3456
		3457	#############################################################################
		3458
3149	package CFClient::UI;	3459	package CFClient::UI;
3150		3460
3151	$ROOT = new CFClient::UI::Root;	3461	$ROOT = new CFClient::UI::Root;
3152	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	3462	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3153		3463

Diff Legend

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