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.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
…		…
1000		1043
1001	our @ISA = CFClient::UI::Bin::;	1044	our @ISA = CFClient::UI::Bin::;
1002		1045
1003	use CFClient::OpenGL;	1046	use CFClient::OpenGL;
1004		1047
1005	my @tex =	1048	my $bg =
		1049	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1050	mipmap => 1, wrap => 1;
		1051
		1052	my @border =
1006	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1053	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);	1054	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1008		1055
1009	sub new {	1056	sub new {
1010	my $class = shift;	1057	my ($class, %arg) = @_;
		1058
		1059	my $title = delete $arg{title};
1011		1060
1012	my $self = $class->SUPER::new (	1061	my $self = $class->SUPER::new (
1013	bg => [1, 1, 1, 1],	1062	bg => [1, 1, 1, 1],
1014	border_bg => [1, 1, 1, 1],	1063	border_bg => [1, 1, 1, 1],
1015	border => 0.6,	1064	border => 0.6,
1016	is_toplevel => 1,
1017	can_events => 1,	1065	can_events => 1,
1018	@_	1066	min_w => 16,
		1067	min_h => 16,
		1068	%arg,
1019	);	1069	);
1020		1070
1021	$self->{title} &&= new CFClient::UI::Label	1071	$self->{title} = new CFClient::UI::Label
1022	align => 0,	1072	align => 0,
1023	valign => 1,	1073	valign => 1,
1024	text => $self->{title},	1074	text => $title,
1025	fontsize => $self->{border};	1075	fontsize => $self->{border}
		1076	if defined $title;
1026		1077
1027	$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};
1028	}	1086	}
1029		1087
1030	sub border {	1088	sub border {
1031	int $_[0]{border} * $::FONTSIZE	1089	int $_[0]{border} * $::FONTSIZE
1032	}	1090	}
1033		1091
1034	sub size_request {	1092	sub size_request {
1035	my ($self) = @_;	1093	my ($self) = @_;
		1094
		1095	$self->{title}->size_request
		1096	if $self->{title};
1036		1097
1037	my ($w, $h) = $self->SUPER::size_request;	1098	my ($w, $h) = $self->SUPER::size_request;
1038		1099
1039	(	1100	(
1040	$w + $self->border * 2,	1101	$w + $self->border * 2,
1041	$h + $self->border * 2,	1102	$h + $self->border * 2,
1042	)	1103	)
1043	}	1104	}
1044		1105
1045	sub size_allocate {	1106	sub size_allocate {
1046	my ($self, $w, $h, $changed) = @_;	1107	my ($self, $w, $h) = @_;
1047		1108
1048	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	}
1049		1114
		1115	my $border = $self->border;
		1116
1050	$h -= List::Util::max 0, $self->border * 2;	1117	$h -= List::Util::max 0, $border * 2;
1051	$w -= List::Util::max 0, $self->border * 2;	1118	$w -= List::Util::max 0, $border * 2;
1052		1119
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);	1120	$self->child->configure ($border, $border, $w, $h);
1057	}	1121	}
1058		1122
1059	sub button_down {	1123	sub button_down {
1060	my ($self, $ev, $x, $y) = @_;	1124	my ($self, $ev, $x, $y) = @_;
1061		1125
…		…
1077	my ($ev, $x, $y) = @_;	1141	my ($ev, $x, $y) = @_;
1078		1142
1079	my $dx = $ev->{x} - $ox;	1143	my $dx = $ev->{x} - $ox;
1080	my $dy = $ev->{y} - $oy;	1144	my $dy = $ev->{y} - $oy;
1081		1145
1082	$self->{user_x} = $wx + $dx * $mx;
1083	$self->{user_y} = $wy + $dy * $my;
1084	$self->{def_w} = $bw + $dx * ($mx ? -1 : 1);	1146	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1085	$self->{def_h} = $bh + $dy * ($my ? -1 : 1);	1147	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1086	$self->move ($self->{user_x}, $self->{user_y});	1148
1087	$self->realloc;	1149	$self->realloc;
		1150	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1088	};	1151	};
