ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.254 by root, Mon May 29 01:53:23 2006 UTC vs.
Revision 1.270 by elmex, Fri Jun 2 09:02:49 2006 UTC

…		…
17	our $BUTTON_STATE;	17	our $BUTTON_STATE;
18		18
19	our %WIDGET; # all widgets, weak-referenced	19	our %WIDGET; # all widgets, weak-referenced
20		20
21	sub get_layout {	21	sub get_layout {
		22	my $layout;
		23
22	for (grep { $_->{name} } values %WIDGET) {	24	for (grep { $_->{name} } values %WIDGET) {
23	$LAYOUT->{$_->{name}} = {	25	my $win = $layout->{$_->{name}} = { };
24	x => $_->{x} / $::WIDTH,
25	y => $_->{y} / $::HEIGHT,
26	w => $_->{w} / $::WIDTH,
27	h => $_->{h} / $::HEIGHT
28	};	26
29	}	27	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
		28	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
		29	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
		30	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
30		31
31	return $LAYOUT;	32	$win->{show} = $_->{visible} && $_->{is_toplevel};
		33	}
		34
		35	$layout
32	}	36	}
33		37
34	sub set_layout {	38	sub set_layout {
35	my ($layout) = @_;	39	my ($layout) = @_;
		40
36	$LAYOUT = $layout;	41	$LAYOUT = $layout;
37	}	42	}
38		43
39	sub check_tooltip {	44	sub check_tooltip {
		45	return if $ENV{CFPLUS_DEBUG} & 8;
		46
40	if (!$GRAB) {	47	if (!$GRAB) {
41	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	48	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
42	if (length $widget->{tooltip}) {	49	if (length $widget->{tooltip}) {
43
44	if ($TOOLTIP->{owner} != $widget) {	50	if ($TOOLTIP->{owner} != $widget) {
45	$TOOLTIP->hide;	51	$TOOLTIP->hide;
46		52
47	$TOOLTIP->{owner} = $widget;	53	$TOOLTIP->{owner} = $widget;
48		54
…		…
165	sub rescale_widgets {	171	sub rescale_widgets {
166	my ($sx, $sy) = @_;	172	my ($sx, $sy) = @_;
167		173
168	for my $widget (values %WIDGET) {	174	for my $widget (values %WIDGET) {
169	if ($widget->{is_toplevel}) {	175	if ($widget->{is_toplevel}) {
		176	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		177	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		178
170	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};	179	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
171	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};	180	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
172	$widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};	181	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
173	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};	182	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
174	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	183	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
175	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};	184	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
		185
		186	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		187	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		188
176	}	189	}
177	}	190	}
178		191
179	reconfigure_widgets;	192	reconfigure_widgets;
180	}	193	}
…		…
189		202
190	sub new {	203	sub new {
191	my $class = shift;	204	my $class = shift;
192		205
193	my $self = bless {	206	my $self = bless {
194	x => 0,	207	x => "center",
195	y => 0,	208	y => "center",
196	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
197	can_events => 1,	212	can_events => 1,
198	@_	213	@_
199	}, $class;	214	}, $class;
		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
200		217
201	for (keys %$self) {	218	for (keys %$self) {
202	if (/^on_(.*)$/) {	219	if (/^on_(.*)$/) {
203	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
204	}	221	}
205	}	222	}
206		223
207	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
208
209	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
210	$self->{req_x} = $layout->{x} * $::WIDTH;	225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
211	$self->{req_y} = $layout->{y} * $::HEIGHT;	226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
212	$self->{def_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH;	227	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
213	$self->{def_h} = ($layout->{h} != 0 ? $layout->{h} : 1) * $::HEIGHT;	228	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		229
		230	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		231	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		232
		233	$self->show if $layout->{show};
214	}	234	}
215		235
216	$self	236	$self
217	}	237	}
218		238
…		…
227	my ($self) = @_;	247	my ($self) = @_;
228		248
229	return if $self->{parent};	249	return if $self->{parent};
230		250
231	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
232	}
233
234	sub center {
235	my ($self) = @_;
236
237	$CFClient::UI::ROOT->on_post_alloc (
238	"center_$self" => sub {
239	$self->move (($self->{parent}{w} - $self->{w}) * 0.5, ($self->{parent}{h} - $self->{h}) * 0.5);
240	},
241	);
242
243	$self->update;
244	}	252	}
245		253
246	sub set_visible {	254	sub set_visible {
247	my ($self) = @_;	255	my ($self) = @_;
248		256
…		…
303		311
304	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
305	if $self->{parent};	313	if $self->{parent};
306	}	314	}
307		315
308	sub move {	316	sub move_abs {
309	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
310		318
311	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
312	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
313	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
314		322
315	$self->update;	323	$self->update;
316	}	324	}
317		325
318	sub set_size {	326	sub set_size {
319	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
320		328
321	$self->{def_w} = $w;	329	$self->{force_w} = $w;
322	$self->{def_h} = $h;	330	$self->{force_h} = $h;
323		331
324	$self->realloc;	332	$self->realloc;
325	}	333	}
326		334
327	sub size_request {	335	sub size_request {
…		…
331		339
332	sub configure {	340	sub configure {
333	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
334		342
335	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
336	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
337	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
338		348
339	# use alignment to adjust x, y	349	# use alignment to adjust x, y
340		350
341	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
342	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
343
344	($w, $h) = ($w2, $h2);
345	}	353	}
346		354
347	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
348	$self->{x} = $x;	356	$self->{x} = $x;
349	$self->{y} = $y;	357	$self->{y} = $y;
350	$self->update;	358	$self->update;
351	}	359	}
352		360
353	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
354	return unless $self->{visible};	362	return unless $self->{visible};
355		363
		364	$self->{alloc_w} = $w;
		365	$self->{alloc_h} = $h;
		366
