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.250 by root, Sun May 28 02:31:03 2006 UTC vs.
Revision 1.269 by root, Fri Jun 2 06:22:55 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->check_size;
61	$TOOLTIP->update;
62	}	61	}
63		62
64	return;	63	return;
65	}	64	}
66	}	65	}
…		…
172	sub rescale_widgets {	171	sub rescale_widgets {
173	my ($sx, $sy) = @_;	172	my ($sx, $sy) = @_;
174		173
175	for my $widget (values %WIDGET) {	174	for my $widget (values %WIDGET) {
176	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
177	$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.]+$/;
178	$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};
179	$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};
180	$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.]+$/;
181	$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};
182	$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
183	}	189	}
184	}	190	}
185		191
186	reconfigure_widgets;	192	reconfigure_widgets;
187	}	193	}
…		…
196		202
197	sub new {	203	sub new {
198	my $class = shift;	204	my $class = shift;
199		205
200	my $self = bless {	206	my $self = bless {
201	x => 0,	207	x => "center",
202	y => 0,	208	y => "center",
203	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
204	can_events => 1,	212	can_events => 1,
205	@_	213	@_
206	}, $class;	214	}, $class;
		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
207		217
208	for (keys %$self) {	218	for (keys %$self) {
209	if (/^on_(.*)$/) {	219	if (/^on_(.*)$/) {
210	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
211	}	221	}
212	}	222	}
213		223
214	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
215
216	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
217	$self->{req_x} = $layout->{x} * $::WIDTH;	225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
218	$self->{req_y} = $layout->{y} * $::HEIGHT;	226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
219	$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};
220	$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};
221	}	234	}
222		235
223	$self	236	$self
224	}	237	}
225		238
…		…
236	return if $self->{parent};	249	return if $self->{parent};
237		250
238	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
239	}	252	}
240		253
241	sub center {
242	my ($self) = @_;
243
244	$CFClient::UI::ROOT->on_post_alloc (
245	"center_$self" => sub {
246	$self->move (($self->{parent}{w} - $self->{w}) * 0.5, ($self->{parent}{h} - $self->{h}) * 0.5);
247	},
248	);
249
250	$self->update;
251	}
252
253	sub set_visible {	254	sub set_visible {
254	my ($self) = @_;	255	my ($self) = @_;
255		256
256	return if $self->{visible};	257	return if $self->{visible};
257		258
258	$self->{root} = $self->{parent}{root};	259	$self->{root} = $self->{parent}{root};
259	$self->{visible} = $self->{parent}{visible} + 1;	260	$self->{visible} = $self->{parent}{visible} + 1;
260		261
261	$self->emit (visibility_change => 1);	262	$self->emit (visibility_change => 1);
		263
		264	$self->realloc if !exists $self->{req_w};
		265
		266	$_->set_visible for $self->children;
262	}	267	}
263		268
264	sub set_invisible {	269	sub set_invisible {
265	my ($self) = @_;	270	my ($self) = @_;
266		271
267	return unless $self->{visible};	272	return unless $self->{visible};
268		273
269	# broken show/hide model	274	$_->set_invisible for $self->children;
270		275
271	delete $self->{root};	276	delete $self->{root};
272	delete $self->{visible};	277	delete $self->{visible};
273		278
274	undef $GRAB if $GRAB == $self;	279	undef $GRAB if $GRAB == $self;
275	undef $HOVER if $HOVER == $self;	280	undef $HOVER if $HOVER == $self;
276		281
277	CFClient::UI::check_tooltip	282	CFClient::UI::check_tooltip
278	if $CFClient::UI::TOOLTIP->{owner} == $self;	283	if $TOOLTIP->{owner} == $self;
279		284
280	$self->focus_out;	285	$self->focus_out;
281		286
282	$self->emit (visibility_change => 0);	287	$self->emit (visibility_change => 0);
283	}	288	}
…		…
306		311
307	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
308	if $self->{parent};	313	if $self->{parent};
309	}	314	}
310		315
311	sub move {	316	sub move_abs {
312	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
313		318
314	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
315	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
316	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
317		322
318	$self->update;	323	$self->update;
319	}	324	}
320		325
321	sub set_size {	326	sub set_size {
322	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
323		328
324	$self->{def_w} = $w;	329	$self->{force_w} = $w;
325	$self->{def_h} = $h;	330	$self->{force_h} = $h;
326		331
327	$self->check_size;	332	$self->realloc;
328	}	333	}
329		334
330	sub size_request {	335	sub size_request {
331	require Carp;	336	require Carp;
332	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
334		339
335	sub configure {	340	sub configure {
336	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
337		342
338	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
339	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
340	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
341		348
342	# use alignment to adjust x, y	349	# use alignment to adjust x, y
343		350
344	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
345	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
346
347	($w, $h) = ($w2, $h2);
348	}	353	}
349		354
350	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
351	$self->{x} = $x;	356	$self->{x} = $x;
352	$self->{y} = $y;	357	$self->{y} = $y;
353	$self->update;	358	$self->update;
354	}	359	}
355		360
356	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
357	$CFClient::UI::ROOT->{size_alloc}{$self+0} = [$self, $w, $h];	362	return unless $self->{visible};
		363
		364	$self->{alloc_w} = $w;
		365	$self->{alloc_h} = $h;
		366
		367	$self->{root}{size_alloc}{$self+0} = $self;
358	}	368	}
359	}	369	}
360		370
361	sub size_allocate {	371	sub size_allocate {
362	# nothing to be done	372	# nothing to be done
363	}
364
365	sub reconfigure {
366	my ($self) = @_;
367
368	$self->check_size (1);
369	$self->update;
370	}	373	}
371		374
372	sub children {	375	sub children {
373	}	376	}
374		377
…		…
447	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
448		451
449	$self->focus_in;	452	$self->focus_in;
450	}	453	}
451		454
452	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	455	sub find_widget {
453	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	456	my ($self, $x, $y) = @_;
454	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	457
455	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	458	return () unless $self->{can_events};
456	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	459
		460	return $self
		461	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		462	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		463
		464	()
		465	}
		466
		467	sub set_parent {
		468	my ($self, $parent) = @_;
		469
		470	Scalar::Util::weaken ($self->{parent} = $parent);
		471	$self->set_visible if $parent->{visible};
		472	}
		473
		474	sub connect {
		475	my ($self, $signal, $cb) = @_;
		476
		477	push @{ $self->{signal_cb}{$signal} }, $cb;
		478	}
		479
		480	sub _emit {
		481	my ($self, $signal, @args) = @_;
		482
		483	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		484	}
		485
		486	sub emit {
		487	my ($self, $signal, @args) = @_;
		488
		489	$self->_emit ($signal, @args)
		490	|| $self->$signal (@args);
		491	}
		492
		493	sub visibility_change {
		494	#my ($self, $visible) = @_;
		495	}
		496
		497	sub realloc {
		498	my ($self) = @_;
		499
		500	if ($self->{visible}) {
		501	return if $self->{root}{realloc}{$self+0};
		502
		503	$self->{root}{realloc}{$self+0} = $self;
		504	$self->{root}->update;
		505	} else {
		506	delete $self->{req_w};
		507	delete $self->{req_h};
		508	}
		509	}
		510
		511	sub update {
		512	my ($self) = @_;
		513
		514	$self->{parent}->update
		515	if $self->{parent};
		516	}
		517
		518	sub reconfigure {
		519	my ($self) = @_;
		520
		521	$self->realloc;
		522	$self->update;
		523	}
		524
		525	# using global variables seems a bit hacky, but passing through all drawing
		526	# functions seems pointless.
		527	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