1089		1152
1090	} elsif ($lr ^ $td) {	1153	} elsif ($lr ^ $td) {
1091	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1154	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1092	my ($bx, $by) = ($self->{x}, $self->{y});	1155	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1094	$self->{motion} = sub {	1157	$self->{motion} = sub {
1095	my ($ev, $x, $y) = @_;	1158	my ($ev, $x, $y) = @_;
1096		1159
1097	($x, $y) = ($ev->{x}, $ev->{y});	1160	($x, $y) = ($ev->{x}, $ev->{y});
1098		1161
1099	$self->{user_x} = $bx + $x - $ox;	1162	$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	};	1163	};
		1164	} else {
		1165	return 0;
		1166	}
		1167
1105	}	1168	1
1106	}	1169	}
1107		1170
1108	sub button_up {	1171	sub button_up {
1109	my ($self, $ev, $x, $y) = @_;	1172	my ($self, $ev, $x, $y) = @_;
1110		1173
1111	delete $self->{motion};	1174	!!delete $self->{motion}
1112	}	1175	}
1113		1176
1114	sub mouse_motion {	1177	sub mouse_motion {
1115	my ($self, $ev, $x, $y) = @_;	1178	my ($self, $ev, $x, $y) = @_;
1116		1179
1117	$self->{motion}->($ev, $x, $y) if $self->{motion};	1180	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1181
		1182	!!$self->{motion}
1118	}	1183	}
1119		1184
1120	sub _draw {	1185	sub _draw {
1121	my ($self) = @_;	1186	my ($self) = @_;
1122		1187
		1188	my $child = $self->{children}[0];
		1189
1123	my ($w, $h ) = ($self->{w}, $self->{h});	1190	my ($w, $h ) = ($self->{w}, $self->{h});
1124	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1191	my ($cw, $ch) = ($child->{w}, $child->{h});
1125		1192
1126	glEnable GL_TEXTURE_2D;	1193	glEnable GL_TEXTURE_2D;
1127	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1194	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1128		1195
1129	my $border = $self->border;	1196	my $border = $self->border;
1130		1197
1131	glColor @{ $self->{border_bg} };	1198	glColor @{ $self->{border_bg} };
1132	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1199	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1133	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1200	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1134	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1201	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1135	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1202	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1136		1203
1137	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1204	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1138	my $bg = $tex[0];	1205	glColor @{ $self->{bg} };
1139		1206
1140	# TODO: repeat texture not scale	1207	# TODO: repeat texture not scale
		1208	# solve this better(?)
1141	my $rep_x = $cw / $bg->{w};	1209	$bg->{s} = $cw / $bg->{w};
1142	my $rep_y = $ch / $bg->{h};	1210	$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);	1211	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1150	}	1212	}
1151		1213
1152	glDisable GL_TEXTURE_2D;	1214	glDisable GL_TEXTURE_2D;
1153		1215
1154	$self->{title}->draw if $self->{title};
1155
1156	$self->child->draw;	1216	$child->draw;
		1217
		1218	if ($self->{title}) {
		1219	glTranslate 0, $border - $self->{h};
		1220	$self->{title}->_draw;
		1221	}
