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.226 by root, Tue May 23 23:14:46 2006 UTC vs.
Revision 1.277 by root, Sun Jun 4 00:21:52 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 {
		376	# nop
		377	}
		378
		379	sub visible_children {
		380	$_[0]->children
301	}	381	}
302		382
303	sub set_max_size {	383	sub set_max_size {
304	my ($self, $w, $h) = @_;	384	my ($self, $w, $h) = @_;
305		385
…		…
307	delete $self->{max_h}; $self->{max_h} = $h if $h;	387	delete $self->{max_h}; $self->{max_h} = $h if $h;
308	}	388	}
309		389
310	sub set_tooltip {	390	sub set_tooltip {
311	my ($self, $tooltip) = @_;	391	my ($self, $tooltip) = @_;
		392
		393	$tooltip =~ s/^\s+//;
		394	$tooltip =~ s/\s+$//;
		395
		396	return if $self->{tooltip} eq $tooltip;
312		397
313	$self->{tooltip} = $tooltip;	398	$self->{tooltip} = $tooltip;
314		399
315	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	400	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
316	delete $CFClient::UI::TOOLTIP->{owner};	401	delete $CFClient::UI::TOOLTIP->{owner};
…		…
338	return if $FOCUS == $self;	423	return if $FOCUS == $self;
339	return unless $self->{can_focus};	424	return unless $self->{can_focus};
340		425
341	my $focus = $FOCUS; $FOCUS = $self;	426	my $focus = $FOCUS; $FOCUS = $self;
342		427
343	$self->emit (focus_in => $focus);	428	$self->_emit (focus_in => $focus);
344		429
345	$focus->update if $focus;	430	$focus->update if $focus;
346	$FOCUS->update;	431	$FOCUS->update;
347	}	432	}
348		433
…		…
351		436
352	return unless $FOCUS == $self;	437	return unless $FOCUS == $self;
353		438
354	my $focus = $FOCUS; undef $FOCUS;	439	my $focus = $FOCUS; undef $FOCUS;
355		440
356	$self->emit (focus_out => $focus);	441	$self->_emit (focus_out => $focus);
357		442
358	$focus->update if $focus; #?	443	$focus->update if $focus; #?
359	}
360		444
		445	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		446	unless $FOCUS;
		447	}
		448
361	sub mouse_motion { }	449	sub mouse_motion { 0 }
362	sub button_up { }	450	sub button_up { 0 }
363	sub key_down { }	451	sub key_down { 0 }
364	sub key_up { }	452	sub key_up { 0 }
365		453
366	sub button_down {	454	sub button_down {
367	my ($self, $ev, $x, $y) = @_;	455	my ($self, $ev, $x, $y) = @_;
368		456
369	$self->focus_in;	457	$self->focus_in;
370	}
371		458
372	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	459	0
373	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	460	}
374	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	461
375	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	462	sub find_widget {
376	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	463	my ($self, $x, $y) = @_;
		464
		465	return () unless $self->{can_events};
		466
		467	return $self
		468	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		469	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		470
		471	()
		472	}
		473
		474	sub set_parent {
		475	my ($self, $parent) = @_;
		476
		477	Scalar::Util::weaken ($self->{parent} = $parent);
		478	$self->set_visible if $parent->{visible};
		479	}
		480
		481	sub connect {
		482	my ($self, $signal, $cb) = @_;
		483
		484	push @{ $self->{signal_cb}{$signal} }, $cb;
		485	}
		486
		487	sub _emit {
		488	my ($self, $signal, @args) = @_;
		489
		490	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		491	}
		492
		493	sub emit {
		494	my ($self, $signal, @args) = @_;
		495
		496	$self->_emit ($signal, @args)
		497	|| $self->$signal (@args);
		498	}
		499
		500	sub visibility_change {
		501	#my ($self, $visible) = @_;
		502	}
		503
		504	sub realloc {
		505	my ($self) = @_;
		506
		507	if ($self->{visible}) {
		508	return if $self->{root}{realloc}{$self+0};
		509
		510	$self->{root}{realloc}{$self+0} = $self;
		511	$self->{root}->update;
		512	} else {
		513	delete $self->{req_w};
		514	delete $self->{req_h};
		515	}
		516	}
		517
		518	sub update {
		519	my ($self) = @_;
		520
		521	$self->{parent}->update
		522	if $self->{parent};
		523	}
		524
		525	sub reconfigure {
		526	my ($self) = @_;
		527
		528	$self->realloc;
		529	$self->update;
		530	}
		531
		532	# using global variables seems a bit hacky, but passing through all drawing
		533	# functions seems pointless.
		534	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
377		535
378	sub draw {	536	sub draw {
379	my ($self) = @_;	537	my ($self) = @_;
380		538
381	return unless $self->{h} && $self->{w};	539	return unless $self->{h} && $self->{w};
		540
		541	# update screen rectangle
		542	local $draw_x = $draw_x + $self->{x};
		543	local $draw_y = $draw_y + $self->{y};
		544	local $draw_w = $draw_x + $self->{w};
		545	local $draw_h = $draw_y + $self->{h};
		546
		547	# skip widgets that are entirely outside the drawing area
		548	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		549	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
382		550
383	glPushMatrix;	551	glPushMatrix;
384	glTranslate $self->{x}, $self->{y}, 0;	552	glTranslate $self->{x}, $self->{y}, 0;
385	$self->_draw;	553	$self->_draw;
386	glPopMatrix;	554	glPopMatrix;
…		…
398	glVertex $x , $y + $self->{h};	566	glVertex $x , $y + $self->{h};
399	glEnd;	567	glEnd;
400	glDisable GL_BLEND;	568	glDisable GL_BLEND;
401	}	569	}
402		570
403	if ($ENV{PCLIENT_DEBUG}) {	571	if ($ENV{CFPLUS_DEBUG} & 1) {
404	glPushMatrix;	572	glPushMatrix;
405	glColor 1, 1, 0, 1;	573	glColor 1, 1, 0, 1;
406	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	574	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
407	glBegin GL_LINE_LOOP;	575	glBegin GL_LINE_LOOP;
408	glVertex 0 , 0;	576	glVertex 0 , 0;
409	glVertex $self->{w}, 0;	577	glVertex $self->{w} - 1, 0;
410	glVertex $self->{w}, $self->{h};	578	glVertex $self->{w} - 1, $self->{h} - 1;
411	glVertex 0 , $self->{h};	579	glVertex 0 , $self->{h} - 1;
412	glEnd;	580	glEnd;
413	glPopMatrix;	581	glPopMatrix;
414	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	582	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
415	}	583	}
416	}	584	}
417		585
418	sub _draw {	586	sub _draw {
419	my ($self) = @_;	587	my ($self) = @_;
420		588
421	warn "no draw defined for $self\n";	589	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	}	590	}
473		591
474	sub DESTROY {	592	sub DESTROY {
475	my ($self) = @_;	593	my ($self) = @_;
476		594
…		…
534	my ($class, %arg) = @_;	652	my ($class, %arg) = @_;
535	$class->SUPER::new (can_events => 0, %arg);	653	$class->SUPER::new (can_events => 0, %arg);
536	}	654	}
537		655
538	sub size_request {	656	sub size_request {
539	(0, 0)	657	my ($self) = @_;
		658
		659	($self->{w} + 0, $self->{h} + 0)
540	}	660	}
541		661
542	sub draw { }	662	sub draw { }
543		663
544	#############################################################################	664	#############################################################################
…		…
548	our @ISA = CFClient::UI::Base::;	668	our @ISA = CFClient::UI::Base::;
549		669
550	sub new {	670	sub new {
551	my ($class, %arg) = @_;	671	my ($class, %arg) = @_;
552		672
553	my $children = delete $arg{children} || [];	673	my $children = delete $arg{children};
554		674
555	my $self = $class->SUPER::new (	675	my $self = $class->SUPER::new (
556	children => [],	676	children => [],
557	can_events => 0,	677	can_events => 0,
558	%arg,	678	%arg,
559	);	679	);
		680
560	$self->add ($_) for @$children;	681	$self->add (@$children)
		682	if $children;
561		683
562	$self	684	$self
563	}	685	}
564		686
565	sub add {	687	sub add {
…		…
573	$self->{children} = [	695	$self->{children} = [
574	sort { $a->{z} <=> $b->{z} }	696	sort { $a->{z} <=> $b->{z} }
575	@{$self->{children}}, @widgets	697	@{$self->{children}}, @widgets
576	];	698	];
577		699
578	$self->check_size (1);	700	$self->realloc;
579	$self->update;
580	}	701	}
581		702
582	sub children {	703	sub children {
583	@{ $_[0]{children} }	704	@{ $_[0]{children} }
584	}	705	}
…		…
589	delete $child->{parent};	710	delete $child->{parent};
590	$child->hide;	711	$child->hide;
591		712
592	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	713	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
593		714
594	$self->check_size;	715	$self->realloc;
595	$self->update;
596	}	716	}
597		717
598	sub clear {	718	sub clear {
599	my ($self) = @_;	719	my ($self) = @_;
600		720
…		…
604	for (@$children) {	724	for (@$children) {
605	delete $_->{parent};	725	delete $_->{parent};
606	$_->hide;	726	$_->hide;
607	}	727	}
608		728
609	$self->check_size;	729	$self->realloc;
610	$self->update;
611	}	730	}
612		731
613	sub find_widget {	732	sub find_widget {
614	my ($self, $x, $y) = @_;	733	my ($self, $x, $y) = @_;
615		734
616	$x -= $self->{x};	735	$x -= $self->{x};
617	$y -= $self->{y};	736	$y -= $self->{y};
618		737
619	my $res;	738	my $res;
620		739
621	for (reverse @{ $self->{children} }) {	740	for (reverse $self->visible_children) {
622	$res = $_->find_widget ($x, $y)	741	$res = $_->find_widget ($x, $y)
623	and return $res;	742	and return $res;
624	}	743	}
625		744
626	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	745	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
675	$self->{children}[0]->configure (0, 0, $w, $h);	794	$self->{children}[0]->configure (0, 0, $w, $h);
676	}	795	}
677		796
678	#############################################################################	797	#############################################################################
679		798
		799	# back-buffered drawing area
		800
