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.270 by elmex, Fri Jun 2 09:02:49 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
19		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	}
		43
20	sub check_tooltip {	44	sub check_tooltip {
		45	return if $ENV{CFPLUS_DEBUG} & 8;
		46
21	if (!$GRAB) {	47	if (!$GRAB) {
22	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	48	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
23	if (length $widget->{tooltip}) {	49	if (length $widget->{tooltip}) {
24
25	if ($TOOLTIP->{owner} != $widget) {	50	if ($TOOLTIP->{owner} != $widget) {
		51	$TOOLTIP->hide;
		52
26	$TOOLTIP->{owner} = $widget;	53	$TOOLTIP->{owner} = $widget;
27		54
28	my $tip = $widget->{tooltip};	55	my $tip = $widget->{tooltip};
29		56
30	$tip = $tip->($widget) if CODE:: eq ref $tip;	57	$tip = $tip->($widget) if CODE:: eq ref $tip;
31		58
32	$TOOLTIP->set_tooltip_from ($widget);	59	$TOOLTIP->set_tooltip_from ($widget);
33	$TOOLTIP->show;	60	$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	}	61	}
44		62
45	return;	63	return;
46	}	64	}
47	}	65	}
…		…
153	sub rescale_widgets {	171	sub rescale_widgets {
154	my ($sx, $sy) = @_;	172	my ($sx, $sy) = @_;
155		173
156	for my $widget (values %WIDGET) {	174	for my $widget (values %WIDGET) {
157	if ($widget->{is_toplevel}) {	175	if ($widget->{is_toplevel}) {
		176	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		177	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		178
158	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};	179	$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};	180	$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};	181	$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};	182	$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};	183	$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};	184	$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};	185
		186	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		187	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		188
166	}	189	}
167	}	190	}
168		191
169	reconfigure_widgets;	192	reconfigure_widgets;
170	}	193	}
…		…
179		202
180	sub new {	203	sub new {
181	my $class = shift;	204	my $class = shift;
182		205
183	my $self = bless {	206	my $self = bless {
184	x => 0,	207	x => "center",
185	y => 0,	208	y => "center",
186	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
187	can_events => 1,	212	can_events => 1,
188	@_	213	@_
189	}, $class;	214	}, $class;
190		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		217
191	for (keys %$self) {	218	for (keys %$self) {
192	if (/^connect_(.*)$/) {	219	if (/^on_(.*)$/) {
193	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
194	}	221	}
195	}	222	}
196		223
197	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		227	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		228	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		229
		230	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		231	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		232
		233	$self->show if $layout->{show};
		234	}
198		235
199	$self	236	$self
200	}	237	}
201		238
202	sub destroy {	239	sub destroy {
…		…
206	%$self = ();	243	%$self = ();
207	}	244	}
208		245
209	sub show {	246	sub show {
210	my ($self) = @_;	247	my ($self) = @_;
		248
211	return if $self->{parent};	249	return if $self->{parent};
212		250
213	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
214	}	252	}
215		253
216	sub show_centered {	254	sub set_visible {
217	my ($self) = @_;	255	my ($self) = @_;
		256
218	return if $self->{parent};	257	return if $self->{visible};
219		258
220	$self->show;	259	$self->{root} = $self->{parent}{root};
		260	$self->{visible} = $self->{parent}{visible} + 1;
221		261
222	$CFClient::UI::ROOT->on_post_alloc (	262	$self->emit (visibility_change => 1);
223	"centered $self" => sub {	263
224	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);	264	$self->realloc if !exists $self->{req_w};
225	},	265
226	);	266	$_->set_visible for $self->children;
227	}	267	}
228		268
229	sub set_invisible {	269	sub set_invisible {
230	my ($self) = @_;	270	my ($self) = @_;
231		271
232	# broken show/hide model	272	return unless $self->{visible};
		273
		274	$_->set_invisible for $self->children;
233		275
234	delete $self->{root};	276	delete $self->{root};
235	delete $self->{visible};	277	delete $self->{visible};
236		278
237	undef $GRAB if $GRAB == $self;	279	undef $GRAB if $GRAB == $self;
238	undef $HOVER if $HOVER == $self;	280	undef $HOVER if $HOVER == $self;
239		281
240	CFClient::UI::check_tooltip	282	CFClient::UI::check_tooltip
241	if $CFClient::UI::TOOLTIP->{owner} == $self;	283	if $TOOLTIP->{owner} == $self;
242		284
243	$self->focus_out;	285	$self->focus_out;
		286
		287	$self->emit (visibility_change => 0);
		288	}
		289
		290	sub set_visibility {
		291	my ($self, $visible) = @_;
		292
		293	return if $self->{visible} == $visible;
		294
		295	$visible ? $self->hide
		296	: $self->show;
		297	}
		298
		299	sub toggle_visibility {
		300	my ($self) = @_;
		301
		302	$self->{visible}
		303	? $self->hide
		304	: $self->show;
244	}	305	}
245		306
246	sub hide {	307	sub hide {
247	my ($self) = @_;	308	my ($self) = @_;
248		309
…		…
250		311
251	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
252	if $self->{parent};	313	if $self->{parent};
253	}	314	}
254		315
255	sub move {	316	sub move_abs {
256	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
257		318
258	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
259	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
260	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
261		322
262	$self->update;	323	$self->update;
263	}	324	}
264		325
265	sub set_size {	326	sub set_size {
266	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
267		328
268	$self->{user_w} = $w;	329	$self->{force_w} = $w;
269	$self->{user_h} = $h;	330	$self->{force_h} = $h;
270		331
271	$self->check_size;	332	$self->realloc;
272	}	333	}
273		334
274	sub size_request {	335	sub size_request {
275	require Carp;	336	require Carp;
276	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
278		339
279	sub configure {	340	sub configure {
280	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
281		342
282	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
283	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
284	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
285		348
286	# use alignment to adjust x, y	349	# use alignment to adjust x, y
287		350
288	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
289	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
290
291	($w, $h) = ($w2, $h2);
292	}	353	}
293		354
294	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
295	$self->{x} = $x;	356	$self->{x} = $x;
296	$self->{y} = $y;	357	$self->{y} = $y;
297	$self->update;	358	$self->update;
298	}	359	}
299		360
300	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
301	$CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h];	362	return unless $self->{visible};
		363
		364	$self->{alloc_w} = $w;
		365	$self->{alloc_h} = $h;
		366
		367	$self->{root}{size_alloc}{$self+0} = $self;
302	}	368	}
303	}	369	}
304		370
305	sub size_allocate {	371	sub size_allocate {
306	# nothing to be done	372	# nothing to be done
307	}
308
309	sub reconfigure {
310	my ($self) = @_;
311
312	$self->check_size (1);
313	$self->update;
314	}	373	}
315		374
316	sub children {	375	sub children {
317	}	376	}
318		377
…		…
391	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
392		451
393	$self->focus_in;	452	$self->focus_in;
394	}	453	}
395		454
396	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	455	sub find_widget {
397	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	456	my ($self, $x, $y) = @_;
398	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	457
399	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	458	return () unless $self->{can_events};
400	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	459
		460	return $self
		461	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		462	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		463
		464	()
		465	}
		466
		467	sub set_parent {
		468	my ($self, $parent) = @_;
		469
		470	Scalar::Util::weaken ($self->{parent} = $parent);
		471	$self->set_visible if $parent->{visible};
		472	}
		473
		474	sub connect {
		475	my ($self, $signal, $cb) = @_;
		476
		477	push @{ $self->{signal_cb}{$signal} }, $cb;
		478	}
		479
		480	sub _emit {
		481	my ($self, $signal, @args) = @_;
		482
		483	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		484	}
		485
		486	sub emit {
		487	my ($self, $signal, @args) = @_;
		488
		489	$self->_emit ($signal, @args)
		490	|| $self->$signal (@args);
		491	}
		492
		493	sub visibility_change {
		494	#my ($self, $visible) = @_;
		495	}
		496
		497	sub realloc {
		498	my ($self) = @_;
		499
		500	if ($self->{visible}) {
		501	return if $self->{root}{realloc}{$self+0};
		502
		503	$self->{root}{realloc}{$self+0} = $self;
		504	$self->{root}->update;
		505	} else {
		506	delete $self->{req_w};
		507	delete $self->{req_h};
		508	}
		509	}
		510
		511	sub update {
		512	my ($self) = @_;
		513
		514	$self->{parent}->update
		515	if $self->{parent};
		516	}
		517
		518	sub reconfigure {
		519	my ($self) = @_;
		520
		521	$self->realloc;
		522	$self->update;
		523	}
		524
		525	# using global variables seems a bit hacky, but passing through all drawing
		526	# functions seems pointless.
		527	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
