[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.250 by root, Sun May 28 02:31:03 2006 UTC vs.
Revision 1.263 by elmex, Wed May 31 14:04:52 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 {
40	if (!$GRAB) {	45	if (!$GRAB) {
41	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	46	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
42	if (length $widget->{tooltip}) {	47	if (length $widget->{tooltip}) {
43		48
44	if ($TOOLTIP->{owner} != $widget) {	49	if ($TOOLTIP->{owner} != $widget) {
		50	$TOOLTIP->hide;
		51
45	$TOOLTIP->{owner} = $widget;	52	$TOOLTIP->{owner} = $widget;
46		53
47	my $tip = $widget->{tooltip};	54	my $tip = $widget->{tooltip};
48		55
49	$tip = $tip->($widget) if CODE:: eq ref $tip;	56	$tip = $tip->($widget) if CODE:: eq ref $tip;
50		57
51	$TOOLTIP->set_tooltip_from ($widget);	58	$TOOLTIP->set_tooltip_from ($widget);
52	$TOOLTIP->show;	59	$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	}	60	}
63		61
64	return;	62	return;
65	}	63	}
66	}	64	}
…		…
172	sub rescale_widgets {	170	sub rescale_widgets {
173	my ($sx, $sy) = @_;	171	my ($sx, $sy) = @_;
174		172
175	for my $widget (values %WIDGET) {	173	for my $widget (values %WIDGET) {
176	if ($widget->{is_toplevel}) {	174	if ($widget->{is_toplevel}) {
		175	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		176	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		177
177	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};	178	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
178	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};	179	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
179	$widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};	180	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
180	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};	181	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
181	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	182	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
182	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};	183	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
		184
		185	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		186	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		187
183	}	188	}
184	}	189	}
185		190
186	reconfigure_widgets;	191	reconfigure_widgets;
187	}	192	}
…		…
196		201
197	sub new {	202	sub new {
198	my $class = shift;	203	my $class = shift;
199		204
200	my $self = bless {	205	my $self = bless {
201	x => 0,	206	x => "center",
202	y => 0,	207	y => "center",
203	z => 0,	208	z => 0,
		209	w => undef,
		210	h => undef,
204	can_events => 1,	211	can_events => 1,
205	@_	212	@_
206	}, $class;	213	}, $class;
		214
		215	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
207		216
208	for (keys %$self) {	217	for (keys %$self) {
209	if (/^on_(.*)$/) {	218	if (/^on_(.*)$/) {
210	$self->connect ($1 => delete $self->{$_});	219	$self->connect ($1 => delete $self->{$_});
211	}	220	}
212	}	221	}
213		222
214	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
215
216	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	223	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
217	$self->{req_x} = $layout->{x} * $::WIDTH;	224	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
218	$self->{req_y} = $layout->{y} * $::HEIGHT;	225	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
219	$self->{def_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH;	226	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
220	$self->{def_h} = ($layout->{h} != 0 ? $layout->{h} : 1) * $::HEIGHT;	227	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		228
		229	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		230	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		231
		232	$self->show if $layout->{show};
221	}	233	}
222		234
223	$self	235	$self
224	}	236	}
225		237
…		…
236	return if $self->{parent};	248	return if $self->{parent};
237		249
238	$CFClient::UI::ROOT->add ($self);	250	$CFClient::UI::ROOT->add ($self);
239	}	251	}
240		252
241	sub center {
242	my ($self) = @_;
243
244	$CFClient::UI::ROOT->on_post_alloc (
245	"center_$self" => sub {
246	$self->move (($self->{parent}{w} - $self->{w}) * 0.5, ($self->{parent}{h} - $self->{h}) * 0.5);
247	},
248	);
249
250	$self->update;
251	}
252
253	sub set_visible {	253	sub set_visible {
254	my ($self) = @_;	254	my ($self) = @_;
255		255
256	return if $self->{visible};	256	return if $self->{visible};
257		257
258	$self->{root} = $self->{parent}{root};	258	$self->{root} = $self->{parent}{root};
259	$self->{visible} = $self->{parent}{visible} + 1;	259	$self->{visible} = $self->{parent}{visible} + 1;
260		260
261	$self->emit (visibility_change => 1);	261	$self->emit (visibility_change => 1);
		262
		263	$self->realloc if !exists $self->{req_w};
		264
		265	$_->set_visible for $self->children;
262	}	266	}
263		267
264	sub set_invisible {	268	sub set_invisible {
265	my ($self) = @_;	269	my ($self) = @_;
266		270
267	return unless $self->{visible};	271	return unless $self->{visible};
268		272
269	# broken show/hide model	273	$_->set_invisible for $self->children;
270		274
271	delete $self->{root};	275	delete $self->{root};
272	delete $self->{visible};	276	delete $self->{visible};
273		277
274	undef $GRAB if $GRAB == $self;	278	undef $GRAB if $GRAB == $self;
275	undef $HOVER if $HOVER == $self;	279	undef $HOVER if $HOVER == $self;
276		280
277	CFClient::UI::check_tooltip	281	CFClient::UI::check_tooltip
278	if $CFClient::UI::TOOLTIP->{owner} == $self;	282	if $TOOLTIP->{owner} == $self;
279		283
280	$self->focus_out;	284	$self->focus_out;
281		285
282	$self->emit (visibility_change => 0);	286	$self->emit (visibility_change => 0);
283	}	287	}
…		…
306		310
307	$self->{parent}->remove ($self)	311	$self->{parent}->remove ($self)
308	if $self->{parent};	312	if $self->{parent};
309	}	313	}
310		314
311	sub move {	315	sub move_abs {
312	my ($self, $x, $y, $z) = @_;	316	my ($self, $x, $y, $z) = @_;
313		317
314	$self->{x} = int $x;	318	$self->{x} = List::Util::max 0, int $x;
315	$self->{y} = int $y;	319	$self->{y} = List::Util::max 0, int $y;
316	$self->{z} = $z if defined $z;	320	$self->{z} = $z if defined $z;
317		321
318	$self->update;	322	$self->update;
319	}	323	}
320		324
321	sub set_size {	325	sub set_size {
322	my ($self, $w, $h) = @_;	326	my ($self, $w, $h) = @_;
323		327
324	$self->{def_w} = $w;	328	$self->{force_w} = $w;
325	$self->{def_h} = $h;	329	$self->{force_h} = $h;
326		330
327	$self->check_size;	331	$self->realloc;
328	}	332	}
329		333
330	sub size_request {	334	sub size_request {
331	require Carp;	335	require Carp;
332	Carp::confess "size_request is abstract";	336	Carp::confess "size_request is abstract";
…		…
334		338
335	sub configure {	339	sub configure {
336	my ($self, $x, $y, $w, $h) = @_;	340	my ($self, $x, $y, $w, $h) = @_;
337		341
338	if ($self->{aspect}) {	342	if ($self->{aspect}) {
		343	my ($ow, $oh) = ($w, $h);
		344
339	my $w2 = List::Util::min $w, int $h * $self->{aspect};	345	$w = List::Util::min $w, int $h * $self->{aspect};
340	my $h2 = List::Util::min $h, int $w / $self->{aspect};	346	$h = List::Util::min $h, int $w / $self->{aspect};
341		347
342	# use alignment to adjust x, y	348	# use alignment to adjust x, y
343		349
344	$x += int +($w - $w2) * 0.5;	350	$x += int 0.5 * ($ow - $w);
345	$y += int +($h - $h2) * 0.5;	351	$y += int 0.5 * ($oh - $h);
346
347	($w, $h) = ($w2, $h2);
348	}	352	}
349		353
350	if ($self->{x} != $x \|\| $self->{y} != $y) {	354	if ($self->{x} ne $x \|\| $self->{y} ne $y) {
351	$self->{x} = $x;	355	$self->{x} = $x;
352	$self->{y} = $y;	356	$self->{y} = $y;
353	$self->update;	357	$self->update;
354	}	358	}
355		359
356	if ($self->{w} != $w \|\| $self->{h} != $h) {	360	if ($self->{alloc_w} != $w \|\| $self->{alloc_h} != $h) {
357	$CFClient::UI::ROOT->{size_alloc}{$self+0} = [$self, $w, $h];	361	return unless $self->{visible};
		362
		363	$self->{alloc_w} = $w;
		364	$self->{alloc_h} = $h;
		365
		366	$self->{root}{size_alloc}{$self+0} = $self;
358	}	367	}
359	}	368	}
360		369
361	sub size_allocate {	370	sub size_allocate {
362	# nothing to be done	371	# nothing to be done
363	}
364
365	sub reconfigure {
366	my ($self) = @_;
367
368	$self->check_size (1);
369	$self->update;
370	}	372	}
371		373
372	sub children {	374	sub children {
373	}	375	}
374		376
…		…
452	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	454	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
453	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	455	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
454	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	456	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
455	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	457	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
456	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	458	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
		459
		460	sub find_widget {
		461	my ($self, $x, $y) = @_;
		462
		463	return () unless $self->{can_events};
		464
		465	return $self
		466	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		467	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		468
		469	()
		470	}
		471
		472	sub set_parent {
		473	my ($self, $parent) = @_;
		474
		475	Scalar::Util::weaken ($self->{parent} = $parent);
		476	$self->set_visible if $parent->{visible};
		477	}
		478
		479	sub connect {
		480	my ($self, $signal, $cb) = @_;
		481
		482	push @{ $self->{signal_cb}{$signal} }, $cb;
		483	}
		484
		485	sub _emit {
		486	my ($self, $signal, @args) = @_;
		487
		488	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} \|\| []}
		489	}
		490
		491	sub emit {
		492	my ($self, $signal, @args) = @_;
		493
		494	$self->_emit ($signal, @args)
		495	\|\| $self->$signal (@args);
		496	}
		497
		498	sub visibility_change {
		499	#my ($self, $visible) = @_;
		500	}
		501
		502	sub realloc {
		503	my ($self) = @_;
		504
		505	if ($self->{visible}) {
		506	return if $self->{root}{realloc}{$self+0};
		507
		508	$self->{root}{realloc}{$self+0} = $self;
		509	$self->{root}->update;
		510	} else {
		511	delete $self->{req_w};
		512	delete $self->{req_h};
		513	}
		514	}
		515
		516	sub update {
		517	my ($self) = @_;
		518
		519	$self->{parent}->update
		520	if $self->{parent};
		521	}
		522
		523	sub reconfigure {
		524	my ($self) = @_;
		525
		526	$self->realloc;
		527	$self->update;
		528	}
