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.229 by root, Wed May 24 21:49:58 2006 UTC vs.
Revision 1.268 by root, Thu Jun 1 05:04:41 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	}
…		…
50	delete $TOOLTIP->{owner};	69	delete $TOOLTIP->{owner};
51	}	70	}
52		71
53	# class methods for events	72	# class methods for events
54	sub feed_sdl_key_down_event {	73	sub feed_sdl_key_down_event {
55	$FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0])	74	$FOCUS->emit (key_down => $_[0])
56	if $FOCUS;	75	if $FOCUS;
57	}	76	}
58		77
59	sub feed_sdl_key_up_event {	78	sub feed_sdl_key_up_event {
60	$FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0])	79	$FOCUS->emit (key_up => $_[0])
61	if $FOCUS;	80	if $FOCUS;
62	}	81	}
63		82
64	sub feed_sdl_button_down_event {	83	sub feed_sdl_button_down_event {
65	my ($ev) = @_;	84	my ($ev) = @_;
…		…
74	check_tooltip;	93	check_tooltip;
75	}	94	}
76		95
77	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	96	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
78		97
79	if ($GRAB) {	98	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
80	($x, $y) = $GRAB->coord2local ($x, $y);	99	if $GRAB;
81	$GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
82	}
83	}	100	}
84		101
85	sub feed_sdl_button_up_event {	102	sub feed_sdl_button_up_event {
86	my ($ev) = @_;	103	my ($ev) = @_;
87	my ($x, $y) = ($ev->{x}, $ev->{y});	104	my ($x, $y) = ($ev->{x}, $ev->{y});
88		105
89	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	106	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
90		107
91	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	108	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
92		109
93	if ($GRAB) {	110	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
94	($x, $y) = $GRAB->coord2local ($x, $y);	111	if $GRAB;
95	$GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
96	}
97		112
98	if (!$BUTTON_STATE) {	113	if (!$BUTTON_STATE) {
99	my $grab = $GRAB; undef $GRAB;	114	my $grab = $GRAB; undef $GRAB;
100	$grab->update if $grab;	115	$grab->update if $grab;
101	$GRAB->update if $GRAB;	116	$GRAB->update if $GRAB;
…		…
117	$HOVER->update if $HOVER && $HOVER->{can_hover};	132	$HOVER->update if $HOVER && $HOVER->{can_hover};
118		133
119	check_tooltip;	134	check_tooltip;
120	}	135	}
121		136
122	if ($HOVER) {
123	($x, $y) = $HOVER->coord2local ($x, $y);
124	$HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y);	137	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
125	}	138	if $HOVER;
126	}	139	}
127		140
128	# convert position array to integers	141	# convert position array to integers
129	sub harmonize {	142	sub harmonize {
130	my ($vals) = @_;	143	my ($vals) = @_;
…		…
144		157
145	$_->update	158	$_->update
146	for @widgets;	159	for @widgets;
147	}	160	}
148		161
		162	sub reconfigure_widgets {
		163	# make a copy, otherwise C<for> complains about freed values.
		164	my @widgets = values %WIDGET;
		165
		166	$_->reconfigure
		167	for @widgets;
		168	}
		169
149	# call when resolution changes etc.	170	# call when resolution changes etc.
150	sub rescale_widgets {	171	sub rescale_widgets {
151	my ($sx, $sy) = @_;	172	my ($sx, $sy) = @_;
152		173
153	# make a copy, otherwise for complains about freed values.
154	my @widgets = values %WIDGET;	174	for my $widget (values %WIDGET) {
155
156	for my $widget (@widgets) {
157	if ($widget->{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
158	$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.]+$/;
159	$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};
160	$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};
161	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
162	$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.]+$/;
163	$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};
164	$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};
165	$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
166	}	189	}
167
168	$widget->reconfigure;
169	}	190	}
		191
		192	reconfigure_widgets;
170	}	193	}
171		194
172	#############################################################################	195	#############################################################################
173		196
174	package CFClient::UI::Base;	197	package CFClient::UI::Base;
…		…
179		202
180	sub new {	203	sub new {
181	my $class = shift;	204	my $class = shift;
182		205
183	my $self = bless {	206	my $self = bless {
184	x => 0,	207	x => "center",
185	y => 0,	208	y => "center",
186	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
187	can_events => 1,	212	can_events => 1,
188	@_	213	@_
189	}, $class;	214	}, $class;
190		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		217
191	for (keys %$self) {	218	for (keys %$self) {
192	if (/^connect_(.*)$/) {	219	if (/^on_(.*)$/) {
193	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
194	}	221	}
195	}	222	}
196		223
197	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	}
198		235
199	$self	236	$self
200	}	237	}
201		238
202	sub destroy {	239	sub destroy {
…		…
206	%$self = ();	243	%$self = ();
207	}	244	}
208		245
209	sub show {	246	sub show {
210	my ($self) = @_;	247	my ($self) = @_;
		248
211	return if $self->{parent};	249	return if $self->{parent};
212		250
213	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
214	}	252	}
215		253
216	sub show_centered {	254	sub set_visible {
217	my ($self) = @_;	255	my ($self) = @_;
		256
218	return if $self->{parent};	257	return if $self->{visible};
219		258
220	$self->show;	259	$self->{root} = $self->{parent}{root};
		260	$self->{visible} = $self->{parent}{visible} + 1;
221		261
222	$CFClient::UI::ROOT->on_post_alloc (	262	$self->emit (visibility_change => 1);
223	"centered $self" => sub {
224	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);
225	},
226	);
227	}
228		263
229	sub hide {	264	$self->realloc if !exists $self->{req_w};
		265
		266	$_->set_visible for $self->children;
		267	}
		268
		269	sub set_invisible {
230	my ($self) = @_;	270	my ($self) = @_;
		271
		272	return unless $self->{visible};
		273
		274	$_->set_invisible for $self->children;
		275
		276	delete $self->{root};
		277	delete $self->{visible};
231		278
232	undef $GRAB if $GRAB == $self;	279	undef $GRAB if $GRAB == $self;
233	undef $HOVER if $HOVER == $self;	280	undef $HOVER if $HOVER == $self;
234		281
		282	CFClient::UI::check_tooltip
		283	if $TOOLTIP->{owner} == $self;
		284
		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;
		305	}
		306
		307	sub hide {
		308	my ($self) = @_;
		309
		310	$self->set_invisible;
		311
235	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
236	if $self->{parent};	313	if $self->{parent};
237	}	314	}
238		315
239	sub move {	316	sub move_abs {
240	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
241		318
242	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
243	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
244	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
245		322
246	$self->update;	323	$self->update;
247	}	324	}
248		325
249	sub set_size {	326	sub set_size {
250	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
251		328
252	$self->{user_w} = $w;	329	$self->{force_w} = $w;
253	$self->{user_h} = $h;	330	$self->{force_h} = $h;
254		331
255	$self->check_size;	332	$self->realloc;
256	}	333	}
257		334
258	sub size_request {	335	sub size_request {
259	require Carp;	336	require Carp;
260	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
262		339
263	sub configure {	340	sub configure {
264	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
265		342
266	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
267	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
268	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
269		348
270	# use alignment to adjust x, y	349	# use alignment to adjust x, y
271		350
272	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
273	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
274
275	($w, $h) = ($w2, $h2);
276	}	353	}
277		354
278	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
279	$self->{x} = $x;	356	$self->{x} = $x;
280	$self->{y} = $y;	357	$self->{y} = $y;
281	$self->update;	358	$self->update;
282	}	359	}
283		360
284	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
285	$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;
286	}	368	}
287	}	369	}
288		370
289	sub size_allocate {	371	sub size_allocate {
290	# nothing to be done	372	# nothing to be done
291	}	373	}
292		374
293	sub reconfigure {
294	my ($self) = @_;
295
296	$self->check_size (1);
297	$self->update;
298	}
299
300	sub children {	375	sub children {
301	}	376	}
302		377
303	sub set_max_size {	378	sub set_max_size {
304	my ($self, $w, $h) = @_;	379	my ($self, $w, $h) = @_;
…		…
307	delete $self->{max_h}; $self->{max_h} = $h if $h;	382	delete $self->{max_h}; $self->{max_h} = $h if $h;
308	}	383	}
309		384
310	sub set_tooltip {	385	sub set_tooltip {
311	my ($self, $tooltip) = @_;	386	my ($self, $tooltip) = @_;
		387
		388	$tooltip =~ s/^\s+//;
		389	$tooltip =~ s/\s+$//;
		390
		391	return if $self->{tooltip} eq $tooltip;
312		392
313	$self->{tooltip} = $tooltip;	393	$self->{tooltip} = $tooltip;
314		394
315	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	395	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
316	delete $CFClient::UI::TOOLTIP->{owner};	396	delete $CFClient::UI::TOOLTIP->{owner};
…		…
338	return if $FOCUS == $self;	418	return if $FOCUS == $self;
339	return unless $self->{can_focus};	419	return unless $self->{can_focus};
340		420
341	my $focus = $FOCUS; $FOCUS = $self;	421	my $focus = $FOCUS; $FOCUS = $self;
342		422
343	$self->emit (focus_in => $focus);	423	$self->_emit (focus_in => $focus);
344		424
345	$focus->update if $focus;	425	$focus->update if $focus;
346	$FOCUS->update;	426	$FOCUS->update;
347	}	427	}
348		428
…		…
351		431
352	return unless $FOCUS == $self;	432	return unless $FOCUS == $self;
353		433
354	my $focus = $FOCUS; undef $FOCUS;	434	my $focus = $FOCUS; undef $FOCUS;
355		435
356	$self->emit (focus_out => $focus);	436	$self->_emit (focus_out => $focus);
357		437
358	$focus->update if $focus; #?	438	$focus->update if $focus; #?
		439
		440	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		441	unless $FOCUS;