457		528
458	sub draw {	529	sub draw {
459	my ($self) = @_;	530	my ($self) = @_;
460		531
461	return unless $self->{h} && $self->{w};	532	return unless $self->{h} && $self->{w};
		533
		534	# update screen rectangle
		535	local $draw_x = $draw_x + $self->{x};
		536	local $draw_y = $draw_y + $self->{y};
		537	local $draw_w = $draw_x + $self->{w};
		538	local $draw_h = $draw_y + $self->{h};
		539
		540	# skip widgets that are entirely outside the drawing area
		541	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		542	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
462		543
463	glPushMatrix;	544	glPushMatrix;
464	glTranslate $self->{x}, $self->{y}, 0;	545	glTranslate $self->{x}, $self->{y}, 0;
465	$self->_draw;	546	$self->_draw;
466	glPopMatrix;	547	glPopMatrix;
…		…
478	glVertex $x , $y + $self->{h};	559	glVertex $x , $y + $self->{h};
479	glEnd;	560	glEnd;
480	glDisable GL_BLEND;	561	glDisable GL_BLEND;
481	}	562	}
482		563
483	if ($ENV{PCLIENT_DEBUG}) {	564	if ($ENV{CFPLUS_DEBUG} & 1) {
484	glPushMatrix;	565	glPushMatrix;
485	glColor 1, 1, 0, 1;	566	glColor 1, 1, 0, 1;
486	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	567	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
487	glBegin GL_LINE_LOOP;	568	glBegin GL_LINE_LOOP;
488	glVertex 0 , 0;	569	glVertex 0 , 0;
…		…
499	my ($self) = @_;	580	my ($self) = @_;
500		581
501	warn "no draw defined for $self\n";	582	warn "no draw defined for $self\n";
502	}	583	}
503		584
504	sub find_widget {
505	my ($self, $x, $y) = @_;
506
507	return () unless $self->{can_events};
508
509	return $self
510	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
511	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
512
513	()
514	}
515
516	sub set_parent {
517	my ($self, $parent) = @_;
518
519	Scalar::Util::weaken ($self->{parent} = $parent);
520
521	$self->set_visible; #TODO why breakssssss borked damn if $parent->{visible};
522
523	$self->check_size;
524	}
525
526	sub check_size {
527	my ($self, $forced) = @_;
528
529	$self->{force_alloc} = 1 if $forced;
530	$CFClient::UI::ROOT->{check_size}{$self} = $self;
531	}
532
533	sub update {
534	my ($self) = @_;
535
536	$self->{parent}->update
537	if $self->{parent};
538	}
539
540	sub connect {
541	my ($self, $signal, $cb) = @_;
542
543	push @{ $self->{signal_cb}{$signal} }, $cb;
544	}
545
546	sub _emit {
547	my ($self, $signal, @args) = @_;
548
549	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
550	}
551
552	sub emit {
553	my ($self, $signal, @args) = @_;
554
555	$self->_emit ($signal, @args)
556	|| $self->$signal (@args);
557	}
558
559	sub visibility_change {
560	#my ($self, $visible) = @_;
561	}
562
563	sub DESTROY {	585	sub DESTROY {
564	my ($self) = @_;	586	my ($self) = @_;
565		587
566	delete $WIDGET{$self+0};	588	delete $WIDGET{$self+0};
567	#$self->deactivate;	589	#$self->deactivate;
…		…
623	my ($class, %arg) = @_;	645	my ($class, %arg) = @_;
624	$class->SUPER::new (can_events => 0, %arg);	646	$class->SUPER::new (can_events => 0, %arg);
625	}	647	}
626		648
627	sub size_request {	649	sub size_request {
628	(0, 0)	650	my ($self) = @_;
		651
		652	($self->{w} + 0, $self->{h} + 0)
629	}	653	}
630		654
631	sub draw { }	655	sub draw { }
632		656
633	#############################################################################	657	#############################################################################
…		…
662	$self->{children} = [	686	$self->{children} = [
663	sort { $a->{z} <=> $b->{z} }	687	sort { $a->{z} <=> $b->{z} }
664	@{$self->{children}}, @widgets	688	@{$self->{children}}, @widgets
665	];	689	];
666		690
667	$self->check_size (1);	691	$self->realloc;
668	$self->update;
669	}	692	}
670		693
671	sub children {	694	sub children {
672	@{ $_[0]{children} }	695	@{ $_[0]{children} }
673	}	696	}
…		…
678	delete $child->{parent};	701	delete $child->{parent};
679	$child->hide;	702	$child->hide;
680		703
681	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	704	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
682		705
683	$self->check_size (1);	706	$self->realloc;
684	$self->update;
685	}	707	}
686		708
687	sub clear {	709	sub clear {
688	my ($self) = @_;	710	my ($self) = @_;
689		711
…		…
693	for (@$children) {	715	for (@$children) {
694	delete $_->{parent};	716	delete $_->{parent};
695	$_->hide;	717	$_->hide;
696	}	718	}
697		719
698	$self->check_size;	720	$self->realloc;
699	$self->update;
700	}	721	}
701		722
702	sub find_widget {	723	sub find_widget {
703	my ($self, $x, $y) = @_;	724	my ($self, $x, $y) = @_;
704		725
…		…
791	$self->SUPER::size_allocate ($w, $h);	812	$self->SUPER::size_allocate ($w, $h);
792	$self->update;	813	$self->update;
793	}	814	}
794		815
795	sub _render {	816	sub _render {
		817	my ($self) = @_;
		818
796	$_[0]{children}[0]->draw;	819	$self->{children}[0]->draw;
797	}	820	}
798		821
799	sub render_child {	822	sub render_child {
800	my ($self) = @_;	823	my ($self) = @_;
801		824
802	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	825	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
803	glClearColor 0, 0, 0, 0;	826	glClearColor 0, 0, 0, 0;
804	glClear GL_COLOR_BUFFER_BIT;	827	glClear GL_COLOR_BUFFER_BIT;
805		828
		829	{
		830	package CFClient::UI::Base;
		831
		832	($draw_x, $draw_y, $draw_w, $draw_h) =
		833	(0, 0, $self->{w}, $self->{h});
		834	}
		835
806	$self->_render;	836	$self->_render;
807	};	837	};
808	}	838	}
809		839
810	sub _draw {	840	sub _draw {
811	my ($self) = @_;	841	my ($self) = @_;
812		842
813	my ($w, $h) = ($self->w, $self->h);	843	my ($w, $h) = @$self{qw(w h)};
814		844
815	my $tex = $self->{texture}	845	my $tex = $self->{texture}
816	or return;	846	or return;
817		847
818	glEnable GL_TEXTURE_2D;	848	glEnable GL_TEXTURE_2D;
…		…
841	}	871	}
842		872
843	sub size_request {	873	sub size_request {
844	my ($self) = @_;	874	my ($self) = @_;
845		875
846	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	876	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
847		877
848	$w = 10 if $self->{scroll_x};	878	$w = 10 if $self->{scroll_x};
849	$h = 10 if $self->{scroll_y};	879	$h = 10 if $self->{scroll_y};
850		880
851	($w, $h)	881	($w, $h)
852	}	882	}
853		883
854	sub size_allocate {	884	sub size_allocate {
855	my ($self, $w, $h) = @_;	885	my ($self, $w, $h) = @_;
856		886
		887	my $child = $self->child;
		888
857	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	889	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
858	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	890	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
859		891
860	$self->child->configure (0, 0, $w, $h);	892	$self->child->configure (0, 0, $w, $h);
861	$self->update;	893	$self->update;
862	}	894	}
863		895
…		…
898	}	930	}
899	}	931	}
900		932
901	sub _render {	933	sub _render {
902	my ($self) = @_;	934	my ($self) = @_;
		935
		936	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		937	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
903		938
904	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	939	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
905		940
906	$self->SUPER::_render;	941	$self->SUPER::_render;
907	}	942	}
…		…
1006		1041
1007	our @ISA = CFClient::UI::Bin::;	1042	our @ISA = CFClient::UI::Bin::;
1008		1043
1009	use CFClient::OpenGL;	1044	use CFClient::OpenGL;
1010		1045
1011	my @tex =	1046	my $bg =
		1047	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1048	mipmap => 1, wrap => 1;
		1049
		1050	my @border =