1157	}	1222	}
1158		1223
1159	#############################################################################	1224	#############################################################################
1160		1225
1161	package CFClient::UI::Table;	1226	package CFClient::UI::Table;
…		…
1235	(sum @$hs),	1300	(sum @$hs),
1236	)	1301	)
1237	}	1302	}
1238		1303
1239	sub size_allocate {	1304	sub size_allocate {
1240	my ($self, $w, $h, $changed) = @_;	1305	my ($self, $w, $h) = @_;
1241		1306
1242	my ($ws, $hs) = $self->get_wh;	1307	my ($ws, $hs) = $self->get_wh;
1243		1308
1244	my $req_w = (sum @$ws) || 1;	1309	my $req_w = (sum @$ws) || 1;
1245	my $req_h = (sum @$hs) || 1;	1310	my $req_h = (sum @$hs) || 1;
…		…
1323	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1388	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1324	)	1389	)
1325	}	1390	}
1326		1391
1327	sub size_allocate {	1392	sub size_allocate {
1328	my ($self, $w, $h, $changed) = @_;	1393	my ($self, $w, $h) = @_;
1329		1394
1330	my $space = $self->{vertical} ? $h : $w;	1395	my $space = $self->{vertical} ? $h : $w;
1331	my $children = $self->{children};	1396	my $children = $self->{children};
1332		1397
1333	my @req;	1398	my @req;
…		…
1416	ellipsise => 3, # end	1481	ellipsise => 3, # end
1417	layout => (new CFClient::Layout),	1482	layout => (new CFClient::Layout),
1418	fontsize => 1,	1483	fontsize => 1,
1419	align => -1,	1484	align => -1,
1420	valign => -1,	1485	valign => -1,
1421	padding => 2,	1486	padding_x => 2,
		1487	padding_y => 2,
1422	can_events => 0,	1488	can_events => 0,
1423	%arg	1489	%arg
1424	);	1490	);
1425		1491
1426	if (exists $self->{template}) {	1492	if (exists $self->{template}) {
…		…
1502		1568
1503	$w = List::Util::max $w, $w2;	1569	$w = List::Util::max $w, $w2;
1504	$h = List::Util::max $h, $h2;	1570	$h = List::Util::max $h, $h2;
1505	}	1571	}
1506		1572
1507	(	1573	($w, $h)
1508	$w + $self->{padding} * 2,
1509	$h + $self->{padding} * 2,
1510	)
1511	}	1574	}
1512		1575
1513	sub size_allocate {	1576	sub size_allocate {
1514	my ($self, $w, $h, $changed) = @_;	1577	my ($self, $w, $h) = @_;
		1578
		1579	delete $self->{ox};
1515		1580
1516	delete $self->{texture}	1581	delete $self->{texture}
1517	if $changed;	1582	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1518	}	1583	}
1519		1584
1520	sub set_fontsize {	1585	sub set_fontsize {
1521	my ($self, $fontsize) = @_;	1586	my ($self, $fontsize) = @_;
1522		1587
…		…
1537	$self->{layout}->set_width ($self->{w});	1602	$self->{layout}->set_width ($self->{w});
1538	$self->{layout}->set_ellipsise ($self->{ellipsise});	1603	$self->{layout}->set_ellipsise ($self->{ellipsise});
1539	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1604	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1540	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1605	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1541		1606
1542	my $tex = new_from_layout CFClient::Texture $self->{layout};	1607	new_from_layout CFClient::Texture $self->{layout}
		1608	};
1543		1609
		1610	unless (exists $self->{ox}) {
1544	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1611	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1545	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1612	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1546	: ($self->{w} - $tex->{w}) * 0.5);	1613	: ($self->{w} - $tex->{w}) * 0.5);
1547		1614
1548	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1615	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1549	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1616	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1550	: ($self->{h} - $tex->{h}) * 0.5);	1617	: ($self->{h} - $tex->{h}) * 0.5);
1551
1552	$tex
1553	};	1618	};
1554		1619
1555	glEnable GL_TEXTURE_2D;	1620	glEnable GL_TEXTURE_2D;
1556	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1621	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1557		1622
…		…
1652	$self->{cursor} = length $text;	1717	$self->{cursor} = length $text;
1653	} elsif ($uni == 27) {	1718	} elsif ($uni == 27) {
1654	$self->_emit ('escape');	1719	$self->_emit ('escape');
1655	} elsif ($uni) {	1720	} elsif ($uni) {
1656	substr $text, $self->{cursor}++, 0, chr $uni;	1721	substr $text, $self->{cursor}++, 0, chr $uni;
		1722	} else {
		1723	return 0;
1657	}	1724	}
1658		1725
1659	$self->_set_text ($text);	1726	$self->_set_text ($text);
1660		1727
1661	$self->realloc;	1728	$self->realloc;
		1729
		1730	1
1662	}	1731	}
1663		1732
1664	sub focus_in {	1733	sub focus_in {
1665	my ($self) = @_;	1734	my ($self) = @_;
1666		1735
…		…
1681	utf8::encode $text;	1750	utf8::encode $text;
1682	$self->{cursor} = length substr $text, 0, $idx;	1751	$self->{cursor} = length substr $text, 0, $idx;
1683		1752
1684	$self->_set_text ($self->{text});	1753	$self->_set_text ($self->{text});
1685	$self->update;	1754	$self->update;
		1755
		1756	1
1686	}	1757	}
1687		1758
1688	sub mouse_motion {	1759	sub mouse_motion {
1689	my ($self, $ev, $x, $y) = @_;	1760	my ($self, $ev, $x, $y) = @_;
1690	# 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
1691	}	1764	}
1692		1765
1693	sub _draw {	1766	sub _draw {
1694	my ($self) = @_;	1767	my ($self) = @_;
1695		1768
…		…
1772	} else {	1845	} else {
1773	$self->set_text ($self->{history_saveback});	1846	$self->set_text ($self->{history_saveback});
1774	}	1847	}
1775		1848
1776	} else {	1849	} else {
1777	$self->SUPER::key_down ($ev);	1850	return $self->SUPER::key_down ($ev)
		1851	}
		1852