680	package CFClient::UI::Window;	801	package CFClient::UI::Window;
681		802
682	our @ISA = CFClient::UI::Bin::;	803	our @ISA = CFClient::UI::Bin::;
683		804
684	use CFClient::OpenGL;	805	use CFClient::OpenGL;
…		…
702	$self->SUPER::size_allocate ($w, $h);	823	$self->SUPER::size_allocate ($w, $h);
703	$self->update;	824	$self->update;
704	}	825	}
705		826
706	sub _render {	827	sub _render {
		828	my ($self) = @_;
		829
707	$_[0]{children}[0]->draw;	830	$self->{children}[0]->draw;
708	}	831	}
709		832
710	sub render_child {	833	sub render_child {
711	my ($self) = @_;	834	my ($self) = @_;
712		835
713	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	836	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
714	glClearColor 0, 0, 0, 0;	837	glClearColor 0, 0, 0, 0;
715	glClear GL_COLOR_BUFFER_BIT;	838	glClear GL_COLOR_BUFFER_BIT;
716		839
		840	{
		841	package CFClient::UI::Base;
		842
		843	($draw_x, $draw_y, $draw_w, $draw_h) =
		844	(0, 0, $self->{w}, $self->{h});
		845	}
		846
717	$self->_render;	847	$self->_render;
718	};	848	};
719	}	849	}
720		850
721	sub _draw {	851	sub _draw {
722	my ($self) = @_;	852	my ($self) = @_;
723		853
724	my ($w, $h) = ($self->w, $self->h);	854	my ($w, $h) = @$self{qw(w h)};
725		855
726	my $tex = $self->{texture}	856	my $tex = $self->{texture}
727	or return;	857	or return;
728		858
729	glEnable GL_TEXTURE_2D;	859	glEnable GL_TEXTURE_2D;
…		…
739		869
740	package CFClient::UI::ViewPort;	870	package CFClient::UI::ViewPort;
741		871
742	our @ISA = CFClient::UI::Window::;	872	our @ISA = CFClient::UI::Window::;
743		873
		874	sub new {
		875	my $class = shift;
		876
		877	$class->SUPER::new (
		878	scroll_x => 0,
		879	scroll_y => 1,
		880	@_,
		881	)
		882	}
		883
744	sub size_request {	884	sub size_request {
745	my ($self) = @_;	885	my ($self) = @_;
746		886
747	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	887	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
748		888
749	@$self{qw(child_w child_h)}	889	$w = 10 if $self->{scroll_x};
		890	$h = 10 if $self->{scroll_y};
		891
		892	($w, $h)
750	}	893	}
751		894
752	sub size_allocate {	895	sub size_allocate {
753	my ($self, $w, $h) = @_;	896	my ($self, $w, $h) = @_;
754		897
755	my ($cw, $ch) = @$self{qw(child_w child_h)};	898	my $child = $self->child;
756	# $w = $self->{w};	899
		900	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
		901	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
		902
757	$self->child->configure (0, 0, $cw, $ch);	903	$self->child->configure (0, 0, $w, $h);
758	$self->update;	904	$self->update;
759	}	905	}
760		906
761	sub set_offset {	907	sub set_offset {
762	my ($self, $x, $y) = @_;	908	my ($self, $x, $y) = @_;
…		…
796	}	942	}
797		943
798	sub _render {	944	sub _render {
799	my ($self) = @_;	945	my ($self) = @_;
800		946
		947	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		948	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		949
801	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	950	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
802		951
803	$self->SUPER::_render;	952	$self->SUPER::_render;
804	}	953	}
805		954
…		…
808	package CFClient::UI::ScrolledWindow;	957	package CFClient::UI::ScrolledWindow;
809		958
810	our @ISA = CFClient::UI::HBox::;	959	our @ISA = CFClient::UI::HBox::;
811		960
812	sub new {	961	sub new {
813	my $class = shift;	962	my ($class, %arg) = @_;
		963
		964	my $child = delete $arg{child};
814		965
815	my $self;	966	my $self;
816		967
817	my $slider = new CFClient::UI::Slider	968	my $slider = new CFClient::UI::Slider
818	vertical => 1,	969	vertical => 1,
819	range => [0, 0, 1, 0.01], # HACK fix	970	range => [0, 0, 1, 0.01], # HACK fix
820	connect_changed => sub {	971	on_changed => sub {
821	$self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h}));	972	$self->{vp}->set_offset (0, $_[1]);
822	},	973	},
823	;	974	;
824		975
825	$self = $class->SUPER::new (	976	$self = $class->SUPER::new (
826	vp => (new CFClient::UI::ViewPort expand => 1),	977	vp => (new CFClient::UI::ViewPort expand => 1),
827	slider => $slider,	978	slider => $slider,
828	@_,	979	%arg,
829	);	980	);
830		981
831	$self->{vp}->add ($self->{scrolled});
832	$self->add ($self->{vp});
833	$self->add ($self->{slider});	982	$self->SUPER::add ($self->{vp}, $self->{slider});
		983	$self->add ($child) if $child;
834		984
835	$self	985	$self
		986	}
		987
		988	sub add {
		989	my ($self, $widget) = @_;
		990
		991	$self->{vp}->add ($self->{child} = $widget);
		992	}
		993
		994	sub update {
		995	my ($self) = @_;
		996
		997	$self->SUPER::update;
		998
		999	# todo: overwrite size_allocate of child
		1000	my $child = $self->{vp}->child;
		1001	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		1002	}
		1003
		1004	sub size_allocate {
		1005	my ($self, $w, $h) = @_;
		1006
		1007	$self->SUPER::size_allocate ($w, $h);
		1008
		1009	my $child = $self->{vp}->child;
		1010	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
836	}	1011	}
837		1012
838	#TODO# update range on size_allocate depending on child	1013	#TODO# update range on size_allocate depending on child
839	# update viewport offset on scroll	1014	# update viewport offset on scroll
840		1015
…		…
884		1059
885	our @ISA = CFClient::UI::Bin::;	1060	our @ISA = CFClient::UI::Bin::;
886		1061
887	use CFClient::OpenGL;	1062	use CFClient::OpenGL;
888		1063
889	my @tex =	1064	my $bg =
		1065	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1066	mipmap => 1, wrap => 1;
		1067
		1068	my @border =
890	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1069	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
891	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1070	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
892		1071
893	sub new {	1072	sub new {
894	my $class = shift;	1073	my ($class, %arg) = @_;
895		1074
896	# TODO: user_x, user_y, overwrite moveto?	1075	my $title = delete $arg{title};
897		1076
898	my $self = $class->SUPER::new (	1077	my $self = $class->SUPER::new (
899	bg => [1, 1, 1, 1],	1078	bg => [1, 1, 1, 1],
900	border_bg => [1, 1, 1, 1],	1079	border_bg => [1, 1, 1, 1],
901	border => 0.6,	1080	border => 0.6,
902	toplevel => 1,
903	can_events => 1,	1081	can_events => 1,
904	@_	1082	min_w => 16,
		1083	min_h => 16,
		1084	%arg,
905	);	1085	);
906		1086
907	$self->{title} &&= new CFClient::UI::Label	1087	$self->{title} = new CFClient::UI::Label
908	align => 0,	1088	align => 0,
909	valign => 1,	1089	valign => 1,
910	text => $self->{title},	1090	text => $title,
911	fontsize => $self->{border};	1091	fontsize => $self->{border}
		1092	if defined $title;
912		1093
913	$self	1094	$self
		1095	}
		1096
		1097	sub add {
		1098	my ($self, @widgets) = @_;
		1099
		1100	$self->SUPER::add (@widgets);
		1101	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
914	}	1102	}
915		1103
916	sub border {	1104	sub border {
917	int $_[0]{border} * $::FONTSIZE	1105	int $_[0]{border} * $::FONTSIZE
918	}	1106	}
919		1107
920	sub size_request {	1108	sub size_request {
921	my ($self) = @_;	1109	my ($self) = @_;
		1110
		1111	$self->{title}->size_request
		1112	if $self->{title};
922		1113
923	my ($w, $h) = $self->SUPER::size_request;	1114	my ($w, $h) = $self->SUPER::size_request;
924		1115
925	(	1116	(
926	$w + $self->border * 2,	1117	$w + $self->border * 2,
…		…
929	}	1120	}
930		1121
931	sub size_allocate {	1122	sub size_allocate {
932	my ($self, $w, $h) = @_;	1123	my ($self, $w, $h) = @_;
933		1124
		1125	if ($self->{title}) {
		1126	$self->{title}{w} = $w;
		1127	$self->{title}{h} = $h;
		1128	$self->{title}->size_allocate ($w, $h);
		1129	}
		1130
		1131	my $border = $self->border;
		1132
934	$h -= List::Util::max 0, $self->border * 2;	1133	$h -= List::Util::max 0, $border * 2;
935	$w -= List::Util::max 0, $self->border * 2;	1134	$w -= List::Util::max 0, $border * 2;
936		1135
937	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
938	if $self->{title};
939
940	$self->child->configure ($self->border, $self->border, $w, $h);	1136	$self->child->configure ($border, $border, $w, $h);
941	}	1137	}
942		1138
943	sub button_down {	1139	sub button_down {
944	my ($self, $ev, $x, $y) = @_;	1140	my ($self, $ev, $x, $y) = @_;
945		1141
…		…
961	my ($ev, $x, $y) = @_;	1157	my ($ev, $x, $y) = @_;
962		1158
963	my $dx = $ev->{x} - $ox;	1159	my $dx = $ev->{x} - $ox;
964	my $dy = $ev->{y} - $oy;	1160	my $dy = $ev->{y} - $oy;
965		1161
966	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1162	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
967	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1163	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1164
968	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1165	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
969	$self->check_size;	1166	$self->realloc;
970	};	1167	};
971		1168
972	} elsif ($lr ^ $td) {	1169	} elsif ($lr ^ $td) {
973	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1170	my ($ox, $oy) = ($ev->{x}, $ev->{y});
974	my ($bx, $by) = ($self->{x}, $self->{y});	1171	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
976	$self->{motion} = sub {	1173	$self->{motion} = sub {
977	my ($ev, $x, $y) = @_;	1174	my ($ev, $x, $y) = @_;
978		1175
979	($x, $y) = ($ev->{x}, $ev->{y});	1176	($x, $y) = ($ev->{x}, $ev->{y});
980		1177
981	$self->move ($bx + $x - $ox, $by + $y - $oy);	1178	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
982	$self->update;	1179	# HACK: the next line is required to enforce placement
		1180	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
983	};	1181	};
		1182	} else {
		1183	return 0;
		1184	}
		1185
984	}	1186	1
985	}	1187	}
986		1188
987	sub button_up {	1189	sub button_up {
988	my ($self, $ev, $x, $y) = @_;	1190	my ($self, $ev, $x, $y) = @_;
989		1191
990	delete $self->{motion};	1192	!!delete $self->{motion}
991	}	1193	}
992		1194
993	sub mouse_motion {	1195	sub mouse_motion {
994	my ($self, $ev, $x, $y) = @_;	1196	my ($self, $ev, $x, $y) = @_;
995		1197
996	$self->{motion}->($ev, $x, $y) if $self->{motion};	1198	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1199
		1200	!!$self->{motion}
997	}	1201	}
998		1202
999	sub _draw {	1203	sub _draw {
1000	my ($self) = @_;	1204	my ($self) = @_;
1001		1205
		1206	my $child = $self->{children}[0];
		1207
1002	my ($w, $h ) = ($self->{w}, $self->{h});	1208	my ($w, $h ) = ($self->{w}, $self->{h});
1003	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1209	my ($cw, $ch) = ($child->{w}, $child->{h});
1004		1210
1005	glEnable GL_TEXTURE_2D;	1211	glEnable GL_TEXTURE_2D;
1006	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1212	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1007		1213
1008	my $border = $self->border;	1214	my $border = $self->border;
1009		1215
1010	glColor @{ $self->{border_bg} };	1216	glColor @{ $self->{border_bg} };
1011	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1217	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1012	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1218	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1013	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1219	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1014	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1220	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1015		1221
1016	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1222	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1017	my $bg = $tex[0];	1223	glColor @{ $self->{bg} };
1018		1224
1019	# TODO: repeat texture not scale	1225	# TODO: repeat texture not scale
		1226	# solve this better(?)
1020	my $rep_x = $cw / $bg->{w};	1227	$bg->{s} = $cw / $bg->{w};
1021	my $rep_y = $ch / $bg->{h};	1228	$bg->{t} = $ch / $bg->{h};
1022
1023	glColor @{ $self->{bg} };
1024
1025	$bg->{s} = $rep_x;
1026	$bg->{t} = $rep_y;
1027	$bg->{wrap_mode} = 1;
1028	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1229	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1029	}	1230	}
1030		1231
1031	glDisable GL_TEXTURE_2D;	1232	glDisable GL_TEXTURE_2D;
1032		1233
1033	$self->{title}->draw if $self->{title};
1034
1035	$self->child->draw;	1234	$child->draw;
		1235
		1236	if ($self->{title}) {
		1237	glTranslate 0, $border - $self->{h};
		1238	$self->{title}->_draw;
		1239	}
