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.244 by root, Sat May 27 21:06:09 2006 UTC vs.
Revision 1.269 by root, Fri Jun 2 06:22:55 2006 UTC

…		…
17	our $BUTTON_STATE;	17	our $BUTTON_STATE;
18		18
19	our %WIDGET; # all widgets, weak-referenced	19	our %WIDGET; # all widgets, weak-referenced
20		20
21	sub get_layout {	21	sub get_layout {
		22	my $layout;
		23
22	for (grep { $_->{name} } values %WIDGET) {	24	for (grep { $_->{name} } values %WIDGET) {
23	$LAYOUT->{$_->{name}} = {	25	my $win = $layout->{$_->{name}} = { };
24	x => $_->{x} / $::WIDTH,
25	y => $_->{y} / $::HEIGHT,
26	w => $_->{w} / $::WIDTH,
27	h => $_->{h} / $::HEIGHT
28	};	26
29	}	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};
30		31
31	return $LAYOUT;	32	$win->{show} = $_->{visible} && $_->{is_toplevel};
		33	}
		34
		35	$layout
32	}	36	}
33		37
34	sub set_layout {	38	sub set_layout {
35	my ($layout) = @_;	39	my ($layout) = @_;
		40
36	$LAYOUT = $layout;	41	$LAYOUT = $layout;
37	}	42	}
38		43
39	sub check_tooltip {	44	sub check_tooltip {
		45	return if $ENV{CFPLUS_DEBUG} & 8;
		46
40	if (!$GRAB) {	47	if (!$GRAB) {
41	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	48	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
42	if (length $widget->{tooltip}) {	49	if (length $widget->{tooltip}) {
43
44	if ($TOOLTIP->{owner} != $widget) {	50	if ($TOOLTIP->{owner} != $widget) {
		51	$TOOLTIP->hide;
		52
45	$TOOLTIP->{owner} = $widget;	53	$TOOLTIP->{owner} = $widget;
46		54
47	my $tip = $widget->{tooltip};	55	my $tip = $widget->{tooltip};
48		56
49	$tip = $tip->($widget) if CODE:: eq ref $tip;	57	$tip = $tip->($widget) if CODE:: eq ref $tip;
50		58
51	$TOOLTIP->set_tooltip_from ($widget);	59	$TOOLTIP->set_tooltip_from ($widget);
52	$TOOLTIP->show;	60	$TOOLTIP->show;
53
54	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
55
56	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
57	if $x + $TOOLTIP->{w} > $::WIDTH;
58
59	$TOOLTIP->move ($x, $y);
60	$TOOLTIP->check_size;
61	$TOOLTIP->update;
62	}	61	}
63		62
64	return;	63	return;
65	}	64	}
66	}	65	}
…		…
172	sub rescale_widgets {	171	sub rescale_widgets {
173	my ($sx, $sy) = @_;	172	my ($sx, $sy) = @_;
174		173
175	for my $widget (values %WIDGET) {	174	for my $widget (values %WIDGET) {
176	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
177	$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.]+$/;
178	$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};
179	$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};
180	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
181	$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.]+$/;
182	$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};
183	$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};
184	$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
185	}	189	}
186	}	190	}
187		191
188	reconfigure_widgets;	192	reconfigure_widgets;
189	}	193	}
…		…
198		202
199	sub new {	203	sub new {
200	my $class = shift;	204	my $class = shift;
201		205
202	my $self = bless {	206	my $self = bless {
203	x => 0,	207	x => "center",
204	y => 0,	208	y => "center",
205	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
206	can_events => 1,	212	can_events => 1,
207	@_	213	@_
208	}, $class;	214	}, $class;
		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
209		217
210	for (keys %$self) {	218	for (keys %$self) {
211	if (/^on_(.*)$/) {	219	if (/^on_(.*)$/) {
212	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
213	}	221	}
214	}	222	}
215		223
216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
217
218	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
219	$self->{user_x} = $layout->{x} * $::WIDTH;	225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
220	$self->{user_y} = $layout->{y} * $::HEIGHT;	226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
221	$self->{user_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH;	227	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
222	$self->{user_h} = ($layout->{h} != 0 ? $layout->{h} : 1) * $::HEIGHT;	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};
223	}	234	}
224		235
225	$self	236	$self
226	}	237	}
227		238
…		…
232	%$self = ();	243	%$self = ();
233	}	244	}
234		245
235	sub show {	246	sub show {
236	my ($self) = @_;	247	my ($self) = @_;
		248
237	return if $self->{parent};	249	return if $self->{parent};
238		250
239	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
240	}	252	}
241		253
242	sub show_centered {	254	sub set_visible {
243	my ($self) = @_;	255	my ($self) = @_;
		256
244	return if $self->{parent};	257	return if $self->{visible};
245		258
246	$self->show;	259	$self->{root} = $self->{parent}{root};
		260	$self->{visible} = $self->{parent}{visible} + 1;
247		261
248	$CFClient::UI::ROOT->on_post_alloc (	262	$self->emit (visibility_change => 1);
249	"centered $self" => sub {	263
250	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);	264	$self->realloc if !exists $self->{req_w};
251	},	265
252	);	266	$_->set_visible for $self->children;
253	}	267	}
254		268
255	sub set_invisible {	269	sub set_invisible {
256	my ($self) = @_;	270	my ($self) = @_;
257		271
258	return unless $self->{visible};	272	return unless $self->{visible};
259		273
260	# broken show/hide model	274	$_->set_invisible for $self->children;
261		275
262	delete $self->{root};	276	delete $self->{root};
263	delete $self->{visible};	277	delete $self->{visible};
264		278
265	undef $GRAB if $GRAB == $self;	279	undef $GRAB if $GRAB == $self;
266	undef $HOVER if $HOVER == $self;	280	undef $HOVER if $HOVER == $self;
267		281
268	CFClient::UI::check_tooltip	282	CFClient::UI::check_tooltip
269	if $CFClient::UI::TOOLTIP->{owner} == $self;	283	if $TOOLTIP->{owner} == $self;
270		284
271	$self->focus_out;	285	$self->focus_out;
272		286
273	$self->emit (visibility_change => 0);	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;
274	}	305	}
275		306
276	sub hide {	307	sub hide {
277	my ($self) = @_;	308	my ($self) = @_;
278		309
…		…
280		311
281	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
282	if $self->{parent};	313	if $self->{parent};
283	}	314	}
284		315
285	sub move {	316	sub move_abs {
286	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
287		318
288	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
289	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
290	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
291		322
292	$self->update;	323	$self->update;
293	}	324	}
294		325
295	sub set_size {	326	sub set_size {
296	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
297		328
298	$self->{user_w} = $w;	329	$self->{force_w} = $w;
299	$self->{user_h} = $h;	330	$self->{force_h} = $h;
300		331
301	$self->check_size;	332	$self->realloc;
302	}	333	}
303		334
304	sub size_request {	335	sub size_request {
305	require Carp;	336	require Carp;
306	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
308		339
309	sub configure {	340	sub configure {
310	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
311		342
312	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
313	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
314	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
315		348
316	# use alignment to adjust x, y	349	# use alignment to adjust x, y
317		350
318	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
319	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
320
321	($w, $h) = ($w2, $h2);
322	}	353	}
323		354
324	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
325	$self->{x} = $x;	356	$self->{x} = $x;
326	$self->{y} = $y;	357	$self->{y} = $y;
327	$self->update;	358	$self->update;
328	}	359	}
329		360
330	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
331	$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;
332	}	368	}
333	}	369	}
334		370
335	sub size_allocate {	371	sub size_allocate {
336	# nothing to be done	372	# nothing to be done
337	}
338
339	sub reconfigure {
340	my ($self) = @_;
341
342	$self->check_size (1);
343	$self->update;
344	}	373	}
345		374
346	sub children {	375	sub children {
347	}	376	}
348		377
…		…
421	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
422		451
423	$self->focus_in;	452	$self->focus_in;
424	}	453	}
425		454
426	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	455	sub find_widget {
427	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	456	my ($self, $x, $y) = @_;
428	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	457
429	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	458	return () unless $self->{can_events};
430	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
431		528
432	sub draw {	529	sub draw {
433	my ($self) = @_;	530	my ($self) = @_;
434		531
435	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);
436		543
437	glPushMatrix;	544	glPushMatrix;
438	glTranslate $self->{x}, $self->{y}, 0;	545	glTranslate $self->{x}, $self->{y}, 0;
439	$self->_draw;	546	$self->_draw;
440	glPopMatrix;	547	glPopMatrix;
…		…
452	glVertex $x , $y + $self->{h};	559	glVertex $x , $y + $self->{h};
453	glEnd;	560	glEnd;
454	glDisable GL_BLEND;	561	glDisable GL_BLEND;
455	}	562	}
456		563
457	if ($ENV{PCLIENT_DEBUG}) {	564	if ($ENV{CFPLUS_DEBUG} & 1) {
458	glPushMatrix;	565	glPushMatrix;
459	glColor 1, 1, 0, 1;	566	glColor 1, 1, 0, 1;
460	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	567	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
461	glBegin GL_LINE_LOOP;	568	glBegin GL_LINE_LOOP;
462	glVertex 0 , 0;	569	glVertex 0 , 0;
…		…
473	my ($self) = @_;	580	my ($self) = @_;
474		581
475	warn "no draw defined for $self\n";	582	warn "no draw defined for $self\n";
476	}	583	}
477		584
478	sub find_widget {
479	my ($self, $x, $y) = @_;
480
481	return () unless $self->{can_events};
482
483	return $self
484	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
485	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
486
487	()
488	}
489
490	sub set_parent {
491	my ($self, $parent) = @_;
492
493	Scalar::Util::weaken ($self->{parent} = $parent);
494
495	if ($parent->{visible} || 1) {
496	$self->{root} = $parent->{root};
497	$self->{visible} = $parent->{visible} + 1;
498
499	$self->emit (visibility_change => 1)
500	unless $self->{parent}{visible};
501	}
502
503	# TODO: req_w _does_change after ->reconfigure
504	$self->check_size
505	unless exists $self->{req_w};
506
507	$self->show;
508	}
509
510	sub check_size {
511	my ($self, $forced) = @_;
512
513	$self->{force_alloc} = 1 if $forced;
514	$CFClient::UI::ROOT->{check_size}{$self} = $self;
515	}
516
517	sub update {
518	my ($self) = @_;
519
520	$self->{parent}->update
521	if $self->{parent};
522	}
523
524	sub connect {
525	my ($self, $signal, $cb) = @_;
526
527	push @{ $self->{signal_cb}{$signal} }, $cb;
528	}
529
530	sub _emit {
531	my ($self, $signal, @args) = @_;
532
533	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
534	}
535
536	sub emit {
537	my ($self, $signal, @args) = @_;
538
539	$self->_emit ($signal, @args)
540	|| $self->$signal (@args);
541	}
542
543	sub visibility_change {
544	#my ($self, $visible) = @_;
545	}
546
547	sub DESTROY {	585	sub DESTROY {
548	my ($self) = @_;	586	my ($self) = @_;
549		587
550	delete $WIDGET{$self+0};	588	delete $WIDGET{$self+0};
551	#$self->deactivate;	589	#$self->deactivate;
…		…
607	my ($class, %arg) = @_;	645	my ($class, %arg) = @_;
608	$class->SUPER::new (can_events => 0, %arg);	646	$class->SUPER::new (can_events => 0, %arg);
609	}	647	}
610		648
611	sub size_request {	649	sub size_request {
612	(0, 0)	650	my ($self) = @_;
		651
		652	($self->{w} + 0, $self->{h} + 0)
613	}	653	}
614		654
615	sub draw { }	655	sub draw { }
616		656
617	#############################################################################	657	#############################################################################
…		…
646	$self->{children} = [	686	$self->{children} = [
647	sort { $a->{z} <=> $b->{z} }	687	sort { $a->{z} <=> $b->{z} }
648	@{$self->{children}}, @widgets	688	@{$self->{children}}, @widgets
649	];	689	];
650		690
651	$self->check_size (1);	691	$self->realloc;
652	$self->update;
653	}	692	}
654		693
655	sub children {	694	sub children {
656	@{ $_[0]{children} }	695	@{ $_[0]{children} }
657	}	696	}
…		…
662	delete $child->{parent};	701	delete $child->{parent};
663	$child->hide;	702	$child->hide;
664		703
665	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	704	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
666		705
667	$self->check_size (1);	706	$self->realloc;
668	$self->update;
669	}	707	}
670		708
671	sub clear {	709	sub clear {
672	my ($self) = @_;	710	my ($self) = @_;
673		711
…		…
677	for (@$children) {	715	for (@$children) {
678	delete $_->{parent};	716	delete $_->{parent};
679	$_->hide;	717	$_->hide;
680	}	718	}
681		719
682	$self->check_size;	720	$self->realloc;
683	$self->update;
684	}	721	}
685		722
686	sub find_widget {	723	sub find_widget {
687	my ($self, $x, $y) = @_;	724	my ($self, $x, $y) = @_;
688		725
…		…
775	$self->SUPER::size_allocate ($w, $h);	812	$self->SUPER::size_allocate ($w, $h);
776	$self->update;	813	$self->update;
777	}	814	}
778		815
779	sub _render {	816	sub _render {
		817	my ($self) = @_;
		818
780	$_[0]{children}[0]->draw;	819	$self->{children}[0]->draw;
781	}	820	}
782		821
783	sub render_child {	822	sub render_child {
784	my ($self) = @_;	823	my ($self) = @_;
785		824
786	$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 {
787	glClearColor 0, 0, 0, 0;	826	glClearColor 0, 0, 0, 0;
788	glClear GL_COLOR_BUFFER_BIT;	827	glClear GL_COLOR_BUFFER_BIT;
789		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
790	$self->_render;	836	$self->_render;
791	};	837	};
792	}	838	}
793		839
794	sub _draw {	840	sub _draw {
795	my ($self) = @_;	841	my ($self) = @_;
796		842
797	my ($w, $h) = ($self->w, $self->h);	843	my ($w, $h) = @$self{qw(w h)};
798		844
799	my $tex = $self->{texture}	845	my $tex = $self->{texture}
800	or return;	846	or return;
801		847
802	glEnable GL_TEXTURE_2D;	848	glEnable GL_TEXTURE_2D;
…		…
825	}	871	}
826		872
827	sub size_request {	873	sub size_request {
828	my ($self) = @_;	874	my ($self) = @_;
829		875
830	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	876	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
831		877
832	@$self{qw(child_w child_h)}	878	$w = 10 if $self->{scroll_x};
		879	$h = 10 if $self->{scroll_y};
		880
		881	($w, $h)
833	}	882	}
834		883
835	sub size_allocate {	884	sub size_allocate {
836	my ($self, $w, $h) = @_;	885	my ($self, $w, $h) = @_;
837		886
		887	my $child = $self->child;
		888
838	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	889	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
839	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	890	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
840		891
841	$self->child->configure (0, 0, $w, $h);	892	$self->child->configure (0, 0, $w, $h);
842	$self->update;	893	$self->update;
843	}	894	}
844		895
…		…
879	}	930	}
880	}	931	}
881		932
882	sub _render {	933	sub _render {
883	my ($self) = @_;	934	my ($self) = @_;
		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};
884		938
885	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	939	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
886		940
887	$self->SUPER::_render;	941	$self->SUPER::_render;
888	}	942	}
…		…
987		1041
988	our @ISA = CFClient::UI::Bin::;	1042	our @ISA = CFClient::UI::Bin::;
989		1043
990	use CFClient::OpenGL;	1044	use CFClient::OpenGL;
991		1045
992	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 =
993	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1051	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
994	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);
995		1053
996	sub new {	1054	sub new {
997	my $class = shift;	1055	my ($class, %arg) = @_;
998		1056
999	# TODO: user_x, user_y, overwrite moveto?	1057	my $title = delete $arg{title};
1000		1058
1001	my $self = $class->SUPER::new (	1059	my $self = $class->SUPER::new (
1002	bg => [1, 1, 1, 1],	1060	bg => [1, 1, 1, 1],
1003	border_bg => [1, 1, 1, 1],	1061	border_bg => [1, 1, 1, 1],
1004	border => 0.6,	1062	border => 0.6,
1005	is_toplevel => 1,
1006	can_events => 1,	1063	can_events => 1,
1007	@_	1064	min_w => 16,
		1065	min_h => 16,
		1066	%arg,
1008	);	1067	);
1009		1068
1010	$self->{title} &&= new CFClient::UI::Label	1069	$self->{title} = new CFClient::UI::Label
1011	align => 0,	1070	align => 0,
1012	valign => 1,	1071	valign => 1,
1013	text => $self->{title},	1072	text => $title,
1014	fontsize => $self->{border};	1073	fontsize => $self->{border}
		1074	if defined $title;
1015		1075
1016	$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};
1017	}	1084	}
1018		1085
1019	sub border {	1086	sub border {
1020	int $_[0]{border} * $::FONTSIZE	1087	int $_[0]{border} * $::FONTSIZE
1021	}	1088	}
1022		1089
1023	sub size_request {	1090	sub size_request {
1024	my ($self) = @_;	1091	my ($self) = @_;
		1092
		1093	$self->{title}->size_request
		1094	if $self->{title};
1025		1095
1026	my ($w, $h) = $self->SUPER::size_request;	1096	my ($w, $h) = $self->SUPER::size_request;
1027		1097
1028	(	1098	(
1029	$w + $self->border * 2,	1099	$w + $self->border * 2,
…		…
1032	}	1102	}
1033		1103
1034	sub size_allocate {	1104	sub size_allocate {
1035	my ($self, $w, $h) = @_;	1105	my ($self, $w, $h) = @_;
1036		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
1037	$h -= List::Util::max 0, $self->border * 2;	1115	$h -= List::Util::max 0, $border * 2;
1038	$w -= List::Util::max 0, $self->border * 2;	1116	$w -= List::Util::max 0, $border * 2;
1039		1117
1040	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1041	if $self->{title};
1042
1043	$self->child->configure ($self->border, $self->border, $w, $h);	1118	$self->child->configure ($border, $border, $w, $h);
1044	}	1119	}
1045		1120
1046	sub button_down {	1121	sub button_down {
1047	my ($self, $ev, $x, $y) = @_;	1122	my ($self, $ev, $x, $y) = @_;
1048		1123
…		…
1064	my ($ev, $x, $y) = @_;	1139	my ($ev, $x, $y) = @_;
1065		1140
1066	my $dx = $ev->{x} - $ox;	1141	my $dx = $ev->{x} - $ox;
1067	my $dy = $ev->{y} - $oy;	1142	my $dy = $ev->{y} - $oy;
1068		1143
1069	$self->{user_x} = $wx + $dx * $mx;
1070	$self->{user_y} = $wy + $dy * $my;
1071	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1144	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1072	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1145	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1073	$self->move ($self->{user_x}, $self->{user_y});	1146
1074	$self->check_size;	1147	$self->realloc;
		1148	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1075	};	1149	};
1076		1150
1077	} elsif ($lr ^ $td) {	1151	} elsif ($lr ^ $td) {
1078	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1152	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1079	my ($bx, $by) = ($self->{x}, $self->{y});	1153	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1081	$self->{motion} = sub {	1155	$self->{motion} = sub {
1082	my ($ev, $x, $y) = @_;	1156	my ($ev, $x, $y) = @_;
1083		1157
1084	($x, $y) = ($ev->{x}, $ev->{y});	1158	($x, $y) = ($ev->{x}, $ev->{y});
1085		1159
1086	$self->{user_x} = $bx + $x - $ox;	1160	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1087	$self->{user_y} = $by + $y - $oy;
1088	$self->move ($self->{user_x}, $self->{user_y});
1089	$self->update;
1090	};	1161	};
1091	}	1162	}
1092	}	1163	}
1093		1164
1094	sub button_up {	1165	sub button_up {
…		…
1104	}	1175	}
1105		1176
1106	sub _draw {	1177	sub _draw {
1107	my ($self) = @_;	1178	my ($self) = @_;
1108		1179
		1180	my $child = $self->{children}[0];
		1181
1109	my ($w, $h ) = ($self->{w}, $self->{h});	1182	my ($w, $h ) = ($self->{w}, $self->{h});
1110	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1183	my ($cw, $ch) = ($child->{w}, $child->{h});
1111		1184
1112	glEnable GL_TEXTURE_2D;	1185	glEnable GL_TEXTURE_2D;
1113	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1186	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1114		1187
1115	my $border = $self->border;	1188	my $border = $self->border;
1116		1189
1117	glColor @{ $self->{border_bg} };	1190	glColor @{ $self->{border_bg} };
1118	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1191	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1119	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1192	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1120	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1193	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1121	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1194	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1122		1195
1123	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1196	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1124	my $bg = $tex[0];	1197	glColor @{ $self->{bg} };
1125		1198
1126	# TODO: repeat texture not scale	1199	# TODO: repeat texture not scale
		1200	# solve this better(?)
1127	my $rep_x = $cw / $bg->{w};	1201	$bg->{s} = $cw / $bg->{w};
1128	my $rep_y = $ch / $bg->{h};	1202	$bg->{t} = $ch / $bg->{h};
1129
1130	glColor @{ $self->{bg} };
1131
1132	$bg->{s} = $rep_x;
1133	$bg->{t} = $rep_y;
1134	$bg->{wrap_mode} = 1;
1135	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1203	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1136	}	1204	}
1137		1205
1138	glDisable GL_TEXTURE_2D;	1206	glDisable GL_TEXTURE_2D;
1139		1207
1140	$self->{title}->draw if $self->{title};
1141
1142	$self->child->draw;	1208	$child->draw;
		1209
		1210	if ($self->{title}) {
		1211	glTranslate 0, $border - $self->{h};
		1212	$self->{title}->_draw;
		1213	}