359	}	442	}
360		443
361	sub mouse_motion { }	444	sub mouse_motion { }
362	sub button_up { }	445	sub button_up { }
363	sub key_down { }	446	sub key_down { }
364	sub key_up { }	447	sub key_up { }
365		448
366	sub button_down {	449	sub button_down {
367	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
368		451
369	$self->focus_in;	452	$self->focus_in;
370	}	453	}
371		454
372	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	455	sub find_widget {
373	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	456	my ($self, $x, $y) = @_;
374	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	457
375	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	458	return () unless $self->{can_events};
376	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
377		528
378	sub draw {	529	sub draw {
379	my ($self) = @_;	530	my ($self) = @_;
380		531
381	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);
382		543
383	glPushMatrix;	544	glPushMatrix;
384	glTranslate $self->{x}, $self->{y}, 0;	545	glTranslate $self->{x}, $self->{y}, 0;
385	$self->_draw;	546	$self->_draw;
386	glPopMatrix;	547	glPopMatrix;
…		…
398	glVertex $x , $y + $self->{h};	559	glVertex $x , $y + $self->{h};
399	glEnd;	560	glEnd;
400	glDisable GL_BLEND;	561	glDisable GL_BLEND;
401	}	562	}
402		563
403	if ($ENV{PCLIENT_DEBUG}) {	564	if ($ENV{CFPLUS_DEBUG} & 1) {
404	glPushMatrix;	565	glPushMatrix;
405	glColor 1, 1, 0, 1;	566	glColor 1, 1, 0, 1;
406	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	567	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
407	glBegin GL_LINE_LOOP;	568	glBegin GL_LINE_LOOP;
408	glVertex 0 , 0;	569	glVertex 0 , 0;
409	glVertex $self->{w}, 0;	570	glVertex $self->{w} - 1, 0;
410	glVertex $self->{w}, $self->{h};	571	glVertex $self->{w} - 1, $self->{h} - 1;
411	glVertex 0 , $self->{h};	572	glVertex 0 , $self->{h} - 1;
412	glEnd;	573	glEnd;
413	glPopMatrix;	574	glPopMatrix;
414	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	575	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
415	}	576	}
416	}	577	}
417		578
418	sub _draw {	579	sub _draw {
419	my ($self) = @_;	580	my ($self) = @_;
420		581
421	warn "no draw defined for $self\n";	582	warn "no draw defined for $self\n";
422	}
423
424	sub find_widget {
425	my ($self, $x, $y) = @_;
426
427	return () unless $self->{can_events};
428
429	return $self
430	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
431	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
432
433	()
434	}
435
436	sub set_parent {
437	my ($self, $parent) = @_;
438
439	Scalar::Util::weaken ($self->{parent} = $parent);
440
441	# TODO: req_w _does_change after ->reconfigure
442	$self->check_size
443	unless exists $self->{req_w};
444
445	$self->show;
446	}
447
448	sub check_size {
449	my ($self, $forced) = @_;
450
451	$self->{force_alloc} = 1 if $forced;
452	$CFClient::UI::ROOT->{check_size}{$self} = $self;
453	}
454
455	sub update {
456	my ($self) = @_;
457
458	$self->{parent}->update
459	if $self->{parent};
460	}
461
462	sub connect {
463	my ($self, $signal, $cb) = @_;
464
465	push @{ $self->{signal_cb}{$signal} }, $cb;
466	}
467
468	sub emit {
469	my ($self, $signal, @args) = @_;
470
471	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
472	}	583	}
473		584
474	sub DESTROY {	585	sub DESTROY {
475	my ($self) = @_;	586	my ($self) = @_;
476		587
…		…
534	my ($class, %arg) = @_;	645	my ($class, %arg) = @_;
535	$class->SUPER::new (can_events => 0, %arg);	646	$class->SUPER::new (can_events => 0, %arg);
536	}	647	}
537		648
538	sub size_request {	649	sub size_request {
539	(0, 0)	650	my ($self) = @_;
		651
		652	($self->{w} + 0, $self->{h} + 0)
540	}	653	}
541		654
542	sub draw { }	655	sub draw { }
543		656
544	#############################################################################	657	#############################################################################
…		…
573	$self->{children} = [	686	$self->{children} = [
574	sort { $a->{z} <=> $b->{z} }	687	sort { $a->{z} <=> $b->{z} }
575	@{$self->{children}}, @widgets	688	@{$self->{children}}, @widgets
576	];	689	];
577		690
578	$self->check_size (1);	691	$self->realloc;
579	$self->update;
580	}	692	}
581		693
582	sub children {	694	sub children {
583	@{ $_[0]{children} }	695	@{ $_[0]{children} }
584	}	696	}
…		…
589	delete $child->{parent};	701	delete $child->{parent};
590	$child->hide;	702	$child->hide;
591		703
592	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	704	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
593		705
594	$self->check_size;	706	$self->realloc;
595	$self->update;
596	}	707	}
597		708
598	sub clear {	709	sub clear {
599	my ($self) = @_;	710	my ($self) = @_;
600		711
…		…
604	for (@$children) {	715	for (@$children) {
605	delete $_->{parent};	716	delete $_->{parent};
606	$_->hide;	717	$_->hide;
607	}	718	}
608		719
609	$self->check_size;	720	$self->realloc;
610	$self->update;
611	}	721	}
612		722
613	sub find_widget {	723	sub find_widget {
614	my ($self, $x, $y) = @_;	724	my ($self, $x, $y) = @_;
615		725
…		…
702	$self->SUPER::size_allocate ($w, $h);	812	$self->SUPER::size_allocate ($w, $h);
703	$self->update;	813	$self->update;
704	}	814	}
705		815
706	sub _render {	816	sub _render {
		817	my ($self) = @_;
		818
707	$_[0]{children}[0]->draw;	819	$self->{children}[0]->draw;
708	}	820	}
709		821
710	sub render_child {	822	sub render_child {
711	my ($self) = @_;	823	my ($self) = @_;
712		824
713	$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 {
714	glClearColor 0, 0, 0, 0;	826	glClearColor 0, 0, 0, 0;
715	glClear GL_COLOR_BUFFER_BIT;	827	glClear GL_COLOR_BUFFER_BIT;
716		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
717	$self->_render;	836	$self->_render;
718	};	837	};
719	}	838	}
720		839
721	sub _draw {	840	sub _draw {
722	my ($self) = @_;	841	my ($self) = @_;
723		842
724	my ($w, $h) = ($self->w, $self->h);	843	my ($w, $h) = @$self{qw(w h)};
725		844
726	my $tex = $self->{texture}	845	my $tex = $self->{texture}
727	or return;	846	or return;
728		847
729	glEnable GL_TEXTURE_2D;	848	glEnable GL_TEXTURE_2D;
…		…
739		858
740	package CFClient::UI::ViewPort;	859	package CFClient::UI::ViewPort;
741		860
742	our @ISA = CFClient::UI::Window::;	861	our @ISA = CFClient::UI::Window::;
743		862
		863	sub new {
		864	my $class = shift;
		865
		866	$class->SUPER::new (
		867	scroll_x => 0,
		868	scroll_y => 1,
		869	@_,
		870	)
		871	}
		872
744	sub size_request {	873	sub size_request {
745	my ($self) = @_;	874	my ($self) = @_;
746		875
747	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	876	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
748		877
749	@$self{qw(child_w child_h)}	878	$w = 10 if $self->{scroll_x};
		879	$h = 10 if $self->{scroll_y};
		880
		881	($w, $h)
750	}	882	}
751		883
752	sub size_allocate {	884	sub size_allocate {
753	my ($self, $w, $h) = @_;	885	my ($self, $w, $h) = @_;
754		886
755	my ($cw, $ch) = @$self{qw(child_w child_h)};	887	my $child = $self->child;
756	# $w = $self->{w};	888
		889	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
		890	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
		891
757	$self->child->configure (0, 0, $cw, $ch);	892	$self->child->configure (0, 0, $w, $h);
758	$self->update;	893	$self->update;
759	}	894	}
760		895
761	sub set_offset {	896	sub set_offset {
762	my ($self, $x, $y) = @_;	897	my ($self, $x, $y) = @_;
…		…
796	}	931	}
797		932
798	sub _render {	933	sub _render {
799	my ($self) = @_;	934	my ($self) = @_;
800		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};
		938
801	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	939	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
802		940
803	$self->SUPER::_render;	941	$self->SUPER::_render;
804	}	942	}
805		943
…		…
813	my $class = shift;	951	my $class = shift;
814		952
815	my $self;	953	my $self;
816		954
817	my $slider = new CFClient::UI::Slider	955	my $slider = new CFClient::UI::Slider
818	vertical => 1,	956	vertical => 1,
819	range => [0, 0, 1, 0.01], # HACK fix	957	range => [0, 0, 1, 0.01], # HACK fix
820	connect_changed => sub {	958	on_changed => sub {
821	$self->{vp}->set_offset (0, $_[1]);	959	$self->{vp}->set_offset (0, $_[1]);
822	},	960	},
823	;	961	;
824		962
825	$self = $class->SUPER::new (	963	$self = $class->SUPER::new (
…		…
831	$self->{vp}->add ($self->{scrolled});	969	$self->{vp}->add ($self->{scrolled});
832	$self->add ($self->{vp});	970	$self->add ($self->{vp});
833	$self->add ($self->{slider});	971	$self->add ($self->{slider});
834		972
835	$self	973	$self
		974	}
		975
		976	sub update {
		977	my ($self) = @_;
		978
		979	$self->SUPER::update;
		980
		981	# todo: overwrite size_allocate of child
		982	my $child = $self->{vp}->child;
		983	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
836	}	984	}
837		985
838	sub size_allocate {	986	sub size_allocate {
839	my ($self, $w, $h) = @_;	987	my ($self, $w, $h) = @_;
840		988
…		…
893		1041
894	our @ISA = CFClient::UI::Bin::;	1042	our @ISA = CFClient::UI::Bin::;
895		1043
896	use CFClient::OpenGL;	1044	use CFClient::OpenGL;
897		1045
898	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 =
899	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1051	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
900	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);
901		1053
902	sub new {	1054	sub new {
903	my $class = shift;	1055	my $class = shift;
904		1056
905	# TODO: user_x, user_y, overwrite moveto?
906
907	my $self = $class->SUPER::new (	1057	my $self = $class->SUPER::new (
908	bg => [1, 1, 1, 1],	1058	bg => [1, 1, 1, 1],
909	border_bg => [1, 1, 1, 1],	1059	border_bg => [1, 1, 1, 1],
910	border => 0.6,	1060	border => 0.6,
911	toplevel => 1,
912	can_events => 1,	1061	can_events => 1,
		1062	min_w => 16,
		1063	min_h => 16,
913	@_	1064	@_
914	);	1065	);
915		1066
916	$self->{title} &&= new CFClient::UI::Label	1067	$self->{title} &&= new CFClient::UI::Label
917	align => 0,	1068	align => 0,
…		…
970	my ($ev, $x, $y) = @_;	1121	my ($ev, $x, $y) = @_;
971		1122
972	my $dx = $ev->{x} - $ox;	1123	my $dx = $ev->{x} - $ox;
973	my $dy = $ev->{y} - $oy;	1124	my $dy = $ev->{y} - $oy;
974		1125
975	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1126	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
976	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1127	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1128
		1129	$self->realloc;
977	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1130	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
978	$self->check_size;
979	};	1131	};
980		1132
981	} elsif ($lr ^ $td) {	1133	} elsif ($lr ^ $td) {
982	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1134	my ($ox, $oy) = ($ev->{x}, $ev->{y});
983	my ($bx, $by) = ($self->{x}, $self->{y});	1135	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
985	$self->{motion} = sub {	1137	$self->{motion} = sub {
986	my ($ev, $x, $y) = @_;	1138	my ($ev, $x, $y) = @_;
987		1139
988	($x, $y) = ($ev->{x}, $ev->{y});	1140	($x, $y) = ($ev->{x}, $ev->{y});
989		1141
990	$self->move ($bx + $x - $ox, $by + $y - $oy);	1142	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
991	$self->update;
992	};	1143	};
993	}	1144	}
994	}	1145	}
995		1146
996	sub button_up {	1147	sub button_up {
…		…
1015	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1166	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1016		1167
1017	my $border = $self->border;	1168	my $border = $self->border;
1018		1169
1019	glColor @{ $self->{border_bg} };	1170	glColor @{ $self->{border_bg} };
1020	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1171	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1021	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1172	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1022	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1173	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1023	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1174	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1024		1175
1025	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1176	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1026	my $bg = $tex[0];	1177	glColor @{ $self->{bg} };
1027		1178
1028	# TODO: repeat texture not scale	1179	# TODO: repeat texture not scale
		1180	# solve this better(?)
1029	my $rep_x = $cw / $bg->{w};	1181	$bg->{s} = $cw / $bg->{w};
1030	my $rep_y = $ch / $bg->{h};	1182	$bg->{t} = $ch / $bg->{h};
1031
1032	glColor @{ $self->{bg} };
1033
1034	$bg->{s} = $rep_x;
1035	$bg->{t} = $rep_y;
1036	$bg->{wrap_mode} = 1;
1037	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1183	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1038	}	1184	}
1039		1185
1040	glDisable GL_TEXTURE_2D;	1186	glDisable GL_TEXTURE_2D;
1041		1187
…		…
1057	sub new {	1203	sub new {
1058	my $class = shift;	1204	my $class = shift;
1059		1205
1060	$class->SUPER::new (	1206	$class->SUPER::new (
1061	col_expand => [],	1207	col_expand => [],
1062	@_	1208	@_,
1063	)	1209	)
		1210	}
		1211
		1212	sub children {
		1213	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1064	}	1214	}