356	$self->{root}->{size_alloc}{$self+0} = [$self, $w, $h];	367	$self->{root}{size_alloc}{$self+0} = $self;
357	}	368	}
358	}	369	}
359		370
360	sub size_allocate {	371	sub size_allocate {
361	# nothing to be done	372	# nothing to be done
…		…
439	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
440		451
441	$self->focus_in;	452	$self->focus_in;
442	}	453	}
443		454
444	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
445	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
446	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
447	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
448	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
449
450	sub find_widget {	455	sub find_widget {
451	my ($self, $x, $y) = @_;	456	my ($self, $x, $y) = @_;
452		457
453	return () unless $self->{can_events};	458	return () unless $self->{can_events};
454		459
…		…
461		466
462	sub set_parent {	467	sub set_parent {
463	my ($self, $parent) = @_;	468	my ($self, $parent) = @_;
464		469
465	Scalar::Util::weaken ($self->{parent} = $parent);	470	Scalar::Util::weaken ($self->{parent} = $parent);
466
467	$self->set_visible if $parent->{visible};	471	$self->set_visible if $parent->{visible};
468	}	472	}
469		473
470	sub connect {	474	sub connect {
471	my ($self, $signal, $cb) = @_;	475	my ($self, $signal, $cb) = @_;
…		…
492		496
493	sub realloc {	497	sub realloc {
494	my ($self) = @_;	498	my ($self) = @_;
495		499
496	if ($self->{visible}) {	500	if ($self->{visible}) {
497	return if $self->{root}{realloc}{$self};	501	return if $self->{root}{realloc}{$self+0};
498		502
499	$self->{root}{realloc}{$self} = $self;	503	$self->{root}{realloc}{$self+0} = $self;
500	$self->{root}->update;	504	$self->{root}->update;
501	} else {	505	} else {
502	delete $self->{req_w};	506	delete $self->{req_w};
		507	delete $self->{req_h};
503	}	508	}
504	}	509	}
505		510
506	sub update {	511	sub update {
507	my ($self) = @_;	512	my ($self) = @_;
508		513
509	$self->{parent}->update	514	$self->{parent}->update
510	if $self->{parent};	515	if $self->{parent};
511	}	516	}
512		517
		518	sub reconfigure {
		519	my ($self) = @_;
		520
		521	$self->realloc;
		522	$self->update;
		523	}
		524
		525	# using global variables seems a bit hacky, but passing through all drawing
		526	# functions seems pointless.
		527	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
		528
513	sub draw {	529	sub draw {
514	my ($self) = @_;	530	my ($self) = @_;
515		531
516	return unless $self->{h} && $self->{w};	532	return unless $self->{h} && $self->{w};
		533
		534	# update screen rectangle
		535	local $draw_x = $draw_x + $self->{x};
		536	local $draw_y = $draw_y + $self->{y};
		537	local $draw_w = $draw_x + $self->{w};
		538	local $draw_h = $draw_y + $self->{h};
		539
		540	# skip widgets that are entirely outside the drawing area
		541	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		542	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
517		543
518	glPushMatrix;	544	glPushMatrix;
519	glTranslate $self->{x}, $self->{y}, 0;	545	glTranslate $self->{x}, $self->{y}, 0;
520	$self->_draw;	546	$self->_draw;
521	glPopMatrix;	547	glPopMatrix;
…		…
533	glVertex $x , $y + $self->{h};	559	glVertex $x , $y + $self->{h};
534	glEnd;	560	glEnd;
535	glDisable GL_BLEND;	561	glDisable GL_BLEND;
536	}	562	}
537		563
538	if ($ENV{PCLIENT_DEBUG}) {	564	if ($ENV{CFPLUS_DEBUG} & 1) {
539	glPushMatrix;	565	glPushMatrix;
540	glColor 1, 1, 0, 1;	566	glColor 1, 1, 0, 1;
541	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	567	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
542	glBegin GL_LINE_LOOP;	568	glBegin GL_LINE_LOOP;
543	glVertex 0 , 0;	569	glVertex 0 , 0;
…		…
619	my ($class, %arg) = @_;	645	my ($class, %arg) = @_;
620	$class->SUPER::new (can_events => 0, %arg);	646	$class->SUPER::new (can_events => 0, %arg);
621	}	647	}
622		648
623	sub size_request {	649	sub size_request {
624	(0, 0)	650	my ($self) = @_;
		651
		652	($self->{w} + 0, $self->{h} + 0)
625	}	653	}
626		654
627	sub draw { }	655	sub draw { }
628		656
629	#############################################################################	657	#############################################################################
…		…
750	sub size_request {	778	sub size_request {
751	$_[0]{children}[0]->size_request	779	$_[0]{children}[0]->size_request
752	}	780	}
753		781
754	sub size_allocate {	782	sub size_allocate {
755	my ($self, $w, $h, $changed) = @_;	783	my ($self, $w, $h) = @_;
756		784
757	$self->{children}[0]->configure (0, 0, $w, $h);	785	$self->{children}[0]->configure (0, 0, $w, $h);
758	}	786	}
759		787
760	#############################################################################	788	#############################################################################
…		…
777	$ROOT->on_post_alloc ($self => sub { $self->render_child });	805	$ROOT->on_post_alloc ($self => sub { $self->render_child });
778	$self->SUPER::update;	806	$self->SUPER::update;
779	}	807	}
780		808
781	sub size_allocate {	809	sub size_allocate {
782	my ($self, $w, $h, $changed) = @_;	810	my ($self, $w, $h) = @_;
783		811
784	$self->SUPER::size_allocate ($w, $h, $changed);	812	$self->SUPER::size_allocate ($w, $h);
785	$self->update	813	$self->update;
786	if $changed;
787	}	814	}
788		815
789	sub _render {	816	sub _render {
		817	my ($self) = @_;
		818
790	$_[0]{children}[0]->draw;	819	$self->{children}[0]->draw;
791	}	820	}
792		821
793	sub render_child {	822	sub render_child {
794	my ($self) = @_;	823	my ($self) = @_;
795		824
796	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	825	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
797	glClearColor 0, 0, 0, 0;	826	glClearColor 0, 0, 0, 0;
798	glClear GL_COLOR_BUFFER_BIT;	827	glClear GL_COLOR_BUFFER_BIT;
799		828
		829	{
		830	package CFClient::UI::Base;
		831
		832	($draw_x, $draw_y, $draw_w, $draw_h) =
		833	(0, 0, $self->{w}, $self->{h});
		834	}
		835
800	$self->_render;	836	$self->_render;
801	};	837	};
802	}	838	}
803		839
804	sub _draw {	840	sub _draw {
805	my ($self) = @_;	841	my ($self) = @_;
806		842
807	my ($w, $h) = ($self->w, $self->h);	843	my ($w, $h) = @$self{qw(w h)};
808		844
809	my $tex = $self->{texture}	845	my $tex = $self->{texture}
810	or return;	846	or return;
811		847
812	glEnable GL_TEXTURE_2D;	848	glEnable GL_TEXTURE_2D;
…		…
835	}	871	}
836		872
837	sub size_request {	873	sub size_request {
838	my ($self) = @_;	874	my ($self) = @_;
839		875
840	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	876	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
841		877
842	$w = 10 if $self->{scroll_x};	878	$w = 10 if $self->{scroll_x};
843	$h = 10 if $self->{scroll_y};	879	$h = 10 if $self->{scroll_y};
844		880
845	($w, $h)	881	($w, $h)
846	}	882	}
847		883
848	sub size_allocate {	884	sub size_allocate {
849	my ($self, $w, $h, $changed) = @_;	885	my ($self, $w, $h) = @_;
850		886
		887	my $child = $self->child;
		888
851	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	889	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
852	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	890	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
853		891
854	$self->child->configure (0, 0, $w, $h);	892	$self->child->configure (0, 0, $w, $h);
855	$self->update;	893	$self->update;
856	}	894	}
857		895
…		…
892	}	930	}
893	}	931	}
894		932
895	sub _render {	933	sub _render {
896	my ($self) = @_;	934	my ($self) = @_;
		935
		936	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		937	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
897		938
898	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	939	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
899		940
900	$self->SUPER::_render;	941	$self->SUPER::_render;
901	}	942	}
…		…
941	my $child = $self->{vp}->child;	982	my $child = $self->{vp}->child;
942	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	983	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
943	}	984	}
944		985
945	sub size_allocate {	986	sub size_allocate {
946	my ($self, $w, $h, $changed) = @_;	987	my ($self, $w, $h) = @_;
947		988
948	$self->SUPER::size_allocate ($w, $h, $changed);	989	$self->SUPER::size_allocate ($w, $h);
949		990
950	my $child = $self->{vp}->child;	991	my $child = $self->{vp}->child;
951	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	992	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
952	}	993	}
953		994
…		…
1000		1041
1001	our @ISA = CFClient::UI::Bin::;	1042	our @ISA = CFClient::UI::Bin::;
1002		1043
1003	use CFClient::OpenGL;	1044	use CFClient::OpenGL;
1004		1045
1005	my @tex =	1046	my $bg =
		1047	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1048	mipmap => 1, wrap => 1;
		1049
		1050	my @border =
