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.255 by root, Mon May 29 02:01:56 2006 UTC vs.
Revision 1.271 by root, Fri Jun 2 22:13:47 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
…		…
428		439
429	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	440	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
430	unless $FOCUS;	441	unless $FOCUS;
431	}	442	}
432		443
433	sub mouse_motion { }	444	sub mouse_motion { 0 }
434	sub button_up { }	445	sub button_up { 0 }
435	sub key_down { }	446	sub key_down { 0 }
436	sub key_up { }	447	sub key_up { 0 }
437		448
438	sub button_down {	449	sub button_down {
439	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
440		451
441	$self->focus_in;	452	$self->focus_in;
442	}
443		453
444	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	454	0
445	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	455	}
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		456
450	sub find_widget {	457	sub find_widget {
451	my ($self, $x, $y) = @_;	458	my ($self, $x, $y) = @_;
452		459
453	return () unless $self->{can_events};	460	return () unless $self->{can_events};
…		…
461		468
462	sub set_parent {	469	sub set_parent {
463	my ($self, $parent) = @_;	470	my ($self, $parent) = @_;
464		471
465	Scalar::Util::weaken ($self->{parent} = $parent);	472	Scalar::Util::weaken ($self->{parent} = $parent);
466
467	$self->set_visible if $parent->{visible};	473	$self->set_visible if $parent->{visible};
468	}	474	}
469		475
470	sub connect {	476	sub connect {
471	my ($self, $signal, $cb) = @_;	477	my ($self, $signal, $cb) = @_;
…		…
492		498
493	sub realloc {	499	sub realloc {
494	my ($self) = @_;	500	my ($self) = @_;
495		501
496	if ($self->{visible}) {	502	if ($self->{visible}) {
497	return if $self->{root}{realloc}{$self};	503	return if $self->{root}{realloc}{$self+0};
498		504
499	$self->{root}{realloc}{$self} = $self;	505	$self->{root}{realloc}{$self+0} = $self;
500	$self->{root}->update;	506	$self->{root}->update;
501	} else {	507	} else {
502	delete $self->{req_w};	508	delete $self->{req_w};
		509	delete $self->{req_h};
503	}	510	}
504	}	511	}
505		512
506	sub update {	513	sub update {
507	my ($self) = @_;	514	my ($self) = @_;
508		515
509	$self->{parent}->update	516	$self->{parent}->update
510	if $self->{parent};	517	if $self->{parent};
511	}	518	}
512		519
		520	sub reconfigure {
		521	my ($self) = @_;
		522
		523	$self->realloc;
		524	$self->update;
		525	}
		526
		527	# using global variables seems a bit hacky, but passing through all drawing
		528	# functions seems pointless.
		529	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
		530
513	sub draw {	531	sub draw {
514	my ($self) = @_;	532	my ($self) = @_;
515		533
516	return unless $self->{h} && $self->{w};	534	return unless $self->{h} && $self->{w};
		535
		536	# update screen rectangle
		537	local $draw_x = $draw_x + $self->{x};
		538	local $draw_y = $draw_y + $self->{y};
		539	local $draw_w = $draw_x + $self->{w};
		540	local $draw_h = $draw_y + $self->{h};
		541
		542	# skip widgets that are entirely outside the drawing area
		543	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		544	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
517		545
518	glPushMatrix;	546	glPushMatrix;
519	glTranslate $self->{x}, $self->{y}, 0;	547	glTranslate $self->{x}, $self->{y}, 0;
520	$self->_draw;	548	$self->_draw;
521	glPopMatrix;	549	glPopMatrix;
…		…
533	glVertex $x , $y + $self->{h};	561	glVertex $x , $y + $self->{h};
534	glEnd;	562	glEnd;
535	glDisable GL_BLEND;	563	glDisable GL_BLEND;
536	}	564	}
537		565
538	if ($ENV{PCLIENT_DEBUG}) {	566	if ($ENV{CFPLUS_DEBUG} & 1) {
539	glPushMatrix;	567	glPushMatrix;
540	glColor 1, 1, 0, 1;	568	glColor 1, 1, 0, 1;
541	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	569	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
542	glBegin GL_LINE_LOOP;	570	glBegin GL_LINE_LOOP;
543	glVertex 0 , 0;	571	glVertex 0 , 0;
…		…
619	my ($class, %arg) = @_;	647	my ($class, %arg) = @_;
620	$class->SUPER::new (can_events => 0, %arg);	648	$class->SUPER::new (can_events => 0, %arg);
621	}	649	}
622		650
623	sub size_request {	651	sub size_request {
624	(0, 0)	652	my ($self) = @_;
		653
		654	($self->{w} + 0, $self->{h} + 0)
625	}	655	}
626		656
627	sub draw { }	657	sub draw { }
628		658
629	#############################################################################	659	#############################################################################
…		…
750	sub size_request {	780	sub size_request {
751	$_[0]{children}[0]->size_request	781	$_[0]{children}[0]->size_request
752	}	782	}
753		783
754	sub size_allocate {	784	sub size_allocate {
755	my ($self, $w, $h, $changed) = @_;	785	my ($self, $w, $h) = @_;
756		786
757	$self->{children}[0]->configure (0, 0, $w, $h);	787	$self->{children}[0]->configure (0, 0, $w, $h);
758	}	788	}
759		789
760	#############################################################################	790	#############################################################################
…		…
777	$ROOT->on_post_alloc ($self => sub { $self->render_child });	807	$ROOT->on_post_alloc ($self => sub { $self->render_child });
778	$self->SUPER::update;	808	$self->SUPER::update;
779	}	809	}
780		810
781	sub size_allocate {	811	sub size_allocate {
782	my ($self, $w, $h, $changed) = @_;	812	my ($self, $w, $h) = @_;
783		813
784	$self->SUPER::size_allocate ($w, $h, $changed);	814	$self->SUPER::size_allocate ($w, $h);
785	$self->update	815	$self->update;
786	if $changed;
787	}	816	}
788		817
789	sub _render {	818	sub _render {
		819	my ($self) = @_;
		820
790	$_[0]{children}[0]->draw;	821	$self->{children}[0]->draw;
791	}	822	}
792		823
793	sub render_child {	824	sub render_child {
794	my ($self) = @_;	825	my ($self) = @_;
795		826
796	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	827	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
797	glClearColor 0, 0, 0, 0;	828	glClearColor 0, 0, 0, 0;
798	glClear GL_COLOR_BUFFER_BIT;	829	glClear GL_COLOR_BUFFER_BIT;
799		830
		831	{
		832	package CFClient::UI::Base;
		833
		834	($draw_x, $draw_y, $draw_w, $draw_h) =
		835	(0, 0, $self->{w}, $self->{h});
		836	}
		837
800	$self->_render;	838	$self->_render;
801	};	839	};
802	}	840	}
803		841
804	sub _draw {	842	sub _draw {
805	my ($self) = @_;	843	my ($self) = @_;
806		844
807	my ($w, $h) = ($self->w, $self->h);	845	my ($w, $h) = @$self{qw(w h)};
808		846
809	my $tex = $self->{texture}	847	my $tex = $self->{texture}
810	or return;	848	or return;
811		849
812	glEnable GL_TEXTURE_2D;	850	glEnable GL_TEXTURE_2D;
…		…
835	}	873	}
836		874
837	sub size_request {	875	sub size_request {
838	my ($self) = @_;	876	my ($self) = @_;
839		877
840	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	878	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
841		879
842	$w = 10 if $self->{scroll_x};	880	$w = 10 if $self->{scroll_x};
843	$h = 10 if $self->{scroll_y};	881	$h = 10 if $self->{scroll_y};
844		882
845	($w, $h)	883	($w, $h)
846	}	884	}
847		885
848	sub size_allocate {	886	sub size_allocate {
849	my ($self, $w, $h, $changed) = @_;	887	my ($self, $w, $h) = @_;
850		888
		889	my $child = $self->child;
		890
851	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	891	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
852	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	892	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
853		893
854	$self->child->configure (0, 0, $w, $h);	894	$self->child->configure (0, 0, $w, $h);
855	$self->update;	895	$self->update;
856	}	896	}
857		897
…		…
892	}	932	}
893	}	933	}
894		934
895	sub _render {	935	sub _render {
896	my ($self) = @_;	936	my ($self) = @_;
		937
		938	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		939	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
897		940
898	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	941	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
899		942
900	$self->SUPER::_render;	943	$self->SUPER::_render;
901	}	944	}
…		…
941	my $child = $self->{vp}->child;	984	my $child = $self->{vp}->child;
942	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	985	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
943	}	986	}
944		987
945	sub size_allocate {	988	sub size_allocate {
946	my ($self, $w, $h, $changed) = @_;	989	my ($self, $w, $h) = @_;
947		990
948	$self->SUPER::size_allocate ($w, $h, $changed);	991	$self->SUPER::size_allocate ($w, $h);
949		992
950	my $child = $self->{vp}->child;	993	my $child = $self->{vp}->child;
951	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	994	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
952	}	995	}
953		996
…		…
1009	my @border =	1052	my @border =
1010	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1053	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1011	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1054	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1012		1055
1013	sub new {	1056	sub new {
1014	my $class = shift;	1057	my ($class, %arg) = @_;
		1058
		1059	my $title = delete $arg{title};
1015		1060
1016	my $self = $class->SUPER::new (	1061	my $self = $class->SUPER::new (
1017	bg => [1, 1, 1, 1],	1062	bg => [1, 1, 1, 1],
1018	border_bg => [1, 1, 1, 1],	1063	border_bg => [1, 1, 1, 1],
1019	border => 0.6,	1064	border => 0.6,
1020	is_toplevel => 1,
1021	can_events => 1,	1065	can_events => 1,
1022	@_	1066	min_w => 16,
		1067	min_h => 16,
		1068	%arg,
1023	);	1069	);
1024		1070
1025	$self->{title} &&= new CFClient::UI::Label	1071	$self->{title} = new CFClient::UI::Label
1026	align => 0,	1072	align => 0,
1027	valign => 1,	1073	valign => 1,
1028	text => $self->{title},	1074	text => $title,
1029	fontsize => $self->{border};	1075	fontsize => $self->{border}
		1076	if defined $title;
1030		1077
1031	$self	1078	$self
		1079	}
		1080
		1081	sub add {
		1082	my ($self, @widgets) = @_;
		1083
		1084	$self->SUPER::add (@widgets);
		1085	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
1032	}	1086	}
1033		1087
1034	sub border {	1088	sub border {
1035	int $_[0]{border} * $::FONTSIZE	1089	int $_[0]{border} * $::FONTSIZE
1036	}	1090	}
1037		1091
1038	sub size_request {	1092	sub size_request {
1039	my ($self) = @_;	1093	my ($self) = @_;
		1094
		1095	$self->{title}->size_request
		1096	if $self->{title};
1040		1097
1041	my ($w, $h) = $self->SUPER::size_request;	1098	my ($w, $h) = $self->SUPER::size_request;
1042		1099
1043	(	1100	(
1044	$w + $self->border * 2,	1101	$w + $self->border * 2,
1045	$h + $self->border * 2,	1102	$h + $self->border * 2,
1046	)	1103	)
1047	}	1104	}
1048		1105
1049	sub size_allocate {	1106	sub size_allocate {
1050	my ($self, $w, $h, $changed) = @_;	1107	my ($self, $w, $h) = @_;
1051		1108
1052	return unless $changed;	1109	if ($self->{title}) {
		1110	$self->{title}{w} = $w;
		1111	$self->{title}{h} = $h;
		1112	$self->{title}->size_allocate ($w, $h);
		1113	}
1053		1114
		1115	my $border = $self->border;
		1116
1054	$h -= List::Util::max 0, $self->border * 2;	1117	$h -= List::Util::max 0, $border * 2;
1055	$w -= List::Util::max 0, $self->border * 2;	1118	$w -= List::Util::max 0, $border * 2;
1056		1119
1057	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1058	if $self->{title};
1059
1060	$self->child->configure ($self->border, $self->border, $w, $h);	1120	$self->child->configure ($border, $border, $w, $h);
1061	}	1121	}
1062		1122
1063	sub button_down {	1123	sub button_down {
1064	my ($self, $ev, $x, $y) = @_;	1124	my ($self, $ev, $x, $y) = @_;
1065		1125
…		…
1081	my ($ev, $x, $y) = @_;	1141	my ($ev, $x, $y) = @_;
1082		1142
1083	my $dx = $ev->{x} - $ox;	1143	my $dx = $ev->{x} - $ox;
1084	my $dy = $ev->{y} - $oy;	1144	my $dy = $ev->{y} - $oy;
1085		1145
1086	$self->{user_x} = $wx + $dx * $mx;
1087	$self->{user_y} = $wy + $dy * $my;
1088	$self->{def_w} = $bw + $dx * ($mx ? -1 : 1);	1146	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1089	$self->{def_h} = $bh + $dy * ($my ? -1 : 1);	1147	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1090	$self->move ($self->{user_x}, $self->{user_y});	1148
1091	$self->realloc;	1149	$self->realloc;
		1150	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1092	};	1151	};