1065		1215
1066	sub add {	1216	sub add {
1067	my ($self, $x, $y, $child) = @_;	1217	my ($self, $x, $y, $child) = @_;
1068		1218
1069	$child->set_parent ($self);	1219	$child->set_parent ($self);
1070	$self->{children}[$y][$x] = $child;	1220	$self->{children}[$y][$x] = $child;
1071		1221
1072	$child->check_size;	1222	$self->realloc;
1073	}	1223	}
1074		1224
1075	sub children {
1076	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1077	}
1078
1079	# TODO: move to container class maybe? send childs a signal on removal?	1225	# TODO: move to container class maybe? send children a signal on removal?
1080	sub clear {	1226	sub clear {
1081	my ($self) = @_;	1227	my ($self) = @_;
1082		1228
1083	my @children = $self->children;	1229	my @children = $self->children;
1084	delete $self->{children};	1230	delete $self->{children};
…		…
1086	for (@children) {	1232	for (@children) {
1087	delete $_->{parent};	1233	delete $_->{parent};
1088	$_->hide;	1234	$_->hide;
1089	}	1235	}
1090		1236
1091	$self->update;	1237	$self->realloc;
1092	}	1238	}
1093		1239
1094	sub get_wh {	1240	sub get_wh {
1095	my ($self) = @_;	1241	my ($self) = @_;
1096		1242
…		…
1127	sub size_allocate {	1273	sub size_allocate {
1128	my ($self, $w, $h) = @_;	1274	my ($self, $w, $h) = @_;
1129		1275
1130	my ($ws, $hs) = $self->get_wh;	1276	my ($ws, $hs) = $self->get_wh;
1131		1277
1132	my $req_w = sum @$ws;	1278	my $req_w = (sum @$ws) || 1;
1133	my $req_h = sum @$hs;	1279	my $req_h = (sum @$hs) || 1;
1134		1280
1135	# TODO: nicer code && do row_expand	1281	# TODO: nicer code && do row_expand
1136	my @col_expand = @{$self->{col_expand}};	1282	my @col_expand = @{$self->{col_expand}};
1137	@col_expand = (1) x @$ws unless @col_expand;	1283	@col_expand = (1) x @$ws unless @col_expand;
1138	my $col_expand = (sum @col_expand) || 1;	1284	my $col_expand = (sum @col_expand) || 1;
…		…
1192	}	1338	}
1193	}	1339	}
1194		1340
1195	#############################################################################	1341	#############################################################################
1196		1342
1197	package CFClient::UI::HBox;	1343	package CFClient::UI::Box;
1198
1199	# TODO: wrap into common Box base class
1200		1344
1201	our @ISA = CFClient::UI::Container::;	1345	our @ISA = CFClient::UI::Container::;
1202		1346
1203	sub size_request {	1347	sub size_request {
1204	my ($self) = @_;	1348	my ($self) = @_;
1205		1349
1206	my @alloc = map [$_->size_request], @{$self->{children}};	1350	$self->{vertical}
1207		1351	? (
1208	(	1352	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1209	(List::Util::sum map $_->[0], @alloc),	1353	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1210	(List::Util::max map $_->[1], @alloc),	1354	)
1211	)	1355	: (
		1356	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1357	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1358	)
1212	}	1359	}
1213		1360
1214	sub size_allocate {	1361	sub size_allocate {
1215	my ($self, $w, $h) = @_;	1362	my ($self, $w, $h) = @_;
1216		1363
1217	($h, $w) = ($w, $h);	1364	my $space = $self->{vertical} ? $h : $w;
1218
1219	my $children = $self->{children};	1365	my $children = $self->{children};
1220		1366
1221	my @h = map $_->{req_w}, @$children;	1367	my @req;
1222		1368
1223	my $req_h = List::Util::sum @h;	1369	if ($self->{homogeneous}) {
1224		1370	@req = ($space / (@$children || 1)) x @$children;
1225	if ($req_h > $h) {
1226	# ah well, not enough space
1227	$_ *= $h / $req_h for @h;
1228	} else {	1371	} else {
		1372	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
		1373	my $req = List::Util::sum @req;
		1374
		1375	if ($req > $space) {
		1376	# ah well, not enough space
		1377	$_ *= $space / $req for @req;
		1378	} else {
1229	my $exp = List::Util::sum map $_->{expand}, @$children;	1379	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1230	$exp ||= 1;
1231		1380
		1381	$space = ($space - $req) / $expand; # remaining space to give away
		1382
		1383	$req[$_] += $space * $children->[$_]{expand}
1232	for (0 .. $#$children) {	1384	for 0 .. $#$children;
1233	my $child = $children->[$_];
1234
1235	my $alloc_h = $h[$_];
1236	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1237	$h[$_] = $alloc_h;
1238	}	1385	}
1239	}	1386	}
1240		1387
1241	CFClient::UI::harmonize \@h;	1388	CFClient::UI::harmonize \@req;
1242		1389
1243	my $y = 0;	1390	my $pos = 0;
1244	for (0 .. $#$children) {	1391	for (0 .. $#$children) {
1245	my $child = $children->[$_];
1246	my $h = $h[$_];	1392	my $alloc = $req[$_];
1247	$child->configure ($y, 0, $h, $w);	1393	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1248		1394
1249	$y += $h;	1395	$pos += $alloc;
1250	}	1396	}
1251		1397
1252	1	1398	1
1253	}	1399	}
1254		1400
1255	#############################################################################	1401	#############################################################################
1256		1402
		1403	package CFClient::UI::HBox;
		1404
		1405	our @ISA = CFClient::UI::Box::;
		1406
		1407	sub new {
		1408	my $class = shift;
		1409
		1410	$class->SUPER::new (
		1411	vertical => 0,
		1412	@_,
		1413	)
		1414	}
		1415
		1416	#############################################################################
		1417