457		529
458	sub draw {	530	sub draw {
459	my ($self) = @_;	531	my ($self) = @_;
460		532
461	return unless $self->{h} && $self->{w};	533	return unless $self->{h} && $self->{w};
…		…
478	glVertex $x , $y + $self->{h};	550	glVertex $x , $y + $self->{h};
479	glEnd;	551	glEnd;
480	glDisable GL_BLEND;	552	glDisable GL_BLEND;
481	}	553	}
482		554
483	if ($ENV{PCLIENT_DEBUG}) {	555	if ($ENV{CFPLUS_DEBUG} & 1) {
484	glPushMatrix;	556	glPushMatrix;
485	glColor 1, 1, 0, 1;	557	glColor 1, 1, 0, 1;
486	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	558	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
487	glBegin GL_LINE_LOOP;	559	glBegin GL_LINE_LOOP;
488	glVertex 0 , 0;	560	glVertex 0 , 0;
…		…
499	my ($self) = @_;	571	my ($self) = @_;
500		572
501	warn "no draw defined for $self\n";	573	warn "no draw defined for $self\n";
502	}	574	}
503		575
504	sub find_widget {
505	my ($self, $x, $y) = @_;
506
507	return () unless $self->{can_events};
508
509	return $self
510	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
511	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
512
513	()
514	}
515
516	sub set_parent {
517	my ($self, $parent) = @_;
518
519	Scalar::Util::weaken ($self->{parent} = $parent);
520
521	$self->set_visible; #TODO why breakssssss borked damn if $parent->{visible};
522
523	$self->check_size;
524	}
525
526	sub check_size {
527	my ($self, $forced) = @_;
528
529	$self->{force_alloc} = 1 if $forced;
530	$CFClient::UI::ROOT->{check_size}{$self} = $self;
531	}
532
533	sub update {
534	my ($self) = @_;
535
536	$self->{parent}->update
537	if $self->{parent};
538	}
539
540	sub connect {
541	my ($self, $signal, $cb) = @_;
542
543	push @{ $self->{signal_cb}{$signal} }, $cb;
544	}
545
546	sub _emit {
547	my ($self, $signal, @args) = @_;
548
549	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} \|\| []}
550	}
551
552	sub emit {
553	my ($self, $signal, @args) = @_;
554
555	$self->_emit ($signal, @args)
556	\|\| $self->$signal (@args);
557	}
558
559	sub visibility_change {
560	#my ($self, $visible) = @_;
561	}
562
563	sub DESTROY {	576	sub DESTROY {
564	my ($self) = @_;	577	my ($self) = @_;
565		578
566	delete $WIDGET{$self+0};	579	delete $WIDGET{$self+0};
567	#$self->deactivate;	580	#$self->deactivate;
…		…
623	my ($class, %arg) = @_;	636	my ($class, %arg) = @_;
624	$class->SUPER::new (can_events => 0, %arg);	637	$class->SUPER::new (can_events => 0, %arg);
625	}	638	}
626		639
627	sub size_request {	640	sub size_request {
628	(0, 0)	641	my ($self) = @_;
		642
		643	($self->{w} + 0, $self->{h} + 0)
629	}	644	}
630		645
631	sub draw { }	646	sub draw { }
632		647
633	#############################################################################	648	#############################################################################
…		…
662	$self->{children} = [	677	$self->{children} = [
663	sort { $a->{z} <=> $b->{z} }	678	sort { $a->{z} <=> $b->{z} }
664	@{$self->{children}}, @widgets	679	@{$self->{children}}, @widgets
665	];	680	];
666		681
667	$self->check_size (1);	682	$self->realloc;
668	$self->update;
669	}	683	}
670		684
671	sub children {	685	sub children {
672	@{ $_[0]{children} }	686	@{ $_[0]{children} }
673	}	687	}
…		…
678	delete $child->{parent};	692	delete $child->{parent};
679	$child->hide;	693	$child->hide;
680		694
681	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	695	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
682		696
683	$self->check_size (1);	697	$self->realloc;
684	$self->update;
685	}	698	}
686		699
687	sub clear {	700	sub clear {
688	my ($self) = @_;	701	my ($self) = @_;
689		702
…		…
693	for (@$children) {	706	for (@$children) {
694	delete $_->{parent};	707	delete $_->{parent};
695	$_->hide;	708	$_->hide;
696	}	709	}
697		710
698	$self->check_size;	711	$self->realloc;
699	$self->update;
700	}	712	}
701		713
702	sub find_widget {	714	sub find_widget {
703	my ($self, $x, $y) = @_;	715	my ($self, $x, $y) = @_;
704		716
…		…
841	}	853	}
842		854
843	sub size_request {	855	sub size_request {
844	my ($self) = @_;	856	my ($self) = @_;
845		857
846	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	858	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
847		859
848	$w = 10 if $self->{scroll_x};	860	$w = 10 if $self->{scroll_x};
849	$h = 10 if $self->{scroll_y};	861	$h = 10 if $self->{scroll_y};
850		862
851	($w, $h)	863	($w, $h)
852	}	864	}
853		865
854	sub size_allocate {	866	sub size_allocate {
855	my ($self, $w, $h) = @_;	867	my ($self, $w, $h) = @_;
856		868
		869	my $child = $self->child;
		870
857	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	871	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
858	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	872	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
859		873
860	$self->child->configure (0, 0, $w, $h);	874	$self->child->configure (0, 0, $w, $h);
861	$self->update;	875	$self->update;
862	}	876	}
863		877
…		…
1006		1020
1007	our @ISA = CFClient::UI::Bin::;	1021	our @ISA = CFClient::UI::Bin::;
1008		1022
1009	use CFClient::OpenGL;	1023	use CFClient::OpenGL;
1010		1024
1011	my @tex =	1025	my $bg =
		1026	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1027	mipmap => 1, wrap => 1;
		1028
		1029	my @border =