1778	}	1853	1
1779
1780	}	1854	}
1781		1855
1782	#############################################################################	1856	#############################################################################
1783		1857
1784	package CFClient::UI::Button;	1858	package CFClient::UI::Button;
…		…
1793		1867
1794	sub new {	1868	sub new {
1795	my $class = shift;	1869	my $class = shift;
1796		1870
1797	$class->SUPER::new (	1871	$class->SUPER::new (
1798	padding => 4,	1872	padding_x => 4,
		1873	padding_y => 4,
1799	fg => [1, 1, 1],	1874	fg => [1, 1, 1],
1800	active_fg => [0, 0, 1],	1875	active_fg => [0, 0, 1],
1801	can_hover => 1,	1876	can_hover => 1,
1802	align => 0,	1877	align => 0,
1803	valign => 0,	1878	valign => 0,
…		…
1812	my ($self, $ev, $x, $y) = @_;	1887	my ($self, $ev, $x, $y) = @_;
1813		1888
1814	$self->emit ("activate")	1889	$self->emit ("activate")
1815	if $x >= 0 && $x < $self->{w}	1890	if $x >= 0 && $x < $self->{w}
1816	&& $y >= 0 && $y < $self->{h};	1891	&& $y >= 0 && $y < $self->{h};
		1892
		1893	1
1817	}	1894	}
1818		1895
1819	sub _draw {	1896	sub _draw {
1820	my ($self) = @_;	1897	my ($self) = @_;
1821		1898
…		…
1850		1927
1851	sub new {	1928	sub new {
1852	my $class = shift;	1929	my $class = shift;
1853		1930
1854	$class->SUPER::new (	1931	$class->SUPER::new (
1855	padding => 2,	1932	padding_x => 2,
		1933	padding_y => 2,
1856	fg => [1, 1, 1],	1934	fg => [1, 1, 1],
1857	active_fg => [1, 1, 0],	1935	active_fg => [1, 1, 0],
1858	bg => [0, 0, 0, 0.2],	1936	bg => [0, 0, 0, 0.2],
1859	active_bg => [1, 1, 1, 0.5],	1937	active_bg => [1, 1, 1, 0.5],
1860	state => 0,	1938	state => 0,
…		…
1864	}	1942	}
1865		1943
1866	sub size_request {	1944	sub size_request {
1867	my ($self) = @_;	1945	my ($self) = @_;
1868		1946
1869	($self->{padding} * 2 + 6) x 2	1947	(6) x 2
1870	}	1948	}
1871		1949
1872	sub button_down {	1950	sub button_down {
1873	my ($self, $ev, $x, $y) = @_;	1951	my ($self, $ev, $x, $y) = @_;
1874		1952
1875	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1953	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1876	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1954	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1877	$self->{state} = !$self->{state};	1955	$self->{state} = !$self->{state};
1878	$self->_emit (changed => $self->{state});	1956	$self->_emit (changed => $self->{state});
		1957	} else {
		1958	return 0
		1959	}
		1960
1879	}	1961	1
1880	}	1962	}
1881		1963
1882	sub _draw {	1964	sub _draw {
1883	my ($self) = @_;	1965	my ($self) = @_;
1884		1966
1885	$self->SUPER::_draw;	1967	$self->SUPER::_draw;
1886		1968
1887	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1969	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1888		1970
1889	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;
1890		1974
1891	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1975	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1892		1976
1893	my $tex = $self->{state} ? $tex[1] : $tex[0];	1977	my $tex = $self->{state} ? $tex[1] : $tex[0];
1894		1978
…		…
2159	fg => [1, 1, 1],	2243	fg => [1, 1, 1],
2160	active_fg => [0, 0, 0],	2244	active_fg => [0, 0, 0],
2161	bg => [0, 0, 0, 0.2],	2245	bg => [0, 0, 0, 0.2],
2162	active_bg => [1, 1, 1, 0.5],	2246	active_bg => [1, 1, 1, 0.5],
2163	range => [0, 0, 100, 10, 0],	2247	range => [0, 0, 100, 10, 0],
2164	req_w => $::WIDTH / 80,	2248	min_w => $::WIDTH / 80,
2165	req_h => $::WIDTH / 80,	2249	min_h => $::WIDTH / 80,
2166	vertical => 0,	2250	vertical => 0,
2167	can_hover => 1,	2251	can_hover => 1,
2168	inner_pad => 0.02,	2252	inner_pad => 0.02,
2169	@_	2253	@_
2170	);	2254	);
…		…
2210	}	2294	}
2211		2295
2212	sub size_request {	2296	sub size_request {
2213	my ($self) = @_;	2297	my ($self) = @_;
2214		2298
2215	my $w = $self->{req_w};	2299	($self->{req_w}, $self->{req_h})
2216	my $h = $self->{req_h};
2217
2218	$self->{vertical} ? ($h, $w) : ($w, $h)
2219	}	2300	}
2220		2301
2221	sub button_down {	2302	sub button_down {
2222	my ($self, $ev, $x, $y) = @_;	2303	my ($self, $ev, $x, $y) = @_;
2223		2304
2224	$self->SUPER::button_down ($ev, $x, $y);	2305	$self->SUPER::button_down ($ev, $x, $y);
2225		2306
2226	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2307	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2227		2308
2228	$self->mouse_motion ($ev, $x, $y);	2309	$self->mouse_motion ($ev, $x, $y)
2229	}	2310	}
2230		2311
2231	sub mouse_motion {	2312	sub mouse_motion {
2232	my ($self, $ev, $x, $y) = @_;	2313	my ($self, $ev, $x, $y) = @_;
2233		2314
…		…
2237	my (undef, $lo, $hi, $page) = @{$self->{range}};	2318	my (undef, $lo, $hi, $page) = @{$self->{range}};
2238		2319
2239	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2320	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2240		2321
2241	$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
2242	}	2327	1
2243	}	2328	}
2244		2329
2245	sub update {	2330	sub update {
2246	my ($self) = @_;	2331	my ($self) = @_;
2247		2332
…		…
2373	$self->{fontsize} = $fontsize;	2458	$self->{fontsize} = $fontsize;
2374	$self->reflow;	2459	$self->reflow;
2375	}	2460	}
2376		2461
2377	sub size_allocate {	2462	sub size_allocate {
2378	my ($self, $w, $h, $changed) = @_;	2463	my ($self, $w, $h) = @_;
2379		2464
2380	$self->SUPER::size_allocate ($w, $h, $changed);	2465	$self->SUPER::size_allocate ($w, $h);
2381
2382	return unless $changed;
2383		2466
2384	$self->{layout}->set_font ($self->{font}) if $self->{font};	2467	$self->{layout}->set_font ($self->{font}) if $self->{font};
2385	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2468	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2386	$self->{layout}->set_width ($self->{children}[0]{w});	2469	$self->{layout}->set_width ($self->{children}[0]{w});
2387		2470
…		…
2610	}	2693	}
2611		2694
2612	sub set_tooltip_from {	2695	sub set_tooltip_from {
2613	my ($self, $widget) = @_;	2696	my ($self, $widget) = @_;
2614		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
2615	$self->add (new CFClient::UI::Label	2707	$self->add (new CFClient::UI::Label
2616	markup => $widget->{tooltip},	2708	markup => $tooltip,
2617	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2709	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2618	fontsize => 0.8,	2710	fontsize => 0.8,
2619	fg => [0, 0, 0, 1],	2711	fg => [0, 0, 0, 1],
2620	ellipsise => 0,	2712	ellipsise => 0,
2621	font => ($widget->{tooltip_font} || $::FONT_PROP),	2713	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2629		2721
2630	($w + 4, $h + 4)	2722	($w + 4, $h + 4)
2631	}	2723	}
2632		2724
2633	sub size_allocate {	2725	sub size_allocate {
2634	my ($self, $w, $h, $changed) = @_;	2726	my ($self, $w, $h) = @_;
2635		2727
2636	return unless $changed;
2637
2638	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2728	$self->SUPER::size_allocate ($w - 4, $h - 4);
2639	}	2729	}
2640		2730
2641	sub visibility_change {	2731	sub visibility_change {
2642	my ($self, $visible) = @_;	2732	my ($self, $visible) = @_;
2643		2733
…		…
2650	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2740	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2651		2741
2652	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2742	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2653	if $x + $self->{w} > $::WIDTH;	2743	if $x + $self->{w} > $::WIDTH;
2654		2744
2655	$self->move ($x, $y);	2745	$self->move_abs ($x, $y);
2656	});	2746	});
2657	}	2747	}
2658		2748
2659	sub _draw {	2749	sub _draw {
2660	my ($self) = @_;	2750	my ($self) = @_;
…		…
2764	$self->SUPER::DESTROY;	2854	$self->SUPER::DESTROY;
2765	}	2855	}
2766		2856
2767	#############################################################################	2857	#############################################################################
2768		2858
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;	2859	package CFClient::UI::Menu;
2812		2860
2813	our @ISA = CFClient::UI::FancyFrame::;	2861	our @ISA = CFClient::UI::FancyFrame::;
2814		2862
2815	use CFClient::OpenGL;	2863	use CFClient::OpenGL;
…		…
2853	# maybe save $GRAB? must be careful about events...	2901	# maybe save $GRAB? must be careful about events...
2854	$GRAB = $self;	2902	$GRAB = $self;
2855	$self->{button} = $ev->{button};	2903	$self->{button} = $ev->{button};
2856		2904
2857	$self->show;	2905	$self->show;
2858	$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);
2859	}	2907	}
2860		2908
2861	sub mouse_motion {	2909	sub mouse_motion {
2862	my ($self, $ev, $x, $y) = @_;	2910	my ($self, $ev, $x, $y) = @_;
2863		2911
2864	# TODO: should use vbox->find_widget or so	2912	# TODO: should use vbox->find_widget or so
2865	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2913	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2866	$self->{hover} = $self->{item}{$HOVER};	2914	$self->{hover} = $self->{item}{$HOVER};
		2915
		2916	0
2867	}	2917	}
2868		2918
2869	sub button_up {	2919	sub button_up {
2870	my ($self, $ev, $x, $y) = @_;	2920	my ($self, $ev, $x, $y) = @_;
2871		2921
…		…
2873	undef $GRAB;	2923	undef $GRAB;
2874	$self->hide;	2924	$self->hide;
2875		2925
2876	$self->_emit ("popdown");	2926	$self->_emit ("popdown");
2877	$self->{hover}[1]->() if $self->{hover};	2927	$self->{hover}[1]->() if $self->{hover};
		2928	} else {
		2929	return 0
		2930	}
		2931
2878	}	2932	1
2879	}	2933	}
2880		2934
2881	#############################################################################	2935	#############################################################################
2882		2936
2883	package CFClient::UI::Statusbox;	2937	package CFClient::UI::Statusbox;
…		…
2988	$self->SUPER::reconfigure;	3042	$self->SUPER::reconfigure;
2989	}	3043	}
2990		3044
2991	#############################################################################	3045	#############################################################################
2992		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
2993	package CFClient::UI::Root;	3343	package CFClient::UI::Root;
2994		3344
2995	our @ISA = CFClient::UI::Container::;	3345	our @ISA = CFClient::UI::Container::;
2996		3346
2997	use CFClient::OpenGL;	3347	use CFClient::OpenGL;
…		…
3007	Scalar::Util::weaken ($self->{root} = $self);	3357	Scalar::Util::weaken ($self->{root} = $self);
3008		3358
3009	$self	3359	$self
3010	}	3360	}
3011		3361
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 {	3362	sub size_request {
3029	my ($self) = @_;	3363	my ($self) = @_;
3030		3364
3031	($self->{w}, $self->{h})	3365	($self->{w}, $self->{h})
3032	}	3366	}
3033		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
3034	sub size_allocate {	3382	sub size_allocate {
3035	my ($self, $w, $h, $changed) = @_;	3383	my ($self, $w, $h) = @_;
3036		3384
3037	for my $child ($self->children) {	3385	for my $child ($self->children) {
3038	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)};
3039		3387
3040	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3388	$X = $child->{force_x} if exists $child->{force_x};
3041	if exists $child->{req_x};	3389	$Y = $child->{force_y} if exists $child->{force_y};
3042		3390
3043	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3391	$X = _to_pixel $X, $W, $self->{w};
3044	if exists $child->{req_y};	3392	$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		3393
3051	$child->configure ($X, $Y, $W, $H);	3394	$child->configure ($X, $Y, $W, $H);
3052	}	3395	}
3053	}	3396	}
3054		3397
…		…
3071	}	3414	}
3072		3415
3073	sub add {	3416	sub add {
3074	my ($self, @children) = @_;	3417	my ($self, @children) = @_;
3075		3418
3076	for my $child (@children) {
3077	$child->{is_toplevel} = 1;	3419	$_->{is_toplevel} = 1
3078		3420	for @children;
3079	# integerise window positions
3080	$child->{x} = int $child->{x};
3081	$child->{y} = int $child->{y};
3082	}
3083		3421
3084	$self->SUPER::add (@children);	3422	$self->SUPER::add (@children);
3085	}	3423	}
3086		3424
3087	sub remove {	3425	sub remove {
3088	my ($self, @children) = @_;	3426	my ($self, @children) = @_;
3089		3427
3090	$self->SUPER::remove (@children);	3428	$self->SUPER::remove (@children);
		3429
		3430	delete $self->{is_toplevel}
		3431	for @children;
3091		3432
3092	while (@children) {	3433	while (@children) {
3093	my $w = pop @children;	3434	my $w = pop @children;
3094	push @children, $w->children;	3435	push @children, $w->children;
3095	$w->set_invisible;	3436	$w->set_invisible;
…		…
3115	$_->()	3456	$_->()
3116	for values %{delete $self->{refresh_hook}};	3457	for values %{delete $self->{refresh_hook}};
3117	}	3458	}
3118		3459
3119	if ($self->{realloc}) {	3460	if ($self->{realloc}) {
		3461	my %queue;
3120	my @queue;	3462	my @queue;
		3463	my $widget;
3121		3464
		3465	outer:
3122	while () {	3466	while () {
3123	if ($self->{realloc}) {	3467	if (my $realloc = delete $self->{realloc}) {
3124	#TODO use array-of-depth approach	3468	for $widget (values %$realloc) {
		3469	$widget->{visible} or next; # do not resize invisible widgets
3125		3470
3126	@queue = sort { $a->{visible} <=> $b->{visible} }	3471	$queue{$widget+0}++ and next; # duplicates are common
3127	@queue, values %{delete $self->{realloc}};	3472
		3473	push @{ $queue[$widget->{visible}] }, $widget;
		3474	}
3128	}	3475	}
3129		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 () {
3130	my $widget = pop @queue || last;	3521	my $widget = pop @queue || last;
3131		3522
3132	$widget->{visible} or last; # do not resize invisible widgets	3523	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		3524
3157	$w = 0 if $w < 0;	3525	$w = 0 if $w < 0;
3158	$h = 0 if $h < 0;	3526	$h = 0 if $h < 0;
3159		3527
3160	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3528	$w = int $w + 0.5;
		3529	$h = int $h + 0.5;
3161		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
3162	$widget->{w} = $w;	3535	$widget->{w} = $w;
3163	$widget->{h} = $h;	3536	$widget->{h} = $h;
3164		3537
3165	$widget->emit (size_allocate => $w, $h, $changed);	3538	$widget->emit (size_allocate => $w, $h);
		3539	}
3166	}	3540	}
3167	}	3541	}
3168		3542
3169	while ($self->{post_alloc_hook}) {	3543	while ($self->{post_alloc_hook}) {
3170	$_->()	3544	$_->()
3171	for values %{delete $self->{post_alloc_hook}};	3545	for values %{delete $self->{post_alloc_hook}};
3172	}	3546	}
		3547
3173		3548
3174	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3549	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3175	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3550	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3176	glClear GL_COLOR_BUFFER_BIT;	3551	glClear GL_COLOR_BUFFER_BIT;
3177		3552
…		…
3179	glLoadIdentity;	3554	glLoadIdentity;
3180	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3555	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3181	glMatrixMode GL_MODELVIEW;	3556	glMatrixMode GL_MODELVIEW;
3182	glLoadIdentity;	3557	glLoadIdentity;
3183		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
3184	$self->_draw;	3566	$self->_draw;
3185	}	3567	}
3186		3568
3187	#############################################################################	3569	#############################################################################
3188		3570

Diff Legend

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