1012	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1051	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);	1052	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1014		1053
1015	sub new {	1054	sub new {
1016	my $class = shift;	1055	my ($class, %arg) = @_;
		1056
		1057	my $title = delete $arg{title};
1017		1058
1018	my $self = $class->SUPER::new (	1059	my $self = $class->SUPER::new (
1019	bg => [1, 1, 1, 1],	1060	bg => [1, 1, 1, 1],
1020	border_bg => [1, 1, 1, 1],	1061	border_bg => [1, 1, 1, 1],
1021	border => 0.6,	1062	border => 0.6,
1022	is_toplevel => 1,
1023	can_events => 1,	1063	can_events => 1,
1024	@_	1064	min_w => 16,
		1065	min_h => 16,
		1066	%arg,
1025	);	1067	);
1026		1068
1027	$self->{title} &&= new CFClient::UI::Label	1069	$self->{title} = new CFClient::UI::Label
1028	align => 0,	1070	align => 0,
1029	valign => 1,	1071	valign => 1,
1030	text => $self->{title},	1072	text => $title,
1031	fontsize => $self->{border};	1073	fontsize => $self->{border}
		1074	if defined $title;
1032		1075
1033	$self	1076	$self
		1077	}
		1078
		1079	sub add {
		1080	my ($self, @widgets) = @_;
		1081
		1082	$self->SUPER::add (@widgets);
		1083	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
1034	}	1084	}
1035		1085
1036	sub border {	1086	sub border {
1037	int $_[0]{border} * $::FONTSIZE	1087	int $_[0]{border} * $::FONTSIZE
1038	}	1088	}
1039		1089
1040	sub size_request {	1090	sub size_request {
1041	my ($self) = @_;	1091	my ($self) = @_;
		1092
		1093	$self->{title}->size_request
		1094	if $self->{title};
1042		1095
1043	my ($w, $h) = $self->SUPER::size_request;	1096	my ($w, $h) = $self->SUPER::size_request;
1044		1097
1045	(	1098	(
1046	$w + $self->border * 2,	1099	$w + $self->border * 2,
…		…
1049	}	1102	}
1050		1103
1051	sub size_allocate {	1104	sub size_allocate {
1052	my ($self, $w, $h) = @_;	1105	my ($self, $w, $h) = @_;
1053		1106
		1107	if ($self->{title}) {
		1108	$self->{title}{w} = $w;
		1109	$self->{title}{h} = $h;
		1110	$self->{title}->size_allocate ($w, $h);
		1111	}
		1112
		1113	my $border = $self->border;
		1114
1054	$h -= List::Util::max 0, $self->border * 2;	1115	$h -= List::Util::max 0, $border * 2;
1055	$w -= List::Util::max 0, $self->border * 2;	1116	$w -= List::Util::max 0, $border * 2;
1056		1117
1057	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1058	if $self->{title};
1059
1060	$self->child->configure ($self->border, $self->border, $w, $h);	1118	$self->child->configure ($border, $border, $w, $h);
1061	}	1119	}
1062		1120
1063	sub button_down {	1121	sub button_down {
1064	my ($self, $ev, $x, $y) = @_;	1122	my ($self, $ev, $x, $y) = @_;
1065		1123
…		…
1081	my ($ev, $x, $y) = @_;	1139	my ($ev, $x, $y) = @_;
1082		1140
1083	my $dx = $ev->{x} - $ox;	1141	my $dx = $ev->{x} - $ox;
1084	my $dy = $ev->{y} - $oy;	1142	my $dy = $ev->{y} - $oy;
1085		1143
1086	$self->{user_x} = $wx + $dx * $mx;
1087	$self->{user_y} = $wy + $dy * $my;
1088	$self->{def_w} = $bw + $dx * ($mx ? -1 : 1);	1144	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1089	$self->{def_h} = $bh + $dy * ($my ? -1 : 1);	1145	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1090	$self->move ($self->{user_x}, $self->{user_y});	1146
1091	$self->check_size;	1147	$self->realloc;
		1148	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1092	};	1149	};
1093		1150
1094	} elsif ($lr ^ $td) {	1151	} elsif ($lr ^ $td) {
1095	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1152	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1096	my ($bx, $by) = ($self->{x}, $self->{y});	1153	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1098	$self->{motion} = sub {	1155	$self->{motion} = sub {
1099	my ($ev, $x, $y) = @_;	1156	my ($ev, $x, $y) = @_;
1100		1157
1101	($x, $y) = ($ev->{x}, $ev->{y});	1158	($x, $y) = ($ev->{x}, $ev->{y});
1102		1159
1103	$self->{user_x} = $bx + $x - $ox;	1160	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1104	$self->{user_y} = $by + $y - $oy;
1105
1106	$self->move ($self->{user_x}, $self->{user_y});
1107	$self->update;
1108	};	1161	};
1109	}	1162	}
1110	}	1163	}
1111		1164
1112	sub button_up {	1165	sub button_up {
…		…
1122	}	1175	}
1123		1176
1124	sub _draw {	1177	sub _draw {
1125	my ($self) = @_;	1178	my ($self) = @_;
1126		1179
		1180	my $child = $self->{children}[0];
		1181
1127	my ($w, $h ) = ($self->{w}, $self->{h});	1182	my ($w, $h ) = ($self->{w}, $self->{h});
1128	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1183	my ($cw, $ch) = ($child->{w}, $child->{h});
1129		1184
1130	glEnable GL_TEXTURE_2D;	1185	glEnable GL_TEXTURE_2D;
1131	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1186	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1132		1187
1133	my $border = $self->border;	1188	my $border = $self->border;
1134		1189
1135	glColor @{ $self->{border_bg} };	1190	glColor @{ $self->{border_bg} };
1136	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1191	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1137	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1192	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1138	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1193	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1139	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1194	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1140		1195
1141	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1196	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1142	my $bg = $tex[0];	1197	glColor @{ $self->{bg} };
1143		1198
1144	# TODO: repeat texture not scale	1199	# TODO: repeat texture not scale
		1200	# solve this better(?)
1145	my $rep_x = $cw / $bg->{w};	1201	$bg->{s} = $cw / $bg->{w};
1146	my $rep_y = $ch / $bg->{h};	1202	$bg->{t} = $ch / $bg->{h};
1147
1148	glColor @{ $self->{bg} };
1149
1150	$bg->{s} = $rep_x;
1151	$bg->{t} = $rep_y;
1152	$bg->{wrap_mode} = 1;
1153	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1203	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1154	}	1204	}
1155		1205
1156	glDisable GL_TEXTURE_2D;	1206	glDisable GL_TEXTURE_2D;
1157		1207
1158	$self->{title}->draw if $self->{title};
1159
1160	$self->child->draw;	1208	$child->draw;
		1209
		1210	if ($self->{title}) {
		1211	glTranslate 0, $border - $self->{h};
		1212	$self->{title}->_draw;
		1213	}