1006	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1051	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1007	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1052	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1008		1053
1009	sub new {	1054	sub new {
1010	my $class = shift;	1055	my ($class, %arg) = @_;
		1056
		1057	my $title = delete $arg{title};
1011		1058
1012	my $self = $class->SUPER::new (	1059	my $self = $class->SUPER::new (
1013	bg => [1, 1, 1, 1],	1060	bg => [1, 1, 1, 1],
1014	border_bg => [1, 1, 1, 1],	1061	border_bg => [1, 1, 1, 1],
1015	border => 0.6,	1062	border => 0.6,
1016	is_toplevel => 1,
1017	can_events => 1,	1063	can_events => 1,
1018	@_	1064	min_w => 16,
		1065	min_h => 16,
		1066	%arg,
1019	);	1067	);
1020		1068
1021	$self->{title} &&= new CFClient::UI::Label	1069	$self->{title} = new CFClient::UI::Label
1022	align => 0,	1070	align => 0,
1023	valign => 1,	1071	valign => 1,
1024	text => $self->{title},	1072	text => $title,
1025	fontsize => $self->{border};	1073	fontsize => $self->{border}
		1074	if defined $title;
1026		1075
1027	$self	1076	$self
		1077	}
		1078
		1079	sub add {
		1080	my ($self, @widgets) = @_;
		1081
		1082	$self->SUPER::add (@widgets);
		1083	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
1028	}	1084	}
1029		1085
1030	sub border {	1086	sub border {
1031	int $_[0]{border} * $::FONTSIZE	1087	int $_[0]{border} * $::FONTSIZE
1032	}	1088	}
1033		1089
1034	sub size_request {	1090	sub size_request {
1035	my ($self) = @_;	1091	my ($self) = @_;
		1092
		1093	$self->{title}->size_request
		1094	if $self->{title};
1036		1095
1037	my ($w, $h) = $self->SUPER::size_request;	1096	my ($w, $h) = $self->SUPER::size_request;
1038		1097
1039	(	1098	(
1040	$w + $self->border * 2,	1099	$w + $self->border * 2,
1041	$h + $self->border * 2,	1100	$h + $self->border * 2,
1042	)	1101	)
1043	}	1102	}
1044		1103
1045	sub size_allocate {	1104	sub size_allocate {
1046	my ($self, $w, $h, $changed) = @_;	1105	my ($self, $w, $h) = @_;
1047		1106
1048	return unless $changed;	1107	if ($self->{title}) {
		1108	$self->{title}{w} = $w;
		1109	$self->{title}{h} = $h;
		1110	$self->{title}->size_allocate ($w, $h);
		1111	}
1049		1112
		1113	my $border = $self->border;
		1114
1050	$h -= List::Util::max 0, $self->border * 2;	1115	$h -= List::Util::max 0, $border * 2;
1051	$w -= List::Util::max 0, $self->border * 2;	1116	$w -= List::Util::max 0, $border * 2;
1052		1117
1053	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1054	if $self->{title};
1055
1056	$self->child->configure ($self->border, $self->border, $w, $h);	1118	$self->child->configure ($border, $border, $w, $h);
1057	}	1119	}
1058		1120
1059	sub button_down {	1121	sub button_down {
1060	my ($self, $ev, $x, $y) = @_;	1122	my ($self, $ev, $x, $y) = @_;
1061		1123
…		…
1077	my ($ev, $x, $y) = @_;	1139	my ($ev, $x, $y) = @_;
1078		1140
1079	my $dx = $ev->{x} - $ox;	1141	my $dx = $ev->{x} - $ox;
1080	my $dy = $ev->{y} - $oy;	1142	my $dy = $ev->{y} - $oy;
1081		1143
1082	$self->{user_x} = $wx + $dx * $mx;
1083	$self->{user_y} = $wy + $dy * $my;
1084	$self->{def_w} = $bw + $dx * ($mx ? -1 : 1);	1144	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1085	$self->{def_h} = $bh + $dy * ($my ? -1 : 1);	1145	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1086	$self->move ($self->{user_x}, $self->{user_y});	1146
1087	$self->realloc;	1147	$self->realloc;
		1148	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1088	};	1149	};