401		528
402	sub draw {	529	sub draw {
403	my ($self) = @_;	530	my ($self) = @_;
404		531
405	return unless $self->{h} && $self->{w};	532	return unless $self->{h} && $self->{w};
		533
		534	# update screen rectangle
		535	local $draw_x = $draw_x + $self->{x};
		536	local $draw_y = $draw_y + $self->{y};
		537	local $draw_w = $draw_x + $self->{w};
		538	local $draw_h = $draw_y + $self->{h};
		539
		540	# skip widgets that are entirely outside the drawing area
		541	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		542	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
406		543
407	glPushMatrix;	544	glPushMatrix;
408	glTranslate $self->{x}, $self->{y}, 0;	545	glTranslate $self->{x}, $self->{y}, 0;
409	$self->_draw;	546	$self->_draw;
410	glPopMatrix;	547	glPopMatrix;
…		…
422	glVertex $x , $y + $self->{h};	559	glVertex $x , $y + $self->{h};
423	glEnd;	560	glEnd;
424	glDisable GL_BLEND;	561	glDisable GL_BLEND;
425	}	562	}
426		563
427	if ($ENV{PCLIENT_DEBUG}) {	564	if ($ENV{CFPLUS_DEBUG} & 1) {
428	glPushMatrix;	565	glPushMatrix;
429	glColor 1, 1, 0, 1;	566	glColor 1, 1, 0, 1;
430	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	567	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
431	glBegin GL_LINE_LOOP;	568	glBegin GL_LINE_LOOP;
432	glVertex 0 , 0;	569	glVertex 0 , 0;
…		…
443	my ($self) = @_;	580	my ($self) = @_;
444		581
445	warn "no draw defined for $self\n";	582	warn "no draw defined for $self\n";
446	}	583	}
447		584
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 {	585	sub DESTROY {
509	my ($self) = @_;	586	my ($self) = @_;
510		587
511	delete $WIDGET{$self+0};	588	delete $WIDGET{$self+0};
512	#$self->deactivate;	589	#$self->deactivate;
…		…
568	my ($class, %arg) = @_;	645	my ($class, %arg) = @_;
569	$class->SUPER::new (can_events => 0, %arg);	646	$class->SUPER::new (can_events => 0, %arg);
570	}	647	}
571		648
572	sub size_request {	649	sub size_request {
573	(0, 0)	650	my ($self) = @_;
		651
		652	($self->{w} + 0, $self->{h} + 0)
574	}	653	}
575		654
576	sub draw { }	655	sub draw { }
577		656
578	#############################################################################	657	#############################################################################
…		…
607	$self->{children} = [	686	$self->{children} = [
608	sort { $a->{z} <=> $b->{z} }	687	sort { $a->{z} <=> $b->{z} }
609	@{$self->{children}}, @widgets	688	@{$self->{children}}, @widgets
610	];	689	];
611		690
612	$self->check_size (1);	691	$self->realloc;
613	$self->update;
614	}	692	}
615		693
616	sub children {	694	sub children {
617	@{ $_[0]{children} }	695	@{ $_[0]{children} }
618	}	696	}
…		…
623	delete $child->{parent};	701	delete $child->{parent};
624	$child->hide;	702	$child->hide;
625		703
626	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	704	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
627		705
628	$self->check_size (1);	706	$self->realloc;
629	$self->update;
630	}	707	}
631		708
632	sub clear {	709	sub clear {
633	my ($self) = @_;	710	my ($self) = @_;
634		711
…		…
638	for (@$children) {	715	for (@$children) {
639	delete $_->{parent};	716	delete $_->{parent};
640	$_->hide;	717	$_->hide;
641	}	718	}
642		719
643	$self->check_size;	720	$self->realloc;
644	$self->update;
645	}	721	}
646		722
647	sub find_widget {	723	sub find_widget {
648	my ($self, $x, $y) = @_;	724	my ($self, $x, $y) = @_;
649		725
…		…
736	$self->SUPER::size_allocate ($w, $h);	812	$self->SUPER::size_allocate ($w, $h);
737	$self->update;	813	$self->update;
738	}	814	}
739		815
740	sub _render {	816	sub _render {
		817	my ($self) = @_;
		818
741	$_[0]{children}[0]->draw;	819	$self->{children}[0]->draw;
742	}	820	}
743		821
744	sub render_child {	822	sub render_child {
745	my ($self) = @_;	823	my ($self) = @_;
746		824
747	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	825	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
748	glClearColor 0, 0, 0, 0;	826	glClearColor 0, 0, 0, 0;
749	glClear GL_COLOR_BUFFER_BIT;	827	glClear GL_COLOR_BUFFER_BIT;
750		828
		829	{
		830	package CFClient::UI::Base;
		831
		832	($draw_x, $draw_y, $draw_w, $draw_h) =
		833	(0, 0, $self->{w}, $self->{h});
		834	}
		835
751	$self->_render;	836	$self->_render;
752	};	837	};
753	}	838	}
754		839
755	sub _draw {	840	sub _draw {
756	my ($self) = @_;	841	my ($self) = @_;
757		842
758	my ($w, $h) = ($self->w, $self->h);	843	my ($w, $h) = @$self{qw(w h)};
759		844
760	my $tex = $self->{texture}	845	my $tex = $self->{texture}
761	or return;	846	or return;
762		847
763	glEnable GL_TEXTURE_2D;	848	glEnable GL_TEXTURE_2D;
…		…
786	}	871	}
787		872
788	sub size_request {	873	sub size_request {
789	my ($self) = @_;	874	my ($self) = @_;
790		875
791	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	876	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
792		877
793	@$self{qw(child_w child_h)}	878	$w = 10 if $self->{scroll_x};
		879	$h = 10 if $self->{scroll_y};
		880
		881	($w, $h)
794	}	882	}
795		883
796	sub size_allocate {	884	sub size_allocate {
797	my ($self, $w, $h) = @_;	885	my ($self, $w, $h) = @_;
798		886
		887	my $child = $self->child;
		888
799	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	889	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
800	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	890	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
801		891
802	$self->child->configure (0, 0, $w, $h);	892	$self->child->configure (0, 0, $w, $h);
803	$self->update;	893	$self->update;
804	}	894	}
805		895
…		…
841	}	931	}
842		932
843	sub _render {	933	sub _render {
844	my ($self) = @_;	934	my ($self) = @_;
845		935
		936	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		937	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		938
846	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	939	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
847		940
848	$self->SUPER::_render;	941	$self->SUPER::_render;
849	}	942	}
850		943
…		…
858	my $class = shift;	951	my $class = shift;
859		952
860	my $self;	953	my $self;
861		954
862	my $slider = new CFClient::UI::Slider	955	my $slider = new CFClient::UI::Slider
863	vertical => 1,	956	vertical => 1,
864	range => [0, 0, 1, 0.01], # HACK fix	957	range => [0, 0, 1, 0.01], # HACK fix
865	connect_changed => sub {	958	on_changed => sub {
866	$self->{vp}->set_offset (0, $_[1]);	959	$self->{vp}->set_offset (0, $_[1]);
867	},	960	},
868	;	961	;
869		962
870	$self = $class->SUPER::new (	963	$self = $class->SUPER::new (
…		…
948		1041
949	our @ISA = CFClient::UI::Bin::;	1042	our @ISA = CFClient::UI::Bin::;
950		1043
951	use CFClient::OpenGL;	1044	use CFClient::OpenGL;
952		1045
953	my @tex =	1046	my $bg =
		1047	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1048	mipmap => 1, wrap => 1;
		1049
		1050	my @border =
954	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1051	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);	1052	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
956		1053
957	sub new {	1054	sub new {
958	my $class = shift;	1055	my ($class, %arg) = @_;
959		1056
960	# TODO: user_x, user_y, overwrite moveto?	1057	my $title = delete $arg{title};
961		1058
962	my $self = $class->SUPER::new (	1059	my $self = $class->SUPER::new (
963	bg => [1, 1, 1, 1],	1060	bg => [1, 1, 1, 1],
964	border_bg => [1, 1, 1, 1],	1061	border_bg => [1, 1, 1, 1],
965	border => 0.6,	1062	border => 0.6,
966	is_toplevel => 1,
967	can_events => 1,	1063	can_events => 1,
968	@_	1064	min_w => 16,
		1065	min_h => 16,
		1066	%arg,
969	);	1067	);
970		1068
971	$self->{title} &&= new CFClient::UI::Label	1069	$self->{title} = new CFClient::UI::Label
972	align => 0,	1070	align => 0,
973	valign => 1,	1071	valign => 1,
974	text => $self->{title},	1072	text => $title,
975	fontsize => $self->{border};	1073	fontsize => $self->{border}
		1074	if defined $title;
976		1075
977	$self	1076	$self
		1077	}
		1078
		1079	sub add {
		1080	my ($self, @widgets) = @_;
		1081
		1082	$self->SUPER::add (@widgets);
		1083	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
978	}	1084	}
979		1085
980	sub border {	1086	sub border {
981	int $_[0]{border} * $::FONTSIZE	1087	int $_[0]{border} * $::FONTSIZE
982	}	1088	}
983		1089
984	sub size_request {	1090	sub size_request {
985	my ($self) = @_;	1091	my ($self) = @_;
		1092
		1093	$self->{title}->size_request
		1094	if $self->{title};
986		1095
987	my ($w, $h) = $self->SUPER::size_request;	1096	my ($w, $h) = $self->SUPER::size_request;
988		1097
989	(	1098	(
990	$w + $self->border * 2,	1099	$w + $self->border * 2,
…		…
993	}	1102	}
994		1103
995	sub size_allocate {	1104	sub size_allocate {
996	my ($self, $w, $h) = @_;	1105	my ($self, $w, $h) = @_;
997		1106
		1107	if ($self->{title}) {
		1108	$self->{title}{w} = $w;
		1109	$self->{title}{h} = $h;
		1110	$self->{title}->size_allocate ($w, $h);
		1111	}
		1112
		1113	my $border = $self->border;
		1114
998	$h -= List::Util::max 0, $self->border * 2;	1115	$h -= List::Util::max 0, $border * 2;
999	$w -= List::Util::max 0, $self->border * 2;	1116	$w -= List::Util::max 0, $border * 2;
1000		1117
1001	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1002	if $self->{title};
1003
1004	$self->child->configure ($self->border, $self->border, $w, $h);	1118	$self->child->configure ($border, $border, $w, $h);
1005	}	1119	}
1006		1120
1007	sub button_down {	1121	sub button_down {
1008	my ($self, $ev, $x, $y) = @_;	1122	my ($self, $ev, $x, $y) = @_;
1009		1123
…		…
1025	my ($ev, $x, $y) = @_;	1139	my ($ev, $x, $y) = @_;
1026		1140
1027	my $dx = $ev->{x} - $ox;	1141	my $dx = $ev->{x} - $ox;
1028	my $dy = $ev->{y} - $oy;	1142	my $dy = $ev->{y} - $oy;
1029		1143
1030	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1144	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1031	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1145	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1146
		1147	$self->realloc;
1032	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1148	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1033	$self->check_size;
1034	};	1149	};
1035		1150
1036	} elsif ($lr ^ $td) {	1151	} elsif ($lr ^ $td) {
1037	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1152	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1038	my ($bx, $by) = ($self->{x}, $self->{y});	1153	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1040	$self->{motion} = sub {	1155	$self->{motion} = sub {
1041	my ($ev, $x, $y) = @_;	1156	my ($ev, $x, $y) = @_;
1042		1157
1043	($x, $y) = ($ev->{x}, $ev->{y});	1158	($x, $y) = ($ev->{x}, $ev->{y});
1044		1159
1045	$self->move ($bx + $x - $ox, $by + $y - $oy);	1160	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1046	$self->update;
1047	};	1161	};
1048	}	1162	}
1049	}	1163	}
1050		1164
1051	sub button_up {	1165	sub button_up {
…		…
1061	}	1175	}
1062		1176
1063	sub _draw {	1177	sub _draw {
1064	my ($self) = @_;	1178	my ($self) = @_;
1065		1179
		1180	my $child = $self->{children}[0];
		1181
1066	my ($w, $h ) = ($self->{w}, $self->{h});	1182	my ($w, $h ) = ($self->{w}, $self->{h});
1067	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1183	my ($cw, $ch) = ($child->{w}, $child->{h});
1068		1184
1069	glEnable GL_TEXTURE_2D;	1185	glEnable GL_TEXTURE_2D;
1070	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1186	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1071		1187
1072	my $border = $self->border;	1188	my $border = $self->border;
1073		1189
1074	glColor @{ $self->{border_bg} };	1190	glColor @{ $self->{border_bg} };
1075	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1191	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1076	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1192	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1077	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1193	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1078	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1194	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1079		1195
1080	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1196	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1081	my $bg = $tex[0];	1197	glColor @{ $self->{bg} };
1082		1198
1083	# TODO: repeat texture not scale	1199	# TODO: repeat texture not scale
		1200	# solve this better(?)
1084	my $rep_x = $cw / $bg->{w};	1201	$bg->{s} = $cw / $bg->{w};
1085	my $rep_y = $ch / $bg->{h};	1202	$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);	1203	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1093	}	1204	}
1094		1205
1095	glDisable GL_TEXTURE_2D;	1206	glDisable GL_TEXTURE_2D;
1096		1207
1097	$self->{title}->draw if $self->{title};
1098
1099	$self->child->draw;	1208	$child->draw;
		1209
		1210	if ($self->{title}) {
		1211	glTranslate 0, $border - $self->{h};
		1212	$self->{title}->_draw;
		1213	}
