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.251 by root, Sun May 28 22:24:24 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) {
		51	$TOOLTIP->hide;
		52
45	$TOOLTIP->{owner} = $widget;	53	$TOOLTIP->{owner} = $widget;
46		54
47	my $tip = $widget->{tooltip};	55	my $tip = $widget->{tooltip};
48		56
49	$tip = $tip->($widget) if CODE:: eq ref $tip;	57	$tip = $tip->($widget) if CODE:: eq ref $tip;
50		58
51	$TOOLTIP->set_tooltip_from ($widget);	59	$TOOLTIP->set_tooltip_from ($widget);
52	$TOOLTIP->show;	60	$TOOLTIP->show;
53
54	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
55
56	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
57	if $x + $TOOLTIP->{w} > $::WIDTH;
58
59	$TOOLTIP->move ($x, $y);
60	$TOOLTIP->realloc;
61	}	61	}
62		62
63	return;	63	return;
64	}	64	}
65	}	65	}
…		…
171	sub rescale_widgets {	171	sub rescale_widgets {
172	my ($sx, $sy) = @_;	172	my ($sx, $sy) = @_;
173		173
174	for my $widget (values %WIDGET) {	174	for my $widget (values %WIDGET) {
175	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
176	$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.]+$/;
177	$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};
178	$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};
179	$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.]+$/;
180	$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};
181	$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
182	}	189	}
183	}	190	}
184		191
185	reconfigure_widgets;	192	reconfigure_widgets;
186	}	193	}
…		…
195		202
196	sub new {	203	sub new {
197	my $class = shift;	204	my $class = shift;
198		205
199	my $self = bless {	206	my $self = bless {
200	x => 0,	207	x => "center",
201	y => 0,	208	y => "center",
202	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
203	can_events => 1,	212	can_events => 1,
204	@_	213	@_
205	}, $class;	214	}, $class;
		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
206		217
207	for (keys %$self) {	218	for (keys %$self) {
208	if (/^on_(.*)$/) {	219	if (/^on_(.*)$/) {
209	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
210	}	221	}
211	}	222	}
212		223
213	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
214
215	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
216	$self->{req_x} = $layout->{x} * $::WIDTH;	225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
217	$self->{req_y} = $layout->{y} * $::HEIGHT;	226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
218	$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};
219	$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};
220	}	234	}
221		235
222	$self	236	$self
223	}	237	}
224		238
…		…
235	return if $self->{parent};	249	return if $self->{parent};
236		250
237	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
238	}	252	}
239		253
240	sub center {
241	my ($self) = @_;
242
243	$CFClient::UI::ROOT->on_post_alloc (
244	"center_$self" => sub {
245	$self->move (($self->{parent}{w} - $self->{w}) * 0.5, ($self->{parent}{h} - $self->{h}) * 0.5);
246	},
247	);
248
249	$self->update;
250	}
251
252	sub set_visible {	254	sub set_visible {
253	my ($self) = @_;	255	my ($self) = @_;
254		256
255	return if $self->{visible};	257	return if $self->{visible};
256		258
257	$self->{root} = $self->{parent}{root};	259	$self->{root} = $self->{parent}{root};
258	$self->{visible} = $self->{parent}{visible} + 1;	260	$self->{visible} = $self->{parent}{visible} + 1;
259		261
260	$self->emit (visibility_change => 1);	262	$self->emit (visibility_change => 1);
261		263
262	$self->realloc unless exists $self->{req_w};	264	$self->realloc if !exists $self->{req_w};
263		265
264	$_->set_visible for $self->children;	266	$_->set_visible for $self->children;
265	}	267	}
266		268
267	sub set_invisible {	269	sub set_invisible {
…		…
309		311
310	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
311	if $self->{parent};	313	if $self->{parent};
312	}	314	}
313		315
314	sub move {	316	sub move_abs {
315	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
316		318
317	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
318	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
319	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
320		322
321	$self->update;	323	$self->update;
322	}	324	}
323		325
324	sub set_size {	326	sub set_size {
325	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
326		328
327	$self->{def_w} = $w;	329	$self->{force_w} = $w;
328	$self->{def_h} = $h;	330	$self->{force_h} = $h;
329		331
330	$self->realloc;	332	$self->realloc;
331	}	333	}
332		334
333	sub size_request {	335	sub size_request {
…		…
337		339
338	sub configure {	340	sub configure {
339	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
340		342
341	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
342	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
343	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
344		348
345	# use alignment to adjust x, y	349	# use alignment to adjust x, y
346		350
347	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
348	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
349
350	($w, $h) = ($w2, $h2);
351	}	353	}
352		354
353	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
354	$self->{x} = $x;	356	$self->{x} = $x;
355	$self->{y} = $y;	357	$self->{y} = $y;
356	$self->update;	358	$self->update;
357	}	359	}
358		360
359	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
360	return unless $self->{visible};	362	return unless $self->{visible};
361		363
		364	$self->{alloc_w} = $w;
		365	$self->{alloc_h} = $h;
		366
