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.230 by root, Wed May 24 21:59:54 2006 UTC vs.
Revision 1.264 by root, Thu Jun 1 02:58:30 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
		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	}
18		43
19	sub check_tooltip {	44	sub check_tooltip {
20	if (!$GRAB) {	45	if (!$GRAB) {
21	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	46	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
22	if (length $widget->{tooltip}) {	47	if (length $widget->{tooltip}) {
23		48
24	if ($TOOLTIP->{owner} != $widget) {	49	if ($TOOLTIP->{owner} != $widget) {
		50	$TOOLTIP->hide;
		51
25	$TOOLTIP->{owner} = $widget;	52	$TOOLTIP->{owner} = $widget;
26		53
27	my $tip = $widget->{tooltip};	54	my $tip = $widget->{tooltip};
28		55
29	$tip = $tip->($widget) if CODE:: eq ref $tip;	56	$tip = $tip->($widget) if CODE:: eq ref $tip;
30		57
31	$TOOLTIP->set_tooltip_from ($widget);	58	$TOOLTIP->set_tooltip_from ($widget);
32	$TOOLTIP->show;	59	$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	}	60	}
43		61
44	return;	62	return;
45	}	63	}
46	}	64	}
…		…
50	delete $TOOLTIP->{owner};	68	delete $TOOLTIP->{owner};
51	}	69	}
52		70
53	# class methods for events	71	# class methods for events
54	sub feed_sdl_key_down_event {	72	sub feed_sdl_key_down_event {
55	$FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0])	73	$FOCUS->emit (key_down => $_[0])
56	if $FOCUS;	74	if $FOCUS;
57	}	75	}
58		76
59	sub feed_sdl_key_up_event {	77	sub feed_sdl_key_up_event {
60	$FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0])	78	$FOCUS->emit (key_up => $_[0])
61	if $FOCUS;	79	if $FOCUS;
62	}	80	}
63		81
64	sub feed_sdl_button_down_event {	82	sub feed_sdl_button_down_event {
65	my ($ev) = @_;	83	my ($ev) = @_;
…		…
74	check_tooltip;	92	check_tooltip;
75	}	93	}
76		94
77	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	95	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
78		96
79	if ($GRAB) {	97	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
80	($x, $y) = $GRAB->coord2local ($x, $y);	98	if $GRAB;
81	$GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
82	}
83	}	99	}
84		100
85	sub feed_sdl_button_up_event {	101	sub feed_sdl_button_up_event {
86	my ($ev) = @_;	102	my ($ev) = @_;
87	my ($x, $y) = ($ev->{x}, $ev->{y});	103	my ($x, $y) = ($ev->{x}, $ev->{y});
88		104
89	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	105	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
90		106
91	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	107	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
92		108
93	if ($GRAB) {	109	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
94	($x, $y) = $GRAB->coord2local ($x, $y);	110	if $GRAB;
95	$GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
96	}
97		111
98	if (!$BUTTON_STATE) {	112	if (!$BUTTON_STATE) {
99	my $grab = $GRAB; undef $GRAB;	113	my $grab = $GRAB; undef $GRAB;
100	$grab->update if $grab;	114	$grab->update if $grab;
101	$GRAB->update if $GRAB;	115	$GRAB->update if $GRAB;
…		…
117	$HOVER->update if $HOVER && $HOVER->{can_hover};	131	$HOVER->update if $HOVER && $HOVER->{can_hover};
118		132
119	check_tooltip;	133	check_tooltip;
120	}	134	}
121		135
122	if ($HOVER) {
123	($x, $y) = $HOVER->coord2local ($x, $y);
124	$HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y);	136	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
125	}	137	if $HOVER;
126	}	138	}
127		139
128	# convert position array to integers	140	# convert position array to integers
129	sub harmonize {	141	sub harmonize {
130	my ($vals) = @_;	142	my ($vals) = @_;
…		…
158	sub rescale_widgets {	170	sub rescale_widgets {
159	my ($sx, $sy) = @_;	171	my ($sx, $sy) = @_;
160		172
161	for my $widget (values %WIDGET) {	173	for my $widget (values %WIDGET) {
162	if ($widget->{is_toplevel}) {	174	if ($widget->{is_toplevel}) {
		175	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		176	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		177
163	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};	178	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
164	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};	179	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
165	$widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};	180	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
166	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
167	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};	181	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
168	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	182	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
169	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};	183	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
170	$widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h};	184
		185	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		186	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		187
171	}	188	}
172	}	189	}
173		190
174	reconfigure_widgets;	191	reconfigure_widgets;
175	}	192	}
…		…
184		201
185	sub new {	202	sub new {
186	my $class = shift;	203	my $class = shift;
187		204
188	my $self = bless {	205	my $self = bless {
189	x => 0,	206	x => "center",
190	y => 0,	207	y => "center",
191	z => 0,	208	z => 0,
		209	w => undef,
		210	h => undef,
192	can_events => 1,	211	can_events => 1,
193	@_	212	@_
194	}, $class;	213	}, $class;
195		214
		215	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		216
196	for (keys %$self) {	217	for (keys %$self) {
197	if (/^connect_(.*)$/) {	218	if (/^on_(.*)$/) {
198	$self->connect ($1 => delete $self->{$_});	219	$self->connect ($1 => delete $self->{$_});
199	}	220	}
200	}	221	}
201		222
202	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	223	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		224	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		225	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		226	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		227	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		228
		229	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		230	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		231
		232	$self->show if $layout->{show};
		233	}
203		234
204	$self	235	$self
205	}	236	}
206		237
207	sub destroy {	238	sub destroy {
…		…
211	%$self = ();	242	%$self = ();
212	}	243	}
213		244
214	sub show {	245	sub show {
215	my ($self) = @_;	246	my ($self) = @_;
		247
216	return if $self->{parent};	248	return if $self->{parent};
217		249
218	$CFClient::UI::ROOT->add ($self);	250	$CFClient::UI::ROOT->add ($self);
219	}	251	}
220		252
221	sub show_centered {	253	sub set_visible {
222	my ($self) = @_;	254	my ($self) = @_;
		255
223	return if $self->{parent};	256	return if $self->{visible};
224		257
225	$self->show;	258	$self->{root} = $self->{parent}{root};
		259	$self->{visible} = $self->{parent}{visible} + 1;
226		260
227	$CFClient::UI::ROOT->on_post_alloc (	261	$self->emit (visibility_change => 1);
228	"centered $self" => sub {
229	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);
230	},
231	);
232	}
233		262
234	sub hide {	263	$self->realloc if !exists $self->{req_w};
		264
		265	$_->set_visible for $self->children;
		266	}
		267
		268	sub set_invisible {
235	my ($self) = @_;	269	my ($self) = @_;
		270
		271	return unless $self->{visible};
		272
		273	$_->set_invisible for $self->children;
		274
		275	delete $self->{root};
		276	delete $self->{visible};
236		277
237	undef $GRAB if $GRAB == $self;	278	undef $GRAB if $GRAB == $self;
238	undef $HOVER if $HOVER == $self;	279	undef $HOVER if $HOVER == $self;
239		280
		281	CFClient::UI::check_tooltip
		282	if $TOOLTIP->{owner} == $self;
		283
		284	$self->focus_out;
		285
		286	$self->emit (visibility_change => 0);
		287	}
		288
		289	sub set_visibility {
		290	my ($self, $visible) = @_;
		291
		292	return if $self->{visible} == $visible;
		293
		294	$visible ? $self->hide
		295	: $self->show;
		296	}
		297
		298	sub toggle_visibility {
		299	my ($self) = @_;
		300
		301	$self->{visible}
		302	? $self->hide
		303	: $self->show;
		304	}
		305
		306	sub hide {
		307	my ($self) = @_;
		308
		309	$self->set_invisible;
		310
240	$self->{parent}->remove ($self)	311	$self->{parent}->remove ($self)
241	if $self->{parent};	312	if $self->{parent};
242	}	313	}
243		314
244	sub move {	315	sub move_abs {
245	my ($self, $x, $y, $z) = @_;	316	my ($self, $x, $y, $z) = @_;
246		317
247	$self->{x} = int $x;	318	$self->{x} = List::Util::max 0, int $x;
248	$self->{y} = int $y;	319	$self->{y} = List::Util::max 0, int $y;
249	$self->{z} = $z if defined $z;	320	$self->{z} = $z if defined $z;
250		321
251	$self->update;	322	$self->update;
252	}	323	}
253		324
254	sub set_size {	325	sub set_size {
255	my ($self, $w, $h) = @_;	326	my ($self, $w, $h) = @_;
256		327
257	$self->{user_w} = $w;	328	$self->{force_w} = $w;
258	$self->{user_h} = $h;	329	$self->{force_h} = $h;
259		330
260	$self->check_size;	331	$self->realloc;
261	}	332	}
262		333
263	sub size_request {	334	sub size_request {
264	require Carp;	335	require Carp;
265	Carp::confess "size_request is abstract";	336	Carp::confess "size_request is abstract";
…		…
267		338
268	sub configure {	339	sub configure {
269	my ($self, $x, $y, $w, $h) = @_;	340	my ($self, $x, $y, $w, $h) = @_;
270		341
271	if ($self->{aspect}) {	342	if ($self->{aspect}) {
		343	my ($ow, $oh) = ($w, $h);
		344
272	my $w2 = List::Util::min $w, int $h * $self->{aspect};	345	$w = List::Util::min $w, int $h * $self->{aspect};
273	my $h2 = List::Util::min $h, int $w / $self->{aspect};	346	$h = List::Util::min $h, int $w / $self->{aspect};
274		347
275	# use alignment to adjust x, y	348	# use alignment to adjust x, y
276		349
277	$x += int +($w - $w2) * 0.5;	350	$x += int 0.5 * ($ow - $w);
278	$y += int +($h - $h2) * 0.5;	351	$y += int 0.5 * ($oh - $h);
279
280	($w, $h) = ($w2, $h2);
281	}	352	}
282		353
283	if ($self->{x} != $x || $self->{y} != $y) {	354	if ($self->{x} ne $x || $self->{y} ne $y) {
284	$self->{x} = $x;	355	$self->{x} = $x;
285	$self->{y} = $y;	356	$self->{y} = $y;
286	$self->update;	357	$self->update;
287	}	358	}
288		359
289	if ($self->{w} != $w || $self->{h} != $h) {	360	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
290	$CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h];	361	return unless $self->{visible};
		362
		363	$self->{alloc_w} = $w;
		364	$self->{alloc_h} = $h;
		365
		366	$self->{root}{size_alloc}{$self+0} = $self;
291	}	367	}
292	}	368	}
293		369
294	sub size_allocate {	370	sub size_allocate {
295	# nothing to be done	371	# nothing to be done
296	}	372	}
297		373
298	sub reconfigure {
299	my ($self) = @_;
300
301	$self->check_size (1);
302	$self->update;
303	}
304
305	sub children {	374	sub children {
306	}	375	}
307		376
308	sub set_max_size {	377	sub set_max_size {
309	my ($self, $w, $h) = @_;	378	my ($self, $w, $h) = @_;
…		…
312	delete $self->{max_h}; $self->{max_h} = $h if $h;	381	delete $self->{max_h}; $self->{max_h} = $h if $h;
313	}	382	}
314		383
315	sub set_tooltip {	384	sub set_tooltip {
316	my ($self, $tooltip) = @_;	385	my ($self, $tooltip) = @_;
		386
		387	$tooltip =~ s/^\s+//;
		388	$tooltip =~ s/\s+$//;
		389
		390	return if $self->{tooltip} eq $tooltip;
317		391
318	$self->{tooltip} = $tooltip;	392	$self->{tooltip} = $tooltip;
319		393
320	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	394	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
321	delete $CFClient::UI::TOOLTIP->{owner};	395	delete $CFClient::UI::TOOLTIP->{owner};
…		…
343	return if $FOCUS == $self;	417	return if $FOCUS == $self;
344	return unless $self->{can_focus};	418	return unless $self->{can_focus};
345		419
346	my $focus = $FOCUS; $FOCUS = $self;	420	my $focus = $FOCUS; $FOCUS = $self;
347		421
348	$self->emit (focus_in => $focus);	422	$self->_emit (focus_in => $focus);
349		423
350	$focus->update if $focus;	424	$focus->update if $focus;
351	$FOCUS->update;	425	$FOCUS->update;
352	}	426	}
353		427
…		…
356		430
357	return unless $FOCUS == $self;	431	return unless $FOCUS == $self;
358		432
359	my $focus = $FOCUS; undef $FOCUS;	433	my $focus = $FOCUS; undef $FOCUS;
360		434
361	$self->emit (focus_out => $focus);	435	$self->_emit (focus_out => $focus);
362		436
363	$focus->update if $focus; #?	437	$focus->update if $focus; #?
		438
		439	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		440	unless $FOCUS;