1012	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1013	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1031	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1014		1032
1015	sub new {	1033	sub new {
1016	my $class = shift;	1034	my $class = shift;
1017		1035
1018	my $self = $class->SUPER::new (	1036	my $self = $class->SUPER::new (
1019	bg => [1, 1, 1, 1],	1037	bg => [1, 1, 1, 1],
1020	border_bg => [1, 1, 1, 1],	1038	border_bg => [1, 1, 1, 1],
1021	border => 0.6,	1039	border => 0.6,
1022	is_toplevel => 1,
1023	can_events => 1,	1040	can_events => 1,
		1041	min_w => 16,
		1042	min_h => 16,
1024	@_	1043	@_
1025	);	1044	);
1026		1045
1027	$self->{title} &&= new CFClient::UI::Label	1046	$self->{title} &&= new CFClient::UI::Label
1028	align => 0,	1047	align => 0,
…		…
1081	my ($ev, $x, $y) = @_;	1100	my ($ev, $x, $y) = @_;
1082		1101
1083	my $dx = $ev->{x} - $ox;	1102	my $dx = $ev->{x} - $ox;
1084	my $dy = $ev->{y} - $oy;	1103	my $dy = $ev->{y} - $oy;
1085		1104
1086	$self->{user_x} = $wx + $dx * $mx;
1087	$self->{user_y} = $wy + $dy * $my;
1088	$self->{def_w} = $bw + $dx * ($mx ? -1 : 1);	1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1089	$self->{def_h} = $bh + $dy * ($my ? -1 : 1);	1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1090	$self->move ($self->{user_x}, $self->{user_y});	1107
1091	$self->check_size;	1108	$self->realloc;
		1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1092	};	1110	};