1161	}	1214	}
1162		1215
1163	#############################################################################	1216	#############################################################################
1164		1217
1165	package CFClient::UI::Table;	1218	package CFClient::UI::Table;
…		…
1187	my ($self, $x, $y, $child) = @_;	1240	my ($self, $x, $y, $child) = @_;
1188		1241
1189	$child->set_parent ($self);	1242	$child->set_parent ($self);
1190	$self->{children}[$y][$x] = $child;	1243	$self->{children}[$y][$x] = $child;
1191		1244
1192	$self->check_size (1);	1245	$self->realloc;
1193	}	1246	}
1194		1247
1195	# TODO: move to container class maybe? send children a signal on removal?	1248	# TODO: move to container class maybe? send children a signal on removal?
1196	sub clear {	1249	sub clear {
1197	my ($self) = @_;	1250	my ($self) = @_;
…		…
1202	for (@children) {	1255	for (@children) {
1203	delete $_->{parent};	1256	delete $_->{parent};
1204	$_->hide;	1257	$_->hide;
1205	}	1258	}
1206		1259
1207	$self->check_size (1);	1260	$self->realloc;
1208	$self->update;
1209	}	1261	}
1210		1262
1211	sub get_wh {	1263	sub get_wh {
1212	my ($self) = @_;	1264	my ($self) = @_;
1213		1265
…		…
1421	ellipsise => 3, # end	1473	ellipsise => 3, # end
1422	layout => (new CFClient::Layout),	1474	layout => (new CFClient::Layout),
1423	fontsize => 1,	1475	fontsize => 1,
1424	align => -1,	1476	align => -1,
1425	valign => -1,	1477	valign => -1,
1426	padding => 2,	1478	padding_x => 2,
		1479	padding_y => 2,
1427	can_events => 0,	1480	can_events => 0,
1428	%arg	1481	%arg
1429	);	1482	);
1430		1483
1431	if (exists $self->{template}) {	1484	if (exists $self->{template}) {
…		…
1467	$self->{text} = "T$text";	1520	$self->{text} = "T$text";
1468		1521
1469	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1522	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1470	$self->{layout}->set_text ($text);	1523	$self->{layout}->set_text ($text);
1471		1524
		1525	$self->realloc;
1472	$self->update;	1526	$self->update;
1473	$self->check_size;
1474	}	1527	}
1475		1528
1476	sub set_markup {	1529	sub set_markup {
1477	my ($self, $markup) = @_;	1530	my ($self, $markup) = @_;
1478		1531
…		…
1482	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1535	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1483		1536
1484	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1537	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1485	$self->{layout}->set_markup ($markup);	1538	$self->{layout}->set_markup ($markup);
1486		1539
		1540	$self->realloc;
1487	$self->update;	1541	$self->update;
1488	$self->check_size;
1489	}	1542	}
1490		1543
1491	sub size_request {	1544	sub size_request {
1492	my ($self) = @_;	1545	my ($self) = @_;
1493		1546
…		…
1507		1560
1508	$w = List::Util::max $w, $w2;	1561	$w = List::Util::max $w, $w2;
1509	$h = List::Util::max $h, $h2;	1562	$h = List::Util::max $h, $h2;
1510	}	1563	}
1511		1564
1512	(	1565	($w, $h)
1513	$w + $self->{padding} * 2,
1514	$h + $self->{padding} * 2,
1515	)
1516	}	1566	}
1517		1567
1518	sub size_allocate {	1568	sub size_allocate {
1519	my ($self, $w, $h) = @_;	1569	my ($self, $w, $h) = @_;
1520		1570
		1571	delete $self->{ox};
		1572
1521	delete $self->{texture};	1573	delete $self->{texture}
		1574	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1522	}	1575	}
