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.263 by elmex, Wed May 31 14:04: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
		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
…		…
1441	my ($self, $fontsize) = @_;	1531	my ($self, $fontsize) = @_;
1442		1532
1443	$self->{fontsize} = $fontsize;	1533	$self->{fontsize} = $fontsize;
1444	delete $self->{texture};	1534	delete $self->{texture};
1445		1535
1446	$self->update;	1536	$self->realloc;
1447	$self->check_size;
1448	}	1537	}
1449		1538
1450	sub _draw {	1539	sub _draw {
1451	my ($self) = @_;	1540	my ($self) = @_;
1452		1541
…		…
1460	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1461	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1462		1551
1463	my $tex = new_from_layout CFClient::Texture $self->{layout};	1552	my $tex = new_from_layout CFClient::Texture $self->{layout};
1464		1553
1465	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1466	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1467	: ($self->{w} - $tex->{w}) * 0.5);	1556	: ($self->{w} - $tex->{w}) * 0.5);
1468		1557
1469	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1470	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1471	: ($self->{h} - $tex->{h}) * 0.5);	1560	: ($self->{h} - $tex->{h}) * 0.5);
1472		1561
1473	$tex	1562	$tex
1474	};	1563	};
1475		1564
…		…
1524	$self->{text} = $text;	1613	$self->{text} = $text;
1525		1614
1526	$text =~ s/./*/g if $self->{hidden};	1615	$text =~ s/./*/g if $self->{hidden};
1527	$self->{layout}->set_text ("$text ");	1616	$self->{layout}->set_text ("$text ");
1528		1617
1529	$self->emit (changed => $self->{text});	1618	$self->_emit (changed => $self->{text});
1530	}	1619	}
1531		1620
1532	sub set_text {	1621	sub set_text {
1533	my ($self, $text) = @_;	1622	my ($self, $text) = @_;
1534		1623
1535	$self->{cursor} = length $text;	1624	$self->{cursor} = length $text;
1536	$self->_set_text ($text);	1625	$self->_set_text ($text);
1537	$self->update;	1626
1538	$self->check_size;	1627	$self->realloc;
1539	}	1628	}
1540		1629
1541	sub get_text {	1630	sub get_text {
1542	$_[0]{text}	1631	$_[0]{text}
1543	}	1632	}
…		…
1546	my ($self) = @_;	1635	my ($self) = @_;
1547		1636
1548	my ($w, $h) = $self->SUPER::size_request;	1637	my ($w, $h) = $self->SUPER::size_request;
1549		1638
1550	($w + 1, $h) # add 1 for cursor	1639	($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	}	1640	}
1558		1641
1559	sub key_down {	1642	sub key_down {
1560	my ($self, $ev) = @_;	1643	my ($self, $ev) = @_;
1561		1644
…		…
1576	} elsif ($sym == CFClient::SDLK_HOME) {	1659	} elsif ($sym == CFClient::SDLK_HOME) {
1577	$self->{cursor} = 0;	1660	$self->{cursor} = 0;
1578	} elsif ($sym == CFClient::SDLK_END) {	1661	} elsif ($sym == CFClient::SDLK_END) {
1579	$self->{cursor} = length $text;	1662	$self->{cursor} = length $text;
1580	} elsif ($uni == 27) {	1663	} elsif ($uni == 27) {
1581	$self->emit ('escape');	1664	$self->_emit ('escape');
1582	} elsif ($uni) {	1665	} elsif ($uni) {
1583	substr $text, $self->{cursor}++, 0, chr $uni;	1666	substr $text, $self->{cursor}++, 0, chr $uni;
1584	}	1667	}
1585		1668
1586	$self->_set_text ($text);	1669	$self->_set_text ($text);
1587	$self->update;	1670
1588	$self->check_size;	1671	$self->realloc;
1589	}	1672	}
1590		1673
1591	sub focus_in {	1674	sub focus_in {
1592	my ($self) = @_;	1675	my ($self) = @_;
1593		1676
…		…
1673	if ($sym == 13) {	1756	if ($sym == 13) {
1674	unshift @{$self->{history}},	1757	unshift @{$self->{history}},
1675	my $txt = $self->get_text;	1758	my $txt = $self->get_text;
1676	$self->{history_pointer} = -1;	1759	$self->{history_pointer} = -1;
1677	$self->{history_saveback} = '';	1760	$self->{history_saveback} = '';
1678	$self->emit (activate => $txt);	1761	$self->_emit (activate => $txt);
1679	$self->update;	1762	$self->update;
1680		1763
1681	} elsif ($sym == CFClient::SDLK_UP) {	1764	} elsif ($sym == CFClient::SDLK_UP) {
1682	if ($self->{history_pointer} < 0) {	1765	if ($self->{history_pointer} < 0) {
1683	$self->{history_saveback} = $self->get_text;	1766	$self->{history_saveback} = $self->get_text;
…		…
1720		1803
1721	sub new {	1804	sub new {
1722	my $class = shift;	1805	my $class = shift;
1723		1806
1724	$class->SUPER::new (	1807	$class->SUPER::new (
1725	padding => 4,	1808	padding_x => 4,
		1809	padding_y => 4,
1726	fg => [1, 1, 1],	1810	fg => [1, 1, 1],
1727	active_fg => [0, 0, 1],	1811	active_fg => [0, 0, 1],
1728	can_hover => 1,	1812	can_hover => 1,
1729	align => 0,	1813	align => 0,
1730	valign => 0,	1814	valign => 0,
1731	can_events => 1,	1815	can_events => 1,
1732	@_	1816	@_
1733	)	1817	)
1734	}	1818	}
1735		1819
		1820	sub activate { }
		1821
1736	sub button_up {	1822	sub button_up {
1737	my ($self, $ev, $x, $y) = @_;	1823	my ($self, $ev, $x, $y) = @_;
1738		1824
		1825	$self->emit ("activate")
1739	if ($x >= 0 && $x < $self->{w}	1826	if $x >= 0 && $x < $self->{w}
1740	&& $y >= 0 && $y < $self->{h}) {	1827	&& $y >= 0 && $y < $self->{h};
1741	$self->emit ("activate");
1742	}
1743	}	1828	}
1744		1829
1745	sub _draw {	1830	sub _draw {
1746	my ($self) = @_;	1831	my ($self) = @_;
1747		1832
…		…
1776		1861
1777	sub new {	1862	sub new {
1778	my $class = shift;	1863	my $class = shift;
1779		1864
1780	$class->SUPER::new (	1865	$class->SUPER::new (
1781	padding => 2,	1866	padding_x => 2,
		1867	padding_y => 2,
1782	fg => [1, 1, 1],	1868	fg => [1, 1, 1],
1783	active_fg => [1, 1, 0],	1869	active_fg => [1, 1, 0],
1784	bg => [0, 0, 0, 0.2],	1870	bg => [0, 0, 0, 0.2],
1785	active_bg => [1, 1, 1, 0.5],	1871	active_bg => [1, 1, 1, 0.5],
1786	state => 0,	1872	state => 0,
…		…
1790	}	1876	}
1791		1877
1792	sub size_request {	1878	sub size_request {
1793	my ($self) = @_;	1879	my ($self) = @_;
1794		1880
1795	($self->{padding} * 2 + 6) x 2	1881	(6) x 2
1796	}	1882	}
1797		1883
1798	sub button_down {	1884	sub button_down {
1799	my ($self, $ev, $x, $y) = @_;	1885	my ($self, $ev, $x, $y) = @_;
1800		1886
1801	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1802	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1803	$self->{state} = !$self->{state};	1889	$self->{state} = !$self->{state};
1804	$self->emit (changed => $self->{state});	1890	$self->_emit (changed => $self->{state});
1805	}	1891	}
1806	}	1892	}
1807		1893
1808	sub _draw {	1894	sub _draw {
1809	my ($self) = @_;	1895	my ($self) = @_;
1810		1896
1811	$self->SUPER::_draw;	1897	$self->SUPER::_draw;
1812		1898
1813	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1899	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1814		1900
1815	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1901	my ($w, $h) = @$self{qw(w h)};
		1902
		1903	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1816		1904
1817	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1905	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1818		1906
1819	my $tex = $self->{state} ? $tex[1] : $tex[0];	1907	my $tex = $self->{state} ? $tex[1] : $tex[0];
1820		1908
…		…
2085	fg => [1, 1, 1],	2173	fg => [1, 1, 1],
2086	active_fg => [0, 0, 0],	2174	active_fg => [0, 0, 0],
2087	bg => [0, 0, 0, 0.2],	2175	bg => [0, 0, 0, 0.2],
2088	active_bg => [1, 1, 1, 0.5],	2176	active_bg => [1, 1, 1, 0.5],
2089	range => [0, 0, 100, 10, 0],	2177	range => [0, 0, 100, 10, 0],
2090	req_w => $::WIDTH / 80,	2178	min_w => $::WIDTH / 80,
2091	req_h => $::WIDTH / 80,	2179	min_h => $::WIDTH / 80,
2092	vertical => 0,	2180	vertical => 0,
2093	can_hover => 1,	2181	can_hover => 1,
2094	inner_pad => 0.02,	2182	inner_pad => 0.02,
2095	@_	2183	@_
2096	);	2184	);
…		…
2099	$self->update;	2187	$self->update;
2100		2188
2101	$self	2189	$self
2102	}	2190	}
2103		2191
		2192	sub changed { }
		2193
2104	sub set_range {	2194	sub set_range {
2105	my ($self, $range) = @_;	2195	my ($self, $range) = @_;
2106		2196
2107	$self->{range} = $range;	2197	($range, $self->{range}) = ($self->{range}, $range);
2108		2198
2109	$self->update;	2199	$self->update
		2200	if "@$range" ne "@{$self->{range}}";
2110	}	2201	}
2111		2202
2112	sub set_value {	2203	sub set_value {
2113	my ($self, $value) = @_;	2204	my ($self, $value) = @_;
2114		2205
…		…
2125	if $unit;	2216	if $unit;
2126		2217
2127	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2218	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2128		2219
2129	if ($value != $old_value) {	2220	if ($value != $old_value) {
2130	$self->emit (changed => $value);	2221	$self->_emit (changed => $value);
2131	$self->update;	2222	$self->update;
2132	}	2223	}
2133	}	2224	}
2134		2225
2135	sub size_request {	2226	sub size_request {
2136	my ($self) = @_;	2227	my ($self) = @_;
2137		2228
2138	my $w = $self->{req_w};	2229	($self->{req_w}, $self->{req_h})
2139	my $h = $self->{req_h};
2140
2141	$self->{vertical} ? ($h, $w) : ($w, $h)
2142	}	2230	}
2143		2231
2144	sub button_down {	2232	sub button_down {
2145	my ($self, $ev, $x, $y) = @_;	2233	my ($self, $ev, $x, $y) = @_;
2146		2234
…		…
2497		2585
2498	sub new {	2586	sub new {
2499	my $class = shift;	2587	my $class = shift;
2500		2588
2501	my $self = $class->SUPER::new (	2589	my $self = $class->SUPER::new (
2502	state => 0,	2590	state => 0,
2503	connect_activate => \&toggle_flopper,	2591	on_activate => \&toggle_flopper,
2504	@_	2592	@_
2505	);	2593	);
2506		2594
2507	if ($self->{state}) {
2508	$self->{state} = 0;
2509	$self->toggle_flopper;
2510	}
2511
2512	$self	2595	$self
2513	}	2596	}
2514		2597
2515	sub toggle_flopper {	2598	sub toggle_flopper {
2516	my ($self) = @_;	2599	my ($self) = @_;
2517		2600
2518	# TODO: use animation	2601	$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	}	2602	}
2530		2603
2531	#############################################################################	2604	#############################################################################
2532		2605
2533	package CFClient::UI::Tooltip;	2606	package CFClient::UI::Tooltip;
…		…
2546	}	2619	}
2547		2620
2548	sub set_tooltip_from {	2621	sub set_tooltip_from {
2549	my ($self, $widget) = @_;	2622	my ($self, $widget) = @_;
2550		2623
		2624	my $tooltip = $widget->{tooltip};
		2625
		2626	if ($ENV{CFPLUS_DEBUG} & 2) {
		2627	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2628	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2629	. "req $widget->{req_w} $widget->{req_h}\n"
		2630	. "visible $widget->{visible}";
		2631	}
		2632
2551	$self->add (new CFClient::UI::Label	2633	$self->add (new CFClient::UI::Label
2552	markup => $widget->{tooltip},	2634	markup => $tooltip,
2553	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2635	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2554	fontsize => 0.8,	2636	fontsize => 0.8,
2555	fg => [0, 0, 0, 1],	2637	fg => [0, 0, 0, 1],
2556	ellipsise => 0,	2638	ellipsise => 0,
2557	font => ($widget->{tooltip_font} || $::FONT_PROP),	2639	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2568		2650
2569	sub size_allocate {	2651	sub size_allocate {
2570	my ($self, $w, $h) = @_;	2652	my ($self, $w, $h) = @_;
2571		2653
2572	$self->SUPER::size_allocate ($w - 4, $h - 4);	2654	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2655	}
		2656
		2657	sub visibility_change {
		2658	my ($self, $visible) = @_;
		2659
		2660	return unless $visible;
		2661
		2662	$self->{root}->on_post_alloc ("move_$self" => sub {
		2663	my $widget = $self->{owner}
		2664	or return;
		2665
		2666	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2667
		2668	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2669	if $x + $self->{w} > $::WIDTH;
		2670
		2671	$self->move_abs ($x, $y);
		2672	});
2573	}	2673	}
2574		2674
2575	sub _draw {	2675	sub _draw {
2576	my ($self) = @_;	2676	my ($self) = @_;
2577		2677
…		…
2594	glVertex $w, $h;	2694	glVertex $w, $h;
2595	glVertex $w, 0;	2695	glVertex $w, 0;
2596	glEnd;	2696	glEnd;
2597		2697
2598	glTranslate 2 - 0.375, 2 - 0.375;	2698	glTranslate 2 - 0.375, 2 - 0.375;
		2699
2599	$self->SUPER::_draw;	2700	$self->SUPER::_draw;
2600	}	2701	}
2601		2702
2602	#############################################################################	2703	#############################################################################
2603		2704
…		…
2609		2710
2610	sub new {	2711	sub new {
2611	my $class = shift;	2712	my $class = shift;
2612		2713
2613	my $self = $class->SUPER::new (	2714	my $self = $class->SUPER::new (
2614	aspect => 1,	2715	aspect => 1,
		2716	can_events => 0,
2615	@_,	2717	@_,
2616	);	2718	);
2617		2719
2618	if ($self->{anim} && $self->{animspeed}) {	2720	if ($self->{anim} && $self->{animspeed}) {
2619	Scalar::Util::weaken (my $widget = $self);	2721	Scalar::Util::weaken (my $widget = $self);
…		…
2678	$self->SUPER::DESTROY;	2780	$self->SUPER::DESTROY;
2679	}	2781	}
2680		2782
2681	#############################################################################	2783	#############################################################################
2682		2784
2683	package CFClient::UI::InventoryItem;	2785	package CFClient::UI::Inventory;
2684		2786
2685	our @ISA = CFClient::UI::HBox::;	2787	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		2788
2713	sub new {	2789	sub new {
2714	my $class = shift;	2790	my $class = shift;
2715		2791
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 (	2792	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),	2793	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2804	@_,	2794	@_,
2805	);	2795	);
2806		2796
2807	$self	2797	$self
2808	}	2798	}
…		…
2818	or ($a->{name} cmp $b->{name})	2808	or ($a->{name} cmp $b->{name})
2819	} @$items;	2809	} @$items;
2820		2810
2821	$self->{real_items} = \@items;	2811	$self->{real_items} = \@items;
2822		2812
		2813	my $row = 0;
2823	for my $item (@items) {	2814	for my $item (@items) {
2824	$item->{item} = $item;	2815	CFClient::Item::update_widgets $item;
2825	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2826	$item->update_item ();
2827	}
2828		2816
2829	my $i = 0;	2817	$self->{scrolled}->add (0, $row, $item->{face_widget});
2830	for (@items) {	2818	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2831	$self->{scrolled}->add (0, $i, $_);	2819	$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		2820
2836	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];	2821	$row++;
2837	}	2822	}
2838
2839	sub size_request {
2840	my ($self) = @_;
2841	($self->{req_w}, $self->{req_h});
2842	}	2823	}
2843		2824
2844	#############################################################################	2825	#############################################################################
2845		2826
2846	package CFClient::UI::Menu;	2827	package CFClient::UI::Menu;
…		…
2881		2862
2882	# popup given the event (must be a mouse button down event currently)	2863	# popup given the event (must be a mouse button down event currently)
2883	sub popup {	2864	sub popup {
2884	my ($self, $ev) = @_;	2865	my ($self, $ev) = @_;
2885		2866
2886	$self->emit ("popdown");	2867	$self->_emit ("popdown");
2887		2868
2888	# maybe save $GRAB? must be careful about events...	2869	# maybe save $GRAB? must be careful about events...
2889	$GRAB = $self;	2870	$GRAB = $self;
2890	$self->{button} = $ev->{button};	2871	$self->{button} = $ev->{button};
2891		2872
2892	$self->show;	2873	$self->show;
2893	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2874	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2894	}	2875	}
2895		2876
2896	sub mouse_motion {	2877	sub mouse_motion {
2897	my ($self, $ev, $x, $y) = @_;	2878	my ($self, $ev, $x, $y) = @_;
2898		2879
…		…
2906		2887
2907	if ($ev->{button} == $self->{button}) {	2888	if ($ev->{button} == $self->{button}) {
2908	undef $GRAB;	2889	undef $GRAB;
2909	$self->hide;	2890	$self->hide;
2910		2891
2911	$self->emit ("popdown");	2892	$self->_emit ("popdown");
2912	$self->{hover}[1]->() if $self->{hover};	2893	$self->{hover}[1]->() if $self->{hover};
2913	}	2894	}
2914	}	2895	}
2915		2896
2916	#############################################################################	2897	#############################################################################
…		…
2978	sub add {	2959	sub add {
2979	my ($self, $text, %arg) = @_;	2960	my ($self, $text, %arg) = @_;
2980		2961
2981	$text =~ s/^\s+//;	2962	$text =~ s/^\s+//;
2982	$text =~ s/\s+$//;	2963	$text =~ s/\s+$//;
		2964
		2965	return unless $text;
2983		2966
2984	my $timeout = time + ((delete $arg{timeout}) || 60);	2967	my $timeout = time + ((delete $arg{timeout}) || 60);
2985		2968
2986	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	2969	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2987		2970
…		…
3030	use CFClient::OpenGL;	3013	use CFClient::OpenGL;
3031		3014
3032	sub new {	3015	sub new {
3033	my $class = shift;	3016	my $class = shift;
3034		3017
3035	$class->SUPER::new (	3018	my $self = $class->SUPER::new (
		3019	visible => 1,
3036	@_,	3020	@_,
3037	)	3021	);
3038	}
3039		3022
3040	sub configure {	3023	Scalar::Util::weaken ($self->{root} = $self);
3041	my ($self, $x, $y, $w, $h) = @_;
3042		3024
3043	$self->{w} = $w;	3025	$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	}	3026	}
3053		3027
3054	sub size_request {	3028	sub size_request {
3055	my ($self) = @_;	3029	my ($self) = @_;
3056		3030
3057	($self->{w}, $self->{h})	3031	($self->{w}, $self->{h})
		3032	}
		3033
		3034	sub _to_pixel {
		3035	my ($coord, $size, $max) = @_;
		3036
		3037	$coord =
		3038	$coord eq "center" ? ($max - $size) * 0.5
		3039	: $coord eq "max" ? $max
		3040	: $coord;
		3041
		3042	$coord = 0 if $coord < 0;
		3043	$coord = $max - $size if $coord > $max - $size;
		3044
		3045	int $coord + 0.5
3058	}	3046	}
3059		3047
3060	sub size_allocate {	3048	sub size_allocate {
3061	my ($self, $w, $h) = @_;	3049	my ($self, $w, $h) = @_;
3062		3050
3063	for my $child ($self->children) {	3051	for my $child ($self->children) {
3064	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3052	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3065		3053
3066	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3054	$X = $child->{force_x} if exists $child->{force_x};
3067	if exists $child->{req_x};	3055	$Y = $child->{force_y} if exists $child->{force_y};
3068		3056
3069	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3057	$X = _to_pixel $X, $W, $self->{w};
3070	if exists $child->{req_y};	3058	$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		3059
3075	$child->configure ($X, $Y, $W, $H);	3060	$child->configure ($X, $Y, $W, $H);
3076	}	3061	}
3077	}	3062	}
3078		3063
…		…
3089	}	3074	}
3090		3075
3091	sub update {	3076	sub update {
3092	my ($self) = @_;	3077	my ($self) = @_;
3093		3078
3094	$self->check_size;
3095	$::WANT_REFRESH++;	3079	$::WANT_REFRESH++;
3096	}	3080	}
3097		3081
3098	sub add {	3082	sub add {
3099	my ($self, @children) = @_;	3083	my ($self, @children) = @_;
3100		3084
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;	3085	$_->{is_toplevel} = 1
3109		3086	for @children;
3110	# integerise window positions
3111	$child->{x} = int $child->{x};
3112	$child->{y} = int $child->{y};
3113	}
3114		3087
3115	$self->SUPER::add (@children);	3088	$self->SUPER::add (@children);
3116	}	3089	}
3117		3090
3118	sub remove {	3091	sub remove {
3119	my ($self, @children) = @_;	3092	my ($self, @children) = @_;
3120		3093
3121	$self->SUPER::remove (@children);	3094	$self->SUPER::remove (@children);
		3095
		3096	delete $self->{is_toplevel}
		3097	for @children;
3122		3098
3123	while (@children) {	3099	while (@children) {
3124	my $w = pop @children;	3100	my $w = pop @children;
3125	push @children, $w->children;	3101	push @children, $w->children;
3126	delete $w->{visible};	3102	$w->set_invisible;
3127	}	3103	}
3128	}	3104	}
3129		3105
3130	sub on_refresh {	3106	sub on_refresh {
3131	my ($self, $id, $cb) = @_;	3107	my ($self, $id, $cb) = @_;
…		…
3145	while ($self->{refresh_hook}) {	3121	while ($self->{refresh_hook}) {
3146	$_->()	3122	$_->()
3147	for values %{delete $self->{refresh_hook}};	3123	for values %{delete $self->{refresh_hook}};
3148	}	3124	}
3149		3125
3150	if ($self->{check_size}) {	3126	if ($self->{realloc}) {
3151	my @queue = ([], []);	3127	my @queue;
3152		3128
3153	for (;;) {	3129	while () {
3154	if ($self->{check_size}) {	3130	if ($self->{realloc}) {
3155	# heuristic: check containers last	3131	#TODO use array-of-depth approach
3156	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3132
3157	for values %{delete $self->{check_size}}	3133	use sort 'stable';
		3134
		3135	@queue = sort { $a->{visible} <=> $b->{visible} }
		3136	@queue, values %{delete $self->{realloc}};
3158	}	3137	}
3159		3138
3160	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3139	my $widget = pop @queue || last;
3161		3140
3162	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3141	$widget->{visible} or last; # do not resize invisible widgets
3163	? @$widget{qw(user_w user_h)}	3142
3164	: $widget->size_request;	3143	my ($w, $h) = $widget->size_request;
3165		3144
		3145	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3146	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3147
		3148	$w = $widget->{force_w} if exists $widget->{force_w};
		3149	$h = $widget->{force_h} if exists $widget->{force_h};
		3150
		3151	if ($widget->{req_w} != $w || $widget->{req_h} != $h
3166	if (delete $widget->{force_alloc}	3152	|| 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;	3153	$widget->{req_w} = $w;
3171	$widget->{req_h} = $h;	3154	$widget->{req_h} = $h;
3172		3155
3173	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3156	$self->{size_alloc}{$widget+0} = $widget;
3174		3157
3175	$widget->{parent}->check_size
3176	if $widget->{parent};	3158	if (my $parent = $widget->{parent}) {
		3159	$self->{realloc}{$parent+0} = $parent;
		3160	#unshift @queue, $parent;
		3161	$parent->{force_size_alloc} = 1;
		3162	$self->{size_alloc}{$parent+0} = $parent;
		3163	}
3177	}	3164	}
		3165
		3166	delete $self->{realloc}{$widget+0};
3178	}	3167	}
3179	}	3168	}
3180		3169
3181	while ($self->{size_alloc}) {	3170	while (my $size_alloc = delete $self->{size_alloc}) {
3182	for (values %{delete $self->{size_alloc}}) {	3171	my @queue = sort { $b->{visible} <=> $a->{visible} }
3183	my ($widget, $w, $h) = @$_;	3172	values %$size_alloc;
		3173
		3174	while () {
		3175	my $widget = pop @queue || last;
		3176
		3177	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3184		3178
3185	$w = 0 if $w < 0;	3179	$w = 0 if $w < 0;
3186	$h = 0 if $h < 0;	3180	$h = 0 if $h < 0;
3187		3181
		3182	$w = int $w + 0.5;
		3183	$h = int $h + 0.5;
		3184
		3185	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3188	$widget->{w} = $w;	3186	$widget->{w} = $w;
3189	$widget->{h} = $h;	3187	$widget->{h} = $h;
3190	$widget->size_allocate ($w, $h);	3188
3191	$widget->emit (size_allocate => $w, $h);	3189	$widget->emit (size_allocate => $w, $h);
		3190	}
3192	}	3191	}
3193	}	3192	}
3194		3193
3195	while ($self->{post_alloc_hook}) {	3194	while ($self->{post_alloc_hook}) {
3196	$_->()	3195	$_->()
3197	for values %{delete $self->{post_alloc_hook}};	3196	for values %{delete $self->{post_alloc_hook}};
3198	}	3197	}
		3198
3199		3199
3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3202	glClear GL_COLOR_BUFFER_BIT;	3202	glClear GL_COLOR_BUFFER_BIT;
3203		3203
…		…
3210	$self->_draw;	3210	$self->_draw;
3211	}	3211	}
3212		3212
3213	#############################################################################	3213	#############################################################################
3214		3214
		3215	package CFClient::UI::BindEditor;
		3216
		3217	our @ISA = CFClient::UI::FancyFrame::;
		3218
		3219	sub new {
		3220	my $class = shift;
		3221
		3222	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3223
		3224	$self->add (my $vb = new CFClient::UI::VBox);
		3225
		3226
		3227	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3228	text => "start recording",
		3229	tooltip => "Start/Stops recording of actions."
		3230	."All subsequent actions after the recording started will be captured."
		3231	."The actions are displayed after the record was stopped."
		3232	."To bind the action you have to click on the 'Bind' button",
		3233	on_activate => sub {
		3234	unless ($self->{recording}) {
		3235	$self->start;
		3236	} else {
		3237	$self->stop;
		3238	}
		3239	});
		3240
		3241	$vb->add (new CFClient::UI::Label text => "Actions:");
		3242	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3243
		3244	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3245	$vb->add (my $hb = new CFClient::UI::HBox);
		3246	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3247	$hb->add (new CFClient::UI::Button
		3248	text => "bind",
		3249	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3250	on_activate => sub {
		3251	$self->ask_for_bind;
		3252	});
		3253
		3254	$vb->add (my $hb = new CFClient::UI::HBox);
		3255	$hb->add (new CFClient::UI::Button
		3256	text => "ok",
		3257	expand => 1,
		3258	tooltip => "This closes the binding editor and saves the binding",
		3259	on_activate => sub {
		3260	$self->hide;
		3261	$self->commit;
		3262	});
		3263
		3264	$hb->add (new CFClient::UI::Button
		3265	text => "cancel",
		3266	expand => 1,
		3267	tooltip => "This closes the binding editor without saving",
		3268	on_activate => sub {
		3269	$self->hide;
		3270	$self->{binding_cancel}->()
		3271	if $self->{binding_cancel};
		3272	});
		3273
		3274	$self->update_binding_widgets;
		3275
		3276	$self
		3277	}
		3278
		3279	sub commit {
		3280	my ($self) = @_;
		3281	my ($mod, $sym, $cmds) = $self->get_binding;
		3282	if ($sym != 0 && @$cmds > 0) {
		3283	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3284	."'. Don't forget 'Save Config'!");
		3285	$self->{binding_change}->($mod, $sym, $cmds)
		3286	if $self->{binding_change};
		3287	} else {
		3288	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3289	$self->{binding_cancel}->()
		3290	if $self->{binding_cancel};
		3291	}
		3292	}
		3293
		3294	sub start {
		3295	my ($self) = @_;
		3296
		3297	$self->{rec_btn}->set_text ("stop recording");
		3298	$self->{recording} = 1;
		3299	$self->clear_command_list;
		3300	$::CONN->start_record if $::CONN;
		3301	}
		3302
		3303	sub stop {
		3304	my ($self) = @_;
		3305
		3306	$self->{rec_btn}->set_text ("start recording");
		3307	$self->{recording} = 0;
		3308
		3309	my $rec;
		3310	$rec = $::CONN->stop_record if $::CONN;
		3311	return unless ref $rec eq 'ARRAY';
		3312	$self->set_command_list ($rec);
		3313	}
		3314
		3315	# if $commit is true, the binding will be set after the user entered a key combo
		3316	sub ask_for_bind {
		3317	my ($self, $commit) = @_;
		3318
		3319	CFClient::Binder::open_binding_dialog (sub {
		3320	my ($mod, $sym) = @_;
		3321	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3322	$self->update_binding_widgets;
		3323	$self->commit if $commit;
		3324	});
		3325	}
		3326
		3327	# $mod and $sym are the modifiers and key symbol
		3328	# $cmds is a array ref of strings (the commands)
		3329	# $cb is the callback that is executed on OK
		3330	# $ccb is the callback that is executed on CANCEL and
		3331	# when the binding was unsuccessful on OK
		3332	sub set_binding {
		3333	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3334
		3335	$self->clear_command_list;
		3336	$self->{recording} = 0;
		3337	$self->{rec_btn}->set_text ("start recording");
		3338
		3339	$self->{binding} = [$mod, $sym];
		3340	$self->{commands} = $cmds;
		3341
		3342	$self->{binding_change} = $cb;
		3343	$self->{binding_cancel} = $ccb;
		3344
		3345	$self->update_binding_widgets;
		3346	}
		3347
		3348	# this is a shortcut method that asks for a binding
		3349	# and then just binds it.
		3350	sub do_quick_binding {
		3351	my ($self, $cmds) = @_;
		3352	$self->set_binding (undef, undef, $cmds, sub {
		3353	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3354	});
		3355	$self->ask_for_bind (1);
		3356	}
		3357
		3358	sub update_binding_widgets {
		3359	my ($self) = @_;
		3360	my ($mod, $sym, $cmds) = $self->get_binding;
		3361	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3362	$self->set_command_list ($cmds);
		3363	}
		3364
		3365	sub get_binding {
		3366	my ($self) = @_;
		3367	return (
		3368	$self->{binding}->[0],
		3369	$self->{binding}->[1],
		3370	[ grep { defined $_ } @{$self->{commands}} ]
		3371	);
		3372	}
		3373
		3374	sub clear_command_list {
		3375	my ($self) = @_;
		3376	$self->{cmdbox}->clear ();
		3377	}
		3378
		3379	sub set_command_list {
		3380	my ($self, $cmds) = @_;
		3381
		3382	$self->{cmdbox}->clear ();
		3383	$self->{commands} = $cmds;
		3384
		3385	my $idx = 0;
		3386
		3387	for (@$cmds) {
		3388	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3389
		3390	my $i = $idx;
		3391	$hb->add (new CFClient::UI::Label text => $_);
		3392	$hb->add (new CFClient::UI::Button
		3393	text => "delete",
		3394	tooltip => "Deletes the action from the record",
		3395	on_activate => sub {
		3396	$self->{cmdbox}->remove ($hb);
		3397	$cmds->[$i] = undef;
		3398	});
		3399
		3400
		3401	$idx++
		3402	}
		3403	}
		3404
		3405
		3406	#############################################################################
		3407
		3408	package CFClient::UI::SpellList;
		3409
		3410	our @ISA = CFClient::UI::FancyFrame::;
		3411
		3412	sub new {
		3413	my $class = shift;
		3414
		3415	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3416
		3417	$self->add (new CFClient::UI::ScrolledWindow
		3418	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3419
		3420	$self;
		3421	}
		3422
		3423	# XXX: Do sorting? Argl...
		3424	sub add_spell {
		3425	my ($self, $spell) = @_;
		3426	$self->{spells}->{$spell->{name}} = $spell;
		3427
		3428	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3429	face => $spell->{face},
		3430	can_hover => 1,
		3431	can_events => 1,
		3432	tooltip => $spell->{message});
		3433
		3434	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3435	text => $spell->{name},
		3436	can_hover => 1,
		3437	can_events => 1,
		3438	tooltip => $spell->{message},
		3439	expand => 1);
		3440
		3441	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3442	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3443	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3444	expand => 1);
		3445
		3446	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3447	text => "bind to key",
		3448	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3449	}
		3450
		3451	sub rebuild_spell_list {
		3452	my ($self) = @_;
		3453	$self->{tbl_idx} = 0;
		3454	$self->add_spell ($_) for values %{$self->{spells}};
		3455	}
		3456
		3457	sub remove_spell {
		3458	my ($self, $spell) = @_;
		3459	delete $self->{spells}->{$spell->{name}};
		3460	$self->rebuild_spell_list;
		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