1143	}	1214	}
1144		1215
1145	#############################################################################	1216	#############################################################################
1146		1217
1147	package CFClient::UI::Table;	1218	package CFClient::UI::Table;
…		…
1169	my ($self, $x, $y, $child) = @_;	1240	my ($self, $x, $y, $child) = @_;
1170		1241
1171	$child->set_parent ($self);	1242	$child->set_parent ($self);
1172	$self->{children}[$y][$x] = $child;	1243	$self->{children}[$y][$x] = $child;
1173		1244
1174	$self->check_size (1);	1245	$self->realloc;
1175	}	1246	}
1176		1247
1177	# 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?
1178	sub clear {	1249	sub clear {
1179	my ($self) = @_;	1250	my ($self) = @_;
…		…
1184	for (@children) {	1255	for (@children) {
1185	delete $_->{parent};	1256	delete $_->{parent};
1186	$_->hide;	1257	$_->hide;
1187	}	1258	}
1188		1259
1189	$self->check_size (1);	1260	$self->realloc;
1190	$self->update;
1191	}	1261	}
1192		1262
1193	sub get_wh {	1263	sub get_wh {
1194	my ($self) = @_;	1264	my ($self) = @_;
1195		1265
…		…
1291	}	1361	}
1292	}	1362	}
1293		1363
1294	#############################################################################	1364	#############################################################################
1295		1365
1296	package CFClient::UI::HBox;	1366	package CFClient::UI::Box;
1297
1298	# TODO: wrap into common Box base class
1299		1367
1300	our @ISA = CFClient::UI::Container::;	1368	our @ISA = CFClient::UI::Container::;
1301		1369
1302	sub size_request {	1370	sub size_request {
1303	my ($self) = @_;	1371	my ($self) = @_;
1304		1372
1305	my @alloc = map [$_->size_request], @{$self->{children}};	1373	$self->{vertical}
1306		1374	? (
1307	(	1375	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1308	(List::Util::sum map $_->[0], @alloc),	1376	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1309	(List::Util::max map $_->[1], @alloc),	1377	)
1310	)	1378	: (
		1379	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1380	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1381	)
1311	}	1382	}
1312		1383
1313	sub size_allocate {	1384	sub size_allocate {
1314	my ($self, $w, $h) = @_;	1385	my ($self, $w, $h) = @_;
1315		1386
1316	($h, $w) = ($w, $h);	1387	my $space = $self->{vertical} ? $h : $w;
1317
1318	my $children = $self->{children};	1388	my $children = $self->{children};
1319		1389
1320	my @h = map $_->{req_w}, @$children;	1390	my @req;
1321		1391
1322	my $req_h = List::Util::sum @h;	1392	if ($self->{homogeneous}) {
1323		1393	@req = ($space / (@$children || 1)) x @$children;
1324	if ($req_h > $h) {
1325	# ah well, not enough space
1326	$_ *= $h / $req_h for @h;
1327	} 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 {
1328	my $exp = List::Util::sum map $_->{expand}, @$children;	1402	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1329	$exp ||= 1;
1330		1403
		1404	$space = ($space - $req) / $expand; # remaining space to give away
		1405
		1406	$req[$_] += $space * $children->[$_]{expand}
1331	for (0 .. $#$children) {	1407	for 0 .. $#$children;
1332	my $child = $children->[$_];
1333
1334	my $alloc_h = $h[$_];
1335	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1336	$h[$_] = $alloc_h;
1337	}	1408	}
1338	}	1409	}
1339		1410
1340	CFClient::UI::harmonize \@h;	1411	CFClient::UI::harmonize \@req;
1341		1412
1342	my $y = 0;	1413	my $pos = 0;
1343	for (0 .. $#$children) {	1414	for (0 .. $#$children) {
1344	my $child = $children->[$_];
1345	my $h = $h[$_];	1415	my $alloc = $req[$_];
1346	$child->configure ($y, 0, $h, $w);	1416	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1347		1417
1348	$y += $h;	1418	$pos += $alloc;
1349	}	1419	}
1350		1420
1351	1	1421	1
1352	}	1422	}
1353		1423
1354	#############################################################################	1424	#############################################################################
1355		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
1356	package CFClient::UI::VBox;	1441	package CFClient::UI::VBox;
1357		1442
1358	# TODO: wrap into common Box base class
1359
1360	our @ISA = CFClient::UI::Container::;	1443	our @ISA = CFClient::UI::Box::;
1361		1444
1362	sub size_request {	1445	sub new {
1363	my ($self) = @_;	1446	my $class = shift;
1364		1447
1365	my @alloc = map [$_->size_request], @{$self->{children}};	1448	$class->SUPER::new (
1366		1449	vertical => 1,
1367	(	1450	@_,
1368	(List::Util::max map $_->[0], @alloc),
1369	(List::Util::sum map $_->[1], @alloc),
1370	)	1451	)
1371	}
1372
1373	sub size_allocate {
1374	my ($self, $w, $h) = @_;
1375
1376	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1377
1378	my $children = $self->{children};
1379
1380	my @h = map $_->{req_h}, @$children;
1381
1382	my $req_h = List::Util::sum @h;
1383
1384	if ($req_h > $h) {
1385	# ah well, not enough space
1386	$_ *= $h / $req_h for @h;
1387	} else {
1388	my $exp = List::Util::sum map $_->{expand}, @$children;
1389	$exp ||= 1;
1390
1391	for (0 .. $#$children) {
1392	my $child = $children->[$_];
1393
1394	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1395	}
1396	}
1397
1398	CFClient::UI::harmonize \@h;
1399
1400	my $y = 0;
1401	for (0 .. $#$children) {
1402	my $child = $children->[$_];
1403	my $h = $h[$_];
1404	$child->configure (0, $y, $w, $h);
1405
1406	$y += $h;
1407	}
1408
1409	1
1410	}	1452	}
1411		1453
1412	#############################################################################	1454	#############################################################################
1413		1455
1414	package CFClient::UI::Label;	1456	package CFClient::UI::Label;
…		…
1431	ellipsise => 3, # end	1473	ellipsise => 3, # end
1432	layout => (new CFClient::Layout),	1474	layout => (new CFClient::Layout),
1433	fontsize => 1,	1475	fontsize => 1,
1434	align => -1,	1476	align => -1,
1435	valign => -1,	1477	valign => -1,
1436	padding => 2,	1478	padding_x => 2,
		1479	padding_y => 2,