1100	}	1214	}
1101		1215
1102	#############################################################################	1216	#############################################################################
1103		1217
1104	package CFClient::UI::Table;	1218	package CFClient::UI::Table;
…		…
1126	my ($self, $x, $y, $child) = @_;	1240	my ($self, $x, $y, $child) = @_;
1127		1241
1128	$child->set_parent ($self);	1242	$child->set_parent ($self);
1129	$self->{children}[$y][$x] = $child;	1243	$self->{children}[$y][$x] = $child;
1130		1244
1131	$self->check_size (1);	1245	$self->realloc;
1132	}	1246	}
1133		1247
1134	# TODO: move to container class maybe? send children a signal on removal?	1248	# TODO: move to container class maybe? send children a signal on removal?
1135	sub clear {	1249	sub clear {
1136	my ($self) = @_;	1250	my ($self) = @_;
…		…
1141	for (@children) {	1255	for (@children) {
1142	delete $_->{parent};	1256	delete $_->{parent};
1143	$_->hide;	1257	$_->hide;
1144	}	1258	}
1145		1259
1146	$self->check_size (1);	1260	$self->realloc;
1147	$self->update;
1148	}	1261	}
1149		1262
1150	sub get_wh {	1263	sub get_wh {
1151	my ($self) = @_;	1264	my ($self) = @_;
1152		1265
…		…
1248	}	1361	}
1249	}	1362	}
1250		1363
1251	#############################################################################	1364	#############################################################################
1252		1365
1253	package CFClient::UI::HBox;	1366	package CFClient::UI::Box;
1254
1255	# TODO: wrap into common Box base class
1256		1367
1257	our @ISA = CFClient::UI::Container::;	1368	our @ISA = CFClient::UI::Container::;
1258		1369
1259	sub size_request {	1370	sub size_request {
1260	my ($self) = @_;	1371	my ($self) = @_;
1261		1372
1262	my @alloc = map [$_->size_request], @{$self->{children}};	1373	$self->{vertical}
1263		1374	? (
1264	(	1375	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1265	(List::Util::sum map $_->[0], @alloc),	1376	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1266	(List::Util::max map $_->[1], @alloc),	1377	)
1267	)	1378	: (
		1379	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1380	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1381	)
1268	}	1382	}
1269		1383
1270	sub size_allocate {	1384	sub size_allocate {
1271	my ($self, $w, $h) = @_;	1385	my ($self, $w, $h) = @_;
1272		1386
1273	($h, $w) = ($w, $h);	1387	my $space = $self->{vertical} ? $h : $w;
1274
1275	my $children = $self->{children};	1388	my $children = $self->{children};
1276		1389
1277	my @h = map $_->{req_w}, @$children;	1390	my @req;
1278		1391
1279	my $req_h = List::Util::sum @h;	1392	if ($self->{homogeneous}) {
1280		1393	@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 {	1394	} else {
		1395	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
		1396	my $req = List::Util::sum @req;
		1397
		1398	if ($req > $space) {
		1399	# ah well, not enough space
		1400	$_ *= $space / $req for @req;
		1401	} else {
1285	my $exp = List::Util::sum map $_->{expand}, @$children;	1402	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1286	$exp ||= 1;
1287		1403
		1404	$space = ($space - $req) / $expand; # remaining space to give away
		1405
		1406	$req[$_] += $space * $children->[$_]{expand}
1288	for (0 .. $#$children) {	1407	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	}	1408	}
1295	}	1409	}
1296		1410
1297	CFClient::UI::harmonize \@h;	1411	CFClient::UI::harmonize \@req;
1298		1412
1299	my $y = 0;	1413	my $pos = 0;
1300	for (0 .. $#$children) {	1414	for (0 .. $#$children) {
1301	my $child = $children->[$_];
1302	my $h = $h[$_];	1415	my $alloc = $req[$_];
1303	$child->configure ($y, 0, $h, $w);	1416	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1304		1417
1305	$y += $h;	1418	$pos += $alloc;
1306	}	1419	}
1307		1420
1308	1	1421	1
1309	}	1422	}
1310		1423
1311	#############################################################################	1424	#############################################################################
1312		1425
		1426	package CFClient::UI::HBox;
		1427
		1428	our @ISA = CFClient::UI::Box::;
		1429
		1430	sub new {
		1431	my $class = shift;
		1432
		1433	$class->SUPER::new (
		1434	vertical => 0,
		1435	@_,
		1436	)
		1437	}
		1438
		1439	#############################################################################
		1440
1313	package CFClient::UI::VBox;	1441	package CFClient::UI::VBox;
1314		1442
1315	# TODO: wrap into common Box base class
1316
1317	our @ISA = CFClient::UI::Container::;	1443	our @ISA = CFClient::UI::Box::;
1318		1444
1319	sub size_request {	1445	sub new {
1320	my ($self) = @_;	1446	my $class = shift;
1321		1447
1322	my @alloc = map [$_->size_request], @{$self->{children}};	1448	$class->SUPER::new (
1323		1449	vertical => 1,
1324	(	1450	@_,
1325	(List::Util::max map $_->[0], @alloc),
1326	(List::Util::sum map $_->[1], @alloc),
1327	)	1451	)
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	}	1452	}
1368		1453
1369	#############################################################################	1454	#############################################################################
1370		1455
1371	package CFClient::UI::Label;	1456	package CFClient::UI::Label;
…		…
1388	ellipsise => 3, # end	1473	ellipsise => 3, # end
1389	layout => (new CFClient::Layout),	1474	layout => (new CFClient::Layout),
1390	fontsize => 1,	1475	fontsize => 1,
1391	align => -1,	1476	align => -1,
1392	valign => -1,	1477	valign => -1,
1393	padding => 2,	1478	padding_x => 2,
		1479	padding_y => 2,
1394	can_events => 0,	1480	can_events => 0,
1395	%arg	1481	%arg
1396	);	1482	);
1397		1483
1398	if (exists $self->{template}) {	1484	if (exists $self->{template}) {
…		…
1434	$self->{text} = "T$text";	1520	$self->{text} = "T$text";
1435		1521
1436	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1522	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1437	$self->{layout}->set_text ($text);	1523	$self->{layout}->set_text ($text);
1438		1524
		1525	$self->realloc;
1439	$self->update;	1526	$self->update;
1440	$self->check_size;
1441	}	1527	}
1442		1528
1443	sub set_markup {	1529	sub set_markup {
1444	my ($self, $markup) = @_;	1530	my ($self, $markup) = @_;
1445		1531
…		…
1449	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1535	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1450		1536
1451	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1537	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1452	$self->{layout}->set_markup ($markup);	1538	$self->{layout}->set_markup ($markup);
1453		1539
		1540	$self->realloc;
1454	$self->update;	1541	$self->update;
1455	$self->check_size;
1456	}	1542	}
1457		1543
1458	sub size_request {	1544	sub size_request {
1459	my ($self) = @_;	1545	my ($self) = @_;
1460		1546
…		…
1474		1560
1475	$w = List::Util::max $w, $w2;	1561	$w = List::Util::max $w, $w2;
1476	$h = List::Util::max $h, $h2;	1562	$h = List::Util::max $h, $h2;
1477	}	1563	}
1478		1564
1479	(	1565	($w, $h)
1480	$w + $self->{padding} * 2,
1481	$h + $self->{padding} * 2,
1482	)
1483	}	1566	}
1484		1567
1485	sub size_allocate {	1568	sub size_allocate {
1486	my ($self, $w, $h) = @_;	1569	my ($self, $w, $h) = @_;
1487		1570
		1571	delete $self->{ox};
		1572
1488	delete $self->{texture};	1573	delete $self->{texture}
		1574	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1489	}	1575	}