362	$self->{root}->{size_alloc}{$self+0} = [$self, $w, $h];	367	$self->{root}{size_alloc}{$self+0} = $self;
363	}	368	}
364	}	369	}
365		370
366	sub size_allocate {	371	sub size_allocate {
367	# nothing to be done	372	# nothing to be done
…		…
434		439
435	$::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
436	unless $FOCUS;	441	unless $FOCUS;
437	}	442	}
438		443
439	sub mouse_motion { }	444	sub mouse_motion { 0 }
440	sub button_up { }	445	sub button_up { 0 }
441	sub key_down { }	446	sub key_down { 0 }
442	sub key_up { }	447	sub key_up { 0 }
443		448
444	sub button_down {	449	sub button_down {
445	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
446		451
447	$self->focus_in;	452	$self->focus_in;
448	}
449		453
450	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	454	0
451	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	455	}
452	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
453	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
454	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
455		456
456	sub find_widget {	457	sub find_widget {
457	my ($self, $x, $y) = @_;	458	my ($self, $x, $y) = @_;
458		459
459	return () unless $self->{can_events};	460	return () unless $self->{can_events};
…		…
467		468
468	sub set_parent {	469	sub set_parent {
469	my ($self, $parent) = @_;	470	my ($self, $parent) = @_;
470		471
471	Scalar::Util::weaken ($self->{parent} = $parent);	472	Scalar::Util::weaken ($self->{parent} = $parent);
472
473	$self->set_visible if $parent->{visible};	473	$self->set_visible if $parent->{visible};
474
475	$self->realloc;
476	}	474	}
477		475
478	sub connect {	476	sub connect {
479	my ($self, $signal, $cb) = @_;	477	my ($self, $signal, $cb) = @_;
480		478
…		…
499	}	497	}
500		498
501	sub realloc {	499	sub realloc {
502	my ($self) = @_;	500	my ($self) = @_;
503		501
504	return unless $self->{visible};	502	if ($self->{visible}) {
505
506	return if $self->{root}{realloc}{$self};	503	return if $self->{root}{realloc}{$self+0};
507		504
508	$self->{root}{realloc}{$self} = $self;	505	$self->{root}{realloc}{$self+0} = $self;
509	$self->{root}->update;	506	$self->{root}->update;
		507	} else {
		508	delete $self->{req_w};
		509	delete $self->{req_h};
		510	}
510	}	511	}
511		512
512	sub update {	513	sub update {
513	my ($self) = @_;	514	my ($self) = @_;
514		515
515	$self->{parent}->update	516	$self->{parent}->update
516	if $self->{parent};	517	if $self->{parent};
517	}	518	}
518		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
519	sub draw {	531	sub draw {
520	my ($self) = @_;	532	my ($self) = @_;
521		533
522	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);
523		545
524	glPushMatrix;	546	glPushMatrix;
525	glTranslate $self->{x}, $self->{y}, 0;	547	glTranslate $self->{x}, $self->{y}, 0;
526	$self->_draw;	548	$self->_draw;
527	glPopMatrix;	549	glPopMatrix;
…		…
539	glVertex $x , $y + $self->{h};	561	glVertex $x , $y + $self->{h};
540	glEnd;	562	glEnd;
541	glDisable GL_BLEND;	563	glDisable GL_BLEND;
542	}	564	}
543		565
544	if ($ENV{PCLIENT_DEBUG}) {	566	if ($ENV{CFPLUS_DEBUG} & 1) {
545	glPushMatrix;	567	glPushMatrix;
546	glColor 1, 1, 0, 1;	568	glColor 1, 1, 0, 1;
547	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	569	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
548	glBegin GL_LINE_LOOP;	570	glBegin GL_LINE_LOOP;
549	glVertex 0 , 0;	571	glVertex 0 , 0;
…		…
625	my ($class, %arg) = @_;	647	my ($class, %arg) = @_;
626	$class->SUPER::new (can_events => 0, %arg);	648	$class->SUPER::new (can_events => 0, %arg);
627	}	649	}
628		650
629	sub size_request {	651	sub size_request {
630	(0, 0)	652	my ($self) = @_;
		653
		654	($self->{w} + 0, $self->{h} + 0)
631	}	655	}
632		656
633	sub draw { }	657	sub draw { }
634		658
635	#############################################################################	659	#############################################################################
…		…
756	sub size_request {	780	sub size_request {
757	$_[0]{children}[0]->size_request	781	$_[0]{children}[0]->size_request
758	}	782	}
759		783
760	sub size_allocate {	784	sub size_allocate {
761	my ($self, $w, $h, $changed) = @_;	785	my ($self, $w, $h) = @_;
762		786
763	$self->{children}[0]->configure (0, 0, $w, $h);	787	$self->{children}[0]->configure (0, 0, $w, $h);
764	}	788	}
765		789
766	#############################################################################	790	#############################################################################
…		…
783	$ROOT->on_post_alloc ($self => sub { $self->render_child });	807	$ROOT->on_post_alloc ($self => sub { $self->render_child });
784	$self->SUPER::update;	808	$self->SUPER::update;
785	}	809	}
786		810
787	sub size_allocate {	811	sub size_allocate {
788	my ($self, $w, $h, $changed) = @_;	812	my ($self, $w, $h) = @_;
789		813
790	$self->SUPER::size_allocate ($w, $h, $changed);	814	$self->SUPER::size_allocate ($w, $h);
791	$self->update	815	$self->update;
792	if $changed;
793	}	816	}
794		817
795	sub _render {	818	sub _render {
		819	my ($self) = @_;
		820
796	$_[0]{children}[0]->draw;	821	$self->{children}[0]->draw;
797	}	822	}
798		823
799	sub render_child {	824	sub render_child {
800	my ($self) = @_;	825	my ($self) = @_;
801		826
802	$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 {
803	glClearColor 0, 0, 0, 0;	828	glClearColor 0, 0, 0, 0;
804	glClear GL_COLOR_BUFFER_BIT;	829	glClear GL_COLOR_BUFFER_BIT;
805		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
806	$self->_render;	838	$self->_render;
807	};	839	};
808	}	840	}
809		841
810	sub _draw {	842	sub _draw {
811	my ($self) = @_;	843	my ($self) = @_;
812		844
813	my ($w, $h) = ($self->w, $self->h);	845	my ($w, $h) = @$self{qw(w h)};
814		846
815	my $tex = $self->{texture}	847	my $tex = $self->{texture}
816	or return;	848	or return;
817		849
818	glEnable GL_TEXTURE_2D;	850	glEnable GL_TEXTURE_2D;
…		…
841	}	873	}
842		874
843	sub size_request {	875	sub size_request {
844	my ($self) = @_;	876	my ($self) = @_;
845		877
846	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)};
847		879
848	$w = 10 if $self->{scroll_x};	880	$w = 10 if $self->{scroll_x};
849	$h = 10 if $self->{scroll_y};	881	$h = 10 if $self->{scroll_y};
850		882
851	($w, $h)	883	($w, $h)
852	}	884	}
853		885
854	sub size_allocate {	886	sub size_allocate {
855	my ($self, $w, $h, $changed) = @_;	887	my ($self, $w, $h) = @_;
856		888
		889	my $child = $self->child;
		890
857	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	891	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
858	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	892	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
859		893
860	$self->child->configure (0, 0, $w, $h);	894	$self->child->configure (0, 0, $w, $h);
861	$self->update;	895	$self->update;
862	}	896	}
863		897
…		…
898	}	932	}
899	}	933	}
900		934
901	sub _render {	935	sub _render {
902	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};
903		940
904	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	941	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
905		942
906	$self->SUPER::_render;	943	$self->SUPER::_render;
907	}	944	}
…		…
947	my $child = $self->{vp}->child;	984	my $child = $self->{vp}->child;
948	$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]);
949	}	986	}
950		987
951	sub size_allocate {	988	sub size_allocate {
952	my ($self, $w, $h, $changed) = @_;	989	my ($self, $w, $h) = @_;
953		990
954	$self->SUPER::size_allocate ($w, $h, $changed);	991	$self->SUPER::size_allocate ($w, $h);
955		992
956	my $child = $self->{vp}->child;	993	my $child = $self->{vp}->child;
957	$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]);
958	}	995	}
959		996
…		…
1006		1043
1007	our @ISA = CFClient::UI::Bin::;	1044	our @ISA = CFClient::UI::Bin::;
1008		1045
1009	use CFClient::OpenGL;	1046	use CFClient::OpenGL;
1010		1047
1011	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 =
1012	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1053	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1013	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1054	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1014		1055
1015	sub new {	1056	sub new {
1016	my $class = shift;	1057	my ($class, %arg) = @_;
		1058
		1059	my $title = delete $arg{title};
1017		1060
1018	my $self = $class->SUPER::new (	1061	my $self = $class->SUPER::new (
1019	bg => [1, 1, 1, 1],	1062	bg => [1, 1, 1, 1],
1020	border_bg => [1, 1, 1, 1],	1063	border_bg => [1, 1, 1, 1],
1021	border => 0.6,	1064	border => 0.6,
1022	is_toplevel => 1,
1023	can_events => 1,	1065	can_events => 1,
1024	@_	1066	min_w => 16,
		1067	min_h => 16,
		1068	%arg,
1025	);	1069	);
1026		1070
1027	$self->{title} &&= new CFClient::UI::Label	1071	$self->{title} = new CFClient::UI::Label
1028	align => 0,	1072	align => 0,
1029	valign => 1,	1073	valign => 1,
1030	text => $self->{title},	1074	text => $title,
1031	fontsize => $self->{border};	1075	fontsize => $self->{border}
		1076	if defined $title;
1032		1077
1033	$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};
1034	}	1086	}
1035		1087
1036	sub border {	1088	sub border {
1037	int $_[0]{border} * $::FONTSIZE	1089	int $_[0]{border} * $::FONTSIZE
1038	}	1090	}
1039		1091
1040	sub size_request {	1092	sub size_request {
1041	my ($self) = @_;	1093	my ($self) = @_;
		1094
		1095	$self->{title}->size_request
		1096	if $self->{title};
1042		1097
1043	my ($w, $h) = $self->SUPER::size_request;	1098	my ($w, $h) = $self->SUPER::size_request;
1044		1099
1045	(	1100	(
1046	$w + $self->border * 2,	1101	$w + $self->border * 2,
1047	$h + $self->border * 2,	1102	$h + $self->border * 2,
1048	)	1103	)
1049	}	1104	}
1050		1105
1051	sub size_allocate {	1106	sub size_allocate {
1052	my ($self, $w, $h, $changed) = @_;	1107	my ($self, $w, $h) = @_;
1053		1108
1054	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	}
1055		1114
		1115	my $border = $self->border;
		1116
1056	$h -= List::Util::max 0, $self->border * 2;	1117	$h -= List::Util::max 0, $border * 2;
1057	$w -= List::Util::max 0, $self->border * 2;	1118	$w -= List::Util::max 0, $border * 2;
1058		1119
1059	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1060	if $self->{title};
1061
1062	$self->child->configure ($self->border, $self->border, $w, $h);	1120	$self->child->configure ($border, $border, $w, $h);
1063	}	1121	}
1064		1122
1065	sub button_down {	1123	sub button_down {
1066	my ($self, $ev, $x, $y) = @_;	1124	my ($self, $ev, $x, $y) = @_;
1067		1125
…		…
1083	my ($ev, $x, $y) = @_;	1141	my ($ev, $x, $y) = @_;
1084		1142
1085	my $dx = $ev->{x} - $ox;	1143	my $dx = $ev->{x} - $ox;
1086	my $dy = $ev->{y} - $oy;	1144	my $dy = $ev->{y} - $oy;
1087		1145
1088	$self->{user_x} = $wx + $dx * $mx;
1089	$self->{user_y} = $wy + $dy * $my;
1090	$self->{def_w} = $bw + $dx * ($mx ? -1 : 1);	1146	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1091	$self->{def_h} = $bh + $dy * ($my ? -1 : 1);	1147	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1092	$self->move ($self->{user_x}, $self->{user_y});	1148
1093	$self->realloc;	1149	$self->realloc;
		1150	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1094	};	1151	};