1089		1150
1090	} elsif ($lr ^ $td) {	1151	} elsif ($lr ^ $td) {
1091	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1152	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1092	my ($bx, $by) = ($self->{x}, $self->{y});	1153	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1094	$self->{motion} = sub {	1155	$self->{motion} = sub {
1095	my ($ev, $x, $y) = @_;	1156	my ($ev, $x, $y) = @_;
1096		1157
1097	($x, $y) = ($ev->{x}, $ev->{y});	1158	($x, $y) = ($ev->{x}, $ev->{y});
1098		1159
1099	$self->{user_x} = $bx + $x - $ox;	1160	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1100	$self->{user_y} = $by + $y - $oy;
1101
1102	$self->move ($self->{user_x}, $self->{user_y});
1103	$self->realloc;
1104	};	1161	};
1105	}	1162	}
1106	}	1163	}
1107		1164
1108	sub button_up {	1165	sub button_up {
…		…
1118	}	1175	}
1119		1176
1120	sub _draw {	1177	sub _draw {
1121	my ($self) = @_;	1178	my ($self) = @_;
1122		1179
		1180	my $child = $self->{children}[0];
		1181
1123	my ($w, $h ) = ($self->{w}, $self->{h});	1182	my ($w, $h ) = ($self->{w}, $self->{h});
1124	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1183	my ($cw, $ch) = ($child->{w}, $child->{h});
1125		1184
1126	glEnable GL_TEXTURE_2D;	1185	glEnable GL_TEXTURE_2D;
1127	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1186	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1128		1187
1129	my $border = $self->border;	1188	my $border = $self->border;
1130		1189
1131	glColor @{ $self->{border_bg} };	1190	glColor @{ $self->{border_bg} };
1132	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1191	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1133	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1192	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1134	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1193	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1135	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1194	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1136		1195
1137	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1196	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1138	my $bg = $tex[0];	1197	glColor @{ $self->{bg} };
1139		1198
1140	# TODO: repeat texture not scale	1199	# TODO: repeat texture not scale
		1200	# solve this better(?)
1141	my $rep_x = $cw / $bg->{w};	1201	$bg->{s} = $cw / $bg->{w};
1142	my $rep_y = $ch / $bg->{h};	1202	$bg->{t} = $ch / $bg->{h};
1143
1144	glColor @{ $self->{bg} };
1145
1146	$bg->{s} = $rep_x;
1147	$bg->{t} = $rep_y;
1148	$bg->{wrap_mode} = 1;
1149	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1203	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1150	}	1204	}
1151		1205
1152	glDisable GL_TEXTURE_2D;	1206	glDisable GL_TEXTURE_2D;
1153		1207
1154	$self->{title}->draw if $self->{title};
1155
1156	$self->child->draw;	1208	$child->draw;
		1209
		1210	if ($self->{title}) {
		1211	glTranslate 0, $border - $self->{h};
		1212	$self->{title}->_draw;
		1213	}