1257	package CFClient::UI::VBox;	1418	package CFClient::UI::VBox;
1258		1419
1259	# TODO: wrap into common Box base class
1260
1261	our @ISA = CFClient::UI::Container::;	1420	our @ISA = CFClient::UI::Box::;
1262		1421
1263	sub size_request {	1422	sub new {
1264	my ($self) = @_;	1423	my $class = shift;
1265		1424
1266	my @alloc = map [$_->size_request], @{$self->{children}};	1425	$class->SUPER::new (
1267		1426	vertical => 1,
1268	(	1427	@_,
1269	(List::Util::max map $_->[0], @alloc),
1270	(List::Util::sum map $_->[1], @alloc),
1271	)	1428	)
1272	}
1273
1274	sub size_allocate {
1275	my ($self, $w, $h) = @_;
1276
1277	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1278
1279	my $children = $self->{children};
1280
1281	my @h = map $_->{req_h}, @$children;
1282
1283	my $req_h = List::Util::sum @h;
1284
1285	if ($req_h > $h) {
1286	# ah well, not enough space
1287	$_ *= $h / $req_h for @h;
1288	} else {
1289	my $exp = List::Util::sum map $_->{expand}, @$children;
1290	$exp ||= 1;
1291
1292	for (0 .. $#$children) {
1293	my $child = $children->[$_];
1294
1295	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1296	}
1297	}
1298
1299	CFClient::UI::harmonize \@h;
1300
1301	my $y = 0;
1302	for (0 .. $#$children) {
1303	my $child = $children->[$_];
1304	my $h = $h[$_];
1305	$child->configure (0, $y, $w, $h);
1306
1307	$y += $h;
1308	}
1309
1310	1
1311	}	1429	}
1312		1430
1313	#############################################################################	1431	#############################################################################
1314		1432
1315	package CFClient::UI::Label;	1433	package CFClient::UI::Label;
…		…
1332	ellipsise => 3, # end	1450	ellipsise => 3, # end
1333	layout => (new CFClient::Layout),	1451	layout => (new CFClient::Layout),
1334	fontsize => 1,	1452	fontsize => 1,
1335	align => -1,	1453	align => -1,
1336	valign => -1,	1454	valign => -1,
1337	padding => 2,	1455	padding_x => 2,
		1456	padding_y => 2,
1338	can_events => 0,	1457	can_events => 0,
1339	%arg	1458	%arg
1340	);	1459	);
1341		1460
1342	if (exists $self->{template}) {	1461	if (exists $self->{template}) {
…		…
1378	$self->{text} = "T$text";	1497	$self->{text} = "T$text";
1379		1498
1380	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1499	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1381	$self->{layout}->set_text ($text);	1500	$self->{layout}->set_text ($text);
1382		1501
		1502	$self->realloc;
1383	$self->update;	1503	$self->update;
1384	$self->check_size;
1385	}	1504	}
1386		1505
1387	sub set_markup {	1506	sub set_markup {
1388	my ($self, $markup) = @_;	1507	my ($self, $markup) = @_;
1389		1508
…		…
1393	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1512	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1394		1513
1395	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1514	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1396	$self->{layout}->set_markup ($markup);	1515	$self->{layout}->set_markup ($markup);
1397		1516
		1517	$self->realloc;
1398	$self->update;	1518	$self->update;
1399	$self->check_size;
1400	}	1519	}
1401		1520
1402	sub size_request {	1521	sub size_request {
1403	my ($self) = @_;	1522	my ($self) = @_;
1404		1523
…		…
1418		1537
1419	$w = List::Util::max $w, $w2;	1538	$w = List::Util::max $w, $w2;
1420	$h = List::Util::max $h, $h2;	1539	$h = List::Util::max $h, $h2;
1421	}	1540	}
1422		1541
1423	(	1542	($w, $h)
1424	$w + $self->{padding} * 2,
1425	$h + $self->{padding} * 2,
1426	)
1427	}	1543	}
1428		1544
1429	sub size_allocate {	1545	sub size_allocate {
1430	my ($self, $w, $h) = @_;	1546	my ($self, $w, $h) = @_;
1431		1547
1432	delete $self->{texture};	1548	delete $self->{texture}
		1549	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1433	}	1550	}
