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.227 by root, Wed May 24 03:29:20 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) = @_;
…		…
144		156
145	$_->update	157	$_->update
146	for @widgets;	158	for @widgets;
147	}	159	}
148		160
		161	sub reconfigure_widgets {
		162	# make a copy, otherwise C<for> complains about freed values.
		163	my @widgets = values %WIDGET;
		164
		165	$_->reconfigure
		166	for @widgets;
		167	}
		168
149	# call when resolution changes etc.	169	# call when resolution changes etc.
150	sub rescale_widgets {	170	sub rescale_widgets {
151	my ($sx, $sy) = @_;	171	my ($sx, $sy) = @_;
152		172
153	# make a copy, otherwise for complains about freed values.
154	my @widgets = values %WIDGET;	173	for my $widget (values %WIDGET) {
155
156	for my $widget (@widgets) {
157	if ($widget->{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
158	$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.]+$/;
159	$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};
160	$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};
161	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
162	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};	181	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
163	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	182	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
164	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};	183	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
165	$widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h};	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
166	}	188	}
167
168	$widget->reconfigure;
169	}	189	}
		190
		191	reconfigure_widgets;
170	}	192	}
171		193
172	#############################################################################	194	#############################################################################
173		195
174	package CFClient::UI::Base;	196	package CFClient::UI::Base;
…		…
179		201
180	sub new {	202	sub new {
181	my $class = shift;	203	my $class = shift;
182		204
183	my $self = bless {	205	my $self = bless {
184	x => 0,	206	x => "center",
185	y => 0,	207	y => "center",
186	z => 0,	208	z => 0,
		209	w => undef,
		210	h => undef,
187	can_events => 1,	211	can_events => 1,
188	@_	212	@_
189	}, $class;	213	}, $class;
190		214
		215	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		216
191	for (keys %$self) {	217	for (keys %$self) {
192	if (/^connect_(.*)$/) {	218	if (/^on_(.*)$/) {
193	$self->connect ($1 => delete $self->{$_});	219	$self->connect ($1 => delete $self->{$_});
194	}	220	}
195	}	221	}
196		222
197	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	}
198		234
199	$self	235	$self
200	}	236	}
201		237
202	sub destroy {	238	sub destroy {
…		…
206	%$self = ();	242	%$self = ();
207	}	243	}
208		244
209	sub show {	245	sub show {
210	my ($self) = @_;	246	my ($self) = @_;
		247
211	return if $self->{parent};	248	return if $self->{parent};
212		249
213	$CFClient::UI::ROOT->add ($self);	250	$CFClient::UI::ROOT->add ($self);
214	}	251	}
215		252
216	sub show_centered {	253	sub set_visible {
217	my ($self) = @_;	254	my ($self) = @_;
		255
218	return if $self->{parent};	256	return if $self->{visible};
219		257
220	$self->show;	258	$self->{root} = $self->{parent}{root};
		259	$self->{visible} = $self->{parent}{visible} + 1;
221		260
222	$CFClient::UI::ROOT->on_post_alloc (	261	$self->emit (visibility_change => 1);
223	"centered $self" => sub {
224	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);
225	},
226	);
227	}
228		262
229	sub hide {	263	$self->realloc if !exists $self->{req_w};
		264
		265	$_->set_visible for $self->children;
		266	}
		267
		268	sub set_invisible {
230	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};
231		277
232	undef $GRAB if $GRAB == $self;	278	undef $GRAB if $GRAB == $self;
233	undef $HOVER if $HOVER == $self;	279	undef $HOVER if $HOVER == $self;
234		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
235	$self->{parent}->remove ($self)	311	$self->{parent}->remove ($self)
236	if $self->{parent};	312	if $self->{parent};
237	}	313	}
238		314
239	sub move {	315	sub move_abs {
240	my ($self, $x, $y, $z) = @_;	316	my ($self, $x, $y, $z) = @_;
241		317
242	$self->{x} = int $x;	318	$self->{x} = List::Util::max 0, int $x;
243	$self->{y} = int $y;	319	$self->{y} = List::Util::max 0, int $y;
244	$self->{z} = $z if defined $z;	320	$self->{z} = $z if defined $z;
245		321
246	$self->update;	322	$self->update;
247	}	323	}
248		324
249	sub set_size {	325	sub set_size {
250	my ($self, $w, $h) = @_;	326	my ($self, $w, $h) = @_;
251		327
252	$self->{user_w} = $w;	328	$self->{force_w} = $w;
253	$self->{user_h} = $h;	329	$self->{force_h} = $h;
254		330
255	$self->check_size;	331	$self->realloc;
256	}	332	}
257		333
258	sub size_request {	334	sub size_request {
259	require Carp;	335	require Carp;
260	Carp::confess "size_request is abstract";	336	Carp::confess "size_request is abstract";
…		…
262		338
263	sub configure {	339	sub configure {
264	my ($self, $x, $y, $w, $h) = @_;	340	my ($self, $x, $y, $w, $h) = @_;
265		341
266	if ($self->{aspect}) {	342	if ($self->{aspect}) {
		343	my ($ow, $oh) = ($w, $h);
		344
267	my $w2 = List::Util::min $w, int $h * $self->{aspect};	345	$w = List::Util::min $w, int $h * $self->{aspect};
268	my $h2 = List::Util::min $h, int $w / $self->{aspect};	346	$h = List::Util::min $h, int $w / $self->{aspect};
269		347
270	# use alignment to adjust x, y	348	# use alignment to adjust x, y
271		349
272	$x += int +($w - $w2) * 0.5;	350	$x += int 0.5 * ($ow - $w);
273	$y += int +($h - $h2) * 0.5;	351	$y += int 0.5 * ($oh - $h);
274
275	($w, $h) = ($w2, $h2);
276	}	352	}
277		353
278	if ($self->{x} != $x || $self->{y} != $y) {	354	if ($self->{x} ne $x || $self->{y} ne $y) {
279	$self->{x} = $x;	355	$self->{x} = $x;
280	$self->{y} = $y;	356	$self->{y} = $y;
281	$self->update;	357	$self->update;
282	}	358	}
283		359
284	if ($self->{w} != $w || $self->{h} != $h) {	360	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
285	$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;
286	}	367	}
287	}	368	}
288		369
289	sub size_allocate {	370	sub size_allocate {
290	# nothing to be done	371	# nothing to be done
291	}	372	}
292		373
293	sub reconfigure {
294	my ($self) = @_;
295
296	$self->check_size (1);
297	$self->update;
298	}
299
300	sub children {	374	sub children {
301	}	375	}
302		376
303	sub set_max_size {	377	sub set_max_size {
304	my ($self, $w, $h) = @_;	378	my ($self, $w, $h) = @_;
…		…
307	delete $self->{max_h}; $self->{max_h} = $h if $h;	381	delete $self->{max_h}; $self->{max_h} = $h if $h;
308	}	382	}
309		383
310	sub set_tooltip {	384	sub set_tooltip {
311	my ($self, $tooltip) = @_;	385	my ($self, $tooltip) = @_;
		386
		387	$tooltip =~ s/^\s+//;
		388	$tooltip =~ s/\s+$//;
		389
		390	return if $self->{tooltip} eq $tooltip;
312		391
313	$self->{tooltip} = $tooltip;	392	$self->{tooltip} = $tooltip;
314		393
315	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	394	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
316	delete $CFClient::UI::TOOLTIP->{owner};	395	delete $CFClient::UI::TOOLTIP->{owner};
…		…
338	return if $FOCUS == $self;	417	return if $FOCUS == $self;
339	return unless $self->{can_focus};	418	return unless $self->{can_focus};
340		419
341	my $focus = $FOCUS; $FOCUS = $self;	420	my $focus = $FOCUS; $FOCUS = $self;
342		421
343	$self->emit (focus_in => $focus);	422	$self->_emit (focus_in => $focus);
344		423
345	$focus->update if $focus;	424	$focus->update if $focus;
346	$FOCUS->update;	425	$FOCUS->update;
347	}	426	}
348		427
…		…
351		430
352	return unless $FOCUS == $self;	431	return unless $FOCUS == $self;
353		432
354	my $focus = $FOCUS; undef $FOCUS;	433	my $focus = $FOCUS; undef $FOCUS;
355		434
356	$self->emit (focus_out => $focus);	435	$self->_emit (focus_out => $focus);
357		436
358	$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;
359	}	441	}
360		442
361	sub mouse_motion { }	443	sub mouse_motion { }
362	sub button_up { }	444	sub button_up { }
363	sub key_down { }	445	sub key_down { }
364	sub key_up { }	446	sub key_up { }
365		447
366	sub button_down {	448	sub button_down {
367	my ($self, $ev, $x, $y) = @_;	449	my ($self, $ev, $x, $y) = @_;
368		450
369	$self->focus_in;	451	$self->focus_in;
…		…
372	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	454	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
373	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	455	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
374	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	456	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
375	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	457	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
376	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	}
377		529
378	sub draw {	530	sub draw {
379	my ($self) = @_;	531	my ($self) = @_;
380		532
381	return unless $self->{h} && $self->{w};	533	return unless $self->{h} && $self->{w};
…		…
398	glVertex $x , $y + $self->{h};	550	glVertex $x , $y + $self->{h};
399	glEnd;	551	glEnd;
400	glDisable GL_BLEND;	552	glDisable GL_BLEND;
401	}	553	}
402		554
403	if ($ENV{PCLIENT_DEBUG}) {	555	if ($ENV{CFPLUS_DEBUG} & 1) {
404	glPushMatrix;	556	glPushMatrix;
405	glColor 1, 1, 0, 1;	557	glColor 1, 1, 0, 1;
406	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	558	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
407	glBegin GL_LINE_LOOP;	559	glBegin GL_LINE_LOOP;
408	glVertex 0 , 0;	560	glVertex 0 , 0;
409	glVertex $self->{w}, 0;	561	glVertex $self->{w} - 1, 0;
410	glVertex $self->{w}, $self->{h};	562	glVertex $self->{w} - 1, $self->{h} - 1;
411	glVertex 0 , $self->{h};	563	glVertex 0 , $self->{h} - 1;
412	glEnd;	564	glEnd;
413	glPopMatrix;	565	glPopMatrix;
414	#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;
415	}	567	}
416	}	568	}
417		569
418	sub _draw {	570	sub _draw {
419	my ($self) = @_;	571	my ($self) = @_;
420		572
421	warn "no draw defined for $self\n";	573	warn "no draw defined for $self\n";
422	}
423
424	sub find_widget {
425	my ($self, $x, $y) = @_;
426
427	return () unless $self->{can_events};
428
429	return $self
430	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
431	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
432
433	()
434	}
435
436	sub set_parent {
437	my ($self, $parent) = @_;
438
439	Scalar::Util::weaken ($self->{parent} = $parent);
440
441	# TODO: req_w _does_change after ->reconfigure
442	$self->check_size
443	unless exists $self->{req_w};
444
445	$self->show;
446	}
447
448	sub check_size {
449	my ($self, $forced) = @_;
450
451	$self->{force_alloc} = 1 if $forced;
452	$CFClient::UI::ROOT->{check_size}{$self} = $self;
453	}
454
455	sub update {
456	my ($self) = @_;
457
458	$self->{parent}->update
459	if $self->{parent};
460	}
461
462	sub connect {
463	my ($self, $signal, $cb) = @_;
464
465	push @{ $self->{signal_cb}{$signal} }, $cb;
466	}
467
468	sub emit {
469	my ($self, $signal, @args) = @_;
470
471	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
472	}	574	}
473		575
474	sub DESTROY {	576	sub DESTROY {
475	my ($self) = @_;	577	my ($self) = @_;
476		578
…		…
534	my ($class, %arg) = @_;	636	my ($class, %arg) = @_;
535	$class->SUPER::new (can_events => 0, %arg);	637	$class->SUPER::new (can_events => 0, %arg);
536	}	638	}
537		639
538	sub size_request {	640	sub size_request {
539	(0, 0)	641	my ($self) = @_;
		642
		643	($self->{w} + 0, $self->{h} + 0)
540	}	644	}
541		645
542	sub draw { }	646	sub draw { }
543		647
544	#############################################################################	648	#############################################################################
…		…
573	$self->{children} = [	677	$self->{children} = [
574	sort { $a->{z} <=> $b->{z} }	678	sort { $a->{z} <=> $b->{z} }
575	@{$self->{children}}, @widgets	679	@{$self->{children}}, @widgets
576	];	680	];
577		681
578	$self->check_size (1);	682	$self->realloc;
579	$self->update;
580	}	683	}
581		684
582	sub children {	685	sub children {
583	@{ $_[0]{children} }	686	@{ $_[0]{children} }
584	}	687	}
…		…
589	delete $child->{parent};	692	delete $child->{parent};
590	$child->hide;	693	$child->hide;
591		694
592	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	695	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
593		696
594	$self->check_size;	697	$self->realloc;
595	$self->update;
596	}	698	}
597		699
598	sub clear {	700	sub clear {
599	my ($self) = @_;	701	my ($self) = @_;
600		702
…		…
604	for (@$children) {	706	for (@$children) {
605	delete $_->{parent};	707	delete $_->{parent};
606	$_->hide;	708	$_->hide;
607	}	709	}
608		710
609	$self->check_size;	711	$self->realloc;
610	$self->update;
611	}	712	}
612		713
613	sub find_widget {	714	sub find_widget {
614	my ($self, $x, $y) = @_;	715	my ($self, $x, $y) = @_;
615		716
…		…
739		840
740	package CFClient::UI::ViewPort;	841	package CFClient::UI::ViewPort;
741		842
742	our @ISA = CFClient::UI::Window::;	843	our @ISA = CFClient::UI::Window::;
743		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
744	sub size_request {	855	sub size_request {
745	my ($self) = @_;	856	my ($self) = @_;
746		857
747	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	858	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
748		859
749	@$self{qw(child_w child_h)}	860	$w = 10 if $self->{scroll_x};
		861	$h = 10 if $self->{scroll_y};
		862
		863	($w, $h)
750	}	864	}
751		865
752	sub size_allocate {	866	sub size_allocate {
753	my ($self, $w, $h) = @_;	867	my ($self, $w, $h) = @_;
754		868
755	my ($cw, $ch) = @$self{qw(child_w child_h)};	869	my $child = $self->child;
756	# $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
757	$self->child->configure (0, 0, $cw, $ch);	874	$self->child->configure (0, 0, $w, $h);
758	$self->update;	875	$self->update;
759	}	876	}
760		877
761	sub set_offset {	878	sub set_offset {
762	my ($self, $x, $y) = @_;	879	my ($self, $x, $y) = @_;
…		…
813	my $class = shift;	930	my $class = shift;
814		931
815	my $self;	932	my $self;
816		933
817	my $slider = new CFClient::UI::Slider	934	my $slider = new CFClient::UI::Slider
818	vertical => 1,	935	vertical => 1,
819	range => [0, 0, 1, 0.01], # HACK fix	936	range => [0, 0, 1, 0.01], # HACK fix
820	connect_changed => sub {	937	on_changed => sub {
821	$self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h}));	938	$self->{vp}->set_offset (0, $_[1]);
822	},	939	},
823	;	940	;
824		941
825	$self = $class->SUPER::new (	942	$self = $class->SUPER::new (
826	vp => (new CFClient::UI::ViewPort expand => 1),	943	vp => (new CFClient::UI::ViewPort expand => 1),
…		…
831	$self->{vp}->add ($self->{scrolled});	948	$self->{vp}->add ($self->{scrolled});
832	$self->add ($self->{vp});	949	$self->add ($self->{vp});
833	$self->add ($self->{slider});	950	$self->add ($self->{slider});
834		951
835	$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]);
		963	}
		964
		965	sub size_allocate {
		966	my ($self, $w, $h) = @_;
		967
		968	$self->SUPER::size_allocate ($w, $h);
		969
		970	my $child = $self->{vp}->child;
		971	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
836	}	972	}
837		973
838	#TODO# update range on size_allocate depending on child	974	#TODO# update range on size_allocate depending on child
839	# update viewport offset on scroll	975	# update viewport offset on scroll
840		976
…		…
884		1020
885	our @ISA = CFClient::UI::Bin::;	1021	our @ISA = CFClient::UI::Bin::;
886		1022
887	use CFClient::OpenGL;	1023	use CFClient::OpenGL;
888		1024
889	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 =
890	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
891	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1031	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
892		1032
893	sub new {	1033	sub new {
894	my $class = shift;	1034	my $class = shift;
895		1035
896	# TODO: user_x, user_y, overwrite moveto?
897
898	my $self = $class->SUPER::new (	1036	my $self = $class->SUPER::new (
899	bg => [1, 1, 1, 1],	1037	bg => [1, 1, 1, 1],
900	border_bg => [1, 1, 1, 1],	1038	border_bg => [1, 1, 1, 1],
901	border => 0.6,	1039	border => 0.6,
902	toplevel => 1,
903	can_events => 1,	1040	can_events => 1,
		1041	min_w => 16,
		1042	min_h => 16,
904	@_	1043	@_
905	);	1044	);
906		1045
907	$self->{title} &&= new CFClient::UI::Label	1046	$self->{title} &&= new CFClient::UI::Label
908	align => 0,	1047	align => 0,
…		…
961	my ($ev, $x, $y) = @_;	1100	my ($ev, $x, $y) = @_;
962		1101
963	my $dx = $ev->{x} - $ox;	1102	my $dx = $ev->{x} - $ox;
964	my $dy = $ev->{y} - $oy;	1103	my $dy = $ev->{y} - $oy;
965		1104
966	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
967	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1107
		1108	$self->realloc;
968	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
969	$self->check_size;
970	};	1110	};
971		1111
972	} elsif ($lr ^ $td) {	1112	} elsif ($lr ^ $td) {
973	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});
974	my ($bx, $by) = ($self->{x}, $self->{y});	1114	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
976	$self->{motion} = sub {	1116	$self->{motion} = sub {
977	my ($ev, $x, $y) = @_;	1117	my ($ev, $x, $y) = @_;
978		1118
979	($x, $y) = ($ev->{x}, $ev->{y});	1119	($x, $y) = ($ev->{x}, $ev->{y});
980		1120
981	$self->move ($bx + $x - $ox, $by + $y - $oy);	1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
982	$self->update;
983	};	1122	};
984	}	1123	}
985	}	1124	}
986		1125
987	sub button_up {	1126	sub button_up {
…		…
1006	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1007		1146
1008	my $border = $self->border;	1147	my $border = $self->border;
1009		1148
1010	glColor @{ $self->{border_bg} };	1149	glColor @{ $self->{border_bg} };
1011	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1150	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1012	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1151	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1013	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1152	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1014	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1153	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1015		1154
1016	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1155	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1017	my $bg = $tex[0];	1156	glColor @{ $self->{bg} };
1018		1157
1019	# TODO: repeat texture not scale	1158	# TODO: repeat texture not scale
		1159	# solve this better(?)
1020	my $rep_x = $cw / $bg->{w};	1160	$bg->{s} = $cw / $bg->{w};
1021	my $rep_y = $ch / $bg->{h};	1161	$bg->{t} = $ch / $bg->{h};
1022
1023	glColor @{ $self->{bg} };
1024
1025	$bg->{s} = $rep_x;
1026	$bg->{t} = $rep_y;
1027	$bg->{wrap_mode} = 1;
1028	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1029	}	1163	}
1030		1164
1031	glDisable GL_TEXTURE_2D;	1165	glDisable GL_TEXTURE_2D;
1032		1166
…		…
1048	sub new {	1182	sub new {
1049	my $class = shift;	1183	my $class = shift;
1050		1184
1051	$class->SUPER::new (	1185	$class->SUPER::new (
1052	col_expand => [],	1186	col_expand => [],
1053	@_	1187	@_,
1054	)	1188	)
		1189	}
		1190
		1191	sub children {
		1192	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1055	}	1193	}