1093		1152
1094	} elsif ($lr ^ $td) {	1153	} elsif ($lr ^ $td) {
1095	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1154	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1096	my ($bx, $by) = ($self->{x}, $self->{y});	1155	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1098	$self->{motion} = sub {	1157	$self->{motion} = sub {
1099	my ($ev, $x, $y) = @_;	1158	my ($ev, $x, $y) = @_;
1100		1159
1101	($x, $y) = ($ev->{x}, $ev->{y});	1160	($x, $y) = ($ev->{x}, $ev->{y});
1102		1161
1103	$self->{user_x} = $bx + $x - $ox;	1162	$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->realloc;
1108	};	1163	};
		1164	} else {
		1165	return 0;
		1166	}
		1167
1109	}	1168	1
1110	}	1169	}
1111		1170
1112	sub button_up {	1171	sub button_up {
1113	my ($self, $ev, $x, $y) = @_;	1172	my ($self, $ev, $x, $y) = @_;
1114		1173
1115	delete $self->{motion};	1174	!!delete $self->{motion}
1116	}	1175	}
1117		1176
1118	sub mouse_motion {	1177	sub mouse_motion {
1119	my ($self, $ev, $x, $y) = @_;	1178	my ($self, $ev, $x, $y) = @_;
1120		1179
1121	$self->{motion}->($ev, $x, $y) if $self->{motion};	1180	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1181
		1182	!!$self->{motion}
1122	}	1183	}
1123		1184
1124	sub _draw {	1185	sub _draw {
1125	my ($self) = @_;	1186	my ($self) = @_;
1126		1187
		1188	my $child = $self->{children}[0];
		1189
1127	my ($w, $h ) = ($self->{w}, $self->{h});	1190	my ($w, $h ) = ($self->{w}, $self->{h});
1128	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1191	my ($cw, $ch) = ($child->{w}, $child->{h});
1129		1192
1130	glEnable GL_TEXTURE_2D;	1193	glEnable GL_TEXTURE_2D;
1131	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1194	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1132		1195
1133	my $border = $self->border;	1196	my $border = $self->border;
…		…
1148	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1211	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1149	}	1212	}
1150		1213
1151	glDisable GL_TEXTURE_2D;	1214	glDisable GL_TEXTURE_2D;
1152		1215
1153	$self->{title}->draw if $self->{title};
1154
1155	$self->child->draw;	1216	$child->draw;
		1217
		1218	if ($self->{title}) {
		1219	glTranslate 0, $border - $self->{h};
		1220	$self->{title}->_draw;
		1221	}