1523		1576
1524	sub set_fontsize {	1577	sub set_fontsize {
1525	my ($self, $fontsize) = @_;	1578	my ($self, $fontsize) = @_;
1526		1579
1527	$self->{fontsize} = $fontsize;	1580	$self->{fontsize} = $fontsize;
1528	delete $self->{texture};	1581	delete $self->{texture};
1529		1582
1530	$self->update;	1583	$self->realloc;
1531	$self->check_size;
1532	}	1584	}
1533		1585
1534	sub _draw {	1586	sub _draw {
1535	my ($self) = @_;	1587	my ($self) = @_;
1536		1588
…		…
1542	$self->{layout}->set_width ($self->{w});	1594	$self->{layout}->set_width ($self->{w});
1543	$self->{layout}->set_ellipsise ($self->{ellipsise});	1595	$self->{layout}->set_ellipsise ($self->{ellipsise});
1544	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1596	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1545	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1597	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1546		1598
1547	my $tex = new_from_layout CFClient::Texture $self->{layout};	1599	new_from_layout CFClient::Texture $self->{layout}
		1600	};
1548		1601
		1602	unless (exists $self->{ox}) {
1549	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1603	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1550	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1604	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1551	: ($self->{w} - $tex->{w}) * 0.5);	1605	: ($self->{w} - $tex->{w}) * 0.5);
1552		1606
1553	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1607	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1554	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1608	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1555	: ($self->{h} - $tex->{h}) * 0.5);	1609	: ($self->{h} - $tex->{h}) * 0.5);
1556
1557	$tex
1558	};	1610	};
1559		1611
1560	glEnable GL_TEXTURE_2D;	1612	glEnable GL_TEXTURE_2D;
1561	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1613	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1562		1614
…		…
1616	sub set_text {	1668	sub set_text {
1617	my ($self, $text) = @_;	1669	my ($self, $text) = @_;
1618		1670
1619	$self->{cursor} = length $text;	1671	$self->{cursor} = length $text;
1620	$self->_set_text ($text);	1672	$self->_set_text ($text);
1621	$self->update;	1673
1622	$self->check_size;	1674	$self->realloc;
1623	}	1675	}
1624		1676
1625	sub get_text {	1677	sub get_text {
1626	$_[0]{text}	1678	$_[0]{text}
1627	}	1679	}
…		…
1660	} elsif ($uni) {	1712	} elsif ($uni) {
1661	substr $text, $self->{cursor}++, 0, chr $uni;	1713	substr $text, $self->{cursor}++, 0, chr $uni;
1662	}	1714	}
1663		1715
1664	$self->_set_text ($text);	1716	$self->_set_text ($text);
1665	$self->update;	1717
1666	$self->check_size;	1718	$self->realloc;
1667	}	1719	}
1668		1720
1669	sub focus_in {	1721	sub focus_in {
1670	my ($self) = @_;	1722	my ($self) = @_;
1671		1723
…		…
1798		1850
1799	sub new {	1851	sub new {
1800	my $class = shift;	1852	my $class = shift;
1801		1853
1802	$class->SUPER::new (	1854	$class->SUPER::new (
1803	padding => 4,	1855	padding_x => 4,
		1856	padding_y => 4,
1804	fg => [1, 1, 1],	1857	fg => [1, 1, 1],
1805	active_fg => [0, 0, 1],	1858	active_fg => [0, 0, 1],
1806	can_hover => 1,	1859	can_hover => 1,
1807	align => 0,	1860	align => 0,
1808	valign => 0,	1861	valign => 0,
…		…
1855		1908
1856	sub new {	1909	sub new {
1857	my $class = shift;	1910	my $class = shift;
1858		1911
1859	$class->SUPER::new (	1912	$class->SUPER::new (
1860	padding => 2,	1913	padding_x => 2,
		1914	padding_y => 2,
1861	fg => [1, 1, 1],	1915	fg => [1, 1, 1],
1862	active_fg => [1, 1, 0],	1916	active_fg => [1, 1, 0],
1863	bg => [0, 0, 0, 0.2],	1917	bg => [0, 0, 0, 0.2],
1864	active_bg => [1, 1, 1, 0.5],	1918	active_bg => [1, 1, 1, 0.5],
1865	state => 0,	1919	state => 0,
…		…
1869	}	1923	}
1870		1924
1871	sub size_request {	1925	sub size_request {
1872	my ($self) = @_;	1926	my ($self) = @_;
1873		1927
1874	($self->{padding} * 2 + 6) x 2	1928	(6) x 2
1875	}	1929	}
1876		1930
1877	sub button_down {	1931	sub button_down {
1878	my ($self, $ev, $x, $y) = @_;	1932	my ($self, $ev, $x, $y) = @_;
1879		1933
1880	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1934	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1881	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1935	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1882	$self->{state} = !$self->{state};	1936	$self->{state} = !$self->{state};
1883	$self->_emit (changed => $self->{state});	1937	$self->_emit (changed => $self->{state});
1884	}	1938	}
1885	}	1939	}
1886		1940
1887	sub _draw {	1941	sub _draw {
1888	my ($self) = @_;	1942	my ($self) = @_;
1889		1943
1890	$self->SUPER::_draw;	1944	$self->SUPER::_draw;
1891		1945
1892	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1946	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1893		1947
1894	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1948	my ($w, $h) = @$self{qw(w h)};
		1949
		1950	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1895		1951
1896	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1952	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1897		1953
1898	my $tex = $self->{state} ? $tex[1] : $tex[0];	1954	my $tex = $self->{state} ? $tex[1] : $tex[0];
1899		1955
…		…
2164	fg => [1, 1, 1],	2220	fg => [1, 1, 1],
2165	active_fg => [0, 0, 0],	2221	active_fg => [0, 0, 0],
2166	bg => [0, 0, 0, 0.2],	2222	bg => [0, 0, 0, 0.2],
2167	active_bg => [1, 1, 1, 0.5],	2223	active_bg => [1, 1, 1, 0.5],
2168	range => [0, 0, 100, 10, 0],	2224	range => [0, 0, 100, 10, 0],
2169	req_w => $::WIDTH / 80,	2225	min_w => $::WIDTH / 80,
2170	req_h => $::WIDTH / 80,	2226	min_h => $::WIDTH / 80,
2171	vertical => 0,	2227	vertical => 0,
2172	can_hover => 1,	2228	can_hover => 1,
2173	inner_pad => 0.02,	2229	inner_pad => 0.02,
2174	@_	2230	@_
2175	);	2231	);
…		…
2178	$self->update;	2234	$self->update;
2179		2235
2180	$self	2236	$self
2181	}	2237	}
2182		2238
		2239	sub changed { }
		2240
2183	sub set_range {	2241	sub set_range {
2184	my ($self, $range) = @_;	2242	my ($self, $range) = @_;
2185		2243
2186	($range, $self->{range}) = ($self->{range}, $range);	2244	($range, $self->{range}) = ($self->{range}, $range);
2187		2245
…		…
2213	}	2271	}
2214		2272
2215	sub size_request {	2273	sub size_request {
2216	my ($self) = @_;	2274	my ($self) = @_;
2217		2275
2218	my $w = $self->{req_w};	2276	($self->{req_w}, $self->{req_h})
2219	my $h = $self->{req_h};
2220
2221	$self->{vertical} ? ($h, $w) : ($w, $h)
2222	}	2277	}
2223		2278
2224	sub button_down {	2279	sub button_down {
2225	my ($self, $ev, $x, $y) = @_;	2280	my ($self, $ev, $x, $y) = @_;
2226		2281
…		…
2611	}	2666	}
2612		2667
2613	sub set_tooltip_from {	2668	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2669	my ($self, $widget) = @_;
2615		2670
		2671	my $tooltip = $widget->{tooltip};
		2672
		2673	if ($ENV{CFPLUS_DEBUG} & 2) {
		2674	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2675	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2676	. "req $widget->{req_w} $widget->{req_h}\n"
		2677	. "visible $widget->{visible}";
		2678	}
		2679
2616	$self->add (new CFClient::UI::Label	2680	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2681	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2682	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2683	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2684	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2685	ellipsise => 0,
2622	font => ($widget->{tooltip_font} || $::FONT_PROP),	2686	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2633		2697
2634	sub size_allocate {	2698	sub size_allocate {
2635	my ($self, $w, $h) = @_;	2699	my ($self, $w, $h) = @_;
2636		2700
2637	$self->SUPER::size_allocate ($w - 4, $h - 4);	2701	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2702	}
		2703
		2704	sub visibility_change {
		2705	my ($self, $visible) = @_;
		2706
		2707	return unless $visible;
		2708
		2709	$self->{root}->on_post_alloc ("move_$self" => sub {
		2710	my $widget = $self->{owner}
		2711	or return;
		2712
		2713	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2714
		2715	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2716	if $x + $self->{w} > $::WIDTH;
		2717
		2718	$self->move_abs ($x, $y);
		2719	});
2638	}	2720	}
2639		2721
2640	sub _draw {	2722	sub _draw {
2641	my ($self) = @_;	2723	my ($self) = @_;
2642		2724
…		…
2659	glVertex $w, $h;	2741	glVertex $w, $h;
2660	glVertex $w, 0;	2742	glVertex $w, 0;
2661	glEnd;	2743	glEnd;
2662		2744
2663	glTranslate 2 - 0.375, 2 - 0.375;	2745	glTranslate 2 - 0.375, 2 - 0.375;
		2746
2664	$self->SUPER::_draw;	2747	$self->SUPER::_draw;
2665	}	2748	}
2666		2749
2667	#############################################################################	2750	#############################################################################
2668		2751
…		…
2744	$self->SUPER::DESTROY;	2827	$self->SUPER::DESTROY;
2745	}	2828	}
2746		2829
2747	#############################################################################	2830	#############################################################################
2748		2831
2749	package CFClient::UI::Inventory;
2750
2751	our @ISA = CFClient::UI::ScrolledWindow::;
2752
2753	sub new {
2754	my $class = shift;
2755
2756	my $self = $class->SUPER::new (
2757	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2758	@_,
2759	);
2760
2761	$self
2762	}
2763
2764	sub set_items {
2765	my ($self, $items) = @_;
2766
2767	$self->{scrolled}->clear;
2768	return unless $items;
2769
2770	my @items = sort {
2771	($a->{type} <=> $b->{type})
2772	or ($a->{name} cmp $b->{name})
2773	} @$items;
2774
2775	$self->{real_items} = \@items;
2776
2777	my $row = 0;
2778	for my $item (@items) {
2779	CFClient::Item::update_widgets $item;
2780
2781	$self->{scrolled}->add (0, $row, $item->{face_widget});
2782	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2783	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2784
2785	$row++;
2786	}
2787	}
2788
2789	#############################################################################
2790
2791	package CFClient::UI::Menu;	2832	package CFClient::UI::Menu;
2792		2833
2793	our @ISA = CFClient::UI::FancyFrame::;	2834	our @ISA = CFClient::UI::FancyFrame::;
2794		2835
2795	use CFClient::OpenGL;	2836	use CFClient::OpenGL;
…		…
2833	# maybe save $GRAB? must be careful about events...	2874	# maybe save $GRAB? must be careful about events...
2834	$GRAB = $self;	2875	$GRAB = $self;
2835	$self->{button} = $ev->{button};	2876	$self->{button} = $ev->{button};
2836		2877
2837	$self->show;	2878	$self->show;
2838	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2879	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2839	}	2880	}
2840		2881
2841	sub mouse_motion {	2882	sub mouse_motion {
2842	my ($self, $ev, $x, $y) = @_;	2883	my ($self, $ev, $x, $y) = @_;
2843		2884
…		…
2968	$self->SUPER::reconfigure;	3009	$self->SUPER::reconfigure;
2969	}	3010	}
2970		3011
2971	#############################################################################	3012	#############################################################################
2972		3013
2973	package CFClient::UI::Root;	3014	package CFClient::UI::Inventory;
2974		3015
2975	our @ISA = CFClient::UI::Container::;	3016	our @ISA = CFClient::UI::ScrolledWindow::;
2976
2977	use CFClient::OpenGL;
2978		3017
2979	sub new {	3018	sub new {
2980	my $class = shift;	3019	my $class = shift;
2981		3020
2982	$class->SUPER::new (	3021	my $self = $class->SUPER::new (
		3022	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3023	@_,
		3024	);
		3025
		3026	$self
		3027	}
		3028
		3029	sub set_items {
		3030	my ($self, $items) = @_;
		3031
		3032	$self->{scrolled}->clear;
		3033	return unless $items;
		3034
		3035	my @items = sort {
		3036	($a->{type} <=> $b->{type})
		3037	or ($a->{name} cmp $b->{name})
		3038	} @$items;
		3039
		3040	$self->{real_items} = \@items;
		3041
		3042	my $row = 0;
		3043	for my $item (@items) {
		3044	CFClient::Item::update_widgets $item;
		3045
		3046	$self->{scrolled}->add (0, $row, $item->{face_widget});
		3047	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		3048	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		3049
		3050	$row++;
		3051	}
		3052	}
		3053
		3054	#############################################################################
		3055
		3056	package CFClient::UI::BindEditor;
		3057
		3058	our @ISA = CFClient::UI::FancyFrame::;
		3059
		3060	sub new {
		3061	my $class = shift;
		3062
		3063	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3064
		3065	$self->add (my $vb = new CFClient::UI::VBox);
		3066
		3067
		3068	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3069	text => "start recording",
		3070	tooltip => "Start/Stops recording of actions."
		3071	."All subsequent actions after the recording started will be captured."
		3072	."The actions are displayed after the record was stopped."
		3073	."To bind the action you have to click on the 'Bind' button",
		3074	on_activate => sub {
		3075	unless ($self->{recording}) {
		3076	$self->start;
		3077	} else {
		3078	$self->stop;
		3079	}
		3080	});
		3081
		3082	$vb->add (new CFClient::UI::Label text => "Actions:");
		3083	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3084
		3085	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3086	$vb->add (my $hb = new CFClient::UI::HBox);
		3087	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3088	$hb->add (new CFClient::UI::Button
		3089	text => "bind",
		3090	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3091	on_activate => sub {
		3092	$self->ask_for_bind;
		3093	});
		3094
		3095	$vb->add (my $hb = new CFClient::UI::HBox);
		3096	$hb->add (new CFClient::UI::Button
		3097	text => "ok",
		3098	expand => 1,
		3099	tooltip => "This closes the binding editor and saves the binding",
		3100	on_activate => sub {
		3101	$self->hide;
		3102	$self->commit;
		3103	});
		3104
		3105	$hb->add (new CFClient::UI::Button
		3106	text => "cancel",
		3107	expand => 1,
		3108	tooltip => "This closes the binding editor without saving",
		3109	on_activate => sub {
		3110	$self->hide;
		3111	$self->{binding_cancel}->()
		3112	if $self->{binding_cancel};
		3113	});
		3114
		3115	$self->update_binding_widgets;
		3116
		3117	$self
		3118	}
		3119
		3120	sub commit {
		3121	my ($self) = @_;
		3122	my ($mod, $sym, $cmds) = $self->get_binding;
		3123	if ($sym != 0 && @$cmds > 0) {
		3124	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3125	."'. Don't forget 'Save Config'!");
		3126	$self->{binding_change}->($mod, $sym, $cmds)
		3127	if $self->{binding_change};
		3128	} else {
		3129	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3130	$self->{binding_cancel}->()
		3131	if $self->{binding_cancel};
		3132	}
		3133	}
		3134
		3135	sub start {
		3136	my ($self) = @_;
		3137
		3138	$self->{rec_btn}->set_text ("stop recording");
		3139	$self->{recording} = 1;
		3140	$self->clear_command_list;
		3141	$::CONN->start_record if $::CONN;
		3142	}
		3143
		3144	sub stop {
		3145	my ($self) = @_;
		3146
		3147	$self->{rec_btn}->set_text ("start recording");
		3148	$self->{recording} = 0;
		3149
		3150	my $rec;
		3151	$rec = $::CONN->stop_record if $::CONN;
		3152	return unless ref $rec eq 'ARRAY';
		3153	$self->set_command_list ($rec);
		3154	}
		3155
		3156	# if $commit is true, the binding will be set after the user entered a key combo
		3157	sub ask_for_bind {
		3158	my ($self, $commit) = @_;
		3159
		3160	CFClient::Binder::open_binding_dialog (sub {
		3161	my ($mod, $sym) = @_;
		3162	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3163	$self->update_binding_widgets;
		3164	$self->commit if $commit;
		3165	});
		3166	}
		3167
		3168	# $mod and $sym are the modifiers and key symbol
		3169	# $cmds is a array ref of strings (the commands)
		3170	# $cb is the callback that is executed on OK
		3171	# $ccb is the callback that is executed on CANCEL and
		3172	# when the binding was unsuccessful on OK
		3173	sub set_binding {
		3174	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3175
		3176	$self->clear_command_list;
		3177	$self->{recording} = 0;
		3178	$self->{rec_btn}->set_text ("start recording");
		3179
		3180	$self->{binding} = [$mod, $sym];
		3181	$self->{commands} = $cmds;
		3182
		3183	$self->{binding_change} = $cb;
		3184	$self->{binding_cancel} = $ccb;
		3185
		3186	$self->update_binding_widgets;
		3187	}
		3188
		3189	# this is a shortcut method that asks for a binding
		3190	# and then just binds it.
		3191	sub do_quick_binding {
		3192	my ($self, $cmds) = @_;
		3193	$self->set_binding (undef, undef, $cmds, sub {
		3194	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3195	});
		3196	$self->ask_for_bind (1);
		3197	}
		3198
		3199	sub update_binding_widgets {
		3200	my ($self) = @_;
		3201	my ($mod, $sym, $cmds) = $self->get_binding;
		3202	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3203	$self->set_command_list ($cmds);
		3204	}
		3205
		3206	sub get_binding {
		3207	my ($self) = @_;
		3208	return (
		3209	$self->{binding}->[0],
		3210	$self->{binding}->[1],
		3211	[ grep { defined $_ } @{$self->{commands}} ]
		3212	);
		3213	}
		3214
		3215	sub clear_command_list {
		3216	my ($self) = @_;
		3217	$self->{cmdbox}->clear ();
		3218	}
		3219
		3220	sub set_command_list {
		3221	my ($self, $cmds) = @_;
		3222
		3223	$self->{cmdbox}->clear ();
		3224	$self->{commands} = $cmds;
		3225
		3226	my $idx = 0;
		3227
		3228	for (@$cmds) {
		3229	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3230
		3231	my $i = $idx;
		3232	$hb->add (new CFClient::UI::Label text => $_);
		3233	$hb->add (new CFClient::UI::Button
		3234	text => "delete",
		3235	tooltip => "Deletes the action from the record",
		3236	on_activate => sub {
		3237	$self->{cmdbox}->remove ($hb);
		3238	$cmds->[$i] = undef;
		3239	});
		3240
		3241
		3242	$idx++
		3243	}
		3244	}
		3245
		3246	#############################################################################
		3247
		3248	package CFClient::UI::SpellList;
		3249
		3250	our @ISA = CFClient::UI::FancyFrame::;
		3251
		3252	sub new {
		3253	my $class = shift;
		3254
		3255	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3256
		3257	$self->add (new CFClient::UI::ScrolledWindow
		3258	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3259
		3260	$self;
		3261	}
		3262
		3263	# XXX: Do sorting? Argl...
		3264	sub add_spell {
		3265	my ($self, $spell) = @_;
		3266	$self->{spells}->{$spell->{name}} = $spell;
		3267
		3268	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3269	face => $spell->{face},
		3270	can_hover => 1,
		3271	can_events => 1,
		3272	tooltip => $spell->{message});
		3273
		3274	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3275	text => $spell->{name},
		3276	can_hover => 1,
		3277	can_events => 1,
		3278	tooltip => $spell->{message},
		3279	expand => 1);
		3280
		3281	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3282	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3283	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3284	expand => 1);
		3285
		3286	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3287	text => "bind to key",
		3288	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3289	}
		3290
		3291	sub rebuild_spell_list {
		3292	my ($self) = @_;
		3293	$self->{tbl_idx} = 0;
		3294	$self->add_spell ($_) for values %{$self->{spells}};
		3295	}
		3296
		3297	sub remove_spell {
		3298	my ($self, $spell) = @_;
		3299	delete $self->{spells}->{$spell->{name}};
		3300	$self->rebuild_spell_list;
		3301	}
		3302
		3303	#############################################################################
		3304
		3305	package CFClient::UI::Root;
		3306
		3307	our @ISA = CFClient::UI::Container::;
		3308
		3309	use CFClient::OpenGL;
		3310
		3311	sub new {
		3312	my $class = shift;
		3313
		3314	my $self = $class->SUPER::new (
2983	visible => 1,	3315	visible => 1,
2984	@_,	3316	@_,
2985	)	3317	);
2986	}
2987		3318
2988	sub configure {	3319	Scalar::Util::weaken ($self->{root} = $self);
2989	my ($self, $x, $y, $w, $h) = @_;
2990		3320
2991	$self->{w} = $w;	3321	$self
2992	$self->{h} = $h;
2993	}
2994
2995	sub check_size {
2996	my ($self) = @_;
2997
2998	$self->size_allocate ($self->{w}, $self->{h})
2999	if $self->{w};
3000	}	3322	}
3001		3323
3002	sub size_request {	3324	sub size_request {
3003	my ($self) = @_;	3325	my ($self) = @_;
3004		3326
3005	($self->{w}, $self->{h})	3327	($self->{w}, $self->{h})
		3328	}
		3329
		3330	sub _to_pixel {
		3331	my ($coord, $size, $max) = @_;
		3332
		3333	$coord =
		3334	$coord eq "center" ? ($max - $size) * 0.5
		3335	: $coord eq "max" ? $max
		3336	: $coord;
		3337
		3338	$coord = 0 if $coord < 0;
		3339	$coord = $max - $size if $coord > $max - $size;
		3340
		3341	int $coord + 0.5
3006	}	3342	}
3007		3343
3008	sub size_allocate {	3344	sub size_allocate {
3009	my ($self, $w, $h) = @_;	3345	my ($self, $w, $h) = @_;
3010		3346
3011	for my $child ($self->children) {	3347	for my $child ($self->children) {
3012	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3348	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3013		3349
3014	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3350	$X = $child->{force_x} if exists $child->{force_x};
3015	if exists $child->{req_x};	3351	$Y = $child->{force_y} if exists $child->{force_y};
3016		3352
3017	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3353	$X = _to_pixel $X, $W, $self->{w};
3018	if exists $child->{req_y};	3354	$Y = _to_pixel $Y, $H, $self->{h};
3019
3020	#delete @$child{qw(req_x req_y)};#d# def_x, def_y
3021
3022	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3023	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3024		3355
3025	$child->configure ($X, $Y, $W, $H);	3356	$child->configure ($X, $Y, $W, $H);
3026	}	3357	}
3027	}	3358	}
3028		3359
…		…
3039	}	3370	}
3040		3371
3041	sub update {	3372	sub update {
3042	my ($self) = @_;	3373	my ($self) = @_;
3043		3374
3044	$self->check_size;
3045	$::WANT_REFRESH++;	3375	$::WANT_REFRESH++;
3046	}	3376	}
3047		3377
3048	sub add {	3378	sub add {
3049	my ($self, @children) = @_;	3379	my ($self, @children) = @_;
3050		3380
3051	for my $child (@children) {
3052	$child->{is_toplevel} = 1;	3381	$_->{is_toplevel} = 1
3053		3382	for @children;
3054	# integerise window positions
3055	$child->{x} = int $child->{x};
3056	$child->{y} = int $child->{y};
3057	}
3058		3383
3059	$self->SUPER::add (@children);	3384	$self->SUPER::add (@children);
3060
3061	for (my @widgets = @children; my $w = pop @widgets; ) {
3062	push @widgets, $w->children;
3063	$w->set_visible;
3064	}
3065
3066	}	3385	}
3067		3386
3068	sub remove {	3387	sub remove {
3069	my ($self, @children) = @_;	3388	my ($self, @children) = @_;
3070		3389
3071	$self->SUPER::remove (@children);	3390	$self->SUPER::remove (@children);
		3391
		3392	delete $self->{is_toplevel}
		3393	for @children;
3072		3394
3073	while (@children) {	3395	while (@children) {
3074	my $w = pop @children;	3396	my $w = pop @children;
3075	push @children, $w->children;	3397	push @children, $w->children;
3076	$w->set_invisible;	3398	$w->set_invisible;
…		…
3095	while ($self->{refresh_hook}) {	3417	while ($self->{refresh_hook}) {
3096	$_->()	3418	$_->()
3097	for values %{delete $self->{refresh_hook}};	3419	for values %{delete $self->{refresh_hook}};
3098	}	3420	}
3099		3421
3100	if ($self->{check_size}) {	3422	if ($self->{realloc}) {
		3423	my %queue;
3101	my @queue;	3424	my @queue;
		3425	my $widget;
3102		3426
		3427	outer:
3103	while () {	3428	while () {
3104	if ($self->{check_size}) {	3429	if (my $realloc = delete $self->{realloc}) {
3105	#TODO use array-of-depth approach	3430	for $widget (values %$realloc) {
		3431	$widget->{visible} or next; # do not resize invisible widgets
3106		3432
3107	@queue = sort { $a->{visible} <=> $b->{visible} }	3433	$queue{$widget+0}++ and next; # duplicates are common
3108	@queue, values %{delete $self->{check_size}};	3434
		3435	push @{ $queue[$widget->{visible}] }, $widget;
		3436	}
3109	}	3437	}
3110		3438
		3439	while () {
		3440	@queue or last outer;
		3441
3111	my $widget = pop @queue || last;	3442	$widget = pop @{ $queue[-1] || [] }
3112		3443	and last;
3113	defined $widget->{visible} or last; # do not resize invisible widgets
3114
3115	my ($w, $h) = $widget->{def_w} && $widget->{def_h}
3116	? @$widget{qw(def_w def_h)}
3117	: $widget->size_request;
3118
3119	if (delete $widget->{force_alloc}
3120	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3121	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3122		3444
		3445	pop @queue;
		3446	}
		3447
		3448	delete $queue{$widget+0};
		3449
		3450	my ($w, $h) = $widget->size_request;
		3451
		3452	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3453	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3454
		3455	$w = $widget->{force_w} if exists $widget->{force_w};
		3456	$h = $widget->{force_h} if exists $widget->{force_h};
		3457
		3458	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3459	|| delete $widget->{force_realloc}) {
3123	$widget->{req_w} = $w;	3460	$widget->{req_w} = $w;
3124	$widget->{req_h} = $h;	3461	$widget->{req_h} = $h;
3125		3462
3126	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3463	$self->{size_alloc}{$widget+0} = $widget;
3127		3464
3128	$widget->{parent}->check_size
3129	if $widget->{parent};	3465	if (my $parent = $widget->{parent}) {
		3466	$self->{realloc}{$parent+0} = $parent
		3467	unless $queue{$parent+0};
		3468
		3469	$parent->{force_size_alloc} = 1;
		3470	$self->{size_alloc}{$parent+0} = $parent;
		3471	}
3130	}	3472	}
		3473
		3474	delete $self->{realloc}{$widget+0};
3131	}	3475	}
3132	}	3476	}
3133		3477
3134	while (my $size_alloc = delete $self->{size_alloc}) {	3478	while (my $size_alloc = delete $self->{size_alloc}) {
3135	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3479	my @queue = sort { $b->{visible} <=> $a->{visible} }
3136	values %$size_alloc;	3480	values %$size_alloc;
3137		3481
3138	while () {	3482	while () {
3139	my ($widget, $w, $h) = @{ pop @queue or last };	3483	my $widget = pop @queue || last;
		3484
		3485	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3140		3486
3141	$w = 0 if $w < 0;	3487	$w = 0 if $w < 0;
3142	$h = 0 if $h < 0;	3488	$h = 0 if $h < 0;
3143		3489
		3490	$w = int $w + 0.5;
		3491	$h = int $h + 0.5;
		3492
		3493	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3494	$widget->{old_w} = $widget->{w};
		3495	$widget->{old_h} = $widget->{h};
		3496
3144	$widget->{w} = $w;	3497	$widget->{w} = $w;
3145	$widget->{h} = $h;	3498	$widget->{h} = $h;
		3499
3146	$widget->emit (size_allocate => $w, $h);	3500	$widget->emit (size_allocate => $w, $h);
		3501	}
3147	}	3502	}
3148	}	3503	}
3149		3504
3150	while ($self->{post_alloc_hook}) {	3505	while ($self->{post_alloc_hook}) {
3151	$_->()	3506	$_->()
3152	for values %{delete $self->{post_alloc_hook}};	3507	for values %{delete $self->{post_alloc_hook}};
3153	}	3508	}
		3509
3154		3510
3155	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3511	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3156	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3512	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3157	glClear GL_COLOR_BUFFER_BIT;	3513	glClear GL_COLOR_BUFFER_BIT;
3158		3514
…		…
3160	glLoadIdentity;	3516	glLoadIdentity;
3161	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3517	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3162	glMatrixMode GL_MODELVIEW;	3518	glMatrixMode GL_MODELVIEW;
3163	glLoadIdentity;	3519	glLoadIdentity;
3164		3520
		3521	{
		3522	package CFClient::UI::Base;
		3523
		3524	($draw_x, $draw_y, $draw_w, $draw_h) =
		3525	(0, 0, $self->{w}, $self->{h});
		3526	}
		3527
3165	$self->_draw;	3528	$self->_draw;
3166	}	3529	}
3167		3530
3168	#############################################################################	3531	#############################################################################
3169		3532

Diff Legend

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