1056		1194
1057	sub add {	1195	sub add {
1058	my ($self, $x, $y, $child) = @_;	1196	my ($self, $x, $y, $child) = @_;
1059		1197
1060	$child->set_parent ($self);	1198	$child->set_parent ($self);
1061	$self->{children}[$y][$x] = $child;	1199	$self->{children}[$y][$x] = $child;
1062		1200
1063	$child->check_size;	1201	$self->realloc;
1064	}	1202	}
1065		1203
1066	sub children {
1067	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1068	}
1069
1070	# 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?
1071	sub clear {	1205	sub clear {
1072	my ($self) = @_;	1206	my ($self) = @_;
1073		1207
1074	my @children = $self->children;	1208	my @children = $self->children;
1075	delete $self->{children};	1209	delete $self->{children};
…		…
1077	for (@children) {	1211	for (@children) {
1078	delete $_->{parent};	1212	delete $_->{parent};
1079	$_->hide;	1213	$_->hide;
1080	}	1214	}
1081		1215
1082	$self->update;	1216	$self->realloc;
1083	}	1217	}
1084		1218
1085	sub get_wh {	1219	sub get_wh {
1086	my ($self) = @_;	1220	my ($self) = @_;
1087		1221
…		…
1118	sub size_allocate {	1252	sub size_allocate {
1119	my ($self, $w, $h) = @_;	1253	my ($self, $w, $h) = @_;
1120		1254
1121	my ($ws, $hs) = $self->get_wh;	1255	my ($ws, $hs) = $self->get_wh;
1122		1256
1123	my $req_w = sum @$ws;	1257	my $req_w = (sum @$ws) || 1;
1124	my $req_h = sum @$hs;	1258	my $req_h = (sum @$hs) || 1;
1125		1259
1126	# TODO: nicer code && do row_expand	1260	# TODO: nicer code && do row_expand
1127	my @col_expand = @{$self->{col_expand}};	1261	my @col_expand = @{$self->{col_expand}};
1128	@col_expand = (1) x @$ws unless @col_expand;	1262	@col_expand = (1) x @$ws unless @col_expand;
1129	my $col_expand = (sum @col_expand) || 1;	1263	my $col_expand = (sum @col_expand) || 1;
…		…
1183	}	1317	}
1184	}	1318	}
1185		1319
1186	#############################################################################	1320	#############################################################################
1187		1321
1188	package CFClient::UI::HBox;	1322	package CFClient::UI::Box;
1189
1190	# TODO: wrap into common Box base class
1191		1323
1192	our @ISA = CFClient::UI::Container::;	1324	our @ISA = CFClient::UI::Container::;
1193		1325
1194	sub size_request {	1326	sub size_request {
1195	my ($self) = @_;	1327	my ($self) = @_;
1196		1328
1197	my @alloc = map [$_->size_request], @{$self->{children}};	1329	$self->{vertical}
1198		1330	? (
1199	(	1331	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1200	(List::Util::sum map $_->[0], @alloc),	1332	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1201	(List::Util::max map $_->[1], @alloc),	1333	)
1202	)	1334	: (
		1335	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1336	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1337	)
1203	}	1338	}
1204		1339
1205	sub size_allocate {	1340	sub size_allocate {
1206	my ($self, $w, $h) = @_;	1341	my ($self, $w, $h) = @_;
1207		1342
1208	($h, $w) = ($w, $h);	1343	my $space = $self->{vertical} ? $h : $w;
1209
1210	my $children = $self->{children};	1344	my $children = $self->{children};
1211		1345
1212	my @h = map $_->{req_w}, @$children;	1346	my @req;
1213		1347
1214	my $req_h = List::Util::sum @h;	1348	if ($self->{homogeneous}) {
1215		1349	@req = ($space / (@$children || 1)) x @$children;
1216	if ($req_h > $h) {
1217	# ah well, not enough space
1218	$_ *= $h / $req_h for @h;
1219	} else {	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 {
1220	my $exp = List::Util::sum map $_->{expand}, @$children;	1358	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1221	$exp ||= 1;
1222		1359
		1360	$space = ($space - $req) / $expand; # remaining space to give away
		1361
		1362	$req[$_] += $space * $children->[$_]{expand}
1223	for (0 .. $#$children) {	1363	for 0 .. $#$children;
1224	my $child = $children->[$_];
1225
1226	my $alloc_h = $h[$_];
1227	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1228	$h[$_] = $alloc_h;
1229	}	1364	}
1230	}	1365	}
1231		1366
1232	CFClient::UI::harmonize \@h;	1367	CFClient::UI::harmonize \@req;
1233		1368
1234	my $y = 0;	1369	my $pos = 0;
1235	for (0 .. $#$children) {	1370	for (0 .. $#$children) {
1236	my $child = $children->[$_];
1237	my $h = $h[$_];	1371	my $alloc = $req[$_];
1238	$child->configure ($y, 0, $h, $w);	1372	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1239		1373
1240	$y += $h;	1374	$pos += $alloc;
1241	}	1375	}
1242		1376
1243	1	1377	1
1244	}	1378	}
1245		1379
1246	#############################################################################	1380	#############################################################################
1247		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
1248	package CFClient::UI::VBox;	1397	package CFClient::UI::VBox;
1249		1398
1250	# TODO: wrap into common Box base class
1251
1252	our @ISA = CFClient::UI::Container::;	1399	our @ISA = CFClient::UI::Box::;
1253		1400
1254	sub size_request {	1401	sub new {
1255	my ($self) = @_;	1402	my $class = shift;
1256		1403
1257	my @alloc = map [$_->size_request], @{$self->{children}};	1404	$class->SUPER::new (
1258		1405	vertical => 1,
1259	(	1406	@_,
1260	(List::Util::max map $_->[0], @alloc),
1261	(List::Util::sum map $_->[1], @alloc),
1262	)	1407	)
1263	}
1264
1265	sub size_allocate {
1266	my ($self, $w, $h) = @_;
1267
1268	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1269
1270	my $children = $self->{children};
1271
1272	my @h = map $_->{req_h}, @$children;
1273
1274	my $req_h = List::Util::sum @h;
1275
1276	if ($req_h > $h) {
1277	# ah well, not enough space
1278	$_ *= $h / $req_h for @h;
1279	} else {
1280	my $exp = List::Util::sum map $_->{expand}, @$children;
1281	$exp ||= 1;
1282
1283	for (0 .. $#$children) {
1284	my $child = $children->[$_];
1285
1286	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1287	}
1288	}
1289
1290	CFClient::UI::harmonize \@h;
1291
1292	my $y = 0;
1293	for (0 .. $#$children) {
1294	my $child = $children->[$_];
1295	my $h = $h[$_];
1296	$child->configure (0, $y, $w, $h);
1297
1298	$y += $h;
1299	}
1300
1301	1
1302	}	1408	}
1303		1409
1304	#############################################################################	1410	#############################################################################
1305		1411
1306	package CFClient::UI::Label;	1412	package CFClient::UI::Label;
…		…
1323	ellipsise => 3, # end	1429	ellipsise => 3, # end
1324	layout => (new CFClient::Layout),	1430	layout => (new CFClient::Layout),
1325	fontsize => 1,	1431	fontsize => 1,
1326	align => -1,	1432	align => -1,
1327	valign => -1,	1433	valign => -1,
1328	padding => 2,	1434	padding_x => 2,
		1435	padding_y => 2,