1036	}	1240	}
1037		1241
1038	#############################################################################	1242	#############################################################################
1039		1243
1040	package CFClient::UI::Table;	1244	package CFClient::UI::Table;
…		…
1048	sub new {	1252	sub new {
1049	my $class = shift;	1253	my $class = shift;
1050		1254
1051	$class->SUPER::new (	1255	$class->SUPER::new (
1052	col_expand => [],	1256	col_expand => [],
1053	@_	1257	@_,
1054	)	1258	)
		1259	}
		1260
		1261	sub children {
		1262	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1055	}	1263	}
1056		1264
1057	sub add {	1265	sub add {
1058	my ($self, $x, $y, $child) = @_;	1266	my ($self, $x, $y, $child) = @_;
1059		1267
1060	$child->set_parent ($self);	1268	$child->set_parent ($self);
1061	$self->{children}[$y][$x] = $child;	1269	$self->{children}[$y][$x] = $child;
1062		1270
1063	$child->check_size;	1271	$self->realloc;
1064	}	1272	}
1065		1273
1066	sub children {
1067	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1068	}
1069
1070	# TODO: move to container class maybe? send childs a signal on removal?	1274	# TODO: move to container class maybe? send children a signal on removal?
1071	sub clear {	1275	sub clear {
1072	my ($self) = @_;	1276	my ($self) = @_;
1073		1277
1074	my @children = $self->children;	1278	my @children = $self->children;
1075	delete $self->{children};	1279	delete $self->{children};
…		…
1077	for (@children) {	1281	for (@children) {
1078	delete $_->{parent};	1282	delete $_->{parent};
1079	$_->hide;	1283	$_->hide;
1080	}	1284	}
1081		1285
1082	$self->update;	1286	$self->realloc;
1083	}	1287	}
1084		1288
1085	sub get_wh {	1289	sub get_wh {
1086	my ($self) = @_;	1290	my ($self) = @_;
1087		1291
…		…
1118	sub size_allocate {	1322	sub size_allocate {
1119	my ($self, $w, $h) = @_;	1323	my ($self, $w, $h) = @_;
1120		1324
1121	my ($ws, $hs) = $self->get_wh;	1325	my ($ws, $hs) = $self->get_wh;
1122		1326
1123	my $req_w = sum @$ws;	1327	my $req_w = (sum @$ws) || 1;
1124	my $req_h = sum @$hs;	1328	my $req_h = (sum @$hs) || 1;
1125		1329
1126	# TODO: nicer code && do row_expand	1330	# TODO: nicer code && do row_expand
1127	my @col_expand = @{$self->{col_expand}};	1331	my @col_expand = @{$self->{col_expand}};
1128	@col_expand = (1) x @$ws unless @col_expand;	1332	@col_expand = (1) x @$ws unless @col_expand;
1129	my $col_expand = (sum @col_expand) || 1;	1333	my $col_expand = (sum @col_expand) || 1;
…		…
1183	}	1387	}
1184	}	1388	}
1185		1389
1186	#############################################################################	1390	#############################################################################
1187		1391
1188	package CFClient::UI::HBox;	1392	package CFClient::UI::Box;
1189
1190	# TODO: wrap into common Box base class
1191		1393
1192	our @ISA = CFClient::UI::Container::;	1394	our @ISA = CFClient::UI::Container::;
1193		1395
1194	sub size_request {	1396	sub size_request {
1195	my ($self) = @_;	1397	my ($self) = @_;
1196		1398
1197	my @alloc = map [$_->size_request], @{$self->{children}};	1399	$self->{vertical}
1198		1400	? (
1199	(	1401	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1200	(List::Util::sum map $_->[0], @alloc),	1402	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1201	(List::Util::max map $_->[1], @alloc),	1403	)
1202	)	1404	: (
		1405	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1406	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1407	)
1203	}	1408	}
1204		1409
1205	sub size_allocate {	1410	sub size_allocate {
1206	my ($self, $w, $h) = @_;	1411	my ($self, $w, $h) = @_;
1207		1412
1208	($h, $w) = ($w, $h);	1413	my $space = $self->{vertical} ? $h : $w;
1209
1210	my $children = $self->{children};	1414	my $children = $self->{children};
1211		1415
1212	my @h = map $_->{req_w}, @$children;	1416	my @req;
1213		1417
1214	my $req_h = List::Util::sum @h;	1418	if ($self->{homogeneous}) {
1215		1419	@req = ($space / (@$children || 1)) x @$children;
1216	if ($req_h > $h) {
1217	# ah well, not enough space
1218	$_ *= $h / $req_h for @h;
1219	} else {	1420	} else {
		1421	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
		1422	my $req = List::Util::sum @req;
		1423
		1424	if ($req > $space) {
		1425	# ah well, not enough space
		1426	$_ *= $space / $req for @req;
		1427	} else {
1220	my $exp = List::Util::sum map $_->{expand}, @$children;	1428	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1221	$exp ||= 1;
1222		1429
		1430	$space = ($space - $req) / $expand; # remaining space to give away
		1431
		1432	$req[$_] += $space * $children->[$_]{expand}
1223	for (0 .. $#$children) {	1433	for 0 .. $#$children;
1224	my $child = $children->[$_];
1225
1226	my $alloc_h = $h[$_];
1227	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1228	$h[$_] = $alloc_h;
1229	}	1434	}
1230	}	1435	}
1231		1436
1232	CFClient::UI::harmonize \@h;	1437	CFClient::UI::harmonize \@req;
1233		1438
1234	my $y = 0;	1439	my $pos = 0;
1235	for (0 .. $#$children) {	1440	for (0 .. $#$children) {
1236	my $child = $children->[$_];
1237	my $h = $h[$_];	1441	my $alloc = $req[$_];
1238	$child->configure ($y, 0, $h, $w);	1442	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1239		1443
1240	$y += $h;	1444	$pos += $alloc;
1241	}	1445	}
1242		1446
1243	1	1447	1
1244	}	1448	}
1245		1449
1246	#############################################################################	1450	#############################################################################
1247		1451
		1452	package CFClient::UI::HBox;
		1453
		1454	our @ISA = CFClient::UI::Box::;
		1455
		1456	sub new {
		1457	my $class = shift;
		1458
		1459	$class->SUPER::new (
		1460	vertical => 0,
		1461	@_,
		1462	)
		1463	}
		1464
		1465	#############################################################################
		1466
1248	package CFClient::UI::VBox;	1467	package CFClient::UI::VBox;
1249		1468
1250	# TODO: wrap into common Box base class
1251
1252	our @ISA = CFClient::UI::Container::;	1469	our @ISA = CFClient::UI::Box::;
1253		1470
1254	sub size_request {	1471	sub new {
1255	my ($self) = @_;	1472	my $class = shift;
1256		1473
1257	my @alloc = map [$_->size_request], @{$self->{children}};	1474	$class->SUPER::new (
1258		1475	vertical => 1,
1259	(	1476	@_,
1260	(List::Util::max map $_->[0], @alloc),
1261	(List::Util::sum map $_->[1], @alloc),
1262	)	1477	)
1263	}
1264
1265	sub size_allocate {
1266	my ($self, $w, $h) = @_;
1267
1268	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1269
1270	my $children = $self->{children};
1271
1272	my @h = map $_->{req_h}, @$children;
1273
1274	my $req_h = List::Util::sum @h;
1275
1276	if ($req_h > $h) {
1277	# ah well, not enough space
1278	$_ *= $h / $req_h for @h;
1279	} else {
1280	my $exp = List::Util::sum map $_->{expand}, @$children;
1281	$exp ||= 1;
1282
1283	for (0 .. $#$children) {
1284	my $child = $children->[$_];
1285
1286	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1287	}
1288	}
1289
1290	CFClient::UI::harmonize \@h;
1291
1292	my $y = 0;
1293	for (0 .. $#$children) {
1294	my $child = $children->[$_];
1295	my $h = $h[$_];
1296	$child->configure (0, $y, $w, $h);
1297
1298	$y += $h;
1299	}
1300
1301	1
1302	}	1478	}
1303		1479
1304	#############################################################################	1480	#############################################################################
1305		1481
1306	package CFClient::UI::Label;	1482	package CFClient::UI::Label;
…		…
1323	ellipsise => 3, # end	1499	ellipsise => 3, # end
1324	layout => (new CFClient::Layout),	1500	layout => (new CFClient::Layout),
1325	fontsize => 1,	1501	fontsize => 1,
1326	align => -1,	1502	align => -1,
1327	valign => -1,	1503	valign => -1,
1328	padding => 2,	1504	padding_x => 2,
		1505	padding_y => 2,
1329	can_events => 0,	1506	can_events => 0,
1330	%arg	1507	%arg
1331	);	1508	);
1332		1509
1333	if (exists $self->{template}) {	1510	if (exists $self->{template}) {
…		…
1369	$self->{text} = "T$text";	1546	$self->{text} = "T$text";
1370		1547
1371	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1548	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1372	$self->{layout}->set_text ($text);	1549	$self->{layout}->set_text ($text);
1373		1550
		1551	$self->realloc;
1374	$self->update;	1552	$self->update;
1375	$self->check_size;
1376	}	1553	}
1377		1554
1378	sub set_markup {	1555	sub set_markup {
1379	my ($self, $markup) = @_;	1556	my ($self, $markup) = @_;
1380		1557
…		…
1384	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1561	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1385		1562
1386	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1563	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1387	$self->{layout}->set_markup ($markup);	1564	$self->{layout}->set_markup ($markup);
1388		1565
		1566	$self->realloc;
1389	$self->update;	1567	$self->update;
1390	$self->check_size;
1391	}	1568	}
1392		1569
1393	sub size_request {	1570	sub size_request {
1394	my ($self) = @_;	1571	my ($self) = @_;
1395		1572
…		…
1409		1586
1410	$w = List::Util::max $w, $w2;	1587	$w = List::Util::max $w, $w2;
1411	$h = List::Util::max $h, $h2;	1588	$h = List::Util::max $h, $h2;
1412	}	1589	}
1413		1590
1414	(	1591	($w, $h)
1415	$w + $self->{padding} * 2,
1416	$h + $self->{padding} * 2,
1417	)
1418	}	1592	}
1419		1593
1420	sub size_allocate {	1594	sub size_allocate {
1421	my ($self, $w, $h) = @_;	1595	my ($self, $w, $h) = @_;
1422		1596
		1597	delete $self->{ox};
		1598
1423	delete $self->{texture};	1599	delete $self->{texture}
		1600	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1424	}	1601	}