364	}	441	}
365		442
366	sub mouse_motion { }	443	sub mouse_motion { }
367	sub button_up { }	444	sub button_up { }
368	sub key_down { }	445	sub key_down { }
369	sub key_up { }	446	sub key_up { }
370		447
371	sub button_down {	448	sub button_down {
372	my ($self, $ev, $x, $y) = @_;	449	my ($self, $ev, $x, $y) = @_;
373		450
374	$self->focus_in;	451	$self->focus_in;
…		…
377	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	454	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
378	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	455	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
379	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	456	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
380	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	457	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
381	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	458	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }
		459
		460	sub find_widget {
		461	my ($self, $x, $y) = @_;
		462
		463	return () unless $self->{can_events};
		464
		465	return $self
		466	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		467	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		468
		469	()
		470	}
		471
		472	sub set_parent {
		473	my ($self, $parent) = @_;
		474
		475	Scalar::Util::weaken ($self->{parent} = $parent);
		476	$self->set_visible if $parent->{visible};
		477	}
		478
		479	sub connect {
		480	my ($self, $signal, $cb) = @_;
		481
		482	push @{ $self->{signal_cb}{$signal} }, $cb;
		483	}
		484
		485	sub _emit {
		486	my ($self, $signal, @args) = @_;
		487
		488	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		489	}
		490
		491	sub emit {
		492	my ($self, $signal, @args) = @_;
		493
		494	$self->_emit ($signal, @args)
		495	|| $self->$signal (@args);
		496	}
		497
		498	sub visibility_change {
		499	#my ($self, $visible) = @_;
		500	}
		501
		502	sub realloc {
		503	my ($self) = @_;
		504
		505	if ($self->{visible}) {
		506	return if $self->{root}{realloc}{$self+0};
		507
		508	$self->{root}{realloc}{$self+0} = $self;
		509	$self->{root}->update;
		510	} else {
		511	delete $self->{req_w};
		512	delete $self->{req_h};
		513	}
		514	}
		515
		516	sub update {
		517	my ($self) = @_;
		518
		519	$self->{parent}->update
		520	if $self->{parent};
		521	}
		522
		523	sub reconfigure {
		524	my ($self) = @_;
		525
		526	$self->realloc;
		527	$self->update;
		528	}
382		529
383	sub draw {	530	sub draw {
384	my ($self) = @_;	531	my ($self) = @_;
385		532
386	return unless $self->{h} && $self->{w};	533	return unless $self->{h} && $self->{w};
…		…
403	glVertex $x , $y + $self->{h};	550	glVertex $x , $y + $self->{h};
404	glEnd;	551	glEnd;
405	glDisable GL_BLEND;	552	glDisable GL_BLEND;
406	}	553	}
407		554
408	if ($ENV{PCLIENT_DEBUG}) {	555	if ($ENV{CFPLUS_DEBUG} & 1) {
409	glPushMatrix;	556	glPushMatrix;
410	glColor 1, 1, 0, 1;	557	glColor 1, 1, 0, 1;
411	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	558	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
412	glBegin GL_LINE_LOOP;	559	glBegin GL_LINE_LOOP;
413	glVertex 0 , 0;	560	glVertex 0 , 0;
414	glVertex $self->{w}, 0;	561	glVertex $self->{w} - 1, 0;
415	glVertex $self->{w}, $self->{h};	562	glVertex $self->{w} - 1, $self->{h} - 1;
416	glVertex 0 , $self->{h};	563	glVertex 0 , $self->{h} - 1;
417	glEnd;	564	glEnd;
418	glPopMatrix;	565	glPopMatrix;
419	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	566	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
420	}	567	}
421	}	568	}
422		569
423	sub _draw {	570	sub _draw {
424	my ($self) = @_;	571	my ($self) = @_;
425		572
426	warn "no draw defined for $self\n";	573	warn "no draw defined for $self\n";
427	}
428
429	sub find_widget {
430	my ($self, $x, $y) = @_;
431
432	return () unless $self->{can_events};
433
434	return $self
435	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
436	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
437
438	()
439	}
440
441	sub set_parent {
442	my ($self, $parent) = @_;
443
444	Scalar::Util::weaken ($self->{parent} = $parent);
445
446	# TODO: req_w _does_change after ->reconfigure
447	$self->check_size
448	unless exists $self->{req_w};
449
450	$self->show;
451	}
452
453	sub check_size {
454	my ($self, $forced) = @_;
455
456	$self->{force_alloc} = 1 if $forced;
457	$CFClient::UI::ROOT->{check_size}{$self} = $self;
458	}
459
460	sub update {
461	my ($self) = @_;
462
463	$self->{parent}->update
464	if $self->{parent};
465	}
466
467	sub connect {
468	my ($self, $signal, $cb) = @_;
469
470	push @{ $self->{signal_cb}{$signal} }, $cb;
471	}
472
473	sub emit {
474	my ($self, $signal, @args) = @_;
475
476	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
477	}	574	}
478		575
479	sub DESTROY {	576	sub DESTROY {
480	my ($self) = @_;	577	my ($self) = @_;
481		578
…		…
539	my ($class, %arg) = @_;	636	my ($class, %arg) = @_;
540	$class->SUPER::new (can_events => 0, %arg);	637	$class->SUPER::new (can_events => 0, %arg);
541	}	638	}
542		639
543	sub size_request {	640	sub size_request {
544	(0, 0)	641	my ($self) = @_;
		642
		643	($self->{w} + 0, $self->{h} + 0)
545	}	644	}
546		645
547	sub draw { }	646	sub draw { }
548		647
549	#############################################################################	648	#############################################################################
…		…
578	$self->{children} = [	677	$self->{children} = [
579	sort { $a->{z} <=> $b->{z} }	678	sort { $a->{z} <=> $b->{z} }
580	@{$self->{children}}, @widgets	679	@{$self->{children}}, @widgets
581	];	680	];
582		681
583	$self->check_size (1);	682	$self->realloc;
584	$self->update;
585	}	683	}
586		684
587	sub children {	685	sub children {
588	@{ $_[0]{children} }	686	@{ $_[0]{children} }
589	}	687	}
…		…
594	delete $child->{parent};	692	delete $child->{parent};
595	$child->hide;	693	$child->hide;
596		694
597	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	695	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
598		696
599	$self->check_size;	697	$self->realloc;
600	$self->update;
601	}	698	}
602		699
603	sub clear {	700	sub clear {
604	my ($self) = @_;	701	my ($self) = @_;
605		702
…		…
609	for (@$children) {	706	for (@$children) {
610	delete $_->{parent};	707	delete $_->{parent};
611	$_->hide;	708	$_->hide;
612	}	709	}
613		710
614	$self->check_size;	711	$self->realloc;
615	$self->update;
616	}	712	}
617		713
618	sub find_widget {	714	sub find_widget {
619	my ($self, $x, $y) = @_;	715	my ($self, $x, $y) = @_;
620		716
…		…
744		840
745	package CFClient::UI::ViewPort;	841	package CFClient::UI::ViewPort;
746		842
747	our @ISA = CFClient::UI::Window::;	843	our @ISA = CFClient::UI::Window::;
748		844
		845	sub new {
		846	my $class = shift;
		847
		848	$class->SUPER::new (
		849	scroll_x => 0,
		850	scroll_y => 1,
		851	@_,
		852	)
		853	}
		854
749	sub size_request {	855	sub size_request {
750	my ($self) = @_;	856	my ($self) = @_;
751		857
752	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	858	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
753		859
754	@$self{qw(child_w child_h)}	860	$w = 10 if $self->{scroll_x};
		861	$h = 10 if $self->{scroll_y};
		862
		863	($w, $h)
755	}	864	}
756		865
757	sub size_allocate {	866	sub size_allocate {
758	my ($self, $w, $h) = @_;	867	my ($self, $w, $h) = @_;
759		868
760	my ($cw, $ch) = @$self{qw(child_w child_h)};	869	my $child = $self->child;
761	# $w = $self->{w};	870
		871	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
		872	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
		873
762	$self->child->configure (0, 0, $cw, $ch);	874	$self->child->configure (0, 0, $w, $h);
763	$self->update;	875	$self->update;
764	}	876	}
765		877
766	sub set_offset {	878	sub set_offset {
767	my ($self, $x, $y) = @_;	879	my ($self, $x, $y) = @_;
…		…
818	my $class = shift;	930	my $class = shift;
819		931
820	my $self;	932	my $self;
821		933
822	my $slider = new CFClient::UI::Slider	934	my $slider = new CFClient::UI::Slider
823	vertical => 1,	935	vertical => 1,
824	range => [0, 0, 1, 0.01], # HACK fix	936	range => [0, 0, 1, 0.01], # HACK fix
825	connect_changed => sub {	937	on_changed => sub {
826	$self->{vp}->set_offset (0, $_[1]);	938	$self->{vp}->set_offset (0, $_[1]);
827	},	939	},
828	;	940	;
829		941
830	$self = $class->SUPER::new (	942	$self = $class->SUPER::new (
…		…
836	$self->{vp}->add ($self->{scrolled});	948	$self->{vp}->add ($self->{scrolled});
837	$self->add ($self->{vp});	949	$self->add ($self->{vp});
838	$self->add ($self->{slider});	950	$self->add ($self->{slider});
839		951
840	$self	952	$self
		953	}
		954
		955	sub update {
		956	my ($self) = @_;
		957
		958	$self->SUPER::update;
		959
		960	# todo: overwrite size_allocate of child
		961	my $child = $self->{vp}->child;
		962	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
841	}	963	}
842		964
843	sub size_allocate {	965	sub size_allocate {
844	my ($self, $w, $h) = @_;	966	my ($self, $w, $h) = @_;
845		967
…		…
898		1020
899	our @ISA = CFClient::UI::Bin::;	1021	our @ISA = CFClient::UI::Bin::;
900		1022
901	use CFClient::OpenGL;	1023	use CFClient::OpenGL;
902		1024
903	my @tex =	1025	my $bg =
		1026	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1027	mipmap => 1, wrap => 1;
		1028
		1029	my @border =
904	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
905	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1031	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
906		1032
907	sub new {	1033	sub new {
908	my $class = shift;	1034	my $class = shift;
909
910	# TODO: user_x, user_y, overwrite moveto?
911		1035
912	my $self = $class->SUPER::new (	1036	my $self = $class->SUPER::new (
913	bg => [1, 1, 1, 1],	1037	bg => [1, 1, 1, 1],
914	border_bg => [1, 1, 1, 1],	1038	border_bg => [1, 1, 1, 1],
915	border => 0.6,	1039	border => 0.6,
916	is_toplevel => 1,
917	can_events => 1,	1040	can_events => 1,
		1041	min_w => 16,
		1042	min_h => 16,
918	@_	1043	@_
919	);	1044	);
920		1045
921	$self->{title} &&= new CFClient::UI::Label	1046	$self->{title} &&= new CFClient::UI::Label
922	align => 0,	1047	align => 0,
…		…
975	my ($ev, $x, $y) = @_;	1100	my ($ev, $x, $y) = @_;
976		1101
977	my $dx = $ev->{x} - $ox;	1102	my $dx = $ev->{x} - $ox;
978	my $dy = $ev->{y} - $oy;	1103	my $dy = $ev->{y} - $oy;
979		1104
980	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
981	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1107
		1108	$self->realloc;
982	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
983	$self->check_size;
984	};	1110	};
985		1111
986	} elsif ($lr ^ $td) {	1112	} elsif ($lr ^ $td) {
987	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});
988	my ($bx, $by) = ($self->{x}, $self->{y});	1114	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
990	$self->{motion} = sub {	1116	$self->{motion} = sub {
991	my ($ev, $x, $y) = @_;	1117	my ($ev, $x, $y) = @_;
992		1118
993	($x, $y) = ($ev->{x}, $ev->{y});	1119	($x, $y) = ($ev->{x}, $ev->{y});
994		1120
995	$self->move ($bx + $x - $ox, $by + $y - $oy);	1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
996	$self->update;
997	};	1122	};
998	}	1123	}
999	}	1124	}
1000		1125
1001	sub button_up {	1126	sub button_up {
…		…
1020	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1021		1146
1022	my $border = $self->border;	1147	my $border = $self->border;
1023		1148
1024	glColor @{ $self->{border_bg} };	1149	glColor @{ $self->{border_bg} };
1025	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1150	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1026	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1151	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1027	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1152	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1028	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1153	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1029		1154
1030	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1155	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1031	my $bg = $tex[0];	1156	glColor @{ $self->{bg} };
1032		1157
1033	# TODO: repeat texture not scale	1158	# TODO: repeat texture not scale
		1159	# solve this better(?)
1034	my $rep_x = $cw / $bg->{w};	1160	$bg->{s} = $cw / $bg->{w};
1035	my $rep_y = $ch / $bg->{h};	1161	$bg->{t} = $ch / $bg->{h};
1036
1037	glColor @{ $self->{bg} };
1038
1039	$bg->{s} = $rep_x;
1040	$bg->{t} = $rep_y;
1041	$bg->{wrap_mode} = 1;
1042	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1043	}	1163	}
1044		1164
1045	glDisable GL_TEXTURE_2D;	1165	glDisable GL_TEXTURE_2D;
1046		1166
…		…
1062	sub new {	1182	sub new {
1063	my $class = shift;	1183	my $class = shift;
1064		1184
1065	$class->SUPER::new (	1185	$class->SUPER::new (
1066	col_expand => [],	1186	col_expand => [],
1067	@_	1187	@_,
1068	)	1188	)
		1189	}
		1190
		1191	sub children {
		1192	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1069	}	1193	}