1490		1576
1491	sub set_fontsize {	1577	sub set_fontsize {
1492	my ($self, $fontsize) = @_;	1578	my ($self, $fontsize) = @_;
1493		1579
1494	$self->{fontsize} = $fontsize;	1580	$self->{fontsize} = $fontsize;
1495	delete $self->{texture};	1581	delete $self->{texture};
1496		1582
1497	$self->update;	1583	$self->realloc;
1498	$self->check_size;
1499	}	1584	}
1500		1585
1501	sub _draw {	1586	sub _draw {
1502	my ($self) = @_;	1587	my ($self) = @_;
1503		1588
…		…
1509	$self->{layout}->set_width ($self->{w});	1594	$self->{layout}->set_width ($self->{w});
1510	$self->{layout}->set_ellipsise ($self->{ellipsise});	1595	$self->{layout}->set_ellipsise ($self->{ellipsise});
1511	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1596	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1512	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1597	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1513		1598
1514	my $tex = new_from_layout CFClient::Texture $self->{layout};	1599	new_from_layout CFClient::Texture $self->{layout}
		1600	};
1515		1601
		1602	unless (exists $self->{ox}) {
1516	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1603	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1517	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1604	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1518	: ($self->{w} - $tex->{w}) * 0.5);	1605	: ($self->{w} - $tex->{w}) * 0.5);
1519		1606
1520	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1607	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1521	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1608	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1522	: ($self->{h} - $tex->{h}) * 0.5);	1609	: ($self->{h} - $tex->{h}) * 0.5);
1523
1524	$tex
1525	};	1610	};
1526		1611
1527	glEnable GL_TEXTURE_2D;	1612	glEnable GL_TEXTURE_2D;
1528	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1613	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1529		1614
…		…
1583	sub set_text {	1668	sub set_text {
1584	my ($self, $text) = @_;	1669	my ($self, $text) = @_;
1585		1670
1586	$self->{cursor} = length $text;	1671	$self->{cursor} = length $text;
1587	$self->_set_text ($text);	1672	$self->_set_text ($text);
1588	$self->update;	1673
1589	$self->check_size;	1674	$self->realloc;
1590	}	1675	}
1591		1676
1592	sub get_text {	1677	sub get_text {
1593	$_[0]{text}	1678	$_[0]{text}
1594	}	1679	}
…		…
1627	} elsif ($uni) {	1712	} elsif ($uni) {
1628	substr $text, $self->{cursor}++, 0, chr $uni;	1713	substr $text, $self->{cursor}++, 0, chr $uni;
1629	}	1714	}
1630		1715
1631	$self->_set_text ($text);	1716	$self->_set_text ($text);
1632	$self->update;	1717
1633	$self->check_size;	1718	$self->realloc;
1634	}	1719	}
1635		1720
1636	sub focus_in {	1721	sub focus_in {
1637	my ($self) = @_;	1722	my ($self) = @_;
1638		1723
…		…
1765		1850
1766	sub new {	1851	sub new {
1767	my $class = shift;	1852	my $class = shift;
1768		1853
1769	$class->SUPER::new (	1854	$class->SUPER::new (
1770	padding => 4,	1855	padding_x => 4,
		1856	padding_y => 4,
1771	fg => [1, 1, 1],	1857	fg => [1, 1, 1],
1772	active_fg => [0, 0, 1],	1858	active_fg => [0, 0, 1],
1773	can_hover => 1,	1859	can_hover => 1,
1774	align => 0,	1860	align => 0,
1775	valign => 0,	1861	valign => 0,
…		…
1822		1908
1823	sub new {	1909	sub new {
1824	my $class = shift;	1910	my $class = shift;
1825		1911
1826	$class->SUPER::new (	1912	$class->SUPER::new (
1827	padding => 2,	1913	padding_x => 2,
		1914	padding_y => 2,
1828	fg => [1, 1, 1],	1915	fg => [1, 1, 1],
1829	active_fg => [1, 1, 0],	1916	active_fg => [1, 1, 0],
1830	bg => [0, 0, 0, 0.2],	1917	bg => [0, 0, 0, 0.2],
1831	active_bg => [1, 1, 1, 0.5],	1918	active_bg => [1, 1, 1, 0.5],
1832	state => 0,	1919	state => 0,
…		…
1836	}	1923	}
1837		1924
1838	sub size_request {	1925	sub size_request {
1839	my ($self) = @_;	1926	my ($self) = @_;
1840		1927
1841	($self->{padding} * 2 + 6) x 2	1928	(6) x 2
1842	}	1929	}
1843		1930
1844	sub button_down {	1931	sub button_down {
1845	my ($self, $ev, $x, $y) = @_;	1932	my ($self, $ev, $x, $y) = @_;
1846		1933
1847	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1934	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1848	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1935	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1849	$self->{state} = !$self->{state};	1936	$self->{state} = !$self->{state};
1850	$self->_emit (changed => $self->{state});	1937	$self->_emit (changed => $self->{state});
1851	}	1938	}
1852	}	1939	}
1853		1940
1854	sub _draw {	1941	sub _draw {
1855	my ($self) = @_;	1942	my ($self) = @_;
1856		1943
1857	$self->SUPER::_draw;	1944	$self->SUPER::_draw;
1858		1945
1859	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1946	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1860		1947
1861	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1948	my ($w, $h) = @$self{qw(w h)};
		1949
		1950	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1862		1951
1863	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1952	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1864		1953
1865	my $tex = $self->{state} ? $tex[1] : $tex[0];	1954	my $tex = $self->{state} ? $tex[1] : $tex[0];
1866		1955
…		…
2131	fg => [1, 1, 1],	2220	fg => [1, 1, 1],
2132	active_fg => [0, 0, 0],	2221	active_fg => [0, 0, 0],
2133	bg => [0, 0, 0, 0.2],	2222	bg => [0, 0, 0, 0.2],
2134	active_bg => [1, 1, 1, 0.5],	2223	active_bg => [1, 1, 1, 0.5],
2135	range => [0, 0, 100, 10, 0],	2224	range => [0, 0, 100, 10, 0],
2136	req_w => $::WIDTH / 80,	2225	min_w => $::WIDTH / 80,
2137	req_h => $::WIDTH / 80,	2226	min_h => $::WIDTH / 80,
2138	vertical => 0,	2227	vertical => 0,
2139	can_hover => 1,	2228	can_hover => 1,
2140	inner_pad => 0.02,	2229	inner_pad => 0.02,
2141	@_	2230	@_
2142	);	2231	);
…		…
2145	$self->update;	2234	$self->update;
2146		2235
2147	$self	2236	$self
2148	}	2237	}
2149		2238
		2239	sub changed { }
		2240
2150	sub set_range {	2241	sub set_range {
2151	my ($self, $range) = @_;	2242	my ($self, $range) = @_;
2152		2243
2153	($range, $self->{range}) = ($self->{range}, $range);	2244	($range, $self->{range}) = ($self->{range}, $range);
2154		2245
…		…
2180	}	2271	}
2181		2272
2182	sub size_request {	2273	sub size_request {
2183	my ($self) = @_;	2274	my ($self) = @_;
2184		2275
2185	my $w = $self->{req_w};	2276	($self->{req_w}, $self->{req_h})
2186	my $h = $self->{req_h};
2187
2188	$self->{vertical} ? ($h, $w) : ($w, $h)
2189	}	2277	}
2190		2278
2191	sub button_down {	2279	sub button_down {
2192	my ($self, $ev, $x, $y) = @_;	2280	my ($self, $ev, $x, $y) = @_;
2193		2281
…		…
2544		2632
2545	sub new {	2633	sub new {
2546	my $class = shift;	2634	my $class = shift;
2547		2635
2548	my $self = $class->SUPER::new (	2636	my $self = $class->SUPER::new (
2549	state => 0,	2637	state => 0,
2550	connect_activate => \&toggle_flopper,	2638	on_activate => \&toggle_flopper,
2551	@_	2639	@_
2552	);	2640	);
2553		2641
2554	if ($self->{state}) {
2555	$self->{state} = 0;
2556	$self->toggle_flopper;
2557	}
2558
2559	$self	2642	$self
2560	}	2643	}
2561		2644
2562	sub toggle_flopper {	2645	sub toggle_flopper {
2563	my ($self) = @_;	2646	my ($self) = @_;
2564		2647
2565	# TODO: use animation	2648	$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	}	2649	}
2577		2650
2578	#############################################################################	2651	#############################################################################
2579		2652
2580	package CFClient::UI::Tooltip;	2653	package CFClient::UI::Tooltip;
…		…
2593	}	2666	}
2594		2667
2595	sub set_tooltip_from {	2668	sub set_tooltip_from {
2596	my ($self, $widget) = @_;	2669	my ($self, $widget) = @_;
2597		2670
		2671	my $tooltip = $widget->{tooltip};
		2672
		2673	if ($ENV{CFPLUS_DEBUG} & 2) {
		2674	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2675	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2676	. "req $widget->{req_w} $widget->{req_h}\n"
		2677	. "visible $widget->{visible}";
		2678	}
		2679
2598	$self->add (new CFClient::UI::Label	2680	$self->add (new CFClient::UI::Label
2599	markup => $widget->{tooltip},	2681	markup => $tooltip,
2600	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2682	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2601	fontsize => 0.8,	2683	fontsize => 0.8,
2602	fg => [0, 0, 0, 1],	2684	fg => [0, 0, 0, 1],
2603	ellipsise => 0,	2685	ellipsise => 0,
2604	font => ($widget->{tooltip_font} || $::FONT_PROP),	2686	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2615		2697
2616	sub size_allocate {	2698	sub size_allocate {
2617	my ($self, $w, $h) = @_;	2699	my ($self, $w, $h) = @_;
2618		2700
2619	$self->SUPER::size_allocate ($w - 4, $h - 4);	2701	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2702	}
		2703
		2704	sub visibility_change {
		2705	my ($self, $visible) = @_;
		2706
		2707	return unless $visible;
		2708
		2709	$self->{root}->on_post_alloc ("move_$self" => sub {
		2710	my $widget = $self->{owner}
		2711	or return;
		2712
		2713	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2714
		2715	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2716	if $x + $self->{w} > $::WIDTH;
		2717
		2718	$self->move_abs ($x, $y);
		2719	});
2620	}	2720	}
2621		2721
2622	sub _draw {	2722	sub _draw {
2623	my ($self) = @_;	2723	my ($self) = @_;
2624		2724
…		…
2641	glVertex $w, $h;	2741	glVertex $w, $h;
2642	glVertex $w, 0;	2742	glVertex $w, 0;
2643	glEnd;	2743	glEnd;
2644		2744
2645	glTranslate 2 - 0.375, 2 - 0.375;	2745	glTranslate 2 - 0.375, 2 - 0.375;
		2746
2646	$self->SUPER::_draw;	2747	$self->SUPER::_draw;
2647	}	2748	}
2648		2749
2649	#############################################################################	2750	#############################################################################
2650		2751
…		…
2726	$self->SUPER::DESTROY;	2827	$self->SUPER::DESTROY;
2727	}	2828	}
2728		2829
2729	#############################################################################	2830	#############################################################################
2730		2831
2731	package CFClient::UI::Inventory;
2732
2733	our @ISA = CFClient::UI::ScrolledWindow::;
2734
2735	sub new {
2736	my $class = shift;
2737
2738	my $self = $class->SUPER::new (
2739	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2740	@_,
2741	);
2742
2743	$self
2744	}
2745
2746	sub set_items {
2747	my ($self, $items) = @_;
2748
2749	$self->{scrolled}->clear;
2750	return unless $items;
2751
2752	my @items = sort {
2753	($a->{type} <=> $b->{type})
2754	or ($a->{name} cmp $b->{name})
2755	} @$items;
2756
2757	$self->{real_items} = \@items;
2758
2759	my $row = 0;
2760	for my $item (@items) {
2761	CFClient::Item::update_widgets $item;
2762
2763	$self->{scrolled}->add (0, $row, $item->{face_widget});
2764	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2765	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2766
2767	$row++;
2768	}
2769	}
2770
2771	sub size_request {
2772	my ($self) = @_;
2773	($self->{req_w}, $self->{req_h});
2774	}
2775
2776	#############################################################################
2777
2778	package CFClient::UI::Menu;	2832	package CFClient::UI::Menu;
2779		2833
2780	our @ISA = CFClient::UI::FancyFrame::;	2834	our @ISA = CFClient::UI::FancyFrame::;
2781		2835
2782	use CFClient::OpenGL;	2836	use CFClient::OpenGL;
…		…
2820	# maybe save $GRAB? must be careful about events...	2874	# maybe save $GRAB? must be careful about events...
2821	$GRAB = $self;	2875	$GRAB = $self;
2822	$self->{button} = $ev->{button};	2876	$self->{button} = $ev->{button};
2823		2877
2824	$self->show;	2878	$self->show;
2825	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2879	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2826	}	2880	}
2827		2881
2828	sub mouse_motion {	2882	sub mouse_motion {
2829	my ($self, $ev, $x, $y) = @_;	2883	my ($self, $ev, $x, $y) = @_;
2830		2884
…		…
2955	$self->SUPER::reconfigure;	3009	$self->SUPER::reconfigure;
2956	}	3010	}
2957		3011
2958	#############################################################################	3012	#############################################################################
2959		3013
2960	package CFClient::UI::Root;	3014	package CFClient::UI::Inventory;
2961		3015
2962	our @ISA = CFClient::UI::Container::;	3016	our @ISA = CFClient::UI::ScrolledWindow::;
2963
2964	use CFClient::OpenGL;
2965		3017
2966	sub new {	3018	sub new {
2967	my $class = shift;	3019	my $class = shift;
2968		3020
2969	$class->SUPER::new (	3021	my $self = $class->SUPER::new (
		3022	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3023	@_,
		3024	);
		3025
		3026	$self
		3027	}
		3028
		3029	sub set_items {
		3030	my ($self, $items) = @_;
		3031
		3032	$self->{scrolled}->clear;
		3033	return unless $items;
		3034
		3035	my @items = sort {
		3036	($a->{type} <=> $b->{type})
		3037	or ($a->{name} cmp $b->{name})
		3038	} @$items;
		3039
		3040	$self->{real_items} = \@items;
		3041
		3042	my $row = 0;
		3043	for my $item (@items) {
		3044	CFClient::Item::update_widgets $item;
		3045
		3046	$self->{scrolled}->add (0, $row, $item->{face_widget});
		3047	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		3048	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		3049
		3050	$row++;
		3051	}
		3052	}
		3053
		3054	#############################################################################
		3055
		3056	package CFClient::UI::BindEditor;
		3057
		3058	our @ISA = CFClient::UI::FancyFrame::;
		3059
		3060	sub new {
		3061	my $class = shift;
		3062
		3063	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3064
		3065	$self->add (my $vb = new CFClient::UI::VBox);
		3066
		3067
		3068	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3069	text => "start recording",
		3070	tooltip => "Start/Stops recording of actions."
		3071	."All subsequent actions after the recording started will be captured."
		3072	."The actions are displayed after the record was stopped."
		3073	."To bind the action you have to click on the 'Bind' button",
		3074	on_activate => sub {
		3075	unless ($self->{recording}) {
		3076	$self->start;
		3077	} else {
		3078	$self->stop;
		3079	}
		3080	});
		3081
		3082	$vb->add (new CFClient::UI::Label text => "Actions:");
		3083	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3084
		3085	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3086	$vb->add (my $hb = new CFClient::UI::HBox);
		3087	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3088	$hb->add (new CFClient::UI::Button
		3089	text => "bind",
		3090	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3091	on_activate => sub {
		3092	$self->ask_for_bind;
		3093	});
		3094
		3095	$vb->add (my $hb = new CFClient::UI::HBox);
		3096	$hb->add (new CFClient::UI::Button
		3097	text => "ok",
		3098	expand => 1,
		3099	tooltip => "This closes the binding editor and saves the binding",
		3100	on_activate => sub {
		3101	$self->hide;
		3102	$self->commit;
		3103	});
		3104
		3105	$hb->add (new CFClient::UI::Button
		3106	text => "cancel",
		3107	expand => 1,
		3108	tooltip => "This closes the binding editor without saving",
		3109	on_activate => sub {
		3110	$self->hide;
		3111	$self->{binding_cancel}->()
		3112	if $self->{binding_cancel};
		3113	});
		3114
		3115	$self->update_binding_widgets;
		3116
		3117	$self
		3118	}
		3119
		3120	sub commit {
		3121	my ($self) = @_;
		3122	my ($mod, $sym, $cmds) = $self->get_binding;
		3123	if ($sym != 0 && @$cmds > 0) {
		3124	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3125	."'. Don't forget 'Save Config'!");
		3126	$self->{binding_change}->($mod, $sym, $cmds)
		3127	if $self->{binding_change};
		3128	} else {
		3129	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3130	$self->{binding_cancel}->()
		3131	if $self->{binding_cancel};
		3132	}
		3133	}
		3134
		3135	sub start {
		3136	my ($self) = @_;
		3137
		3138	$self->{rec_btn}->set_text ("stop recording");
		3139	$self->{recording} = 1;
		3140	$self->clear_command_list;
		3141	$::CONN->start_record if $::CONN;
		3142	}
		3143
		3144	sub stop {
		3145	my ($self) = @_;
		3146
		3147	$self->{rec_btn}->set_text ("start recording");
		3148	$self->{recording} = 0;
		3149
		3150	my $rec;
		3151	$rec = $::CONN->stop_record if $::CONN;
		3152	return unless ref $rec eq 'ARRAY';
		3153	$self->set_command_list ($rec);
		3154	}
		3155
		3156
		3157	sub ask_for_bind_and_commit {
		3158	my ($self) = @_;
		3159	$self->ask_for_bind (1);
		3160	}
		3161
		3162	sub ask_for_bind {
		3163	my ($self, $commit) = @_;
		3164
		3165	CFClient::Binder::open_binding_dialog (sub {
		3166	my ($mod, $sym) = @_;
		3167	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3168	$self->update_binding_widgets;
		3169	$self->commit if $commit;
		3170	});
		3171	}
		3172
		3173	# $mod and $sym are the modifiers and key symbol
		3174	# $cmds is a array ref of strings (the commands)
		3175	# $cb is the callback that is executed on OK
		3176	# $ccb is the callback that is executed on CANCEL and
		3177	# when the binding was unsuccessful on OK
		3178	sub set_binding {
		3179	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3180
		3181	$self->clear_command_list;
		3182	$self->{recording} = 0;
		3183	$self->{rec_btn}->set_text ("start recording");
		3184
		3185	$self->{binding} = [$mod, $sym];
		3186	$self->{commands} = $cmds;
		3187
		3188	$self->{binding_change} = $cb;
		3189	$self->{binding_cancel} = $ccb;
		3190
		3191	$self->update_binding_widgets;
		3192	}
		3193
		3194	# this is a shortcut method that asks for a binding
		3195	# and then just binds it.
		3196	sub do_quick_binding {
		3197	my ($self, $cmds) = @_;
		3198	$self->set_binding (undef, undef, $cmds, sub {
		3199	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3200	});
		3201	$self->ask_for_bind (1);
		3202	}
		3203
		3204	sub update_binding_widgets {
		3205	my ($self) = @_;
		3206	my ($mod, $sym, $cmds) = $self->get_binding;
		3207	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3208	$self->set_command_list ($cmds);
		3209	}
		3210
		3211	sub get_binding {
		3212	my ($self) = @_;
		3213	return (
		3214	$self->{binding}->[0],
		3215	$self->{binding}->[1],
		3216	[ grep { defined $_ } @{$self->{commands}} ]
		3217	);
		3218	}
		3219
		3220	sub clear_command_list {
		3221	my ($self) = @_;
		3222	$self->{cmdbox}->clear ();
		3223	}
		3224
		3225	sub set_command_list {
		3226	my ($self, $cmds) = @_;
		3227
		3228	$self->{cmdbox}->clear ();
		3229	$self->{commands} = $cmds;
		3230
		3231	my $idx = 0;
		3232
		3233	for (@$cmds) {
		3234	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3235
		3236	my $i = $idx;
		3237	$hb->add (new CFClient::UI::Label text => $_);
		3238	$hb->add (new CFClient::UI::Button
		3239	text => "delete",
		3240	tooltip => "Deletes the action from the record",
		3241	on_activate => sub {
		3242	$self->{cmdbox}->remove ($hb);
		3243	$cmds->[$i] = undef;
		3244	});
		3245
		3246
		3247	$idx++
		3248	}
		3249	}
		3250
		3251	#############################################################################
		3252
		3253	package CFClient::UI::SpellList;
		3254
		3255	our @ISA = CFClient::UI::FancyFrame::;
		3256
		3257	sub new {
		3258	my $class = shift;
		3259
		3260	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3261
		3262	$self->add (new CFClient::UI::ScrolledWindow
		3263	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3264
		3265	$self;
		3266	}
		3267
		3268	# XXX: Do sorting? Argl...
		3269	sub add_spell {
		3270	my ($self, $spell) = @_;
		3271	$self->{spells}->{$spell->{name}} = $spell;
		3272
		3273	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3274	face => $spell->{face},
		3275	can_hover => 1,
		3276	can_events => 1,
		3277	tooltip => $spell->{message});
		3278
		3279	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3280	text => $spell->{name},
		3281	can_hover => 1,
		3282	can_events => 1,
		3283	tooltip => $spell->{message},
		3284	expand => 1);
		3285
		3286	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3287	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3288	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3289	expand => 1);
		3290
		3291	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3292	text => "bind to key",
		3293	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3294	}
		3295
		3296	sub rebuild_spell_list {
		3297	my ($self) = @_;
		3298	$self->{tbl_idx} = 0;
		3299	$self->add_spell ($_) for values %{$self->{spells}};
		3300	}
		3301
		3302	sub remove_spell {
		3303	my ($self, $spell) = @_;
		3304	delete $self->{spells}->{$spell->{name}};
		3305	$self->rebuild_spell_list;
		3306	}
		3307
		3308	#############################################################################
		3309
		3310	package CFClient::UI::Root;
		3311
		3312	our @ISA = CFClient::UI::Container::;
		3313
		3314	use CFClient::OpenGL;
		3315
		3316	sub new {
		3317	my $class = shift;
		3318
		3319	my $self = $class->SUPER::new (
2970	visible => 1,	3320	visible => 1,
2971	@_,	3321	@_,
2972	)	3322	);
2973	}
2974		3323
2975	sub configure {	3324	Scalar::Util::weaken ($self->{root} = $self);
2976	my ($self, $x, $y, $w, $h) = @_;
2977		3325
2978	$self->{w} = $w;	3326	$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	}	3327	}
2988		3328
2989	sub size_request {	3329	sub size_request {
2990	my ($self) = @_;	3330	my ($self) = @_;
2991		3331
2992	($self->{w}, $self->{h})	3332	($self->{w}, $self->{h})
		3333	}
		3334
		3335	sub _to_pixel {
		3336	my ($coord, $size, $max) = @_;
		3337
		3338	$coord =
		3339	$coord eq "center" ? ($max - $size) * 0.5
		3340	: $coord eq "max" ? $max
		3341	: $coord;
		3342
		3343	$coord = 0 if $coord < 0;
		3344	$coord = $max - $size if $coord > $max - $size;
		3345
		3346	int $coord + 0.5
2993	}	3347	}
2994		3348
2995	sub size_allocate {	3349	sub size_allocate {
2996	my ($self, $w, $h) = @_;	3350	my ($self, $w, $h) = @_;
2997		3351
2998	for my $child ($self->children) {	3352	for my $child ($self->children) {
2999	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3353	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3000		3354
3001	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3355	$X = $child->{force_x} if exists $child->{force_x};
3002	if exists $child->{req_x};	3356	$Y = $child->{force_y} if exists $child->{force_y};
3003		3357
3004	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3358	$X = _to_pixel $X, $W, $self->{w};
3005	if exists $child->{req_y};	3359	$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		3360
3010	$child->configure ($X, $Y, $W, $H);	3361	$child->configure ($X, $Y, $W, $H);
3011	}	3362	}
3012	}	3363	}
3013		3364
…		…
3024	}	3375	}
3025		3376
3026	sub update {	3377	sub update {
3027	my ($self) = @_;	3378	my ($self) = @_;
3028		3379
3029	$self->check_size;
3030	$::WANT_REFRESH++;	3380	$::WANT_REFRESH++;
3031	}	3381	}
3032		3382
3033	sub add {	3383	sub add {
3034	my ($self, @children) = @_;	3384	my ($self, @children) = @_;
3035		3385
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;	3386	$_->{is_toplevel} = 1
3044		3387	for @children;
3045	# integerise window positions
3046	$child->{x} = int $child->{x};
3047	$child->{y} = int $child->{y};
3048	}
3049		3388
3050	$self->SUPER::add (@children);	3389	$self->SUPER::add (@children);
3051	}	3390	}
3052		3391
3053	sub remove {	3392	sub remove {
3054	my ($self, @children) = @_;	3393	my ($self, @children) = @_;
3055		3394
3056	$self->SUPER::remove (@children);	3395	$self->SUPER::remove (@children);
		3396
		3397	delete $self->{is_toplevel}
		3398	for @children;
3057		3399
3058	while (@children) {	3400	while (@children) {
3059	my $w = pop @children;	3401	my $w = pop @children;
3060	push @children, $w->children;	3402	push @children, $w->children;
3061	$w->set_invisible;	3403	$w->set_invisible;
…		…
3080	while ($self->{refresh_hook}) {	3422	while ($self->{refresh_hook}) {
3081	$_->()	3423	$_->()
3082	for values %{delete $self->{refresh_hook}};	3424	for values %{delete $self->{refresh_hook}};
3083	}	3425	}
3084		3426
3085	if ($self->{check_size}) {	3427	if ($self->{realloc}) {
3086	my @queue = ([], []);	3428	my %queue;
		3429	my @queue;
		3430	my $widget;
3087		3431
3088	for (;;) {	3432	outer:
3089	if ($self->{check_size}) {	3433	while () {
3090	# heuristic: check containers last	3434	if (my $realloc = delete $self->{realloc}) {
3091	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3435	for $widget (values %$realloc) {
3092	for values %{delete $self->{check_size}}	3436	$widget->{visible} or next; # do not resize invisible widgets
		3437
		3438	$queue{$widget+0}++ and next; # duplicates are common
		3439
		3440	push @{ $queue[$widget->{visible}] }, $widget;
		3441	}
3093	}	3442	}
3094		3443
3095	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3444	while () {
		3445	@queue or last outer;
3096		3446
3097	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3447	$widget = pop @{ $queue[-1] || [] }
3098	? @$widget{qw(user_w user_h)}	3448	and last;
3099	: $widget->size_request;
3100
3101	if (delete $widget->{force_alloc}
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		3449
		3450	pop @queue;
		3451	}
		3452
		3453	delete $queue{$widget+0};
		3454
		3455	my ($w, $h) = $widget->size_request;
		3456
		3457	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3458	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3459
		3460	$w = $widget->{force_w} if exists $widget->{force_w};
		3461	$h = $widget->{force_h} if exists $widget->{force_h};
		3462
		3463	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3464	|| delete $widget->{force_realloc}) {
3105	$widget->{req_w} = $w;	3465	$widget->{req_w} = $w;
3106	$widget->{req_h} = $h;	3466	$widget->{req_h} = $h;
3107		3467
3108	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3468	$self->{size_alloc}{$widget+0} = $widget;
3109		3469
3110	$widget->{parent}->check_size
3111	if $widget->{parent};	3470	if (my $parent = $widget->{parent}) {
		3471	$self->{realloc}{$parent+0} = $parent
		3472	unless $queue{$parent+0};
		3473
		3474	$parent->{force_size_alloc} = 1;
		3475	$self->{size_alloc}{$parent+0} = $parent;
		3476	}
3112	}	3477	}
		3478
		3479	delete $self->{realloc}{$widget+0};
3113	}	3480	}
3114	}	3481	}
3115		3482
3116	while ($self->{size_alloc}) {	3483	while (my $size_alloc = delete $self->{size_alloc}) {
3117	for (values %{delete $self->{size_alloc}}) {	3484	my @queue = sort { $b->{visible} <=> $a->{visible} }
3118	my ($widget, $w, $h) = @$_;	3485	values %$size_alloc;
		3486
		3487	while () {
		3488	my $widget = pop @queue || last;
		3489
		3490	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3119		3491
3120	$w = 0 if $w < 0;	3492	$w = 0 if $w < 0;
3121	$h = 0 if $h < 0;	3493	$h = 0 if $h < 0;
3122		3494
		3495	$w = int $w + 0.5;
		3496	$h = int $h + 0.5;
		3497
		3498	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3499	$widget->{old_w} = $widget->{w};
		3500	$widget->{old_h} = $widget->{h};
		3501
3123	$widget->{w} = $w;	3502	$widget->{w} = $w;
3124	$widget->{h} = $h;	3503	$widget->{h} = $h;
		3504
3125	$widget->emit (size_allocate => $w, $h);	3505	$widget->emit (size_allocate => $w, $h);
		3506	}
3126	}	3507	}
3127	}	3508	}
3128		3509
3129	while ($self->{post_alloc_hook}) {	3510	while ($self->{post_alloc_hook}) {
3130	$_->()	3511	$_->()
3131	for values %{delete $self->{post_alloc_hook}};	3512	for values %{delete $self->{post_alloc_hook}};
3132	}	3513	}
		3514
3133		3515
3134	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3516	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3135	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3517	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3136	glClear GL_COLOR_BUFFER_BIT;	3518	glClear GL_COLOR_BUFFER_BIT;
3137		3519
…		…
3139	glLoadIdentity;	3521	glLoadIdentity;
3140	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3522	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3141	glMatrixMode GL_MODELVIEW;	3523	glMatrixMode GL_MODELVIEW;
3142	glLoadIdentity;	3524	glLoadIdentity;
3143		3525
		3526	{
		3527	package CFClient::UI::Base;
		3528
		3529	($draw_x, $draw_y, $draw_w, $draw_h) =
		3530	(0, 0, $self->{w}, $self->{h});
		3531	}
		3532
3144	$self->_draw;	3533	$self->_draw;
3145	}	3534	}
3146		3535
3147	#############################################################################	3536	#############################################################################
3148		3537

Diff Legend

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