1156	}	1222	}
1157		1223
1158	#############################################################################	1224	#############################################################################
1159		1225
1160	package CFClient::UI::Table;	1226	package CFClient::UI::Table;
…		…
1234	(sum @$hs),	1300	(sum @$hs),
1235	)	1301	)
1236	}	1302	}
1237		1303
1238	sub size_allocate {	1304	sub size_allocate {
1239	my ($self, $w, $h, $changed) = @_;	1305	my ($self, $w, $h) = @_;
1240		1306
1241	my ($ws, $hs) = $self->get_wh;	1307	my ($ws, $hs) = $self->get_wh;
1242		1308
1243	my $req_w = (sum @$ws) || 1;	1309	my $req_w = (sum @$ws) || 1;
1244	my $req_h = (sum @$hs) || 1;	1310	my $req_h = (sum @$hs) || 1;
…		…
1322	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1388	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1323	)	1389	)
1324	}	1390	}
1325		1391
1326	sub size_allocate {	1392	sub size_allocate {
1327	my ($self, $w, $h, $changed) = @_;	1393	my ($self, $w, $h) = @_;
1328		1394
1329	my $space = $self->{vertical} ? $h : $w;	1395	my $space = $self->{vertical} ? $h : $w;
1330	my $children = $self->{children};	1396	my $children = $self->{children};
1331		1397
1332	my @req;	1398	my @req;
…		…
1415	ellipsise => 3, # end	1481	ellipsise => 3, # end
1416	layout => (new CFClient::Layout),	1482	layout => (new CFClient::Layout),
1417	fontsize => 1,	1483	fontsize => 1,
1418	align => -1,	1484	align => -1,
1419	valign => -1,	1485	valign => -1,
1420	padding => 2,	1486	padding_x => 2,
		1487	padding_y => 2,
1421	can_events => 0,	1488	can_events => 0,
1422	%arg	1489	%arg
1423	);	1490	);
1424		1491
1425	if (exists $self->{template}) {	1492	if (exists $self->{template}) {
…		…
1501		1568
1502	$w = List::Util::max $w, $w2;	1569	$w = List::Util::max $w, $w2;
1503	$h = List::Util::max $h, $h2;	1570	$h = List::Util::max $h, $h2;
1504	}	1571	}
1505		1572
1506	(	1573	($w, $h)
1507	$w + $self->{padding} * 2,
1508	$h + $self->{padding} * 2,
1509	)
1510	}	1574	}
1511		1575
1512	sub size_allocate {	1576	sub size_allocate {
1513	my ($self, $w, $h, $changed) = @_;	1577	my ($self, $w, $h) = @_;
		1578
		1579	delete $self->{ox};
1514		1580
1515	delete $self->{texture}	1581	delete $self->{texture}
1516	if $changed;	1582	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1517	}	1583	}
1518		1584
1519	sub set_fontsize {	1585	sub set_fontsize {
1520	my ($self, $fontsize) = @_;	1586	my ($self, $fontsize) = @_;
1521		1587
…		…
1536	$self->{layout}->set_width ($self->{w});	1602	$self->{layout}->set_width ($self->{w});
1537	$self->{layout}->set_ellipsise ($self->{ellipsise});	1603	$self->{layout}->set_ellipsise ($self->{ellipsise});
1538	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1604	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1539	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1605	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1540		1606
1541	my $tex = new_from_layout CFClient::Texture $self->{layout};	1607	new_from_layout CFClient::Texture $self->{layout}
		1608	};
1542		1609
		1610	unless (exists $self->{ox}) {
1543	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1611	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1544	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1612	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1545	: ($self->{w} - $tex->{w}) * 0.5);	1613	: ($self->{w} - $tex->{w}) * 0.5);
1546		1614
1547	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1615	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1548	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1616	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1549	: ($self->{h} - $tex->{h}) * 0.5);	1617	: ($self->{h} - $tex->{h}) * 0.5);
1550
1551	$tex
1552	};	1618	};
1553		1619
1554	glEnable GL_TEXTURE_2D;	1620	glEnable GL_TEXTURE_2D;
1555	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1621	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1556		1622
…		…
1651	$self->{cursor} = length $text;	1717	$self->{cursor} = length $text;
1652	} elsif ($uni == 27) {	1718	} elsif ($uni == 27) {
1653	$self->_emit ('escape');	1719	$self->_emit ('escape');
1654	} elsif ($uni) {	1720	} elsif ($uni) {
1655	substr $text, $self->{cursor}++, 0, chr $uni;	1721	substr $text, $self->{cursor}++, 0, chr $uni;
		1722	} else {
		1723	return 0;
1656	}	1724	}
1657		1725
1658	$self->_set_text ($text);	1726	$self->_set_text ($text);
1659		1727
1660	$self->realloc;	1728	$self->realloc;
		1729
		1730	1