1095		1152
1096	} elsif ($lr ^ $td) {	1153	} elsif ($lr ^ $td) {
1097	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1154	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1098	my ($bx, $by) = ($self->{x}, $self->{y});	1155	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1100	$self->{motion} = sub {	1157	$self->{motion} = sub {
1101	my ($ev, $x, $y) = @_;	1158	my ($ev, $x, $y) = @_;
1102		1159
1103	($x, $y) = ($ev->{x}, $ev->{y});	1160	($x, $y) = ($ev->{x}, $ev->{y});
1104		1161
1105	$self->{user_x} = $bx + $x - $ox;	1162	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1106	$self->{user_y} = $by + $y - $oy;
1107
1108	$self->move ($self->{user_x}, $self->{user_y});
1109	$self->realloc;
1110	};	1163	};
		1164	} else {
		1165	return 0;
		1166	}
		1167
1111	}	1168	1
1112	}	1169	}
1113		1170
1114	sub button_up {	1171	sub button_up {
1115	my ($self, $ev, $x, $y) = @_;	1172	my ($self, $ev, $x, $y) = @_;
1116		1173
1117	delete $self->{motion};	1174	!!delete $self->{motion}
1118	}	1175	}
1119		1176
1120	sub mouse_motion {	1177	sub mouse_motion {
1121	my ($self, $ev, $x, $y) = @_;	1178	my ($self, $ev, $x, $y) = @_;
1122		1179
1123	$self->{motion}->($ev, $x, $y) if $self->{motion};	1180	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1181
		1182	!!$self->{motion}
1124	}	1183	}
1125		1184
1126	sub _draw {	1185	sub _draw {
1127	my ($self) = @_;	1186	my ($self) = @_;
1128		1187
		1188	my $child = $self->{children}[0];
		1189
1129	my ($w, $h ) = ($self->{w}, $self->{h});	1190	my ($w, $h ) = ($self->{w}, $self->{h});
1130	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1191	my ($cw, $ch) = ($child->{w}, $child->{h});
1131		1192
1132	glEnable GL_TEXTURE_2D;	1193	glEnable GL_TEXTURE_2D;
1133	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1194	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1134		1195
1135	my $border = $self->border;	1196	my $border = $self->border;
1136		1197
1137	glColor @{ $self->{border_bg} };	1198	glColor @{ $self->{border_bg} };
1138	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1199	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1139	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1200	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1140	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1201	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1141	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1202	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1142		1203
1143	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1204	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1144	my $bg = $tex[0];	1205	glColor @{ $self->{bg} };
1145		1206
1146	# TODO: repeat texture not scale	1207	# TODO: repeat texture not scale
		1208	# solve this better(?)
1147	my $rep_x = $cw / $bg->{w};	1209	$bg->{s} = $cw / $bg->{w};
1148	my $rep_y = $ch / $bg->{h};	1210	$bg->{t} = $ch / $bg->{h};
1149
1150	glColor @{ $self->{bg} };
1151
1152	$bg->{s} = $rep_x;
1153	$bg->{t} = $rep_y;
1154	$bg->{wrap_mode} = 1;
1155	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1211	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1156	}	1212	}
1157		1213
1158	glDisable GL_TEXTURE_2D;	1214	glDisable GL_TEXTURE_2D;
1159		1215
1160	$self->{title}->draw if $self->{title};
1161
1162	$self->child->draw;	1216	$child->draw;
		1217
		1218	if ($self->{title}) {
		1219	glTranslate 0, $border - $self->{h};
		1220	$self->{title}->_draw;
		1221	}