1070		1194
1071	sub add {	1195	sub add {
1072	my ($self, $x, $y, $child) = @_;	1196	my ($self, $x, $y, $child) = @_;
1073		1197
1074	$child->set_parent ($self);	1198	$child->set_parent ($self);
1075	$self->{children}[$y][$x] = $child;	1199	$self->{children}[$y][$x] = $child;
1076		1200
1077	$child->check_size;	1201	$self->realloc;
1078	}	1202	}
1079		1203
1080	sub children {
1081	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1082	}
1083
1084	# TODO: move to container class maybe? send childs a signal on removal?	1204	# TODO: move to container class maybe? send children a signal on removal?
1085	sub clear {	1205	sub clear {
1086	my ($self) = @_;	1206	my ($self) = @_;
1087		1207
1088	my @children = $self->children;	1208	my @children = $self->children;
1089	delete $self->{children};	1209	delete $self->{children};
…		…
1091	for (@children) {	1211	for (@children) {
1092	delete $_->{parent};	1212	delete $_->{parent};
1093	$_->hide;	1213	$_->hide;
1094	}	1214	}
1095		1215
1096	$self->update;	1216	$self->realloc;
1097	}	1217	}
1098		1218
1099	sub get_wh {	1219	sub get_wh {
1100	my ($self) = @_;	1220	my ($self) = @_;
1101		1221
…		…
1132	sub size_allocate {	1252	sub size_allocate {
1133	my ($self, $w, $h) = @_;	1253	my ($self, $w, $h) = @_;
1134		1254
1135	my ($ws, $hs) = $self->get_wh;	1255	my ($ws, $hs) = $self->get_wh;
1136		1256
1137	my $req_w = sum @$ws;	1257	my $req_w = (sum @$ws) || 1;
1138	my $req_h = sum @$hs;	1258	my $req_h = (sum @$hs) || 1;
1139		1259
1140	# TODO: nicer code && do row_expand	1260	# TODO: nicer code && do row_expand
1141	my @col_expand = @{$self->{col_expand}};	1261	my @col_expand = @{$self->{col_expand}};
1142	@col_expand = (1) x @$ws unless @col_expand;	1262	@col_expand = (1) x @$ws unless @col_expand;
1143	my $col_expand = (sum @col_expand) || 1;	1263	my $col_expand = (sum @col_expand) || 1;
…		…
1197	}	1317	}
1198	}	1318	}
1199		1319
1200	#############################################################################	1320	#############################################################################
1201		1321
1202	package CFClient::UI::HBox;	1322	package CFClient::UI::Box;
1203
1204	# TODO: wrap into common Box base class
1205		1323
1206	our @ISA = CFClient::UI::Container::;	1324	our @ISA = CFClient::UI::Container::;
1207		1325
1208	sub size_request {	1326	sub size_request {
1209	my ($self) = @_;	1327	my ($self) = @_;
1210		1328
1211	my @alloc = map [$_->size_request], @{$self->{children}};	1329	$self->{vertical}
1212		1330	? (
1213	(	1331	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1214	(List::Util::sum map $_->[0], @alloc),	1332	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1215	(List::Util::max map $_->[1], @alloc),	1333	)
1216	)	1334	: (
		1335	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1336	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1337	)
1217	}	1338	}
1218		1339
1219	sub size_allocate {	1340	sub size_allocate {
1220	my ($self, $w, $h) = @_;	1341	my ($self, $w, $h) = @_;
1221		1342
1222	($h, $w) = ($w, $h);	1343	my $space = $self->{vertical} ? $h : $w;
1223
1224	my $children = $self->{children};	1344	my $children = $self->{children};
1225		1345
1226	my @h = map $_->{req_w}, @$children;	1346	my @req;
1227		1347
1228	my $req_h = List::Util::sum @h;	1348	if ($self->{homogeneous}) {
1229		1349	@req = ($space / (@$children || 1)) x @$children;
1230	if ($req_h > $h) {
1231	# ah well, not enough space
1232	$_ *= $h / $req_h for @h;
1233	} else {	1350	} else {
		1351	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
		1352	my $req = List::Util::sum @req;
		1353
		1354	if ($req > $space) {
		1355	# ah well, not enough space
		1356	$_ *= $space / $req for @req;
		1357	} else {
1234	my $exp = List::Util::sum map $_->{expand}, @$children;	1358	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1235	$exp ||= 1;
1236		1359
		1360	$space = ($space - $req) / $expand; # remaining space to give away
		1361
		1362	$req[$_] += $space * $children->[$_]{expand}
1237	for (0 .. $#$children) {	1363	for 0 .. $#$children;
1238	my $child = $children->[$_];
1239
1240	my $alloc_h = $h[$_];
1241	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1242	$h[$_] = $alloc_h;
1243	}	1364	}
1244	}	1365	}
1245		1366
1246	CFClient::UI::harmonize \@h;	1367	CFClient::UI::harmonize \@req;
1247		1368
1248	my $y = 0;	1369	my $pos = 0;
1249	for (0 .. $#$children) {	1370	for (0 .. $#$children) {
1250	my $child = $children->[$_];
1251	my $h = $h[$_];	1371	my $alloc = $req[$_];
1252	$child->configure ($y, 0, $h, $w);	1372	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1253		1373
1254	$y += $h;	1374	$pos += $alloc;
1255	}	1375	}
1256		1376
1257	1	1377	1
1258	}	1378	}
1259		1379
1260	#############################################################################	1380	#############################################################################
1261		1381
		1382	package CFClient::UI::HBox;
		1383
		1384	our @ISA = CFClient::UI::Box::;
		1385
		1386	sub new {
		1387	my $class = shift;
		1388
		1389	$class->SUPER::new (
		1390	vertical => 0,
		1391	@_,
		1392	)
		1393	}
		1394
		1395	#############################################################################
		1396