1661	}	1731	}
1662		1732
1663	sub focus_in {	1733	sub focus_in {
1664	my ($self) = @_;	1734	my ($self) = @_;
1665		1735
…		…
1680	utf8::encode $text;	1750	utf8::encode $text;
1681	$self->{cursor} = length substr $text, 0, $idx;	1751	$self->{cursor} = length substr $text, 0, $idx;
1682		1752
1683	$self->_set_text ($self->{text});	1753	$self->_set_text ($self->{text});
1684	$self->update;	1754	$self->update;
		1755
		1756	1
1685	}	1757	}
1686		1758
1687	sub mouse_motion {	1759	sub mouse_motion {
1688	my ($self, $ev, $x, $y) = @_;	1760	my ($self, $ev, $x, $y) = @_;
1689	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1761	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1762
		1763	0
1690	}	1764	}
1691		1765
1692	sub _draw {	1766	sub _draw {
1693	my ($self) = @_;	1767	my ($self) = @_;
1694		1768
…		…
1771	} else {	1845	} else {
1772	$self->set_text ($self->{history_saveback});	1846	$self->set_text ($self->{history_saveback});
1773	}	1847	}
1774		1848
1775	} else {	1849	} else {
1776	$self->SUPER::key_down ($ev);	1850	return $self->SUPER::key_down ($ev)
		1851	}
		1852