1437	can_events => 0,	1480	can_events => 0,
1438	%arg	1481	%arg
1439	);	1482	);
1440		1483
1441	if (exists $self->{template}) {	1484	if (exists $self->{template}) {
…		…
1477	$self->{text} = "T$text";	1520	$self->{text} = "T$text";
1478		1521
1479	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1522	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1480	$self->{layout}->set_text ($text);	1523	$self->{layout}->set_text ($text);
1481		1524
		1525	$self->realloc;
1482	$self->update;	1526	$self->update;
1483	$self->check_size;
1484	}	1527	}
1485		1528
1486	sub set_markup {	1529	sub set_markup {
1487	my ($self, $markup) = @_;	1530	my ($self, $markup) = @_;
1488		1531
…		…
1492	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1535	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1493		1536
1494	$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;
1495	$self->{layout}->set_markup ($markup);	1538	$self->{layout}->set_markup ($markup);
1496		1539
		1540	$self->realloc;
1497	$self->update;	1541	$self->update;
1498	$self->check_size;
1499	}	1542	}
1500		1543
1501	sub size_request {	1544	sub size_request {
1502	my ($self) = @_;	1545	my ($self) = @_;
1503		1546
…		…
1517		1560
1518	$w = List::Util::max $w, $w2;	1561	$w = List::Util::max $w, $w2;
1519	$h = List::Util::max $h, $h2;	1562	$h = List::Util::max $h, $h2;
1520	}	1563	}
1521		1564
1522	(	1565	($w, $h)
1523	$w + $self->{padding} * 2,
1524	$h + $self->{padding} * 2,
1525	)
1526	}	1566	}
1527		1567
1528	sub size_allocate {	1568	sub size_allocate {
1529	my ($self, $w, $h) = @_;	1569	my ($self, $w, $h) = @_;
1530		1570
		1571	delete $self->{ox};
		1572
1531	delete $self->{texture};	1573	delete $self->{texture}
		1574	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1532	}	1575	}
