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.232 by root, Thu May 25 02:23:14 2006 UTC vs.
Revision 1.271 by root, Fri Jun 2 22:13:47 2006 UTC

…		…
5		5
6	use Scalar::Util ();	6	use Scalar::Util ();
7	use List::Util ();	7	use List::Util ();
8		8
9	use CFClient;	9	use CFClient;
		10	use CFClient::Texture;
10		11
11	our ($FOCUS, $HOVER, $GRAB); # various widgets	12	our ($FOCUS, $HOVER, $GRAB); # various widgets
12		13
		14	our $LAYOUT;
13	our $ROOT;	15	our $ROOT;
14	our $TOOLTIP;	16	our $TOOLTIP;
15	our $BUTTON_STATE;	17	our $BUTTON_STATE;
16		18
17	our %WIDGET; # all widgets, weak-referenced	19	our %WIDGET; # all widgets, weak-referenced
18		20
		21	sub get_layout {
		22	my $layout;
		23
		24	for (grep { $_->{name} } values %WIDGET) {
		25	my $win = $layout->{$_->{name}} = { };
		26
		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};
		31
		32	$win->{show} = $_->{visible} && $_->{is_toplevel};
		33	}
		34
		35	$layout
		36	}
		37
		38	sub set_layout {
		39	my ($layout) = @_;
		40
		41	$LAYOUT = $layout;
		42	}
		43
19	sub check_tooltip {	44	sub check_tooltip {
		45	return if $ENV{CFPLUS_DEBUG} & 8;
		46
20	if (!$GRAB) {	47	if (!$GRAB) {
21	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	48	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
22	if (length $widget->{tooltip}) {	49	if (length $widget->{tooltip}) {
23
24	if ($TOOLTIP->{owner} != $widget) {	50	if ($TOOLTIP->{owner} != $widget) {
		51	$TOOLTIP->hide;
		52
25	$TOOLTIP->{owner} = $widget;	53	$TOOLTIP->{owner} = $widget;
26		54
27	my $tip = $widget->{tooltip};	55	my $tip = $widget->{tooltip};
28		56
29	$tip = $tip->($widget) if CODE:: eq ref $tip;	57	$tip = $tip->($widget) if CODE:: eq ref $tip;
30		58
31	$TOOLTIP->set_tooltip_from ($widget);	59	$TOOLTIP->set_tooltip_from ($widget);
32	$TOOLTIP->show;	60	$TOOLTIP->show;
33
34	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
35
36	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
37	if $x + $TOOLTIP->{w} > $::WIDTH;
38
39	$TOOLTIP->move ($x, $y);
40	$TOOLTIP->check_size;
41	$TOOLTIP->update;
42	}	61	}
43		62
44	return;	63	return;
45	}	64	}
46	}	65	}
…		…
152	sub rescale_widgets {	171	sub rescale_widgets {
153	my ($sx, $sy) = @_;	172	my ($sx, $sy) = @_;
154		173
155	for my $widget (values %WIDGET) {	174	for my $widget (values %WIDGET) {
156	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
157	$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.]+$/;
158	$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};
159	$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};
160	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
161	$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.]+$/;
162	$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};
163	$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};
164	$widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_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
165	}	189	}
166	}	190	}
167		191
168	reconfigure_widgets;	192	reconfigure_widgets;
169	}	193	}
…		…
178		202
179	sub new {	203	sub new {
180	my $class = shift;	204	my $class = shift;
181		205
182	my $self = bless {	206	my $self = bless {
183	x => 0,	207	x => "center",
184	y => 0,	208	y => "center",
185	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
186	can_events => 1,	212	can_events => 1,
187	@_	213	@_
188	}, $class;	214	}, $class;
189		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		217
190	for (keys %$self) {	218	for (keys %$self) {
191	if (/^connect_(.*)$/) {	219	if (/^on_(.*)$/) {
192	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
193	}	221	}
194	}	222	}
195		223
196	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		227	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		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};
		234	}