1777	}	1853	1
1778
1779	}	1854	}
1780		1855
1781	#############################################################################	1856	#############################################################################
1782		1857
1783	package CFClient::UI::Button;	1858	package CFClient::UI::Button;
…		…
1792		1867
1793	sub new {	1868	sub new {
1794	my $class = shift;	1869	my $class = shift;
1795		1870
1796	$class->SUPER::new (	1871	$class->SUPER::new (
1797	padding => 4,	1872	padding_x => 4,
		1873	padding_y => 4,
1798	fg => [1, 1, 1],	1874	fg => [1, 1, 1],
1799	active_fg => [0, 0, 1],	1875	active_fg => [0, 0, 1],
1800	can_hover => 1,	1876	can_hover => 1,
1801	align => 0,	1877	align => 0,
1802	valign => 0,	1878	valign => 0,
…		…
1811	my ($self, $ev, $x, $y) = @_;	1887	my ($self, $ev, $x, $y) = @_;
1812		1888
1813	$self->emit ("activate")	1889	$self->emit ("activate")
1814	if $x >= 0 && $x < $self->{w}	1890	if $x >= 0 && $x < $self->{w}
1815	&& $y >= 0 && $y < $self->{h};	1891	&& $y >= 0 && $y < $self->{h};
		1892
		1893	1
1816	}	1894	}
1817		1895
1818	sub _draw {	1896	sub _draw {
1819	my ($self) = @_;	1897	my ($self) = @_;
1820		1898
…		…
1849		1927
1850	sub new {	1928	sub new {
1851	my $class = shift;	1929	my $class = shift;
1852		1930
1853	$class->SUPER::new (	1931	$class->SUPER::new (
1854	padding => 2,	1932	padding_x => 2,
		1933	padding_y => 2,
1855	fg => [1, 1, 1],	1934	fg => [1, 1, 1],
1856	active_fg => [1, 1, 0],	1935	active_fg => [1, 1, 0],
1857	bg => [0, 0, 0, 0.2],	1936	bg => [0, 0, 0, 0.2],
1858	active_bg => [1, 1, 1, 0.5],	1937	active_bg => [1, 1, 1, 0.5],
1859	state => 0,	1938	state => 0,
…		…
1863	}	1942	}
1864		1943
1865	sub size_request {	1944	sub size_request {
1866	my ($self) = @_;	1945	my ($self) = @_;
1867		1946
1868	($self->{padding} * 2 + 6) x 2	1947	(6) x 2
1869	}	1948	}
1870		1949
1871	sub button_down {	1950	sub button_down {
1872	my ($self, $ev, $x, $y) = @_;	1951	my ($self, $ev, $x, $y) = @_;
1873		1952
1874	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1953	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1875	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1954	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1876	$self->{state} = !$self->{state};	1955	$self->{state} = !$self->{state};
1877	$self->_emit (changed => $self->{state});	1956	$self->_emit (changed => $self->{state});
		1957	} else {
		1958	return 0
		1959	}
		1960
1878	}	1961	1
1879	}	1962	}
1880		1963
1881	sub _draw {	1964	sub _draw {
1882	my ($self) = @_;	1965	my ($self) = @_;
1883		1966
1884	$self->SUPER::_draw;	1967	$self->SUPER::_draw;
1885		1968
1886	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1969	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1887		1970
1888	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1971	my ($w, $h) = @$self{qw(w h)};
		1972
		1973	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1889		1974
1890	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1975	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1891		1976
1892	my $tex = $self->{state} ? $tex[1] : $tex[0];	1977	my $tex = $self->{state} ? $tex[1] : $tex[0];
1893		1978
…		…
2158	fg => [1, 1, 1],	2243	fg => [1, 1, 1],
2159	active_fg => [0, 0, 0],	2244	active_fg => [0, 0, 0],
2160	bg => [0, 0, 0, 0.2],	2245	bg => [0, 0, 0, 0.2],
2161	active_bg => [1, 1, 1, 0.5],	2246	active_bg => [1, 1, 1, 0.5],
2162	range => [0, 0, 100, 10, 0],	2247	range => [0, 0, 100, 10, 0],
2163	req_w => $::WIDTH / 80,	2248	min_w => $::WIDTH / 80,
2164	req_h => $::WIDTH / 80,	2249	min_h => $::WIDTH / 80,
2165	vertical => 0,	2250	vertical => 0,
2166	can_hover => 1,	2251	can_hover => 1,
2167	inner_pad => 0.02,	2252	inner_pad => 0.02,
2168	@_	2253	@_
2169	);	2254	);
…		…
2209	}	2294	}
2210		2295
2211	sub size_request {	2296	sub size_request {
2212	my ($self) = @_;	2297	my ($self) = @_;
2213		2298
2214	my $w = $self->{req_w};	2299	($self->{req_w}, $self->{req_h})
2215	my $h = $self->{req_h};
2216
2217	$self->{vertical} ? ($h, $w) : ($w, $h)
2218	}	2300	}
2219		2301
2220	sub button_down {	2302	sub button_down {
2221	my ($self, $ev, $x, $y) = @_;	2303	my ($self, $ev, $x, $y) = @_;
2222		2304
2223	$self->SUPER::button_down ($ev, $x, $y);	2305	$self->SUPER::button_down ($ev, $x, $y);
2224		2306
2225	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2307	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2226		2308
2227	$self->mouse_motion ($ev, $x, $y);	2309	$self->mouse_motion ($ev, $x, $y)
2228	}	2310	}
2229		2311
2230	sub mouse_motion {	2312	sub mouse_motion {
2231	my ($self, $ev, $x, $y) = @_;	2313	my ($self, $ev, $x, $y) = @_;
2232		2314
…		…
2236	my (undef, $lo, $hi, $page) = @{$self->{range}};	2318	my (undef, $lo, $hi, $page) = @{$self->{range}};
2237		2319
2238	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2320	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2239		2321
2240	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2322	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2323	} else {
		2324	return 0;
		2325	}
		2326
2241	}	2327	1
2242	}	2328	}
2243		2329
2244	sub update {	2330	sub update {
2245	my ($self) = @_;	2331	my ($self) = @_;
2246		2332
…		…
2372	$self->{fontsize} = $fontsize;	2458	$self->{fontsize} = $fontsize;
2373	$self->reflow;	2459	$self->reflow;
2374	}	2460	}
2375		2461
2376	sub size_allocate {	2462	sub size_allocate {
2377	my ($self, $w, $h, $changed) = @_;	2463	my ($self, $w, $h) = @_;
2378		2464
2379	$self->SUPER::size_allocate ($w, $h, $changed);	2465	$self->SUPER::size_allocate ($w, $h);
2380
2381	return unless $changed;
2382		2466
2383	$self->{layout}->set_font ($self->{font}) if $self->{font};	2467	$self->{layout}->set_font ($self->{font}) if $self->{font};
2384	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2468	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2385	$self->{layout}->set_width ($self->{children}[0]{w});	2469	$self->{layout}->set_width ($self->{children}[0]{w});
2386		2470
…		…
2609	}	2693	}
2610		2694
2611	sub set_tooltip_from {	2695	sub set_tooltip_from {
2612	my ($self, $widget) = @_;	2696	my ($self, $widget) = @_;
2613		2697
		2698	my $tooltip = $widget->{tooltip};
		2699
		2700	if ($ENV{CFPLUS_DEBUG} & 2) {
		2701	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2702	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2703	. "req $widget->{req_w} $widget->{req_h}\n"
		2704	. "visible $widget->{visible}";
		2705	}
		2706
2614	$self->add (new CFClient::UI::Label	2707	$self->add (new CFClient::UI::Label
2615	markup => $widget->{tooltip},	2708	markup => $tooltip,
2616	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2709	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2617	fontsize => 0.8,	2710	fontsize => 0.8,
2618	fg => [0, 0, 0, 1],	2711	fg => [0, 0, 0, 1],
2619	ellipsise => 0,	2712	ellipsise => 0,
2620	font => ($widget->{tooltip_font} || $::FONT_PROP),	2713	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2628		2721
2629	($w + 4, $h + 4)	2722	($w + 4, $h + 4)
2630	}	2723	}
2631		2724
2632	sub size_allocate {	2725	sub size_allocate {
2633	my ($self, $w, $h, $changed) = @_;	2726	my ($self, $w, $h) = @_;
2634		2727
2635	return unless $changed;
2636
2637	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2728	$self->SUPER::size_allocate ($w - 4, $h - 4);
2638	}	2729	}
2639		2730
2640	sub visibility_change {	2731	sub visibility_change {
2641	my ($self, $visible) = @_;	2732	my ($self, $visible) = @_;
2642		2733
…		…
2649	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2740	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2650		2741
2651	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2742	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2652	if $x + $self->{w} > $::WIDTH;	2743	if $x + $self->{w} > $::WIDTH;
2653		2744
2654	$self->move ($x, $y);	2745	$self->move_abs ($x, $y);
2655	});	2746	});
2656	}	2747	}
2657		2748
2658	sub _draw {	2749	sub _draw {
2659	my ($self) = @_;	2750	my ($self) = @_;
…		…
2763	$self->SUPER::DESTROY;	2854	$self->SUPER::DESTROY;
2764	}	2855	}
2765		2856
2766	#############################################################################	2857	#############################################################################
2767		2858
2768	package CFClient::UI::Inventory;
2769
2770	our @ISA = CFClient::UI::ScrolledWindow::;
2771
2772	sub new {
2773	my $class = shift;
2774
2775	my $self = $class->SUPER::new (
2776	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2777	@_,
2778	);
2779
2780	$self
2781	}
2782
2783	sub set_items {
2784	my ($self, $items) = @_;
2785
2786	$self->{scrolled}->clear;
2787	return unless $items;
2788
2789	my @items = sort {
2790	($a->{type} <=> $b->{type})
2791	or ($a->{name} cmp $b->{name})
2792	} @$items;
2793
2794	$self->{real_items} = \@items;
2795
2796	my $row = 0;
2797	for my $item (@items) {
2798	CFClient::Item::update_widgets $item;
2799
2800	$self->{scrolled}->add (0, $row, $item->{face_widget});
2801	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2802	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2803
2804	$row++;
2805	}
2806	}
2807
2808	#############################################################################
2809
2810	package CFClient::UI::Menu;	2859	package CFClient::UI::Menu;
2811		2860
2812	our @ISA = CFClient::UI::FancyFrame::;	2861	our @ISA = CFClient::UI::FancyFrame::;
2813		2862
2814	use CFClient::OpenGL;	2863	use CFClient::OpenGL;
…		…
2852	# maybe save $GRAB? must be careful about events...	2901	# maybe save $GRAB? must be careful about events...
2853	$GRAB = $self;	2902	$GRAB = $self;
2854	$self->{button} = $ev->{button};	2903	$self->{button} = $ev->{button};
2855		2904
2856	$self->show;	2905	$self->show;
2857	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2906	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2858	}	2907	}
2859		2908
2860	sub mouse_motion {	2909	sub mouse_motion {
2861	my ($self, $ev, $x, $y) = @_;	2910	my ($self, $ev, $x, $y) = @_;
2862		2911
2863	# TODO: should use vbox->find_widget or so	2912	# TODO: should use vbox->find_widget or so
2864	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2913	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2865	$self->{hover} = $self->{item}{$HOVER};	2914	$self->{hover} = $self->{item}{$HOVER};
		2915
		2916	0
2866	}	2917	}
2867		2918
2868	sub button_up {	2919	sub button_up {
2869	my ($self, $ev, $x, $y) = @_;	2920	my ($self, $ev, $x, $y) = @_;
2870		2921
…		…
2872	undef $GRAB;	2923	undef $GRAB;
2873	$self->hide;	2924	$self->hide;
2874		2925
2875	$self->_emit ("popdown");	2926	$self->_emit ("popdown");
2876	$self->{hover}[1]->() if $self->{hover};	2927	$self->{hover}[1]->() if $self->{hover};
		2928	} else {
		2929	return 0
		2930	}
		2931
2877	}	2932	1
2878	}	2933	}
2879		2934
2880	#############################################################################	2935	#############################################################################
2881		2936
2882	package CFClient::UI::Statusbox;	2937	package CFClient::UI::Statusbox;
…		…
2987	$self->SUPER::reconfigure;	3042	$self->SUPER::reconfigure;
2988	}	3043	}
2989		3044
2990	#############################################################################	3045	#############################################################################
2991		3046
		3047	package CFClient::UI::Inventory;
		3048
		3049	our @ISA = CFClient::UI::ScrolledWindow::;
		3050
		3051	sub new {
		3052	my $class = shift;
		3053
		3054	my $self = $class->SUPER::new (
		3055	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3056	@_,
		3057	);
		3058
		3059	$self
		3060	}
		3061
		3062	sub set_items {
		3063	my ($self, $items) = @_;
		3064
		3065	$self->{scrolled}->clear;
		3066	return unless $items;
		3067
		3068	my @items = sort {
		3069	($a->{type} <=> $b->{type})
		3070	or ($a->{name} cmp $b->{name})
		3071	} @$items;
		3072
		3073	$self->{real_items} = \@items;
		3074
		3075	my $row = 0;
		3076	for my $item (@items) {
		3077	CFClient::Item::update_widgets $item;
		3078
		3079	$self->{scrolled}->add (0, $row, $item->{face_widget});
		3080	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		3081	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		3082
		3083	$row++;
		3084	}
		3085	}
		3086
		3087	#############################################################################
		3088
		3089	package CFClient::UI::BindEditor;
		3090
		3091	our @ISA = CFClient::UI::FancyFrame::;
		3092
		3093	sub new {
		3094	my $class = shift;
		3095
		3096	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3097
		3098	$self->add (my $vb = new CFClient::UI::VBox);
		3099
		3100
		3101	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3102	text => "start recording",
		3103	tooltip => "Start/Stops recording of actions."
		3104	."All subsequent actions after the recording started will be captured."
		3105	."The actions are displayed after the record was stopped."
		3106	."To bind the action you have to click on the 'Bind' button",
		3107	on_activate => sub {
		3108	unless ($self->{recording}) {
		3109	$self->start;
		3110	} else {
		3111	$self->stop;
		3112	}
		3113	});
		3114
		3115	$vb->add (new CFClient::UI::Label text => "Actions:");
		3116	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3117
		3118	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3119	$vb->add (my $hb = new CFClient::UI::HBox);
		3120	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3121	$hb->add (new CFClient::UI::Button
		3122	text => "bind",
		3123	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3124	on_activate => sub {
		3125	$self->ask_for_bind;
		3126	});
		3127
		3128	$vb->add (my $hb = new CFClient::UI::HBox);
		3129	$hb->add (new CFClient::UI::Button
		3130	text => "ok",
		3131	expand => 1,
		3132	tooltip => "This closes the binding editor and saves the binding",
		3133	on_activate => sub {
		3134	$self->hide;
		3135	$self->commit;
		3136	});
		3137
		3138	$hb->add (new CFClient::UI::Button
		3139	text => "cancel",
		3140	expand => 1,
		3141	tooltip => "This closes the binding editor without saving",
		3142	on_activate => sub {
		3143	$self->hide;
		3144	$self->{binding_cancel}->()
		3145	if $self->{binding_cancel};
		3146	});
		3147
		3148	$self->update_binding_widgets;
		3149
		3150	$self
		3151	}
		3152
		3153	sub commit {
		3154	my ($self) = @_;
		3155	my ($mod, $sym, $cmds) = $self->get_binding;
		3156	if ($sym != 0 && @$cmds > 0) {
		3157	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3158	."'. Don't forget 'Save Config'!");
		3159	$self->{binding_change}->($mod, $sym, $cmds)
		3160	if $self->{binding_change};
		3161	} else {
		3162	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3163	$self->{binding_cancel}->()
		3164	if $self->{binding_cancel};
		3165	}
		3166	}
		3167
		3168	sub start {
		3169	my ($self) = @_;
		3170
		3171	$self->{rec_btn}->set_text ("stop recording");
		3172	$self->{recording} = 1;
		3173	$self->clear_command_list;
		3174	$::CONN->start_record if $::CONN;
		3175	}
		3176
		3177	sub stop {
		3178	my ($self) = @_;
		3179
		3180	$self->{rec_btn}->set_text ("start recording");
		3181	$self->{recording} = 0;
		3182
		3183	my $rec;
		3184	$rec = $::CONN->stop_record if $::CONN;
		3185	return unless ref $rec eq 'ARRAY';
		3186	$self->set_command_list ($rec);
		3187	}
		3188
		3189
		3190	sub ask_for_bind_and_commit {
		3191	my ($self) = @_;
		3192	$self->ask_for_bind (1);
		3193	}
		3194
		3195	sub ask_for_bind {
		3196	my ($self, $commit) = @_;
		3197
		3198	CFClient::Binder::open_binding_dialog (sub {
		3199	my ($mod, $sym) = @_;
		3200	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3201	$self->update_binding_widgets;
		3202	$self->commit if $commit;
		3203	});
		3204	}
		3205
		3206	# $mod and $sym are the modifiers and key symbol
		3207	# $cmds is a array ref of strings (the commands)
		3208	# $cb is the callback that is executed on OK
		3209	# $ccb is the callback that is executed on CANCEL and
		3210	# when the binding was unsuccessful on OK
		3211	sub set_binding {
		3212	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3213
		3214	$self->clear_command_list;
		3215	$self->{recording} = 0;
		3216	$self->{rec_btn}->set_text ("start recording");
		3217
		3218	$self->{binding} = [$mod, $sym];
		3219	$self->{commands} = $cmds;
		3220
		3221	$self->{binding_change} = $cb;
		3222	$self->{binding_cancel} = $ccb;
		3223
		3224	$self->update_binding_widgets;
		3225	}
		3226
		3227	# this is a shortcut method that asks for a binding
		3228	# and then just binds it.
		3229	sub do_quick_binding {
		3230	my ($self, $cmds) = @_;
		3231	$self->set_binding (undef, undef, $cmds, sub {
		3232	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3233	});
		3234	$self->ask_for_bind (1);
		3235	}
		3236
		3237	sub update_binding_widgets {
		3238	my ($self) = @_;
		3239	my ($mod, $sym, $cmds) = $self->get_binding;
		3240	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3241	$self->set_command_list ($cmds);
		3242	}
		3243
		3244	sub get_binding {
		3245	my ($self) = @_;
		3246	return (
		3247	$self->{binding}->[0],
		3248	$self->{binding}->[1],
		3249	[ grep { defined $_ } @{$self->{commands}} ]
		3250	);
		3251	}
		3252
		3253	sub clear_command_list {
		3254	my ($self) = @_;
		3255	$self->{cmdbox}->clear ();
		3256	}
		3257
		3258	sub set_command_list {
		3259	my ($self, $cmds) = @_;
		3260
		3261	$self->{cmdbox}->clear ();
		3262	$self->{commands} = $cmds;
		3263
		3264	my $idx = 0;
		3265
		3266	for (@$cmds) {
		3267	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3268
		3269	my $i = $idx;
		3270	$hb->add (new CFClient::UI::Label text => $_);
		3271	$hb->add (new CFClient::UI::Button
		3272	text => "delete",
		3273	tooltip => "Deletes the action from the record",
		3274	on_activate => sub {
		3275	$self->{cmdbox}->remove ($hb);
		3276	$cmds->[$i] = undef;
		3277	});
		3278
		3279
		3280	$idx++
		3281	}
		3282	}
		3283
		3284	#############################################################################
		3285
		3286	package CFClient::UI::SpellList;
		3287
		3288	our @ISA = CFClient::UI::FancyFrame::;
		3289
		3290	sub new {
		3291	my $class = shift;
		3292
		3293	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3294
		3295	$self->add (new CFClient::UI::ScrolledWindow
		3296	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3297
		3298	$self;
		3299	}
		3300
		3301	# XXX: Do sorting? Argl...
		3302	sub add_spell {
		3303	my ($self, $spell) = @_;
		3304	$self->{spells}->{$spell->{name}} = $spell;
		3305
		3306	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3307	face => $spell->{face},
		3308	can_hover => 1,
		3309	can_events => 1,
		3310	tooltip => $spell->{message});
		3311
		3312	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3313	text => $spell->{name},
		3314	can_hover => 1,
		3315	can_events => 1,
		3316	tooltip => $spell->{message},
		3317	expand => 1);
		3318
		3319	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3320	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3321	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3322	expand => 1);
		3323
		3324	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3325	text => "bind to key",
		3326	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3327	}
		3328
		3329	sub rebuild_spell_list {
		3330	my ($self) = @_;
		3331	$self->{tbl_idx} = 0;
		3332	$self->add_spell ($_) for values %{$self->{spells}};
		3333	}
		3334
		3335	sub remove_spell {
		3336	my ($self, $spell) = @_;
		3337	delete $self->{spells}->{$spell->{name}};
		3338	$self->rebuild_spell_list;
		3339	}
		3340
		3341	#############################################################################
		3342