1425		1602
1426	sub set_fontsize {	1603	sub set_fontsize {
1427	my ($self, $fontsize) = @_;	1604	my ($self, $fontsize) = @_;
1428		1605
1429	$self->{fontsize} = $fontsize;	1606	$self->{fontsize} = $fontsize;
1430	delete $self->{texture};	1607	delete $self->{texture};
1431		1608
1432	$self->update;	1609	$self->realloc;
1433	$self->check_size;
1434	}	1610	}
1435		1611
1436	sub _draw {	1612	sub _draw {
1437	my ($self) = @_;	1613	my ($self) = @_;
1438		1614
…		…
1444	$self->{layout}->set_width ($self->{w});	1620	$self->{layout}->set_width ($self->{w});
1445	$self->{layout}->set_ellipsise ($self->{ellipsise});	1621	$self->{layout}->set_ellipsise ($self->{ellipsise});
1446	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1622	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1447	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1623	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1448		1624
1449	my $tex = new_from_layout CFClient::Texture $self->{layout};	1625	new_from_layout CFClient::Texture $self->{layout}
		1626	};
1450		1627
		1628	unless (exists $self->{ox}) {
1451	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1629	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1452	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1630	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1453	: ($self->{w} - $tex->{w}) * 0.5);	1631	: ($self->{w} - $tex->{w}) * 0.5);
1454		1632
1455	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1633	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1456	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1634	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1457	: ($self->{h} - $tex->{h}) * 0.5);	1635	: ($self->{h} - $tex->{h}) * 0.5);
1458
1459	$tex
1460	};	1636	};
1461		1637
1462	glEnable GL_TEXTURE_2D;	1638	glEnable GL_TEXTURE_2D;
1463	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1639	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1464		1640
…		…
1502		1678
1503	delete $self->{cur_h};	1679	delete $self->{cur_h};
1504		1680
1505	return if $self->{text} eq $text;	1681	return if $self->{text} eq $text;
1506		1682
1507	delete $self->{texture};
1508
1509	$self->{last_activity} = $::NOW;	1683	$self->{last_activity} = $::NOW;
1510	$self->{text} = $text;	1684	$self->{text} = $text;
1511		1685
1512	$text =~ s/./*/g if $self->{hidden};	1686	$text =~ s/./*/g if $self->{hidden};
1513	$self->{layout}->set_text ("$text ");	1687	$self->{layout}->set_text ("$text ");
1514		1688
1515	$self->emit (changed => $self->{text});	1689	$self->_emit (changed => $self->{text});
		1690	$self->update;
1516	}	1691	}
1517		1692
1518	sub set_text {	1693	sub set_text {
1519	my ($self, $text) = @_;	1694	my ($self, $text) = @_;
1520		1695
1521	$self->{cursor} = length $text;	1696	$self->{cursor} = length $text;
1522	$self->_set_text ($text);	1697	$self->_set_text ($text);
1523	$self->update;	1698
1524	$self->check_size;	1699	$self->realloc;
1525	}	1700	}
1526		1701
1527	sub get_text {	1702	sub get_text {
1528	$_[0]{text}	1703	$_[0]{text}
1529	}	1704	}
…		…
1532	my ($self) = @_;	1707	my ($self) = @_;
1533		1708
1534	my ($w, $h) = $self->SUPER::size_request;	1709	my ($w, $h) = $self->SUPER::size_request;
1535		1710
1536	($w + 1, $h) # add 1 for cursor	1711	($w + 1, $h) # add 1 for cursor
1537	}
1538
1539	sub size_allocate {
1540	my ($self, $w, $h) = @_;
1541
1542	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1543	}	1712	}
1544		1713
1545	sub key_down {	1714	sub key_down {
1546	my ($self, $ev) = @_;	1715	my ($self, $ev) = @_;
1547		1716
…		…
1562	} elsif ($sym == CFClient::SDLK_HOME) {	1731	} elsif ($sym == CFClient::SDLK_HOME) {
1563	$self->{cursor} = 0;	1732	$self->{cursor} = 0;
1564	} elsif ($sym == CFClient::SDLK_END) {	1733	} elsif ($sym == CFClient::SDLK_END) {
1565	$self->{cursor} = length $text;	1734	$self->{cursor} = length $text;
1566	} elsif ($uni == 27) {	1735	} elsif ($uni == 27) {
1567	$self->emit ('escape');	1736	$self->_emit ('escape');
1568	} elsif ($uni) {	1737	} elsif ($uni) {
1569	substr $text, $self->{cursor}++, 0, chr $uni;	1738	substr $text, $self->{cursor}++, 0, chr $uni;
		1739	} else {
		1740	return 0;
1570	}	1741	}
1571		1742
1572	$self->_set_text ($text);	1743	$self->_set_text ($text);
1573	$self->update;	1744
1574	$self->check_size;	1745	$self->realloc;
		1746
		1747	1
1575	}	1748	}
1576		1749
1577	sub focus_in {	1750	sub focus_in {
1578	my ($self) = @_;	1751	my ($self) = @_;
1579		1752
…		…
1594	utf8::encode $text;	1767	utf8::encode $text;
1595	$self->{cursor} = length substr $text, 0, $idx;	1768	$self->{cursor} = length substr $text, 0, $idx;
1596		1769
1597	$self->_set_text ($self->{text});	1770	$self->_set_text ($self->{text});
1598	$self->update;	1771	$self->update;
		1772
		1773	1
1599	}	1774	}
1600		1775
1601	sub mouse_motion {	1776	sub mouse_motion {
1602	my ($self, $ev, $x, $y) = @_;	1777	my ($self, $ev, $x, $y) = @_;
1603	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1778	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1779
		1780	0
1604	}	1781	}
1605		1782
1606	sub _draw {	1783	sub _draw {
1607	my ($self) = @_;	1784	my ($self) = @_;
1608		1785
…		…
1659	if ($sym == 13) {	1836	if ($sym == 13) {
1660	unshift @{$self->{history}},	1837	unshift @{$self->{history}},
1661	my $txt = $self->get_text;	1838	my $txt = $self->get_text;
1662	$self->{history_pointer} = -1;	1839	$self->{history_pointer} = -1;
1663	$self->{history_saveback} = '';	1840	$self->{history_saveback} = '';
1664	$self->emit (activate => $txt);	1841	$self->_emit (activate => $txt);
1665	$self->update;	1842	$self->update;
1666		1843
1667	} elsif ($sym == CFClient::SDLK_UP) {	1844	} elsif ($sym == CFClient::SDLK_UP) {
1668	if ($self->{history_pointer} < 0) {	1845	if ($self->{history_pointer} < 0) {
1669	$self->{history_saveback} = $self->get_text;	1846	$self->{history_saveback} = $self->get_text;
…		…
1685	} else {	1862	} else {
1686	$self->set_text ($self->{history_saveback});	1863	$self->set_text ($self->{history_saveback});
1687	}	1864	}
1688		1865
1689	} else {	1866	} else {
1690	$self->SUPER::key_down ($ev);	1867	return $self->SUPER::key_down ($ev)
		1868	}
		1869
1691	}	1870	1
1692
1693	}	1871	}
1694		1872
1695	#############################################################################	1873	#############################################################################
1696		1874
1697	package CFClient::UI::Button;	1875	package CFClient::UI::Button;
…		…
1706		1884
1707	sub new {	1885	sub new {
1708	my $class = shift;	1886	my $class = shift;
1709		1887
1710	$class->SUPER::new (	1888	$class->SUPER::new (
1711	padding => 4,	1889	padding_x => 4,
		1890	padding_y => 4,
1712	fg => [1, 1, 1],	1891	fg => [1, 1, 1],
1713	active_fg => [0, 0, 1],	1892	active_fg => [0, 0, 1],
1714	can_hover => 1,	1893	can_hover => 1,
1715	align => 0,	1894	align => 0,
1716	valign => 0,	1895	valign => 0,
1717	can_events => 1,	1896	can_events => 1,
1718	@_	1897	@_
1719	)	1898	)
1720	}	1899	}
1721		1900
		1901	sub activate { }
		1902