197		235
198	$self	236	$self
199	}	237	}
200		238
201	sub destroy {	239	sub destroy {
…		…
205	%$self = ();	243	%$self = ();
206	}	244	}
207		245
208	sub show {	246	sub show {
209	my ($self) = @_;	247	my ($self) = @_;
		248
210	return if $self->{parent};	249	return if $self->{parent};
211		250
212	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
213	}	252	}
214		253
215	sub show_centered {	254	sub set_visible {
216	my ($self) = @_;	255	my ($self) = @_;
		256
217	return if $self->{parent};	257	return if $self->{visible};
218		258
219	$self->show;	259	$self->{root} = $self->{parent}{root};
		260	$self->{visible} = $self->{parent}{visible} + 1;
220		261
221	$CFClient::UI::ROOT->on_post_alloc (	262	$self->emit (visibility_change => 1);
222	"centered $self" => sub {	263
223	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);	264	$self->realloc if !exists $self->{req_w};
224	},	265
225	);	266	$_->set_visible for $self->children;
226	}	267	}
227		268
228	sub set_invisible {	269	sub set_invisible {
229	my ($self) = @_;	270	my ($self) = @_;
230		271
231	# broken show/hide model	272	return unless $self->{visible};
232		273
		274	$_->set_invisible for $self->children;
		275
		276	delete $self->{root};
233	delete $self->{visible};	277	delete $self->{visible};
234		278
235	undef $GRAB if $GRAB == $self;	279	undef $GRAB if $GRAB == $self;
236	undef $HOVER if $HOVER == $self;	280	undef $HOVER if $HOVER == $self;
237		281
238	CFClient::UI::check_tooltip	282	CFClient::UI::check_tooltip
239	if $CFClient::UI::TOOLTIP->{owner} == $self;	283	if $TOOLTIP->{owner} == $self;
240		284
241	$self->focus_out;	285	$self->focus_out;
		286
		287	$self->emit (visibility_change => 0);
		288	}
		289
		290	sub set_visibility {
		291	my ($self, $visible) = @_;
		292
		293	return if $self->{visible} == $visible;
		294
		295	$visible ? $self->hide
		296	: $self->show;
		297	}
		298
		299	sub toggle_visibility {
		300	my ($self) = @_;
		301
		302	$self->{visible}
		303	? $self->hide
		304	: $self->show;
242	}	305	}
243		306
244	sub hide {	307	sub hide {
245	my ($self) = @_;	308	my ($self) = @_;
246		309
…		…
248		311
249	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
250	if $self->{parent};	313	if $self->{parent};
251	}	314	}
252		315
253	sub move {	316	sub move_abs {
254	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
255		318
256	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
257	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
258	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
259		322
260	$self->update;	323	$self->update;
261	}	324	}
262		325
263	sub set_size {	326	sub set_size {
264	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
265		328
266	$self->{user_w} = $w;	329	$self->{force_w} = $w;
267	$self->{user_h} = $h;	330	$self->{force_h} = $h;
268		331
269	$self->check_size;	332	$self->realloc;
270	}	333	}
271		334
272	sub size_request {	335	sub size_request {
273	require Carp;	336	require Carp;
274	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
276		339
277	sub configure {	340	sub configure {
278	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
279		342
280	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
281	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
282	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
283		348
284	# use alignment to adjust x, y	349	# use alignment to adjust x, y
285		350
286	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
287	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
288
289	($w, $h) = ($w2, $h2);
290	}	353	}
291		354
292	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
293	$self->{x} = $x;	356	$self->{x} = $x;
294	$self->{y} = $y;	357	$self->{y} = $y;
295	$self->update;	358	$self->update;
296	}	359	}
297		360
298	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
299	$CFClient::UI::ROOT->{size_alloc}{$self} = [$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;
300	}	368	}
301	}	369	}
302		370
303	sub size_allocate {	371	sub size_allocate {
304	# nothing to be done	372	# nothing to be done
305	}	373	}
306		374
307	sub reconfigure {
308	my ($self) = @_;
309
310	$self->check_size (1);
311	$self->update;
312	}
313
314	sub children {	375	sub children {
315	}	376	}
316		377
317	sub set_max_size {	378	sub set_max_size {
318	my ($self, $w, $h) = @_;	379	my ($self, $w, $h) = @_;
…		…
321	delete $self->{max_h}; $self->{max_h} = $h if $h;	382	delete $self->{max_h}; $self->{max_h} = $h if $h;
322	}	383	}
323		384
324	sub set_tooltip {	385	sub set_tooltip {
325	my ($self, $tooltip) = @_;	386	my ($self, $tooltip) = @_;
		387
		388	$tooltip =~ s/^\s+//;
		389	$tooltip =~ s/\s+$//;
		390
		391	return if $self->{tooltip} eq $tooltip;
326		392
327	$self->{tooltip} = $tooltip;	393	$self->{tooltip} = $tooltip;
328		394
329	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	395	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
330	delete $CFClient::UI::TOOLTIP->{owner};	396	delete $CFClient::UI::TOOLTIP->{owner};
…		…
373		439
374	$::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
375	unless $FOCUS;	441	unless $FOCUS;
376	}	442	}
377		443
378	sub mouse_motion { }	444	sub mouse_motion { 0 }
379	sub button_up { }	445	sub button_up { 0 }
380	sub key_down { }	446	sub key_down { 0 }
381	sub key_up { }	447	sub key_up { 0 }
382		448
383	sub button_down {	449	sub button_down {
384	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
385		451
386	$self->focus_in;	452	$self->focus_in;
387	}
388		453
389	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	454	0
390	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	455	}
391	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	456
392	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	457	sub find_widget {
393	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	458	my ($self, $x, $y) = @_;
		459
		460	return () unless $self->{can_events};
		461
		462	return $self
		463	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		464	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		465
		466	()
		467	}
		468
		469	sub set_parent {
		470	my ($self, $parent) = @_;
		471
		472	Scalar::Util::weaken ($self->{parent} = $parent);
		473	$self->set_visible if $parent->{visible};
		474	}
		475
		476	sub connect {
		477	my ($self, $signal, $cb) = @_;
		478
		479	push @{ $self->{signal_cb}{$signal} }, $cb;
		480	}
		481
		482	sub _emit {
		483	my ($self, $signal, @args) = @_;
		484
		485	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		486	}
		487
		488	sub emit {
		489	my ($self, $signal, @args) = @_;
		490
		491	$self->_emit ($signal, @args)
		492	|| $self->$signal (@args);
		493	}
		494
		495	sub visibility_change {
		496	#my ($self, $visible) = @_;
		497	}
		498
		499	sub realloc {
		500	my ($self) = @_;
		501
		502	if ($self->{visible}) {
		503	return if $self->{root}{realloc}{$self+0};
		504
		505	$self->{root}{realloc}{$self+0} = $self;
		506	$self->{root}->update;
		507	} else {
		508	delete $self->{req_w};
		509	delete $self->{req_h};
		510	}
		511	}
		512
		513	sub update {
		514	my ($self) = @_;
		515
		516	$self->{parent}->update
		517	if $self->{parent};
		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
394		530
395	sub draw {	531	sub draw {
396	my ($self) = @_;	532	my ($self) = @_;
397		533
398	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);
399		545
400	glPushMatrix;	546	glPushMatrix;
401	glTranslate $self->{x}, $self->{y}, 0;	547	glTranslate $self->{x}, $self->{y}, 0;
402	$self->_draw;	548	$self->_draw;
403	glPopMatrix;	549	glPopMatrix;
…		…
415	glVertex $x , $y + $self->{h};	561	glVertex $x , $y + $self->{h};
416	glEnd;	562	glEnd;
417	glDisable GL_BLEND;	563	glDisable GL_BLEND;
418	}	564	}
419		565
420	if ($ENV{PCLIENT_DEBUG}) {	566	if ($ENV{CFPLUS_DEBUG} & 1) {
421	glPushMatrix;	567	glPushMatrix;
422	glColor 1, 1, 0, 1;	568	glColor 1, 1, 0, 1;
423	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	569	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
424	glBegin GL_LINE_LOOP;	570	glBegin GL_LINE_LOOP;
425	glVertex 0 , 0;	571	glVertex 0 , 0;
426	glVertex $self->{w}, 0;	572	glVertex $self->{w} - 1, 0;
427	glVertex $self->{w}, $self->{h};	573	glVertex $self->{w} - 1, $self->{h} - 1;
428	glVertex 0 , $self->{h};	574	glVertex 0 , $self->{h} - 1;
429	glEnd;	575	glEnd;
430	glPopMatrix;	576	glPopMatrix;
431	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	577	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
432	}	578	}
433	}	579	}
434		580
435	sub _draw {	581	sub _draw {
436	my ($self) = @_;	582	my ($self) = @_;
437		583
438	warn "no draw defined for $self\n";	584	warn "no draw defined for $self\n";
439	}
440
441	sub find_widget {
442	my ($self, $x, $y) = @_;
443
444	return () unless $self->{can_events};
445
446	return $self
447	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
448	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
449
450	()
451	}
452
453	sub set_parent {
454	my ($self, $parent) = @_;
455
456	Scalar::Util::weaken ($self->{parent} = $parent);
457
458	# TODO: req_w _does_change after ->reconfigure
459	$self->check_size
460	unless exists $self->{req_w};
461
462	$self->show;
463	}
464
465	sub check_size {
466	my ($self, $forced) = @_;
467
468	$self->{force_alloc} = 1 if $forced;
469	$CFClient::UI::ROOT->{check_size}{$self} = $self;
470	}
471
472	sub update {
473	my ($self) = @_;
474
475	$self->{parent}->update
476	if $self->{parent};
477	}
478
479	sub connect {
480	my ($self, $signal, $cb) = @_;
481
482	push @{ $self->{signal_cb}{$signal} }, $cb;
483	}
484
485	sub _emit {
486	my ($self, $signal, @args) = @_;
487
488	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
489	}
490
491	sub emit {
492	my ($self, $signal, @args) = @_;
493
494	$self->_emit ($signal, @args)
495	|| $self->$signal (@args);
496	}	585	}
497		586
498	sub DESTROY {	587	sub DESTROY {
499	my ($self) = @_;	588	my ($self) = @_;
500		589
…		…
558	my ($class, %arg) = @_;	647	my ($class, %arg) = @_;
559	$class->SUPER::new (can_events => 0, %arg);	648	$class->SUPER::new (can_events => 0, %arg);
560	}	649	}
561		650
562	sub size_request {	651	sub size_request {
563	(0, 0)	652	my ($self) = @_;
		653
		654	($self->{w} + 0, $self->{h} + 0)
564	}	655	}
565		656
566	sub draw { }	657	sub draw { }
567		658
568	#############################################################################	659	#############################################################################
…		…
597	$self->{children} = [	688	$self->{children} = [
598	sort { $a->{z} <=> $b->{z} }	689	sort { $a->{z} <=> $b->{z} }
599	@{$self->{children}}, @widgets	690	@{$self->{children}}, @widgets
600	];	691	];
601		692
602	$self->check_size (1);	693	$self->realloc;
603	$self->update;
604	}	694	}
605		695
606	sub children {	696	sub children {
607	@{ $_[0]{children} }	697	@{ $_[0]{children} }
608	}	698	}
…		…
613	delete $child->{parent};	703	delete $child->{parent};
614	$child->hide;	704	$child->hide;
615		705
616	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	706	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
617		707
618	$self->check_size;	708	$self->realloc;
619	$self->update;
620	}	709	}
621		710
622	sub clear {	711	sub clear {
623	my ($self) = @_;	712	my ($self) = @_;
624		713
…		…
628	for (@$children) {	717	for (@$children) {
629	delete $_->{parent};	718	delete $_->{parent};
630	$_->hide;	719	$_->hide;
631	}	720	}
632		721
633	$self->check_size;	722	$self->realloc;
634	$self->update;
635	}	723	}
636		724
637	sub find_widget {	725	sub find_widget {
638	my ($self, $x, $y) = @_;	726	my ($self, $x, $y) = @_;
639		727
…		…
726	$self->SUPER::size_allocate ($w, $h);	814	$self->SUPER::size_allocate ($w, $h);
727	$self->update;	815	$self->update;
728	}	816	}
729		817
730	sub _render {	818	sub _render {
		819	my ($self) = @_;
		820
731	$_[0]{children}[0]->draw;	821	$self->{children}[0]->draw;
732	}	822	}
733		823
734	sub render_child {	824	sub render_child {
735	my ($self) = @_;	825	my ($self) = @_;
736		826
737	$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 {
738	glClearColor 0, 0, 0, 0;	828	glClearColor 0, 0, 0, 0;
739	glClear GL_COLOR_BUFFER_BIT;	829	glClear GL_COLOR_BUFFER_BIT;
740		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
741	$self->_render;	838	$self->_render;
742	};	839	};
743	}	840	}
744		841
745	sub _draw {	842	sub _draw {
746	my ($self) = @_;	843	my ($self) = @_;
747		844
748	my ($w, $h) = ($self->w, $self->h);	845	my ($w, $h) = @$self{qw(w h)};
749		846
750	my $tex = $self->{texture}	847	my $tex = $self->{texture}
751	or return;	848	or return;
752		849
753	glEnable GL_TEXTURE_2D;	850	glEnable GL_TEXTURE_2D;
…		…
763		860
764	package CFClient::UI::ViewPort;	861	package CFClient::UI::ViewPort;
765		862
766	our @ISA = CFClient::UI::Window::;	863	our @ISA = CFClient::UI::Window::;
767		864
		865	sub new {
		866	my $class = shift;
		867
		868	$class->SUPER::new (
		869	scroll_x => 0,
		870	scroll_y => 1,
		871	@_,
		872	)
		873	}
		874
768	sub size_request {	875	sub size_request {
769	my ($self) = @_;	876	my ($self) = @_;
770		877
771	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	878	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
772		879
773	@$self{qw(child_w child_h)}	880	$w = 10 if $self->{scroll_x};
		881	$h = 10 if $self->{scroll_y};
		882
		883	($w, $h)
774	}	884	}
775		885
776	sub size_allocate {	886	sub size_allocate {
777	my ($self, $w, $h) = @_;	887	my ($self, $w, $h) = @_;
778		888
779	my ($cw, $ch) = @$self{qw(child_w child_h)};	889	my $child = $self->child;
780	# $w = $self->{w};	890
		891	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
		892	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
		893
781	$self->child->configure (0, 0, $cw, $ch);	894	$self->child->configure (0, 0, $w, $h);
782	$self->update;	895	$self->update;
783	}	896	}
784		897
785	sub set_offset {	898	sub set_offset {
786	my ($self, $x, $y) = @_;	899	my ($self, $x, $y) = @_;
…		…
820	}	933	}
821		934
822	sub _render {	935	sub _render {
823	my ($self) = @_;	936	my ($self) = @_;
824		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};
		940
825	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	941	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
826		942
827	$self->SUPER::_render;	943	$self->SUPER::_render;
828	}	944	}
829		945
…		…
837	my $class = shift;	953	my $class = shift;
838		954
839	my $self;	955	my $self;
840		956
841	my $slider = new CFClient::UI::Slider	957	my $slider = new CFClient::UI::Slider
842	vertical => 1,	958	vertical => 1,
843	range => [0, 0, 1, 0.01], # HACK fix	959	range => [0, 0, 1, 0.01], # HACK fix
844	connect_changed => sub {	960	on_changed => sub {
845	$self->{vp}->set_offset (0, $_[1]);	961	$self->{vp}->set_offset (0, $_[1]);
846	},	962	},
847	;	963	;
848		964
849	$self = $class->SUPER::new (	965	$self = $class->SUPER::new (
…		…
855	$self->{vp}->add ($self->{scrolled});	971	$self->{vp}->add ($self->{scrolled});
856	$self->add ($self->{vp});	972	$self->add ($self->{vp});
857	$self->add ($self->{slider});	973	$self->add ($self->{slider});
858		974
859	$self	975	$self
		976	}
		977
		978	sub update {
		979	my ($self) = @_;
		980
		981	$self->SUPER::update;
		982
		983	# todo: overwrite size_allocate of child
		984	my $child = $self->{vp}->child;
		985	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
860	}	986	}
861		987
862	sub size_allocate {	988	sub size_allocate {
863	my ($self, $w, $h) = @_;	989	my ($self, $w, $h) = @_;
864		990
…		…
917		1043
918	our @ISA = CFClient::UI::Bin::;	1044	our @ISA = CFClient::UI::Bin::;
919		1045
920	use CFClient::OpenGL;	1046	use CFClient::OpenGL;
921		1047
922	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 =
923	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1053	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
924	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);
925		1055
926	sub new {	1056	sub new {
927	my $class = shift;	1057	my ($class, %arg) = @_;
928		1058
929	# TODO: user_x, user_y, overwrite moveto?	1059	my $title = delete $arg{title};
930		1060
931	my $self = $class->SUPER::new (	1061	my $self = $class->SUPER::new (
932	bg => [1, 1, 1, 1],	1062	bg => [1, 1, 1, 1],
933	border_bg => [1, 1, 1, 1],	1063	border_bg => [1, 1, 1, 1],
934	border => 0.6,	1064	border => 0.6,
935	is_toplevel => 1,
936	can_events => 1,	1065	can_events => 1,
937	@_	1066	min_w => 16,
		1067	min_h => 16,
		1068	%arg,
938	);	1069	);
939		1070
940	$self->{title} &&= new CFClient::UI::Label	1071	$self->{title} = new CFClient::UI::Label
941	align => 0,	1072	align => 0,
942	valign => 1,	1073	valign => 1,
943	text => $self->{title},	1074	text => $title,
944	fontsize => $self->{border};	1075	fontsize => $self->{border}
		1076	if defined $title;
945		1077
946	$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};
947	}	1086	}
948		1087
949	sub border {	1088	sub border {
950	int $_[0]{border} * $::FONTSIZE	1089	int $_[0]{border} * $::FONTSIZE
951	}	1090	}
952		1091
953	sub size_request {	1092	sub size_request {
954	my ($self) = @_;	1093	my ($self) = @_;
		1094
		1095	$self->{title}->size_request
		1096	if $self->{title};
955		1097
956	my ($w, $h) = $self->SUPER::size_request;	1098	my ($w, $h) = $self->SUPER::size_request;
957		1099
958	(	1100	(
959	$w + $self->border * 2,	1101	$w + $self->border * 2,
…		…
962	}	1104	}
963		1105
964	sub size_allocate {	1106	sub size_allocate {
965	my ($self, $w, $h) = @_;	1107	my ($self, $w, $h) = @_;
966		1108
		1109	if ($self->{title}) {
		1110	$self->{title}{w} = $w;
		1111	$self->{title}{h} = $h;
		1112	$self->{title}->size_allocate ($w, $h);
		1113	}
		1114
		1115	my $border = $self->border;
		1116
967	$h -= List::Util::max 0, $self->border * 2;	1117	$h -= List::Util::max 0, $border * 2;
968	$w -= List::Util::max 0, $self->border * 2;	1118	$w -= List::Util::max 0, $border * 2;
969		1119
970	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
971	if $self->{title};
972
973	$self->child->configure ($self->border, $self->border, $w, $h);	1120	$self->child->configure ($border, $border, $w, $h);
974	}	1121	}
975		1122
976	sub button_down {	1123	sub button_down {
977	my ($self, $ev, $x, $y) = @_;	1124	my ($self, $ev, $x, $y) = @_;
978		1125
…		…
994	my ($ev, $x, $y) = @_;	1141	my ($ev, $x, $y) = @_;
995		1142
996	my $dx = $ev->{x} - $ox;	1143	my $dx = $ev->{x} - $ox;
997	my $dy = $ev->{y} - $oy;	1144	my $dy = $ev->{y} - $oy;
998		1145
999	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1146	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1000	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1147	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1148
		1149	$self->realloc;
1001	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1150	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1002	$self->check_size;
1003	};	1151	};
1004		1152
1005	} elsif ($lr ^ $td) {	1153	} elsif ($lr ^ $td) {
1006	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1154	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1007	my ($bx, $by) = ($self->{x}, $self->{y});	1155	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1009	$self->{motion} = sub {	1157	$self->{motion} = sub {
1010	my ($ev, $x, $y) = @_;	1158	my ($ev, $x, $y) = @_;
1011		1159
1012	($x, $y) = ($ev->{x}, $ev->{y});	1160	($x, $y) = ($ev->{x}, $ev->{y});
1013		1161
1014	$self->move ($bx + $x - $ox, $by + $y - $oy);	1162	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1015	$self->update;
1016	};	1163	};
		1164	} else {
		1165	return 0;
		1166	}
		1167
1017	}	1168	1
1018	}	1169	}
1019		1170
1020	sub button_up {	1171	sub button_up {
1021	my ($self, $ev, $x, $y) = @_;	1172	my ($self, $ev, $x, $y) = @_;
1022		1173
1023	delete $self->{motion};	1174	!!delete $self->{motion}
1024	}	1175	}
1025		1176
1026	sub mouse_motion {	1177	sub mouse_motion {
1027	my ($self, $ev, $x, $y) = @_;	1178	my ($self, $ev, $x, $y) = @_;
1028		1179
1029	$self->{motion}->($ev, $x, $y) if $self->{motion};	1180	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1181
		1182	!!$self->{motion}
1030	}	1183	}
1031		1184
1032	sub _draw {	1185	sub _draw {
1033	my ($self) = @_;	1186	my ($self) = @_;
1034		1187
		1188	my $child = $self->{children}[0];
		1189
1035	my ($w, $h ) = ($self->{w}, $self->{h});	1190	my ($w, $h ) = ($self->{w}, $self->{h});
1036	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1191	my ($cw, $ch) = ($child->{w}, $child->{h});
1037		1192
1038	glEnable GL_TEXTURE_2D;	1193	glEnable GL_TEXTURE_2D;
1039	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1194	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1040		1195
1041	my $border = $self->border;	1196	my $border = $self->border;
1042		1197
1043	glColor @{ $self->{border_bg} };	1198	glColor @{ $self->{border_bg} };
1044	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1199	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1045	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1200	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1046	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1201	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1047	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1202	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1048		1203
1049	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1204	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1050	my $bg = $tex[0];	1205	glColor @{ $self->{bg} };
1051		1206
1052	# TODO: repeat texture not scale	1207	# TODO: repeat texture not scale
		1208	# solve this better(?)
1053	my $rep_x = $cw / $bg->{w};	1209	$bg->{s} = $cw / $bg->{w};
1054	my $rep_y = $ch / $bg->{h};	1210	$bg->{t} = $ch / $bg->{h};
1055
1056	glColor @{ $self->{bg} };
1057
1058	$bg->{s} = $rep_x;
1059	$bg->{t} = $rep_y;
1060	$bg->{wrap_mode} = 1;
1061	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1211	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1062	}	1212	}
1063		1213
1064	glDisable GL_TEXTURE_2D;	1214	glDisable GL_TEXTURE_2D;
1065		1215
1066	$self->{title}->draw if $self->{title};
1067
1068	$self->child->draw;	1216	$child->draw;
		1217
		1218	if ($self->{title}) {
		1219	glTranslate 0, $border - $self->{h};
		1220	$self->{title}->_draw;
		1221	}