2992	package CFClient::UI::Root;	3343	package CFClient::UI::Root;
2993		3344
2994	our @ISA = CFClient::UI::Container::;	3345	our @ISA = CFClient::UI::Container::;
2995		3346
2996	use CFClient::OpenGL;	3347	use CFClient::OpenGL;
…		…
3006	Scalar::Util::weaken ($self->{root} = $self);	3357	Scalar::Util::weaken ($self->{root} = $self);
3007		3358
3008	$self	3359	$self
3009	}	3360	}
3010		3361
3011	sub configure {
3012	my ($self, $x, $y, $w, $h) = @_;
3013
3014	$self->{w} = $w;
3015	$self->{h} = $h;
3016	}
3017
3018	sub reconfigure {
3019	my ($self) = @_;
3020
3021	$self->SUPER::reconfigure;
3022
3023	$self->size_allocate ($self->{w}, $self->{h}, 1)
3024	if $self->{w};
3025	}
3026
3027	sub size_request {	3362	sub size_request {
3028	my ($self) = @_;	3363	my ($self) = @_;
3029		3364
3030	($self->{w}, $self->{h})	3365	($self->{w}, $self->{h})
3031	}	3366	}
3032		3367
		3368	sub _to_pixel {
		3369	my ($coord, $size, $max) = @_;
		3370
		3371	$coord =
		3372	$coord eq "center" ? ($max - $size) * 0.5
		3373	: $coord eq "max" ? $max
		3374	: $coord;
		3375
		3376	$coord = 0 if $coord < 0;
		3377	$coord = $max - $size if $coord > $max - $size;
		3378
		3379	int $coord + 0.5
		3380	}
		3381