1329	can_events => 0,	1436	can_events => 0,
1330	%arg	1437	%arg
1331	);	1438	);
1332		1439
1333	if (exists $self->{template}) {	1440	if (exists $self->{template}) {
…		…
1369	$self->{text} = "T$text";	1476	$self->{text} = "T$text";
1370		1477
1371	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1372	$self->{layout}->set_text ($text);	1479	$self->{layout}->set_text ($text);
1373		1480
		1481	$self->realloc;
1374	$self->update;	1482	$self->update;
1375	$self->check_size;
1376	}	1483	}
1377		1484
1378	sub set_markup {	1485	sub set_markup {
1379	my ($self, $markup) = @_;	1486	my ($self, $markup) = @_;
1380		1487
…		…
1384	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1491	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1385		1492
1386	$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;
1387	$self->{layout}->set_markup ($markup);	1494	$self->{layout}->set_markup ($markup);
1388		1495
		1496	$self->realloc;
1389	$self->update;	1497	$self->update;
1390	$self->check_size;
1391	}	1498	}
1392		1499
1393	sub size_request {	1500	sub size_request {
1394	my ($self) = @_;	1501	my ($self) = @_;
1395		1502
…		…
1409		1516
1410	$w = List::Util::max $w, $w2;	1517	$w = List::Util::max $w, $w2;
1411	$h = List::Util::max $h, $h2;	1518	$h = List::Util::max $h, $h2;
1412	}	1519	}
1413		1520
1414	(	1521	($w, $h)
1415	$w + $self->{padding} * 2,
1416	$h + $self->{padding} * 2,
1417	)
1418	}	1522	}
1419		1523
1420	sub size_allocate {	1524	sub size_allocate {
1421	my ($self, $w, $h) = @_;	1525	my ($self, $w, $h) = @_;
1422		1526
…		…
1427	my ($self, $fontsize) = @_;	1531	my ($self, $fontsize) = @_;
1428		1532
1429	$self->{fontsize} = $fontsize;	1533	$self->{fontsize} = $fontsize;
1430	delete $self->{texture};	1534	delete $self->{texture};
1431		1535
1432	$self->update;	1536	$self->realloc;
1433	$self->check_size;
1434	}	1537	}
1435		1538
1436	sub _draw {	1539	sub _draw {
1437	my ($self) = @_;	1540	my ($self) = @_;
1438		1541
…		…
1446	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1447	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1448		1551
1449	my $tex = new_from_layout CFClient::Texture $self->{layout};	1552	my $tex = new_from_layout CFClient::Texture $self->{layout};
1450		1553
1451	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1452	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1453	: ($self->{w} - $tex->{w}) * 0.5);	1556	: ($self->{w} - $tex->{w}) * 0.5);
1454		1557
1455	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1456	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1457	: ($self->{h} - $tex->{h}) * 0.5);	1560	: ($self->{h} - $tex->{h}) * 0.5);
1458		1561
1459	$tex	1562	$tex
1460	};	1563	};
1461		1564
…		…
1510	$self->{text} = $text;	1613	$self->{text} = $text;
1511		1614
1512	$text =~ s/./*/g if $self->{hidden};	1615	$text =~ s/./*/g if $self->{hidden};
1513	$self->{layout}->set_text ("$text ");	1616	$self->{layout}->set_text ("$text ");
1514		1617
1515	$self->emit (changed => $self->{text});	1618	$self->_emit (changed => $self->{text});
1516	}	1619	}
1517		1620
1518	sub set_text {	1621	sub set_text {
1519	my ($self, $text) = @_;	1622	my ($self, $text) = @_;
1520		1623
1521	$self->{cursor} = length $text;	1624	$self->{cursor} = length $text;
1522	$self->_set_text ($text);	1625	$self->_set_text ($text);
1523	$self->update;	1626
1524	$self->check_size;	1627	$self->realloc;
1525	}	1628	}
1526		1629
1527	sub get_text {	1630	sub get_text {
1528	$_[0]{text}	1631	$_[0]{text}
1529	}	1632	}
…		…
1532	my ($self) = @_;	1635	my ($self) = @_;
1533		1636
1534	my ($w, $h) = $self->SUPER::size_request;	1637	my ($w, $h) = $self->SUPER::size_request;
1535		1638
1536	($w + 1, $h) # add 1 for cursor	1639	($w + 1, $h) # add 1 for cursor
1537	}
1538
1539	sub size_allocate {
1540	my ($self, $w, $h) = @_;
1541
1542	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1543	}	1640	}
1544		1641
1545	sub key_down {	1642	sub key_down {
1546	my ($self, $ev) = @_;	1643	my ($self, $ev) = @_;
1547		1644
…		…
1562	} elsif ($sym == CFClient::SDLK_HOME) {	1659	} elsif ($sym == CFClient::SDLK_HOME) {
1563	$self->{cursor} = 0;	1660	$self->{cursor} = 0;
1564	} elsif ($sym == CFClient::SDLK_END) {	1661	} elsif ($sym == CFClient::SDLK_END) {
1565	$self->{cursor} = length $text;	1662	$self->{cursor} = length $text;
1566	} elsif ($uni == 27) {	1663	} elsif ($uni == 27) {
1567	$self->emit ('escape');	1664	$self->_emit ('escape');
1568	} elsif ($uni) {	1665	} elsif ($uni) {
1569	substr $text, $self->{cursor}++, 0, chr $uni;	1666	substr $text, $self->{cursor}++, 0, chr $uni;
1570	}	1667	}
1571		1668
1572	$self->_set_text ($text);	1669	$self->_set_text ($text);
1573	$self->update;	1670
1574	$self->check_size;	1671	$self->realloc;
1575	}	1672	}
1576		1673
1577	sub focus_in {	1674	sub focus_in {
1578	my ($self) = @_;	1675	my ($self) = @_;
1579		1676
…		…
1659	if ($sym == 13) {	1756	if ($sym == 13) {
1660	unshift @{$self->{history}},	1757	unshift @{$self->{history}},
1661	my $txt = $self->get_text;	1758	my $txt = $self->get_text;
1662	$self->{history_pointer} = -1;	1759	$self->{history_pointer} = -1;
1663	$self->{history_saveback} = '';	1760	$self->{history_saveback} = '';
1664	$self->emit (activate => $txt);	1761	$self->_emit (activate => $txt);
1665	$self->update;	1762	$self->update;
1666		1763
1667	} elsif ($sym == CFClient::SDLK_UP) {	1764	} elsif ($sym == CFClient::SDLK_UP) {
1668	if ($self->{history_pointer} < 0) {	1765	if ($self->{history_pointer} < 0) {
1669	$self->{history_saveback} = $self->get_text;	1766	$self->{history_saveback} = $self->get_text;
…		…
1706		1803
1707	sub new {	1804	sub new {
1708	my $class = shift;	1805	my $class = shift;
1709		1806
1710	$class->SUPER::new (	1807	$class->SUPER::new (
1711	padding => 4,	1808	padding_x => 4,
		1809	padding_y => 4,
1712	fg => [1, 1, 1],	1810	fg => [1, 1, 1],
1713	active_fg => [0, 0, 1],	1811	active_fg => [0, 0, 1],
1714	can_hover => 1,	1812	can_hover => 1,
1715	align => 0,	1813	align => 0,
1716	valign => 0,	1814	valign => 0,
1717	can_events => 1,	1815	can_events => 1,
1718	@_	1816	@_
1719	)	1817	)
1720	}	1818	}
1721		1819
		1820	sub activate { }
		1821
1722	sub button_up {	1822	sub button_up {
1723	my ($self, $ev, $x, $y) = @_;	1823	my ($self, $ev, $x, $y) = @_;
1724		1824
		1825	$self->emit ("activate")
1725	if ($x >= 0 && $x < $self->{w}	1826	if $x >= 0 && $x < $self->{w}
1726	&& $y >= 0 && $y < $self->{h}) {	1827	&& $y >= 0 && $y < $self->{h};
1727	$self->emit ("activate");
1728	}
1729	}	1828	}
1730		1829
1731	sub _draw {	1830	sub _draw {
1732	my ($self) = @_;	1831	my ($self) = @_;
1733		1832
…		…
1762		1861
1763	sub new {	1862	sub new {
1764	my $class = shift;	1863	my $class = shift;
1765		1864
1766	$class->SUPER::new (	1865	$class->SUPER::new (
1767	padding => 2,	1866	padding_x => 2,
		1867	padding_y => 2,
1768	fg => [1, 1, 1],	1868	fg => [1, 1, 1],
1769	active_fg => [1, 1, 0],	1869	active_fg => [1, 1, 0],
1770	bg => [0, 0, 0, 0.2],	1870	bg => [0, 0, 0, 0.2],
1771	active_bg => [1, 1, 1, 0.5],	1871	active_bg => [1, 1, 1, 0.5],
1772	state => 0,	1872	state => 0,
…		…
1776	}	1876	}
1777		1877
1778	sub size_request {	1878	sub size_request {
1779	my ($self) = @_;	1879	my ($self) = @_;
1780		1880
1781	($self->{padding} * 2 + 6) x 2	1881	(6) x 2
1782	}	1882	}
1783		1883
1784	sub button_down {	1884	sub button_down {
1785	my ($self, $ev, $x, $y) = @_;	1885	my ($self, $ev, $x, $y) = @_;
1786		1886
1787	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1788	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1789	$self->{state} = !$self->{state};	1889	$self->{state} = !$self->{state};
1790	$self->emit (changed => $self->{state});	1890	$self->_emit (changed => $self->{state});
1791	}	1891	}
1792	}	1892	}
1793		1893
1794	sub _draw {	1894	sub _draw {
1795	my ($self) = @_;	1895	my ($self) = @_;
1796		1896
1797	$self->SUPER::_draw;	1897	$self->SUPER::_draw;
1798		1898
1799	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1899	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1800		1900
1801	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;
1802		1904
1803	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1905	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1804		1906
1805	my $tex = $self->{state} ? $tex[1] : $tex[0];	1907	my $tex = $self->{state} ? $tex[1] : $tex[0];
1806		1908
…		…
2071	fg => [1, 1, 1],	2173	fg => [1, 1, 1],
2072	active_fg => [0, 0, 0],	2174	active_fg => [0, 0, 0],
2073	bg => [0, 0, 0, 0.2],	2175	bg => [0, 0, 0, 0.2],
2074	active_bg => [1, 1, 1, 0.5],	2176	active_bg => [1, 1, 1, 0.5],
2075	range => [0, 0, 100, 10, 0],	2177	range => [0, 0, 100, 10, 0],
2076	req_w => $::WIDTH / 80,	2178	min_w => $::WIDTH / 80,
2077	req_h => $::WIDTH / 80,	2179	min_h => $::WIDTH / 80,
2078	vertical => 0,	2180	vertical => 0,
2079	can_hover => 1,	2181	can_hover => 1,
2080	inner_pad => 0.02,	2182	inner_pad => 0.02,
2081	@_	2183	@_
2082	);	2184	);
…		…
2085	$self->update;	2187	$self->update;
2086		2188
2087	$self	2189	$self
2088	}	2190	}
2089		2191
		2192	sub changed { }
		2193
2090	sub set_range {	2194	sub set_range {
2091	my ($self, $range) = @_;	2195	my ($self, $range) = @_;
2092		2196
2093	$self->{range} = $range;	2197	($range, $self->{range}) = ($self->{range}, $range);
2094		2198
2095	$self->update;	2199	$self->update
		2200	if "@$range" ne "@{$self->{range}}";
2096	}	2201	}
2097		2202
2098	sub set_value {	2203	sub set_value {
2099	my ($self, $value) = @_;	2204	my ($self, $value) = @_;
2100		2205
…		…
2111	if $unit;	2216	if $unit;
2112		2217
2113	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2218	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2114		2219
2115	if ($value != $old_value) {	2220	if ($value != $old_value) {
2116	$self->emit (changed => $value);	2221	$self->_emit (changed => $value);
2117	$self->update;	2222	$self->update;
2118	}	2223	}
2119	}	2224	}
2120		2225
2121	sub size_request {	2226	sub size_request {
2122	my ($self) = @_;	2227	my ($self) = @_;
2123		2228
2124	my $w = $self->{req_w};	2229	($self->{req_w}, $self->{req_h})
2125	my $h = $self->{req_h};
2126
2127	$self->{vertical} ? ($h, $w) : ($w, $h)
2128	}	2230	}
2129		2231
2130	sub button_down {	2232	sub button_down {
2131	my ($self, $ev, $x, $y) = @_;	2233	my ($self, $ev, $x, $y) = @_;
2132		2234
…		…
2293	$self->{layout}->set_width ($self->{children}[0]{w});	2395	$self->{layout}->set_width ($self->{children}[0]{w});
2294		2396
2295	$self->reflow;	2397	$self->reflow;
2296	}	2398	}
2297		2399
2298	sub text_height {	2400	sub text_size {
2299	my ($self, $text, $indent) = @_;	2401	my ($self, $text, $indent) = @_;
2300		2402
2301	my $layout = $self->{layout};	2403	my $layout = $self->{layout};
2302		2404
2303	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2405	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2304	$layout->set_width ($self->{children}[0]{w} - $indent);	2406	$layout->set_width ($self->{children}[0]{w} - $indent);
2305	$layout->set_markup ($text);	2407	$layout->set_markup ($text);
2306		2408
2307	($layout->size)[1]	2409	$layout->size
2308	}	2410	}
2309		2411
2310	sub reflow {	2412	sub reflow {
2311	my ($self) = @_;	2413	my ($self) = @_;
2312		2414
…		…
2331		2433
2332	sub add_paragraph {	2434	sub add_paragraph {
2333	my ($self, $color, $text, $indent) = @_;	2435	my ($self, $color, $text, $indent) = @_;
2334		2436
2335	for my $line (split /\n/, $text) {	2437	for my $line (split /\n/, $text) {
2336	my $height = $self->text_height ($line);	2438	my ($w, $h) = $self->text_size ($line);
2337	$self->{height} += $height;	2439	$self->{height} += $h;
2338	push @{$self->{par}}, [$height, $color, $indent, $line];	2440	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
2339	}	2441	}
2340		2442
2341	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	2443	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2342	}	2444	}
2343		2445
…		…
2349	return unless $self->{h} > 0;	2451	return unless $self->{h} > 0;
2350		2452
2351	delete $self->{texture};	2453	delete $self->{texture};
2352		2454
2353	$ROOT->on_post_alloc ($self, sub {	2455	$ROOT->on_post_alloc ($self, sub {
		2456	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2457
2354	if (delete $self->{need_reflow}) {	2458	if (delete $self->{need_reflow}) {
2355	my $height = 0;	2459	my $height = 0;
2356		2460
2357	$height += $_->[0] = $self->text_height ($_->[3], $_->[2])	2461	my $layout = $self->{layout};
		2462
		2463	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2464
2358	for @{$self->{par}};	2465	for (@{$self->{par}}) {
		2466	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
		2467	$layout->set_width ($W - $_->[3]);
		2468	$layout->set_markup ($_->[4]);
		2469	my ($w, $h) = $layout->size;
		2470	$_->[0] = $w + $_->[3];
		2471	$_->[1] = $h;
		2472	}
		2473
		2474	$height += $_->[1];
		2475	}
2359		2476
2360	$self->{height} = $height;	2477	$self->{height} = $height;
2361		2478
2362	$self->{children}[1]->set_range ([$height, 0, $height, $self->{h}, 1]);	2479	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2363		2480
2364	delete $self->{texture};	2481	delete $self->{texture};
2365	}	2482	}
2366		2483
2367	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {	2484	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2368	glClearColor 0.5, 0.5, 0.5, 0;	2485	glClearColor 0.5, 0.5, 0.5, 0;
2369	glClear GL_COLOR_BUFFER_BIT;	2486	glClear GL_COLOR_BUFFER_BIT;
2370		2487
2371	my $top = int $self->{children}[1]{range}[0];	2488	my $top = int $self->{children}[1]{range}[0];
2372		2489
2373	my $y0 = $top;	2490	my $y0 = $top;
2374	my $y1 = $top + $self->{h};	2491	my $y1 = $top + $H;
2375		2492
2376	my $y = 0;	2493	my $y = 0;
2377		2494
2378	my $layout = $self->{layout};	2495	my $layout = $self->{layout};
2379		2496
2380	$layout->set_font ($self->{font}) if $self->{font};	2497	$layout->set_font ($self->{font}) if $self->{font};
2381		2498
2382	glEnable GL_BLEND;	2499	glEnable GL_BLEND;
		2500	#TODO# not correct in windows where rgba is forced off
2383	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2501	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2384		2502
2385	for my $par (@{$self->{par}}) {	2503	for my $par (@{$self->{par}}) {
2386	my $h = $par->[0];	2504	my $h = $par->[1];
2387		2505
2388	if ($y0 < $y + $h && $y < $y1) {	2506	if ($y0 < $y + $h && $y < $y1) {
2389	$layout->set_foreground (@{ $par->[1] });	2507	$layout->set_foreground (@{ $par->[2] });
2390	$layout->set_width ($self->{w} - $par->[2]);	2508	$layout->set_width ($W - $par->[3]);
2391	$layout->set_markup ($par->[3]);	2509	$layout->set_markup ($par->[4]);
2392		2510
2393	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2511	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2394		2512
2395	glRasterPos $par->[2], $y - $y0;	2513	glRasterPos $par->[3], $y - $y0;
2396	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	2514	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2397	}	2515	}
2398		2516
2399	$y += $h;	2517	$y += $h;
2400	}	2518	}
…		…
2467		2585
2468	sub new {	2586	sub new {
2469	my $class = shift;	2587	my $class = shift;
2470		2588
2471	my $self = $class->SUPER::new (	2589	my $self = $class->SUPER::new (
2472	state => 0,	2590	state => 0,
2473	connect_activate => \&toggle_flopper,	2591	on_activate => \&toggle_flopper,
2474	@_	2592	@_
2475	);	2593	);
2476		2594
2477	if ($self->{state}) {
2478	$self->{state} = 0;
2479	$self->toggle_flopper;
2480	}
2481
2482	$self	2595	$self
2483	}	2596	}
2484		2597
2485	sub toggle_flopper {	2598	sub toggle_flopper {
2486	my ($self) = @_;	2599	my ($self) = @_;
2487		2600
2488	# TODO: use animation	2601	$self->{other}->toggle_visibility;
2489	if ($self->{state} = !$self->{state}) {
2490	$CFClient::UI::ROOT->add ($self->{other});
2491	$self->{other}->move ($self->coord2global (0, $self->{h}));
2492	$self->emit ("open");
2493	} else {
2494	$CFClient::UI::ROOT->remove ($self->{other});
2495	$self->emit ("close");
2496	}
2497
2498	$self->emit (changed => $self->{state});
2499	}	2602	}
2500		2603
2501	#############################################################################	2604	#############################################################################
2502		2605
2503	package CFClient::UI::Tooltip;	2606	package CFClient::UI::Tooltip;
…		…
2516	}	2619	}
2517		2620
2518	sub set_tooltip_from {	2621	sub set_tooltip_from {
2519	my ($self, $widget) = @_;	2622	my ($self, $widget) = @_;
2520		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
2521	$self->add (new CFClient::UI::Label	2633	$self->add (new CFClient::UI::Label
2522	markup => $widget->{tooltip},	2634	markup => $tooltip,
2523	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2635	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2524	fontsize => 0.8,	2636	fontsize => 0.8,
2525	fg => [0, 0, 0, 1],	2637	fg => [0, 0, 0, 1],
2526	ellipsise => 0,	2638	ellipsise => 0,
2527	font => ($widget->{tooltip_font} || $::FONT_PROP),	2639	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2538		2650
2539	sub size_allocate {	2651	sub size_allocate {
2540	my ($self, $w, $h) = @_;	2652	my ($self, $w, $h) = @_;
2541		2653
2542	$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	});
2543	}	2673	}
2544		2674
2545	sub _draw {	2675	sub _draw {
2546	my ($self) = @_;	2676	my ($self) = @_;
2547		2677
…		…
2564	glVertex $w, $h;	2694	glVertex $w, $h;
2565	glVertex $w, 0;	2695	glVertex $w, 0;
2566	glEnd;	2696	glEnd;
2567		2697
2568	glTranslate 2 - 0.375, 2 - 0.375;	2698	glTranslate 2 - 0.375, 2 - 0.375;
		2699
2569	$self->SUPER::_draw;	2700	$self->SUPER::_draw;
2570	}	2701	}
2571		2702
2572	#############################################################################	2703	#############################################################################
2573		2704
…		…
2579		2710
2580	sub new {	2711	sub new {
2581	my $class = shift;	2712	my $class = shift;
2582		2713
2583	my $self = $class->SUPER::new (	2714	my $self = $class->SUPER::new (
2584	aspect => 1,	2715	aspect => 1,
		2716	can_events => 0,
2585	@_,	2717	@_,
2586	);	2718	);
2587		2719
2588	if ($self->{anim} && $self->{animspeed}) {	2720	if ($self->{anim} && $self->{animspeed}) {
2589	Scalar::Util::weaken (my $widget = $self);	2721	Scalar::Util::weaken (my $widget = $self);
…		…
2648	$self->SUPER::DESTROY;	2780	$self->SUPER::DESTROY;
2649	}	2781	}
2650		2782
2651	#############################################################################	2783	#############################################################################
2652		2784
2653	package CFClient::UI::InventoryItem;	2785	package CFClient::UI::Inventory;
2654		2786
2655	our @ISA = CFClient::UI::HBox::;	2787	our @ISA = CFClient::UI::ScrolledWindow::;
2656
2657	sub _item_to_desc {
2658	my ($item) = @_;
2659
2660	my $desc =
2661	$item->{nrof} < 2
2662	? $item->{name}
2663	: "$item->{nrof} × $item->{name_pl}";
2664
2665	$item->{flags} & Crossfire::Protocol::F_OPEN
2666	and $desc .= " (open)";
2667	$item->{flags} & Crossfire::Protocol::F_APPLIED
2668	and $desc .= " (applied)";
2669	$item->{flags} & Crossfire::Protocol::F_UNPAID
2670	and $desc .= " (unpaid)";
2671	$item->{flags} & Crossfire::Protocol::F_MAGIC
2672	and $desc .= " (magic)";
2673	$item->{flags} & Crossfire::Protocol::F_CURSED
2674	and $desc .= " (cursed)";
2675	$item->{flags} & Crossfire::Protocol::F_DAMNED
2676	and $desc .= " (damned)";
2677	$item->{flags} & Crossfire::Protocol::F_LOCKED
2678	and $desc .= " *";
2679
2680	$desc
2681	}
2682		2788
2683	sub new {	2789	sub new {
2684	my $class = shift;	2790	my $class = shift;
2685		2791
2686	my %args = @_;
2687
2688	my $item = delete $args{item};
2689
2690	my $desc = _item_to_desc ($item);
2691
2692	my $self = $class->SUPER::new (	2792	my $self = $class->SUPER::new (
2693	can_hover => 1,
2694	can_events => 1,
2695	tooltip => ((CFClient::UI::Label::escape $desc)
2696	. "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2697	connect_button_down => sub {
2698	my ($self, $ev, $x, $y) = @_;
2699
2700	# todo: maybe put examine on 1? but should just be a tooltip :(
2701	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2702	my $targ = $::CONN->{player}{tag};
2703
2704	if ($item->{container} == $::CONN->{player}{tag}) {
2705	$targ = $main::OPENCONT;
2706	}
2707
2708	$::CONN->send ("move $targ $item->{tag} 0");
2709	} elsif ($ev->{button} == 1) {
2710	$::CONN->send ("examine $item->{tag}");
2711	} elsif ($ev->{button} == 2) {
2712	$::CONN->send ("apply $item->{tag}");
2713	} elsif ($ev->{button} == 3) {
2714	my @menu_items = (
2715	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2716	["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2717	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2718	(
2719	$item->{flags} & Crossfire::Protocol::F_LOCKED
2720	? (
2721	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2722	)
2723	: (
2724	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2725	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2726	)
2727	),
2728	);
2729
2730	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2731	}
2732
2733	1
2734	},
2735	%args
2736	);
2737
2738
2739	$self->add (new CFClient::UI::Face
2740	can_events => 0,
2741	face => $item->{face},
2742	anim => $item->{anim},
2743	animspeed => $item->{animspeed},
2744	);
2745
2746	$self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2747
2748	$self->{item} = $item;
2749
2750	$self->update_item;
2751
2752	$self
2753	}
2754
2755	sub update_item {
2756	my ($self) = @_;
2757
2758	my $desc = _item_to_desc ($self->{item});
2759
2760	$self->{name_lbl}->set_text ($desc);
2761	}
2762
2763	#############################################################################
2764
2765	package CFClient::UI::Inventory;
2766
2767	our @ISA = CFClient::UI::ScrolledWindow::;
2768
2769	sub new {
2770	my $class = shift;
2771
2772	my $self = $class->SUPER::new (
2773	scrolled => (new CFClient::UI::Table),	2793	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2774	@_,	2794	@_,
2775	);	2795	);
2776		2796
2777	$self	2797	$self
2778	}	2798	}
…		…
2788	or ($a->{name} cmp $b->{name})	2808	or ($a->{name} cmp $b->{name})
2789	} @$items;	2809	} @$items;
2790		2810
2791	$self->{real_items} = \@items;	2811	$self->{real_items} = \@items;
2792		2812
		2813	my $row = 0;
2793	for my $item (@items) {	2814	for my $item (@items) {
2794	$item->{item} = $item;	2815	CFClient::Item::update_widgets $item;
2795	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2796	$item->update_item ();
2797	}
2798		2816
2799	my $i = 0;	2817	$self->{scrolled}->add (0, $row, $item->{face_widget});
2800	for (@items) {	2818	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2801	$self->{scrolled}->add (0, $i, $_);	2819	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2802	my $nrof = $_->{item}->{nrof} || 1;
2803	$self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2804	}
2805		2820
2806	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];	2821	$row++;
2807	}	2822	}
2808
2809	sub size_request {
2810	my ($self) = @_;
2811	($self->{req_w}, $self->{req_h});
2812	}	2823	}
2813		2824
2814	#############################################################################	2825	#############################################################################
2815		2826
2816	package CFClient::UI::Menu;	2827	package CFClient::UI::Menu;
…		…
2851		2862
2852	# 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)
2853	sub popup {	2864	sub popup {
2854	my ($self, $ev) = @_;	2865	my ($self, $ev) = @_;
2855		2866
2856	$self->emit ("popdown");	2867	$self->_emit ("popdown");
2857		2868
2858	# maybe save $GRAB? must be careful about events...	2869	# maybe save $GRAB? must be careful about events...
2859	$GRAB = $self;	2870	$GRAB = $self;
2860	$self->{button} = $ev->{button};	2871	$self->{button} = $ev->{button};
2861		2872
2862	$self->show;	2873	$self->show;
2863	$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);
2864	}	2875	}
2865		2876
2866	sub mouse_motion {	2877	sub mouse_motion {
2867	my ($self, $ev, $x, $y) = @_;	2878	my ($self, $ev, $x, $y) = @_;
2868		2879
…		…
2876		2887
2877	if ($ev->{button} == $self->{button}) {	2888	if ($ev->{button} == $self->{button}) {
2878	undef $GRAB;	2889	undef $GRAB;
2879	$self->hide;	2890	$self->hide;
2880		2891
2881	$self->emit ("popdown");	2892	$self->_emit ("popdown");
2882	$self->{hover}[1]->() if $self->{hover};	2893	$self->{hover}[1]->() if $self->{hover};
2883	}	2894	}
2884	}	2895	}
2885		2896
2886	#############################################################################	2897	#############################################################################
…		…
2948	sub add {	2959	sub add {
2949	my ($self, $text, %arg) = @_;	2960	my ($self, $text, %arg) = @_;
2950		2961
2951	$text =~ s/^\s+//;	2962	$text =~ s/^\s+//;
2952	$text =~ s/\s+$//;	2963	$text =~ s/\s+$//;
		2964
		2965	return unless $text;
2953		2966
2954	my $timeout = time + ((delete $arg{timeout}) || 60);	2967	my $timeout = time + ((delete $arg{timeout}) || 60);
2955		2968
2956	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	2969	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2957		2970
…		…
3000	use CFClient::OpenGL;	3013	use CFClient::OpenGL;
3001		3014
3002	sub new {	3015	sub new {
3003	my $class = shift;	3016	my $class = shift;
3004		3017
3005	$class->SUPER::new (	3018	my $self = $class->SUPER::new (
		3019	visible => 1,
3006	@_,	3020	@_,
3007	)	3021	);
3008	}
3009		3022
3010	sub configure {	3023	Scalar::Util::weaken ($self->{root} = $self);
3011	my ($self, $x, $y, $w, $h) = @_;
3012		3024
3013	$self->{w} = $w;	3025	$self
3014	$self->{h} = $h;
3015	}
3016
3017	sub check_size {
3018	my ($self) = @_;
3019
3020	$self->size_allocate ($self->{w}, $self->{h})
3021	if $self->{w};
3022	}	3026	}
3023		3027
3024	sub size_request {	3028	sub size_request {
3025	my ($self) = @_;	3029	my ($self) = @_;
3026		3030
3027	($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
3028	}	3046	}
3029		3047
3030	sub size_allocate {	3048	sub size_allocate {
3031	my ($self, $w, $h) = @_;	3049	my ($self, $w, $h) = @_;
3032		3050
3033	my $old_w = $self->{old_w}; $self->{old_w} = $w;
3034	my $old_h = $self->{old_h}; $self->{old_h} = $h;
3035
3036	CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
3037	if $old_w && $old_h && ($old_w != $w || $old_h != $h);
3038
3039	for my $child ($self->children) {	3051	for my $child ($self->children) {
3040	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)};
3041		3053
3042	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3054	$X = $child->{force_x} if exists $child->{force_x};
3043	if exists $child->{req_x};	3055	$Y = $child->{force_y} if exists $child->{force_y};
3044		3056
3045	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3057	$X = _to_pixel $X, $W, $self->{w};
3046	if exists $child->{req_y};	3058	$Y = _to_pixel $Y, $H, $self->{h};
3047
3048	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3049	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3050		3059
3051	$child->configure ($X, $Y, $W, $H);	3060	$child->configure ($X, $Y, $W, $H);
3052	}	3061	}
3053	}	3062	}
3054		3063
…		…
3065	}	3074	}
3066		3075
3067	sub update {	3076	sub update {
3068	my ($self) = @_;	3077	my ($self) = @_;
3069		3078
3070	$self->check_size;
3071	$::WANT_REFRESH++;	3079	$::WANT_REFRESH++;
3072	}	3080	}
3073		3081
3074	sub add {	3082	sub add {
3075	my ($self, @children) = @_;	3083	my ($self, @children) = @_;
3076		3084
3077	for my $child (@children) {
3078	$child->{toplevel} = 1;	3085	$_->{is_toplevel} = 1
3079		3086	for @children;
3080	# integerise window positions
3081	$child->{x} = int $child->{x};
3082	$child->{y} = int $child->{y};
3083	}
3084		3087
3085	$self->SUPER::add (@children);	3088	$self->SUPER::add (@children);
		3089	}
		3090
		3091	sub remove {
		3092	my ($self, @children) = @_;
		3093
		3094	$self->SUPER::remove (@children);
		3095
		3096	delete $self->{is_toplevel}
		3097	for @children;
3086		3098
3087	while (@children) {	3099	while (@children) {
3088	my $w = pop @children;	3100	my $w = pop @children;
3089	push @children, $w->children;	3101	push @children, $w->children;
3090	$w->{visible} = 1;	3102	$w->set_invisible;
3091	}
3092	}
3093
3094	sub remove {
3095	my ($self, @children) = @_;
3096
3097	$self->SUPER::remove (@children);
3098
3099	while (@children) {
3100	my $w = pop @children;
3101	push @children, $w->children;
3102	delete $w->{visible};
3103	}	3103	}
3104	}	3104	}
3105		3105
3106	sub on_refresh {	3106	sub on_refresh {
3107	my ($self, $id, $cb) = @_;	3107	my ($self, $id, $cb) = @_;
…		…
3121	while ($self->{refresh_hook}) {	3121	while ($self->{refresh_hook}) {
3122	$_->()	3122	$_->()
3123	for values %{delete $self->{refresh_hook}};	3123	for values %{delete $self->{refresh_hook}};
3124	}	3124	}
3125		3125
3126	if ($self->{check_size}) {	3126	if ($self->{realloc}) {
3127	my @queue = ([], []);	3127	my @queue;
3128		3128
3129	for (;;) {	3129	while () {
3130	if ($self->{check_size}) {	3130	if ($self->{realloc}) {
3131	# heuristic: check containers last	3131	#TODO use array-of-depth approach
3132	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3132
3133	for values %{delete $self->{check_size}}	3133	use sort 'stable';
		3134
		3135	@queue = sort { $a->{visible} <=> $b->{visible} }
		3136	@queue, values %{delete $self->{realloc}};
3134	}	3137	}
3135		3138
3136	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3139	my $widget = pop @queue || last;
3137		3140
3138	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3141	$widget->{visible} or last; # do not resize invisible widgets
3139	? @$widget{qw(user_w user_h)}	3142
3140	: $widget->size_request;	3143	my ($w, $h) = $widget->size_request;
3141		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
3142	if (delete $widget->{force_alloc}	3152	|| delete $widget->{force_realloc}) {
3143	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3144	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3145
3146	$widget->{req_w} = $w;	3153	$widget->{req_w} = $w;
3147	$widget->{req_h} = $h;	3154	$widget->{req_h} = $h;
3148		3155
3149	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3156	$self->{size_alloc}{$widget+0} = $widget;
3150		3157
3151	$widget->{parent}->check_size
3152	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	}
3153	}	3164	}
		3165
		3166	delete $self->{realloc}{$widget+0};
3154	}	3167	}
3155	}	3168	}
3156		3169
3157	while ($self->{size_alloc}) {	3170	while (my $size_alloc = delete $self->{size_alloc}) {
3158	for (values %{delete $self->{size_alloc}}) {	3171	my @queue = sort { $b->{visible} <=> $a->{visible} }
3159	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)};
3160		3178
3161	$w = 0 if $w < 0;	3179	$w = 0 if $w < 0;
3162	$h = 0 if $h < 0;	3180	$h = 0 if $h < 0;
3163		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}) {
3164	$widget->{w} = $w;	3186	$widget->{w} = $w;
3165	$widget->{h} = $h;	3187	$widget->{h} = $h;
3166	$widget->size_allocate ($w, $h);	3188
3167	$widget->emit (size_allocate => $w, $h);	3189	$widget->emit (size_allocate => $w, $h);
		3190	}
3168	}	3191	}
3169	}	3192	}
3170		3193
3171	while ($self->{post_alloc_hook}) {	3194	while ($self->{post_alloc_hook}) {
3172	$_->()	3195	$_->()
3173	for values %{delete $self->{post_alloc_hook}};	3196	for values %{delete $self->{post_alloc_hook}};
3174	}	3197	}
		3198
3175		3199
3176	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3177	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3178	glClear GL_COLOR_BUFFER_BIT;	3202	glClear GL_COLOR_BUFFER_BIT;
3179		3203
…		…
3186	$self->_draw;	3210	$self->_draw;
3187	}	3211	}
3188		3212
3189	#############################################################################	3213	#############################################################################
3190		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
3191	package CFClient::UI;	3465	package CFClient::UI;
3192		3466
3193	$ROOT = new CFClient::UI::Root;	3467	$ROOT = new CFClient::UI::Root;
3194	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	3468	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3195		3469

Diff Legend

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