1069	}	1222	}
1070		1223
1071	#############################################################################	1224	#############################################################################
1072		1225
1073	package CFClient::UI::Table;	1226	package CFClient::UI::Table;
…		…
1081	sub new {	1234	sub new {
1082	my $class = shift;	1235	my $class = shift;
1083		1236
1084	$class->SUPER::new (	1237	$class->SUPER::new (
1085	col_expand => [],	1238	col_expand => [],
1086	@_	1239	@_,
1087	)	1240	)
		1241	}
		1242
		1243	sub children {
		1244	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1088	}	1245	}
1089		1246
1090	sub add {	1247	sub add {
1091	my ($self, $x, $y, $child) = @_;	1248	my ($self, $x, $y, $child) = @_;
1092		1249
1093	$child->set_parent ($self);	1250	$child->set_parent ($self);
1094	$self->{children}[$y][$x] = $child;	1251	$self->{children}[$y][$x] = $child;
1095		1252
1096	$child->check_size;	1253	$self->realloc;
1097	}	1254	}
1098		1255
1099	sub children {
1100	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1101	}
1102
1103	# TODO: move to container class maybe? send childs a signal on removal?	1256	# TODO: move to container class maybe? send children a signal on removal?
1104	sub clear {	1257	sub clear {
1105	my ($self) = @_;	1258	my ($self) = @_;
1106		1259
1107	my @children = $self->children;	1260	my @children = $self->children;
1108	delete $self->{children};	1261	delete $self->{children};
…		…
1110	for (@children) {	1263	for (@children) {
1111	delete $_->{parent};	1264	delete $_->{parent};
1112	$_->hide;	1265	$_->hide;
1113	}	1266	}
1114		1267
1115	$self->update;	1268	$self->realloc;
1116	}	1269	}
1117		1270
1118	sub get_wh {	1271	sub get_wh {
1119	my ($self) = @_;	1272	my ($self) = @_;
1120		1273
…		…
1151	sub size_allocate {	1304	sub size_allocate {
1152	my ($self, $w, $h) = @_;	1305	my ($self, $w, $h) = @_;
1153		1306
1154	my ($ws, $hs) = $self->get_wh;	1307	my ($ws, $hs) = $self->get_wh;
1155		1308
1156	my $req_w = sum @$ws;	1309	my $req_w = (sum @$ws) || 1;
1157	my $req_h = sum @$hs;	1310	my $req_h = (sum @$hs) || 1;
1158		1311
1159	# TODO: nicer code && do row_expand	1312	# TODO: nicer code && do row_expand
1160	my @col_expand = @{$self->{col_expand}};	1313	my @col_expand = @{$self->{col_expand}};
1161	@col_expand = (1) x @$ws unless @col_expand;	1314	@col_expand = (1) x @$ws unless @col_expand;
1162	my $col_expand = (sum @col_expand) || 1;	1315	my $col_expand = (sum @col_expand) || 1;
…		…
1216	}	1369	}
1217	}	1370	}
1218		1371
1219	#############################################################################	1372	#############################################################################
1220		1373
1221	package CFClient::UI::HBox;	1374	package CFClient::UI::Box;
1222
1223	# TODO: wrap into common Box base class
1224		1375
1225	our @ISA = CFClient::UI::Container::;	1376	our @ISA = CFClient::UI::Container::;
1226		1377
1227	sub size_request {	1378	sub size_request {
1228	my ($self) = @_;	1379	my ($self) = @_;
1229		1380
1230	my @alloc = map [$_->size_request], @{$self->{children}};	1381	$self->{vertical}
1231		1382	? (
1232	(	1383	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1233	(List::Util::sum map $_->[0], @alloc),	1384	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1234	(List::Util::max map $_->[1], @alloc),	1385	)
1235	)	1386	: (
		1387	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1388	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1389	)
1236	}	1390	}
1237		1391
1238	sub size_allocate {	1392	sub size_allocate {
1239	my ($self, $w, $h) = @_;	1393	my ($self, $w, $h) = @_;
1240		1394
1241	($h, $w) = ($w, $h);	1395	my $space = $self->{vertical} ? $h : $w;
1242
1243	my $children = $self->{children};	1396	my $children = $self->{children};
1244		1397
1245	my @h = map $_->{req_w}, @$children;	1398	my @req;
1246		1399
1247	my $req_h = List::Util::sum @h;	1400	if ($self->{homogeneous}) {
1248		1401	@req = ($space / (@$children || 1)) x @$children;
1249	if ($req_h > $h) {
1250	# ah well, not enough space
1251	$_ *= $h / $req_h for @h;
1252	} else {	1402	} else {
		1403	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
		1404	my $req = List::Util::sum @req;
		1405
		1406	if ($req > $space) {
		1407	# ah well, not enough space
		1408	$_ *= $space / $req for @req;
		1409	} else {
1253	my $exp = List::Util::sum map $_->{expand}, @$children;	1410	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1254	$exp ||= 1;
1255		1411
		1412	$space = ($space - $req) / $expand; # remaining space to give away
		1413
		1414	$req[$_] += $space * $children->[$_]{expand}
1256	for (0 .. $#$children) {	1415	for 0 .. $#$children;
1257	my $child = $children->[$_];
1258
1259	my $alloc_h = $h[$_];
1260	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1261	$h[$_] = $alloc_h;
1262	}	1416	}
1263	}	1417	}
1264		1418
1265	CFClient::UI::harmonize \@h;	1419	CFClient::UI::harmonize \@req;
1266		1420
1267	my $y = 0;	1421	my $pos = 0;
1268	for (0 .. $#$children) {	1422	for (0 .. $#$children) {
1269	my $child = $children->[$_];
1270	my $h = $h[$_];	1423	my $alloc = $req[$_];
1271	$child->configure ($y, 0, $h, $w);	1424	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1272		1425
1273	$y += $h;	1426	$pos += $alloc;
1274	}	1427	}
1275		1428
1276	1	1429	1
1277	}	1430	}
1278		1431
1279	#############################################################################	1432	#############################################################################
1280		1433
		1434	package CFClient::UI::HBox;
		1435
		1436	our @ISA = CFClient::UI::Box::;
		1437
		1438	sub new {
		1439	my $class = shift;
		1440
		1441	$class->SUPER::new (
		1442	vertical => 0,
		1443	@_,
		1444	)
		1445	}
		1446
		1447	#############################################################################
		1448