1262	package CFClient::UI::VBox;	1397	package CFClient::UI::VBox;
1263		1398
1264	# TODO: wrap into common Box base class
1265
1266	our @ISA = CFClient::UI::Container::;	1399	our @ISA = CFClient::UI::Box::;
1267		1400
1268	sub size_request {	1401	sub new {
1269	my ($self) = @_;	1402	my $class = shift;
1270		1403
1271	my @alloc = map [$_->size_request], @{$self->{children}};	1404	$class->SUPER::new (
1272		1405	vertical => 1,
1273	(	1406	@_,
1274	(List::Util::max map $_->[0], @alloc),
1275	(List::Util::sum map $_->[1], @alloc),
1276	)	1407	)
1277	}
1278
1279	sub size_allocate {
1280	my ($self, $w, $h) = @_;
1281
1282	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1283
1284	my $children = $self->{children};
1285
1286	my @h = map $_->{req_h}, @$children;
1287
1288	my $req_h = List::Util::sum @h;
1289
1290	if ($req_h > $h) {
1291	# ah well, not enough space
1292	$_ *= $h / $req_h for @h;
1293	} else {
1294	my $exp = List::Util::sum map $_->{expand}, @$children;
1295	$exp ||= 1;
1296
1297	for (0 .. $#$children) {
1298	my $child = $children->[$_];
1299
1300	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1301	}
1302	}
1303
1304	CFClient::UI::harmonize \@h;
1305
1306	my $y = 0;
1307	for (0 .. $#$children) {
1308	my $child = $children->[$_];
1309	my $h = $h[$_];
1310	$child->configure (0, $y, $w, $h);
1311
1312	$y += $h;
1313	}
1314
1315	1
1316	}	1408	}
1317		1409
1318	#############################################################################	1410	#############################################################################
1319		1411
1320	package CFClient::UI::Label;	1412	package CFClient::UI::Label;
…		…
1337	ellipsise => 3, # end	1429	ellipsise => 3, # end
1338	layout => (new CFClient::Layout),	1430	layout => (new CFClient::Layout),
1339	fontsize => 1,	1431	fontsize => 1,
1340	align => -1,	1432	align => -1,
1341	valign => -1,	1433	valign => -1,
1342	padding => 2,	1434	padding_x => 2,
		1435	padding_y => 2,