1157	}	1214	}
1158		1215
1159	#############################################################################	1216	#############################################################################
1160		1217
1161	package CFClient::UI::Table;	1218	package CFClient::UI::Table;
…		…
1235	(sum @$hs),	1292	(sum @$hs),
1236	)	1293	)
1237	}	1294	}
1238		1295
1239	sub size_allocate {	1296	sub size_allocate {
1240	my ($self, $w, $h, $changed) = @_;	1297	my ($self, $w, $h) = @_;
1241		1298
1242	my ($ws, $hs) = $self->get_wh;	1299	my ($ws, $hs) = $self->get_wh;
1243		1300
1244	my $req_w = (sum @$ws) || 1;	1301	my $req_w = (sum @$ws) || 1;
1245	my $req_h = (sum @$hs) || 1;	1302	my $req_h = (sum @$hs) || 1;
…		…
1323	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1380	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1324	)	1381	)
1325	}	1382	}
1326		1383
1327	sub size_allocate {	1384	sub size_allocate {
1328	my ($self, $w, $h, $changed) = @_;	1385	my ($self, $w, $h) = @_;
1329		1386
1330	my $space = $self->{vertical} ? $h : $w;	1387	my $space = $self->{vertical} ? $h : $w;
1331	my $children = $self->{children};	1388	my $children = $self->{children};
1332		1389
1333	my @req;	1390	my @req;
…		…
1416	ellipsise => 3, # end	1473	ellipsise => 3, # end
1417	layout => (new CFClient::Layout),	1474	layout => (new CFClient::Layout),
1418	fontsize => 1,	1475	fontsize => 1,
1419	align => -1,	1476	align => -1,
1420	valign => -1,	1477	valign => -1,
1421	padding => 2,	1478	padding_x => 2,
		1479	padding_y => 2,
1422	can_events => 0,	1480	can_events => 0,
1423	%arg	1481	%arg
1424	);	1482	);
1425		1483
1426	if (exists $self->{template}) {	1484	if (exists $self->{template}) {
…		…
1502		1560
1503	$w = List::Util::max $w, $w2;	1561	$w = List::Util::max $w, $w2;
1504	$h = List::Util::max $h, $h2;	1562	$h = List::Util::max $h, $h2;
1505	}	1563	}
1506		1564
1507	(	1565	($w, $h)
1508	$w + $self->{padding} * 2,
1509	$h + $self->{padding} * 2,
1510	)
1511	}	1566	}
1512		1567
1513	sub size_allocate {	1568	sub size_allocate {
1514	my ($self, $w, $h, $changed) = @_;	1569	my ($self, $w, $h) = @_;
		1570
		1571	delete $self->{ox};
1515		1572
1516	delete $self->{texture}	1573	delete $self->{texture}
1517	if $changed;	1574	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1518	}	1575	}
1519		1576
1520	sub set_fontsize {	1577	sub set_fontsize {
1521	my ($self, $fontsize) = @_;	1578	my ($self, $fontsize) = @_;
1522		1579
…		…
1537	$self->{layout}->set_width ($self->{w});	1594	$self->{layout}->set_width ($self->{w});
1538	$self->{layout}->set_ellipsise ($self->{ellipsise});	1595	$self->{layout}->set_ellipsise ($self->{ellipsise});
1539	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1596	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1540	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1597	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1541		1598
1542	my $tex = new_from_layout CFClient::Texture $self->{layout};	1599	new_from_layout CFClient::Texture $self->{layout}
		1600	};
1543		1601
		1602	unless (exists $self->{ox}) {
1544	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1603	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1545	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1604	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1546	: ($self->{w} - $tex->{w}) * 0.5);	1605	: ($self->{w} - $tex->{w}) * 0.5);
1547		1606
1548	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1607	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1549	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1608	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1550	: ($self->{h} - $tex->{h}) * 0.5);	1609	: ($self->{h} - $tex->{h}) * 0.5);
1551
1552	$tex
1553	};	1610	};
1554		1611
1555	glEnable GL_TEXTURE_2D;	1612	glEnable GL_TEXTURE_2D;
1556	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1613	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1557		1614
…		…
1793		1850
1794	sub new {	1851	sub new {
1795	my $class = shift;	1852	my $class = shift;
1796		1853
1797	$class->SUPER::new (	1854	$class->SUPER::new (
1798	padding => 4,	1855	padding_x => 4,
		1856	padding_y => 4,
1799	fg => [1, 1, 1],	1857	fg => [1, 1, 1],
1800	active_fg => [0, 0, 1],	1858	active_fg => [0, 0, 1],
1801	can_hover => 1,	1859	can_hover => 1,
1802	align => 0,	1860	align => 0,
1803	valign => 0,	1861	valign => 0,
…		…
1850		1908
1851	sub new {	1909	sub new {
1852	my $class = shift;	1910	my $class = shift;
1853		1911
1854	$class->SUPER::new (	1912	$class->SUPER::new (
1855	padding => 2,	1913	padding_x => 2,
		1914	padding_y => 2,
1856	fg => [1, 1, 1],	1915	fg => [1, 1, 1],
1857	active_fg => [1, 1, 0],	1916	active_fg => [1, 1, 0],
1858	bg => [0, 0, 0, 0.2],	1917	bg => [0, 0, 0, 0.2],
1859	active_bg => [1, 1, 1, 0.5],	1918	active_bg => [1, 1, 1, 0.5],
1860	state => 0,	1919	state => 0,
…		…
1864	}	1923	}
1865		1924
1866	sub size_request {	1925	sub size_request {
1867	my ($self) = @_;	1926	my ($self) = @_;
1868		1927
1869	($self->{padding} * 2 + 6) x 2	1928	(6) x 2
1870	}	1929	}
1871		1930
1872	sub button_down {	1931	sub button_down {
1873	my ($self, $ev, $x, $y) = @_;	1932	my ($self, $ev, $x, $y) = @_;
1874		1933
1875	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1934	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1876	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1935	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1877	$self->{state} = !$self->{state};	1936	$self->{state} = !$self->{state};
1878	$self->_emit (changed => $self->{state});	1937	$self->_emit (changed => $self->{state});
1879	}	1938	}
1880	}	1939	}
1881		1940
1882	sub _draw {	1941	sub _draw {
1883	my ($self) = @_;	1942	my ($self) = @_;
1884		1943
1885	$self->SUPER::_draw;	1944	$self->SUPER::_draw;
1886		1945
1887	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1946	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1888		1947
1889	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1948	my ($w, $h) = @$self{qw(w h)};
		1949
		1950	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1890		1951
1891	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1952	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1892		1953
1893	my $tex = $self->{state} ? $tex[1] : $tex[0];	1954	my $tex = $self->{state} ? $tex[1] : $tex[0];
1894		1955
…		…
2159	fg => [1, 1, 1],	2220	fg => [1, 1, 1],
2160	active_fg => [0, 0, 0],	2221	active_fg => [0, 0, 0],
2161	bg => [0, 0, 0, 0.2],	2222	bg => [0, 0, 0, 0.2],
2162	active_bg => [1, 1, 1, 0.5],	2223	active_bg => [1, 1, 1, 0.5],
2163	range => [0, 0, 100, 10, 0],	2224	range => [0, 0, 100, 10, 0],
2164	req_w => $::WIDTH / 80,	2225	min_w => $::WIDTH / 80,
2165	req_h => $::WIDTH / 80,	2226	min_h => $::WIDTH / 80,
2166	vertical => 0,	2227	vertical => 0,
2167	can_hover => 1,	2228	can_hover => 1,
2168	inner_pad => 0.02,	2229	inner_pad => 0.02,
2169	@_	2230	@_
2170	);	2231	);
…		…
2210	}	2271	}
2211		2272
2212	sub size_request {	2273	sub size_request {
2213	my ($self) = @_;	2274	my ($self) = @_;
2214		2275
2215	my $w = $self->{req_w};	2276	($self->{req_w}, $self->{req_h})
2216	my $h = $self->{req_h};
2217
2218	$self->{vertical} ? ($h, $w) : ($w, $h)
2219	}	2277	}
2220		2278
2221	sub button_down {	2279	sub button_down {
2222	my ($self, $ev, $x, $y) = @_;	2280	my ($self, $ev, $x, $y) = @_;
2223		2281
…		…
2373	$self->{fontsize} = $fontsize;	2431	$self->{fontsize} = $fontsize;
2374	$self->reflow;	2432	$self->reflow;
2375	}	2433	}
2376		2434
2377	sub size_allocate {	2435	sub size_allocate {
2378	my ($self, $w, $h, $changed) = @_;	2436	my ($self, $w, $h) = @_;
2379		2437
2380	$self->SUPER::size_allocate ($w, $h, $changed);	2438	$self->SUPER::size_allocate ($w, $h);
2381
2382	return unless $changed;
2383		2439
2384	$self->{layout}->set_font ($self->{font}) if $self->{font};	2440	$self->{layout}->set_font ($self->{font}) if $self->{font};
2385	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2441	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2386	$self->{layout}->set_width ($self->{children}[0]{w});	2442	$self->{layout}->set_width ($self->{children}[0]{w});
2387		2443
…		…
2610	}	2666	}
2611		2667
2612	sub set_tooltip_from {	2668	sub set_tooltip_from {
2613	my ($self, $widget) = @_;	2669	my ($self, $widget) = @_;
2614		2670
		2671	my $tooltip = $widget->{tooltip};
		2672
		2673	if ($ENV{CFPLUS_DEBUG} & 2) {
		2674	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2675	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2676	. "req $widget->{req_w} $widget->{req_h}\n"
		2677	. "visible $widget->{visible}";
		2678	}
		2679
2615	$self->add (new CFClient::UI::Label	2680	$self->add (new CFClient::UI::Label
2616	markup => $widget->{tooltip},	2681	markup => $tooltip,
2617	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2682	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2618	fontsize => 0.8,	2683	fontsize => 0.8,
2619	fg => [0, 0, 0, 1],	2684	fg => [0, 0, 0, 1],
2620	ellipsise => 0,	2685	ellipsise => 0,
2621	font => ($widget->{tooltip_font} || $::FONT_PROP),	2686	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2629		2694
2630	($w + 4, $h + 4)	2695	($w + 4, $h + 4)
2631	}	2696	}
2632		2697
2633	sub size_allocate {	2698	sub size_allocate {
2634	my ($self, $w, $h, $changed) = @_;	2699	my ($self, $w, $h) = @_;
2635		2700
2636	return unless $changed;
2637
2638	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2701	$self->SUPER::size_allocate ($w - 4, $h - 4);
2639	}	2702	}
2640		2703
2641	sub visibility_change {	2704	sub visibility_change {
2642	my ($self, $visible) = @_;	2705	my ($self, $visible) = @_;
2643		2706
…		…
2650	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2713	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2651		2714
2652	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2715	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2653	if $x + $self->{w} > $::WIDTH;	2716	if $x + $self->{w} > $::WIDTH;
2654		2717
2655	$self->move ($x, $y);	2718	$self->move_abs ($x, $y);
2656	});	2719	});
2657	}	2720	}
2658		2721
2659	sub _draw {	2722	sub _draw {
2660	my ($self) = @_;	2723	my ($self) = @_;
…		…
2764	$self->SUPER::DESTROY;	2827	$self->SUPER::DESTROY;
2765	}	2828	}
2766		2829
2767	#############################################################################	2830	#############################################################################
2768		2831
2769	package CFClient::UI::Inventory;
2770
2771	our @ISA = CFClient::UI::ScrolledWindow::;
2772
2773	sub new {
2774	my $class = shift;
2775
2776	my $self = $class->SUPER::new (
2777	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2778	@_,
2779	);
2780
2781	$self
2782	}
2783
2784	sub set_items {
2785	my ($self, $items) = @_;
2786
2787	$self->{scrolled}->clear;
2788	return unless $items;
2789
2790	my @items = sort {
2791	($a->{type} <=> $b->{type})
2792	or ($a->{name} cmp $b->{name})
2793	} @$items;
2794
2795	$self->{real_items} = \@items;
2796
2797	my $row = 0;
2798	for my $item (@items) {
2799	CFClient::Item::update_widgets $item;
2800
2801	$self->{scrolled}->add (0, $row, $item->{face_widget});
2802	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2803	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2804
2805	$row++;
2806	}
2807	}
2808
2809	#############################################################################
2810
2811	package CFClient::UI::Menu;	2832	package CFClient::UI::Menu;
2812		2833
2813	our @ISA = CFClient::UI::FancyFrame::;	2834	our @ISA = CFClient::UI::FancyFrame::;
2814		2835
2815	use CFClient::OpenGL;	2836	use CFClient::OpenGL;
…		…
2853	# maybe save $GRAB? must be careful about events...	2874	# maybe save $GRAB? must be careful about events...
2854	$GRAB = $self;	2875	$GRAB = $self;
2855	$self->{button} = $ev->{button};	2876	$self->{button} = $ev->{button};
2856		2877
2857	$self->show;	2878	$self->show;
2858	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2879	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2859	}	2880	}
2860		2881
2861	sub mouse_motion {	2882	sub mouse_motion {
2862	my ($self, $ev, $x, $y) = @_;	2883	my ($self, $ev, $x, $y) = @_;
2863		2884
…		…
2988	$self->SUPER::reconfigure;	3009	$self->SUPER::reconfigure;
2989	}	3010	}
2990		3011
2991	#############################################################################	3012	#############################################################################
2992		3013
		3014	package CFClient::UI::Inventory;
		3015
		3016	our @ISA = CFClient::UI::ScrolledWindow::;
		3017
		3018	sub new {
		3019	my $class = shift;
		3020
		3021	my $self = $class->SUPER::new (
		3022	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3023	@_,
		3024	);
		3025
		3026	$self
		3027	}
		3028
		3029	sub set_items {
		3030	my ($self, $items) = @_;
		3031
		3032	$self->{scrolled}->clear;
		3033	return unless $items;
		3034
		3035	my @items = sort {
		3036	($a->{type} <=> $b->{type})
		3037	or ($a->{name} cmp $b->{name})
		3038	} @$items;
		3039
		3040	$self->{real_items} = \@items;
		3041
		3042	my $row = 0;
		3043	for my $item (@items) {
		3044	CFClient::Item::update_widgets $item;
		3045
		3046	$self->{scrolled}->add (0, $row, $item->{face_widget});
		3047	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		3048	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		3049
		3050	$row++;
		3051	}
		3052	}
		3053
		3054	#############################################################################
		3055
		3056	package CFClient::UI::BindEditor;
		3057
		3058	our @ISA = CFClient::UI::FancyFrame::;
		3059
		3060	sub new {
		3061	my $class = shift;
		3062
		3063	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3064
		3065	$self->add (my $vb = new CFClient::UI::VBox);
		3066
		3067
		3068	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3069	text => "start recording",
		3070	tooltip => "Start/Stops recording of actions."
		3071	."All subsequent actions after the recording started will be captured."
		3072	."The actions are displayed after the record was stopped."
		3073	."To bind the action you have to click on the 'Bind' button",
		3074	on_activate => sub {
		3075	unless ($self->{recording}) {
		3076	$self->start;
		3077	} else {
		3078	$self->stop;
		3079	}
		3080	});
		3081
		3082	$vb->add (new CFClient::UI::Label text => "Actions:");
		3083	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3084
		3085	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3086	$vb->add (my $hb = new CFClient::UI::HBox);
		3087	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3088	$hb->add (new CFClient::UI::Button
		3089	text => "bind",
		3090	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3091	on_activate => sub {
		3092	$self->ask_for_bind;
		3093	});
		3094
		3095	$vb->add (my $hb = new CFClient::UI::HBox);
		3096	$hb->add (new CFClient::UI::Button
		3097	text => "ok",
		3098	expand => 1,
		3099	tooltip => "This closes the binding editor and saves the binding",
		3100	on_activate => sub {
		3101	$self->hide;
		3102	$self->commit;
		3103	});
		3104
		3105	$hb->add (new CFClient::UI::Button
		3106	text => "cancel",
		3107	expand => 1,
		3108	tooltip => "This closes the binding editor without saving",
		3109	on_activate => sub {
		3110	$self->hide;
		3111	$self->{binding_cancel}->()
		3112	if $self->{binding_cancel};
		3113	});
		3114
		3115	$self->update_binding_widgets;
		3116
		3117	$self
		3118	}
		3119
		3120	sub commit {
		3121	my ($self) = @_;
		3122	my ($mod, $sym, $cmds) = $self->get_binding;
		3123	if ($sym != 0 && @$cmds > 0) {
		3124	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3125	."'. Don't forget 'Save Config'!");
		3126	$self->{binding_change}->($mod, $sym, $cmds)
		3127	if $self->{binding_change};
		3128	} else {
		3129	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3130	$self->{binding_cancel}->()
		3131	if $self->{binding_cancel};
		3132	}
		3133	}
		3134
		3135	sub start {
		3136	my ($self) = @_;
		3137
		3138	$self->{rec_btn}->set_text ("stop recording");
		3139	$self->{recording} = 1;
		3140	$self->clear_command_list;
		3141	$::CONN->start_record if $::CONN;
		3142	}
		3143
		3144	sub stop {
		3145	my ($self) = @_;
		3146
		3147	$self->{rec_btn}->set_text ("start recording");
		3148	$self->{recording} = 0;
		3149
		3150	my $rec;
		3151	$rec = $::CONN->stop_record if $::CONN;
		3152	return unless ref $rec eq 'ARRAY';
		3153	$self->set_command_list ($rec);
		3154	}
		3155
		3156
		3157	sub ask_for_bind_and_commit {
		3158	my ($self) = @_;
		3159	$self->ask_for_bind (1);
		3160	}
		3161
		3162	sub ask_for_bind {
		3163	my ($self, $commit) = @_;
		3164
		3165	CFClient::Binder::open_binding_dialog (sub {
		3166	my ($mod, $sym) = @_;
		3167	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3168	$self->update_binding_widgets;
		3169	$self->commit if $commit;
		3170	});
		3171	}
		3172
		3173	# $mod and $sym are the modifiers and key symbol
		3174	# $cmds is a array ref of strings (the commands)
		3175	# $cb is the callback that is executed on OK
		3176	# $ccb is the callback that is executed on CANCEL and
		3177	# when the binding was unsuccessful on OK
		3178	sub set_binding {
		3179	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3180
		3181	$self->clear_command_list;
		3182	$self->{recording} = 0;
		3183	$self->{rec_btn}->set_text ("start recording");
		3184
		3185	$self->{binding} = [$mod, $sym];
		3186	$self->{commands} = $cmds;
		3187
		3188	$self->{binding_change} = $cb;
		3189	$self->{binding_cancel} = $ccb;
		3190
		3191	$self->update_binding_widgets;
		3192	}
		3193
		3194	# this is a shortcut method that asks for a binding
		3195	# and then just binds it.
		3196	sub do_quick_binding {
		3197	my ($self, $cmds) = @_;
		3198	$self->set_binding (undef, undef, $cmds, sub {
		3199	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3200	});
		3201	$self->ask_for_bind (1);
		3202	}
		3203
		3204	sub update_binding_widgets {
		3205	my ($self) = @_;
		3206	my ($mod, $sym, $cmds) = $self->get_binding;
		3207	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3208	$self->set_command_list ($cmds);
		3209	}
		3210
		3211	sub get_binding {
		3212	my ($self) = @_;
		3213	return (
		3214	$self->{binding}->[0],
		3215	$self->{binding}->[1],
		3216	[ grep { defined $_ } @{$self->{commands}} ]
		3217	);
		3218	}
		3219
		3220	sub clear_command_list {
		3221	my ($self) = @_;
		3222	$self->{cmdbox}->clear ();
		3223	}
		3224
		3225	sub set_command_list {
		3226	my ($self, $cmds) = @_;
		3227
		3228	$self->{cmdbox}->clear ();
		3229	$self->{commands} = $cmds;
		3230
		3231	my $idx = 0;
		3232
		3233	for (@$cmds) {
		3234	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3235
		3236	my $i = $idx;
		3237	$hb->add (new CFClient::UI::Label text => $_);
		3238	$hb->add (new CFClient::UI::Button
		3239	text => "delete",
		3240	tooltip => "Deletes the action from the record",
		3241	on_activate => sub {
		3242	$self->{cmdbox}->remove ($hb);
		3243	$cmds->[$i] = undef;
		3244	});
		3245
		3246
		3247	$idx++
		3248	}
		3249	}
		3250
		3251	#############################################################################
		3252
		3253	package CFClient::UI::SpellList;
		3254
		3255	our @ISA = CFClient::UI::FancyFrame::;
		3256
		3257	sub new {
		3258	my $class = shift;
		3259
		3260	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3261
		3262	$self->add (new CFClient::UI::ScrolledWindow
		3263	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3264
		3265	$self;
		3266	}
		3267
		3268	# XXX: Do sorting? Argl...
		3269	sub add_spell {
		3270	my ($self, $spell) = @_;
		3271	$self->{spells}->{$spell->{name}} = $spell;
		3272
		3273	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3274	face => $spell->{face},
		3275	can_hover => 1,
		3276	can_events => 1,
		3277	tooltip => $spell->{message});
		3278
		3279	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3280	text => $spell->{name},
		3281	can_hover => 1,
		3282	can_events => 1,
		3283	tooltip => $spell->{message},
		3284	expand => 1);
		3285
		3286	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3287	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3288	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3289	expand => 1);
		3290
		3291	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3292	text => "bind to key",
		3293	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3294	}
		3295
		3296	sub rebuild_spell_list {
		3297	my ($self) = @_;
		3298	$self->{tbl_idx} = 0;
		3299	$self->add_spell ($_) for values %{$self->{spells}};
		3300	}
		3301
		3302	sub remove_spell {
		3303	my ($self, $spell) = @_;
		3304	delete $self->{spells}->{$spell->{name}};
		3305	$self->rebuild_spell_list;
		3306	}
		3307
		3308	#############################################################################
		3309