1281	package CFClient::UI::VBox;	1449	package CFClient::UI::VBox;
1282		1450
1283	# TODO: wrap into common Box base class
1284
1285	our @ISA = CFClient::UI::Container::;	1451	our @ISA = CFClient::UI::Box::;
1286		1452
1287	sub size_request {	1453	sub new {
1288	my ($self) = @_;	1454	my $class = shift;
1289		1455
1290	my @alloc = map [$_->size_request], @{$self->{children}};	1456	$class->SUPER::new (
1291		1457	vertical => 1,
1292	(	1458	@_,
1293	(List::Util::max map $_->[0], @alloc),
1294	(List::Util::sum map $_->[1], @alloc),
1295	)	1459	)
1296	}
1297
1298	sub size_allocate {
1299	my ($self, $w, $h) = @_;
1300
1301	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1302
1303	my $children = $self->{children};
1304
1305	my @h = map $_->{req_h}, @$children;
1306
1307	my $req_h = List::Util::sum @h;
1308
1309	if ($req_h > $h) {
1310	# ah well, not enough space
1311	$_ *= $h / $req_h for @h;
1312	} else {
1313	my $exp = List::Util::sum map $_->{expand}, @$children;
1314	$exp ||= 1;
1315
1316	for (0 .. $#$children) {
1317	my $child = $children->[$_];
1318
1319	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1320	}
1321	}
1322
1323	CFClient::UI::harmonize \@h;
1324
1325	my $y = 0;
1326	for (0 .. $#$children) {
1327	my $child = $children->[$_];
1328	my $h = $h[$_];
1329	$child->configure (0, $y, $w, $h);
1330
1331	$y += $h;
1332	}
1333
1334	1
1335	}	1460	}
1336		1461
1337	#############################################################################	1462	#############################################################################
1338		1463
1339	package CFClient::UI::Label;	1464	package CFClient::UI::Label;
…		…
1356	ellipsise => 3, # end	1481	ellipsise => 3, # end
1357	layout => (new CFClient::Layout),	1482	layout => (new CFClient::Layout),
1358	fontsize => 1,	1483	fontsize => 1,
1359	align => -1,	1484	align => -1,
1360	valign => -1,	1485	valign => -1,
1361	padding => 2,	1486	padding_x => 2,
		1487	padding_y => 2,