1093		1111
1094	} elsif ($lr ^ $td) {	1112	} elsif ($lr ^ $td) {
1095	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1096	my ($bx, $by) = ($self->{x}, $self->{y});	1114	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1098	$self->{motion} = sub {	1116	$self->{motion} = sub {
1099	my ($ev, $x, $y) = @_;	1117	my ($ev, $x, $y) = @_;
1100		1118
1101	($x, $y) = ($ev->{x}, $ev->{y});	1119	($x, $y) = ($ev->{x}, $ev->{y});
1102		1120
1103	$self->{user_x} = $bx + $x - $ox;	1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1104	$self->{user_y} = $by + $y - $oy;
1105
1106	$self->move ($self->{user_x}, $self->{user_y});
1107	$self->update;
1108	};	1122	};
1109	}	1123	}
1110	}	1124	}
1111		1125
1112	sub button_up {	1126	sub button_up {
…		…
1131	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1132		1146
1133	my $border = $self->border;	1147	my $border = $self->border;
1134		1148
1135	glColor @{ $self->{border_bg} };	1149	glColor @{ $self->{border_bg} };
1136	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1150	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1137	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1151	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1138	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1152	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1139	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1153	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1140		1154
1141	if (@{$self->{bg}} < 4 \|\| $self->{bg}[3]) {	1155	if (@{$self->{bg}} < 4 \|\| $self->{bg}[3]) {
1142	my $bg = $tex[0];	1156	glColor @{ $self->{bg} };
1143		1157
1144	# TODO: repeat texture not scale	1158	# TODO: repeat texture not scale
		1159	# solve this better(?)
1145	my $rep_x = $cw / $bg->{w};	1160	$bg->{s} = $cw / $bg->{w};
1146	my $rep_y = $ch / $bg->{h};	1161	$bg->{t} = $ch / $bg->{h};
1147
1148	glColor @{ $self->{bg} };
1149
1150	$bg->{s} = $rep_x;
1151	$bg->{t} = $rep_y;
1152	$bg->{wrap_mode} = 1;
1153	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1154	}	1163	}
1155		1164
1156	glDisable GL_TEXTURE_2D;	1165	glDisable GL_TEXTURE_2D;
1157		1166
…		…
1187	my ($self, $x, $y, $child) = @_;	1196	my ($self, $x, $y, $child) = @_;
1188		1197
1189	$child->set_parent ($self);	1198	$child->set_parent ($self);
1190	$self->{children}[$y][$x] = $child;	1199	$self->{children}[$y][$x] = $child;
1191		1200
1192	$self->check_size (1);	1201	$self->realloc;
1193	}	1202	}
1194		1203
1195	# TODO: move to container class maybe? send children a signal on removal?	1204	# TODO: move to container class maybe? send children a signal on removal?
1196	sub clear {	1205	sub clear {
1197	my ($self) = @_;	1206	my ($self) = @_;
…		…
1202	for (@children) {	1211	for (@children) {
1203	delete $_->{parent};	1212	delete $_->{parent};
1204	$_->hide;	1213	$_->hide;
1205	}	1214	}
1206		1215
1207	$self->check_size (1);	1216	$self->realloc;
1208	$self->update;
1209	}	1217	}
1210		1218
1211	sub get_wh {	1219	sub get_wh {
1212	my ($self) = @_;	1220	my ($self) = @_;
1213		1221
…		…
1421	ellipsise => 3, # end	1429	ellipsise => 3, # end
1422	layout => (new CFClient::Layout),	1430	layout => (new CFClient::Layout),
1423	fontsize => 1,	1431	fontsize => 1,
1424	align => -1,	1432	align => -1,
1425	valign => -1,	1433	valign => -1,
1426	padding => 2,	1434	padding_x => 2,
		1435	padding_y => 2,
1427	can_events => 0,	1436	can_events => 0,
1428	%arg	1437	%arg
1429	);	1438	);
1430		1439
1431	if (exists $self->{template}) {	1440	if (exists $self->{template}) {
…		…
1467	$self->{text} = "T$text";	1476	$self->{text} = "T$text";
1468		1477
1469	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1470	$self->{layout}->set_text ($text);	1479	$self->{layout}->set_text ($text);
1471		1480
		1481	$self->realloc;
1472	$self->update;	1482	$self->update;
1473	$self->check_size;
1474	}	1483	}
1475		1484
1476	sub set_markup {	1485	sub set_markup {
1477	my ($self, $markup) = @_;	1486	my ($self, $markup) = @_;
1478		1487
…		…
1482	my $rgba = $markup =~ /span.*(?:foreground\|background)/;	1491	my $rgba = $markup =~ /span.*(?:foreground\|background)/;
1483		1492
1484	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1493	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1485	$self->{layout}->set_markup ($markup);	1494	$self->{layout}->set_markup ($markup);
1486		1495
		1496	$self->realloc;
1487	$self->update;	1497	$self->update;
1488	$self->check_size;
1489	}	1498	}
1490		1499
1491	sub size_request {	1500	sub size_request {
1492	my ($self) = @_;	1501	my ($self) = @_;
1493		1502
…		…
1507		1516
1508	$w = List::Util::max $w, $w2;	1517	$w = List::Util::max $w, $w2;
1509	$h = List::Util::max $h, $h2;	1518	$h = List::Util::max $h, $h2;
1510	}	1519	}
1511		1520
1512	(	1521	($w, $h)
1513	$w + $self->{padding} * 2,
1514	$h + $self->{padding} * 2,
1515	)
1516	}	1522	}
1517		1523
1518	sub size_allocate {	1524	sub size_allocate {
1519	my ($self, $w, $h) = @_;	1525	my ($self, $w, $h) = @_;
1520		1526
…		…
1525	my ($self, $fontsize) = @_;	1531	my ($self, $fontsize) = @_;
1526		1532
1527	$self->{fontsize} = $fontsize;	1533	$self->{fontsize} = $fontsize;
1528	delete $self->{texture};	1534	delete $self->{texture};
1529		1535
1530	$self->update;	1536	$self->realloc;
1531	$self->check_size;
1532	}	1537	}
1533		1538
1534	sub _draw {	1539	sub _draw {
1535	my ($self) = @_;	1540	my ($self) = @_;
1536		1541
…		…
1544	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1545	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1546		1551
1547	my $tex = new_from_layout CFClient::Texture $self->{layout};	1552	my $tex = new_from_layout CFClient::Texture $self->{layout};
1548		1553
1549	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1550	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1551	: ($self->{w} - $tex->{w}) * 0.5);	1556	: ($self->{w} - $tex->{w}) * 0.5);
1552		1557
1553	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1554	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1555	: ($self->{h} - $tex->{h}) * 0.5);	1560	: ($self->{h} - $tex->{h}) * 0.5);
1556		1561
1557	$tex	1562	$tex
1558	};	1563	};
1559		1564
…		…
1616	sub set_text {	1621	sub set_text {
1617	my ($self, $text) = @_;	1622	my ($self, $text) = @_;
1618		1623
1619	$self->{cursor} = length $text;	1624	$self->{cursor} = length $text;
1620	$self->_set_text ($text);	1625	$self->_set_text ($text);
1621	$self->update;	1626
1622	$self->check_size;	1627	$self->realloc;
1623	}	1628	}
1624		1629
1625	sub get_text {	1630	sub get_text {
1626	$_[0]{text}	1631	$_[0]{text}
1627	}	1632	}
…		…
1660	} elsif ($uni) {	1665	} elsif ($uni) {
1661	substr $text, $self->{cursor}++, 0, chr $uni;	1666	substr $text, $self->{cursor}++, 0, chr $uni;
1662	}	1667	}
1663		1668
1664	$self->_set_text ($text);	1669	$self->_set_text ($text);
1665	$self->update;	1670
1666	$self->check_size;	1671	$self->realloc;
1667	}	1672	}
1668		1673
1669	sub focus_in {	1674	sub focus_in {
1670	my ($self) = @_;	1675	my ($self) = @_;
1671		1676
…		…
1798		1803
1799	sub new {	1804	sub new {
1800	my $class = shift;	1805	my $class = shift;
1801		1806
1802	$class->SUPER::new (	1807	$class->SUPER::new (
1803	padding => 4,	1808	padding_x => 4,
		1809	padding_y => 4,
1804	fg => [1, 1, 1],	1810	fg => [1, 1, 1],
1805	active_fg => [0, 0, 1],	1811	active_fg => [0, 0, 1],
1806	can_hover => 1,	1812	can_hover => 1,
1807	align => 0,	1813	align => 0,
1808	valign => 0,	1814	valign => 0,
…		…
1855		1861
1856	sub new {	1862	sub new {
1857	my $class = shift;	1863	my $class = shift;
1858		1864
1859	$class->SUPER::new (	1865	$class->SUPER::new (
1860	padding => 2,	1866	padding_x => 2,
		1867	padding_y => 2,
1861	fg => [1, 1, 1],	1868	fg => [1, 1, 1],
1862	active_fg => [1, 1, 0],	1869	active_fg => [1, 1, 0],
1863	bg => [0, 0, 0, 0.2],	1870	bg => [0, 0, 0, 0.2],
1864	active_bg => [1, 1, 1, 0.5],	1871	active_bg => [1, 1, 1, 0.5],
1865	state => 0,	1872	state => 0,
…		…
1869	}	1876	}
1870		1877
1871	sub size_request {	1878	sub size_request {
1872	my ($self) = @_;	1879	my ($self) = @_;
1873		1880
1874	($self->{padding} * 2 + 6) x 2	1881	(6) x 2
1875	}	1882	}
1876		1883
1877	sub button_down {	1884	sub button_down {
1878	my ($self, $ev, $x, $y) = @_;	1885	my ($self, $ev, $x, $y) = @_;
1879		1886
1880	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1881	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1882	$self->{state} = !$self->{state};	1889	$self->{state} = !$self->{state};
1883	$self->_emit (changed => $self->{state});	1890	$self->_emit (changed => $self->{state});
1884	}	1891	}
1885	}	1892	}
1886		1893
1887	sub _draw {	1894	sub _draw {
1888	my ($self) = @_;	1895	my ($self) = @_;
1889		1896
1890	$self->SUPER::_draw;	1897	$self->SUPER::_draw;
1891		1898
1892	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1899	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1893		1900
1894	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1901	my ($w, $h) = @$self{qw(w h)};
		1902
		1903	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1895		1904
1896	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1905	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1897		1906
1898	my $tex = $self->{state} ? $tex[1] : $tex[0];	1907	my $tex = $self->{state} ? $tex[1] : $tex[0];
1899		1908
…		…
2164	fg => [1, 1, 1],	2173	fg => [1, 1, 1],
2165	active_fg => [0, 0, 0],	2174	active_fg => [0, 0, 0],
2166	bg => [0, 0, 0, 0.2],	2175	bg => [0, 0, 0, 0.2],
2167	active_bg => [1, 1, 1, 0.5],	2176	active_bg => [1, 1, 1, 0.5],
2168	range => [0, 0, 100, 10, 0],	2177	range => [0, 0, 100, 10, 0],
2169	req_w => $::WIDTH / 80,	2178	min_w => $::WIDTH / 80,
2170	req_h => $::WIDTH / 80,	2179	min_h => $::WIDTH / 80,
2171	vertical => 0,	2180	vertical => 0,
2172	can_hover => 1,	2181	can_hover => 1,
2173	inner_pad => 0.02,	2182	inner_pad => 0.02,
2174	@_	2183	@_
2175	);	2184	);
…		…
2178	$self->update;	2187	$self->update;
2179		2188
2180	$self	2189	$self
2181	}	2190	}
2182		2191
		2192	sub changed { }
		2193
2183	sub set_range {	2194	sub set_range {
2184	my ($self, $range) = @_;	2195	my ($self, $range) = @_;
2185		2196
2186	($range, $self->{range}) = ($self->{range}, $range);	2197	($range, $self->{range}) = ($self->{range}, $range);
2187		2198
…		…
2213	}	2224	}
2214		2225
2215	sub size_request {	2226	sub size_request {
2216	my ($self) = @_;	2227	my ($self) = @_;
2217		2228
2218	my $w = $self->{req_w};	2229	($self->{req_w}, $self->{req_h})
2219	my $h = $self->{req_h};
2220
2221	$self->{vertical} ? ($h, $w) : ($w, $h)
2222	}	2230	}
2223		2231
2224	sub button_down {	2232	sub button_down {
2225	my ($self, $ev, $x, $y) = @_;	2233	my ($self, $ev, $x, $y) = @_;
2226		2234
…		…
2611	}	2619	}
2612		2620
2613	sub set_tooltip_from {	2621	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2622	my ($self, $widget) = @_;
2615		2623
		2624	my $tooltip = $widget->{tooltip};
		2625
		2626	if ($ENV{CFPLUS_DEBUG} & 2) {
		2627	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2628	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2629	. "req $widget->{req_w} $widget->{req_h}\n"
		2630	. "visible $widget->{visible}";
		2631	}
		2632
2616	$self->add (new CFClient::UI::Label	2633	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2634	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} \|\| 0.25) * $::WIDTH,	2635	max_w => ($widget->{tooltip_width} \|\| 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2636	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2637	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2638	ellipsise => 0,
2622	font => ($widget->{tooltip_font} \|\| $::FONT_PROP),	2639	font => ($widget->{tooltip_font} \|\| $::FONT_PROP),
…		…
2633		2650
2634	sub size_allocate {	2651	sub size_allocate {
2635	my ($self, $w, $h) = @_;	2652	my ($self, $w, $h) = @_;
2636		2653
2637	$self->SUPER::size_allocate ($w - 4, $h - 4);	2654	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2655	}
		2656
		2657	sub visibility_change {
		2658	my ($self, $visible) = @_;
		2659
		2660	return unless $visible;
		2661
		2662	$self->{root}->on_post_alloc ("move_$self" => sub {
		2663	my $widget = $self->{owner}
		2664	or return;
		2665
		2666	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2667
		2668	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2669	if $x + $self->{w} > $::WIDTH;
		2670
		2671	$self->move_abs ($x, $y);
		2672	});
2638	}	2673	}
2639		2674
2640	sub _draw {	2675	sub _draw {
2641	my ($self) = @_;	2676	my ($self) = @_;
2642		2677
…		…
2659	glVertex $w, $h;	2694	glVertex $w, $h;
2660	glVertex $w, 0;	2695	glVertex $w, 0;
2661	glEnd;	2696	glEnd;
2662		2697
2663	glTranslate 2 - 0.375, 2 - 0.375;	2698	glTranslate 2 - 0.375, 2 - 0.375;
		2699
2664	$self->SUPER::_draw;	2700	$self->SUPER::_draw;
2665	}	2701	}
2666		2702
2667	#############################################################################	2703	#############################################################################
2668		2704
…		…
2833	# maybe save $GRAB? must be careful about events...	2869	# maybe save $GRAB? must be careful about events...
2834	$GRAB = $self;	2870	$GRAB = $self;
2835	$self->{button} = $ev->{button};	2871	$self->{button} = $ev->{button};
2836		2872
2837	$self->show;	2873	$self->show;
2838	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2874	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2839	}	2875	}
2840		2876
2841	sub mouse_motion {	2877	sub mouse_motion {
2842	my ($self, $ev, $x, $y) = @_;	2878	my ($self, $ev, $x, $y) = @_;
2843		2879
…		…
2977	use CFClient::OpenGL;	3013	use CFClient::OpenGL;
2978		3014
2979	sub new {	3015	sub new {
2980	my $class = shift;	3016	my $class = shift;
2981		3017
2982	$class->SUPER::new (	3018	my $self = $class->SUPER::new (
2983	visible => 1,	3019	visible => 1,
2984	@_,	3020	@_,
2985	)	3021	);
2986	}
2987		3022
2988	sub configure {	3023	Scalar::Util::weaken ($self->{root} = $self);
2989	my ($self, $x, $y, $w, $h) = @_;
2990		3024
2991	$self->{w} = $w;	3025	$self
2992	$self->{h} = $h;
2993	}
2994
2995	sub check_size {
2996	my ($self) = @_;
2997
2998	$self->size_allocate ($self->{w}, $self->{h})
2999	if $self->{w};
3000	}	3026	}
3001		3027
3002	sub size_request {	3028	sub size_request {
3003	my ($self) = @_;	3029	my ($self) = @_;
3004		3030
3005	($self->{w}, $self->{h})	3031	($self->{w}, $self->{h})
		3032	}
		3033
		3034	sub _to_pixel {
		3035	my ($coord, $size, $max) = @_;
		3036
		3037	$coord =
		3038	$coord eq "center" ? ($max - $size) * 0.5
		3039	: $coord eq "max" ? $max
		3040	: $coord;
		3041
		3042	$coord = 0 if $coord < 0;
		3043	$coord = $max - $size if $coord > $max - $size;
		3044
		3045	int $coord + 0.5
3006	}	3046	}
3007		3047
3008	sub size_allocate {	3048	sub size_allocate {
3009	my ($self, $w, $h) = @_;	3049	my ($self, $w, $h) = @_;
3010		3050
3011	for my $child ($self->children) {	3051	for my $child ($self->children) {
3012	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3052	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3013		3053
3014	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3054	$X = $child->{force_x} if exists $child->{force_x};
3015	if exists $child->{req_x};	3055	$Y = $child->{force_y} if exists $child->{force_y};
3016		3056
3017	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3057	$X = _to_pixel $X, $W, $self->{w};
3018	if exists $child->{req_y};	3058	$Y = _to_pixel $Y, $H, $self->{h};
3019
3020	#delete @$child{qw(req_x req_y)};#d# def_x, def_y
3021
3022	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3023	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3024		3059
3025	$child->configure ($X, $Y, $W, $H);	3060	$child->configure ($X, $Y, $W, $H);
3026	}	3061	}
3027	}	3062	}
3028		3063
…		…
3039	}	3074	}
3040		3075
3041	sub update {	3076	sub update {
3042	my ($self) = @_;	3077	my ($self) = @_;
3043		3078
3044	$self->check_size;
3045	$::WANT_REFRESH++;	3079	$::WANT_REFRESH++;
3046	}	3080	}
3047		3081
3048	sub add {	3082	sub add {
3049	my ($self, @children) = @_;	3083	my ($self, @children) = @_;
3050		3084
3051	for my $child (@children) {
3052	$child->{is_toplevel} = 1;	3085	$_->{is_toplevel} = 1
3053		3086	for @children;
3054	# integerise window positions
3055	$child->{x} = int $child->{x};
3056	$child->{y} = int $child->{y};
3057	}
3058		3087
3059	$self->SUPER::add (@children);	3088	$self->SUPER::add (@children);
3060
3061	for (my @widgets = @children; my $w = pop @widgets; ) {
3062	push @widgets, $w->children;
3063	$w->set_visible;
3064	}
3065
3066	}	3089	}
3067		3090
3068	sub remove {	3091	sub remove {
3069	my ($self, @children) = @_;	3092	my ($self, @children) = @_;
3070		3093
3071	$self->SUPER::remove (@children);	3094	$self->SUPER::remove (@children);
		3095
		3096	delete $self->{is_toplevel}
		3097	for @children;
3072		3098
3073	while (@children) {	3099	while (@children) {
3074	my $w = pop @children;	3100	my $w = pop @children;
3075	push @children, $w->children;	3101	push @children, $w->children;
3076	$w->set_invisible;	3102	$w->set_invisible;
…		…
3095	while ($self->{refresh_hook}) {	3121	while ($self->{refresh_hook}) {
3096	$_->()	3122	$_->()
3097	for values %{delete $self->{refresh_hook}};	3123	for values %{delete $self->{refresh_hook}};
3098	}	3124	}
3099		3125
3100	if ($self->{check_size}) {	3126	if ($self->{realloc}) {
3101	my @queue;	3127	my @queue;
3102		3128
3103	while () {	3129	while () {
3104	if ($self->{check_size}) {	3130	if ($self->{realloc}) {
3105	#TODO use array-of-depth approach	3131	#TODO use array-of-depth approach
3106		3132
		3133	use sort 'stable';
		3134
3107	@queue = sort { $a->{visible} <=> $b->{visible} }	3135	@queue = sort { $a->{visible} <=> $b->{visible} }
3108	@queue, values %{delete $self->{check_size}};	3136	@queue, values %{delete $self->{realloc}};
3109	}	3137	}
3110		3138
3111	my $widget = pop @queue \|\| last;	3139	my $widget = pop @queue \|\| last;
3112		3140
3113	defined $widget->{visible} or last; # do not resize invisible widgets	3141	$widget->{visible} or last; # do not resize invisible widgets
3114		3142
3115	my ($w, $h) = $widget->{def_w} && $widget->{def_h}
3116	? @$widget{qw(def_w def_h)}
3117	: $widget->size_request;	3143	my ($w, $h) = $widget->size_request;
3118		3144
		3145	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3146	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3147
		3148	$w = $widget->{force_w} if exists $widget->{force_w};
		3149	$h = $widget->{force_h} if exists $widget->{force_h};
		3150
		3151	if ($widget->{req_w} != $w \|\| $widget->{req_h} != $h
3119	if (delete $widget->{force_alloc}	3152	\|\| delete $widget->{force_realloc}) {
3120	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3121	Carp::confess "$widget: size_request is negative" if $w < 0 \|\| $h < 0;#d#
3122
3123	$widget->{req_w} = $w;	3153	$widget->{req_w} = $w;
3124	$widget->{req_h} = $h;	3154	$widget->{req_h} = $h;
3125		3155
3126	$self->{size_alloc}{$widget} = [$widget, $widget->{w} \|\| $w, $widget->{h} \|\| $h];	3156	$self->{size_alloc}{$widget+0} = $widget;
3127		3157
3128	$widget->{parent}->check_size
3129	if $widget->{parent};	3158	if (my $parent = $widget->{parent}) {
		3159	$self->{realloc}{$parent+0} = $parent;
		3160	#unshift @queue, $parent;
		3161	$parent->{force_size_alloc} = 1;
		3162	$self->{size_alloc}{$parent+0} = $parent;
		3163	}
3130	}	3164	}
		3165
		3166	delete $self->{realloc}{$widget+0};
3131	}	3167	}
3132	}	3168	}
3133		3169
3134	while (my $size_alloc = delete $self->{size_alloc}) {	3170	while (my $size_alloc = delete $self->{size_alloc}) {
3135	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3171	my @queue = sort { $b->{visible} <=> $a->{visible} }
3136	values %$size_alloc;	3172	values %$size_alloc;
3137		3173
3138	while () {	3174	while () {
3139	my ($widget, $w, $h) = @{ pop @queue or last };	3175	my $widget = pop @queue \|\| last;
		3176
		3177	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3140		3178
3141	$w = 0 if $w < 0;	3179	$w = 0 if $w < 0;
3142	$h = 0 if $h < 0;	3180	$h = 0 if $h < 0;
3143		3181
		3182	$w = int $w + 0.5;
		3183	$h = int $h + 0.5;
		3184
		3185	if ($widget->{w} != $w \|\| $widget->{h} != $h \|\| delete $widget->{force_size_alloc}) {
3144	$widget->{w} = $w;	3186	$widget->{w} = $w;
3145	$widget->{h} = $h;	3187	$widget->{h} = $h;
		3188
3146	$widget->emit (size_allocate => $w, $h);	3189	$widget->emit (size_allocate => $w, $h);
		3190	}
3147	}	3191	}
3148	}	3192	}
3149		3193
3150	while ($self->{post_alloc_hook}) {	3194	while ($self->{post_alloc_hook}) {
3151	$_->()	3195	$_->()
3152	for values %{delete $self->{post_alloc_hook}};	3196	for values %{delete $self->{post_alloc_hook}};
3153	}	3197	}
		3198
3154		3199
3155	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3156	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3157	glClear GL_COLOR_BUFFER_BIT;	3202	glClear GL_COLOR_BUFFER_BIT;
3158		3203
…		…
3165	$self->_draw;	3210	$self->_draw;
3166	}	3211	}
3167		3212
3168	#############################################################################	3213	#############################################################################
3169		3214
		3215	package CFClient::UI::BindEditor;
		3216
		3217	our @ISA = CFClient::UI::FancyFrame::;
		3218
		3219	sub new {
		3220	my $class = shift;
		3221
		3222	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3223
		3224	$self->add (my $vb = new CFClient::UI::VBox);
		3225
		3226
		3227	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3228	text => "start recording",
		3229	tooltip => "Start/Stops recording of actions."
		3230	."All subsequent actions after the recording started will be captured."
		3231	."The actions are displayed after the record was stopped."
		3232	."To bind the action you have to click on the 'Bind' button",
		3233	on_activate => sub {
		3234	unless ($self->{recording}) {
		3235	$self->start;
		3236	} else {
		3237	$self->stop;
		3238	}
		3239	});
		3240
		3241	$vb->add (new CFClient::UI::Label text => "Actions:");
		3242	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3243
		3244	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3245	$vb->add (my $hb = new CFClient::UI::HBox);
		3246	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3247	$hb->add (new CFClient::UI::Button
		3248	text => "bind",
		3249	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3250	on_activate => sub {
		3251	$self->ask_for_bind;
		3252	});
		3253
		3254	$vb->add (my $hb = new CFClient::UI::HBox);
		3255	$hb->add (new CFClient::UI::Button
		3256	text => "ok",
		3257	expand => 1,
		3258	tooltip => "This closes the binding editor and saves the binding",
		3259	on_activate => sub {
		3260	$self->hide;
		3261	$self->commit;
		3262	});
		3263
		3264	$hb->add (new CFClient::UI::Button
		3265	text => "cancel",
		3266	expand => 1,
		3267	tooltip => "This closes the binding editor without saving",
		3268	on_activate => sub {
		3269	$self->hide;
		3270	$self->{binding_cancel}->()
		3271	if $self->{binding_cancel};
		3272	});
		3273
		3274	$self->update_binding_widgets;
		3275
		3276	$self
		3277	}
		3278
		3279	sub commit {
		3280	my ($self) = @_;
		3281	my ($mod, $sym, $cmds) = $self->get_binding;
		3282	if ($sym != 0 && @$cmds > 0) {
		3283	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3284	."'. Don't forget 'Save Config'!");
		3285	$self->{binding_change}->($mod, $sym, $cmds)
		3286	if $self->{binding_change};
		3287	} else {
		3288	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3289	$self->{binding_cancel}->()
		3290	if $self->{binding_cancel};
		3291	}
		3292	}
		3293
		3294	sub start {
		3295	my ($self) = @_;
		3296
		3297	$self->{rec_btn}->set_text ("stop recording");
		3298	$self->{recording} = 1;
		3299	$self->clear_command_list;
		3300	$::CONN->start_record if $::CONN;
		3301	}
		3302
		3303	sub stop {
		3304	my ($self) = @_;
		3305
		3306	$self->{rec_btn}->set_text ("start recording");
		3307	$self->{recording} = 0;
		3308
		3309	my $rec;
		3310	$rec = $::CONN->stop_record if $::CONN;
		3311	return unless ref $rec eq 'ARRAY';
		3312	$self->set_command_list ($rec);
		3313	}
		3314
		3315	# if $commit is true, the binding will be set after the user entered a key combo
		3316	sub ask_for_bind {
		3317	my ($self, $commit) = @_;
		3318
		3319	CFClient::Binder::open_binding_dialog (sub {
		3320	my ($mod, $sym) = @_;
		3321	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3322	$self->update_binding_widgets;
		3323	$self->commit if $commit;
		3324	});
		3325	}
		3326
		3327	# $mod and $sym are the modifiers and key symbol
		3328	# $cmds is a array ref of strings (the commands)
		3329	# $cb is the callback that is executed on OK
		3330	# $ccb is the callback that is executed on CANCEL and
		3331	# when the binding was unsuccessful on OK
		3332	sub set_binding {
		3333	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3334
		3335	$self->clear_command_list;
		3336	$self->{recording} = 0;
		3337	$self->{rec_btn}->set_text ("start recording");
		3338
		3339	$self->{binding} = [$mod, $sym];
		3340	$self->{commands} = $cmds;
		3341
		3342	$self->{binding_change} = $cb;
		3343	$self->{binding_cancel} = $ccb;
		3344
		3345	$self->update_binding_widgets;
		3346	}
		3347
		3348	# this is a shortcut method that asks for a binding
		3349	# and then just binds it.
		3350	sub do_quick_binding {
		3351	my ($self, $cmds) = @_;
		3352	$self->set_binding (undef, undef, $cmds, sub {
		3353	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3354	});
		3355	$self->ask_for_bind (1);
		3356	}
		3357
		3358	sub update_binding_widgets {
		3359	my ($self) = @_;
		3360	my ($mod, $sym, $cmds) = $self->get_binding;
		3361	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3362	$self->set_command_list ($cmds);
		3363	}
		3364
		3365	sub get_binding {
		3366	my ($self) = @_;
		3367	return (
		3368	$self->{binding}->[0],
		3369	$self->{binding}->[1],
		3370	[ grep { defined $_ } @{$self->{commands}} ]
		3371	);
		3372	}
		3373
		3374	sub clear_command_list {
		3375	my ($self) = @_;
		3376	$self->{cmdbox}->clear ();
		3377	}
		3378
		3379	sub set_command_list {
		3380	my ($self, $cmds) = @_;
		3381
		3382	$self->{cmdbox}->clear ();
		3383	$self->{commands} = $cmds;
		3384
		3385	my $idx = 0;
		3386
		3387	for (@$cmds) {
		3388	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3389
		3390	my $i = $idx;
		3391	$hb->add (new CFClient::UI::Label text => $_);
		3392	$hb->add (new CFClient::UI::Button
		3393	text => "delete",
		3394	tooltip => "Deletes the action from the record",
		3395	on_activate => sub {
		3396	$self->{cmdbox}->remove ($hb);
		3397	$cmds->[$i] = undef;
		3398	});
		3399
		3400
		3401	$idx++
		3402	}
		3403	}
		3404
		3405
		3406	#############################################################################
		3407
		3408	package CFClient::UI::SpellList;
		3409
		3410	our @ISA = CFClient::UI::FancyFrame::;
		3411
		3412	sub new {
		3413	my $class = shift;
		3414
		3415	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3416
		3417	$self->add (new CFClient::UI::ScrolledWindow
		3418	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3419
		3420	$self;
		3421	}
		3422
		3423	# XXX: Do sorting? Argl...
		3424	sub add_spell {
		3425	my ($self, $spell) = @_;
		3426	$self->{spells}->{$spell->{name}} = $spell;
		3427
		3428	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3429	face => $spell->{face},
		3430	can_hover => 1,
		3431	can_events => 1,
		3432	tooltip => $spell->{message});
		3433
		3434	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3435	text => $spell->{name},
		3436	can_hover => 1,
		3437	can_events => 1,
		3438	tooltip => $spell->{message},
		3439	expand => 1);
		3440
		3441	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3442	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3443	$spell->{level}, ($spell->{mana} \|\| $spell->{grace}), $spell->{damage}),
		3444	expand => 1);
		3445
		3446	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3447	text => "bind to key",
		3448	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3449	}
		3450
		3451	sub rebuild_spell_list {
		3452	my ($self) = @_;
		3453	$self->{tbl_idx} = 0;
		3454	$self->add_spell ($_) for values %{$self->{spells}};
		3455	}
		3456
		3457	sub remove_spell {
		3458	my ($self, $spell) = @_;
		3459	delete $self->{spells}->{$spell->{name}};
		3460	$self->rebuild_spell_list;
		3461	}
		3462
		3463	#############################################################################
		3464
3170	package CFClient::UI;	3465	package CFClient::UI;
3171		3466
3172	$ROOT = new CFClient::UI::Root;	3467	$ROOT = new CFClient::UI::Root;
3173	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	3468	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3174		3469

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.250 by root, Sun May 28 02:31:03 2006 UTC vs. Revision 1.263 by elmex, Wed May 31 14:04:52 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.250 by root, Sun May 28 02:31:03 2006 UTC vs.
Revision 1.263 by elmex, Wed May 31 14:04:52 2006 UTC