1434		1551
1435	sub set_fontsize {	1552	sub set_fontsize {
1436	my ($self, $fontsize) = @_;	1553	my ($self, $fontsize) = @_;
1437		1554
1438	$self->{fontsize} = $fontsize;	1555	$self->{fontsize} = $fontsize;
1439	delete $self->{texture};	1556	delete $self->{texture};
1440		1557
1441	$self->update;	1558	$self->realloc;
1442	$self->check_size;
1443	}	1559	}
1444		1560
1445	sub _draw {	1561	sub _draw {
1446	my ($self) = @_;	1562	my ($self) = @_;
1447		1563
…		…
1455	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1571	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1456	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1572	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1457		1573
1458	my $tex = new_from_layout CFClient::Texture $self->{layout};	1574	my $tex = new_from_layout CFClient::Texture $self->{layout};
1459		1575
1460	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1576	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1461	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1577	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1462	: ($self->{w} - $tex->{w}) * 0.5);	1578	: ($self->{w} - $tex->{w}) * 0.5);
1463		1579
1464	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1580	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1465	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1581	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1466	: ($self->{h} - $tex->{h}) * 0.5);	1582	: ($self->{h} - $tex->{h}) * 0.5);
1467		1583
1468	$tex	1584	$tex
1469	};	1585	};
1470		1586
…		…
1519	$self->{text} = $text;	1635	$self->{text} = $text;
1520		1636
1521	$text =~ s/./*/g if $self->{hidden};	1637	$text =~ s/./*/g if $self->{hidden};
1522	$self->{layout}->set_text ("$text ");	1638	$self->{layout}->set_text ("$text ");
1523		1639
1524	$self->emit (changed => $self->{text});	1640	$self->_emit (changed => $self->{text});
1525	}	1641	}
1526		1642
1527	sub set_text {	1643	sub set_text {
1528	my ($self, $text) = @_;	1644	my ($self, $text) = @_;
1529		1645
1530	$self->{cursor} = length $text;	1646	$self->{cursor} = length $text;
1531	$self->_set_text ($text);	1647	$self->_set_text ($text);
1532	$self->update;	1648
1533	$self->check_size;	1649	$self->realloc;
1534	}	1650	}
1535		1651
1536	sub get_text {	1652	sub get_text {
1537	$_[0]{text}	1653	$_[0]{text}
1538	}	1654	}
…		…
1541	my ($self) = @_;	1657	my ($self) = @_;
1542		1658
1543	my ($w, $h) = $self->SUPER::size_request;	1659	my ($w, $h) = $self->SUPER::size_request;
1544		1660
1545	($w + 1, $h) # add 1 for cursor	1661	($w + 1, $h) # add 1 for cursor
1546	}
1547
1548	sub size_allocate {
1549	my ($self, $w, $h) = @_;
1550
1551	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1552	}	1662	}
1553		1663
1554	sub key_down {	1664	sub key_down {
1555	my ($self, $ev) = @_;	1665	my ($self, $ev) = @_;
1556		1666
…		…
1571	} elsif ($sym == CFClient::SDLK_HOME) {	1681	} elsif ($sym == CFClient::SDLK_HOME) {
1572	$self->{cursor} = 0;	1682	$self->{cursor} = 0;
1573	} elsif ($sym == CFClient::SDLK_END) {	1683	} elsif ($sym == CFClient::SDLK_END) {
1574	$self->{cursor} = length $text;	1684	$self->{cursor} = length $text;
1575	} elsif ($uni == 27) {	1685	} elsif ($uni == 27) {
1576	$self->emit ('escape');	1686	$self->_emit ('escape');
1577	} elsif ($uni) {	1687	} elsif ($uni) {
1578	substr $text, $self->{cursor}++, 0, chr $uni;	1688	substr $text, $self->{cursor}++, 0, chr $uni;
1579	}	1689	}
1580		1690
1581	$self->_set_text ($text);	1691	$self->_set_text ($text);
1582	$self->update;	1692
1583	$self->check_size;	1693	$self->realloc;
1584	}	1694	}
1585		1695
1586	sub focus_in {	1696	sub focus_in {
1587	my ($self) = @_;	1697	my ($self) = @_;
1588		1698
…		…
1668	if ($sym == 13) {	1778	if ($sym == 13) {
1669	unshift @{$self->{history}},	1779	unshift @{$self->{history}},
1670	my $txt = $self->get_text;	1780	my $txt = $self->get_text;
1671	$self->{history_pointer} = -1;	1781	$self->{history_pointer} = -1;
1672	$self->{history_saveback} = '';	1782	$self->{history_saveback} = '';
1673	$self->emit (activate => $txt);	1783	$self->_emit (activate => $txt);
1674	$self->update;	1784	$self->update;
1675		1785
1676	} elsif ($sym == CFClient::SDLK_UP) {	1786	} elsif ($sym == CFClient::SDLK_UP) {
1677	if ($self->{history_pointer} < 0) {	1787	if ($self->{history_pointer} < 0) {
1678	$self->{history_saveback} = $self->get_text;	1788	$self->{history_saveback} = $self->get_text;
…		…
1715		1825
1716	sub new {	1826	sub new {
1717	my $class = shift;	1827	my $class = shift;
1718		1828
1719	$class->SUPER::new (	1829	$class->SUPER::new (
1720	padding => 4,	1830	padding_x => 4,
		1831	padding_y => 4,
1721	fg => [1, 1, 1],	1832	fg => [1, 1, 1],
1722	active_fg => [0, 0, 1],	1833	active_fg => [0, 0, 1],
1723	can_hover => 1,	1834	can_hover => 1,
1724	align => 0,	1835	align => 0,
1725	valign => 0,	1836	valign => 0,
1726	can_events => 1,	1837	can_events => 1,
1727	@_	1838	@_
1728	)	1839	)
1729	}	1840	}
1730		1841
		1842	sub activate { }
		1843
1731	sub button_up {	1844	sub button_up {
1732	my ($self, $ev, $x, $y) = @_;	1845	my ($self, $ev, $x, $y) = @_;
1733		1846
		1847	$self->emit ("activate")
1734	if ($x >= 0 && $x < $self->{w}	1848	if $x >= 0 && $x < $self->{w}
1735	&& $y >= 0 && $y < $self->{h}) {	1849	&& $y >= 0 && $y < $self->{h};
1736	$self->emit ("activate");
1737	}
1738	}	1850	}
1739		1851
1740	sub _draw {	1852	sub _draw {
1741	my ($self) = @_;	1853	my ($self) = @_;
1742		1854
…		…
1771		1883
1772	sub new {	1884	sub new {
1773	my $class = shift;	1885	my $class = shift;
1774		1886
1775	$class->SUPER::new (	1887	$class->SUPER::new (
1776	padding => 2,	1888	padding_x => 2,
		1889	padding_y => 2,
1777	fg => [1, 1, 1],	1890	fg => [1, 1, 1],
1778	active_fg => [1, 1, 0],	1891	active_fg => [1, 1, 0],
1779	bg => [0, 0, 0, 0.2],	1892	bg => [0, 0, 0, 0.2],
1780	active_bg => [1, 1, 1, 0.5],	1893	active_bg => [1, 1, 1, 0.5],
1781	state => 0,	1894	state => 0,
…		…
1785	}	1898	}
1786		1899
1787	sub size_request {	1900	sub size_request {
1788	my ($self) = @_;	1901	my ($self) = @_;
1789		1902
1790	($self->{padding} * 2 + 6) x 2	1903	(6) x 2
1791	}	1904	}
1792		1905
1793	sub button_down {	1906	sub button_down {
1794	my ($self, $ev, $x, $y) = @_;	1907	my ($self, $ev, $x, $y) = @_;
1795		1908
1796	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1909	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1797	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1910	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1798	$self->{state} = !$self->{state};	1911	$self->{state} = !$self->{state};
1799	$self->emit (changed => $self->{state});	1912	$self->_emit (changed => $self->{state});
1800	}	1913	}
1801	}	1914	}
1802		1915
1803	sub _draw {	1916	sub _draw {
1804	my ($self) = @_;	1917	my ($self) = @_;
1805		1918
1806	$self->SUPER::_draw;	1919	$self->SUPER::_draw;
1807		1920
1808	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1921	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1809		1922
1810	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1923	my ($w, $h) = @$self{qw(w h)};
		1924
		1925	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1811		1926
1812	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1927	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1813		1928
1814	my $tex = $self->{state} ? $tex[1] : $tex[0];	1929	my $tex = $self->{state} ? $tex[1] : $tex[0];
1815		1930
…		…
2080	fg => [1, 1, 1],	2195	fg => [1, 1, 1],
2081	active_fg => [0, 0, 0],	2196	active_fg => [0, 0, 0],
2082	bg => [0, 0, 0, 0.2],	2197	bg => [0, 0, 0, 0.2],
2083	active_bg => [1, 1, 1, 0.5],	2198	active_bg => [1, 1, 1, 0.5],
2084	range => [0, 0, 100, 10, 0],	2199	range => [0, 0, 100, 10, 0],
2085	req_w => $::WIDTH / 80,	2200	min_w => $::WIDTH / 80,
2086	req_h => $::WIDTH / 80,	2201	min_h => $::WIDTH / 80,
2087	vertical => 0,	2202	vertical => 0,
2088	can_hover => 1,	2203	can_hover => 1,
2089	inner_pad => 0.02,	2204	inner_pad => 0.02,
2090	@_	2205	@_
2091	);	2206	);
…		…
2094	$self->update;	2209	$self->update;
2095		2210
2096	$self	2211	$self
2097	}	2212	}
2098		2213
		2214	sub changed { }
		2215
2099	sub set_range {	2216	sub set_range {
2100	my ($self, $range) = @_;	2217	my ($self, $range) = @_;
2101		2218
2102	$self->{range} = $range;	2219	($range, $self->{range}) = ($self->{range}, $range);
2103		2220
2104	$self->update;	2221	$self->update
		2222	if "@$range" ne "@{$self->{range}}";
2105	}	2223	}
2106		2224
2107	sub set_value {	2225	sub set_value {
2108	my ($self, $value) = @_;	2226	my ($self, $value) = @_;
2109		2227
…		…
2120	if $unit;	2238	if $unit;
2121		2239
2122	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2240	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2123		2241
2124	if ($value != $old_value) {	2242	if ($value != $old_value) {
2125	$self->emit (changed => $value);	2243	$self->_emit (changed => $value);
2126	$self->update;	2244	$self->update;
2127	}	2245	}
2128	}	2246	}
2129		2247
2130	sub size_request {	2248	sub size_request {
2131	my ($self) = @_;	2249	my ($self) = @_;
2132		2250
2133	my $w = $self->{req_w};	2251	($self->{req_w}, $self->{req_h})
2134	my $h = $self->{req_h};
2135
2136	$self->{vertical} ? ($h, $w) : ($w, $h)
2137	}	2252	}
2138		2253
2139	sub button_down {	2254	sub button_down {
2140	my ($self, $ev, $x, $y) = @_;	2255	my ($self, $ev, $x, $y) = @_;
2141		2256
…		…
2492		2607
2493	sub new {	2608	sub new {
2494	my $class = shift;	2609	my $class = shift;
2495		2610
2496	my $self = $class->SUPER::new (	2611	my $self = $class->SUPER::new (
2497	state => 0,	2612	state => 0,
2498	connect_activate => \&toggle_flopper,	2613	on_activate => \&toggle_flopper,
2499	@_	2614	@_
2500	);	2615	);
2501		2616
2502	if ($self->{state}) {
2503	$self->{state} = 0;
2504	$self->toggle_flopper;
2505	}
2506
2507	$self	2617	$self
2508	}	2618	}
2509		2619
2510	sub toggle_flopper {	2620	sub toggle_flopper {
2511	my ($self) = @_;	2621	my ($self) = @_;
2512		2622
2513	# TODO: use animation	2623	$self->{other}->toggle_visibility;
2514	if ($self->{state} = !$self->{state}) {
2515	$CFClient::UI::ROOT->add ($self->{other});
2516	$self->{other}->move ($self->coord2global (0, $self->{h}));
2517	$self->emit ("open");
2518	} else {
2519	$CFClient::UI::ROOT->remove ($self->{other});
2520	$self->emit ("close");
2521	}
2522
2523	$self->emit (changed => $self->{state});
2524	}	2624	}
2525		2625
2526	#############################################################################	2626	#############################################################################
2527		2627
2528	package CFClient::UI::Tooltip;	2628	package CFClient::UI::Tooltip;
…		…
2541	}	2641	}
2542		2642
2543	sub set_tooltip_from {	2643	sub set_tooltip_from {
2544	my ($self, $widget) = @_;	2644	my ($self, $widget) = @_;
2545		2645
		2646	my $tooltip = $widget->{tooltip};
		2647
		2648	if ($ENV{CFPLUS_DEBUG} & 2) {
		2649	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2650	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2651	. "req $widget->{req_w} $widget->{req_h}\n"
		2652	. "visible $widget->{visible}";
		2653	}
		2654
2546	$self->add (new CFClient::UI::Label	2655	$self->add (new CFClient::UI::Label
2547	markup => $widget->{tooltip},	2656	markup => $tooltip,
2548	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2657	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2549	fontsize => 0.8,	2658	fontsize => 0.8,
2550	fg => [0, 0, 0, 1],	2659	fg => [0, 0, 0, 1],
2551	ellipsise => 0,	2660	ellipsise => 0,
2552	font => ($widget->{tooltip_font} || $::FONT_PROP),	2661	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2563		2672
2564	sub size_allocate {	2673	sub size_allocate {
2565	my ($self, $w, $h) = @_;	2674	my ($self, $w, $h) = @_;
2566		2675
2567	$self->SUPER::size_allocate ($w - 4, $h - 4);	2676	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2677	}
		2678
		2679	sub visibility_change {
		2680	my ($self, $visible) = @_;
		2681
		2682	return unless $visible;
		2683
		2684	$self->{root}->on_post_alloc ("move_$self" => sub {
		2685	my $widget = $self->{owner}
		2686	or return;
		2687
		2688	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2689
		2690	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2691	if $x + $self->{w} > $::WIDTH;
		2692
		2693	$self->move_abs ($x, $y);
		2694	});
2568	}	2695	}
2569		2696
2570	sub _draw {	2697	sub _draw {
2571	my ($self) = @_;	2698	my ($self) = @_;
2572		2699
…		…
2589	glVertex $w, $h;	2716	glVertex $w, $h;
2590	glVertex $w, 0;	2717	glVertex $w, 0;
2591	glEnd;	2718	glEnd;
2592		2719
2593	glTranslate 2 - 0.375, 2 - 0.375;	2720	glTranslate 2 - 0.375, 2 - 0.375;
		2721
2594	$self->SUPER::_draw;	2722	$self->SUPER::_draw;
2595	}	2723	}
2596		2724
2597	#############################################################################	2725	#############################################################################
2598		2726
…		…
2604		2732
2605	sub new {	2733	sub new {
2606	my $class = shift;	2734	my $class = shift;
2607		2735
2608	my $self = $class->SUPER::new (	2736	my $self = $class->SUPER::new (
2609	aspect => 1,	2737	aspect => 1,
		2738	can_events => 0,
2610	@_,	2739	@_,
2611	);	2740	);
2612		2741
2613	if ($self->{anim} && $self->{animspeed}) {	2742	if ($self->{anim} && $self->{animspeed}) {
2614	Scalar::Util::weaken (my $widget = $self);	2743	Scalar::Util::weaken (my $widget = $self);
…		…
2673	$self->SUPER::DESTROY;	2802	$self->SUPER::DESTROY;
2674	}	2803	}
2675		2804
2676	#############################################################################	2805	#############################################################################
2677		2806
2678	package CFClient::UI::InventoryItem;
2679
2680	our @ISA = CFClient::UI::HBox::;
2681
2682	sub _item_to_desc {
2683	my ($item) = @_;
2684
2685	my $desc =
2686	$item->{nrof} < 2
2687	? $item->{name}
2688	: "$item->{nrof} × $item->{name_pl}";
2689
2690	$item->{flags} & Crossfire::Protocol::F_OPEN
2691	and $desc .= " (open)";
2692	$item->{flags} & Crossfire::Protocol::F_APPLIED
2693	and $desc .= " (applied)";
2694	$item->{flags} & Crossfire::Protocol::F_UNPAID
2695	and $desc .= " (unpaid)";
2696	$item->{flags} & Crossfire::Protocol::F_MAGIC
2697	and $desc .= " (magic)";
2698	$item->{flags} & Crossfire::Protocol::F_CURSED
2699	and $desc .= " (cursed)";
2700	$item->{flags} & Crossfire::Protocol::F_DAMNED
2701	and $desc .= " (damned)";
2702	$item->{flags} & Crossfire::Protocol::F_LOCKED
2703	and $desc .= " *";
2704
2705	$desc
2706	}
2707
2708	sub new {
2709	my $class = shift;
2710
2711	my %args = @_;
2712
2713	my $item = delete $args{item};
2714
2715	my $desc = _item_to_desc ($item);
2716
2717	my $self = $class->SUPER::new (
2718	can_hover => 1,
2719	can_events => 1,
2720	tooltip => ((CFClient::UI::Label::escape $desc)
2721	. "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2722	connect_button_down => sub {
2723	my ($self, $ev, $x, $y) = @_;
2724
2725	# todo: maybe put examine on 1? but should just be a tooltip :(
2726	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2727	my $targ = $::CONN->{player}{tag};
2728
2729	if ($item->{container} == $::CONN->{player}{tag}) {
2730	$targ = $main::OPENCONT;
2731	}
2732
2733	$::CONN->send ("move $targ $item->{tag} 0");
2734	} elsif ($ev->{button} == 1) {
2735	$::CONN->send ("examine $item->{tag}");
2736	} elsif ($ev->{button} == 2) {
2737	$::CONN->send ("apply $item->{tag}");
2738	} elsif ($ev->{button} == 3) {
2739	my @menu_items = (
2740	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2741	["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2742	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2743	(
2744	$item->{flags} & Crossfire::Protocol::F_LOCKED
2745	? (
2746	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2747	)
2748	: (
2749	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2750	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2751	)
2752	),
2753	);
2754
2755	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2756	}
2757
2758	1
2759	},
2760	%args
2761	);
2762
2763
2764	$self->add (new CFClient::UI::Face
2765	can_events => 0,
2766	face => $item->{face},
2767	anim => $item->{anim},
2768	animspeed => $item->{animspeed},
2769	);
2770
2771	$self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2772
2773	$self->{item} = $item;
2774
2775	$self->update_item;
2776
2777	$self
2778	}
2779
2780	sub update_item {
2781	my ($self) = @_;
2782
2783	my $desc = _item_to_desc ($self->{item});
2784
2785	$self->{name_lbl}->set_text ($desc);
2786	}
2787
2788	#############################################################################
2789
2790	package CFClient::UI::Inventory;
2791
2792	our @ISA = CFClient::UI::ScrolledWindow::;
2793
2794	sub new {
2795	my $class = shift;
2796
2797	my $self = $class->SUPER::new (
2798	scrolled => (new CFClient::UI::Table),
2799	@_,
2800	);
2801
2802	$self
2803	}
2804
2805	sub set_items {
2806	my ($self, $items) = @_;
2807
2808	$self->{scrolled}->clear;
2809	return unless $items;
2810
2811	my @items = sort {
2812	($a->{type} <=> $b->{type})
2813	or ($a->{name} cmp $b->{name})
2814	} @$items;
2815
2816	$self->{real_items} = \@items;
2817
2818	for my $item (@items) {
2819	$item->{item} = $item;
2820	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2821	$item->update_item ();
2822	}
2823
2824	my $i = 0;
2825	for (@items) {
2826	$self->{scrolled}->add (0, $i, $_);
2827	my $nrof = $_->{item}->{nrof} || 1;
2828	$self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2829	}
2830
2831	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2832	}
2833
2834	sub size_request {
2835	my ($self) = @_;
2836	($self->{req_w}, $self->{req_h});
2837	}
2838
2839	#############################################################################
2840
2841	package CFClient::UI::Menu;	2807	package CFClient::UI::Menu;
2842		2808
2843	our @ISA = CFClient::UI::FancyFrame::;	2809	our @ISA = CFClient::UI::FancyFrame::;
2844		2810
2845	use CFClient::OpenGL;	2811	use CFClient::OpenGL;
…		…
2876		2842
2877	# popup given the event (must be a mouse button down event currently)	2843	# popup given the event (must be a mouse button down event currently)
2878	sub popup {	2844	sub popup {
2879	my ($self, $ev) = @_;	2845	my ($self, $ev) = @_;
2880		2846
2881	$self->emit ("popdown");	2847	$self->_emit ("popdown");
2882		2848
2883	# maybe save $GRAB? must be careful about events...	2849	# maybe save $GRAB? must be careful about events...
2884	$GRAB = $self;	2850	$GRAB = $self;
2885	$self->{button} = $ev->{button};	2851	$self->{button} = $ev->{button};
2886		2852
2887	$self->show;	2853	$self->show;
2888	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2854	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2889	}	2855	}
2890		2856
2891	sub mouse_motion {	2857	sub mouse_motion {
2892	my ($self, $ev, $x, $y) = @_;	2858	my ($self, $ev, $x, $y) = @_;
2893		2859
…		…
2901		2867
2902	if ($ev->{button} == $self->{button}) {	2868	if ($ev->{button} == $self->{button}) {
2903	undef $GRAB;	2869	undef $GRAB;
2904	$self->hide;	2870	$self->hide;
2905		2871
2906	$self->emit ("popdown");	2872	$self->_emit ("popdown");
2907	$self->{hover}[1]->() if $self->{hover};	2873	$self->{hover}[1]->() if $self->{hover};
2908	}	2874	}
2909	}	2875	}
2910		2876
2911	#############################################################################	2877	#############################################################################
…		…
2973	sub add {	2939	sub add {
2974	my ($self, $text, %arg) = @_;	2940	my ($self, $text, %arg) = @_;
2975		2941
2976	$text =~ s/^\s+//;	2942	$text =~ s/^\s+//;
2977	$text =~ s/\s+$//;	2943	$text =~ s/\s+$//;
		2944
		2945	return unless $text;
2978		2946
2979	my $timeout = time + ((delete $arg{timeout}) || 60);	2947	my $timeout = time + ((delete $arg{timeout}) || 60);
2980		2948
2981	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	2949	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2982		2950
…		…
3016	$self->SUPER::reconfigure;	2984	$self->SUPER::reconfigure;
3017	}	2985	}
3018		2986
3019	#############################################################################	2987	#############################################################################
3020		2988
3021	package CFClient::UI::Root;	2989	package CFClient::UI::Inventory;
3022		2990
3023	our @ISA = CFClient::UI::Container::;	2991	our @ISA = CFClient::UI::ScrolledWindow::;
3024
3025	use CFClient::OpenGL;
3026		2992
3027	sub new {	2993	sub new {
3028	my $class = shift;	2994	my $class = shift;
3029		2995
3030	$class->SUPER::new (	2996	my $self = $class->SUPER::new (
		2997	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3031	@_,	2998	@_,
3032	)	2999	);
3033	}
3034		3000
3035	sub configure {	3001	$self
		3002	}
		3003
		3004	sub set_items {
		3005	my ($self, $items) = @_;
		3006
		3007	$self->{scrolled}->clear;
		3008	return unless $items;
		3009
		3010	my @items = sort {
		3011	($a->{type} <=> $b->{type})
		3012	or ($a->{name} cmp $b->{name})
		3013	} @$items;
		3014
		3015	$self->{real_items} = \@items;
		3016
		3017	my $row = 0;
		3018	for my $item (@items) {
		3019	CFClient::Item::update_widgets $item;
		3020
		3021	$self->{scrolled}->add (0, $row, $item->{face_widget});
		3022	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		3023	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		3024
		3025	$row++;
		3026	}
		3027	}
		3028
		3029	#############################################################################
		3030
		3031	package CFClient::UI::BindEditor;
		3032
		3033	our @ISA = CFClient::UI::FancyFrame::;
		3034
		3035	sub new {
		3036	my $class = shift;
		3037
		3038	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3039
		3040	$self->add (my $vb = new CFClient::UI::VBox);
		3041
		3042
		3043	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3044	text => "start recording",
		3045	tooltip => "Start/Stops recording of actions."
		3046	."All subsequent actions after the recording started will be captured."
		3047	."The actions are displayed after the record was stopped."
		3048	."To bind the action you have to click on the 'Bind' button",
		3049	on_activate => sub {
		3050	unless ($self->{recording}) {
		3051	$self->start;
		3052	} else {
		3053	$self->stop;
		3054	}
		3055	});
		3056
		3057	$vb->add (new CFClient::UI::Label text => "Actions:");
		3058	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3059
		3060	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3061	$vb->add (my $hb = new CFClient::UI::HBox);
		3062	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3063	$hb->add (new CFClient::UI::Button
		3064	text => "bind",
		3065	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3066	on_activate => sub {
		3067	$self->ask_for_bind;
		3068	});
		3069
		3070	$vb->add (my $hb = new CFClient::UI::HBox);
		3071	$hb->add (new CFClient::UI::Button
		3072	text => "ok",
		3073	expand => 1,
		3074	tooltip => "This closes the binding editor and saves the binding",
		3075	on_activate => sub {
		3076	$self->hide;
		3077	$self->commit;
		3078	});
		3079
		3080	$hb->add (new CFClient::UI::Button
		3081	text => "cancel",
		3082	expand => 1,
		3083	tooltip => "This closes the binding editor without saving",
		3084	on_activate => sub {
		3085	$self->hide;
		3086	$self->{binding_cancel}->()
		3087	if $self->{binding_cancel};
		3088	});
		3089
		3090	$self->update_binding_widgets;
		3091
		3092	$self
		3093	}
		3094
		3095	sub commit {
		3096	my ($self) = @_;
		3097	my ($mod, $sym, $cmds) = $self->get_binding;
		3098	if ($sym != 0 && @$cmds > 0) {
		3099	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3100	."'. Don't forget 'Save Config'!");
		3101	$self->{binding_change}->($mod, $sym, $cmds)
		3102	if $self->{binding_change};
		3103	} else {
		3104	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3105	$self->{binding_cancel}->()
		3106	if $self->{binding_cancel};
		3107	}
		3108	}
		3109
		3110	sub start {
		3111	my ($self) = @_;
		3112
		3113	$self->{rec_btn}->set_text ("stop recording");
		3114	$self->{recording} = 1;
		3115	$self->clear_command_list;
		3116	$::CONN->start_record if $::CONN;
		3117	}
		3118
		3119	sub stop {
		3120	my ($self) = @_;
		3121
		3122	$self->{rec_btn}->set_text ("start recording");
		3123	$self->{recording} = 0;
		3124
		3125	my $rec;
		3126	$rec = $::CONN->stop_record if $::CONN;
		3127	return unless ref $rec eq 'ARRAY';
		3128	$self->set_command_list ($rec);
		3129	}
		3130
		3131	# if $commit is true, the binding will be set after the user entered a key combo
		3132	sub ask_for_bind {
		3133	my ($self, $commit) = @_;
		3134
		3135	CFClient::Binder::open_binding_dialog (sub {
		3136	my ($mod, $sym) = @_;
		3137	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3138	$self->update_binding_widgets;
		3139	$self->commit if $commit;
		3140	});
		3141	}
		3142
		3143	# $mod and $sym are the modifiers and key symbol
		3144	# $cmds is a array ref of strings (the commands)
		3145	# $cb is the callback that is executed on OK
		3146	# $ccb is the callback that is executed on CANCEL and
		3147	# when the binding was unsuccessful on OK
		3148	sub set_binding {
3036	my ($self, $x, $y, $w, $h) = @_;	3149	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3037		3150
3038	$self->{w} = $w;	3151	$self->clear_command_list;
3039	$self->{h} = $h;	3152	$self->{recording} = 0;
3040	}	3153	$self->{rec_btn}->set_text ("start recording");
3041		3154
3042	sub check_size {	3155	$self->{binding} = [$mod, $sym];
		3156	$self->{commands} = $cmds;
		3157
		3158	$self->{binding_change} = $cb;
		3159	$self->{binding_cancel} = $ccb;
		3160
		3161	$self->update_binding_widgets;
		3162	}
		3163
		3164	# this is a shortcut method that asks for a binding
		3165	# and then just binds it.
		3166	sub do_quick_binding {
3043	my ($self) = @_;	3167	my ($self, $cmds) = @_;
		3168	$self->set_binding (undef, undef, $cmds, sub {
		3169	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3170	});
		3171	$self->ask_for_bind (1);
		3172	}
3044		3173
3045	$self->size_allocate ($self->{w}, $self->{h})	3174	sub update_binding_widgets {
3046	if $self->{w};	3175	my ($self) = @_;
		3176	my ($mod, $sym, $cmds) = $self->get_binding;
		3177	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3178	$self->set_command_list ($cmds);
		3179	}
		3180
		3181	sub get_binding {
		3182	my ($self) = @_;
		3183	return (
		3184	$self->{binding}->[0],
		3185	$self->{binding}->[1],
		3186	[ grep { defined $_ } @{$self->{commands}} ]
		3187	);
		3188	}
		3189
		3190	sub clear_command_list {
		3191	my ($self) = @_;
		3192	$self->{cmdbox}->clear ();
		3193	}
		3194
		3195	sub set_command_list {
		3196	my ($self, $cmds) = @_;
		3197
		3198	$self->{cmdbox}->clear ();
		3199	$self->{commands} = $cmds;
		3200
		3201	my $idx = 0;
		3202
		3203	for (@$cmds) {
		3204	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3205
		3206	my $i = $idx;
		3207	$hb->add (new CFClient::UI::Label text => $_);
		3208	$hb->add (new CFClient::UI::Button
		3209	text => "delete",
		3210	tooltip => "Deletes the action from the record",
		3211	on_activate => sub {
		3212	$self->{cmdbox}->remove ($hb);
		3213	$cmds->[$i] = undef;
		3214	});
		3215
		3216
		3217	$idx++
		3218	}
		3219	}
		3220
		3221	#############################################################################
		3222
		3223	package CFClient::UI::SpellList;
		3224
		3225	our @ISA = CFClient::UI::FancyFrame::;
		3226
		3227	sub new {
		3228	my $class = shift;
		3229
		3230	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3231
		3232	$self->add (new CFClient::UI::ScrolledWindow
		3233	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3234
		3235	$self;
		3236	}
		3237
		3238	# XXX: Do sorting? Argl...
		3239	sub add_spell {
		3240	my ($self, $spell) = @_;
		3241	$self->{spells}->{$spell->{name}} = $spell;
		3242
		3243	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3244	face => $spell->{face},
		3245	can_hover => 1,
		3246	can_events => 1,
		3247	tooltip => $spell->{message});
		3248
		3249	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3250	text => $spell->{name},
		3251	can_hover => 1,
		3252	can_events => 1,
		3253	tooltip => $spell->{message},
		3254	expand => 1);
		3255
		3256	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3257	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3258	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3259	expand => 1);
		3260
		3261	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3262	text => "bind to key",
		3263	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3264	}
		3265
		3266	sub rebuild_spell_list {
		3267	my ($self) = @_;
		3268	$self->{tbl_idx} = 0;
		3269	$self->add_spell ($_) for values %{$self->{spells}};
		3270	}
		3271
		3272	sub remove_spell {
		3273	my ($self, $spell) = @_;
		3274	delete $self->{spells}->{$spell->{name}};
		3275	$self->rebuild_spell_list;
		3276	}
		3277
		3278	#############################################################################
		3279
		3280	package CFClient::UI::Root;
		3281
		3282	our @ISA = CFClient::UI::Container::;
		3283
		3284	use CFClient::OpenGL;
		3285
		3286	sub new {
		3287	my $class = shift;
		3288
		3289	my $self = $class->SUPER::new (
		3290	visible => 1,
		3291	@_,
		3292	);
		3293
		3294	Scalar::Util::weaken ($self->{root} = $self);
		3295
		3296	$self
3047	}	3297	}
3048		3298
3049	sub size_request {	3299	sub size_request {
3050	my ($self) = @_;	3300	my ($self) = @_;
3051		3301
3052	($self->{w}, $self->{h})	3302	($self->{w}, $self->{h})
		3303	}
		3304
		3305	sub _to_pixel {
		3306	my ($coord, $size, $max) = @_;
		3307
		3308	$coord =
		3309	$coord eq "center" ? ($max - $size) * 0.5
		3310	: $coord eq "max" ? $max
		3311	: $coord;
		3312
		3313	$coord = 0 if $coord < 0;
		3314	$coord = $max - $size if $coord > $max - $size;
		3315
		3316	int $coord + 0.5
3053	}	3317	}
3054		3318
3055	sub size_allocate {	3319	sub size_allocate {
3056	my ($self, $w, $h) = @_;	3320	my ($self, $w, $h) = @_;
3057		3321
3058	my $old_w = $self->{old_w}; $self->{old_w} = $w;
3059	my $old_h = $self->{old_h}; $self->{old_h} = $h;
3060
3061	CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
3062	if $old_w && $old_h && ($old_w != $w || $old_h != $h);
3063
3064	for my $child ($self->children) {	3322	for my $child ($self->children) {
3065	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3323	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3066		3324
3067	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3325	$X = $child->{force_x} if exists $child->{force_x};
3068	if exists $child->{req_x};	3326	$Y = $child->{force_y} if exists $child->{force_y};
3069		3327
3070	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3328	$X = _to_pixel $X, $W, $self->{w};
3071	if exists $child->{req_y};	3329	$Y = _to_pixel $Y, $H, $self->{h};
3072
3073	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3074	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3075		3330
3076	$child->configure ($X, $Y, $W, $H);	3331	$child->configure ($X, $Y, $W, $H);
3077	}	3332	}
3078	}	3333	}
3079		3334
…		…
3090	}	3345	}
3091		3346
3092	sub update {	3347	sub update {
3093	my ($self) = @_;	3348	my ($self) = @_;
3094		3349
3095	$self->check_size;
3096	$::WANT_REFRESH++;	3350	$::WANT_REFRESH++;
3097	}	3351	}
3098		3352
3099	sub add {	3353	sub add {
3100	my ($self, @children) = @_;	3354	my ($self, @children) = @_;
3101		3355
3102	for (my @widgets = @children; my $w = pop @widgets; ) {
3103	push @widgets, $w->children;
3104	$w->{root} = $self;
3105	$w->{visible} = 1;
3106	}
3107
3108	for my $child (@children) {
3109	$child->{toplevel} = 1;	3356	$_->{is_toplevel} = 1
3110		3357	for @children;
3111	# integerise window positions
3112	$child->{x} = int $child->{x};
3113	$child->{y} = int $child->{y};
3114	}
3115		3358
3116	$self->SUPER::add (@children);	3359	$self->SUPER::add (@children);
3117	}	3360	}
3118		3361
3119	sub remove {	3362	sub remove {
3120	my ($self, @children) = @_;	3363	my ($self, @children) = @_;
3121		3364
3122	$self->SUPER::remove (@children);	3365	$self->SUPER::remove (@children);
		3366
		3367	delete $self->{is_toplevel}
		3368	for @children;
3123		3369
3124	while (@children) {	3370	while (@children) {
3125	my $w = pop @children;	3371	my $w = pop @children;
3126	push @children, $w->children;	3372	push @children, $w->children;
3127	delete $w->{visible};	3373	$w->set_invisible;
3128	}	3374	}
3129	}	3375	}
3130		3376
3131	sub on_refresh {	3377	sub on_refresh {
3132	my ($self, $id, $cb) = @_;	3378	my ($self, $id, $cb) = @_;
…		…
3146	while ($self->{refresh_hook}) {	3392	while ($self->{refresh_hook}) {
3147	$_->()	3393	$_->()
3148	for values %{delete $self->{refresh_hook}};	3394	for values %{delete $self->{refresh_hook}};
3149	}	3395	}
3150		3396
3151	if ($self->{check_size}) {	3397	if ($self->{realloc}) {
3152	my @queue = ([], []);	3398	my %queue;
		3399	my @queue;
		3400	my $widget;
3153		3401
3154	for (;;) {	3402	outer:
3155	if ($self->{check_size}) {	3403	while () {
3156	# heuristic: check containers last	3404	if (my $realloc = delete $self->{realloc}) {
3157	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3405	for $widget (values %$realloc) {
3158	for values %{delete $self->{check_size}}	3406	$widget->{visible} or next; # do not resize invisible widgets
		3407
		3408	$queue{$widget+0}++ and next; # duplicates are common
		3409
		3410	push @{ $queue[$widget->{visible}] }, $widget;
		3411	}
3159	}	3412	}
3160		3413
3161	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3414	while () {
		3415	@queue or last outer;
3162		3416
3163	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3417	$widget = pop @{ $queue[-1] || [] }
3164	? @$widget{qw(user_w user_h)}	3418	and last;
3165	: $widget->size_request;
3166
3167	if (delete $widget->{force_alloc}
3168	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3169	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3170		3419
		3420	pop @queue;
		3421	}
		3422
		3423	delete $queue{$widget+0};
		3424
		3425	my ($w, $h) = $widget->size_request;
		3426
		3427	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3428	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3429
		3430	$w = $widget->{force_w} if exists $widget->{force_w};
		3431	$h = $widget->{force_h} if exists $widget->{force_h};
		3432
		3433	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3434	|| delete $widget->{force_realloc}) {
3171	$widget->{req_w} = $w;	3435	$widget->{req_w} = $w;
3172	$widget->{req_h} = $h;	3436	$widget->{req_h} = $h;
3173		3437
3174	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3438	$self->{size_alloc}{$widget+0} = $widget;
3175		3439
3176	$widget->{parent}->check_size
3177	if $widget->{parent};	3440	if (my $parent = $widget->{parent}) {
		3441	$self->{realloc}{$parent+0} = $parent
		3442	unless $queue{$parent+0};
		3443
		3444	$parent->{force_size_alloc} = 1;
		3445	$self->{size_alloc}{$parent+0} = $parent;
		3446	}
3178	}	3447	}
		3448
		3449	delete $self->{realloc}{$widget+0};
3179	}	3450	}
3180	}	3451	}
3181		3452
3182	while ($self->{size_alloc}) {	3453	while (my $size_alloc = delete $self->{size_alloc}) {
3183	for (values %{delete $self->{size_alloc}}) {	3454	my @queue = sort { $b->{visible} <=> $a->{visible} }
3184	my ($widget, $w, $h) = @$_;	3455	values %$size_alloc;
		3456
		3457	while () {
		3458	my $widget = pop @queue || last;
		3459
		3460	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3185		3461
3186	$w = 0 if $w < 0;	3462	$w = 0 if $w < 0;
3187	$h = 0 if $h < 0;	3463	$h = 0 if $h < 0;
3188		3464
		3465	$w = int $w + 0.5;
		3466	$h = int $h + 0.5;
		3467
		3468	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3469	$widget->{old_w} = $widget->{w};
		3470	$widget->{old_h} = $widget->{h};
		3471
3189	$widget->{w} = $w;	3472	$widget->{w} = $w;
3190	$widget->{h} = $h;	3473	$widget->{h} = $h;
3191	$widget->size_allocate ($w, $h);	3474
3192	$widget->emit (size_allocate => $w, $h);	3475	$widget->emit (size_allocate => $w, $h);
		3476	}
3193	}	3477	}
3194	}	3478	}
3195		3479
3196	while ($self->{post_alloc_hook}) {	3480	while ($self->{post_alloc_hook}) {
3197	$_->()	3481	$_->()
3198	for values %{delete $self->{post_alloc_hook}};	3482	for values %{delete $self->{post_alloc_hook}};
3199	}	3483	}
		3484
3200		3485
3201	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3486	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3202	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3487	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3203	glClear GL_COLOR_BUFFER_BIT;	3488	glClear GL_COLOR_BUFFER_BIT;
3204		3489
…		…
3206	glLoadIdentity;	3491	glLoadIdentity;
3207	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3492	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3208	glMatrixMode GL_MODELVIEW;	3493	glMatrixMode GL_MODELVIEW;
3209	glLoadIdentity;	3494	glLoadIdentity;
3210		3495
		3496	{
		3497	package CFClient::UI::Base;
		3498
		3499	($draw_x, $draw_y, $draw_w, $draw_h) =
		3500	(0, 0, $self->{w}, $self->{h});
		3501	}
		3502
3211	$self->_draw;	3503	$self->_draw;
3212	}	3504	}
3213		3505
3214	#############################################################################	3506	#############################################################################
3215		3507

Diff Legend

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