1362	can_events => 0,	1488	can_events => 0,
1363	%arg	1489	%arg
1364	);	1490	);
1365		1491
1366	if (exists $self->{template}) {	1492	if (exists $self->{template}) {
…		…
1402	$self->{text} = "T$text";	1528	$self->{text} = "T$text";
1403		1529
1404	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1530	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1405	$self->{layout}->set_text ($text);	1531	$self->{layout}->set_text ($text);
1406		1532
		1533	$self->realloc;
1407	$self->update;	1534	$self->update;
1408	$self->check_size;
1409	}	1535	}
1410		1536
1411	sub set_markup {	1537	sub set_markup {
1412	my ($self, $markup) = @_;	1538	my ($self, $markup) = @_;
1413		1539
…		…
1417	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1543	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1418		1544
1419	$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;
1420	$self->{layout}->set_markup ($markup);	1546	$self->{layout}->set_markup ($markup);
1421		1547
		1548	$self->realloc;
1422	$self->update;	1549	$self->update;
1423	$self->check_size;
1424	}	1550	}
1425		1551
1426	sub size_request {	1552	sub size_request {
1427	my ($self) = @_;	1553	my ($self) = @_;
1428		1554
…		…
1442		1568
1443	$w = List::Util::max $w, $w2;	1569	$w = List::Util::max $w, $w2;
1444	$h = List::Util::max $h, $h2;	1570	$h = List::Util::max $h, $h2;
1445	}	1571	}
1446		1572
1447	(	1573	($w, $h)
1448	$w + $self->{padding} * 2,
1449	$h + $self->{padding} * 2,
1450	)
1451	}	1574	}
1452		1575
1453	sub size_allocate {	1576	sub size_allocate {
1454	my ($self, $w, $h) = @_;	1577	my ($self, $w, $h) = @_;
1455		1578
		1579	delete $self->{ox};
		1580
1456	delete $self->{texture};	1581	delete $self->{texture}
		1582	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1457	}	1583	}
1458		1584
1459	sub set_fontsize {	1585	sub set_fontsize {
1460	my ($self, $fontsize) = @_;	1586	my ($self, $fontsize) = @_;
1461		1587
1462	$self->{fontsize} = $fontsize;	1588	$self->{fontsize} = $fontsize;
1463	delete $self->{texture};	1589	delete $self->{texture};
1464		1590
1465	$self->update;	1591	$self->realloc;
1466	$self->check_size;
1467	}	1592	}
1468		1593
1469	sub _draw {	1594	sub _draw {
1470	my ($self) = @_;	1595	my ($self) = @_;
1471		1596
…		…
1477	$self->{layout}->set_width ($self->{w});	1602	$self->{layout}->set_width ($self->{w});
1478	$self->{layout}->set_ellipsise ($self->{ellipsise});	1603	$self->{layout}->set_ellipsise ($self->{ellipsise});
1479	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1604	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1480	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1605	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1481		1606
1482	my $tex = new_from_layout CFClient::Texture $self->{layout};	1607	new_from_layout CFClient::Texture $self->{layout}
		1608	};
1483		1609
		1610	unless (exists $self->{ox}) {
1484	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1611	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1485	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1612	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1486	: ($self->{w} - $tex->{w}) * 0.5);	1613	: ($self->{w} - $tex->{w}) * 0.5);
1487		1614
1488	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1615	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1489	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1616	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1490	: ($self->{h} - $tex->{h}) * 0.5);	1617	: ($self->{h} - $tex->{h}) * 0.5);
1491
1492	$tex
1493	};	1618	};
1494		1619
1495	glEnable GL_TEXTURE_2D;	1620	glEnable GL_TEXTURE_2D;
1496	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1621	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1497		1622
…		…
1551	sub set_text {	1676	sub set_text {
1552	my ($self, $text) = @_;	1677	my ($self, $text) = @_;
1553		1678
1554	$self->{cursor} = length $text;	1679	$self->{cursor} = length $text;
1555	$self->_set_text ($text);	1680	$self->_set_text ($text);
1556	$self->update;	1681
1557	$self->check_size;	1682	$self->realloc;
1558	}	1683	}
1559		1684
1560	sub get_text {	1685	sub get_text {
1561	$_[0]{text}	1686	$_[0]{text}
1562	}	1687	}
…		…
1592	$self->{cursor} = length $text;	1717	$self->{cursor} = length $text;
1593	} elsif ($uni == 27) {	1718	} elsif ($uni == 27) {
1594	$self->_emit ('escape');	1719	$self->_emit ('escape');
1595	} elsif ($uni) {	1720	} elsif ($uni) {
1596	substr $text, $self->{cursor}++, 0, chr $uni;	1721	substr $text, $self->{cursor}++, 0, chr $uni;
		1722	} else {
		1723	return 0;
1597	}	1724	}
1598		1725
1599	$self->_set_text ($text);	1726	$self->_set_text ($text);
1600	$self->update;	1727
1601	$self->check_size;	1728	$self->realloc;
		1729
		1730	1
1602	}	1731	}
1603		1732
1604	sub focus_in {	1733	sub focus_in {
1605	my ($self) = @_;	1734	my ($self) = @_;
1606		1735
…		…
1621	utf8::encode $text;	1750	utf8::encode $text;
1622	$self->{cursor} = length substr $text, 0, $idx;	1751	$self->{cursor} = length substr $text, 0, $idx;
1623		1752
1624	$self->_set_text ($self->{text});	1753	$self->_set_text ($self->{text});
1625	$self->update;	1754	$self->update;
		1755
		1756	1
1626	}	1757	}
1627		1758
1628	sub mouse_motion {	1759	sub mouse_motion {
1629	my ($self, $ev, $x, $y) = @_;	1760	my ($self, $ev, $x, $y) = @_;
1630	# 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
1631	}	1764	}
1632		1765
1633	sub _draw {	1766	sub _draw {
1634	my ($self) = @_;	1767	my ($self) = @_;
1635		1768
…		…
1712	} else {	1845	} else {
1713	$self->set_text ($self->{history_saveback});	1846	$self->set_text ($self->{history_saveback});
1714	}	1847	}
1715		1848
1716	} else {	1849	} else {
1717	$self->SUPER::key_down ($ev);	1850	return $self->SUPER::key_down ($ev)
		1851	}
		1852
