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.264 by root, Thu Jun 1 02:58:30 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
1488	delete $self->{texture};	1527	delete $self->{texture}
		1528	;#d#
1489	}	1529	}
1490		1530
1491	sub set_fontsize {	1531	sub set_fontsize {
1492	my ($self, $fontsize) = @_;	1532	my ($self, $fontsize) = @_;
1493		1533
1494	$self->{fontsize} = $fontsize;	1534	$self->{fontsize} = $fontsize;
1495	delete $self->{texture};	1535	delete $self->{texture};
1496		1536
1497	$self->update;	1537	$self->realloc;
1498	$self->check_size;
1499	}	1538	}
1500		1539
1501	sub _draw {	1540	sub _draw {
1502	my ($self) = @_;	1541	my ($self) = @_;
1503		1542
…		…
1511	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1550	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1512	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1551	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1513		1552
1514	my $tex = new_from_layout CFClient::Texture $self->{layout};	1553	my $tex = new_from_layout CFClient::Texture $self->{layout};
1515		1554
1516	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1555	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1517	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1556	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1518	: ($self->{w} - $tex->{w}) * 0.5);	1557	: ($self->{w} - $tex->{w}) * 0.5);
1519		1558
1520	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1559	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1521	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1560	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1522	: ($self->{h} - $tex->{h}) * 0.5);	1561	: ($self->{h} - $tex->{h}) * 0.5);
1523		1562
1524	$tex	1563	$tex
1525	};	1564	};
1526		1565
…		…
1583	sub set_text {	1622	sub set_text {
1584	my ($self, $text) = @_;	1623	my ($self, $text) = @_;
1585		1624
1586	$self->{cursor} = length $text;	1625	$self->{cursor} = length $text;
1587	$self->_set_text ($text);	1626	$self->_set_text ($text);
1588	$self->update;	1627
1589	$self->check_size;	1628	$self->realloc;
1590	}	1629	}
1591		1630
1592	sub get_text {	1631	sub get_text {
1593	$_[0]{text}	1632	$_[0]{text}
1594	}	1633	}
…		…
1627	} elsif ($uni) {	1666	} elsif ($uni) {
1628	substr $text, $self->{cursor}++, 0, chr $uni;	1667	substr $text, $self->{cursor}++, 0, chr $uni;
1629	}	1668	}
1630		1669
1631	$self->_set_text ($text);	1670	$self->_set_text ($text);
1632	$self->update;	1671
1633	$self->check_size;	1672	$self->realloc;
1634	}	1673	}
1635		1674
1636	sub focus_in {	1675	sub focus_in {
1637	my ($self) = @_;	1676	my ($self) = @_;
1638		1677
…		…
1765		1804
1766	sub new {	1805	sub new {
1767	my $class = shift;	1806	my $class = shift;
1768		1807
1769	$class->SUPER::new (	1808	$class->SUPER::new (
1770	padding => 4,	1809	padding_x => 4,
		1810	padding_y => 4,
1771	fg => [1, 1, 1],	1811	fg => [1, 1, 1],
1772	active_fg => [0, 0, 1],	1812	active_fg => [0, 0, 1],
1773	can_hover => 1,	1813	can_hover => 1,
1774	align => 0,	1814	align => 0,
1775	valign => 0,	1815	valign => 0,
…		…
1822		1862
1823	sub new {	1863	sub new {
1824	my $class = shift;	1864	my $class = shift;
1825		1865
1826	$class->SUPER::new (	1866	$class->SUPER::new (
1827	padding => 2,	1867	padding_x => 2,
		1868	padding_y => 2,
1828	fg => [1, 1, 1],	1869	fg => [1, 1, 1],
1829	active_fg => [1, 1, 0],	1870	active_fg => [1, 1, 0],
1830	bg => [0, 0, 0, 0.2],	1871	bg => [0, 0, 0, 0.2],
1831	active_bg => [1, 1, 1, 0.5],	1872	active_bg => [1, 1, 1, 0.5],
1832	state => 0,	1873	state => 0,
…		…
1836	}	1877	}
1837		1878
1838	sub size_request {	1879	sub size_request {
1839	my ($self) = @_;	1880	my ($self) = @_;
1840		1881
1841	($self->{padding} * 2 + 6) x 2	1882	(6) x 2
1842	}	1883	}
1843		1884
1844	sub button_down {	1885	sub button_down {
1845	my ($self, $ev, $x, $y) = @_;	1886	my ($self, $ev, $x, $y) = @_;
1846		1887
1847	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1888	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1848	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1889	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1849	$self->{state} = !$self->{state};	1890	$self->{state} = !$self->{state};
1850	$self->_emit (changed => $self->{state});	1891	$self->_emit (changed => $self->{state});
1851	}	1892	}
1852	}	1893	}
1853		1894
1854	sub _draw {	1895	sub _draw {
1855	my ($self) = @_;	1896	my ($self) = @_;
1856		1897
1857	$self->SUPER::_draw;	1898	$self->SUPER::_draw;
1858		1899
1859	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1900	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1860		1901
1861	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1902	my ($w, $h) = @$self{qw(w h)};
		1903
		1904	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1862		1905
1863	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1906	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1864		1907
1865	my $tex = $self->{state} ? $tex[1] : $tex[0];	1908	my $tex = $self->{state} ? $tex[1] : $tex[0];
1866		1909
…		…
2131	fg => [1, 1, 1],	2174	fg => [1, 1, 1],
2132	active_fg => [0, 0, 0],	2175	active_fg => [0, 0, 0],
2133	bg => [0, 0, 0, 0.2],	2176	bg => [0, 0, 0, 0.2],
2134	active_bg => [1, 1, 1, 0.5],	2177	active_bg => [1, 1, 1, 0.5],
2135	range => [0, 0, 100, 10, 0],	2178	range => [0, 0, 100, 10, 0],
2136	req_w => $::WIDTH / 80,	2179	min_w => $::WIDTH / 80,
2137	req_h => $::WIDTH / 80,	2180	min_h => $::WIDTH / 80,
2138	vertical => 0,	2181	vertical => 0,
2139	can_hover => 1,	2182	can_hover => 1,
2140	inner_pad => 0.02,	2183	inner_pad => 0.02,
2141	@_	2184	@_
2142	);	2185	);
…		…
2145	$self->update;	2188	$self->update;
2146		2189
2147	$self	2190	$self
2148	}	2191	}
2149		2192
		2193	sub changed { }
		2194
2150	sub set_range {	2195	sub set_range {
2151	my ($self, $range) = @_;	2196	my ($self, $range) = @_;
2152		2197
2153	($range, $self->{range}) = ($self->{range}, $range);	2198	($range, $self->{range}) = ($self->{range}, $range);
2154		2199
…		…
2180	}	2225	}
2181		2226
2182	sub size_request {	2227	sub size_request {
2183	my ($self) = @_;	2228	my ($self) = @_;
2184		2229
2185	my $w = $self->{req_w};	2230	($self->{req_w}, $self->{req_h})
2186	my $h = $self->{req_h};
2187
2188	$self->{vertical} ? ($h, $w) : ($w, $h)
2189	}	2231	}
2190		2232
2191	sub button_down {	2233	sub button_down {
2192	my ($self, $ev, $x, $y) = @_;	2234	my ($self, $ev, $x, $y) = @_;
2193		2235
…		…
2544		2586
2545	sub new {	2587	sub new {
2546	my $class = shift;	2588	my $class = shift;
2547		2589
2548	my $self = $class->SUPER::new (	2590	my $self = $class->SUPER::new (
2549	state => 0,	2591	state => 0,
2550	connect_activate => \&toggle_flopper,	2592	on_activate => \&toggle_flopper,
2551	@_	2593	@_
2552	);	2594	);
2553		2595
2554	if ($self->{state}) {
2555	$self->{state} = 0;
2556	$self->toggle_flopper;
2557	}
2558
2559	$self	2596	$self
2560	}	2597	}
2561		2598
2562	sub toggle_flopper {	2599	sub toggle_flopper {
2563	my ($self) = @_;	2600	my ($self) = @_;
2564		2601
2565	# TODO: use animation	2602	$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	}	2603	}
2577		2604
2578	#############################################################################	2605	#############################################################################
2579		2606
2580	package CFClient::UI::Tooltip;	2607	package CFClient::UI::Tooltip;
…		…
2593	}	2620	}
2594		2621
2595	sub set_tooltip_from {	2622	sub set_tooltip_from {
2596	my ($self, $widget) = @_;	2623	my ($self, $widget) = @_;
2597		2624
		2625	my $tooltip = $widget->{tooltip};
		2626
		2627	if ($ENV{CFPLUS_DEBUG} & 2) {
		2628	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2629	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2630	. "req $widget->{req_w} $widget->{req_h}\n"
		2631	. "visible $widget->{visible}";
		2632	}
		2633
2598	$self->add (new CFClient::UI::Label	2634	$self->add (new CFClient::UI::Label
2599	markup => $widget->{tooltip},	2635	markup => $tooltip,
2600	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2636	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2601	fontsize => 0.8,	2637	fontsize => 0.8,
2602	fg => [0, 0, 0, 1],	2638	fg => [0, 0, 0, 1],
2603	ellipsise => 0,	2639	ellipsise => 0,
2604	font => ($widget->{tooltip_font} || $::FONT_PROP),	2640	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2615		2651
2616	sub size_allocate {	2652	sub size_allocate {
2617	my ($self, $w, $h) = @_;	2653	my ($self, $w, $h) = @_;
2618		2654
2619	$self->SUPER::size_allocate ($w - 4, $h - 4);	2655	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2656	}
		2657
		2658	sub visibility_change {
		2659	my ($self, $visible) = @_;
		2660
		2661	return unless $visible;
		2662
		2663	$self->{root}->on_post_alloc ("move_$self" => sub {
		2664	my $widget = $self->{owner}
		2665	or return;
		2666
		2667	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2668
		2669	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2670	if $x + $self->{w} > $::WIDTH;
		2671
		2672	$self->move_abs ($x, $y);
		2673	});
2620	}	2674	}
2621		2675
2622	sub _draw {	2676	sub _draw {
2623	my ($self) = @_;	2677	my ($self) = @_;
2624		2678
…		…
2641	glVertex $w, $h;	2695	glVertex $w, $h;
2642	glVertex $w, 0;	2696	glVertex $w, 0;
2643	glEnd;	2697	glEnd;
2644		2698
2645	glTranslate 2 - 0.375, 2 - 0.375;	2699	glTranslate 2 - 0.375, 2 - 0.375;
		2700
2646	$self->SUPER::_draw;	2701	$self->SUPER::_draw;
2647	}	2702	}
2648		2703
2649	#############################################################################	2704	#############################################################################
2650		2705
…		…
2766		2821
2767	$row++;	2822	$row++;
2768	}	2823	}
2769	}	2824	}
2770		2825
2771	sub size_request {
2772	my ($self) = @_;
2773	($self->{req_w}, $self->{req_h});
2774	}
2775
2776	#############################################################################	2826	#############################################################################
2777		2827
2778	package CFClient::UI::Menu;	2828	package CFClient::UI::Menu;
2779		2829
2780	our @ISA = CFClient::UI::FancyFrame::;	2830	our @ISA = CFClient::UI::FancyFrame::;
…		…
2820	# maybe save $GRAB? must be careful about events...	2870	# maybe save $GRAB? must be careful about events...
2821	$GRAB = $self;	2871	$GRAB = $self;
2822	$self->{button} = $ev->{button};	2872	$self->{button} = $ev->{button};
2823		2873
2824	$self->show;	2874	$self->show;
2825	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2875	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2826	}	2876	}
2827		2877
2828	sub mouse_motion {	2878	sub mouse_motion {
2829	my ($self, $ev, $x, $y) = @_;	2879	my ($self, $ev, $x, $y) = @_;
2830		2880
…		…
2964	use CFClient::OpenGL;	3014	use CFClient::OpenGL;
2965		3015
2966	sub new {	3016	sub new {
2967	my $class = shift;	3017	my $class = shift;
2968		3018
2969	$class->SUPER::new (	3019	my $self = $class->SUPER::new (
2970	visible => 1,	3020	visible => 1,
2971	@_,	3021	@_,
2972	)	3022	);
2973	}
2974		3023
2975	sub configure {	3024	Scalar::Util::weaken ($self->{root} = $self);
2976	my ($self, $x, $y, $w, $h) = @_;
2977		3025
2978	$self->{w} = $w;	3026	$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	}	3027	}
2988		3028
2989	sub size_request {	3029	sub size_request {
2990	my ($self) = @_;	3030	my ($self) = @_;
2991		3031
2992	($self->{w}, $self->{h})	3032	($self->{w}, $self->{h})
		3033	}
		3034
		3035	sub _to_pixel {
		3036	my ($coord, $size, $max) = @_;
		3037
		3038	$coord =
		3039	$coord eq "center" ? ($max - $size) * 0.5
		3040	: $coord eq "max" ? $max
		3041	: $coord;
		3042
		3043	$coord = 0 if $coord < 0;
		3044	$coord = $max - $size if $coord > $max - $size;
		3045
		3046	int $coord + 0.5
2993	}	3047	}
2994		3048
2995	sub size_allocate {	3049	sub size_allocate {
2996	my ($self, $w, $h) = @_;	3050	my ($self, $w, $h) = @_;
2997		3051
2998	for my $child ($self->children) {	3052	for my $child ($self->children) {
2999	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3053	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3000		3054
3001	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3055	$X = $child->{force_x} if exists $child->{force_x};
3002	if exists $child->{req_x};	3056	$Y = $child->{force_y} if exists $child->{force_y};
3003		3057
3004	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3058	$X = _to_pixel $X, $W, $self->{w};
3005	if exists $child->{req_y};	3059	$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		3060
3010	$child->configure ($X, $Y, $W, $H);	3061	$child->configure ($X, $Y, $W, $H);
3011	}	3062	}
3012	}	3063	}
3013		3064
…		…
3024	}	3075	}
3025		3076
3026	sub update {	3077	sub update {
3027	my ($self) = @_;	3078	my ($self) = @_;
3028		3079
3029	$self->check_size;
3030	$::WANT_REFRESH++;	3080	$::WANT_REFRESH++;
3031	}	3081	}
3032		3082
3033	sub add {	3083	sub add {
3034	my ($self, @children) = @_;	3084	my ($self, @children) = @_;
3035		3085
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;	3086	$_->{is_toplevel} = 1
3044		3087	for @children;
3045	# integerise window positions
3046	$child->{x} = int $child->{x};
3047	$child->{y} = int $child->{y};
3048	}
3049		3088
3050	$self->SUPER::add (@children);	3089	$self->SUPER::add (@children);
3051	}	3090	}
3052		3091
3053	sub remove {	3092	sub remove {
3054	my ($self, @children) = @_;	3093	my ($self, @children) = @_;
3055		3094
3056	$self->SUPER::remove (@children);	3095	$self->SUPER::remove (@children);
		3096
		3097	delete $self->{is_toplevel}
		3098	for @children;
3057		3099
3058	while (@children) {	3100	while (@children) {
3059	my $w = pop @children;	3101	my $w = pop @children;
3060	push @children, $w->children;	3102	push @children, $w->children;
3061	$w->set_invisible;	3103	$w->set_invisible;
…		…
3080	while ($self->{refresh_hook}) {	3122	while ($self->{refresh_hook}) {
3081	$_->()	3123	$_->()
3082	for values %{delete $self->{refresh_hook}};	3124	for values %{delete $self->{refresh_hook}};
3083	}	3125	}
3084		3126
3085	if ($self->{check_size}) {	3127	if ($self->{realloc}) {
3086	my @queue = ([], []);	3128	my @queue;
3087		3129
3088	for (;;) {	3130	while () {
3089	if ($self->{check_size}) {	3131	if ($self->{realloc}) {
3090	# heuristic: check containers last	3132	#TODO use array-of-depth approach
3091	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3133
3092	for values %{delete $self->{check_size}}	3134	use sort 'stable';
		3135
		3136	@queue = sort { $a->{visible} <=> $b->{visible} }
		3137	@queue, values %{delete $self->{realloc}};
3093	}	3138	}
3094		3139
3095	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3140	my $widget = pop @queue || last;
3096		3141
3097	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3142	$widget->{visible} or last; # do not resize invisible widgets
3098	? @$widget{qw(user_w user_h)}	3143
3099	: $widget->size_request;	3144	my ($w, $h) = $widget->size_request;
3100		3145
		3146	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3147	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3148
		3149	$w = $widget->{force_w} if exists $widget->{force_w};
		3150	$h = $widget->{force_h} if exists $widget->{force_h};
		3151
		3152	if ($widget->{req_w} != $w || $widget->{req_h} != $h
3101	if (delete $widget->{force_alloc}	3153	|| 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;	3154	$widget->{req_w} = $w;
3106	$widget->{req_h} = $h;	3155	$widget->{req_h} = $h;
3107		3156
3108	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3157	$self->{size_alloc}{$widget+0} = $widget;
3109		3158
3110	$widget->{parent}->check_size
3111	if $widget->{parent};	3159	if (my $parent = $widget->{parent}) {
		3160	$self->{realloc}{$parent+0} = $parent;
		3161	#unshift @queue, $parent;
		3162	$parent->{force_size_alloc} = 1;
		3163	$self->{size_alloc}{$parent+0} = $parent;
		3164	}
3112	}	3165	}
		3166
		3167	delete $self->{realloc}{$widget+0};
3113	}	3168	}
3114	}	3169	}
3115		3170
3116	while ($self->{size_alloc}) {	3171	while (my $size_alloc = delete $self->{size_alloc}) {
3117	for (values %{delete $self->{size_alloc}}) {	3172	my @queue = sort { $b->{visible} <=> $a->{visible} }
3118	my ($widget, $w, $h) = @$_;	3173	values %$size_alloc;
		3174
		3175	while () {
		3176	my $widget = pop @queue || last;
		3177
		3178	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3119		3179
3120	$w = 0 if $w < 0;	3180	$w = 0 if $w < 0;
3121	$h = 0 if $h < 0;	3181	$h = 0 if $h < 0;
3122		3182
		3183	$w = int $w + 0.5;
		3184	$h = int $h + 0.5;
		3185
		3186	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3123	$widget->{w} = $w;	3187	$widget->{w} = $w;
3124	$widget->{h} = $h;	3188	$widget->{h} = $h;
		3189
3125	$widget->emit (size_allocate => $w, $h);	3190	$widget->emit (size_allocate => $w, $h);
		3191	}
3126	}	3192	}
3127	}	3193	}
3128		3194
3129	while ($self->{post_alloc_hook}) {	3195	while ($self->{post_alloc_hook}) {
3130	$_->()	3196	$_->()
3131	for values %{delete $self->{post_alloc_hook}};	3197	for values %{delete $self->{post_alloc_hook}};
3132	}	3198	}
		3199
3133		3200
3134	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3201	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3135	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3202	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3136	glClear GL_COLOR_BUFFER_BIT;	3203	glClear GL_COLOR_BUFFER_BIT;
3137		3204
…		…
3144	$self->_draw;	3211	$self->_draw;
3145	}	3212	}
3146		3213
3147	#############################################################################	3214	#############################################################################
3148		3215
		3216	package CFClient::UI::SpellList;
		3217
		3218	our @ISA = CFClient::UI::FancyFrame::;
		3219
		3220	sub new {
		3221	my $class = shift;
		3222
		3223	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3224
		3225	$self->add (new CFClient::UI::ScrolledWindow
		3226	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3227
		3228	$self;
		3229	}
		3230
		3231	# XXX: Do sorting? Argl...
		3232	sub add_spell {
		3233	my ($self, $spell) = @_;
		3234	$self->{spells}->{$spell->{name}} = $spell;
		3235
		3236	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3237	face => $spell->{face},
		3238	can_hover => 1,
		3239	can_events => 1,
		3240	tooltip => $spell->{message});
		3241
		3242	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3243	text => $spell->{name},
		3244	can_hover => 1,
		3245	can_events => 1,
		3246	tooltip => $spell->{message},
		3247	expand => 1);
		3248
		3249	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3250	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3251	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3252	expand => 1);
		3253
		3254	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3255	text => "bind to key",
		3256	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3257	}
		3258
		3259	sub rebuild_spell_list {
		3260	my ($self) = @_;
		3261	$self->{tbl_idx} = 0;
		3262	$self->add_spell ($_) for values %{$self->{spells}};
		3263	}
		3264
		3265	sub remove_spell {
		3266	my ($self, $spell) = @_;
		3267	delete $self->{spells}->{$spell->{name}};
		3268	$self->rebuild_spell_list;
		3269	}
		3270
		3271	#############################################################################
		3272
		3273	package CFClient::UI::BindEditor;
		3274
		3275	our @ISA = CFClient::UI::FancyFrame::;
		3276
		3277	sub new {
		3278	my $class = shift;
		3279
		3280	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3281
		3282	$self->add (my $vb = new CFClient::UI::VBox);
		3283
		3284
		3285	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3286	text => "start recording",
		3287	tooltip => "Start/Stops recording of actions."
		3288	."All subsequent actions after the recording started will be captured."
		3289	."The actions are displayed after the record was stopped."
		3290	."To bind the action you have to click on the 'Bind' button",
		3291	on_activate => sub {
		3292	unless ($self->{recording}) {
		3293	$self->start;
		3294	} else {
		3295	$self->stop;
		3296	}
		3297	});
		3298
		3299	$vb->add (new CFClient::UI::Label text => "Actions:");
		3300	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3301
		3302	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3303	$vb->add (my $hb = new CFClient::UI::HBox);
		3304	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3305	$hb->add (new CFClient::UI::Button
		3306	text => "bind",
		3307	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3308	on_activate => sub {
		3309	$self->ask_for_bind;
		3310	});
		3311
		3312	$vb->add (my $hb = new CFClient::UI::HBox);
		3313	$hb->add (new CFClient::UI::Button
		3314	text => "ok",
		3315	expand => 1,
		3316	tooltip => "This closes the binding editor and saves the binding",
		3317	on_activate => sub {
		3318	$self->hide;
		3319	$self->commit;
		3320	});
		3321
		3322	$hb->add (new CFClient::UI::Button
		3323	text => "cancel",
		3324	expand => 1,
		3325	tooltip => "This closes the binding editor without saving",
		3326	on_activate => sub {
		3327	$self->hide;
		3328	$self->{binding_cancel}->()
		3329	if $self->{binding_cancel};
		3330	});
		3331
		3332	$self->update_binding_widgets;
		3333
		3334	$self
		3335	}
		3336
		3337	sub commit {
		3338	my ($self) = @_;
		3339	my ($mod, $sym, $cmds) = $self->get_binding;
		3340	if ($sym != 0 && @$cmds > 0) {
		3341	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3342	."'. Don't forget 'Save Config'!");
		3343	$self->{binding_change}->($mod, $sym, $cmds)
		3344	if $self->{binding_change};
		3345	} else {
		3346	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3347	$self->{binding_cancel}->()
		3348	if $self->{binding_cancel};
		3349	}
		3350	}
		3351
		3352	sub start {
		3353	my ($self) = @_;
		3354
		3355	$self->{rec_btn}->set_text ("stop recording");
		3356	$self->{recording} = 1;
		3357	$self->clear_command_list;
		3358	$::CONN->start_record if $::CONN;
		3359	}
		3360
		3361	sub stop {
		3362	my ($self) = @_;
		3363
		3364	$self->{rec_btn}->set_text ("start recording");
		3365	$self->{recording} = 0;
		3366
		3367	my $rec;
		3368	$rec = $::CONN->stop_record if $::CONN;
		3369	return unless ref $rec eq 'ARRAY';
		3370	$self->set_command_list ($rec);
		3371	}
		3372
		3373	# if $commit is true, the binding will be set after the user entered a key combo
		3374	sub ask_for_bind {
		3375	my ($self, $commit) = @_;
		3376
		3377	CFClient::Binder::open_binding_dialog (sub {
		3378	my ($mod, $sym) = @_;
		3379	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3380	$self->update_binding_widgets;
		3381	$self->commit if $commit;
		3382	});
		3383	}
		3384
		3385	# $mod and $sym are the modifiers and key symbol
		3386	# $cmds is a array ref of strings (the commands)
		3387	# $cb is the callback that is executed on OK
		3388	# $ccb is the callback that is executed on CANCEL and
		3389	# when the binding was unsuccessful on OK
		3390	sub set_binding {
		3391	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3392
		3393	$self->clear_command_list;
		3394	$self->{recording} = 0;
		3395	$self->{rec_btn}->set_text ("start recording");
		3396
		3397	$self->{binding} = [$mod, $sym];
		3398	$self->{commands} = $cmds;
		3399
		3400	$self->{binding_change} = $cb;
		3401	$self->{binding_cancel} = $ccb;
		3402
		3403	$self->update_binding_widgets;
		3404	}
		3405
		3406	# this is a shortcut method that asks for a binding
		3407	# and then just binds it.
		3408	sub do_quick_binding {
		3409	my ($self, $cmds) = @_;
		3410	$self->set_binding (undef, undef, $cmds, sub {
		3411	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3412	});
		3413	$self->ask_for_bind (1);
		3414	}
		3415
		3416	sub update_binding_widgets {
		3417	my ($self) = @_;
		3418	my ($mod, $sym, $cmds) = $self->get_binding;
		3419	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3420	$self->set_command_list ($cmds);
		3421	}
		3422
		3423	sub get_binding {
		3424	my ($self) = @_;
		3425	return (
		3426	$self->{binding}->[0],
		3427	$self->{binding}->[1],
		3428	[ grep { defined $_ } @{$self->{commands}} ]
		3429	);
		3430	}
		3431
		3432	sub clear_command_list {
		3433	my ($self) = @_;
		3434	$self->{cmdbox}->clear ();
		3435	}
		3436
		3437	sub set_command_list {
		3438	my ($self, $cmds) = @_;
		3439
		3440	$self->{cmdbox}->clear ();
		3441	$self->{commands} = $cmds;
		3442
		3443	my $idx = 0;
		3444
		3445	for (@$cmds) {
		3446	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3447
		3448	my $i = $idx;
		3449	$hb->add (new CFClient::UI::Label text => $_);
		3450	$hb->add (new CFClient::UI::Button
		3451	text => "delete",
		3452	tooltip => "Deletes the action from the record",
		3453	on_activate => sub {
		3454	$self->{cmdbox}->remove ($hb);
		3455	$cmds->[$i] = undef;
		3456	});
		3457
		3458
		3459	$idx++
		3460	}
		3461	}
		3462
		3463	#############################################################################
		3464
3149	package CFClient::UI;	3465	package CFClient::UI;
3150		3466
3151	$ROOT = new CFClient::UI::Root;	3467	$ROOT = new CFClient::UI::Root;
3152	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	3468	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3153		3469

Diff Legend

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