1722	sub button_up {	1903	sub button_up {
1723	my ($self, $ev, $x, $y) = @_;	1904	my ($self, $ev, $x, $y) = @_;
1724		1905
		1906	$self->emit ("activate")
1725	if ($x >= 0 && $x < $self->{w}	1907	if $x >= 0 && $x < $self->{w}
1726	&& $y >= 0 && $y < $self->{h}) {	1908	&& $y >= 0 && $y < $self->{h};
1727	$self->emit ("activate");	1909
1728	}	1910	1
1729	}	1911	}
1730		1912
1731	sub _draw {	1913	sub _draw {
1732	my ($self) = @_;	1914	my ($self) = @_;
1733		1915
…		…
1762		1944
1763	sub new {	1945	sub new {
1764	my $class = shift;	1946	my $class = shift;
1765		1947
1766	$class->SUPER::new (	1948	$class->SUPER::new (
1767	padding => 2,	1949	padding_x => 2,
		1950	padding_y => 2,
1768	fg => [1, 1, 1],	1951	fg => [1, 1, 1],
1769	active_fg => [1, 1, 0],	1952	active_fg => [1, 1, 0],
1770	bg => [0, 0, 0, 0.2],	1953	bg => [0, 0, 0, 0.2],
1771	active_bg => [1, 1, 1, 0.5],	1954	active_bg => [1, 1, 1, 0.5],
1772	state => 0,	1955	state => 0,
…		…
1776	}	1959	}
1777		1960
1778	sub size_request {	1961	sub size_request {
1779	my ($self) = @_;	1962	my ($self) = @_;
1780		1963
1781	($self->{padding} * 2 + 6) x 2	1964	(6) x 2
1782	}	1965	}
1783		1966
1784	sub button_down {	1967	sub button_down {
1785	my ($self, $ev, $x, $y) = @_;	1968	my ($self, $ev, $x, $y) = @_;
1786		1969
1787	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1970	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1788	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1971	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1789	$self->{state} = !$self->{state};	1972	$self->{state} = !$self->{state};
1790	$self->emit (changed => $self->{state});	1973	$self->_emit (changed => $self->{state});
		1974	} else {
		1975	return 0
		1976	}
		1977
1791	}	1978	1
1792	}	1979	}
1793		1980
1794	sub _draw {	1981	sub _draw {
1795	my ($self) = @_;	1982	my ($self) = @_;
1796		1983
1797	$self->SUPER::_draw;	1984	$self->SUPER::_draw;
1798		1985
1799	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1986	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1800		1987
1801	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1988	my ($w, $h) = @$self{qw(w h)};
		1989
		1990	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1802		1991
1803	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1992	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1804		1993
1805	my $tex = $self->{state} ? $tex[1] : $tex[0];	1994	my $tex = $self->{state} ? $tex[1] : $tex[0];
1806		1995
…		…
2070	my $self = $class->SUPER::new (	2259	my $self = $class->SUPER::new (
2071	fg => [1, 1, 1],	2260	fg => [1, 1, 1],
2072	active_fg => [0, 0, 0],	2261	active_fg => [0, 0, 0],
2073	bg => [0, 0, 0, 0.2],	2262	bg => [0, 0, 0, 0.2],
2074	active_bg => [1, 1, 1, 0.5],	2263	active_bg => [1, 1, 1, 0.5],
2075	range => [0, 0, 100, 10],	2264	range => [0, 0, 100, 10, 0],
2076	req_w => $::WIDTH / 80,	2265	min_w => $::WIDTH / 80,
2077	req_h => $::WIDTH / 80,	2266	min_h => $::WIDTH / 80,
2078	vertical => 0,	2267	vertical => 0,
2079	can_hover => 1,	2268	can_hover => 1,
2080	inner_pad => 0.02,	2269	inner_pad => 0.02,
2081	@_	2270	@_
2082	);	2271	);
…		…
2085	$self->update;	2274	$self->update;
2086		2275
2087	$self	2276	$self
2088	}	2277	}
2089		2278
		2279	sub changed { }
		2280
2090	sub set_range {	2281	sub set_range {
2091	my ($self, $range) = @_;	2282	my ($self, $range) = @_;
2092		2283
2093	$self->{range} = $range;	2284	($range, $self->{range}) = ($self->{range}, $range);
2094		2285
2095	$self->update;	2286	$self->update
		2287	if "@$range" ne "@{$self->{range}}";
2096	}	2288	}
2097		2289
2098	sub set_value {	2290	sub set_value {
2099	my ($self, $value) = @_;	2291	my ($self, $value) = @_;
2100		2292
2101	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};	2293	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
2102		2294
2103	$hi = $lo + 1 if $hi <= $lo;	2295	$hi = $lo + 1 if $hi <= $lo;
2104		2296
		2297	$page = $hi - $lo if $page > $hi - $lo;
		2298
2105	$value = $lo if $value < $lo;	2299	$value = $lo if $value < $lo;
2106	$value = $hi if $value > $hi;	2300	$value = $hi - $page if $value > $hi - $page;
2107		2301
2108	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit	2302	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
2109	if $unit;	2303	if $unit;
2110		2304
2111	$page = $hi - $lo if $page > $hi - $lo;
2112
2113	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2305	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2114		2306
2115	if ($value != $old_value) {	2307	if ($value != $old_value) {
2116	$self->emit (changed => $value);	2308	$self->_emit (changed => $value);
2117	$self->update;	2309	$self->update;
2118	}	2310	}
2119	}	2311	}
2120		2312
2121	sub size_request {	2313	sub size_request {
2122	my ($self) = @_;	2314	my ($self) = @_;
2123		2315
2124	my $w = $self->{req_w};	2316	($self->{req_w}, $self->{req_h})
2125	my $h = $self->{req_h};
2126
2127	$self->{vertical} ? ($h, $w) : ($w, $h)
2128	}	2317	}
2129		2318
2130	sub button_down {	2319	sub button_down {
2131	my ($self, $ev, $x, $y) = @_;	2320	my ($self, $ev, $x, $y) = @_;
2132		2321
2133	$self->SUPER::button_down ($ev, $x, $y);	2322	$self->SUPER::button_down ($ev, $x, $y);
		2323
		2324	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
		2325
2134	$self->mouse_motion ($ev, $x, $y);	2326	$self->mouse_motion ($ev, $x, $y)
2135	}	2327	}
2136		2328
2137	sub mouse_motion {	2329	sub mouse_motion {
2138	my ($self, $ev, $x, $y) = @_;	2330	my ($self, $ev, $x, $y) = @_;
2139		2331
2140	if ($GRAB == $self) {	2332	if ($GRAB == $self) {
2141	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2333	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2142		2334
2143	my (undef, $lo, $hi, $page) = @{$self->{range}};	2335	my (undef, $lo, $hi, $page) = @{$self->{range}};
2144		2336
2145	$x = $x / ($w * (1 - 2 * $self->{inner_pad})) - $self->{inner_pad};	2337	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2146		2338
2147	$self->set_value ($x * ($hi - $lo) + $lo);	2339	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2340	} else {
		2341	return 0;
		2342	}
		2343
2148	}	2344	1
2149	}	2345	}
2150		2346
2151	sub update {	2347	sub update {
2152	my ($self) = @_;	2348	my ($self) = @_;
2153		2349
2154	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2350	delete $self->{knob_w};
		2351	$self->SUPER::update;
		2352	}
		2353
		2354	sub _draw {
		2355	my ($self) = @_;
		2356
		2357	unless ($self->{knob_w}) {
2155	$self->set_value ($self->{range}[0]);	2358	$self->set_value ($self->{range}[0]);
2156		2359
2157	my ($value, $lo, $hi, $page) = @{$self->{range}};	2360	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2361	my $range = ($hi - $page - $lo) || 1e-100;
2158		2362
2159	my $inner_w = 1 - 2 * $self->{inner_pad};	2363	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2160		2364
2161	$self->{scale} = ($inner_w / ($hi - $lo)) || 1;	2365	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
		2366	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2162		2367
2163	$page = $self->{scale} * $page || 10 / ($self->{w} || 1);	2368	$value = ($value - $lo) / $range;
2164	$value = $self->{scale} * ($value - $lo);	2369	$value = $value * $self->{scale} + $self->{offset};
2165		2370
2166	$value = $self->{inner_pad} + ($value - $page * 0.5);
2167
2168	$value = 0 if $value < 0;
2169	$page = 1 - $value if $value + $page > 1;
2170
2171	$self->{knob_x} = $value;	2371	$self->{knob_x} = $value - $knob_w * 0.5;
2172	$self->{knob_w} = $page;	2372	$self->{knob_w} = $knob_w;
2173	});	2373	}
2174
2175	$self->SUPER::update;
2176	}
2177
2178	sub _draw {
2179	my ($self) = @_;
2180		2374
2181	$self->SUPER::_draw ();	2375	$self->SUPER::_draw ();
2182		2376
2183	glScale $self->{w}, $self->{h};	2377	glScale $self->{w}, $self->{h};
2184		2378
…		…
2293	$self->{layout}->set_width ($self->{children}[0]{w});	2487	$self->{layout}->set_width ($self->{children}[0]{w});
2294		2488
2295	$self->reflow;	2489	$self->reflow;
2296	}	2490	}
2297		2491
2298	sub text_height {	2492	sub text_size {
2299	my ($self, $text, $indent) = @_;	2493	my ($self, $text, $indent) = @_;
2300		2494
2301	my $layout = $self->{layout};	2495	my $layout = $self->{layout};
2302		2496
2303	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2497	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2304	$layout->set_width ($self->{children}[0]{w} - $indent);	2498	$layout->set_width ($self->{children}[0]{w} - $indent);
2305	$layout->set_markup ($text);	2499	$layout->set_markup ($text);
2306		2500
2307	($layout->size)[1]	2501	$layout->size
2308	}	2502	}
2309		2503
2310	sub reflow {	2504	sub reflow {
2311	my ($self) = @_;	2505	my ($self) = @_;
2312		2506
2313	$self->{need_reflow}++;	2507	$self->{need_reflow}++;
2314	$self->update;	2508	$self->update;
2315	}	2509	}
2316		2510
		2511	sub set_offset {
		2512	my ($self, $offset) = @_;
		2513
		2514	# todo: base offset on lines or so, not on pixels
		2515	$self->{children}[1]->set_value ($offset);
		2516	}
		2517