1163	}	1222	}
1164		1223
1165	#############################################################################	1224	#############################################################################
1166		1225
1167	package CFClient::UI::Table;	1226	package CFClient::UI::Table;
…		…
1241	(sum @$hs),	1300	(sum @$hs),
1242	)	1301	)
1243	}	1302	}
1244		1303
1245	sub size_allocate {	1304	sub size_allocate {
1246	my ($self, $w, $h, $changed) = @_;	1305	my ($self, $w, $h) = @_;
1247		1306
1248	my ($ws, $hs) = $self->get_wh;	1307	my ($ws, $hs) = $self->get_wh;
1249		1308
1250	my $req_w = (sum @$ws) || 1;	1309	my $req_w = (sum @$ws) || 1;
1251	my $req_h = (sum @$hs) || 1;	1310	my $req_h = (sum @$hs) || 1;
…		…
1329	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1388	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1330	)	1389	)
1331	}	1390	}
1332		1391
1333	sub size_allocate {	1392	sub size_allocate {
1334	my ($self, $w, $h, $changed) = @_;	1393	my ($self, $w, $h) = @_;
1335		1394
1336	my $space = $self->{vertical} ? $h : $w;	1395	my $space = $self->{vertical} ? $h : $w;
1337	my $children = $self->{children};	1396	my $children = $self->{children};
1338		1397
1339	my @req;	1398	my @req;
…		…
1422	ellipsise => 3, # end	1481	ellipsise => 3, # end
1423	layout => (new CFClient::Layout),	1482	layout => (new CFClient::Layout),
1424	fontsize => 1,	1483	fontsize => 1,
1425	align => -1,	1484	align => -1,
1426	valign => -1,	1485	valign => -1,
1427	padding => 2,	1486	padding_x => 2,
		1487	padding_y => 2,
1428	can_events => 0,	1488	can_events => 0,
1429	%arg	1489	%arg
1430	);	1490	);
1431		1491
1432	if (exists $self->{template}) {	1492	if (exists $self->{template}) {
…		…
1469		1529
1470	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1530	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1471	$self->{layout}->set_text ($text);	1531	$self->{layout}->set_text ($text);
1472		1532
1473	$self->realloc;	1533	$self->realloc;
		1534	$self->update;
1474	}	1535	}
1475		1536
1476	sub set_markup {	1537	sub set_markup {
1477	my ($self, $markup) = @_;	1538	my ($self, $markup) = @_;
1478		1539
…		…
1483		1544
1484	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1545	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1485	$self->{layout}->set_markup ($markup);	1546	$self->{layout}->set_markup ($markup);
1486		1547
1487	$self->realloc;	1548	$self->realloc;
		1549	$self->update;
1488	}	1550	}
1489		1551
1490	sub size_request {	1552	sub size_request {
1491	my ($self) = @_;	1553	my ($self) = @_;
1492		1554
…		…
1506		1568
1507	$w = List::Util::max $w, $w2;	1569	$w = List::Util::max $w, $w2;
1508	$h = List::Util::max $h, $h2;	1570	$h = List::Util::max $h, $h2;
1509	}	1571	}
1510		1572
1511	(	1573	($w, $h)
1512	$w + $self->{padding} * 2,
1513	$h + $self->{padding} * 2,
1514	)
1515	}	1574	}
1516		1575
1517	sub size_allocate {	1576	sub size_allocate {
1518	my ($self, $w, $h, $changed) = @_;	1577	my ($self, $w, $h) = @_;
		1578
		1579	delete $self->{ox};
1519		1580
1520	delete $self->{texture}	1581	delete $self->{texture}
1521	if $changed;	1582	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1522	}	1583	}
1523		1584
1524	sub set_fontsize {	1585	sub set_fontsize {
1525	my ($self, $fontsize) = @_;	1586	my ($self, $fontsize) = @_;
1526		1587
…		…
1541	$self->{layout}->set_width ($self->{w});	1602	$self->{layout}->set_width ($self->{w});
1542	$self->{layout}->set_ellipsise ($self->{ellipsise});	1603	$self->{layout}->set_ellipsise ($self->{ellipsise});
1543	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1604	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1544	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1605	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1545		1606
1546	my $tex = new_from_layout CFClient::Texture $self->{layout};	1607	new_from_layout CFClient::Texture $self->{layout}
		1608	};
1547		1609
		1610	unless (exists $self->{ox}) {
1548	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1611	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1549	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1612	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1550	: ($self->{w} - $tex->{w}) * 0.5);	1613	: ($self->{w} - $tex->{w}) * 0.5);
1551		1614
1552	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1615	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1553	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1616	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1554	: ($self->{h} - $tex->{h}) * 0.5);	1617	: ($self->{h} - $tex->{h}) * 0.5);
1555
1556	$tex
1557	};	1618	};
1558		1619
1559	glEnable GL_TEXTURE_2D;	1620	glEnable GL_TEXTURE_2D;
1560	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1621	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1561		1622
…		…
1656	$self->{cursor} = length $text;	1717	$self->{cursor} = length $text;
1657	} elsif ($uni == 27) {	1718	} elsif ($uni == 27) {
1658	$self->_emit ('escape');	1719	$self->_emit ('escape');
1659	} elsif ($uni) {	1720	} elsif ($uni) {
1660	substr $text, $self->{cursor}++, 0, chr $uni;	1721	substr $text, $self->{cursor}++, 0, chr $uni;
		1722	} else {
		1723	return 0;
1661	}	1724	}
1662		1725
1663	$self->_set_text ($text);	1726	$self->_set_text ($text);
1664		1727
1665	$self->realloc;	1728	$self->realloc;
		1729
		1730	1