1533		1576
1534	sub set_fontsize {	1577	sub set_fontsize {
1535	my ($self, $fontsize) = @_;	1578	my ($self, $fontsize) = @_;
1536		1579
1537	$self->{fontsize} = $fontsize;	1580	$self->{fontsize} = $fontsize;
1538	delete $self->{texture};	1581	delete $self->{texture};
1539		1582
1540	$self->update;	1583	$self->realloc;
1541	$self->check_size;
1542	}	1584	}
1543		1585
1544	sub _draw {	1586	sub _draw {
1545	my ($self) = @_;	1587	my ($self) = @_;
1546		1588
…		…
1552	$self->{layout}->set_width ($self->{w});	1594	$self->{layout}->set_width ($self->{w});
1553	$self->{layout}->set_ellipsise ($self->{ellipsise});	1595	$self->{layout}->set_ellipsise ($self->{ellipsise});
1554	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1596	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1555	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1597	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1556		1598
1557	my $tex = new_from_layout CFClient::Texture $self->{layout};	1599	new_from_layout CFClient::Texture $self->{layout}
		1600	};
1558		1601
		1602	unless (exists $self->{ox}) {
1559	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1603	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1560	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1604	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1561	: ($self->{w} - $tex->{w}) * 0.5);	1605	: ($self->{w} - $tex->{w}) * 0.5);
1562		1606
1563	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1607	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1564	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1608	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1565	: ($self->{h} - $tex->{h}) * 0.5);	1609	: ($self->{h} - $tex->{h}) * 0.5);
1566
1567	$tex
1568	};	1610	};
1569		1611
1570	glEnable GL_TEXTURE_2D;	1612	glEnable GL_TEXTURE_2D;
1571	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1613	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1572		1614
…		…
1626	sub set_text {	1668	sub set_text {
1627	my ($self, $text) = @_;	1669	my ($self, $text) = @_;
1628		1670
1629	$self->{cursor} = length $text;	1671	$self->{cursor} = length $text;
1630	$self->_set_text ($text);	1672	$self->_set_text ($text);
1631	$self->update;	1673
1632	$self->check_size;	1674	$self->realloc;
1633	}	1675	}
1634		1676
1635	sub get_text {	1677	sub get_text {
1636	$_[0]{text}	1678	$_[0]{text}
1637	}	1679	}
…		…
1670	} elsif ($uni) {	1712	} elsif ($uni) {
1671	substr $text, $self->{cursor}++, 0, chr $uni;	1713	substr $text, $self->{cursor}++, 0, chr $uni;
1672	}	1714	}
1673		1715
1674	$self->_set_text ($text);	1716	$self->_set_text ($text);
1675	$self->update;	1717
1676	$self->check_size;	1718	$self->realloc;
1677	}	1719	}
1678		1720
1679	sub focus_in {	1721	sub focus_in {
1680	my ($self) = @_;	1722	my ($self) = @_;
1681		1723
…		…
1808		1850
1809	sub new {	1851	sub new {
1810	my $class = shift;	1852	my $class = shift;
1811		1853
1812	$class->SUPER::new (	1854	$class->SUPER::new (
1813	padding => 4,	1855	padding_x => 4,
		1856	padding_y => 4,
1814	fg => [1, 1, 1],	1857	fg => [1, 1, 1],
1815	active_fg => [0, 0, 1],	1858	active_fg => [0, 0, 1],
1816	can_hover => 1,	1859	can_hover => 1,
1817	align => 0,	1860	align => 0,
1818	valign => 0,	1861	valign => 0,
…		…
1865		1908
1866	sub new {	1909	sub new {
1867	my $class = shift;	1910	my $class = shift;
1868		1911
1869	$class->SUPER::new (	1912	$class->SUPER::new (
1870	padding => 2,	1913	padding_x => 2,
		1914	padding_y => 2,
1871	fg => [1, 1, 1],	1915	fg => [1, 1, 1],
1872	active_fg => [1, 1, 0],	1916	active_fg => [1, 1, 0],
1873	bg => [0, 0, 0, 0.2],	1917	bg => [0, 0, 0, 0.2],
1874	active_bg => [1, 1, 1, 0.5],	1918	active_bg => [1, 1, 1, 0.5],
1875	state => 0,	1919	state => 0,
…		…
1879	}	1923	}
1880		1924
1881	sub size_request {	1925	sub size_request {
1882	my ($self) = @_;	1926	my ($self) = @_;
1883		1927
1884	($self->{padding} * 2 + 6) x 2	1928	(6) x 2
1885	}	1929	}
1886		1930
1887	sub button_down {	1931	sub button_down {
1888	my ($self, $ev, $x, $y) = @_;	1932	my ($self, $ev, $x, $y) = @_;
1889		1933
1890	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1934	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1891	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1935	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1892	$self->{state} = !$self->{state};	1936	$self->{state} = !$self->{state};
1893	$self->_emit (changed => $self->{state});	1937	$self->_emit (changed => $self->{state});
1894	}	1938	}
1895	}	1939	}
1896		1940
1897	sub _draw {	1941	sub _draw {
1898	my ($self) = @_;	1942	my ($self) = @_;
1899		1943
1900	$self->SUPER::_draw;	1944	$self->SUPER::_draw;
1901		1945
1902	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1946	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1903		1947
1904	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;
1905		1951
1906	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1952	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1907		1953
1908	my $tex = $self->{state} ? $tex[1] : $tex[0];	1954	my $tex = $self->{state} ? $tex[1] : $tex[0];
1909		1955
…		…
2174	fg => [1, 1, 1],	2220	fg => [1, 1, 1],
2175	active_fg => [0, 0, 0],	2221	active_fg => [0, 0, 0],
2176	bg => [0, 0, 0, 0.2],	2222	bg => [0, 0, 0, 0.2],
2177	active_bg => [1, 1, 1, 0.5],	2223	active_bg => [1, 1, 1, 0.5],
2178	range => [0, 0, 100, 10, 0],	2224	range => [0, 0, 100, 10, 0],
2179	req_w => $::WIDTH / 80,	2225	min_w => $::WIDTH / 80,
2180	req_h => $::WIDTH / 80,	2226	min_h => $::WIDTH / 80,
2181	vertical => 0,	2227	vertical => 0,
2182	can_hover => 1,	2228	can_hover => 1,
2183	inner_pad => 0.02,	2229	inner_pad => 0.02,
2184	@_	2230	@_
2185	);	2231	);
…		…
2188	$self->update;	2234	$self->update;
2189		2235
2190	$self	2236	$self
2191	}	2237	}
2192		2238
		2239	sub changed { }
		2240
2193	sub set_range {	2241	sub set_range {
2194	my ($self, $range) = @_;	2242	my ($self, $range) = @_;
2195		2243
2196	($range, $self->{range}) = ($self->{range}, $range);	2244	($range, $self->{range}) = ($self->{range}, $range);
2197		2245
…		…
2223	}	2271	}
2224		2272
2225	sub size_request {	2273	sub size_request {
2226	my ($self) = @_;	2274	my ($self) = @_;
2227		2275
2228	my $w = $self->{req_w};	2276	($self->{req_w}, $self->{req_h})
2229	my $h = $self->{req_h};
2230
2231	$self->{vertical} ? ($h, $w) : ($w, $h)
2232	}	2277	}
2233		2278
2234	sub button_down {	2279	sub button_down {
2235	my ($self, $ev, $x, $y) = @_;	2280	my ($self, $ev, $x, $y) = @_;
2236		2281
…		…
2592	state => 0,	2637	state => 0,
2593	on_activate => \&toggle_flopper,	2638	on_activate => \&toggle_flopper,
2594	@_	2639	@_
2595	);	2640	);
2596		2641
2597	if ($self->{state}) {
2598	$self->{state} = 0;
2599	$self->toggle_flopper;
2600	}
2601
2602	$self	2642	$self
2603	}	2643	}
2604		2644
2605	sub toggle_flopper {	2645	sub toggle_flopper {
2606	my ($self) = @_;	2646	my ($self) = @_;
2607		2647
2608	# TODO: use animation	2648	$self->{other}->toggle_visibility;
2609	if ($self->{state} = !$self->{state}) {
2610	$CFClient::UI::ROOT->add ($self->{other});
2611	$self->{other}->move ($self->coord2global (0, $self->{h}));
2612	$self->_emit ("open");
2613	} else {
2614	$CFClient::UI::ROOT->remove ($self->{other});
2615	$self->_emit ("close");
2616	}
2617
2618	$self->_emit (changed => $self->{state});
2619	}	2649	}
2620		2650
2621	#############################################################################	2651	#############################################################################
2622		2652
2623	package CFClient::UI::Tooltip;	2653	package CFClient::UI::Tooltip;
…		…
2636	}	2666	}
2637		2667
2638	sub set_tooltip_from {	2668	sub set_tooltip_from {
2639	my ($self, $widget) = @_;	2669	my ($self, $widget) = @_;
2640		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
2641	$self->add (new CFClient::UI::Label	2680	$self->add (new CFClient::UI::Label
2642	markup => $widget->{tooltip},	2681	markup => $tooltip,
2643	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2682	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2644	fontsize => 0.8,	2683	fontsize => 0.8,
2645	fg => [0, 0, 0, 1],	2684	fg => [0, 0, 0, 1],
2646	ellipsise => 0,	2685	ellipsise => 0,
2647	font => ($widget->{tooltip_font} || $::FONT_PROP),	2686	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2658		2697
2659	sub size_allocate {	2698	sub size_allocate {
2660	my ($self, $w, $h) = @_;	2699	my ($self, $w, $h) = @_;
2661		2700
2662	$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	});
2663	}	2720	}
2664		2721
2665	sub _draw {	2722	sub _draw {
2666	my ($self) = @_;	2723	my ($self) = @_;
2667		2724
…		…
2684	glVertex $w, $h;	2741	glVertex $w, $h;
2685	glVertex $w, 0;	2742	glVertex $w, 0;
2686	glEnd;	2743	glEnd;
2687		2744
2688	glTranslate 2 - 0.375, 2 - 0.375;	2745	glTranslate 2 - 0.375, 2 - 0.375;
		2746
2689	$self->SUPER::_draw;	2747	$self->SUPER::_draw;
2690	}	2748	}
2691		2749
2692	#############################################################################	2750	#############################################################################
2693		2751
…		…
2769	$self->SUPER::DESTROY;	2827	$self->SUPER::DESTROY;
2770	}	2828	}
2771		2829
2772	#############################################################################	2830	#############################################################################
2773		2831
2774	package CFClient::UI::Inventory;
2775
2776	our @ISA = CFClient::UI::ScrolledWindow::;
2777
2778	sub new {
2779	my $class = shift;
2780
2781	my $self = $class->SUPER::new (
2782	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2783	@_,
2784	);
2785
2786	$self
2787	}
2788
2789	sub set_items {
2790	my ($self, $items) = @_;
2791
2792	$self->{scrolled}->clear;
2793	return unless $items;
2794
2795	my @items = sort {
2796	($a->{type} <=> $b->{type})
2797	or ($a->{name} cmp $b->{name})
2798	} @$items;
2799
2800	$self->{real_items} = \@items;
2801
2802	my $row = 0;
2803	for my $item (@items) {
2804	CFClient::Item::update_widgets $item;
2805
2806	$self->{scrolled}->add (0, $row, $item->{face_widget});
2807	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2808	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2809
2810	$row++;
2811	}
2812	}
2813
2814	sub size_request {
2815	my ($self) = @_;
2816	($self->{req_w}, $self->{req_h});
2817	}
2818
2819	#############################################################################
2820
2821	package CFClient::UI::Menu;	2832	package CFClient::UI::Menu;
2822		2833
2823	our @ISA = CFClient::UI::FancyFrame::;	2834	our @ISA = CFClient::UI::FancyFrame::;
2824		2835
2825	use CFClient::OpenGL;	2836	use CFClient::OpenGL;
…		…
2863	# maybe save $GRAB? must be careful about events...	2874	# maybe save $GRAB? must be careful about events...
2864	$GRAB = $self;	2875	$GRAB = $self;
2865	$self->{button} = $ev->{button};	2876	$self->{button} = $ev->{button};
2866		2877
2867	$self->show;	2878	$self->show;
2868	$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);
2869	}	2880	}
2870		2881
2871	sub mouse_motion {	2882	sub mouse_motion {
2872	my ($self, $ev, $x, $y) = @_;	2883	my ($self, $ev, $x, $y) = @_;
2873		2884
…		…
2998	$self->SUPER::reconfigure;	3009	$self->SUPER::reconfigure;
2999	}	3010	}
3000		3011
3001	#############################################################################	3012	#############################################################################
3002		3013
3003	package CFClient::UI::Root;	3014	package CFClient::UI::Inventory;
3004		3015
3005	our @ISA = CFClient::UI::Container::;	3016	our @ISA = CFClient::UI::ScrolledWindow::;
3006
3007	use CFClient::OpenGL;
3008		3017
3009	sub new {	3018	sub new {
3010	my $class = shift;	3019	my $class = shift;
3011		3020
3012	$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	# if $commit is true, the binding will be set after the user entered a key combo
		3157	sub ask_for_bind {
		3158	my ($self, $commit) = @_;
		3159
		3160	CFClient::Binder::open_binding_dialog (sub {
		3161	my ($mod, $sym) = @_;
		3162	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3163	$self->update_binding_widgets;
		3164	$self->commit if $commit;
		3165	});
		3166	}
		3167
		3168	# $mod and $sym are the modifiers and key symbol
		3169	# $cmds is a array ref of strings (the commands)
		3170	# $cb is the callback that is executed on OK
		3171	# $ccb is the callback that is executed on CANCEL and
		3172	# when the binding was unsuccessful on OK
		3173	sub set_binding {
		3174	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3175
		3176	$self->clear_command_list;
		3177	$self->{recording} = 0;
		3178	$self->{rec_btn}->set_text ("start recording");
		3179
		3180	$self->{binding} = [$mod, $sym];
		3181	$self->{commands} = $cmds;
		3182
		3183	$self->{binding_change} = $cb;
		3184	$self->{binding_cancel} = $ccb;
		3185
		3186	$self->update_binding_widgets;
		3187	}
		3188
		3189	# this is a shortcut method that asks for a binding
		3190	# and then just binds it.
		3191	sub do_quick_binding {
		3192	my ($self, $cmds) = @_;
		3193	$self->set_binding (undef, undef, $cmds, sub {
		3194	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3195	});
		3196	$self->ask_for_bind (1);
		3197	}
		3198
		3199	sub update_binding_widgets {
		3200	my ($self) = @_;
		3201	my ($mod, $sym, $cmds) = $self->get_binding;
		3202	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3203	$self->set_command_list ($cmds);
		3204	}
		3205
		3206	sub get_binding {
		3207	my ($self) = @_;
		3208	return (
		3209	$self->{binding}->[0],
		3210	$self->{binding}->[1],
		3211	[ grep { defined $_ } @{$self->{commands}} ]
		3212	);
		3213	}
		3214
		3215	sub clear_command_list {
		3216	my ($self) = @_;
		3217	$self->{cmdbox}->clear ();
		3218	}
		3219
		3220	sub set_command_list {
		3221	my ($self, $cmds) = @_;
		3222
		3223	$self->{cmdbox}->clear ();
		3224	$self->{commands} = $cmds;
		3225
		3226	my $idx = 0;
		3227
		3228	for (@$cmds) {
		3229	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3230
		3231	my $i = $idx;
		3232	$hb->add (new CFClient::UI::Label text => $_);
		3233	$hb->add (new CFClient::UI::Button
		3234	text => "delete",
		3235	tooltip => "Deletes the action from the record",
		3236	on_activate => sub {
		3237	$self->{cmdbox}->remove ($hb);
		3238	$cmds->[$i] = undef;
		3239	});
		3240
		3241
		3242	$idx++
		3243	}
		3244	}
		3245
		3246	#############################################################################
		3247
		3248	package CFClient::UI::SpellList;
		3249
		3250	our @ISA = CFClient::UI::FancyFrame::;
		3251
		3252	sub new {
		3253	my $class = shift;
		3254
		3255	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3256
		3257	$self->add (new CFClient::UI::ScrolledWindow
		3258	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3259
		3260	$self;
		3261	}
		3262
		3263	# XXX: Do sorting? Argl...
		3264	sub add_spell {
		3265	my ($self, $spell) = @_;
		3266	$self->{spells}->{$spell->{name}} = $spell;
		3267
		3268	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3269	face => $spell->{face},
		3270	can_hover => 1,
		3271	can_events => 1,
		3272	tooltip => $spell->{message});
		3273
		3274	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3275	text => $spell->{name},
		3276	can_hover => 1,
		3277	can_events => 1,
		3278	tooltip => $spell->{message},
		3279	expand => 1);
		3280
		3281	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3282	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3283	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3284	expand => 1);
		3285
		3286	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3287	text => "bind to key",
		3288	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3289	}
		3290
		3291	sub rebuild_spell_list {
		3292	my ($self) = @_;
		3293	$self->{tbl_idx} = 0;
		3294	$self->add_spell ($_) for values %{$self->{spells}};
		3295	}
		3296
		3297	sub remove_spell {
		3298	my ($self, $spell) = @_;
		3299	delete $self->{spells}->{$spell->{name}};
		3300	$self->rebuild_spell_list;
		3301	}
		3302
		3303	#############################################################################
		3304
		3305	package CFClient::UI::Root;
		3306
		3307	our @ISA = CFClient::UI::Container::;
		3308
		3309	use CFClient::OpenGL;
		3310
		3311	sub new {
		3312	my $class = shift;
		3313
		3314	my $self = $class->SUPER::new (
3013	visible => 1,	3315	visible => 1,
3014	@_,	3316	@_,
3015	)	3317	);
3016	}
3017		3318
3018	sub configure {	3319	Scalar::Util::weaken ($self->{root} = $self);
3019	my ($self, $x, $y, $w, $h) = @_;
3020		3320
3021	$self->{w} = $w;	3321	$self
3022	$self->{h} = $h;
3023	}
3024
3025	sub check_size {
3026	my ($self) = @_;
3027
3028	$self->size_allocate ($self->{w}, $self->{h})
3029	if $self->{w};
3030	}	3322	}
3031		3323
3032	sub size_request {	3324	sub size_request {
3033	my ($self) = @_;	3325	my ($self) = @_;
3034		3326
3035	($self->{w}, $self->{h})	3327	($self->{w}, $self->{h})
		3328	}
		3329
		3330	sub _to_pixel {
		3331	my ($coord, $size, $max) = @_;
		3332
		3333	$coord =
		3334	$coord eq "center" ? ($max - $size) * 0.5
		3335	: $coord eq "max" ? $max
		3336	: $coord;
		3337
		3338	$coord = 0 if $coord < 0;
		3339	$coord = $max - $size if $coord > $max - $size;
		3340
		3341	int $coord + 0.5
3036	}	3342	}
3037		3343
3038	sub size_allocate {	3344	sub size_allocate {
3039	my ($self, $w, $h) = @_;	3345	my ($self, $w, $h) = @_;
3040		3346
3041	for my $child ($self->children) {	3347	for my $child ($self->children) {
3042	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3348	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3043		3349
3044	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3350	$X = $child->{force_x} if exists $child->{force_x};
3045	if exists $child->{req_x};	3351	$Y = $child->{force_y} if exists $child->{force_y};
3046		3352
3047	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3353	$X = _to_pixel $X, $W, $self->{w};
3048	if exists $child->{req_y};	3354	$Y = _to_pixel $Y, $H, $self->{h};
3049
3050	$X = $self->{user_x} if exists $self->{user_x};
3051	$Y = $self->{user_y} if exists $self->{user_y};
3052
3053	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3054	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3055		3355
3056	$child->configure ($X, $Y, $W, $H);	3356	$child->configure ($X, $Y, $W, $H);
3057	}	3357	}
3058	}	3358	}
3059		3359
…		…
3070	}	3370	}
3071		3371
3072	sub update {	3372	sub update {
3073	my ($self) = @_;	3373	my ($self) = @_;
3074		3374
3075	$self->check_size;
3076	$::WANT_REFRESH++;	3375	$::WANT_REFRESH++;
3077	}	3376	}
3078		3377
3079	sub add {	3378	sub add {
3080	my ($self, @children) = @_;	3379	my ($self, @children) = @_;
3081		3380
3082	for (my @widgets = @children; my $w = pop @widgets; ) {
3083	push @widgets, $w->children;
3084	$w->{root} = $self;
3085	$w->{visible} = $self->{visible} + 1;
3086	}
3087
3088	for my $child (@children) {
3089	$child->{is_toplevel} = 1;	3381	$_->{is_toplevel} = 1
3090		3382	for @children;
3091	# integerise window positions
3092	$child->{x} = int $child->{x};
3093	$child->{y} = int $child->{y};
3094	}
3095		3383
3096	$self->SUPER::add (@children);	3384	$self->SUPER::add (@children);
3097	}	3385	}
3098		3386
3099	sub remove {	3387	sub remove {
3100	my ($self, @children) = @_;	3388	my ($self, @children) = @_;
3101		3389
3102	$self->SUPER::remove (@children);	3390	$self->SUPER::remove (@children);
		3391
		3392	delete $self->{is_toplevel}
		3393	for @children;
3103		3394
3104	while (@children) {	3395	while (@children) {
3105	my $w = pop @children;	3396	my $w = pop @children;
3106	push @children, $w->children;	3397	push @children, $w->children;
3107	$w->set_invisible;	3398	$w->set_invisible;
…		…
3126	while ($self->{refresh_hook}) {	3417	while ($self->{refresh_hook}) {
3127	$_->()	3418	$_->()
3128	for values %{delete $self->{refresh_hook}};	3419	for values %{delete $self->{refresh_hook}};
3129	}	3420	}
3130		3421
3131	if ($self->{check_size}) {	3422	if ($self->{realloc}) {
		3423	my %queue;
3132	my @queue;	3424	my @queue;
		3425	my $widget;
3133		3426
3134	for (;;) {	3427	outer:
3135	if ($self->{check_size}) {	3428	while () {
3136	#TODO use array-of-depth approach	3429	if (my $realloc = delete $self->{realloc}) {
		3430	for $widget (values %$realloc) {
		3431	$widget->{visible} or next; # do not resize invisible widgets
3137		3432
3138	@queue = sort { $a->{visible} <=> $b->{visible} }	3433	$queue{$widget+0}++ and next; # duplicates are common
3139	@queue, values %{delete $self->{check_size}};	3434
		3435	push @{ $queue[$widget->{visible}] }, $widget;
		3436	}
3140	}	3437	}
3141		3438
		3439	while () {
		3440	@queue or last outer;
		3441
3142	my $widget = pop @queue || last;	3442	$widget = pop @{ $queue[-1] || [] }
3143		3443	and last;
3144	defined $widget->{visible} or last; # do not resize invisible widgets
3145
3146	my ($w, $h) = $widget->{user_w} && $widget->{user_h}
3147	? @$widget{qw(user_w user_h)}
3148	: $widget->size_request;
3149
3150	if (delete $widget->{force_alloc}
3151	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3152	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3153		3444
		3445	pop @queue;
		3446	}
		3447
		3448	delete $queue{$widget+0};
		3449
		3450	my ($w, $h) = $widget->size_request;
		3451
		3452	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3453	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3454
		3455	$w = $widget->{force_w} if exists $widget->{force_w};
		3456	$h = $widget->{force_h} if exists $widget->{force_h};
		3457
		3458	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3459	|| delete $widget->{force_realloc}) {
3154	$widget->{req_w} = $w;	3460	$widget->{req_w} = $w;
3155	$widget->{req_h} = $h;	3461	$widget->{req_h} = $h;
3156		3462
3157	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3463	$self->{size_alloc}{$widget+0} = $widget;
3158		3464
3159	$widget->{parent}->check_size
3160	if $widget->{parent};	3465	if (my $parent = $widget->{parent}) {
		3466	$self->{realloc}{$parent+0} = $parent
		3467	unless $queue{$parent+0};
		3468
		3469	$parent->{force_size_alloc} = 1;
		3470	$self->{size_alloc}{$parent+0} = $parent;
		3471	}
3161	}	3472	}
		3473
		3474	delete $self->{realloc}{$widget+0};
3162	}	3475	}
3163	}	3476	}
3164		3477
3165	while ($self->{size_alloc}) {	3478	while (my $size_alloc = delete $self->{size_alloc}) {
3166	for (values %{delete $self->{size_alloc}}) {	3479	my @queue = sort { $b->{visible} <=> $a->{visible} }
3167	my ($widget, $w, $h) = @$_;	3480	values %$size_alloc;
		3481
		3482	while () {
		3483	my $widget = pop @queue || last;
		3484
		3485	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3168		3486
3169	$w = 0 if $w < 0;	3487	$w = 0 if $w < 0;
3170	$h = 0 if $h < 0;	3488	$h = 0 if $h < 0;
3171		3489
		3490	$w = int $w + 0.5;
		3491	$h = int $h + 0.5;
		3492
		3493	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3494	$widget->{old_w} = $widget->{w};
		3495	$widget->{old_h} = $widget->{h};
		3496
3172	$widget->{w} = $w;	3497	$widget->{w} = $w;
3173	$widget->{h} = $h;	3498	$widget->{h} = $h;
		3499
3174	$widget->emit (size_allocate => $w, $h);	3500	$widget->emit (size_allocate => $w, $h);
		3501	}
3175	}	3502	}
3176	}	3503	}
3177		3504
3178	while ($self->{post_alloc_hook}) {	3505	while ($self->{post_alloc_hook}) {
3179	$_->()	3506	$_->()
3180	for values %{delete $self->{post_alloc_hook}};	3507	for values %{delete $self->{post_alloc_hook}};
3181	}	3508	}
		3509
3182		3510
3183	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3511	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3184	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3512	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3185	glClear GL_COLOR_BUFFER_BIT;	3513	glClear GL_COLOR_BUFFER_BIT;
3186		3514
…		…
3188	glLoadIdentity;	3516	glLoadIdentity;
3189	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3517	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3190	glMatrixMode GL_MODELVIEW;	3518	glMatrixMode GL_MODELVIEW;
3191	glLoadIdentity;	3519	glLoadIdentity;
3192		3520
		3521	{
		3522	package CFClient::UI::Base;
		3523
		3524	($draw_x, $draw_y, $draw_w, $draw_h) =
		3525	(0, 0, $self->{w}, $self->{h});
		3526	}
		3527
3193	$self->_draw;	3528	$self->_draw;
3194	}	3529	}
3195		3530
3196	#############################################################################	3531	#############################################################################
3197		3532

Diff Legend

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