3033	sub size_allocate {	3382	sub size_allocate {
3034	my ($self, $w, $h, $changed) = @_;	3383	my ($self, $w, $h) = @_;
3035		3384
3036	for my $child ($self->children) {	3385	for my $child ($self->children) {
3037	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3386	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3038		3387
3039	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3388	$X = $child->{force_x} if exists $child->{force_x};
3040	if exists $child->{req_x};	3389	$Y = $child->{force_y} if exists $child->{force_y};
3041		3390
3042	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3391	$X = _to_pixel $X, $W, $self->{w};
3043	if exists $child->{req_y};	3392	$Y = _to_pixel $Y, $H, $self->{h};
3044
3045	#delete @$child{qw(req_x req_y)};#d# def_x, def_y
3046
3047	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3048	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3049		3393
3050	$child->configure ($X, $Y, $W, $H);	3394	$child->configure ($X, $Y, $W, $H);
3051	}	3395	}
3052	}	3396	}
3053		3397
…		…
3070	}	3414	}
3071		3415
3072	sub add {	3416	sub add {
3073	my ($self, @children) = @_;	3417	my ($self, @children) = @_;
3074		3418
3075	for my $child (@children) {
3076	$child->{is_toplevel} = 1;	3419	$_->{is_toplevel} = 1
3077		3420	for @children;
3078	# integerise window positions
3079	$child->{x} = int $child->{x};
3080	$child->{y} = int $child->{y};
3081	}
3082		3421
3083	$self->SUPER::add (@children);	3422	$self->SUPER::add (@children);
3084	}	3423	}
3085		3424
3086	sub remove {	3425	sub remove {
3087	my ($self, @children) = @_;	3426	my ($self, @children) = @_;
3088		3427
3089	$self->SUPER::remove (@children);	3428	$self->SUPER::remove (@children);
		3429
		3430	delete $self->{is_toplevel}
		3431	for @children;
3090		3432
3091	while (@children) {	3433	while (@children) {
3092	my $w = pop @children;	3434	my $w = pop @children;
3093	push @children, $w->children;	3435	push @children, $w->children;
3094	$w->set_invisible;	3436	$w->set_invisible;
…		…
3114	$_->()	3456	$_->()
3115	for values %{delete $self->{refresh_hook}};	3457	for values %{delete $self->{refresh_hook}};
3116	}	3458	}
3117		3459
3118	if ($self->{realloc}) {	3460	if ($self->{realloc}) {
		3461	my %queue;
3119	my @queue;	3462	my @queue;
		3463	my $widget;
3120		3464
		3465	outer:
3121	while () {	3466	while () {
3122	if ($self->{realloc}) {	3467	if (my $realloc = delete $self->{realloc}) {
3123	#TODO use array-of-depth approach	3468	for $widget (values %$realloc) {
		3469	$widget->{visible} or next; # do not resize invisible widgets
3124		3470
3125	@queue = sort { $a->{visible} <=> $b->{visible} }	3471	$queue{$widget+0}++ and next; # duplicates are common
3126	@queue, values %{delete $self->{realloc}};	3472
		3473	push @{ $queue[$widget->{visible}] }, $widget;
		3474	}
3127	}	3475	}
3128		3476
		3477	while () {
		3478	@queue or last outer;
		3479
		3480	$widget = pop @{ $queue[-1] || [] }
		3481	and last;
		3482
		3483	pop @queue;
		3484	}
		3485
		3486	delete $queue{$widget+0};
		3487
		3488	my ($w, $h) = $widget->size_request;
		3489
		3490	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3491	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3492
		3493	$w = $widget->{force_w} if exists $widget->{force_w};
		3494	$h = $widget->{force_h} if exists $widget->{force_h};
		3495
		3496	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3497	|| delete $widget->{force_realloc}) {
		3498	$widget->{req_w} = $w;
		3499	$widget->{req_h} = $h;
		3500
		3501	$self->{size_alloc}{$widget+0} = $widget;
		3502
		3503	if (my $parent = $widget->{parent}) {
		3504	$self->{realloc}{$parent+0} = $parent
		3505	unless $queue{$parent+0};
		3506
		3507	$parent->{force_size_alloc} = 1;
		3508	$self->{size_alloc}{$parent+0} = $parent;
		3509	}
		3510	}
		3511
		3512	delete $self->{realloc}{$widget+0};
		3513	}
		3514	}
		3515
		3516	while (my $size_alloc = delete $self->{size_alloc}) {
		3517	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3518	values %$size_alloc;
		3519
		3520	while () {
3129	my $widget = pop @queue || last;	3521	my $widget = pop @queue || last;
3130		3522
3131	$widget->{visible} or last; # do not resize invisible widgets	3523	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3132
3133	my ($w, $h) = $widget->{def_w} && $widget->{def_h}
3134	? @$widget{qw(def_w def_h)}
3135	: $widget->size_request;
3136
3137	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3138
3139	$widget->{req_w} = $w;
3140	$widget->{req_h} = $h;
3141
3142	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];
3143
3144	push @queue, $widget->{parent}
3145	if $widget->{parent};
3146	}
3147	}
3148
3149	while (my $size_alloc = delete $self->{size_alloc}) {
3150	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},
3151	values %$size_alloc;
3152
3153	while () {
3154	my ($widget, $w, $h) = @{ pop @queue or last };
3155		3524
3156	$w = 0 if $w < 0;	3525	$w = 0 if $w < 0;
3157	$h = 0 if $h < 0;	3526	$h = 0 if $h < 0;
3158		3527
3159	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3528	$w = int $w + 0.5;
		3529	$h = int $h + 0.5;
3160		3530
		3531	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3532	$widget->{old_w} = $widget->{w};
		3533	$widget->{old_h} = $widget->{h};
		3534
3161	$widget->{w} = $w;	3535	$widget->{w} = $w;
3162	$widget->{h} = $h;	3536	$widget->{h} = $h;
3163		3537
3164	$widget->emit (size_allocate => $w, $h, $changed);	3538	$widget->emit (size_allocate => $w, $h);
		3539	}
3165	}	3540	}
3166	}	3541	}
3167		3542
3168	while ($self->{post_alloc_hook}) {	3543	while ($self->{post_alloc_hook}) {
3169	$_->()	3544	$_->()
3170	for values %{delete $self->{post_alloc_hook}};	3545	for values %{delete $self->{post_alloc_hook}};
3171	}	3546	}
		3547
3172		3548
3173	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3549	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3174	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3550	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3175	glClear GL_COLOR_BUFFER_BIT;	3551	glClear GL_COLOR_BUFFER_BIT;
3176		3552
…		…
3178	glLoadIdentity;	3554	glLoadIdentity;
3179	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3555	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3180	glMatrixMode GL_MODELVIEW;	3556	glMatrixMode GL_MODELVIEW;
3181	glLoadIdentity;	3557	glLoadIdentity;
3182		3558
		3559	{
		3560	package CFClient::UI::Base;
		3561
		3562	($draw_x, $draw_y, $draw_w, $draw_h) =
		3563	(0, 0, $self->{w}, $self->{h});
		3564	}
		3565
3183	$self->_draw;	3566	$self->_draw;
3184	}	3567	}
3185		3568
3186	#############################################################################	3569	#############################################################################
3187		3570

Diff Legend

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