1666	}	1731	}
1667		1732
1668	sub focus_in {	1733	sub focus_in {
1669	my ($self) = @_;	1734	my ($self) = @_;
1670		1735
…		…
1685	utf8::encode $text;	1750	utf8::encode $text;
1686	$self->{cursor} = length substr $text, 0, $idx;	1751	$self->{cursor} = length substr $text, 0, $idx;
1687		1752
1688	$self->_set_text ($self->{text});	1753	$self->_set_text ($self->{text});
1689	$self->update;	1754	$self->update;
		1755
		1756	1
1690	}	1757	}
1691		1758
1692	sub mouse_motion {	1759	sub mouse_motion {
1693	my ($self, $ev, $x, $y) = @_;	1760	my ($self, $ev, $x, $y) = @_;
1694	# 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
1695	}	1764	}
1696		1765
1697	sub _draw {	1766	sub _draw {
1698	my ($self) = @_;	1767	my ($self) = @_;
1699		1768
…		…
1776	} else {	1845	} else {
1777	$self->set_text ($self->{history_saveback});	1846	$self->set_text ($self->{history_saveback});
1778	}	1847	}
1779		1848
1780	} else {	1849	} else {
1781	$self->SUPER::key_down ($ev);	1850	return $self->SUPER::key_down ($ev)
		1851	}
		1852