1718	}	1853	1
1719
1720	}	1854	}
1721		1855
1722	#############################################################################	1856	#############################################################################
1723		1857
1724	package CFClient::UI::Button;	1858	package CFClient::UI::Button;
…		…
1733		1867
1734	sub new {	1868	sub new {
1735	my $class = shift;	1869	my $class = shift;
1736		1870
1737	$class->SUPER::new (	1871	$class->SUPER::new (
1738	padding => 4,	1872	padding_x => 4,
		1873	padding_y => 4,
1739	fg => [1, 1, 1],	1874	fg => [1, 1, 1],
1740	active_fg => [0, 0, 1],	1875	active_fg => [0, 0, 1],
1741	can_hover => 1,	1876	can_hover => 1,
1742	align => 0,	1877	align => 0,
1743	valign => 0,	1878	valign => 0,
…		…
1752	my ($self, $ev, $x, $y) = @_;	1887	my ($self, $ev, $x, $y) = @_;
1753		1888
1754	$self->emit ("activate")	1889	$self->emit ("activate")
1755	if $x >= 0 && $x < $self->{w}	1890	if $x >= 0 && $x < $self->{w}
1756	&& $y >= 0 && $y < $self->{h};	1891	&& $y >= 0 && $y < $self->{h};
		1892
		1893	1
1757	}	1894	}
1758		1895
1759	sub _draw {	1896	sub _draw {
1760	my ($self) = @_;	1897	my ($self) = @_;
1761		1898
…		…
1790		1927
1791	sub new {	1928	sub new {
1792	my $class = shift;	1929	my $class = shift;
1793		1930
1794	$class->SUPER::new (	1931	$class->SUPER::new (
1795	padding => 2,	1932	padding_x => 2,
		1933	padding_y => 2,
1796	fg => [1, 1, 1],	1934	fg => [1, 1, 1],
1797	active_fg => [1, 1, 0],	1935	active_fg => [1, 1, 0],
1798	bg => [0, 0, 0, 0.2],	1936	bg => [0, 0, 0, 0.2],
1799	active_bg => [1, 1, 1, 0.5],	1937	active_bg => [1, 1, 1, 0.5],
1800	state => 0,	1938	state => 0,
…		…
1804	}	1942	}
1805		1943
1806	sub size_request {	1944	sub size_request {
1807	my ($self) = @_;	1945	my ($self) = @_;
1808		1946
1809	($self->{padding} * 2 + 6) x 2	1947	(6) x 2
1810	}	1948	}
1811		1949
1812	sub button_down {	1950	sub button_down {
1813	my ($self, $ev, $x, $y) = @_;	1951	my ($self, $ev, $x, $y) = @_;
1814		1952
1815	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1953	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1816	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1954	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1817	$self->{state} = !$self->{state};	1955	$self->{state} = !$self->{state};
1818	$self->_emit (changed => $self->{state});	1956	$self->_emit (changed => $self->{state});
		1957	} else {
		1958	return 0
		1959	}
		1960
1819	}	1961	1
1820	}	1962	}
1821		1963
1822	sub _draw {	1964	sub _draw {
1823	my ($self) = @_;	1965	my ($self) = @_;
1824		1966
1825	$self->SUPER::_draw;	1967	$self->SUPER::_draw;
1826		1968
1827	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1969	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1828		1970
1829	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;
1830		1974
1831	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1975	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1832		1976
1833	my $tex = $self->{state} ? $tex[1] : $tex[0];	1977	my $tex = $self->{state} ? $tex[1] : $tex[0];
1834		1978
…		…
2099	fg => [1, 1, 1],	2243	fg => [1, 1, 1],
2100	active_fg => [0, 0, 0],	2244	active_fg => [0, 0, 0],
2101	bg => [0, 0, 0, 0.2],	2245	bg => [0, 0, 0, 0.2],
2102	active_bg => [1, 1, 1, 0.5],	2246	active_bg => [1, 1, 1, 0.5],
2103	range => [0, 0, 100, 10, 0],	2247	range => [0, 0, 100, 10, 0],
2104	req_w => $::WIDTH / 80,	2248	min_w => $::WIDTH / 80,
2105	req_h => $::WIDTH / 80,	2249	min_h => $::WIDTH / 80,
2106	vertical => 0,	2250	vertical => 0,
2107	can_hover => 1,	2251	can_hover => 1,
2108	inner_pad => 0.02,	2252	inner_pad => 0.02,
2109	@_	2253	@_
2110	);	2254	);
…		…
2113	$self->update;	2257	$self->update;
2114		2258
2115	$self	2259	$self
2116	}	2260	}
2117		2261
		2262	sub changed { }
		2263
2118	sub set_range {	2264	sub set_range {
2119	my ($self, $range) = @_;	2265	my ($self, $range) = @_;
2120		2266
2121	$self->{range} = $range;	2267	($range, $self->{range}) = ($self->{range}, $range);
2122		2268
2123	$self->update;	2269	$self->update
		2270	if "@$range" ne "@{$self->{range}}";
2124	}	2271	}
2125		2272
2126	sub set_value {	2273	sub set_value {
2127	my ($self, $value) = @_;	2274	my ($self, $value) = @_;
2128		2275
…		…
2147	}	2294	}
2148		2295
2149	sub size_request {	2296	sub size_request {
2150	my ($self) = @_;	2297	my ($self) = @_;
2151		2298
2152	my $w = $self->{req_w};	2299	($self->{req_w}, $self->{req_h})
2153	my $h = $self->{req_h};
2154
2155	$self->{vertical} ? ($h, $w) : ($w, $h)
2156	}	2300	}
2157		2301
2158	sub button_down {	2302	sub button_down {
2159	my ($self, $ev, $x, $y) = @_;	2303	my ($self, $ev, $x, $y) = @_;
2160		2304
2161	$self->SUPER::button_down ($ev, $x, $y);	2305	$self->SUPER::button_down ($ev, $x, $y);
2162		2306
2163	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2307	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2164		2308
2165	$self->mouse_motion ($ev, $x, $y);	2309	$self->mouse_motion ($ev, $x, $y)
2166	}	2310	}
2167		2311
2168	sub mouse_motion {	2312	sub mouse_motion {
2169	my ($self, $ev, $x, $y) = @_;	2313	my ($self, $ev, $x, $y) = @_;
2170		2314
…		…
2174	my (undef, $lo, $hi, $page) = @{$self->{range}};	2318	my (undef, $lo, $hi, $page) = @{$self->{range}};
2175		2319
2176	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2320	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2177		2321
2178	$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
2179	}	2327	1
2180	}	2328	}
2181		2329
2182	sub update {	2330	sub update {
2183	my ($self) = @_;	2331	my ($self) = @_;
2184		2332
…		…
2511		2659
2512	sub new {	2660	sub new {
2513	my $class = shift;	2661	my $class = shift;
2514		2662
2515	my $self = $class->SUPER::new (	2663	my $self = $class->SUPER::new (
2516	state => 0,	2664	state => 0,
2517	connect_activate => \&toggle_flopper,	2665	on_activate => \&toggle_flopper,
2518	@_	2666	@_
2519	);	2667	);
2520		2668
2521	if ($self->{state}) {
2522	$self->{state} = 0;
2523	$self->toggle_flopper;
2524	}
2525
2526	$self	2669	$self
2527	}	2670	}
2528		2671
2529	sub toggle_flopper {	2672	sub toggle_flopper {
2530	my ($self) = @_;	2673	my ($self) = @_;
2531		2674
2532	# TODO: use animation	2675	$self->{other}->toggle_visibility;
2533	if ($self->{state} = !$self->{state}) {
2534	$CFClient::UI::ROOT->add ($self->{other});
2535	$self->{other}->move ($self->coord2global (0, $self->{h}));
2536	$self->_emit ("open");
2537	} else {
2538	$CFClient::UI::ROOT->remove ($self->{other});
2539	$self->_emit ("close");
2540	}
2541
2542	$self->_emit (changed => $self->{state});
2543	}	2676	}
2544		2677
2545	#############################################################################	2678	#############################################################################
2546		2679
2547	package CFClient::UI::Tooltip;	2680	package CFClient::UI::Tooltip;
…		…
2560	}	2693	}
2561		2694
2562	sub set_tooltip_from {	2695	sub set_tooltip_from {
2563	my ($self, $widget) = @_;	2696	my ($self, $widget) = @_;
2564		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
2565	$self->add (new CFClient::UI::Label	2707	$self->add (new CFClient::UI::Label
2566	markup => $widget->{tooltip},	2708	markup => $tooltip,
2567	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2709	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2568	fontsize => 0.8,	2710	fontsize => 0.8,
2569	fg => [0, 0, 0, 1],	2711	fg => [0, 0, 0, 1],
2570	ellipsise => 0,	2712	ellipsise => 0,
2571	font => ($widget->{tooltip_font} || $::FONT_PROP),	2713	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2582		2724
2583	sub size_allocate {	2725	sub size_allocate {
2584	my ($self, $w, $h) = @_;	2726	my ($self, $w, $h) = @_;
2585		2727
2586	$self->SUPER::size_allocate ($w - 4, $h - 4);	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	});
2587	}	2747	}
2588		2748
2589	sub _draw {	2749	sub _draw {
2590	my ($self) = @_;	2750	my ($self) = @_;
2591		2751
…		…
2608	glVertex $w, $h;	2768	glVertex $w, $h;
2609	glVertex $w, 0;	2769	glVertex $w, 0;
2610	glEnd;	2770	glEnd;
2611		2771
2612	glTranslate 2 - 0.375, 2 - 0.375;	2772	glTranslate 2 - 0.375, 2 - 0.375;
		2773
2613	$self->SUPER::_draw;	2774	$self->SUPER::_draw;
2614	}	2775	}
2615		2776
2616	#############################################################################	2777	#############################################################################
2617		2778
…		…
2623		2784
2624	sub new {	2785	sub new {
2625	my $class = shift;	2786	my $class = shift;
2626		2787
2627	my $self = $class->SUPER::new (	2788	my $self = $class->SUPER::new (
2628	aspect => 1,	2789	aspect => 1,
		2790	can_events => 0,
2629	@_,	2791	@_,
2630	);	2792	);
2631		2793
2632	if ($self->{anim} && $self->{animspeed}) {	2794	if ($self->{anim} && $self->{animspeed}) {
2633	Scalar::Util::weaken (my $widget = $self);	2795	Scalar::Util::weaken (my $widget = $self);
…		…
2692	$self->SUPER::DESTROY;	2854	$self->SUPER::DESTROY;
2693	}	2855	}
2694		2856
2695	#############################################################################	2857	#############################################################################
2696		2858
2697	package CFClient::UI::InventoryItem;
2698
2699	our @ISA = CFClient::UI::HBox::;
2700
2701	sub _item_to_desc {
2702	my ($item) = @_;
2703
2704	my $desc =
2705	$item->{nrof} < 2
2706	? $item->{name}
2707	: "$item->{nrof} × $item->{name_pl}";
2708
2709	$item->{flags} & Crossfire::Protocol::F_OPEN
2710	and $desc .= " (open)";
2711	$item->{flags} & Crossfire::Protocol::F_APPLIED
2712	and $desc .= " (applied)";
2713	$item->{flags} & Crossfire::Protocol::F_UNPAID
2714	and $desc .= " (unpaid)";
2715	$item->{flags} & Crossfire::Protocol::F_MAGIC
2716	and $desc .= " (magic)";
2717	$item->{flags} & Crossfire::Protocol::F_CURSED
2718	and $desc .= " (cursed)";
2719	$item->{flags} & Crossfire::Protocol::F_DAMNED
2720	and $desc .= " (damned)";
2721	$item->{flags} & Crossfire::Protocol::F_LOCKED
2722	and $desc .= " *";
2723
2724	$desc
2725	}
2726
2727	sub new {
2728	my $class = shift;
2729
2730	my %args = @_;
2731
2732	my $item = delete $args{item};
2733
2734	my $desc = _item_to_desc ($item);
2735
2736	my $self = $class->SUPER::new (
2737	can_hover => 1,
2738	can_events => 1,
2739	tooltip => ((CFClient::UI::Label::escape $desc)
2740	. "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2741	connect_button_down => sub {
2742	my ($self, $ev, $x, $y) = @_;
2743
2744	# todo: maybe put examine on 1? but should just be a tooltip :(
2745	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2746	my $targ = $::CONN->{player}{tag};
2747
2748	if ($item->{container} == $::CONN->{player}{tag}) {
2749	$targ = $main::OPENCONT;
2750	}
2751
2752	$::CONN->send ("move $targ $item->{tag} 0");
2753	} elsif ($ev->{button} == 1) {
2754	$::CONN->send ("examine $item->{tag}");
2755	} elsif ($ev->{button} == 2) {
2756	$::CONN->send ("apply $item->{tag}");
2757	} elsif ($ev->{button} == 3) {
2758	my @menu_items = (
2759	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2760	["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2761	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2762	(
2763	$item->{flags} & Crossfire::Protocol::F_LOCKED
2764	? (
2765	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2766	)
2767	: (
2768	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2769	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2770	)
2771	),
2772	);
2773
2774	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2775	}
2776
2777	1
2778	},
2779	%args
2780	);
2781
2782
2783	$self->add (new CFClient::UI::Face
2784	can_events => 0,
2785	face => $item->{face},
2786	anim => $item->{anim},
2787	animspeed => $item->{animspeed},
2788	);
2789
2790	$self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2791
2792	$self->{item} = $item;
2793
2794	$self->update_item;
2795
2796	$self
2797	}
2798
2799	sub update_item {
2800	my ($self) = @_;
2801
2802	my $desc = _item_to_desc ($self->{item});
2803
2804	$self->{name_lbl}->set_text ($desc);
2805	}
2806
2807	#############################################################################
2808
2809	package CFClient::UI::Inventory;
2810
2811	our @ISA = CFClient::UI::ScrolledWindow::;
2812
2813	sub new {
2814	my $class = shift;
2815
2816	my $self = $class->SUPER::new (
2817	scrolled => (new CFClient::UI::Table),
2818	@_,
2819	);
2820
2821	$self
2822	}
2823
2824	sub set_items {
2825	my ($self, $items) = @_;
2826
2827	$self->{scrolled}->clear;
2828	return unless $items;
2829
2830	my @items = sort {
2831	($a->{type} <=> $b->{type})
2832	or ($a->{name} cmp $b->{name})
2833	} @$items;
2834
2835	$self->{real_items} = \@items;
2836
2837	for my $item (@items) {
2838	$item->{item} = $item;
2839	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2840	$item->update_item ();
2841	}
2842
2843	my $i = 0;
2844	for (@items) {
2845	$self->{scrolled}->add (0, $i, $_);
2846	my $nrof = $_->{item}->{nrof} || 1;
2847	$self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2848	}
2849
2850	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2851	}
2852
2853	sub size_request {
2854	my ($self) = @_;
2855	($self->{req_w}, $self->{req_h});
2856	}
2857
2858	#############################################################################
2859
2860	package CFClient::UI::Menu;	2859	package CFClient::UI::Menu;
2861		2860
2862	our @ISA = CFClient::UI::FancyFrame::;	2861	our @ISA = CFClient::UI::FancyFrame::;
2863		2862
2864	use CFClient::OpenGL;	2863	use CFClient::OpenGL;
…		…
2902	# maybe save $GRAB? must be careful about events...	2901	# maybe save $GRAB? must be careful about events...
2903	$GRAB = $self;	2902	$GRAB = $self;
2904	$self->{button} = $ev->{button};	2903	$self->{button} = $ev->{button};
2905		2904
2906	$self->show;	2905	$self->show;
2907	$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);
2908	}	2907	}
2909		2908
2910	sub mouse_motion {	2909	sub mouse_motion {
2911	my ($self, $ev, $x, $y) = @_;	2910	my ($self, $ev, $x, $y) = @_;
2912		2911
2913	# TODO: should use vbox->find_widget or so	2912	# TODO: should use vbox->find_widget or so
2914	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2913	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2915	$self->{hover} = $self->{item}{$HOVER};	2914	$self->{hover} = $self->{item}{$HOVER};
		2915
		2916	0
2916	}	2917	}
2917		2918
2918	sub button_up {	2919	sub button_up {
2919	my ($self, $ev, $x, $y) = @_;	2920	my ($self, $ev, $x, $y) = @_;
2920		2921
…		…
2922	undef $GRAB;	2923	undef $GRAB;
2923	$self->hide;	2924	$self->hide;
2924		2925
2925	$self->_emit ("popdown");	2926	$self->_emit ("popdown");
2926	$self->{hover}[1]->() if $self->{hover};	2927	$self->{hover}[1]->() if $self->{hover};
		2928	} else {
		2929	return 0
		2930	}
		2931
2927	}	2932	1
2928	}	2933	}
2929		2934
2930	#############################################################################	2935	#############################################################################
2931		2936
2932	package CFClient::UI::Statusbox;	2937	package CFClient::UI::Statusbox;
…		…
2992	sub add {	2997	sub add {
2993	my ($self, $text, %arg) = @_;	2998	my ($self, $text, %arg) = @_;
2994		2999
2995	$text =~ s/^\s+//;	3000	$text =~ s/^\s+//;
2996	$text =~ s/\s+$//;	3001	$text =~ s/\s+$//;
		3002
		3003	return unless $text;
2997		3004
2998	my $timeout = time + ((delete $arg{timeout}) || 60);	3005	my $timeout = time + ((delete $arg{timeout}) || 60);
2999		3006
3000	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3007	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
3001		3008
…		…
3035	$self->SUPER::reconfigure;	3042	$self->SUPER::reconfigure;
3036	}	3043	}
3037		3044
3038	#############################################################################	3045	#############################################################################
3039		3046
3040	package CFClient::UI::Root;	3047	package CFClient::UI::Inventory;
3041		3048
3042	our @ISA = CFClient::UI::Container::;	3049	our @ISA = CFClient::UI::ScrolledWindow::;
3043
3044	use CFClient::OpenGL;
3045		3050
3046	sub new {	3051	sub new {
3047	my $class = shift;	3052	my $class = shift;
3048		3053
3049	$class->SUPER::new (	3054	my $self = $class->SUPER::new (
		3055	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3050	@_,	3056	@_,
3051	)	3057	);
3052	}
3053		3058
3054	sub configure {	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 {
3055	my ($self, $x, $y, $w, $h) = @_;	3212	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3056		3213
3057	$self->{w} = $w;	3214	$self->clear_command_list;
3058	$self->{h} = $h;	3215	$self->{recording} = 0;
3059	}	3216	$self->{rec_btn}->set_text ("start recording");
3060		3217
3061	sub check_size {	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 {
3062	my ($self) = @_;	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	}
3063		3236
3064	$self->size_allocate ($self->{w}, $self->{h})	3237	sub update_binding_widgets {
3065	if $self->{w};	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
		3343	package CFClient::UI::Root;
		3344
		3345	our @ISA = CFClient::UI::Container::;
		3346
		3347	use CFClient::OpenGL;
		3348
		3349	sub new {
		3350	my $class = shift;
		3351
		3352	my $self = $class->SUPER::new (
		3353	visible => 1,
		3354	@_,
		3355	);
		3356
		3357	Scalar::Util::weaken ($self->{root} = $self);
		3358
		3359	$self
3066	}	3360	}
3067		3361
3068	sub size_request {	3362	sub size_request {
3069	my ($self) = @_;	3363	my ($self) = @_;
3070		3364
3071	($self->{w}, $self->{h})	3365	($self->{w}, $self->{h})
		3366	}
		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
3072	}	3380	}
3073		3381
3074	sub size_allocate {	3382	sub size_allocate {
3075	my ($self, $w, $h) = @_;	3383	my ($self, $w, $h) = @_;
3076		3384
3077	for my $child ($self->children) {	3385	for my $child ($self->children) {
3078	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)};
3079		3387
3080	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3388	$X = $child->{force_x} if exists $child->{force_x};
3081	if exists $child->{req_x};	3389	$Y = $child->{force_y} if exists $child->{force_y};
3082		3390
3083	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3391	$X = _to_pixel $X, $W, $self->{w};
3084	if exists $child->{req_y};	3392	$Y = _to_pixel $Y, $H, $self->{h};
3085
3086	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3087	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3088		3393
3089	$child->configure ($X, $Y, $W, $H);	3394	$child->configure ($X, $Y, $W, $H);
3090	}	3395	}
3091	}	3396	}
3092		3397
…		…
3103	}	3408	}
3104		3409
3105	sub update {	3410	sub update {
3106	my ($self) = @_;	3411	my ($self) = @_;
3107		3412
3108	$self->check_size;
3109	$::WANT_REFRESH++;	3413	$::WANT_REFRESH++;
3110	}	3414	}
3111		3415
3112	sub add {	3416	sub add {
3113	my ($self, @children) = @_;	3417	my ($self, @children) = @_;
3114		3418
3115	for (my @widgets = @children; my $w = pop @widgets; ) {
3116	push @widgets, $w->children;
3117	$w->{root} = $self;
3118	$w->{visible} = 1;
3119	}
3120
3121	for my $child (@children) {
3122	$child->{is_toplevel} = 1;	3419	$_->{is_toplevel} = 1
3123		3420	for @children;
3124	# integerise window positions
3125	$child->{x} = int $child->{x};
3126	$child->{y} = int $child->{y};
3127	}
3128		3421
3129	$self->SUPER::add (@children);	3422	$self->SUPER::add (@children);
3130	}	3423	}
3131		3424
3132	sub remove {	3425	sub remove {
3133	my ($self, @children) = @_;	3426	my ($self, @children) = @_;
3134		3427
3135	$self->SUPER::remove (@children);	3428	$self->SUPER::remove (@children);
		3429
		3430	delete $self->{is_toplevel}
		3431	for @children;
3136		3432
3137	while (@children) {	3433	while (@children) {
3138	my $w = pop @children;	3434	my $w = pop @children;
3139	push @children, $w->children;	3435	push @children, $w->children;
3140	$w->set_invisible;	3436	$w->set_invisible;
…		…
3159	while ($self->{refresh_hook}) {	3455	while ($self->{refresh_hook}) {
3160	$_->()	3456	$_->()
3161	for values %{delete $self->{refresh_hook}};	3457	for values %{delete $self->{refresh_hook}};
3162	}	3458	}
3163		3459
3164	if ($self->{check_size}) {	3460	if ($self->{realloc}) {
3165	my @queue = ([], []);	3461	my %queue;
		3462	my @queue;
		3463	my $widget;
3166		3464
3167	for (;;) {	3465	outer:
3168	if ($self->{check_size}) {	3466	while () {
3169	# heuristic: check containers last	3467	if (my $realloc = delete $self->{realloc}) {
3170	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3468	for $widget (values %$realloc) {
3171	for values %{delete $self->{check_size}}	3469	$widget->{visible} or next; # do not resize invisible widgets
		3470
		3471	$queue{$widget+0}++ and next; # duplicates are common
		3472
		3473	push @{ $queue[$widget->{visible}] }, $widget;
		3474	}
3172	}	3475	}
3173		3476
3174	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3477	while () {
		3478	@queue or last outer;
3175		3479
3176	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3480	$widget = pop @{ $queue[-1] || [] }
3177	? @$widget{qw(user_w user_h)}	3481	and last;
3178	: $widget->size_request;
3179
3180	if (delete $widget->{force_alloc}
3181	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3182	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3183		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}) {
3184	$widget->{req_w} = $w;	3498	$widget->{req_w} = $w;
3185	$widget->{req_h} = $h;	3499	$widget->{req_h} = $h;
3186		3500
3187	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3501	$self->{size_alloc}{$widget+0} = $widget;
3188		3502
3189	$widget->{parent}->check_size
3190	if $widget->{parent};	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	}
3191	}	3510	}
		3511
		3512	delete $self->{realloc}{$widget+0};
3192	}	3513	}
3193	}	3514	}
3194		3515
3195	while ($self->{size_alloc}) {	3516	while (my $size_alloc = delete $self->{size_alloc}) {
3196	for (values %{delete $self->{size_alloc}}) {	3517	my @queue = sort { $b->{visible} <=> $a->{visible} }
3197	my ($widget, $w, $h) = @$_;	3518	values %$size_alloc;
		3519
		3520	while () {
		3521	my $widget = pop @queue || last;
		3522
		3523	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3198		3524
3199	$w = 0 if $w < 0;	3525	$w = 0 if $w < 0;
3200	$h = 0 if $h < 0;	3526	$h = 0 if $h < 0;
3201		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
3202	$widget->{w} = $w;	3535	$widget->{w} = $w;
3203	$widget->{h} = $h;	3536	$widget->{h} = $h;
		3537
3204	$widget->emit (size_allocate => $w, $h);	3538	$widget->emit (size_allocate => $w, $h);
		3539	}
3205	}	3540	}
3206	}	3541	}
3207		3542
3208	while ($self->{post_alloc_hook}) {	3543	while ($self->{post_alloc_hook}) {
3209	$_->()	3544	$_->()
3210	for values %{delete $self->{post_alloc_hook}};	3545	for values %{delete $self->{post_alloc_hook}};
3211	}	3546	}
		3547
3212		3548
3213	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3549	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3214	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3550	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3215	glClear GL_COLOR_BUFFER_BIT;	3551	glClear GL_COLOR_BUFFER_BIT;
3216		3552
…		…
3218	glLoadIdentity;	3554	glLoadIdentity;
3219	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3555	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3220	glMatrixMode GL_MODELVIEW;	3556	glMatrixMode GL_MODELVIEW;
3221	glLoadIdentity;	3557	glLoadIdentity;
3222		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
3223	$self->_draw;	3566	$self->_draw;
3224	}	3567	}
3225		3568
3226	#############################################################################	3569	#############################################################################
3227		3570

Diff Legend

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