[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.264 by root, Thu Jun 1 02:58:30 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
1521	delete $self->{texture};	1527	delete $self->{texture}
		1528	;#d#
1522	}	1529	}
1523		1530
1524	sub set_fontsize {	1531	sub set_fontsize {
1525	my ($self, $fontsize) = @_;	1532	my ($self, $fontsize) = @_;
1526		1533
1527	$self->{fontsize} = $fontsize;	1534	$self->{fontsize} = $fontsize;
1528	delete $self->{texture};	1535	delete $self->{texture};
1529		1536
1530	$self->update;	1537	$self->realloc;
1531	$self->check_size;
1532	}	1538	}
1533		1539
1534	sub _draw {	1540	sub _draw {
1535	my ($self) = @_;	1541	my ($self) = @_;
1536		1542
…		…
1544	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1550	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1545	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1551	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1546		1552
1547	my $tex = new_from_layout CFClient::Texture $self->{layout};	1553	my $tex = new_from_layout CFClient::Texture $self->{layout};
1548		1554
1549	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1555	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1550	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1556	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1551	: ($self->{w} - $tex->{w}) * 0.5);	1557	: ($self->{w} - $tex->{w}) * 0.5);
1552		1558
1553	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1559	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1554	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1560	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1555	: ($self->{h} - $tex->{h}) * 0.5);	1561	: ($self->{h} - $tex->{h}) * 0.5);
1556		1562
1557	$tex	1563	$tex
1558	};	1564	};
1559		1565
…		…
1616	sub set_text {	1622	sub set_text {
1617	my ($self, $text) = @_;	1623	my ($self, $text) = @_;
1618		1624
1619	$self->{cursor} = length $text;	1625	$self->{cursor} = length $text;
1620	$self->_set_text ($text);	1626	$self->_set_text ($text);
1621	$self->update;	1627
1622	$self->check_size;	1628	$self->realloc;
1623	}	1629	}
1624		1630
1625	sub get_text {	1631	sub get_text {
1626	$_[0]{text}	1632	$_[0]{text}
1627	}	1633	}
…		…
1660	} elsif ($uni) {	1666	} elsif ($uni) {
1661	substr $text, $self->{cursor}++, 0, chr $uni;	1667	substr $text, $self->{cursor}++, 0, chr $uni;
1662	}	1668	}
1663		1669
1664	$self->_set_text ($text);	1670	$self->_set_text ($text);
1665	$self->update;	1671
1666	$self->check_size;	1672	$self->realloc;
1667	}	1673	}
1668		1674
1669	sub focus_in {	1675	sub focus_in {
1670	my ($self) = @_;	1676	my ($self) = @_;
1671		1677
…		…
1798		1804
1799	sub new {	1805	sub new {
1800	my $class = shift;	1806	my $class = shift;
1801		1807
1802	$class->SUPER::new (	1808	$class->SUPER::new (
1803	padding => 4,	1809	padding_x => 4,
		1810	padding_y => 4,
1804	fg => [1, 1, 1],	1811	fg => [1, 1, 1],
1805	active_fg => [0, 0, 1],	1812	active_fg => [0, 0, 1],
1806	can_hover => 1,	1813	can_hover => 1,
1807	align => 0,	1814	align => 0,
1808	valign => 0,	1815	valign => 0,
…		…
1855		1862
1856	sub new {	1863	sub new {
1857	my $class = shift;	1864	my $class = shift;
1858		1865
1859	$class->SUPER::new (	1866	$class->SUPER::new (
1860	padding => 2,	1867	padding_x => 2,
		1868	padding_y => 2,
1861	fg => [1, 1, 1],	1869	fg => [1, 1, 1],
1862	active_fg => [1, 1, 0],	1870	active_fg => [1, 1, 0],
1863	bg => [0, 0, 0, 0.2],	1871	bg => [0, 0, 0, 0.2],
1864	active_bg => [1, 1, 1, 0.5],	1872	active_bg => [1, 1, 1, 0.5],
1865	state => 0,	1873	state => 0,
…		…
1869	}	1877	}
1870		1878
1871	sub size_request {	1879	sub size_request {
1872	my ($self) = @_;	1880	my ($self) = @_;
1873		1881
1874	($self->{padding} * 2 + 6) x 2	1882	(6) x 2
1875	}	1883	}
1876		1884
1877	sub button_down {	1885	sub button_down {
1878	my ($self, $ev, $x, $y) = @_;	1886	my ($self, $ev, $x, $y) = @_;
1879		1887
1880	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1888	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1881	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1889	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1882	$self->{state} = !$self->{state};	1890	$self->{state} = !$self->{state};
1883	$self->_emit (changed => $self->{state});	1891	$self->_emit (changed => $self->{state});
1884	}	1892	}
1885	}	1893	}
1886		1894
1887	sub _draw {	1895	sub _draw {
1888	my ($self) = @_;	1896	my ($self) = @_;
1889		1897
1890	$self->SUPER::_draw;	1898	$self->SUPER::_draw;
1891		1899
1892	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1900	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1893		1901
1894	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1902	my ($w, $h) = @$self{qw(w h)};
		1903
		1904	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1895		1905
1896	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1906	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1897		1907
1898	my $tex = $self->{state} ? $tex[1] : $tex[0];	1908	my $tex = $self->{state} ? $tex[1] : $tex[0];
1899		1909
…		…
2164	fg => [1, 1, 1],	2174	fg => [1, 1, 1],
2165	active_fg => [0, 0, 0],	2175	active_fg => [0, 0, 0],
2166	bg => [0, 0, 0, 0.2],	2176	bg => [0, 0, 0, 0.2],
2167	active_bg => [1, 1, 1, 0.5],	2177	active_bg => [1, 1, 1, 0.5],
2168	range => [0, 0, 100, 10, 0],	2178	range => [0, 0, 100, 10, 0],
2169	req_w => $::WIDTH / 80,	2179	min_w => $::WIDTH / 80,
2170	req_h => $::WIDTH / 80,	2180	min_h => $::WIDTH / 80,
2171	vertical => 0,	2181	vertical => 0,
2172	can_hover => 1,	2182	can_hover => 1,
2173	inner_pad => 0.02,	2183	inner_pad => 0.02,
2174	@_	2184	@_
2175	);	2185	);
…		…
2178	$self->update;	2188	$self->update;
2179		2189
2180	$self	2190	$self
2181	}	2191	}
2182		2192
		2193	sub changed { }
		2194
2183	sub set_range {	2195	sub set_range {
2184	my ($self, $range) = @_;	2196	my ($self, $range) = @_;
2185		2197
2186	($range, $self->{range}) = ($self->{range}, $range);	2198	($range, $self->{range}) = ($self->{range}, $range);
2187		2199
…		…
2213	}	2225	}
2214		2226
2215	sub size_request {	2227	sub size_request {
2216	my ($self) = @_;	2228	my ($self) = @_;
2217		2229
2218	my $w = $self->{req_w};	2230	($self->{req_w}, $self->{req_h})
2219	my $h = $self->{req_h};
2220
2221	$self->{vertical} ? ($h, $w) : ($w, $h)
2222	}	2231	}
2223		2232
2224	sub button_down {	2233	sub button_down {
2225	my ($self, $ev, $x, $y) = @_;	2234	my ($self, $ev, $x, $y) = @_;
2226		2235
…		…
2611	}	2620	}
2612		2621
2613	sub set_tooltip_from {	2622	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2623	my ($self, $widget) = @_;
2615		2624
		2625	my $tooltip = $widget->{tooltip};
		2626
		2627	if ($ENV{CFPLUS_DEBUG} & 2) {
		2628	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2629	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2630	. "req $widget->{req_w} $widget->{req_h}\n"
		2631	. "visible $widget->{visible}";
		2632	}
		2633
2616	$self->add (new CFClient::UI::Label	2634	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2635	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} \|\| 0.25) * $::WIDTH,	2636	max_w => ($widget->{tooltip_width} \|\| 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2637	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2638	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2639	ellipsise => 0,
2622	font => ($widget->{tooltip_font} \|\| $::FONT_PROP),	2640	font => ($widget->{tooltip_font} \|\| $::FONT_PROP),
…		…
2633		2651
2634	sub size_allocate {	2652	sub size_allocate {
2635	my ($self, $w, $h) = @_;	2653	my ($self, $w, $h) = @_;
2636		2654
2637	$self->SUPER::size_allocate ($w - 4, $h - 4);	2655	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2656	}
		2657
		2658	sub visibility_change {
		2659	my ($self, $visible) = @_;
		2660
		2661	return unless $visible;
		2662
		2663	$self->{root}->on_post_alloc ("move_$self" => sub {
		2664	my $widget = $self->{owner}
		2665	or return;
		2666
		2667	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2668
		2669	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2670	if $x + $self->{w} > $::WIDTH;
		2671
		2672	$self->move_abs ($x, $y);
		2673	});
2638	}	2674	}
2639		2675
2640	sub _draw {	2676	sub _draw {
2641	my ($self) = @_;	2677	my ($self) = @_;
2642		2678
…		…
2659	glVertex $w, $h;	2695	glVertex $w, $h;
2660	glVertex $w, 0;	2696	glVertex $w, 0;
2661	glEnd;	2697	glEnd;
2662		2698
2663	glTranslate 2 - 0.375, 2 - 0.375;	2699	glTranslate 2 - 0.375, 2 - 0.375;
		2700
2664	$self->SUPER::_draw;	2701	$self->SUPER::_draw;
2665	}	2702	}
2666		2703
2667	#############################################################################	2704	#############################################################################
2668		2705
…		…
2833	# maybe save $GRAB? must be careful about events...	2870	# maybe save $GRAB? must be careful about events...
2834	$GRAB = $self;	2871	$GRAB = $self;
2835	$self->{button} = $ev->{button};	2872	$self->{button} = $ev->{button};
2836		2873
2837	$self->show;	2874	$self->show;
2838	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2875	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2839	}	2876	}
2840		2877
2841	sub mouse_motion {	2878	sub mouse_motion {
2842	my ($self, $ev, $x, $y) = @_;	2879	my ($self, $ev, $x, $y) = @_;
2843		2880
…		…
2977	use CFClient::OpenGL;	3014	use CFClient::OpenGL;
2978		3015
2979	sub new {	3016	sub new {
2980	my $class = shift;	3017	my $class = shift;
2981		3018
2982	$class->SUPER::new (	3019	my $self = $class->SUPER::new (
2983	visible => 1,	3020	visible => 1,
2984	@_,	3021	@_,
2985	)	3022	);
2986	}
2987		3023
2988	sub configure {	3024	Scalar::Util::weaken ($self->{root} = $self);
2989	my ($self, $x, $y, $w, $h) = @_;
2990		3025
2991	$self->{w} = $w;	3026	$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	}	3027	}
3001		3028
3002	sub size_request {	3029	sub size_request {
3003	my ($self) = @_;	3030	my ($self) = @_;
3004		3031
3005	($self->{w}, $self->{h})	3032	($self->{w}, $self->{h})
		3033	}
		3034
		3035	sub _to_pixel {
		3036	my ($coord, $size, $max) = @_;
		3037
		3038	$coord =
		3039	$coord eq "center" ? ($max - $size) * 0.5
		3040	: $coord eq "max" ? $max
		3041	: $coord;
		3042
		3043	$coord = 0 if $coord < 0;
		3044	$coord = $max - $size if $coord > $max - $size;
		3045
		3046	int $coord + 0.5
3006	}	3047	}
3007		3048
3008	sub size_allocate {	3049	sub size_allocate {
3009	my ($self, $w, $h) = @_;	3050	my ($self, $w, $h) = @_;
3010		3051
3011	for my $child ($self->children) {	3052	for my $child ($self->children) {
3012	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3053	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3013		3054
3014	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3055	$X = $child->{force_x} if exists $child->{force_x};
3015	if exists $child->{req_x};	3056	$Y = $child->{force_y} if exists $child->{force_y};
3016		3057
3017	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3058	$X = _to_pixel $X, $W, $self->{w};
3018	if exists $child->{req_y};	3059	$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		3060
3025	$child->configure ($X, $Y, $W, $H);	3061	$child->configure ($X, $Y, $W, $H);
3026	}	3062	}
3027	}	3063	}
3028		3064
…		…
3039	}	3075	}
3040		3076
3041	sub update {	3077	sub update {
3042	my ($self) = @_;	3078	my ($self) = @_;
3043		3079
3044	$self->check_size;
3045	$::WANT_REFRESH++;	3080	$::WANT_REFRESH++;
3046	}	3081	}
3047		3082
3048	sub add {	3083	sub add {
3049	my ($self, @children) = @_;	3084	my ($self, @children) = @_;
3050		3085
3051	for my $child (@children) {
3052	$child->{is_toplevel} = 1;	3086	$_->{is_toplevel} = 1
3053		3087	for @children;
3054	# integerise window positions
3055	$child->{x} = int $child->{x};
3056	$child->{y} = int $child->{y};
3057	}
3058		3088
3059	$self->SUPER::add (@children);	3089	$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	}	3090	}
3067		3091
3068	sub remove {	3092	sub remove {
3069	my ($self, @children) = @_;	3093	my ($self, @children) = @_;
3070		3094
3071	$self->SUPER::remove (@children);	3095	$self->SUPER::remove (@children);
		3096
		3097	delete $self->{is_toplevel}
		3098	for @children;
3072		3099
3073	while (@children) {	3100	while (@children) {
3074	my $w = pop @children;	3101	my $w = pop @children;
3075	push @children, $w->children;	3102	push @children, $w->children;
3076	$w->set_invisible;	3103	$w->set_invisible;
…		…
3095	while ($self->{refresh_hook}) {	3122	while ($self->{refresh_hook}) {
3096	$_->()	3123	$_->()
3097	for values %{delete $self->{refresh_hook}};	3124	for values %{delete $self->{refresh_hook}};
3098	}	3125	}
3099		3126
3100	if ($self->{check_size}) {	3127	if ($self->{realloc}) {
3101	my @queue;	3128	my @queue;
3102		3129
3103	while () {	3130	while () {
3104	if ($self->{check_size}) {	3131	if ($self->{realloc}) {
3105	#TODO use array-of-depth approach	3132	#TODO use array-of-depth approach
3106		3133
		3134	use sort 'stable';
		3135
3107	@queue = sort { $a->{visible} <=> $b->{visible} }	3136	@queue = sort { $a->{visible} <=> $b->{visible} }
3108	@queue, values %{delete $self->{check_size}};	3137	@queue, values %{delete $self->{realloc}};
3109	}	3138	}
3110		3139
3111	my $widget = pop @queue \|\| last;	3140	my $widget = pop @queue \|\| last;
3112		3141
3113	defined $widget->{visible} or last; # do not resize invisible widgets	3142	$widget->{visible} or last; # do not resize invisible widgets
3114		3143
3115	my ($w, $h) = $widget->{def_w} && $widget->{def_h}
3116	? @$widget{qw(def_w def_h)}
3117	: $widget->size_request;	3144	my ($w, $h) = $widget->size_request;
3118		3145
		3146	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3147	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3148
		3149	$w = $widget->{force_w} if exists $widget->{force_w};
		3150	$h = $widget->{force_h} if exists $widget->{force_h};
		3151
		3152	if ($widget->{req_w} != $w \|\| $widget->{req_h} != $h
3119	if (delete $widget->{force_alloc}	3153	\|\| 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;	3154	$widget->{req_w} = $w;
3124	$widget->{req_h} = $h;	3155	$widget->{req_h} = $h;
3125		3156
3126	$self->{size_alloc}{$widget} = [$widget, $widget->{w} \|\| $w, $widget->{h} \|\| $h];	3157	$self->{size_alloc}{$widget+0} = $widget;
3127		3158
3128	$widget->{parent}->check_size
3129	if $widget->{parent};	3159	if (my $parent = $widget->{parent}) {
		3160	$self->{realloc}{$parent+0} = $parent;
		3161	#unshift @queue, $parent;
		3162	$parent->{force_size_alloc} = 1;
		3163	$self->{size_alloc}{$parent+0} = $parent;
		3164	}
3130	}	3165	}
		3166
		3167	delete $self->{realloc}{$widget+0};
3131	}	3168	}
3132	}	3169	}
3133		3170
3134	while (my $size_alloc = delete $self->{size_alloc}) {	3171	while (my $size_alloc = delete $self->{size_alloc}) {
3135	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3172	my @queue = sort { $b->{visible} <=> $a->{visible} }
3136	values %$size_alloc;	3173	values %$size_alloc;
3137		3174
3138	while () {	3175	while () {
3139	my ($widget, $w, $h) = @{ pop @queue or last };	3176	my $widget = pop @queue \|\| last;
		3177
		3178	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3140		3179
3141	$w = 0 if $w < 0;	3180	$w = 0 if $w < 0;
3142	$h = 0 if $h < 0;	3181	$h = 0 if $h < 0;
3143		3182
		3183	$w = int $w + 0.5;
		3184	$h = int $h + 0.5;
		3185
		3186	if ($widget->{w} != $w \|\| $widget->{h} != $h \|\| delete $widget->{force_size_alloc}) {
3144	$widget->{w} = $w;	3187	$widget->{w} = $w;
3145	$widget->{h} = $h;	3188	$widget->{h} = $h;
		3189
3146	$widget->emit (size_allocate => $w, $h);	3190	$widget->emit (size_allocate => $w, $h);
		3191	}
3147	}	3192	}
3148	}	3193	}
3149		3194
3150	while ($self->{post_alloc_hook}) {	3195	while ($self->{post_alloc_hook}) {
3151	$_->()	3196	$_->()
3152	for values %{delete $self->{post_alloc_hook}};	3197	for values %{delete $self->{post_alloc_hook}};
3153	}	3198	}
		3199
3154		3200
3155	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3201	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3156	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3202	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3157	glClear GL_COLOR_BUFFER_BIT;	3203	glClear GL_COLOR_BUFFER_BIT;
3158		3204
…		…
3165	$self->_draw;	3211	$self->_draw;
3166	}	3212	}
3167		3213
3168	#############################################################################	3214	#############################################################################
3169		3215
		3216	package CFClient::UI::SpellList;
		3217
		3218	our @ISA = CFClient::UI::FancyFrame::;
		3219
		3220	sub new {
		3221	my $class = shift;
		3222
		3223	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3224
		3225	$self->add (new CFClient::UI::ScrolledWindow
		3226	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3227
		3228	$self;
		3229	}
		3230
		3231	# XXX: Do sorting? Argl...
		3232	sub add_spell {
		3233	my ($self, $spell) = @_;
		3234	$self->{spells}->{$spell->{name}} = $spell;
		3235
		3236	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3237	face => $spell->{face},
		3238	can_hover => 1,
		3239	can_events => 1,
		3240	tooltip => $spell->{message});
		3241
		3242	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3243	text => $spell->{name},
		3244	can_hover => 1,
		3245	can_events => 1,
		3246	tooltip => $spell->{message},
		3247	expand => 1);
		3248
		3249	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3250	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3251	$spell->{level}, ($spell->{mana} \|\| $spell->{grace}), $spell->{damage}),
		3252	expand => 1);
		3253
		3254	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3255	text => "bind to key",
		3256	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3257	}
		3258
		3259	sub rebuild_spell_list {
		3260	my ($self) = @_;
		3261	$self->{tbl_idx} = 0;
		3262	$self->add_spell ($_) for values %{$self->{spells}};
		3263	}
		3264
		3265	sub remove_spell {
		3266	my ($self, $spell) = @_;
		3267	delete $self->{spells}->{$spell->{name}};
		3268	$self->rebuild_spell_list;
		3269	}
		3270
		3271	#############################################################################
		3272
		3273	package CFClient::UI::BindEditor;
		3274
		3275	our @ISA = CFClient::UI::FancyFrame::;
		3276
		3277	sub new {
		3278	my $class = shift;
		3279
		3280	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3281
		3282	$self->add (my $vb = new CFClient::UI::VBox);
		3283
		3284
		3285	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3286	text => "start recording",
		3287	tooltip => "Start/Stops recording of actions."
		3288	."All subsequent actions after the recording started will be captured."
		3289	."The actions are displayed after the record was stopped."
		3290	."To bind the action you have to click on the 'Bind' button",
		3291	on_activate => sub {
		3292	unless ($self->{recording}) {
		3293	$self->start;
		3294	} else {
		3295	$self->stop;
		3296	}
		3297	});
		3298
		3299	$vb->add (new CFClient::UI::Label text => "Actions:");
		3300	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3301
		3302	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3303	$vb->add (my $hb = new CFClient::UI::HBox);
		3304	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3305	$hb->add (new CFClient::UI::Button
		3306	text => "bind",
		3307	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3308	on_activate => sub {
		3309	$self->ask_for_bind;
		3310	});
		3311
		3312	$vb->add (my $hb = new CFClient::UI::HBox);
		3313	$hb->add (new CFClient::UI::Button
		3314	text => "ok",
		3315	expand => 1,
		3316	tooltip => "This closes the binding editor and saves the binding",
		3317	on_activate => sub {
		3318	$self->hide;
		3319	$self->commit;
		3320	});
		3321
		3322	$hb->add (new CFClient::UI::Button
		3323	text => "cancel",
		3324	expand => 1,
		3325	tooltip => "This closes the binding editor without saving",
		3326	on_activate => sub {
		3327	$self->hide;
		3328	$self->{binding_cancel}->()
		3329	if $self->{binding_cancel};
		3330	});
		3331
		3332	$self->update_binding_widgets;
		3333
		3334	$self
		3335	}
		3336
		3337	sub commit {
		3338	my ($self) = @_;
		3339	my ($mod, $sym, $cmds) = $self->get_binding;
		3340	if ($sym != 0 && @$cmds > 0) {
		3341	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3342	."'. Don't forget 'Save Config'!");
		3343	$self->{binding_change}->($mod, $sym, $cmds)
		3344	if $self->{binding_change};
		3345	} else {
		3346	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3347	$self->{binding_cancel}->()
		3348	if $self->{binding_cancel};
		3349	}
		3350	}
		3351
		3352	sub start {
		3353	my ($self) = @_;
		3354
		3355	$self->{rec_btn}->set_text ("stop recording");
		3356	$self->{recording} = 1;
		3357	$self->clear_command_list;
		3358	$::CONN->start_record if $::CONN;
		3359	}
		3360
		3361	sub stop {
		3362	my ($self) = @_;
		3363
		3364	$self->{rec_btn}->set_text ("start recording");
		3365	$self->{recording} = 0;
		3366
		3367	my $rec;
		3368	$rec = $::CONN->stop_record if $::CONN;
		3369	return unless ref $rec eq 'ARRAY';
		3370	$self->set_command_list ($rec);
		3371	}
		3372
		3373	# if $commit is true, the binding will be set after the user entered a key combo
		3374	sub ask_for_bind {
		3375	my ($self, $commit) = @_;
		3376
		3377	CFClient::Binder::open_binding_dialog (sub {
		3378	my ($mod, $sym) = @_;
		3379	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3380	$self->update_binding_widgets;
		3381	$self->commit if $commit;
		3382	});
		3383	}
		3384
		3385	# $mod and $sym are the modifiers and key symbol
		3386	# $cmds is a array ref of strings (the commands)
		3387	# $cb is the callback that is executed on OK
		3388	# $ccb is the callback that is executed on CANCEL and
		3389	# when the binding was unsuccessful on OK
		3390	sub set_binding {
		3391	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3392
		3393	$self->clear_command_list;
		3394	$self->{recording} = 0;
		3395	$self->{rec_btn}->set_text ("start recording");
		3396
		3397	$self->{binding} = [$mod, $sym];
		3398	$self->{commands} = $cmds;
		3399
		3400	$self->{binding_change} = $cb;
		3401	$self->{binding_cancel} = $ccb;
		3402
		3403	$self->update_binding_widgets;
		3404	}
		3405
		3406	# this is a shortcut method that asks for a binding
		3407	# and then just binds it.
		3408	sub do_quick_binding {
		3409	my ($self, $cmds) = @_;
		3410	$self->set_binding (undef, undef, $cmds, sub {
		3411	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3412	});
		3413	$self->ask_for_bind (1);
		3414	}
		3415
		3416	sub update_binding_widgets {
		3417	my ($self) = @_;
		3418	my ($mod, $sym, $cmds) = $self->get_binding;
		3419	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3420	$self->set_command_list ($cmds);
		3421	}
		3422
		3423	sub get_binding {
		3424	my ($self) = @_;
		3425	return (
		3426	$self->{binding}->[0],
		3427	$self->{binding}->[1],
		3428	[ grep { defined $_ } @{$self->{commands}} ]
		3429	);
		3430	}
		3431
		3432	sub clear_command_list {
		3433	my ($self) = @_;
		3434	$self->{cmdbox}->clear ();
		3435	}
		3436
		3437	sub set_command_list {
		3438	my ($self, $cmds) = @_;
		3439
		3440	$self->{cmdbox}->clear ();
		3441	$self->{commands} = $cmds;
		3442
		3443	my $idx = 0;
		3444
		3445	for (@$cmds) {
		3446	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3447
		3448	my $i = $idx;
		3449	$hb->add (new CFClient::UI::Label text => $_);
		3450	$hb->add (new CFClient::UI::Button
		3451	text => "delete",
		3452	tooltip => "Deletes the action from the record",
		3453	on_activate => sub {
		3454	$self->{cmdbox}->remove ($hb);
		3455	$cmds->[$i] = undef;
		3456	});
		3457
		3458
		3459	$idx++
		3460	}
		3461	}
		3462
		3463	#############################################################################
		3464
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.264 by root, Thu Jun 1 02:58:30 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.264 by root, Thu Jun 1 02:58:30 2006 UTC