2993	package CFClient::UI::Root;	3310	package CFClient::UI::Root;
2994		3311
2995	our @ISA = CFClient::UI::Container::;	3312	our @ISA = CFClient::UI::Container::;
2996		3313
2997	use CFClient::OpenGL;	3314	use CFClient::OpenGL;
…		…
3007	Scalar::Util::weaken ($self->{root} = $self);	3324	Scalar::Util::weaken ($self->{root} = $self);
3008		3325
3009	$self	3326	$self
3010	}	3327	}
3011		3328
3012	sub configure {
3013	my ($self, $x, $y, $w, $h) = @_;
3014
3015	$self->{w} = $w;
3016	$self->{h} = $h;
3017	}
3018
3019	sub reconfigure {
3020	my ($self) = @_;
3021
3022	$self->SUPER::reconfigure;
3023
3024	$self->size_allocate ($self->{w}, $self->{h}, 1)
3025	if $self->{w};
3026	}
3027
3028	sub size_request {	3329	sub size_request {
3029	my ($self) = @_;	3330	my ($self) = @_;
3030		3331
3031	($self->{w}, $self->{h})	3332	($self->{w}, $self->{h})
3032	}	3333	}
3033		3334
		3335	sub _to_pixel {
		3336	my ($coord, $size, $max) = @_;
		3337
		3338	$coord =
		3339	$coord eq "center" ? ($max - $size) * 0.5
		3340	: $coord eq "max" ? $max
		3341	: $coord;
		3342
		3343	$coord = 0 if $coord < 0;
		3344	$coord = $max - $size if $coord > $max - $size;
		3345
		3346	int $coord + 0.5
		3347	}
		3348