1782	}	1853	1
1783
1784	}	1854	}
1785		1855
1786	#############################################################################	1856	#############################################################################
1787		1857
1788	package CFClient::UI::Button;	1858	package CFClient::UI::Button;
…		…
1797		1867
1798	sub new {	1868	sub new {
1799	my $class = shift;	1869	my $class = shift;
1800		1870
1801	$class->SUPER::new (	1871	$class->SUPER::new (
1802	padding => 4,	1872	padding_x => 4,
		1873	padding_y => 4,
1803	fg => [1, 1, 1],	1874	fg => [1, 1, 1],
1804	active_fg => [0, 0, 1],	1875	active_fg => [0, 0, 1],
1805	can_hover => 1,	1876	can_hover => 1,
1806	align => 0,	1877	align => 0,
1807	valign => 0,	1878	valign => 0,
…		…
1816	my ($self, $ev, $x, $y) = @_;	1887	my ($self, $ev, $x, $y) = @_;
1817		1888
1818	$self->emit ("activate")	1889	$self->emit ("activate")
1819	if $x >= 0 && $x < $self->{w}	1890	if $x >= 0 && $x < $self->{w}
1820	&& $y >= 0 && $y < $self->{h};	1891	&& $y >= 0 && $y < $self->{h};
		1892
		1893	1
1821	}	1894	}
1822		1895
1823	sub _draw {	1896	sub _draw {
1824	my ($self) = @_;	1897	my ($self) = @_;
1825		1898
…		…
1854		1927
1855	sub new {	1928	sub new {
1856	my $class = shift;	1929	my $class = shift;
1857		1930
1858	$class->SUPER::new (	1931	$class->SUPER::new (
1859	padding => 2,	1932	padding_x => 2,
		1933	padding_y => 2,
1860	fg => [1, 1, 1],	1934	fg => [1, 1, 1],
1861	active_fg => [1, 1, 0],	1935	active_fg => [1, 1, 0],
1862	bg => [0, 0, 0, 0.2],	1936	bg => [0, 0, 0, 0.2],
1863	active_bg => [1, 1, 1, 0.5],	1937	active_bg => [1, 1, 1, 0.5],
1864	state => 0,	1938	state => 0,
…		…
1868	}	1942	}
1869		1943
1870	sub size_request {	1944	sub size_request {
1871	my ($self) = @_;	1945	my ($self) = @_;
1872		1946
1873	($self->{padding} * 2 + 6) x 2	1947	(6) x 2
1874	}	1948	}
1875		1949
1876	sub button_down {	1950	sub button_down {
1877	my ($self, $ev, $x, $y) = @_;	1951	my ($self, $ev, $x, $y) = @_;
1878		1952
1879	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1953	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1880	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1954	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1881	$self->{state} = !$self->{state};	1955	$self->{state} = !$self->{state};
1882	$self->_emit (changed => $self->{state});	1956	$self->_emit (changed => $self->{state});
		1957	} else {
		1958	return 0
		1959	}
		1960
1883	}	1961	1
1884	}	1962	}
1885		1963
1886	sub _draw {	1964	sub _draw {
1887	my ($self) = @_;	1965	my ($self) = @_;
1888		1966
1889	$self->SUPER::_draw;	1967	$self->SUPER::_draw;
1890		1968
1891	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1969	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1892		1970
1893	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;
1894		1974
1895	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1975	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1896		1976
1897	my $tex = $self->{state} ? $tex[1] : $tex[0];	1977	my $tex = $self->{state} ? $tex[1] : $tex[0];
1898		1978
…		…
2163	fg => [1, 1, 1],	2243	fg => [1, 1, 1],
2164	active_fg => [0, 0, 0],	2244	active_fg => [0, 0, 0],
2165	bg => [0, 0, 0, 0.2],	2245	bg => [0, 0, 0, 0.2],
2166	active_bg => [1, 1, 1, 0.5],	2246	active_bg => [1, 1, 1, 0.5],
2167	range => [0, 0, 100, 10, 0],	2247	range => [0, 0, 100, 10, 0],
2168	req_w => $::WIDTH / 80,	2248	min_w => $::WIDTH / 80,
2169	req_h => $::WIDTH / 80,	2249	min_h => $::WIDTH / 80,
2170	vertical => 0,	2250	vertical => 0,
2171	can_hover => 1,	2251	can_hover => 1,
2172	inner_pad => 0.02,	2252	inner_pad => 0.02,
2173	@_	2253	@_
2174	);	2254	);
…		…
2214	}	2294	}
2215		2295
2216	sub size_request {	2296	sub size_request {
2217	my ($self) = @_;	2297	my ($self) = @_;
2218		2298
2219	my $w = $self->{req_w};	2299	($self->{req_w}, $self->{req_h})
2220	my $h = $self->{req_h};
2221
2222	$self->{vertical} ? ($h, $w) : ($w, $h)
2223	}	2300	}
2224		2301
2225	sub button_down {	2302	sub button_down {
2226	my ($self, $ev, $x, $y) = @_;	2303	my ($self, $ev, $x, $y) = @_;
2227		2304
2228	$self->SUPER::button_down ($ev, $x, $y);	2305	$self->SUPER::button_down ($ev, $x, $y);
2229		2306
2230	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2307	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2231		2308
2232	$self->mouse_motion ($ev, $x, $y);	2309	$self->mouse_motion ($ev, $x, $y)
2233	}	2310	}
2234		2311
2235	sub mouse_motion {	2312	sub mouse_motion {
2236	my ($self, $ev, $x, $y) = @_;	2313	my ($self, $ev, $x, $y) = @_;
2237		2314
…		…
2241	my (undef, $lo, $hi, $page) = @{$self->{range}};	2318	my (undef, $lo, $hi, $page) = @{$self->{range}};
2242		2319
2243	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2320	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2244		2321
2245	$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
2246	}	2327	1
2247	}	2328	}
2248		2329
2249	sub update {	2330	sub update {
2250	my ($self) = @_;	2331	my ($self) = @_;
2251		2332
…		…
2377	$self->{fontsize} = $fontsize;	2458	$self->{fontsize} = $fontsize;
2378	$self->reflow;	2459	$self->reflow;
2379	}	2460	}
2380		2461
2381	sub size_allocate {	2462	sub size_allocate {
2382	my ($self, $w, $h, $changed) = @_;	2463	my ($self, $w, $h) = @_;
2383		2464
2384	$self->SUPER::size_allocate ($w, $h, $changed);	2465	$self->SUPER::size_allocate ($w, $h);
2385
2386	return unless $changed;
2387		2466
2388	$self->{layout}->set_font ($self->{font}) if $self->{font};	2467	$self->{layout}->set_font ($self->{font}) if $self->{font};
2389	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2468	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2390	$self->{layout}->set_width ($self->{children}[0]{w});	2469	$self->{layout}->set_width ($self->{children}[0]{w});
2391		2470
…		…
2614	}	2693	}
2615		2694
2616	sub set_tooltip_from {	2695	sub set_tooltip_from {
2617	my ($self, $widget) = @_;	2696	my ($self, $widget) = @_;
2618		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
2619	$self->add (new CFClient::UI::Label	2707	$self->add (new CFClient::UI::Label
2620	markup => $widget->{tooltip},	2708	markup => $tooltip,
2621	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2709	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2622	fontsize => 0.8,	2710	fontsize => 0.8,
2623	fg => [0, 0, 0, 1],	2711	fg => [0, 0, 0, 1],
2624	ellipsise => 0,	2712	ellipsise => 0,
2625	font => ($widget->{tooltip_font} || $::FONT_PROP),	2713	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2633		2721
2634	($w + 4, $h + 4)	2722	($w + 4, $h + 4)
2635	}	2723	}
2636		2724
2637	sub size_allocate {	2725	sub size_allocate {
2638	my ($self, $w, $h, $changed) = @_;	2726	my ($self, $w, $h) = @_;
2639		2727
2640	return unless $changed;
2641
2642	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2728	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2729	}
		2730
		2731	sub visibility_change {
		2732	my ($self, $visible) = @_;
		2733
		2734	return unless $visible;
		2735
		2736	$self->{root}->on_post_alloc ("move_$self" => sub {
		2737	my $widget = $self->{owner}
		2738	or return;
		2739
		2740	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2741
		2742	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2743	if $x + $self->{w} > $::WIDTH;
		2744
		2745	$self->move_abs ($x, $y);
		2746	});
2643	}	2747	}
2644		2748
2645	sub _draw {	2749	sub _draw {
2646	my ($self) = @_;	2750	my ($self) = @_;
2647		2751
…		…
2664	glVertex $w, $h;	2768	glVertex $w, $h;
2665	glVertex $w, 0;	2769	glVertex $w, 0;
2666	glEnd;	2770	glEnd;
2667		2771
2668	glTranslate 2 - 0.375, 2 - 0.375;	2772	glTranslate 2 - 0.375, 2 - 0.375;
		2773
2669	$self->SUPER::_draw;	2774	$self->SUPER::_draw;
2670	}	2775	}
2671		2776
2672	#############################################################################	2777	#############################################################################
2673		2778
…		…
2749	$self->SUPER::DESTROY;	2854	$self->SUPER::DESTROY;
2750	}	2855	}
2751		2856
2752	#############################################################################	2857	#############################################################################
2753		2858
2754	package CFClient::UI::Inventory;
2755
2756	our @ISA = CFClient::UI::ScrolledWindow::;
2757
2758	sub new {
2759	my $class = shift;
2760
2761	my $self = $class->SUPER::new (
2762	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2763	@_,
2764	);
2765
2766	$self
2767	}
2768
2769	sub set_items {
2770	my ($self, $items) = @_;
2771
2772	$self->{scrolled}->clear;
2773	return unless $items;
2774
2775	my @items = sort {
2776	($a->{type} <=> $b->{type})
2777	or ($a->{name} cmp $b->{name})
2778	} @$items;
2779
2780	$self->{real_items} = \@items;
2781
2782	my $row = 0;
2783	for my $item (@items) {
2784	CFClient::Item::update_widgets $item;
2785
2786	$self->{scrolled}->add (0, $row, $item->{face_widget});
2787	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2788	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2789
2790	$row++;
2791	}
2792	}
2793
2794	#############################################################################
2795
2796	package CFClient::UI::Menu;	2859	package CFClient::UI::Menu;
2797		2860
2798	our @ISA = CFClient::UI::FancyFrame::;	2861	our @ISA = CFClient::UI::FancyFrame::;
2799		2862
2800	use CFClient::OpenGL;	2863	use CFClient::OpenGL;
…		…
2838	# maybe save $GRAB? must be careful about events...	2901	# maybe save $GRAB? must be careful about events...
2839	$GRAB = $self;	2902	$GRAB = $self;
2840	$self->{button} = $ev->{button};	2903	$self->{button} = $ev->{button};
2841		2904
2842	$self->show;	2905	$self->show;
2843	$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);
2844	}	2907	}
2845		2908
2846	sub mouse_motion {	2909	sub mouse_motion {
2847	my ($self, $ev, $x, $y) = @_;	2910	my ($self, $ev, $x, $y) = @_;
2848		2911
2849	# TODO: should use vbox->find_widget or so	2912	# TODO: should use vbox->find_widget or so
2850	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2913	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2851	$self->{hover} = $self->{item}{$HOVER};	2914	$self->{hover} = $self->{item}{$HOVER};
		2915
		2916	0
2852	}	2917	}
2853		2918
2854	sub button_up {	2919	sub button_up {
2855	my ($self, $ev, $x, $y) = @_;	2920	my ($self, $ev, $x, $y) = @_;
2856		2921
…		…
2858	undef $GRAB;	2923	undef $GRAB;
2859	$self->hide;	2924	$self->hide;
2860		2925
2861	$self->_emit ("popdown");	2926	$self->_emit ("popdown");
2862	$self->{hover}[1]->() if $self->{hover};	2927	$self->{hover}[1]->() if $self->{hover};
		2928	} else {
		2929	return 0
		2930	}
		2931
2863	}	2932	1
2864	}	2933	}
2865		2934
2866	#############################################################################	2935	#############################################################################
2867		2936
2868	package CFClient::UI::Statusbox;	2937	package CFClient::UI::Statusbox;
…		…
2973	$self->SUPER::reconfigure;	3042	$self->SUPER::reconfigure;
2974	}	3043	}
2975		3044
2976	#############################################################################	3045	#############################################################################
2977		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
2978	package CFClient::UI::Root;	3343	package CFClient::UI::Root;
2979		3344
2980	our @ISA = CFClient::UI::Container::;	3345	our @ISA = CFClient::UI::Container::;
2981		3346
2982	use CFClient::OpenGL;	3347	use CFClient::OpenGL;
…		…
2992	Scalar::Util::weaken ($self->{root} = $self);	3357	Scalar::Util::weaken ($self->{root} = $self);
2993		3358
2994	$self	3359	$self
2995	}	3360	}
2996		3361
2997	sub configure {
2998	my ($self, $x, $y, $w, $h) = @_;
2999
3000	$self->{w} = $w;
3001	$self->{h} = $h;
3002	}
3003
3004	sub reconfigure {
3005	my ($self) = @_;
3006
3007	$self->SUPER::reconfigure;
3008
3009	$self->size_allocate ($self->{w}, $self->{h}, 1)
3010	if $self->{w};
3011	}
3012
3013	sub size_request {	3362	sub size_request {
3014	my ($self) = @_;	3363	my ($self) = @_;
3015		3364
3016	($self->{w}, $self->{h})	3365	($self->{w}, $self->{h})
3017	}	3366	}
3018		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
3019	sub size_allocate {	3382	sub size_allocate {
3020	my ($self, $w, $h, $changed) = @_;	3383	my ($self, $w, $h) = @_;
3021		3384
3022	for my $child ($self->children) {	3385	for my $child ($self->children) {
3023	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)};
3024		3387
3025	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3388	$X = $child->{force_x} if exists $child->{force_x};
3026	if exists $child->{req_x};	3389	$Y = $child->{force_y} if exists $child->{force_y};
3027		3390
3028	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3391	$X = _to_pixel $X, $W, $self->{w};
3029	if exists $child->{req_y};	3392	$Y = _to_pixel $Y, $H, $self->{h};
3030
3031	#delete @$child{qw(req_x req_y)};#d# def_x, def_y
3032
3033	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3034	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3035		3393
3036	$child->configure ($X, $Y, $W, $H);	3394	$child->configure ($X, $Y, $W, $H);
3037	}	3395	}
3038	}	3396	}
3039		3397
…		…
3056	}	3414	}
3057		3415
3058	sub add {	3416	sub add {
3059	my ($self, @children) = @_;	3417	my ($self, @children) = @_;
3060		3418
3061	for my $child (@children) {
3062	$child->{is_toplevel} = 1;	3419	$_->{is_toplevel} = 1
3063		3420	for @children;
3064	# integerise window positions
3065	$child->{x} = int $child->{x};
3066	$child->{y} = int $child->{y};
3067	}
3068		3421
3069	$self->SUPER::add (@children);	3422	$self->SUPER::add (@children);
3070	}	3423	}
3071		3424
3072	sub remove {	3425	sub remove {
3073	my ($self, @children) = @_;	3426	my ($self, @children) = @_;
3074		3427
3075	$self->SUPER::remove (@children);	3428	$self->SUPER::remove (@children);
		3429
		3430	delete $self->{is_toplevel}
		3431	for @children;
3076		3432
3077	while (@children) {	3433	while (@children) {
3078	my $w = pop @children;	3434	my $w = pop @children;
3079	push @children, $w->children;	3435	push @children, $w->children;
3080	$w->set_invisible;	3436	$w->set_invisible;
…		…
3100	$_->()	3456	$_->()
3101	for values %{delete $self->{refresh_hook}};	3457	for values %{delete $self->{refresh_hook}};
3102	}	3458	}
3103		3459
3104	if ($self->{realloc}) {	3460	if ($self->{realloc}) {
		3461	my %queue;
3105	my @queue;	3462	my @queue;
		3463	my $widget;
3106		3464
		3465	outer:
3107	while () {	3466	while () {
3108	if ($self->{realloc}) {	3467	if (my $realloc = delete $self->{realloc}) {
3109	#TODO use array-of-depth approach	3468	for $widget (values %$realloc) {
		3469	$widget->{visible} or next; # do not resize invisible widgets
3110		3470
3111	@queue = sort { $a->{visible} <=> $b->{visible} }	3471	$queue{$widget+0}++ and next; # duplicates are common
3112	@queue, values %{delete $self->{realloc}};	3472
		3473	push @{ $queue[$widget->{visible}] }, $widget;
		3474	}
3113	}	3475	}
3114		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 () {
3115	my $widget = pop @queue || last;	3521	my $widget = pop @queue || last;
3116		3522
3117	$widget->{visible} or last; # do not resize invisible widgets	3523	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3118
3119	my ($w, $h) = $widget->{def_w} && $widget->{def_h}
3120	? @$widget{qw(def_w def_h)}
3121	: $widget->size_request;
3122
3123	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3124
3125	$widget->{req_w} = $w;
3126	$widget->{req_h} = $h;
3127
3128	$self->{size_alloc}{$widget} = [$widget, $widget->{w}, $widget->{h}];
3129
3130	push @queue, $widget->{parent}
3131	if $widget->{parent};
3132	}
3133	}
3134
3135	while (my $size_alloc = delete $self->{size_alloc}) {
3136	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},
3137	values %$size_alloc;
3138
3139	while () {
3140	my ($widget, $w, $h) = @{ pop @queue or last };
3141		3524
3142	$w = 0 if $w < 0;	3525	$w = 0 if $w < 0;
3143	$h = 0 if $h < 0;	3526	$h = 0 if $h < 0;
3144		3527
		3528	$w = int $w + 0.5;
		3529	$h = int $h + 0.5;
		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
3145	$widget->{w} = $w;	3535	$widget->{w} = $w;
3146	$widget->{h} = $h;	3536	$widget->{h} = $h;
		3537
3147	$widget->emit (size_allocate => $w, $h, 1);	3538	$widget->emit (size_allocate => $w, $h);
		3539	}
3148	}	3540	}
3149	}	3541	}
3150		3542
3151	while ($self->{post_alloc_hook}) {	3543	while ($self->{post_alloc_hook}) {
3152	$_->()	3544	$_->()
3153	for values %{delete $self->{post_alloc_hook}};	3545	for values %{delete $self->{post_alloc_hook}};
3154	}	3546	}
		3547
3155		3548
3156	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3549	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3157	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3550	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3158	glClear GL_COLOR_BUFFER_BIT;	3551	glClear GL_COLOR_BUFFER_BIT;
3159		3552
…		…
3161	glLoadIdentity;	3554	glLoadIdentity;
3162	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3555	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3163	glMatrixMode GL_MODELVIEW;	3556	glMatrixMode GL_MODELVIEW;
3164	glLoadIdentity;	3557	glLoadIdentity;
3165		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
3166	$self->_draw;	3566	$self->_draw;
3167	}	3567	}
3168		3568
3169	#############################################################################	3569	#############################################################################
3170		3570

Diff Legend

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