1343	can_events => 0,	1436	can_events => 0,
1344	%arg	1437	%arg
1345	);	1438	);
1346		1439
1347	if (exists $self->{template}) {	1440	if (exists $self->{template}) {
…		…
1383	$self->{text} = "T$text";	1476	$self->{text} = "T$text";
1384		1477
1385	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1386	$self->{layout}->set_text ($text);	1479	$self->{layout}->set_text ($text);
1387		1480
		1481	$self->realloc;
1388	$self->update;	1482	$self->update;
1389	$self->check_size;
1390	}	1483	}
1391		1484
1392	sub set_markup {	1485	sub set_markup {
1393	my ($self, $markup) = @_;	1486	my ($self, $markup) = @_;
1394		1487
…		…
1398	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1491	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1399		1492
1400	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1493	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1401	$self->{layout}->set_markup ($markup);	1494	$self->{layout}->set_markup ($markup);
1402		1495
		1496	$self->realloc;
1403	$self->update;	1497	$self->update;
1404	$self->check_size;
1405	}	1498	}
1406		1499
1407	sub size_request {	1500	sub size_request {
1408	my ($self) = @_;	1501	my ($self) = @_;
1409		1502
…		…
1423		1516
1424	$w = List::Util::max $w, $w2;	1517	$w = List::Util::max $w, $w2;
1425	$h = List::Util::max $h, $h2;	1518	$h = List::Util::max $h, $h2;
1426	}	1519	}
1427		1520
1428	(	1521	($w, $h)
1429	$w + $self->{padding} * 2,
1430	$h + $self->{padding} * 2,
1431	)
1432	}	1522	}
1433		1523
1434	sub size_allocate {	1524	sub size_allocate {
1435	my ($self, $w, $h) = @_;	1525	my ($self, $w, $h) = @_;
1436		1526
1437	delete $self->{texture};	1527	delete $self->{texture}
		1528	;#d#
1438	}	1529	}
1439		1530
1440	sub set_fontsize {	1531	sub set_fontsize {
1441	my ($self, $fontsize) = @_;	1532	my ($self, $fontsize) = @_;
1442		1533
1443	$self->{fontsize} = $fontsize;	1534	$self->{fontsize} = $fontsize;
1444	delete $self->{texture};	1535	delete $self->{texture};
1445		1536
1446	$self->update;	1537	$self->realloc;
1447	$self->check_size;
1448	}	1538	}
1449		1539
1450	sub _draw {	1540	sub _draw {
1451	my ($self) = @_;	1541	my ($self) = @_;
1452		1542
…		…
1460	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1550	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1461	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1551	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1462		1552
1463	my $tex = new_from_layout CFClient::Texture $self->{layout};	1553	my $tex = new_from_layout CFClient::Texture $self->{layout};
1464		1554
1465	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1555	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1466	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1556	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1467	: ($self->{w} - $tex->{w}) * 0.5);	1557	: ($self->{w} - $tex->{w}) * 0.5);
1468		1558
1469	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1559	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1470	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1560	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1471	: ($self->{h} - $tex->{h}) * 0.5);	1561	: ($self->{h} - $tex->{h}) * 0.5);
1472		1562
1473	$tex	1563	$tex
1474	};	1564	};
1475		1565
…		…
1524	$self->{text} = $text;	1614	$self->{text} = $text;
1525		1615
1526	$text =~ s/./*/g if $self->{hidden};	1616	$text =~ s/./*/g if $self->{hidden};
1527	$self->{layout}->set_text ("$text ");	1617	$self->{layout}->set_text ("$text ");
1528		1618
1529	$self->emit (changed => $self->{text});	1619	$self->_emit (changed => $self->{text});
1530	}	1620	}
1531		1621
1532	sub set_text {	1622	sub set_text {
1533	my ($self, $text) = @_;	1623	my ($self, $text) = @_;
1534		1624
1535	$self->{cursor} = length $text;	1625	$self->{cursor} = length $text;
1536	$self->_set_text ($text);	1626	$self->_set_text ($text);
1537	$self->update;	1627
1538	$self->check_size;	1628	$self->realloc;
1539	}	1629	}
1540		1630
1541	sub get_text {	1631	sub get_text {
1542	$_[0]{text}	1632	$_[0]{text}
1543	}	1633	}
…		…
1546	my ($self) = @_;	1636	my ($self) = @_;
1547		1637
1548	my ($w, $h) = $self->SUPER::size_request;	1638	my ($w, $h) = $self->SUPER::size_request;
1549		1639
1550	($w + 1, $h) # add 1 for cursor	1640	($w + 1, $h) # add 1 for cursor
1551	}
1552
1553	sub size_allocate {
1554	my ($self, $w, $h) = @_;
1555
1556	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1557	}	1641	}
1558		1642
1559	sub key_down {	1643	sub key_down {
1560	my ($self, $ev) = @_;	1644	my ($self, $ev) = @_;
1561		1645
…		…
1576	} elsif ($sym == CFClient::SDLK_HOME) {	1660	} elsif ($sym == CFClient::SDLK_HOME) {
1577	$self->{cursor} = 0;	1661	$self->{cursor} = 0;
1578	} elsif ($sym == CFClient::SDLK_END) {	1662	} elsif ($sym == CFClient::SDLK_END) {
1579	$self->{cursor} = length $text;	1663	$self->{cursor} = length $text;
1580	} elsif ($uni == 27) {	1664	} elsif ($uni == 27) {
1581	$self->emit ('escape');	1665	$self->_emit ('escape');
1582	} elsif ($uni) {	1666	} elsif ($uni) {
1583	substr $text, $self->{cursor}++, 0, chr $uni;	1667	substr $text, $self->{cursor}++, 0, chr $uni;
1584	}	1668	}
1585		1669
1586	$self->_set_text ($text);	1670	$self->_set_text ($text);
1587	$self->update;	1671
1588	$self->check_size;	1672	$self->realloc;
1589	}	1673	}
1590		1674
1591	sub focus_in {	1675	sub focus_in {
1592	my ($self) = @_;	1676	my ($self) = @_;
1593		1677
…		…
1673	if ($sym == 13) {	1757	if ($sym == 13) {
1674	unshift @{$self->{history}},	1758	unshift @{$self->{history}},
1675	my $txt = $self->get_text;	1759	my $txt = $self->get_text;
1676	$self->{history_pointer} = -1;	1760	$self->{history_pointer} = -1;
1677	$self->{history_saveback} = '';	1761	$self->{history_saveback} = '';
1678	$self->emit (activate => $txt);	1762	$self->_emit (activate => $txt);
1679	$self->update;	1763	$self->update;
1680		1764
1681	} elsif ($sym == CFClient::SDLK_UP) {	1765	} elsif ($sym == CFClient::SDLK_UP) {
1682	if ($self->{history_pointer} < 0) {	1766	if ($self->{history_pointer} < 0) {
1683	$self->{history_saveback} = $self->get_text;	1767	$self->{history_saveback} = $self->get_text;
…		…
1720		1804
1721	sub new {	1805	sub new {
1722	my $class = shift;	1806	my $class = shift;
1723		1807
1724	$class->SUPER::new (	1808	$class->SUPER::new (
1725	padding => 4,	1809	padding_x => 4,
		1810	padding_y => 4,
1726	fg => [1, 1, 1],	1811	fg => [1, 1, 1],
1727	active_fg => [0, 0, 1],	1812	active_fg => [0, 0, 1],
1728	can_hover => 1,	1813	can_hover => 1,
1729	align => 0,	1814	align => 0,
1730	valign => 0,	1815	valign => 0,
1731	can_events => 1,	1816	can_events => 1,
1732	@_	1817	@_
1733	)	1818	)
1734	}	1819	}
1735		1820
		1821	sub activate { }
		1822
1736	sub button_up {	1823	sub button_up {
1737	my ($self, $ev, $x, $y) = @_;	1824	my ($self, $ev, $x, $y) = @_;
1738		1825
		1826	$self->emit ("activate")
1739	if ($x >= 0 && $x < $self->{w}	1827	if $x >= 0 && $x < $self->{w}
1740	&& $y >= 0 && $y < $self->{h}) {	1828	&& $y >= 0 && $y < $self->{h};
1741	$self->emit ("activate");
1742	}
1743	}	1829	}
1744		1830
1745	sub _draw {	1831	sub _draw {
1746	my ($self) = @_;	1832	my ($self) = @_;
1747		1833
…		…
1776		1862
1777	sub new {	1863	sub new {
1778	my $class = shift;	1864	my $class = shift;
1779		1865
1780	$class->SUPER::new (	1866	$class->SUPER::new (
1781	padding => 2,	1867	padding_x => 2,
		1868	padding_y => 2,
1782	fg => [1, 1, 1],	1869	fg => [1, 1, 1],
1783	active_fg => [1, 1, 0],	1870	active_fg => [1, 1, 0],
1784	bg => [0, 0, 0, 0.2],	1871	bg => [0, 0, 0, 0.2],
1785	active_bg => [1, 1, 1, 0.5],	1872	active_bg => [1, 1, 1, 0.5],
1786	state => 0,	1873	state => 0,
…		…
1790	}	1877	}
1791		1878
1792	sub size_request {	1879	sub size_request {
1793	my ($self) = @_;	1880	my ($self) = @_;
1794		1881
1795	($self->{padding} * 2 + 6) x 2	1882	(6) x 2
1796	}	1883	}
1797		1884
1798	sub button_down {	1885	sub button_down {
1799	my ($self, $ev, $x, $y) = @_;	1886	my ($self, $ev, $x, $y) = @_;
1800		1887
1801	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1888	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1802	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1889	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1803	$self->{state} = !$self->{state};	1890	$self->{state} = !$self->{state};
1804	$self->emit (changed => $self->{state});	1891	$self->_emit (changed => $self->{state});
1805	}	1892	}
1806	}	1893	}
1807		1894
1808	sub _draw {	1895	sub _draw {
1809	my ($self) = @_;	1896	my ($self) = @_;
1810		1897
1811	$self->SUPER::_draw;	1898	$self->SUPER::_draw;
1812		1899
1813	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1900	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1814		1901
1815	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1902	my ($w, $h) = @$self{qw(w h)};
		1903
		1904	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1816		1905
1817	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1906	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1818		1907
1819	my $tex = $self->{state} ? $tex[1] : $tex[0];	1908	my $tex = $self->{state} ? $tex[1] : $tex[0];
1820		1909
…		…
2085	fg => [1, 1, 1],	2174	fg => [1, 1, 1],
2086	active_fg => [0, 0, 0],	2175	active_fg => [0, 0, 0],
2087	bg => [0, 0, 0, 0.2],	2176	bg => [0, 0, 0, 0.2],
2088	active_bg => [1, 1, 1, 0.5],	2177	active_bg => [1, 1, 1, 0.5],
2089	range => [0, 0, 100, 10, 0],	2178	range => [0, 0, 100, 10, 0],
2090	req_w => $::WIDTH / 80,	2179	min_w => $::WIDTH / 80,
2091	req_h => $::WIDTH / 80,	2180	min_h => $::WIDTH / 80,
2092	vertical => 0,	2181	vertical => 0,
2093	can_hover => 1,	2182	can_hover => 1,
2094	inner_pad => 0.02,	2183	inner_pad => 0.02,
2095	@_	2184	@_
2096	);	2185	);
…		…
2099	$self->update;	2188	$self->update;
2100		2189
2101	$self	2190	$self
2102	}	2191	}
2103		2192
		2193	sub changed { }
		2194
2104	sub set_range {	2195	sub set_range {
2105	my ($self, $range) = @_;	2196	my ($self, $range) = @_;
2106		2197
2107	$self->{range} = $range;	2198	($range, $self->{range}) = ($self->{range}, $range);
2108		2199
2109	$self->update;	2200	$self->update
		2201	if "@$range" ne "@{$self->{range}}";
2110	}	2202	}
2111		2203
2112	sub set_value {	2204	sub set_value {
2113	my ($self, $value) = @_;	2205	my ($self, $value) = @_;
2114		2206
…		…
2125	if $unit;	2217	if $unit;
2126		2218
2127	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2219	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2128		2220
2129	if ($value != $old_value) {	2221	if ($value != $old_value) {
2130	$self->emit (changed => $value);	2222	$self->_emit (changed => $value);
2131	$self->update;	2223	$self->update;
2132	}	2224	}
2133	}	2225	}
2134		2226
2135	sub size_request {	2227	sub size_request {
2136	my ($self) = @_;	2228	my ($self) = @_;
2137		2229
2138	my $w = $self->{req_w};	2230	($self->{req_w}, $self->{req_h})
2139	my $h = $self->{req_h};
2140
2141	$self->{vertical} ? ($h, $w) : ($w, $h)
2142	}	2231	}
2143		2232
2144	sub button_down {	2233	sub button_down {
2145	my ($self, $ev, $x, $y) = @_;	2234	my ($self, $ev, $x, $y) = @_;
2146		2235
…		…
2497		2586
2498	sub new {	2587	sub new {
2499	my $class = shift;	2588	my $class = shift;
2500		2589
2501	my $self = $class->SUPER::new (	2590	my $self = $class->SUPER::new (
2502	state => 0,	2591	state => 0,
2503	connect_activate => \&toggle_flopper,	2592	on_activate => \&toggle_flopper,
2504	@_	2593	@_
2505	);	2594	);
2506		2595
2507	if ($self->{state}) {
2508	$self->{state} = 0;
2509	$self->toggle_flopper;
2510	}
2511
2512	$self	2596	$self
2513	}	2597	}
2514		2598
2515	sub toggle_flopper {	2599	sub toggle_flopper {
2516	my ($self) = @_;	2600	my ($self) = @_;
2517		2601
2518	# TODO: use animation	2602	$self->{other}->toggle_visibility;
2519	if ($self->{state} = !$self->{state}) {
2520	$CFClient::UI::ROOT->add ($self->{other});
2521	$self->{other}->move ($self->coord2global (0, $self->{h}));
2522	$self->emit ("open");
2523	} else {
2524	$CFClient::UI::ROOT->remove ($self->{other});
2525	$self->emit ("close");
2526	}
2527
2528	$self->emit (changed => $self->{state});
2529	}	2603	}
2530		2604
2531	#############################################################################	2605	#############################################################################
2532		2606
2533	package CFClient::UI::Tooltip;	2607	package CFClient::UI::Tooltip;
…		…
2546	}	2620	}
2547		2621
2548	sub set_tooltip_from {	2622	sub set_tooltip_from {
2549	my ($self, $widget) = @_;	2623	my ($self, $widget) = @_;
2550		2624
		2625	my $tooltip = $widget->{tooltip};
		2626
		2627	if ($ENV{CFPLUS_DEBUG} & 2) {
		2628	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2629	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2630	. "req $widget->{req_w} $widget->{req_h}\n"
		2631	. "visible $widget->{visible}";
		2632	}
		2633
2551	$self->add (new CFClient::UI::Label	2634	$self->add (new CFClient::UI::Label
2552	markup => $widget->{tooltip},	2635	markup => $tooltip,
2553	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2636	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2554	fontsize => 0.8,	2637	fontsize => 0.8,
2555	fg => [0, 0, 0, 1],	2638	fg => [0, 0, 0, 1],
2556	ellipsise => 0,	2639	ellipsise => 0,
2557	font => ($widget->{tooltip_font} || $::FONT_PROP),	2640	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2568		2651
2569	sub size_allocate {	2652	sub size_allocate {
2570	my ($self, $w, $h) = @_;	2653	my ($self, $w, $h) = @_;
2571		2654
2572	$self->SUPER::size_allocate ($w - 4, $h - 4);	2655	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2656	}
		2657
		2658	sub visibility_change {
		2659	my ($self, $visible) = @_;
		2660
		2661	return unless $visible;
		2662
		2663	$self->{root}->on_post_alloc ("move_$self" => sub {
		2664	my $widget = $self->{owner}
		2665	or return;
		2666
		2667	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2668
		2669	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2670	if $x + $self->{w} > $::WIDTH;
		2671
		2672	$self->move_abs ($x, $y);
		2673	});
2573	}	2674	}
2574		2675
2575	sub _draw {	2676	sub _draw {
2576	my ($self) = @_;	2677	my ($self) = @_;
2577		2678
…		…
2594	glVertex $w, $h;	2695	glVertex $w, $h;
2595	glVertex $w, 0;	2696	glVertex $w, 0;
2596	glEnd;	2697	glEnd;
2597		2698
2598	glTranslate 2 - 0.375, 2 - 0.375;	2699	glTranslate 2 - 0.375, 2 - 0.375;
		2700
2599	$self->SUPER::_draw;	2701	$self->SUPER::_draw;
2600	}	2702	}
2601		2703
2602	#############################################################################	2704	#############################################################################
2603		2705
…		…
2609		2711
2610	sub new {	2712	sub new {
2611	my $class = shift;	2713	my $class = shift;
2612		2714
2613	my $self = $class->SUPER::new (	2715	my $self = $class->SUPER::new (
2614	aspect => 1,	2716	aspect => 1,
		2717	can_events => 0,
2615	@_,	2718	@_,
2616	);	2719	);
2617		2720
2618	if ($self->{anim} && $self->{animspeed}) {	2721	if ($self->{anim} && $self->{animspeed}) {
2619	Scalar::Util::weaken (my $widget = $self);	2722	Scalar::Util::weaken (my $widget = $self);
…		…
2678	$self->SUPER::DESTROY;	2781	$self->SUPER::DESTROY;
2679	}	2782	}
2680		2783
2681	#############################################################################	2784	#############################################################################
2682		2785
2683	package CFClient::UI::InventoryItem;	2786	package CFClient::UI::Inventory;
2684		2787
2685	our @ISA = CFClient::UI::HBox::;	2788	our @ISA = CFClient::UI::ScrolledWindow::;
2686
2687	sub _item_to_desc {
2688	my ($item) = @_;
2689
2690	my $desc =
2691	$item->{nrof} < 2
2692	? $item->{name}
2693	: "$item->{nrof} × $item->{name_pl}";
2694
2695	$item->{flags} & Crossfire::Protocol::F_OPEN
2696	and $desc .= " (open)";
2697	$item->{flags} & Crossfire::Protocol::F_APPLIED
2698	and $desc .= " (applied)";
2699	$item->{flags} & Crossfire::Protocol::F_UNPAID
2700	and $desc .= " (unpaid)";
2701	$item->{flags} & Crossfire::Protocol::F_MAGIC
2702	and $desc .= " (magic)";
2703	$item->{flags} & Crossfire::Protocol::F_CURSED
2704	and $desc .= " (cursed)";
2705	$item->{flags} & Crossfire::Protocol::F_DAMNED
2706	and $desc .= " (damned)";
2707	$item->{flags} & Crossfire::Protocol::F_LOCKED
2708	and $desc .= " *";
2709
2710	$desc
2711	}
2712		2789
2713	sub new {	2790	sub new {
2714	my $class = shift;	2791	my $class = shift;
2715		2792
2716	my %args = @_;
2717
2718	my $item = delete $args{item};
2719
2720	my $desc = _item_to_desc ($item);
2721
2722	my $self = $class->SUPER::new (	2793	my $self = $class->SUPER::new (
2723	can_hover => 1,
2724	can_events => 1,
2725	tooltip => ((CFClient::UI::Label::escape $desc)
2726	. "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2727	connect_button_down => sub {
2728	my ($self, $ev, $x, $y) = @_;
2729
2730	# todo: maybe put examine on 1? but should just be a tooltip :(
2731	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2732	my $targ = $::CONN->{player}{tag};
2733
2734	if ($item->{container} == $::CONN->{player}{tag}) {
2735	$targ = $main::OPENCONT;
2736	}
2737
2738	$::CONN->send ("move $targ $item->{tag} 0");
2739	} elsif ($ev->{button} == 1) {
2740	$::CONN->send ("examine $item->{tag}");
2741	} elsif ($ev->{button} == 2) {
2742	$::CONN->send ("apply $item->{tag}");
2743	} elsif ($ev->{button} == 3) {
2744	my @menu_items = (
2745	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2746	["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2747	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2748	(
2749	$item->{flags} & Crossfire::Protocol::F_LOCKED
2750	? (
2751	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2752	)
2753	: (
2754	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2755	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2756	)
2757	),
2758	);
2759
2760	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2761	}
2762
2763	1
2764	},
2765	%args
2766	);
2767
2768
2769	$self->add (new CFClient::UI::Face
2770	can_events => 0,
2771	face => $item->{face},
2772	anim => $item->{anim},
2773	animspeed => $item->{animspeed},
2774	);
2775
2776	$self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2777
2778	$self->{item} = $item;
2779
2780	$self->update_item;
2781
2782	$self
2783	}
2784
2785	sub update_item {
2786	my ($self) = @_;
2787
2788	my $desc = _item_to_desc ($self->{item});
2789
2790	$self->{name_lbl}->set_text ($desc);
2791	}
2792
2793	#############################################################################
2794
2795	package CFClient::UI::Inventory;
2796
2797	our @ISA = CFClient::UI::ScrolledWindow::;
2798
2799	sub new {
2800	my $class = shift;
2801
2802	my $self = $class->SUPER::new (
2803	scrolled => (new CFClient::UI::Table),	2794	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2804	@_,	2795	@_,
2805	);	2796	);
2806		2797
2807	$self	2798	$self
2808	}	2799	}
…		…
2818	or ($a->{name} cmp $b->{name})	2809	or ($a->{name} cmp $b->{name})
2819	} @$items;	2810	} @$items;
2820		2811
2821	$self->{real_items} = \@items;	2812	$self->{real_items} = \@items;
2822		2813
		2814	my $row = 0;
2823	for my $item (@items) {	2815	for my $item (@items) {
2824	$item->{item} = $item;	2816	CFClient::Item::update_widgets $item;
2825	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2826	$item->update_item ();
2827	}
2828		2817
2829	my $i = 0;	2818	$self->{scrolled}->add (0, $row, $item->{face_widget});
2830	for (@items) {	2819	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2831	$self->{scrolled}->add (0, $i, $_);	2820	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2832	my $nrof = $_->{item}->{nrof} || 1;
2833	$self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2834	}
2835		2821
2836	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];	2822	$row++;
2837	}	2823	}
2838
2839	sub size_request {
2840	my ($self) = @_;
2841	($self->{req_w}, $self->{req_h});
2842	}	2824	}
2843		2825
2844	#############################################################################	2826	#############################################################################
2845		2827
2846	package CFClient::UI::Menu;	2828	package CFClient::UI::Menu;
…		…
2881		2863
2882	# popup given the event (must be a mouse button down event currently)	2864	# popup given the event (must be a mouse button down event currently)
2883	sub popup {	2865	sub popup {
2884	my ($self, $ev) = @_;	2866	my ($self, $ev) = @_;
2885		2867
2886	$self->emit ("popdown");	2868	$self->_emit ("popdown");
2887		2869
2888	# maybe save $GRAB? must be careful about events...	2870	# maybe save $GRAB? must be careful about events...
2889	$GRAB = $self;	2871	$GRAB = $self;
2890	$self->{button} = $ev->{button};	2872	$self->{button} = $ev->{button};
2891		2873
2892	$self->show;	2874	$self->show;
2893	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2875	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2894	}	2876	}
2895		2877
2896	sub mouse_motion {	2878	sub mouse_motion {
2897	my ($self, $ev, $x, $y) = @_;	2879	my ($self, $ev, $x, $y) = @_;
2898		2880
…		…
2906		2888
2907	if ($ev->{button} == $self->{button}) {	2889	if ($ev->{button} == $self->{button}) {
2908	undef $GRAB;	2890	undef $GRAB;
2909	$self->hide;	2891	$self->hide;
2910		2892
2911	$self->emit ("popdown");	2893	$self->_emit ("popdown");
2912	$self->{hover}[1]->() if $self->{hover};	2894	$self->{hover}[1]->() if $self->{hover};
2913	}	2895	}
2914	}	2896	}
2915		2897
2916	#############################################################################	2898	#############################################################################
…		…
2978	sub add {	2960	sub add {
2979	my ($self, $text, %arg) = @_;	2961	my ($self, $text, %arg) = @_;
2980		2962
2981	$text =~ s/^\s+//;	2963	$text =~ s/^\s+//;
2982	$text =~ s/\s+$//;	2964	$text =~ s/\s+$//;
		2965
		2966	return unless $text;
2983		2967
2984	my $timeout = time + ((delete $arg{timeout}) || 60);	2968	my $timeout = time + ((delete $arg{timeout}) || 60);
2985		2969
2986	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	2970	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2987		2971
…		…
3030	use CFClient::OpenGL;	3014	use CFClient::OpenGL;
3031		3015
3032	sub new {	3016	sub new {
3033	my $class = shift;	3017	my $class = shift;
3034		3018
3035	$class->SUPER::new (	3019	my $self = $class->SUPER::new (
		3020	visible => 1,
3036	@_,	3021	@_,
3037	)	3022	);
3038	}
3039		3023
3040	sub configure {	3024	Scalar::Util::weaken ($self->{root} = $self);
3041	my ($self, $x, $y, $w, $h) = @_;
3042		3025
3043	$self->{w} = $w;	3026	$self
3044	$self->{h} = $h;
3045	}
3046
3047	sub check_size {
3048	my ($self) = @_;
3049
3050	$self->size_allocate ($self->{w}, $self->{h})
3051	if $self->{w};
3052	}	3027	}
3053		3028
3054	sub size_request {	3029	sub size_request {
3055	my ($self) = @_;	3030	my ($self) = @_;
3056		3031
3057	($self->{w}, $self->{h})	3032	($self->{w}, $self->{h})
		3033	}
		3034
		3035	sub _to_pixel {
		3036	my ($coord, $size, $max) = @_;
		3037
		3038	$coord =
		3039	$coord eq "center" ? ($max - $size) * 0.5
		3040	: $coord eq "max" ? $max
		3041	: $coord;
		3042
		3043	$coord = 0 if $coord < 0;
		3044	$coord = $max - $size if $coord > $max - $size;
		3045
		3046	int $coord + 0.5
3058	}	3047	}
3059		3048
3060	sub size_allocate {	3049	sub size_allocate {
3061	my ($self, $w, $h) = @_;	3050	my ($self, $w, $h) = @_;
3062		3051
3063	for my $child ($self->children) {	3052	for my $child ($self->children) {
3064	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3053	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3065		3054
3066	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3055	$X = $child->{force_x} if exists $child->{force_x};
3067	if exists $child->{req_x};	3056	$Y = $child->{force_y} if exists $child->{force_y};
3068		3057
3069	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3058	$X = _to_pixel $X, $W, $self->{w};
3070	if exists $child->{req_y};	3059	$Y = _to_pixel $Y, $H, $self->{h};
3071
3072	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3073	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3074		3060
3075	$child->configure ($X, $Y, $W, $H);	3061	$child->configure ($X, $Y, $W, $H);
3076	}	3062	}
3077	}	3063	}
3078		3064
…		…
3089	}	3075	}
3090		3076
3091	sub update {	3077	sub update {
3092	my ($self) = @_;	3078	my ($self) = @_;
3093		3079
3094	$self->check_size;
3095	$::WANT_REFRESH++;	3080	$::WANT_REFRESH++;
3096	}	3081	}
3097		3082
3098	sub add {	3083	sub add {
3099	my ($self, @children) = @_;	3084	my ($self, @children) = @_;
3100		3085
3101	for (my @widgets = @children; my $w = pop @widgets; ) {
3102	push @widgets, $w->children;
3103	$w->{root} = $self;
3104	$w->{visible} = 1;
3105	}
3106
3107	for my $child (@children) {
3108	$child->{is_toplevel} = 1;	3086	$_->{is_toplevel} = 1
3109		3087	for @children;
3110	# integerise window positions
3111	$child->{x} = int $child->{x};
3112	$child->{y} = int $child->{y};
3113	}
3114		3088
3115	$self->SUPER::add (@children);	3089	$self->SUPER::add (@children);
3116	}	3090	}
3117		3091
3118	sub remove {	3092	sub remove {
3119	my ($self, @children) = @_;	3093	my ($self, @children) = @_;
3120		3094
3121	$self->SUPER::remove (@children);	3095	$self->SUPER::remove (@children);
		3096
		3097	delete $self->{is_toplevel}
		3098	for @children;
3122		3099
3123	while (@children) {	3100	while (@children) {
3124	my $w = pop @children;	3101	my $w = pop @children;
3125	push @children, $w->children;	3102	push @children, $w->children;
3126	delete $w->{visible};	3103	$w->set_invisible;
3127	}	3104	}
3128	}	3105	}
3129		3106
3130	sub on_refresh {	3107	sub on_refresh {
3131	my ($self, $id, $cb) = @_;	3108	my ($self, $id, $cb) = @_;
…		…
3145	while ($self->{refresh_hook}) {	3122	while ($self->{refresh_hook}) {
3146	$_->()	3123	$_->()
3147	for values %{delete $self->{refresh_hook}};	3124	for values %{delete $self->{refresh_hook}};
3148	}	3125	}
3149		3126
3150	if ($self->{check_size}) {	3127	if ($self->{realloc}) {
3151	my @queue = ([], []);	3128	my @queue;
3152		3129
3153	for (;;) {	3130	while () {
3154	if ($self->{check_size}) {	3131	if ($self->{realloc}) {
3155	# heuristic: check containers last	3132	#TODO use array-of-depth approach
3156	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3133
3157	for values %{delete $self->{check_size}}	3134	use sort 'stable';
		3135
		3136	@queue = sort { $a->{visible} <=> $b->{visible} }
		3137	@queue, values %{delete $self->{realloc}};
3158	}	3138	}
3159		3139
3160	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3140	my $widget = pop @queue || last;
3161		3141
3162	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3142	$widget->{visible} or last; # do not resize invisible widgets
3163	? @$widget{qw(user_w user_h)}	3143
3164	: $widget->size_request;	3144	my ($w, $h) = $widget->size_request;
3165		3145
		3146	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3147	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3148
		3149	$w = $widget->{force_w} if exists $widget->{force_w};
		3150	$h = $widget->{force_h} if exists $widget->{force_h};
		3151
		3152	if ($widget->{req_w} != $w || $widget->{req_h} != $h
3166	if (delete $widget->{force_alloc}	3153	|| delete $widget->{force_realloc}) {
3167	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3168	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3169
3170	$widget->{req_w} = $w;	3154	$widget->{req_w} = $w;
3171	$widget->{req_h} = $h;	3155	$widget->{req_h} = $h;
3172		3156
3173	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3157	$self->{size_alloc}{$widget+0} = $widget;
3174		3158
3175	$widget->{parent}->check_size
3176	if $widget->{parent};	3159	if (my $parent = $widget->{parent}) {
		3160	$self->{realloc}{$parent+0} = $parent;
		3161	#unshift @queue, $parent;
		3162	$parent->{force_size_alloc} = 1;
		3163	$self->{size_alloc}{$parent+0} = $parent;
		3164	}
3177	}	3165	}
		3166
		3167	delete $self->{realloc}{$widget+0};
3178	}	3168	}
3179	}	3169	}
3180		3170
3181	while ($self->{size_alloc}) {	3171	while (my $size_alloc = delete $self->{size_alloc}) {
3182	for (values %{delete $self->{size_alloc}}) {	3172	my @queue = sort { $b->{visible} <=> $a->{visible} }
3183	my ($widget, $w, $h) = @$_;	3173	values %$size_alloc;
		3174
		3175	while () {
		3176	my $widget = pop @queue || last;
		3177
		3178	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3184		3179
3185	$w = 0 if $w < 0;	3180	$w = 0 if $w < 0;
3186	$h = 0 if $h < 0;	3181	$h = 0 if $h < 0;
3187		3182
		3183	$w = int $w + 0.5;
		3184	$h = int $h + 0.5;
		3185
		3186	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3188	$widget->{w} = $w;	3187	$widget->{w} = $w;
3189	$widget->{h} = $h;	3188	$widget->{h} = $h;
3190	$widget->size_allocate ($w, $h);	3189
3191	$widget->emit (size_allocate => $w, $h);	3190	$widget->emit (size_allocate => $w, $h);
		3191	}
3192	}	3192	}
3193	}	3193	}
3194		3194
3195	while ($self->{post_alloc_hook}) {	3195	while ($self->{post_alloc_hook}) {
3196	$_->()	3196	$_->()
3197	for values %{delete $self->{post_alloc_hook}};	3197	for values %{delete $self->{post_alloc_hook}};
3198	}	3198	}
		3199
3199		3200
3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3201	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3202	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3202	glClear GL_COLOR_BUFFER_BIT;	3203	glClear GL_COLOR_BUFFER_BIT;
3203		3204
…		…
3210	$self->_draw;	3211	$self->_draw;
3211	}	3212	}
3212		3213
3213	#############################################################################	3214	#############################################################################
3214		3215
		3216	package CFClient::UI::SpellList;
		3217
		3218	our @ISA = CFClient::UI::FancyFrame::;
		3219
		3220	sub new {
		3221	my $class = shift;
		3222
		3223	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3224
		3225	$self->add (new CFClient::UI::ScrolledWindow
		3226	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3227
		3228	$self;
		3229	}
		3230
		3231	# XXX: Do sorting? Argl...
		3232	sub add_spell {
		3233	my ($self, $spell) = @_;
		3234	$self->{spells}->{$spell->{name}} = $spell;
		3235
		3236	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3237	face => $spell->{face},
		3238	can_hover => 1,
		3239	can_events => 1,
		3240	tooltip => $spell->{message});
		3241
		3242	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3243	text => $spell->{name},
		3244	can_hover => 1,
		3245	can_events => 1,
		3246	tooltip => $spell->{message},
		3247	expand => 1);
		3248
		3249	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3250	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3251	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3252	expand => 1);
		3253
		3254	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3255	text => "bind to key",
		3256	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3257	}
		3258
		3259	sub rebuild_spell_list {
		3260	my ($self) = @_;
		3261	$self->{tbl_idx} = 0;
		3262	$self->add_spell ($_) for values %{$self->{spells}};
		3263	}
		3264
		3265	sub remove_spell {
		3266	my ($self, $spell) = @_;
		3267	delete $self->{spells}->{$spell->{name}};
		3268	$self->rebuild_spell_list;
		3269	}
		3270
		3271	#############################################################################
		3272
		3273	package CFClient::UI::BindEditor;
		3274
		3275	our @ISA = CFClient::UI::FancyFrame::;
		3276
		3277	sub new {
		3278	my $class = shift;
		3279
		3280	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3281
		3282	$self->add (my $vb = new CFClient::UI::VBox);
		3283
		3284
		3285	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3286	text => "start recording",
		3287	tooltip => "Start/Stops recording of actions."
		3288	."All subsequent actions after the recording started will be captured."
		3289	."The actions are displayed after the record was stopped."
		3290	."To bind the action you have to click on the 'Bind' button",
		3291	on_activate => sub {
		3292	unless ($self->{recording}) {
		3293	$self->start;
		3294	} else {
		3295	$self->stop;
		3296	}
		3297	});
		3298
		3299	$vb->add (new CFClient::UI::Label text => "Actions:");
		3300	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3301
		3302	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3303	$vb->add (my $hb = new CFClient::UI::HBox);
		3304	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3305	$hb->add (new CFClient::UI::Button
		3306	text => "bind",
		3307	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3308	on_activate => sub {
		3309	$self->ask_for_bind;
		3310	});
		3311
		3312	$vb->add (my $hb = new CFClient::UI::HBox);
		3313	$hb->add (new CFClient::UI::Button
		3314	text => "ok",
		3315	expand => 1,
		3316	tooltip => "This closes the binding editor and saves the binding",
		3317	on_activate => sub {
		3318	$self->hide;
		3319	$self->commit;
		3320	});
		3321
		3322	$hb->add (new CFClient::UI::Button
		3323	text => "cancel",
		3324	expand => 1,
		3325	tooltip => "This closes the binding editor without saving",
		3326	on_activate => sub {
		3327	$self->hide;
		3328	$self->{binding_cancel}->()
		3329	if $self->{binding_cancel};
		3330	});
		3331
		3332	$self->update_binding_widgets;
		3333
		3334	$self
		3335	}
		3336
		3337	sub commit {
		3338	my ($self) = @_;
		3339	my ($mod, $sym, $cmds) = $self->get_binding;
		3340	if ($sym != 0 && @$cmds > 0) {
		3341	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3342	."'. Don't forget 'Save Config'!");
		3343	$self->{binding_change}->($mod, $sym, $cmds)
		3344	if $self->{binding_change};
		3345	} else {
		3346	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3347	$self->{binding_cancel}->()
		3348	if $self->{binding_cancel};
		3349	}
		3350	}
		3351
		3352	sub start {
		3353	my ($self) = @_;
		3354
		3355	$self->{rec_btn}->set_text ("stop recording");
		3356	$self->{recording} = 1;
		3357	$self->clear_command_list;
		3358	$::CONN->start_record if $::CONN;
		3359	}
		3360
		3361	sub stop {
		3362	my ($self) = @_;
		3363
		3364	$self->{rec_btn}->set_text ("start recording");
		3365	$self->{recording} = 0;
		3366
		3367	my $rec;
		3368	$rec = $::CONN->stop_record if $::CONN;
		3369	return unless ref $rec eq 'ARRAY';
		3370	$self->set_command_list ($rec);
		3371	}
		3372
		3373	# if $commit is true, the binding will be set after the user entered a key combo
		3374	sub ask_for_bind {
		3375	my ($self, $commit) = @_;
		3376
		3377	CFClient::Binder::open_binding_dialog (sub {
		3378	my ($mod, $sym) = @_;
		3379	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3380	$self->update_binding_widgets;
		3381	$self->commit if $commit;
		3382	});
		3383	}
		3384
		3385	# $mod and $sym are the modifiers and key symbol
		3386	# $cmds is a array ref of strings (the commands)
		3387	# $cb is the callback that is executed on OK
		3388	# $ccb is the callback that is executed on CANCEL and
		3389	# when the binding was unsuccessful on OK
		3390	sub set_binding {
		3391	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3392
		3393	$self->clear_command_list;
		3394	$self->{recording} = 0;
		3395	$self->{rec_btn}->set_text ("start recording");
		3396
		3397	$self->{binding} = [$mod, $sym];
		3398	$self->{commands} = $cmds;
		3399
		3400	$self->{binding_change} = $cb;
		3401	$self->{binding_cancel} = $ccb;
		3402
		3403	$self->update_binding_widgets;
		3404	}
		3405
		3406	# this is a shortcut method that asks for a binding
		3407	# and then just binds it.
		3408	sub do_quick_binding {
		3409	my ($self, $cmds) = @_;
		3410	$self->set_binding (undef, undef, $cmds, sub {
		3411	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3412	});
		3413	$self->ask_for_bind (1);
		3414	}
		3415
		3416	sub update_binding_widgets {
		3417	my ($self) = @_;
		3418	my ($mod, $sym, $cmds) = $self->get_binding;
		3419	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3420	$self->set_command_list ($cmds);
		3421	}
		3422
		3423	sub get_binding {
		3424	my ($self) = @_;
		3425	return (
		3426	$self->{binding}->[0],
		3427	$self->{binding}->[1],
		3428	[ grep { defined $_ } @{$self->{commands}} ]
		3429	);
		3430	}
		3431
		3432	sub clear_command_list {
		3433	my ($self) = @_;
		3434	$self->{cmdbox}->clear ();
		3435	}
		3436
		3437	sub set_command_list {
		3438	my ($self, $cmds) = @_;
		3439
		3440	$self->{cmdbox}->clear ();
		3441	$self->{commands} = $cmds;
		3442
		3443	my $idx = 0;
		3444
		3445	for (@$cmds) {
		3446	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3447
		3448	my $i = $idx;
		3449	$hb->add (new CFClient::UI::Label text => $_);
		3450	$hb->add (new CFClient::UI::Button
		3451	text => "delete",
		3452	tooltip => "Deletes the action from the record",
		3453	on_activate => sub {
		3454	$self->{cmdbox}->remove ($hb);
		3455	$cmds->[$i] = undef;
		3456	});
		3457
		3458
		3459	$idx++
		3460	}
		3461	}
		3462
		3463	#############################################################################
		3464
3215	package CFClient::UI;	3465	package CFClient::UI;
3216		3466
3217	$ROOT = new CFClient::UI::Root;	3467	$ROOT = new CFClient::UI::Root;
3218	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	3468	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3219		3469

Diff Legend

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