3034	sub size_allocate {	3349	sub size_allocate {
3035	my ($self, $w, $h, $changed) = @_;	3350	my ($self, $w, $h) = @_;
3036		3351
3037	for my $child ($self->children) {	3352	for my $child ($self->children) {
3038	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3353	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3039		3354
3040	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3355	$X = $child->{force_x} if exists $child->{force_x};
3041	if exists $child->{req_x};	3356	$Y = $child->{force_y} if exists $child->{force_y};
3042		3357
3043	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3358	$X = _to_pixel $X, $W, $self->{w};
3044	if exists $child->{req_y};	3359	$Y = _to_pixel $Y, $H, $self->{h};
3045
3046	#delete @$child{qw(req_x req_y)};#d# def_x, def_y
3047
3048	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3049	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3050		3360
3051	$child->configure ($X, $Y, $W, $H);	3361	$child->configure ($X, $Y, $W, $H);
3052	}	3362	}
3053	}	3363	}
3054		3364
…		…
3071	}	3381	}
3072		3382
3073	sub add {	3383	sub add {
3074	my ($self, @children) = @_;	3384	my ($self, @children) = @_;
3075		3385
3076	for my $child (@children) {
3077	$child->{is_toplevel} = 1;	3386	$_->{is_toplevel} = 1
3078		3387	for @children;
3079	# integerise window positions
3080	$child->{x} = int $child->{x};
3081	$child->{y} = int $child->{y};
3082	}
3083		3388
3084	$self->SUPER::add (@children);	3389	$self->SUPER::add (@children);
3085	}	3390	}
3086		3391
3087	sub remove {	3392	sub remove {
3088	my ($self, @children) = @_;	3393	my ($self, @children) = @_;
3089		3394
3090	$self->SUPER::remove (@children);	3395	$self->SUPER::remove (@children);
		3396
		3397	delete $self->{is_toplevel}
		3398	for @children;
3091		3399
3092	while (@children) {	3400	while (@children) {
3093	my $w = pop @children;	3401	my $w = pop @children;
3094	push @children, $w->children;	3402	push @children, $w->children;
3095	$w->set_invisible;	3403	$w->set_invisible;
…		…
3115	$_->()	3423	$_->()
3116	for values %{delete $self->{refresh_hook}};	3424	for values %{delete $self->{refresh_hook}};
3117	}	3425	}
3118		3426
3119	if ($self->{realloc}) {	3427	if ($self->{realloc}) {
		3428	my %queue;
3120	my @queue;	3429	my @queue;
		3430	my $widget;
3121		3431
		3432	outer:
3122	while () {	3433	while () {
3123	if ($self->{realloc}) {	3434	if (my $realloc = delete $self->{realloc}) {
3124	#TODO use array-of-depth approach	3435	for $widget (values %$realloc) {
		3436	$widget->{visible} or next; # do not resize invisible widgets
3125		3437
3126	@queue = sort { $a->{visible} <=> $b->{visible} }	3438	$queue{$widget+0}++ and next; # duplicates are common
3127	@queue, values %{delete $self->{realloc}};	3439
		3440	push @{ $queue[$widget->{visible}] }, $widget;
		3441	}
3128	}	3442	}
3129		3443
		3444	while () {
		3445	@queue or last outer;
		3446
		3447	$widget = pop @{ $queue[-1] || [] }
		3448	and last;
		3449
		3450	pop @queue;
		3451	}
		3452
		3453	delete $queue{$widget+0};
		3454
		3455	my ($w, $h) = $widget->size_request;
		3456
		3457	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3458	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3459
		3460	$w = $widget->{force_w} if exists $widget->{force_w};
		3461	$h = $widget->{force_h} if exists $widget->{force_h};
		3462
		3463	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3464	|| delete $widget->{force_realloc}) {
		3465	$widget->{req_w} = $w;
		3466	$widget->{req_h} = $h;
		3467
		3468	$self->{size_alloc}{$widget+0} = $widget;
		3469
		3470	if (my $parent = $widget->{parent}) {
		3471	$self->{realloc}{$parent+0} = $parent
		3472	unless $queue{$parent+0};
		3473
		3474	$parent->{force_size_alloc} = 1;
		3475	$self->{size_alloc}{$parent+0} = $parent;
		3476	}
		3477	}
		3478
		3479	delete $self->{realloc}{$widget+0};
		3480	}
		3481	}
		3482
		3483	while (my $size_alloc = delete $self->{size_alloc}) {
		3484	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3485	values %$size_alloc;
		3486
		3487	while () {
3130	my $widget = pop @queue || last;	3488	my $widget = pop @queue || last;
3131		3489
3132	$widget->{visible} or last; # do not resize invisible widgets	3490	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3133
3134	my ($w, $h) = $widget->{def_w} && $widget->{def_h}
3135	? @$widget{qw(def_w def_h)}
3136	: $widget->size_request;
3137
3138	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3139
3140	$widget->{req_w} = $w;
3141	$widget->{req_h} = $h;
3142
3143	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];
3144
3145	push @queue, $widget->{parent}
3146	if $widget->{parent};
3147	}
3148	}
3149
3150	while (my $size_alloc = delete $self->{size_alloc}) {
3151	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},
3152	values %$size_alloc;
3153
3154	while () {
3155	my ($widget, $w, $h) = @{ pop @queue or last };
3156		3491
3157	$w = 0 if $w < 0;	3492	$w = 0 if $w < 0;
3158	$h = 0 if $h < 0;	3493	$h = 0 if $h < 0;
3159		3494
3160	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3495	$w = int $w + 0.5;
		3496	$h = int $h + 0.5;
3161		3497
		3498	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3499	$widget->{old_w} = $widget->{w};
		3500	$widget->{old_h} = $widget->{h};
		3501
3162	$widget->{w} = $w;	3502	$widget->{w} = $w;
3163	$widget->{h} = $h;	3503	$widget->{h} = $h;
3164		3504
3165	$widget->emit (size_allocate => $w, $h, $changed);	3505	$widget->emit (size_allocate => $w, $h);
		3506	}
3166	}	3507	}
3167	}	3508	}
3168		3509
3169	while ($self->{post_alloc_hook}) {	3510	while ($self->{post_alloc_hook}) {
3170	$_->()	3511	$_->()
3171	for values %{delete $self->{post_alloc_hook}};	3512	for values %{delete $self->{post_alloc_hook}};
3172	}	3513	}
		3514
3173		3515
3174	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3516	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3175	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3517	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3176	glClear GL_COLOR_BUFFER_BIT;	3518	glClear GL_COLOR_BUFFER_BIT;
3177		3519
…		…
3179	glLoadIdentity;	3521	glLoadIdentity;
3180	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3522	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3181	glMatrixMode GL_MODELVIEW;	3523	glMatrixMode GL_MODELVIEW;
3182	glLoadIdentity;	3524	glLoadIdentity;
3183		3525
		3526	{
		3527	package CFClient::UI::Base;
		3528
		3529	($draw_x, $draw_y, $draw_w, $draw_h) =
		3530	(0, 0, $self->{w}, $self->{h});
		3531	}
		3532
3184	$self->_draw;	3533	$self->_draw;
3185	}	3534	}
3186		3535
3187	#############################################################################	3536	#############################################################################
3188		3537

Diff Legend

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