2317	sub clear {	2518	sub clear {
2318	my ($self) = @_;	2519	my ($self) = @_;
2319		2520
2320	$self->{par} = [];	2521	$self->{par} = [];
2321	$self->{height} = 0;	2522	$self->{height} = 0;
2322		2523	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2323	$self->reflow;
2324	}	2524	}
2325		2525
2326	sub add_paragraph {	2526	sub add_paragraph {
2327	my ($self, $color, $text, $indent) = @_;	2527	my ($self, $color, $text, $indent) = @_;
2328		2528
2329	for my $line (split /\n/, $text) {	2529	for my $line (split /\n/, $text) {
2330	my $height = $self->text_height ($line);	2530	my ($w, $h) = $self->text_size ($line);
2331	$self->{height} += $height;	2531	$self->{height} += $h;
2332	push @{$self->{par}}, [$height, $color, $indent, $line];	2532	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2333	}	2533	}
2334		2534
2335	$self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}];	2535	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2336	$self->{children}[1]->update;
2337	}	2536	}
2338		2537
2339	sub update {	2538	sub update {
2340	my ($self) = @_;	2539	my ($self) = @_;
2341		2540
…		…
2344	return unless $self->{h} > 0;	2543	return unless $self->{h} > 0;
2345		2544
2346	delete $self->{texture};	2545	delete $self->{texture};
2347		2546
2348	$ROOT->on_post_alloc ($self, sub {	2547	$ROOT->on_post_alloc ($self, sub {
		2548	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2549
2349	if (delete $self->{need_reflow}) {	2550	if (delete $self->{need_reflow}) {
2350	my $height = 0;	2551	my $height = 0;
2351		2552
2352	$height += $_->[0] = $self->text_height ($_->[3], $_->[2])	2553	my $layout = $self->{layout};
		2554
		2555	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2556
2353	for @{$self->{par}};	2557	for (@{$self->{par}}) {
		2558	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
		2559	$layout->set_width ($W - $_->[3]);
		2560	$layout->set_markup ($_->[4]);
		2561	my ($w, $h) = $layout->size;
		2562	$_->[0] = $w + $_->[3];
		2563	$_->[1] = $h;
		2564	}
		2565
		2566	$height += $_->[1];
		2567	}
2354		2568
2355	$self->{height} = $height;	2569	$self->{height} = $height;
2356		2570
2357	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2571	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2358	$self->{children}[1]->update;
2359		2572
2360	delete $self->{texture};	2573	delete $self->{texture};
2361	}	2574	}
2362		2575
2363	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {	2576	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2364	glClearColor 0.5, 0.5, 0.5, 0;	2577	glClearColor 0.5, 0.5, 0.5, 0;
2365	glClear GL_COLOR_BUFFER_BIT;	2578	glClear GL_COLOR_BUFFER_BIT;
2366		2579
2367	my $top = int $self->{children}[1]{range}[0];	2580	my $top = int $self->{children}[1]{range}[0];
2368		2581
2369	my $y0 = $top;	2582	my $y0 = $top;
2370	my $y1 = $top + $self->{h};	2583	my $y1 = $top + $H;
2371		2584
2372	my $y = 0;	2585	my $y = 0;
2373		2586
2374	my $layout = $self->{layout};	2587	my $layout = $self->{layout};
2375		2588
2376	$layout->set_font ($self->{font}) if $self->{font};	2589	$layout->set_font ($self->{font}) if $self->{font};
2377		2590
2378	glEnable GL_BLEND;	2591	glEnable GL_BLEND;
		2592	#TODO# not correct in windows where rgba is forced off
2379	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2593	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2380		2594
2381	for my $par (@{$self->{par}}) {	2595	for my $par (@{$self->{par}}) {
2382	my $h = $par->[0];	2596	my $h = $par->[1];
2383		2597
2384	if ($y0 < $y + $h && $y < $y1) {	2598	if ($y0 < $y + $h && $y < $y1) {
2385	$layout->set_foreground (@{ $par->[1] });	2599	$layout->set_foreground (@{ $par->[2] });
2386	$layout->set_width ($self->{w} - $par->[2]);	2600	$layout->set_width ($W - $par->[3]);
2387	$layout->set_markup ($par->[3]);	2601	$layout->set_markup ($par->[4]);
2388		2602
2389	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2603	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2390		2604
2391	glRasterPos $par->[2], $y - $y0;	2605	glRasterPos $par->[3], $y - $y0;
2392	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2606	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2393	}	2607	}
2394		2608
2395	$y += $h;	2609	$y += $h;
2396	}	2610	}
…		…
2463		2677
2464	sub new {	2678	sub new {
2465	my $class = shift;	2679	my $class = shift;
2466		2680
2467	my $self = $class->SUPER::new (	2681	my $self = $class->SUPER::new (
2468	state => 0,	2682	state => 0,
2469	connect_activate => \&toggle_flopper,	2683	on_activate => \&toggle_flopper,
2470	@_	2684	@_
2471	);	2685	);
2472		2686
2473	if ($self->{state}) {
2474	$self->{state} = 0;
2475	$self->toggle_flopper;
2476	}
2477
2478	$self	2687	$self
2479	}	2688	}
2480		2689
2481	sub toggle_flopper {	2690	sub toggle_flopper {
2482	my ($self) = @_;	2691	my ($self) = @_;
2483		2692
2484	# TODO: use animation	2693	$self->{other}->toggle_visibility;
2485	if ($self->{state} = !$self->{state}) {
2486	$CFClient::UI::ROOT->add ($self->{other});
2487	$self->{other}->move ($self->coord2global (0, $self->{h}));
2488	$self->emit ("open");
2489	} else {
2490	$CFClient::UI::ROOT->remove ($self->{other});
2491	$self->emit ("close");
2492	}
2493
2494	$self->emit (changed => $self->{state});
2495	}	2694	}
2496		2695
2497	#############################################################################	2696	#############################################################################
2498		2697
2499	package CFClient::UI::Tooltip;	2698	package CFClient::UI::Tooltip;
…		…
2512	}	2711	}
2513		2712
2514	sub set_tooltip_from {	2713	sub set_tooltip_from {
2515	my ($self, $widget) = @_;	2714	my ($self, $widget) = @_;
2516		2715
		2716	my $tooltip = $widget->{tooltip};
		2717
		2718	if ($ENV{CFPLUS_DEBUG} & 2) {
		2719	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2720	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2721	. "req $widget->{req_w} $widget->{req_h}\n"
		2722	. "visible $widget->{visible}";
		2723	}
		2724
2517	$self->add (new CFClient::UI::Label	2725	$self->add (new CFClient::UI::Label
2518	markup => $widget->{tooltip},	2726	markup => $tooltip,
2519	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2727	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2520	fontsize => 0.8,	2728	fontsize => 0.8,
2521	fg => [0, 0, 0, 1],	2729	fg => [0, 0, 0, 1],
2522	ellipsise => 0,	2730	ellipsise => 0,
2523	font => ($widget->{tooltip_font} || $::FONT_PROP),	2731	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2534		2742
2535	sub size_allocate {	2743	sub size_allocate {
2536	my ($self, $w, $h) = @_;	2744	my ($self, $w, $h) = @_;
2537		2745
2538	$self->SUPER::size_allocate ($w - 4, $h - 4);	2746	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2747	}
		2748
		2749	sub visibility_change {
		2750	my ($self, $visible) = @_;
		2751
		2752	return unless $visible;
		2753
		2754	$self->{root}->on_post_alloc ("move_$self" => sub {
		2755	my $widget = $self->{owner}
		2756	or return;
		2757
		2758	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2759
		2760	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2761	if $x + $self->{w} > $::WIDTH;
		2762
		2763	$self->move_abs ($x, $y);
		2764	});
2539	}	2765	}
2540		2766
2541	sub _draw {	2767	sub _draw {
2542	my ($self) = @_;	2768	my ($self) = @_;
2543		2769
…		…
2560	glVertex $w, $h;	2786	glVertex $w, $h;
2561	glVertex $w, 0;	2787	glVertex $w, 0;
2562	glEnd;	2788	glEnd;
2563		2789
2564	glTranslate 2 - 0.375, 2 - 0.375;	2790	glTranslate 2 - 0.375, 2 - 0.375;
		2791
2565	$self->SUPER::_draw;	2792	$self->SUPER::_draw;
2566	}	2793	}
2567		2794
2568	#############################################################################	2795	#############################################################################
2569		2796
…		…
2575		2802
2576	sub new {	2803	sub new {
2577	my $class = shift;	2804	my $class = shift;
2578		2805
2579	my $self = $class->SUPER::new (	2806	my $self = $class->SUPER::new (
2580	aspect => 1,	2807	aspect => 1,
		2808	can_events => 0,
2581	@_,	2809	@_,
2582	);	2810	);
2583		2811
2584	if ($self->{anim} && $self->{animspeed}) {	2812	if ($self->{anim} && $self->{animspeed}) {
2585	Scalar::Util::weaken (my $widget = $self);	2813	Scalar::Util::weaken (my $widget = $self);
…		…
2611	}	2839	}
2612		2840
2613	sub _draw {	2841	sub _draw {
2614	my ($self) = @_;	2842	my ($self) = @_;
2615		2843
2616	return unless $::CONN;#d# manage and cache textures differently	2844	return unless $::CONN;
2617		2845
2618	my $face;	2846	my $face;
2619		2847
2620	if ($self->{frame}) {	2848	if ($self->{frame}) {
2621	my $anim = $::CONN->{anim}[$self->{anim}];	2849	my $anim = $::CONN->{anim}[$self->{anim}];
…		…
2644	$self->SUPER::DESTROY;	2872	$self->SUPER::DESTROY;
2645	}	2873	}
2646		2874
2647	#############################################################################	2875	#############################################################################
2648		2876
2649	package CFClient::UI::InventoryItem;	2877	package CFClient::UI::Buttonbar;
2650		2878
2651	our @ISA = CFClient::UI::HBox::;	2879	our @ISA = CFClient::UI::HBox::;
2652		2880
2653	sub _item_to_desc {	2881	# TODO: should actualyl wrap buttons and other goodies.
2654	my ($item) = @_;
2655
2656	my $desc =
2657	$item->{nrof} < 2
2658	? $item->{name}
2659	: "$item->{nrof} × $item->{name_pl}";
2660
2661	$item->{flags} & Crossfire::Protocol::F_OPEN
2662	and $desc .= " (open)";
2663	$item->{flags} & Crossfire::Protocol::F_APPLIED
2664	and $desc .= " (applied)";
2665	$item->{flags} & Crossfire::Protocol::F_UNPAID
2666	and $desc .= " (unpaid)";
2667	$item->{flags} & Crossfire::Protocol::F_MAGIC
2668	and $desc .= " (magic)";
2669	$item->{flags} & Crossfire::Protocol::F_CURSED
2670	and $desc .= " (cursed)";
2671	$item->{flags} & Crossfire::Protocol::F_DAMNED
2672	and $desc .= " (damned)";
2673	$item->{flags} & Crossfire::Protocol::F_LOCKED
2674	and $desc .= " *";
2675
2676	$desc
2677	}
2678
2679	sub new {
2680	my $class = shift;
2681
2682	my %args = @_;
2683
2684	my $item = delete $args{item};
2685
2686	my $desc = _item_to_desc ($item);
2687
2688	my $self = $class->SUPER::new (
2689	can_hover => 1,
2690	can_events => 1,
2691	tooltip => ((CFClient::UI::Label::escape $desc)
2692	. "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2693	connect_button_down => sub {
2694	my ($self, $ev, $x, $y) = @_;
2695
2696	# todo: maybe put examine on 1? but should just be a tooltip :(
2697	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2698	my $targ = $::CONN->{player}{tag};
2699
2700	if ($item->{container} == $::CONN->{player}{tag}) {
2701	$targ = $main::OPENCONT;
2702	}
2703
2704	$::CONN->send ("move $targ $item->{tag} 0");
2705	} elsif ($ev->{button} == 1) {
2706	$::CONN->send ("examine $item->{tag}");
2707	} elsif ($ev->{button} == 2) {
2708	$::CONN->send ("apply $item->{tag}");
2709	} elsif ($ev->{button} == 3) {
2710	my @menu_items = (
2711	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2712	["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2713	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2714	(
2715	$item->{flags} & Crossfire::Protocol::F_LOCKED
2716	? (
2717	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2718	)
2719	: (
2720	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2721	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2722	)
2723	),
2724	);
2725
2726	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2727	}
2728
2729	1
2730	},
2731	%args
2732	);
2733
2734
2735	$self->add (new CFClient::UI::Face
2736	can_events => 0,
2737	face => $item->{face},
2738	anim => $item->{anim},
2739	animspeed => $item->{animspeed},
2740	);
2741
2742	$self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2743
2744	$self->{item} = $item;
2745
2746	$self->update_item;
2747
2748	$self
2749	}
2750
2751	sub update_item {
2752	my ($self) = @_;
2753
2754	my $desc = _item_to_desc ($self->{item});
2755
2756	$self->{name_lbl}->set_text ($desc);
2757	}
2758
2759	#############################################################################
2760
2761	package CFClient::UI::Inventory;
2762
2763	our @ISA = CFClient::UI::ScrolledWindow::;
2764
2765	sub new {
2766	my $class = shift;
2767
2768	my $self = $class->SUPER::new (
2769	scrolled => (new CFClient::UI::Table),
2770	@_,
2771	);
2772
2773	$self
2774	}
2775
2776	sub set_items {
2777	my ($self, $items) = @_;
2778
2779	$self->{scrolled}->clear;
2780	return unless $items;
2781
2782	my @items = sort {
2783	($a->{type} <=> $b->{type})
2784	or ($a->{name} cmp $b->{name})
2785	} @$items;
2786
2787	$self->{real_items} = \@items;
2788
2789	for my $item (@items) {
2790	$item->{item} = $item;
2791	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2792	$item->update_item ();
2793	}
2794
2795	my $i = 0;
2796	for (@items) {
2797	$self->{scrolled}->add (0, $i, $_);
2798	my $nrof = $_->{item}->{nrof} || 1;
2799	$self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2800	}
2801
2802	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2803	}
2804
2805	sub size_request {
2806	my ($self) = @_;
2807	($self->{req_w}, $self->{req_h});
2808	}
2809		2882
2810	#############################################################################	2883	#############################################################################
2811		2884
2812	package CFClient::UI::Menu;	2885	package CFClient::UI::Menu;
2813		2886
…		…
2847		2920
2848	# popup given the event (must be a mouse button down event currently)	2921	# popup given the event (must be a mouse button down event currently)
2849	sub popup {	2922	sub popup {
2850	my ($self, $ev) = @_;	2923	my ($self, $ev) = @_;
2851		2924
2852	$self->emit ("popdown");	2925	$self->_emit ("popdown");
2853		2926
2854	# maybe save $GRAB? must be careful about events...	2927	# maybe save $GRAB? must be careful about events...
2855	$GRAB = $self;	2928	$GRAB = $self;
2856	$self->{button} = $ev->{button};	2929	$self->{button} = $ev->{button};
2857		2930
2858	$self->show;	2931	$self->show;
2859	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2932	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2860	}	2933	}
2861		2934
2862	sub mouse_motion {	2935	sub mouse_motion {
2863	my ($self, $ev, $x, $y) = @_;	2936	my ($self, $ev, $x, $y) = @_;
2864		2937
2865	# TODO: should use vbox->find_widget or so	2938	# TODO: should use vbox->find_widget or so
2866	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2939	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2867	$self->{hover} = $self->{item}{$HOVER};	2940	$self->{hover} = $self->{item}{$HOVER};
		2941
		2942	0
2868	}	2943	}
2869		2944
2870	sub button_up {	2945	sub button_up {
2871	my ($self, $ev, $x, $y) = @_;	2946	my ($self, $ev, $x, $y) = @_;
2872		2947
2873	if ($ev->{button} == $self->{button}) {	2948	if ($ev->{button} == $self->{button}) {
2874	undef $GRAB;	2949	undef $GRAB;
2875	$self->hide;	2950	$self->hide;
2876		2951
2877	$self->emit ("popdown");	2952	$self->_emit ("popdown");
2878	$self->{hover}[1]->() if $self->{hover};	2953	$self->{hover}[1]->() if $self->{hover};
		2954	} else {
		2955	return 0
		2956	}
		2957
		2958	1
		2959	}
		2960
		2961	#############################################################################
		2962
		2963	package CFClient::UI::Multiplexer;
		2964
		2965	our @ISA = CFClient::UI::Container::;
		2966
		2967	sub new {
		2968	my $class = shift;
		2969
		2970	my $self = $class->SUPER::new (
		2971	@_,
		2972	);
		2973
		2974	$self->{current} = $self->{children}[0]
		2975	if @{ $self->{children} };
		2976
		2977	$self
		2978	}
		2979
		2980	sub add {
		2981	my ($self, @widgets) = @_;
		2982
		2983	$self->SUPER::add (@widgets);
		2984
		2985	$self->{current} = $self->{children}[0]
		2986	if @{ $self->{children} };
		2987	}
		2988
		2989	sub set_current_page {
		2990	my ($self, $page_or_widget) = @_;
		2991
		2992	my $widget = ref $page_or_widget
		2993	? $page_or_widget
		2994	: $self->{children}[$page_or_widget];
		2995
		2996	$self->{current} = $widget;
		2997	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		2998
		2999	$self->_emit (page_changed => $self->{current});
		3000
		3001	$self->realloc;
		3002	}
		3003
		3004	sub visible_children {
		3005	$_[0]{current}
		3006	}
		3007
		3008	sub size_request {
		3009	my ($self) = @_;
		3010
		3011	$self->{current}->size_request
		3012	}
		3013
		3014	sub size_allocate {
		3015	my ($self, $w, $h) = @_;
		3016
		3017	$self->{current}->configure (0, 0, $w, $h);
		3018	}
		3019
		3020	sub _draw {
		3021	my ($self) = @_;
		3022
		3023	$self->{current}->draw;
		3024	}
		3025
		3026	#############################################################################
		3027
		3028	package CFClient::UI::Notebook;
		3029
		3030	our @ISA = CFClient::UI::VBox::;
		3031
		3032	sub new {
		3033	my $class = shift;
		3034
		3035	my $self = $class->SUPER::new (
		3036	buttonbar => (new CFClient::UI::Buttonbar),
		3037	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3038	# filter => # will be put between multiplexer and $self
		3039	@_,
		3040	);
2879	}	3041
		3042	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3043	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3044
		3045	$self
		3046	}
		3047
		3048	sub add {
		3049	my ($self, $title, $widget, $tooltip) = @_;
		3050
		3051	Scalar::Util::weaken $self;
		3052
		3053	$self->{buttonbar}->add (new CFClient::UI::Button
		3054	markup => $title,
		3055	tooltip => $tooltip,
		3056	on_activate => sub { $self->set_current_page ($widget) },
		3057	);
		3058
		3059	$self->{multiplexer}->add ($widget);
		3060	}
		3061
		3062	sub set_current_page {
		3063	my ($self, $page) = @_;
		3064
		3065	$self->{multiplexer}->set_current_page ($page);
		3066	$self->_emit (page_changed => $self->{multiplexer}{current});
2880	}	3067	}
2881		3068
2882	#############################################################################	3069	#############################################################################
2883		3070
2884	package CFClient::UI::Statusbox;	3071	package CFClient::UI::Statusbox;
…		…
2944	sub add {	3131	sub add {
2945	my ($self, $text, %arg) = @_;	3132	my ($self, $text, %arg) = @_;
2946		3133
2947	$text =~ s/^\s+//;	3134	$text =~ s/^\s+//;
2948	$text =~ s/\s+$//;	3135	$text =~ s/\s+$//;
		3136
		3137	return unless $text;
2949		3138
2950	my $timeout = time + ((delete $arg{timeout}) || 60);	3139	my $timeout = time + ((delete $arg{timeout}) || 60);
2951		3140
2952	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3141	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2953		3142
…		…
2987	$self->SUPER::reconfigure;	3176	$self->SUPER::reconfigure;
2988	}	3177	}
2989		3178
2990	#############################################################################	3179	#############################################################################
2991		3180
2992	package CFClient::UI::Root;	3181	package CFClient::UI::Inventory;
2993		3182
2994	our @ISA = CFClient::UI::Container::;	3183	our @ISA = CFClient::UI::ScrolledWindow::;
2995
2996	use CFClient::OpenGL;
2997		3184
2998	sub new {	3185	sub new {
2999	my $class = shift;	3186	my $class = shift;
3000		3187
3001	$class->SUPER::new (	3188	my $self = $class->SUPER::new (
		3189	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3190	@_,
		3191	);
		3192
		3193	$self
		3194	}
		3195
		3196	sub set_items {
		3197	my ($self, $items) = @_;
		3198
		3199	$self->{child}->clear;
		3200	return unless $items;
		3201
		3202	my @items = sort {
		3203	($a->{type} <=> $b->{type})
		3204	or ($a->{name} cmp $b->{name})
		3205	} @$items;
		3206
		3207	$self->{real_items} = \@items;
		3208
		3209	my $row = 0;
		3210	for my $item (@items) {
		3211	CFClient::Item::update_widgets $item;
		3212
		3213	$self->{child}->add (0, $row, $item->{face_widget});
		3214	$self->{child}->add (1, $row, $item->{desc_widget});
		3215	$self->{child}->add (2, $row, $item->{weight_widget});
		3216
		3217	$row++;
		3218	}
		3219	}
		3220
		3221	#############################################################################
		3222
		3223	package CFClient::UI::BindEditor;
		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 (my $vb = new CFClient::UI::VBox);
		3233
		3234
		3235	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3236	text => "start recording",
		3237	tooltip => "Start/Stops recording of actions."
		3238	."All subsequent actions after the recording started will be captured."
		3239	."The actions are displayed after the record was stopped."
		3240	."To bind the action you have to click on the 'Bind' button",
		3241	on_activate => sub {
		3242	unless ($self->{recording}) {
		3243	$self->start;
		3244	} else {
		3245	$self->stop;
		3246	}
		3247	});
		3248
		3249	$vb->add (new CFClient::UI::Label text => "Actions:");
		3250	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3251
		3252	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3253	$vb->add (my $hb = new CFClient::UI::HBox);
		3254	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3255	$hb->add (new CFClient::UI::Button
		3256	text => "bind",
		3257	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3258	on_activate => sub {
		3259	$self->ask_for_bind;
		3260	});
		3261
		3262	$vb->add (my $hb = new CFClient::UI::HBox);
		3263	$hb->add (new CFClient::UI::Button
		3264	text => "ok",
		3265	expand => 1,
		3266	tooltip => "This closes the binding editor and saves the binding",
		3267	on_activate => sub {
		3268	$self->hide;
		3269	$self->commit;
		3270	});
		3271
		3272	$hb->add (new CFClient::UI::Button
		3273	text => "cancel",
		3274	expand => 1,
		3275	tooltip => "This closes the binding editor without saving",
		3276	on_activate => sub {
		3277	$self->hide;
		3278	$self->{binding_cancel}->()
		3279	if $self->{binding_cancel};
		3280	});
		3281
		3282	$self->update_binding_widgets;
		3283
		3284	$self
		3285	}
		3286
		3287	sub commit {
		3288	my ($self) = @_;
		3289	my ($mod, $sym, $cmds) = $self->get_binding;
		3290	if ($sym != 0 && @$cmds > 0) {
		3291	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3292	."'. Don't forget 'Save Config'!");
		3293	$self->{binding_change}->($mod, $sym, $cmds)
		3294	if $self->{binding_change};
		3295	} else {
		3296	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3297	$self->{binding_cancel}->()
		3298	if $self->{binding_cancel};
		3299	}
		3300	}
		3301
		3302	sub start {
		3303	my ($self) = @_;
		3304
		3305	$self->{rec_btn}->set_text ("stop recording");
		3306	$self->{recording} = 1;
		3307	$self->clear_command_list;
		3308	$::CONN->start_record if $::CONN;
		3309	}
		3310
		3311	sub stop {
		3312	my ($self) = @_;
		3313
		3314	$self->{rec_btn}->set_text ("start recording");
		3315	$self->{recording} = 0;
		3316
		3317	my $rec;
		3318	$rec = $::CONN->stop_record if $::CONN;
		3319	return unless ref $rec eq 'ARRAY';
		3320	$self->set_command_list ($rec);
		3321	}
		3322
		3323
		3324	sub ask_for_bind_and_commit {
		3325	my ($self) = @_;
		3326	$self->ask_for_bind (1);
		3327	}
		3328
		3329	sub ask_for_bind {
		3330	my ($self, $commit) = @_;
		3331
		3332	CFClient::Binder::open_binding_dialog (sub {
		3333	my ($mod, $sym) = @_;
		3334	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3335	$self->update_binding_widgets;
		3336	$self->commit if $commit;
		3337	});
		3338	}
		3339
		3340	# $mod and $sym are the modifiers and key symbol
		3341	# $cmds is a array ref of strings (the commands)
		3342	# $cb is the callback that is executed on OK
		3343	# $ccb is the callback that is executed on CANCEL and
		3344	# when the binding was unsuccessful on OK
		3345	sub set_binding {
		3346	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3347
		3348	$self->clear_command_list;
		3349	$self->{recording} = 0;
		3350	$self->{rec_btn}->set_text ("start recording");
		3351
		3352	$self->{binding} = [$mod, $sym];
		3353	$self->{commands} = $cmds;
		3354
		3355	$self->{binding_change} = $cb;
		3356	$self->{binding_cancel} = $ccb;
		3357
		3358	$self->update_binding_widgets;
		3359	}
		3360
		3361	# this is a shortcut method that asks for a binding
		3362	# and then just binds it.
		3363	sub do_quick_binding {
		3364	my ($self, $cmds) = @_;
		3365	$self->set_binding (undef, undef, $cmds, sub {
		3366	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3367	});
		3368	$self->ask_for_bind (1);
		3369	}
		3370
		3371	sub update_binding_widgets {
		3372	my ($self) = @_;
		3373	my ($mod, $sym, $cmds) = $self->get_binding;
		3374	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3375	$self->set_command_list ($cmds);
		3376	}
		3377
		3378	sub get_binding {
		3379	my ($self) = @_;
		3380	return (
		3381	$self->{binding}->[0],
		3382	$self->{binding}->[1],
		3383	[ grep { defined $_ } @{$self->{commands}} ]
		3384	);
		3385	}
		3386
		3387	sub clear_command_list {
		3388	my ($self) = @_;
		3389	$self->{cmdbox}->clear ();
		3390	}
		3391
		3392	sub set_command_list {
		3393	my ($self, $cmds) = @_;
		3394
		3395	$self->{cmdbox}->clear ();
		3396	$self->{commands} = $cmds;
		3397
		3398	my $idx = 0;
		3399
		3400	for (@$cmds) {
		3401	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3402
		3403	my $i = $idx;
		3404	$hb->add (new CFClient::UI::Label text => $_);
		3405	$hb->add (new CFClient::UI::Button
		3406	text => "delete",
		3407	tooltip => "Deletes the action from the record",
		3408	on_activate => sub {
		3409	$self->{cmdbox}->remove ($hb);
		3410	$cmds->[$i] = undef;
		3411	});
		3412
		3413
		3414	$idx++
		3415	}
		3416	}
		3417
		3418	#############################################################################
		3419
		3420	package CFClient::UI::SpellList;
		3421
		3422	our @ISA = CFClient::UI::Table::;
		3423
		3424	sub new {
		3425	my $class = shift;
		3426
		3427	my $self = $class->SUPER::new (
		3428	binding => [],
		3429	commands => [],
3002	@_,	3430	@_,
3003	)	3431	)
3004	}	3432	}
3005		3433
3006	sub configure {	3434	# XXX: Do sorting? Argl...
3007	my ($self, $x, $y, $w, $h) = @_;	3435	sub add_spell {
3008
3009	$self->{w} = $w;
3010	$self->{h} = $h;
3011	}
3012
3013	sub check_size {
3014	my ($self) = @_;	3436	my ($self, $spell) = @_;
		3437	$self->{spells}->{$spell->{name}} = $spell;
3015		3438
3016	$self->size_allocate ($self->{w}, $self->{h})	3439	$self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3017	if $self->{w};	3440	face => $spell->{face},
		3441	can_hover => 1,
		3442	can_events => 1,
		3443	tooltip => $spell->{message});
		3444
		3445	$self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3446	text => $spell->{name},
		3447	can_hover => 1,
		3448	can_events => 1,
		3449	tooltip => $spell->{message},
		3450	expand => 1);
		3451
		3452	$self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3453	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3454	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3455	expand => 1);
		3456
		3457	$self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3458	text => "bind to key",
		3459	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3460	}
		3461
		3462	sub rebuild_spell_list {
		3463	my ($self) = @_;
		3464	$self->{tbl_idx} = 0;
		3465	$self->add_spell ($_) for values %{$self->{spells}};
		3466	}
		3467
		3468	sub remove_spell {
		3469	my ($self, $spell) = @_;
		3470	delete $self->{spells}->{$spell->{name}};
		3471	$self->rebuild_spell_list;
		3472	}
		3473
		3474	#############################################################################
		3475
		3476	package CFClient::UI::Root;
		3477
		3478	our @ISA = CFClient::UI::Container::;
		3479
		3480	use CFClient::OpenGL;
		3481
		3482	sub new {
		3483	my $class = shift;
		3484
		3485	my $self = $class->SUPER::new (
		3486	visible => 1,
		3487	@_,
		3488	);
		3489
		3490	Scalar::Util::weaken ($self->{root} = $self);
		3491
		3492	$self
3018	}	3493	}
3019		3494
3020	sub size_request {	3495	sub size_request {
3021	my ($self) = @_;	3496	my ($self) = @_;
3022		3497
3023	($self->{w}, $self->{h})	3498	($self->{w}, $self->{h})
		3499	}
		3500
		3501	sub _to_pixel {
		3502	my ($coord, $size, $max) = @_;
		3503
		3504	$coord =
		3505	$coord eq "center" ? ($max - $size) * 0.5
		3506	: $coord eq "max" ? $max
		3507	: $coord;
		3508
		3509	$coord = 0 if $coord < 0;
		3510	$coord = $max - $size if $coord > $max - $size;
		3511
		3512	int $coord + 0.5
3024	}	3513	}
3025		3514
3026	sub size_allocate {	3515	sub size_allocate {
3027	my ($self, $w, $h) = @_;	3516	my ($self, $w, $h) = @_;
3028		3517
3029	my $old_w = $self->{old_w}; $self->{old_w} = $w;
3030	my $old_h = $self->{old_h}; $self->{old_h} = $h;
3031
3032	CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
3033	if $old_w && $old_h && ($old_w != $w || $old_h != $h);
3034
3035	for my $child ($self->children) {	3518	for my $child ($self->children) {
3036	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3519	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3037		3520
3038	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3521	$X = $child->{force_x} if exists $child->{force_x};
3039	if exists $child->{req_x};	3522	$Y = $child->{force_y} if exists $child->{force_y};
3040		3523
3041	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3524	$X = _to_pixel $X, $W, $self->{w};
3042	if exists $child->{req_y};	3525	$Y = _to_pixel $Y, $H, $self->{h};
3043
3044	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3045	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3046		3526
3047	$child->configure ($X, $Y, $W, $H);	3527	$child->configure ($X, $Y, $W, $H);
3048	}	3528	}
3049	}	3529	}
3050		3530
…		…
3061	}	3541	}
3062		3542
3063	sub update {	3543	sub update {
3064	my ($self) = @_;	3544	my ($self) = @_;
3065		3545
3066	$self->check_size;
3067	$::WANT_REFRESH++;	3546	$::WANT_REFRESH++;
3068	}	3547	}
3069		3548
3070	sub add {	3549	sub add {
3071	my ($self, @children) = @_;	3550	my ($self, @children) = @_;
3072		3551
3073	for my $child (@children) {
3074	$child->{toplevel} = 1;	3552	$_->{is_toplevel} = 1
3075		3553	for @children;
3076	# integerise window positions
3077	$child->{x} = int $child->{x};
3078	$child->{y} = int $child->{y};
3079	}
3080		3554
3081	$self->SUPER::add (@children);	3555	$self->SUPER::add (@children);
		3556	}
		3557
		3558	sub remove {
		3559	my ($self, @children) = @_;
		3560
		3561	$self->SUPER::remove (@children);
		3562
		3563	delete $self->{is_toplevel}
		3564	for @children;
3082		3565
3083	while (@children) {	3566	while (@children) {
3084	my $w = pop @children;	3567	my $w = pop @children;
3085	push @children, $w->children;	3568	push @children, $w->children;
3086	$w->{visible} = 1;	3569	$w->set_invisible;
3087	}
3088	}
3089
3090	sub remove {
3091	my ($self, @children) = @_;
3092
3093	$self->SUPER::remove (@children);
3094
3095	while (@children) {
3096	my $w = pop @children;
3097	push @children, $w->children;
3098	delete $w->{visible};
3099	}	3570	}
3100	}	3571	}
3101		3572
3102	sub on_refresh {	3573	sub on_refresh {
3103	my ($self, $id, $cb) = @_;	3574	my ($self, $id, $cb) = @_;
…		…
3117	while ($self->{refresh_hook}) {	3588	while ($self->{refresh_hook}) {
3118	$_->()	3589	$_->()
3119	for values %{delete $self->{refresh_hook}};	3590	for values %{delete $self->{refresh_hook}};
3120	}	3591	}
3121		3592
3122	if ($self->{check_size}) {	3593	if ($self->{realloc}) {
3123	my @queue = ([], []);	3594	my %queue;
		3595	my @queue;
		3596	my $widget;
3124		3597
3125	for (;;) {	3598	outer:
3126	if ($self->{check_size}) {	3599	while () {
3127	# heuristic: check containers last	3600	if (my $realloc = delete $self->{realloc}) {
3128	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3601	for $widget (values %$realloc) {
3129	for values %{delete $self->{check_size}}	3602	$widget->{visible} or next; # do not resize invisible widgets
		3603
		3604	$queue{$widget+0}++ and next; # duplicates are common
		3605
		3606	push @{ $queue[$widget->{visible}] }, $widget;
		3607	}
3130	}	3608	}
3131		3609
3132	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3610	while () {
		3611	@queue or last outer;
3133		3612
3134	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3613	$widget = pop @{ $queue[-1] || [] }
3135	? @$widget{qw(user_w user_h)}	3614	and last;
3136	: $widget->size_request;
3137
3138	if (delete $widget->{force_alloc}
3139	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3140	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3141		3615
		3616	pop @queue;
		3617	}
		3618
		3619	delete $queue{$widget+0};
		3620
		3621	my ($w, $h) = $widget->size_request;
		3622
		3623	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3624	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3625
		3626	$w = $widget->{force_w} if exists $widget->{force_w};
		3627	$h = $widget->{force_h} if exists $widget->{force_h};
		3628
		3629	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3630	|| delete $widget->{force_realloc}) {
3142	$widget->{req_w} = $w;	3631	$widget->{req_w} = $w;
3143	$widget->{req_h} = $h;	3632	$widget->{req_h} = $h;
3144		3633
3145	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3634	$self->{size_alloc}{$widget+0} = $widget;
3146		3635
3147	$widget->{parent}->check_size
3148	if $widget->{parent};	3636	if (my $parent = $widget->{parent}) {
		3637	$self->{realloc}{$parent+0} = $parent
		3638	unless $queue{$parent+0};
		3639
		3640	$parent->{force_size_alloc} = 1;
		3641	$self->{size_alloc}{$parent+0} = $parent;
		3642	}
3149	}	3643	}
		3644
		3645	delete $self->{realloc}{$widget+0};
3150	}	3646	}
3151	}	3647	}
3152		3648
3153	while ($self->{size_alloc}) {	3649	while (my $size_alloc = delete $self->{size_alloc}) {
3154	for (values %{delete $self->{size_alloc}}) {	3650	my @queue = sort { $b->{visible} <=> $a->{visible} }
3155	my ($widget, $w, $h) = @$_;	3651	values %$size_alloc;
		3652
		3653	while () {
		3654	my $widget = pop @queue || last;
		3655
		3656	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3156		3657
3157	$w = 0 if $w < 0;	3658	$w = 0 if $w < 0;
3158	$h = 0 if $h < 0;	3659	$h = 0 if $h < 0;
3159		3660
		3661	$w = int $w + 0.5;
		3662	$h = int $h + 0.5;
		3663
		3664	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3665	$widget->{old_w} = $widget->{w};
		3666	$widget->{old_h} = $widget->{h};
		3667
3160	$widget->{w} = $w;	3668	$widget->{w} = $w;
3161	$widget->{h} = $h;	3669	$widget->{h} = $h;
3162	$widget->size_allocate ($w, $h);	3670
3163	$widget->emit (size_allocate => $w, $h);	3671	$widget->emit (size_allocate => $w, $h);
		3672	}
3164	}	3673	}
3165	}	3674	}
3166		3675
3167	while ($self->{post_alloc_hook}) {	3676	while ($self->{post_alloc_hook}) {
3168	$_->()	3677	$_->()
3169	for values %{delete $self->{post_alloc_hook}};	3678	for values %{delete $self->{post_alloc_hook}};
3170	}	3679	}
		3680
3171		3681
3172	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3682	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3173	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3683	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3174	glClear GL_COLOR_BUFFER_BIT;	3684	glClear GL_COLOR_BUFFER_BIT;
3175		3685
…		…
3177	glLoadIdentity;	3687	glLoadIdentity;
3178	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3688	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3179	glMatrixMode GL_MODELVIEW;	3689	glMatrixMode GL_MODELVIEW;
3180	glLoadIdentity;	3690	glLoadIdentity;
3181		3691
		3692	{
		3693	package CFClient::UI::Base;
		3694
		3695	($draw_x, $draw_y, $draw_w, $draw_h) =
		3696	(0, 0, $self->{w}, $self->{h});
		3697	}
		3698
3182	$self->_draw;	3699	$self->_draw;
3183	}	3700	}
3184		3701
3185	#############################################################################	3702	#############################################################################
3186		3703

Diff Legend

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