ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.229 by root, Wed May 24 21:49:58 2006 UTC vs.
Revision 1.265 by root, Thu Jun 1 02:59:46 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]);	938	$self->{vp}->set_offset (0, $_[1]);
822	},	939	},
823	;	940	;
824		941
825	$self = $class->SUPER::new (	942	$self = $class->SUPER::new (
…		…
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]);
836	}	963	}
837		964
838	sub size_allocate {	965	sub size_allocate {
839	my ($self, $w, $h) = @_;	966	my ($self, $w, $h) = @_;
840		967
…		…
893		1020
894	our @ISA = CFClient::UI::Bin::;	1021	our @ISA = CFClient::UI::Bin::;
895		1022
896	use CFClient::OpenGL;	1023	use CFClient::OpenGL;
897		1024
898	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 =
899	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
900	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1031	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
901		1032
902	sub new {	1033	sub new {
903	my $class = shift;	1034	my $class = shift;
904		1035
905	# TODO: user_x, user_y, overwrite moveto?
906
907	my $self = $class->SUPER::new (	1036	my $self = $class->SUPER::new (
908	bg => [1, 1, 1, 1],	1037	bg => [1, 1, 1, 1],
909	border_bg => [1, 1, 1, 1],	1038	border_bg => [1, 1, 1, 1],
910	border => 0.6,	1039	border => 0.6,
911	toplevel => 1,
912	can_events => 1,	1040	can_events => 1,
		1041	min_w => 16,
		1042	min_h => 16,
913	@_	1043	@_
914	);	1044	);
915		1045
916	$self->{title} &&= new CFClient::UI::Label	1046	$self->{title} &&= new CFClient::UI::Label
917	align => 0,	1047	align => 0,
…		…
970	my ($ev, $x, $y) = @_;	1100	my ($ev, $x, $y) = @_;
971		1101
972	my $dx = $ev->{x} - $ox;	1102	my $dx = $ev->{x} - $ox;
973	my $dy = $ev->{y} - $oy;	1103	my $dy = $ev->{y} - $oy;
974		1104
975	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
976	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1107
		1108	$self->realloc;
977	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
978	$self->check_size;
979	};	1110	};
980		1111
981	} elsif ($lr ^ $td) {	1112	} elsif ($lr ^ $td) {
982	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});
983	my ($bx, $by) = ($self->{x}, $self->{y});	1114	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
985	$self->{motion} = sub {	1116	$self->{motion} = sub {
986	my ($ev, $x, $y) = @_;	1117	my ($ev, $x, $y) = @_;
987		1118
988	($x, $y) = ($ev->{x}, $ev->{y});	1119	($x, $y) = ($ev->{x}, $ev->{y});
989		1120
990	$self->move ($bx + $x - $ox, $by + $y - $oy);	1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
991	$self->update;
992	};	1122	};
993	}	1123	}
994	}	1124	}
995		1125
996	sub button_up {	1126	sub button_up {
…		…
1015	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1016		1146
1017	my $border = $self->border;	1147	my $border = $self->border;
1018		1148
1019	glColor @{ $self->{border_bg} };	1149	glColor @{ $self->{border_bg} };
1020	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1150	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1021	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1151	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1022	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1152	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1023	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1153	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1024		1154
1025	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1155	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1026	my $bg = $tex[0];	1156	glColor @{ $self->{bg} };
1027		1157
1028	# TODO: repeat texture not scale	1158	# TODO: repeat texture not scale
		1159	# solve this better(?)
1029	my $rep_x = $cw / $bg->{w};	1160	$bg->{s} = $cw / $bg->{w};
1030	my $rep_y = $ch / $bg->{h};	1161	$bg->{t} = $ch / $bg->{h};
1031
1032	glColor @{ $self->{bg} };
1033
1034	$bg->{s} = $rep_x;
1035	$bg->{t} = $rep_y;
1036	$bg->{wrap_mode} = 1;
1037	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1038	}	1163	}
1039		1164
1040	glDisable GL_TEXTURE_2D;	1165	glDisable GL_TEXTURE_2D;
1041		1166
…		…
1057	sub new {	1182	sub new {
1058	my $class = shift;	1183	my $class = shift;
1059		1184
1060	$class->SUPER::new (	1185	$class->SUPER::new (
1061	col_expand => [],	1186	col_expand => [],
1062	@_	1187	@_,
1063	)	1188	)
		1189	}
		1190
		1191	sub children {
		1192	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1064	}	1193	}
1065		1194
1066	sub add {	1195	sub add {
1067	my ($self, $x, $y, $child) = @_;	1196	my ($self, $x, $y, $child) = @_;
1068		1197
1069	$child->set_parent ($self);	1198	$child->set_parent ($self);
1070	$self->{children}[$y][$x] = $child;	1199	$self->{children}[$y][$x] = $child;
1071		1200
1072	$child->check_size;	1201	$self->realloc;
1073	}	1202	}
1074		1203
1075	sub children {
1076	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1077	}
1078
1079	# 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?
1080	sub clear {	1205	sub clear {
1081	my ($self) = @_;	1206	my ($self) = @_;
1082		1207
1083	my @children = $self->children;	1208	my @children = $self->children;
1084	delete $self->{children};	1209	delete $self->{children};
…		…
1086	for (@children) {	1211	for (@children) {
1087	delete $_->{parent};	1212	delete $_->{parent};
1088	$_->hide;	1213	$_->hide;
1089	}	1214	}
1090		1215
1091	$self->update;	1216	$self->realloc;
1092	}	1217	}
1093		1218
1094	sub get_wh {	1219	sub get_wh {
1095	my ($self) = @_;	1220	my ($self) = @_;
1096		1221
…		…
1127	sub size_allocate {	1252	sub size_allocate {
1128	my ($self, $w, $h) = @_;	1253	my ($self, $w, $h) = @_;
1129		1254
1130	my ($ws, $hs) = $self->get_wh;	1255	my ($ws, $hs) = $self->get_wh;
1131		1256
1132	my $req_w = sum @$ws;	1257	my $req_w = (sum @$ws) || 1;
1133	my $req_h = sum @$hs;	1258	my $req_h = (sum @$hs) || 1;
1134		1259
1135	# TODO: nicer code && do row_expand	1260	# TODO: nicer code && do row_expand
1136	my @col_expand = @{$self->{col_expand}};	1261	my @col_expand = @{$self->{col_expand}};
1137	@col_expand = (1) x @$ws unless @col_expand;	1262	@col_expand = (1) x @$ws unless @col_expand;
1138	my $col_expand = (sum @col_expand) || 1;	1263	my $col_expand = (sum @col_expand) || 1;
…		…
1192	}	1317	}
1193	}	1318	}
1194		1319
1195	#############################################################################	1320	#############################################################################
1196		1321
1197	package CFClient::UI::HBox;	1322	package CFClient::UI::Box;
1198
1199	# TODO: wrap into common Box base class
1200		1323
1201	our @ISA = CFClient::UI::Container::;	1324	our @ISA = CFClient::UI::Container::;
1202		1325
1203	sub size_request {	1326	sub size_request {
1204	my ($self) = @_;	1327	my ($self) = @_;
1205		1328
1206	my @alloc = map [$_->size_request], @{$self->{children}};	1329	$self->{vertical}
1207		1330	? (
1208	(	1331	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1209	(List::Util::sum map $_->[0], @alloc),	1332	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1210	(List::Util::max map $_->[1], @alloc),	1333	)
1211	)	1334	: (
		1335	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1336	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1337	)
1212	}	1338	}
1213		1339
1214	sub size_allocate {	1340	sub size_allocate {
1215	my ($self, $w, $h) = @_;	1341	my ($self, $w, $h) = @_;
1216		1342
1217	($h, $w) = ($w, $h);	1343	my $space = $self->{vertical} ? $h : $w;
1218
1219	my $children = $self->{children};	1344	my $children = $self->{children};
1220		1345
1221	my @h = map $_->{req_w}, @$children;	1346	my @req;
1222		1347
1223	my $req_h = List::Util::sum @h;	1348	if ($self->{homogeneous}) {
1224		1349	@req = ($space / (@$children || 1)) x @$children;
1225	if ($req_h > $h) {
1226	# ah well, not enough space
1227	$_ *= $h / $req_h for @h;
1228	} else {	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 {
1229	my $exp = List::Util::sum map $_->{expand}, @$children;	1358	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1230	$exp ||= 1;
1231		1359
		1360	$space = ($space - $req) / $expand; # remaining space to give away
		1361
		1362	$req[$_] += $space * $children->[$_]{expand}
1232	for (0 .. $#$children) {	1363	for 0 .. $#$children;
1233	my $child = $children->[$_];
1234
1235	my $alloc_h = $h[$_];
1236	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1237	$h[$_] = $alloc_h;
1238	}	1364	}
1239	}	1365	}
1240		1366
1241	CFClient::UI::harmonize \@h;	1367	CFClient::UI::harmonize \@req;
1242		1368
1243	my $y = 0;	1369	my $pos = 0;
1244	for (0 .. $#$children) {	1370	for (0 .. $#$children) {
1245	my $child = $children->[$_];
1246	my $h = $h[$_];	1371	my $alloc = $req[$_];
1247	$child->configure ($y, 0, $h, $w);	1372	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1248		1373
1249	$y += $h;	1374	$pos += $alloc;
1250	}	1375	}
1251		1376
1252	1	1377	1
1253	}	1378	}
1254		1379
1255	#############################################################################	1380	#############################################################################
1256		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
1257	package CFClient::UI::VBox;	1397	package CFClient::UI::VBox;
1258		1398
1259	# TODO: wrap into common Box base class
1260
1261	our @ISA = CFClient::UI::Container::;	1399	our @ISA = CFClient::UI::Box::;
1262		1400
1263	sub size_request {	1401	sub new {
1264	my ($self) = @_;	1402	my $class = shift;
1265		1403
1266	my @alloc = map [$_->size_request], @{$self->{children}};	1404	$class->SUPER::new (
1267		1405	vertical => 1,
1268	(	1406	@_,
1269	(List::Util::max map $_->[0], @alloc),
1270	(List::Util::sum map $_->[1], @alloc),
1271	)	1407	)
1272	}
1273
1274	sub size_allocate {
1275	my ($self, $w, $h) = @_;
1276
1277	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1278
1279	my $children = $self->{children};
1280
1281	my @h = map $_->{req_h}, @$children;
1282
1283	my $req_h = List::Util::sum @h;
1284
1285	if ($req_h > $h) {
1286	# ah well, not enough space
1287	$_ *= $h / $req_h for @h;
1288	} else {
1289	my $exp = List::Util::sum map $_->{expand}, @$children;
1290	$exp ||= 1;
1291
1292	for (0 .. $#$children) {
1293	my $child = $children->[$_];
1294
1295	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1296	}
1297	}
1298
1299	CFClient::UI::harmonize \@h;
1300
1301	my $y = 0;
1302	for (0 .. $#$children) {
1303	my $child = $children->[$_];
1304	my $h = $h[$_];
1305	$child->configure (0, $y, $w, $h);
1306
1307	$y += $h;
1308	}
1309
1310	1
1311	}	1408	}
1312		1409
1313	#############################################################################	1410	#############################################################################
1314		1411
1315	package CFClient::UI::Label;	1412	package CFClient::UI::Label;
…		…
1332	ellipsise => 3, # end	1429	ellipsise => 3, # end
1333	layout => (new CFClient::Layout),	1430	layout => (new CFClient::Layout),
1334	fontsize => 1,	1431	fontsize => 1,
1335	align => -1,	1432	align => -1,
1336	valign => -1,	1433	valign => -1,
1337	padding => 2,	1434	padding_x => 2,
		1435	padding_y => 2,
1338	can_events => 0,	1436	can_events => 0,
1339	%arg	1437	%arg
1340	);	1438	);
1341		1439
1342	if (exists $self->{template}) {	1440	if (exists $self->{template}) {
…		…
1378	$self->{text} = "T$text";	1476	$self->{text} = "T$text";
1379		1477
1380	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1381	$self->{layout}->set_text ($text);	1479	$self->{layout}->set_text ($text);
1382		1480
		1481	$self->realloc;
1383	$self->update;	1482	$self->update;
1384	$self->check_size;
1385	}	1483	}
1386		1484
1387	sub set_markup {	1485	sub set_markup {
1388	my ($self, $markup) = @_;	1486	my ($self, $markup) = @_;
1389		1487
…		…
1393	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1491	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1394		1492
1395	$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;
1396	$self->{layout}->set_markup ($markup);	1494	$self->{layout}->set_markup ($markup);
1397		1495
		1496	$self->realloc;
1398	$self->update;	1497	$self->update;
1399	$self->check_size;
1400	}	1498	}
1401		1499
1402	sub size_request {	1500	sub size_request {
1403	my ($self) = @_;	1501	my ($self) = @_;
1404		1502
…		…
1418		1516
1419	$w = List::Util::max $w, $w2;	1517	$w = List::Util::max $w, $w2;
1420	$h = List::Util::max $h, $h2;	1518	$h = List::Util::max $h, $h2;
1421	}	1519	}
1422		1520
1423	(	1521	($w, $h)
1424	$w + $self->{padding} * 2,
1425	$h + $self->{padding} * 2,
1426	)
1427	}	1522	}
1428		1523
1429	sub size_allocate {	1524	sub size_allocate {
1430	my ($self, $w, $h) = @_;	1525	my ($self, $w, $h) = @_;
1431		1526
1432	delete $self->{texture};	1527	delete $self->{texture}
		1528	;#d#
1433	}	1529	}
1434		1530
1435	sub set_fontsize {	1531	sub set_fontsize {
1436	my ($self, $fontsize) = @_;	1532	my ($self, $fontsize) = @_;
1437		1533
1438	$self->{fontsize} = $fontsize;	1534	$self->{fontsize} = $fontsize;
1439	delete $self->{texture};	1535	delete $self->{texture};
1440		1536
1441	$self->update;	1537	$self->realloc;
1442	$self->check_size;
1443	}	1538	}
1444		1539
1445	sub _draw {	1540	sub _draw {
1446	my ($self) = @_;	1541	my ($self) = @_;
1447		1542
…		…
1455	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1550	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1456	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1551	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1457		1552
1458	my $tex = new_from_layout CFClient::Texture $self->{layout};	1553	my $tex = new_from_layout CFClient::Texture $self->{layout};
1459		1554
1460	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1555	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1461	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1556	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1462	: ($self->{w} - $tex->{w}) * 0.5);	1557	: ($self->{w} - $tex->{w}) * 0.5);
1463		1558
1464	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1559	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1465	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1560	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1466	: ($self->{h} - $tex->{h}) * 0.5);	1561	: ($self->{h} - $tex->{h}) * 0.5);
1467		1562
1468	$tex	1563	$tex
1469	};	1564	};
1470		1565
…		…
1519	$self->{text} = $text;	1614	$self->{text} = $text;
1520		1615
1521	$text =~ s/./*/g if $self->{hidden};	1616	$text =~ s/./*/g if $self->{hidden};
1522	$self->{layout}->set_text ("$text ");	1617	$self->{layout}->set_text ("$text ");
1523		1618
1524	$self->emit (changed => $self->{text});	1619	$self->_emit (changed => $self->{text});
1525	}	1620	}
1526		1621
1527	sub set_text {	1622	sub set_text {
1528	my ($self, $text) = @_;	1623	my ($self, $text) = @_;
1529		1624
1530	$self->{cursor} = length $text;	1625	$self->{cursor} = length $text;
1531	$self->_set_text ($text);	1626	$self->_set_text ($text);
1532	$self->update;	1627
1533	$self->check_size;	1628	$self->realloc;
1534	}	1629	}
1535		1630
1536	sub get_text {	1631	sub get_text {
1537	$_[0]{text}	1632	$_[0]{text}
1538	}	1633	}
…		…
1541	my ($self) = @_;	1636	my ($self) = @_;
1542		1637
1543	my ($w, $h) = $self->SUPER::size_request;	1638	my ($w, $h) = $self->SUPER::size_request;
1544		1639
1545	($w + 1, $h) # add 1 for cursor	1640	($w + 1, $h) # add 1 for cursor
1546	}
1547
1548	sub size_allocate {
1549	my ($self, $w, $h) = @_;
1550
1551	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1552	}	1641	}
1553		1642
1554	sub key_down {	1643	sub key_down {
1555	my ($self, $ev) = @_;	1644	my ($self, $ev) = @_;
1556		1645
…		…
1571	} elsif ($sym == CFClient::SDLK_HOME) {	1660	} elsif ($sym == CFClient::SDLK_HOME) {
1572	$self->{cursor} = 0;	1661	$self->{cursor} = 0;
1573	} elsif ($sym == CFClient::SDLK_END) {	1662	} elsif ($sym == CFClient::SDLK_END) {
1574	$self->{cursor} = length $text;	1663	$self->{cursor} = length $text;
1575	} elsif ($uni == 27) {	1664	} elsif ($uni == 27) {
1576	$self->emit ('escape');	1665	$self->_emit ('escape');
1577	} elsif ($uni) {	1666	} elsif ($uni) {
1578	substr $text, $self->{cursor}++, 0, chr $uni;	1667	substr $text, $self->{cursor}++, 0, chr $uni;
1579	}	1668	}
1580		1669
1581	$self->_set_text ($text);	1670	$self->_set_text ($text);
1582	$self->update;	1671
1583	$self->check_size;	1672	$self->realloc;
1584	}	1673	}
1585		1674
1586	sub focus_in {	1675	sub focus_in {
1587	my ($self) = @_;	1676	my ($self) = @_;
1588		1677
…		…
1668	if ($sym == 13) {	1757	if ($sym == 13) {
1669	unshift @{$self->{history}},	1758	unshift @{$self->{history}},
1670	my $txt = $self->get_text;	1759	my $txt = $self->get_text;
1671	$self->{history_pointer} = -1;	1760	$self->{history_pointer} = -1;
1672	$self->{history_saveback} = '';	1761	$self->{history_saveback} = '';
1673	$self->emit (activate => $txt);	1762	$self->_emit (activate => $txt);
1674	$self->update;	1763	$self->update;
1675		1764
1676	} elsif ($sym == CFClient::SDLK_UP) {	1765	} elsif ($sym == CFClient::SDLK_UP) {
1677	if ($self->{history_pointer} < 0) {	1766	if ($self->{history_pointer} < 0) {
1678	$self->{history_saveback} = $self->get_text;	1767	$self->{history_saveback} = $self->get_text;
…		…
1715		1804
1716	sub new {	1805	sub new {
1717	my $class = shift;	1806	my $class = shift;
1718		1807
1719	$class->SUPER::new (	1808	$class->SUPER::new (
1720	padding => 4,	1809	padding_x => 4,
		1810	padding_y => 4,
1721	fg => [1, 1, 1],	1811	fg => [1, 1, 1],
1722	active_fg => [0, 0, 1],	1812	active_fg => [0, 0, 1],
1723	can_hover => 1,	1813	can_hover => 1,
1724	align => 0,	1814	align => 0,
1725	valign => 0,	1815	valign => 0,
1726	can_events => 1,	1816	can_events => 1,
1727	@_	1817	@_
1728	)	1818	)
1729	}	1819	}
1730		1820
		1821	sub activate { }
		1822
1731	sub button_up {	1823	sub button_up {
1732	my ($self, $ev, $x, $y) = @_;	1824	my ($self, $ev, $x, $y) = @_;
1733		1825
		1826	$self->emit ("activate")
1734	if ($x >= 0 && $x < $self->{w}	1827	if $x >= 0 && $x < $self->{w}
1735	&& $y >= 0 && $y < $self->{h}) {	1828	&& $y >= 0 && $y < $self->{h};
1736	$self->emit ("activate");
1737	}
1738	}	1829	}
1739		1830
1740	sub _draw {	1831	sub _draw {
1741	my ($self) = @_;	1832	my ($self) = @_;
1742		1833
…		…
1771		1862
1772	sub new {	1863	sub new {
1773	my $class = shift;	1864	my $class = shift;
1774		1865
1775	$class->SUPER::new (	1866	$class->SUPER::new (
1776	padding => 2,	1867	padding_x => 2,
		1868	padding_y => 2,
1777	fg => [1, 1, 1],	1869	fg => [1, 1, 1],
1778	active_fg => [1, 1, 0],	1870	active_fg => [1, 1, 0],
1779	bg => [0, 0, 0, 0.2],	1871	bg => [0, 0, 0, 0.2],
1780	active_bg => [1, 1, 1, 0.5],	1872	active_bg => [1, 1, 1, 0.5],
1781	state => 0,	1873	state => 0,
…		…
1785	}	1877	}
1786		1878
1787	sub size_request {	1879	sub size_request {
1788	my ($self) = @_;	1880	my ($self) = @_;
1789		1881
1790	($self->{padding} * 2 + 6) x 2	1882	(6) x 2
1791	}	1883	}
1792		1884
1793	sub button_down {	1885	sub button_down {
1794	my ($self, $ev, $x, $y) = @_;	1886	my ($self, $ev, $x, $y) = @_;
1795		1887
1796	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1888	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1797	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1889	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1798	$self->{state} = !$self->{state};	1890	$self->{state} = !$self->{state};
1799	$self->emit (changed => $self->{state});	1891	$self->_emit (changed => $self->{state});
1800	}	1892	}
1801	}	1893	}
1802		1894
1803	sub _draw {	1895	sub _draw {
1804	my ($self) = @_;	1896	my ($self) = @_;
1805		1897
1806	$self->SUPER::_draw;	1898	$self->SUPER::_draw;
1807		1899
1808	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1900	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1809		1901
1810	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1902	my ($w, $h) = @$self{qw(w h)};
		1903
		1904	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1811		1905
1812	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1906	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1813		1907
1814	my $tex = $self->{state} ? $tex[1] : $tex[0];	1908	my $tex = $self->{state} ? $tex[1] : $tex[0];
1815		1909
…		…
2080	fg => [1, 1, 1],	2174	fg => [1, 1, 1],
2081	active_fg => [0, 0, 0],	2175	active_fg => [0, 0, 0],
2082	bg => [0, 0, 0, 0.2],	2176	bg => [0, 0, 0, 0.2],
2083	active_bg => [1, 1, 1, 0.5],	2177	active_bg => [1, 1, 1, 0.5],
2084	range => [0, 0, 100, 10, 0],	2178	range => [0, 0, 100, 10, 0],
2085	req_w => $::WIDTH / 80,	2179	min_w => $::WIDTH / 80,
2086	req_h => $::WIDTH / 80,	2180	min_h => $::WIDTH / 80,
2087	vertical => 0,	2181	vertical => 0,
2088	can_hover => 1,	2182	can_hover => 1,
2089	inner_pad => 0.02,	2183	inner_pad => 0.02,
2090	@_	2184	@_
2091	);	2185	);
…		…
2094	$self->update;	2188	$self->update;
2095		2189
2096	$self	2190	$self
2097	}	2191	}
2098		2192
		2193	sub changed { }
		2194
2099	sub set_range {	2195	sub set_range {
2100	my ($self, $range) = @_;	2196	my ($self, $range) = @_;
2101		2197
2102	$self->{range} = $range;	2198	($range, $self->{range}) = ($self->{range}, $range);
2103		2199
2104	$self->update;	2200	$self->update
		2201	if "@$range" ne "@{$self->{range}}";
2105	}	2202	}
2106		2203
2107	sub set_value {	2204	sub set_value {
2108	my ($self, $value) = @_;	2205	my ($self, $value) = @_;
2109		2206
…		…
2120	if $unit;	2217	if $unit;
2121		2218
2122	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2219	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2123		2220
2124	if ($value != $old_value) {	2221	if ($value != $old_value) {
2125	$self->emit (changed => $value);	2222	$self->_emit (changed => $value);
2126	$self->update;	2223	$self->update;
2127	}	2224	}
2128	}	2225	}
2129		2226
2130	sub size_request {	2227	sub size_request {
2131	my ($self) = @_;	2228	my ($self) = @_;
2132		2229
2133	my $w = $self->{req_w};	2230	($self->{req_w}, $self->{req_h})
2134	my $h = $self->{req_h};
2135
2136	$self->{vertical} ? ($h, $w) : ($w, $h)
2137	}	2231	}
2138		2232
2139	sub button_down {	2233	sub button_down {
2140	my ($self, $ev, $x, $y) = @_;	2234	my ($self, $ev, $x, $y) = @_;
2141		2235
…		…
2492		2586
2493	sub new {	2587	sub new {
2494	my $class = shift;	2588	my $class = shift;
2495		2589
2496	my $self = $class->SUPER::new (	2590	my $self = $class->SUPER::new (
2497	state => 0,	2591	state => 0,
2498	connect_activate => \&toggle_flopper,	2592	on_activate => \&toggle_flopper,
2499	@_	2593	@_
2500	);	2594	);
2501		2595
2502	if ($self->{state}) {
2503	$self->{state} = 0;
2504	$self->toggle_flopper;
2505	}
2506
2507	$self	2596	$self
2508	}	2597	}
2509		2598
2510	sub toggle_flopper {	2599	sub toggle_flopper {
2511	my ($self) = @_;	2600	my ($self) = @_;
2512		2601
2513	# TODO: use animation	2602	$self->{other}->toggle_visibility;
2514	if ($self->{state} = !$self->{state}) {
2515	$CFClient::UI::ROOT->add ($self->{other});
2516	$self->{other}->move ($self->coord2global (0, $self->{h}));
2517	$self->emit ("open");
2518	} else {
2519	$CFClient::UI::ROOT->remove ($self->{other});
2520	$self->emit ("close");
2521	}
2522
2523	$self->emit (changed => $self->{state});
2524	}	2603	}
2525		2604
2526	#############################################################################	2605	#############################################################################
2527		2606
2528	package CFClient::UI::Tooltip;	2607	package CFClient::UI::Tooltip;
…		…
2541	}	2620	}
2542		2621
2543	sub set_tooltip_from {	2622	sub set_tooltip_from {
2544	my ($self, $widget) = @_;	2623	my ($self, $widget) = @_;
2545		2624
		2625	my $tooltip = $widget->{tooltip};
		2626
		2627	if ($ENV{CFPLUS_DEBUG} & 2) {
		2628	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2629	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2630	. "req $widget->{req_w} $widget->{req_h}\n"
		2631	. "visible $widget->{visible}";
		2632	}
		2633
2546	$self->add (new CFClient::UI::Label	2634	$self->add (new CFClient::UI::Label
2547	markup => $widget->{tooltip},	2635	markup => $tooltip,
2548	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2636	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2549	fontsize => 0.8,	2637	fontsize => 0.8,
2550	fg => [0, 0, 0, 1],	2638	fg => [0, 0, 0, 1],
2551	ellipsise => 0,	2639	ellipsise => 0,
2552	font => ($widget->{tooltip_font} || $::FONT_PROP),	2640	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2563		2651
2564	sub size_allocate {	2652	sub size_allocate {
2565	my ($self, $w, $h) = @_;	2653	my ($self, $w, $h) = @_;
2566		2654
2567	$self->SUPER::size_allocate ($w - 4, $h - 4);	2655	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2656	}
		2657
		2658	sub visibility_change {
		2659	my ($self, $visible) = @_;
		2660
		2661	return unless $visible;
		2662
		2663	$self->{root}->on_post_alloc ("move_$self" => sub {
		2664	my $widget = $self->{owner}
		2665	or return;
		2666
		2667	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2668
		2669	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2670	if $x + $self->{w} > $::WIDTH;
		2671
		2672	$self->move_abs ($x, $y);
		2673	});
2568	}	2674	}
2569		2675
2570	sub _draw {	2676	sub _draw {
2571	my ($self) = @_;	2677	my ($self) = @_;
2572		2678
…		…
2589	glVertex $w, $h;	2695	glVertex $w, $h;
2590	glVertex $w, 0;	2696	glVertex $w, 0;
2591	glEnd;	2697	glEnd;
2592		2698
2593	glTranslate 2 - 0.375, 2 - 0.375;	2699	glTranslate 2 - 0.375, 2 - 0.375;
		2700
2594	$self->SUPER::_draw;	2701	$self->SUPER::_draw;
2595	}	2702	}
2596		2703
2597	#############################################################################	2704	#############################################################################
2598		2705
…		…
2604		2711
2605	sub new {	2712	sub new {
2606	my $class = shift;	2713	my $class = shift;
2607		2714
2608	my $self = $class->SUPER::new (	2715	my $self = $class->SUPER::new (
2609	aspect => 1,	2716	aspect => 1,
		2717	can_events => 0,
2610	@_,	2718	@_,
2611	);	2719	);
2612		2720
2613	if ($self->{anim} && $self->{animspeed}) {	2721	if ($self->{anim} && $self->{animspeed}) {
2614	Scalar::Util::weaken (my $widget = $self);	2722	Scalar::Util::weaken (my $widget = $self);
…		…
2673	$self->SUPER::DESTROY;	2781	$self->SUPER::DESTROY;
2674	}	2782	}
2675		2783
2676	#############################################################################	2784	#############################################################################
2677		2785
2678	package CFClient::UI::InventoryItem;
2679
2680	our @ISA = CFClient::UI::HBox::;
2681
2682	sub _item_to_desc {
2683	my ($item) = @_;
2684
2685	my $desc =
2686	$item->{nrof} < 2
2687	? $item->{name}
2688	: "$item->{nrof} × $item->{name_pl}";
2689
2690	$item->{flags} & Crossfire::Protocol::F_OPEN
2691	and $desc .= " (open)";
2692	$item->{flags} & Crossfire::Protocol::F_APPLIED
2693	and $desc .= " (applied)";
2694	$item->{flags} & Crossfire::Protocol::F_UNPAID
2695	and $desc .= " (unpaid)";
2696	$item->{flags} & Crossfire::Protocol::F_MAGIC
2697	and $desc .= " (magic)";
2698	$item->{flags} & Crossfire::Protocol::F_CURSED
2699	and $desc .= " (cursed)";
2700	$item->{flags} & Crossfire::Protocol::F_DAMNED
2701	and $desc .= " (damned)";
2702	$item->{flags} & Crossfire::Protocol::F_LOCKED
2703	and $desc .= " *";
2704
2705	$desc
2706	}
2707
2708	sub new {
2709	my $class = shift;
2710
2711	my %args = @_;
2712
2713	my $item = delete $args{item};
2714
2715	my $desc = _item_to_desc ($item);
2716
2717	my $self = $class->SUPER::new (
2718	can_hover => 1,
2719	can_events => 1,
2720	tooltip => ((CFClient::UI::Label::escape $desc)
2721	. "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2722	connect_button_down => sub {
2723	my ($self, $ev, $x, $y) = @_;
2724
2725	# todo: maybe put examine on 1? but should just be a tooltip :(
2726	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2727	my $targ = $::CONN->{player}{tag};
2728
2729	if ($item->{container} == $::CONN->{player}{tag}) {
2730	$targ = $main::OPENCONT;
2731	}
2732
2733	$::CONN->send ("move $targ $item->{tag} 0");
2734	} elsif ($ev->{button} == 1) {
2735	$::CONN->send ("examine $item->{tag}");
2736	} elsif ($ev->{button} == 2) {
2737	$::CONN->send ("apply $item->{tag}");
2738	} elsif ($ev->{button} == 3) {
2739	my @menu_items = (
2740	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2741	["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2742	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2743	(
2744	$item->{flags} & Crossfire::Protocol::F_LOCKED
2745	? (
2746	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2747	)
2748	: (
2749	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2750	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2751	)
2752	),
2753	);
2754
2755	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2756	}
2757
2758	1
2759	},
2760	%args
2761	);
2762
2763
2764	$self->add (new CFClient::UI::Face
2765	can_events => 0,
2766	face => $item->{face},
2767	anim => $item->{anim},
2768	animspeed => $item->{animspeed},
2769	);
2770
2771	$self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2772
2773	$self->{item} = $item;
2774
2775	$self->update_item;
2776
2777	$self
2778	}
2779
2780	sub update_item {
2781	my ($self) = @_;
2782
2783	my $desc = _item_to_desc ($self->{item});
2784
2785	$self->{name_lbl}->set_text ($desc);
2786	}
2787
2788	#############################################################################
2789
2790	package CFClient::UI::Inventory;
2791
2792	our @ISA = CFClient::UI::ScrolledWindow::;
2793
2794	sub new {
2795	my $class = shift;
2796
2797	my $self = $class->SUPER::new (
2798	scrolled => (new CFClient::UI::Table),
2799	@_,
2800	);
2801
2802	$self
2803	}
2804
2805	sub set_items {
2806	my ($self, $items) = @_;
2807
2808	$self->{scrolled}->clear;
2809	return unless $items;
2810
2811	my @items = sort {
2812	($a->{type} <=> $b->{type})
2813	or ($a->{name} cmp $b->{name})
2814	} @$items;
2815
2816	$self->{real_items} = \@items;
2817
2818	for my $item (@items) {
2819	$item->{item} = $item;
2820	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2821	$item->update_item ();
2822	}
2823
2824	my $i = 0;
2825	for (@items) {
2826	$self->{scrolled}->add (0, $i, $_);
2827	my $nrof = $_->{item}->{nrof} || 1;
2828	$self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2829	}
2830
2831	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2832	}
2833
2834	sub size_request {
2835	my ($self) = @_;
2836	($self->{req_w}, $self->{req_h});
2837	}
2838
2839	#############################################################################
2840
2841	package CFClient::UI::Menu;	2786	package CFClient::UI::Menu;
2842		2787
2843	our @ISA = CFClient::UI::FancyFrame::;	2788	our @ISA = CFClient::UI::FancyFrame::;
2844		2789
2845	use CFClient::OpenGL;	2790	use CFClient::OpenGL;
…		…
2876		2821
2877	# popup given the event (must be a mouse button down event currently)	2822	# popup given the event (must be a mouse button down event currently)
2878	sub popup {	2823	sub popup {
2879	my ($self, $ev) = @_;	2824	my ($self, $ev) = @_;
2880		2825
2881	$self->emit ("popdown");	2826	$self->_emit ("popdown");
2882		2827
2883	# maybe save $GRAB? must be careful about events...	2828	# maybe save $GRAB? must be careful about events...
2884	$GRAB = $self;	2829	$GRAB = $self;
2885	$self->{button} = $ev->{button};	2830	$self->{button} = $ev->{button};
2886		2831
2887	$self->show;	2832	$self->show;
2888	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2833	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2889	}	2834	}
2890		2835
2891	sub mouse_motion {	2836	sub mouse_motion {
2892	my ($self, $ev, $x, $y) = @_;	2837	my ($self, $ev, $x, $y) = @_;
2893		2838
…		…
2901		2846
2902	if ($ev->{button} == $self->{button}) {	2847	if ($ev->{button} == $self->{button}) {
2903	undef $GRAB;	2848	undef $GRAB;
2904	$self->hide;	2849	$self->hide;
2905		2850
2906	$self->emit ("popdown");	2851	$self->_emit ("popdown");
2907	$self->{hover}[1]->() if $self->{hover};	2852	$self->{hover}[1]->() if $self->{hover};
2908	}	2853	}
2909	}	2854	}
2910		2855
2911	#############################################################################	2856	#############################################################################
…		…
2973	sub add {	2918	sub add {
2974	my ($self, $text, %arg) = @_;	2919	my ($self, $text, %arg) = @_;
2975		2920
2976	$text =~ s/^\s+//;	2921	$text =~ s/^\s+//;
2977	$text =~ s/\s+$//;	2922	$text =~ s/\s+$//;
		2923
		2924	return unless $text;
2978		2925
2979	my $timeout = time + ((delete $arg{timeout}) || 60);	2926	my $timeout = time + ((delete $arg{timeout}) || 60);
2980		2927
2981	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	2928	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2982		2929
…		…
3016	$self->SUPER::reconfigure;	2963	$self->SUPER::reconfigure;
3017	}	2964	}
3018		2965
3019	#############################################################################	2966	#############################################################################
3020		2967
3021	package CFClient::UI::Root;	2968	package CFClient::UI::Inventory;
3022		2969
3023	our @ISA = CFClient::UI::Container::;	2970	our @ISA = CFClient::UI::ScrolledWindow::;
3024
3025	use CFClient::OpenGL;
3026		2971
3027	sub new {	2972	sub new {
3028	my $class = shift;	2973	my $class = shift;
3029		2974
3030	$class->SUPER::new (	2975	my $self = $class->SUPER::new (
		2976	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3031	@_,	2977	@_,
3032	)	2978	);
3033	}
3034		2979
3035	sub configure {	2980	$self
		2981	}
		2982
		2983	sub set_items {
		2984	my ($self, $items) = @_;
		2985
		2986	$self->{scrolled}->clear;
		2987	return unless $items;
		2988
		2989	my @items = sort {
		2990	($a->{type} <=> $b->{type})
		2991	or ($a->{name} cmp $b->{name})
		2992	} @$items;
		2993
		2994	$self->{real_items} = \@items;
		2995
		2996	my $row = 0;
		2997	for my $item (@items) {
		2998	CFClient::Item::update_widgets $item;
		2999
		3000	$self->{scrolled}->add (0, $row, $item->{face_widget});
		3001	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		3002	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		3003
		3004	$row++;
		3005	}
		3006	}
		3007
		3008	#############################################################################
		3009
		3010	package CFClient::UI::BindEditor;
		3011
		3012	our @ISA = CFClient::UI::FancyFrame::;
		3013
		3014	sub new {
		3015	my $class = shift;
		3016
		3017	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3018
		3019	$self->add (my $vb = new CFClient::UI::VBox);
		3020
		3021
		3022	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3023	text => "start recording",
		3024	tooltip => "Start/Stops recording of actions."
		3025	."All subsequent actions after the recording started will be captured."
		3026	."The actions are displayed after the record was stopped."
		3027	."To bind the action you have to click on the 'Bind' button",
		3028	on_activate => sub {
		3029	unless ($self->{recording}) {
		3030	$self->start;
		3031	} else {
		3032	$self->stop;
		3033	}
		3034	});
		3035
		3036	$vb->add (new CFClient::UI::Label text => "Actions:");
		3037	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3038
		3039	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3040	$vb->add (my $hb = new CFClient::UI::HBox);
		3041	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3042	$hb->add (new CFClient::UI::Button
		3043	text => "bind",
		3044	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3045	on_activate => sub {
		3046	$self->ask_for_bind;
		3047	});
		3048
		3049	$vb->add (my $hb = new CFClient::UI::HBox);
		3050	$hb->add (new CFClient::UI::Button
		3051	text => "ok",
		3052	expand => 1,
		3053	tooltip => "This closes the binding editor and saves the binding",
		3054	on_activate => sub {
		3055	$self->hide;
		3056	$self->commit;
		3057	});
		3058
		3059	$hb->add (new CFClient::UI::Button
		3060	text => "cancel",
		3061	expand => 1,
		3062	tooltip => "This closes the binding editor without saving",
		3063	on_activate => sub {
		3064	$self->hide;
		3065	$self->{binding_cancel}->()
		3066	if $self->{binding_cancel};
		3067	});
		3068
		3069	$self->update_binding_widgets;
		3070
		3071	$self
		3072	}
		3073
		3074	sub commit {
		3075	my ($self) = @_;
		3076	my ($mod, $sym, $cmds) = $self->get_binding;
		3077	if ($sym != 0 && @$cmds > 0) {
		3078	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3079	."'. Don't forget 'Save Config'!");
		3080	$self->{binding_change}->($mod, $sym, $cmds)
		3081	if $self->{binding_change};
		3082	} else {
		3083	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3084	$self->{binding_cancel}->()
		3085	if $self->{binding_cancel};
		3086	}
		3087	}
		3088
		3089	sub start {
		3090	my ($self) = @_;
		3091
		3092	$self->{rec_btn}->set_text ("stop recording");
		3093	$self->{recording} = 1;
		3094	$self->clear_command_list;
		3095	$::CONN->start_record if $::CONN;
		3096	}
		3097
		3098	sub stop {
		3099	my ($self) = @_;
		3100
		3101	$self->{rec_btn}->set_text ("start recording");
		3102	$self->{recording} = 0;
		3103
		3104	my $rec;
		3105	$rec = $::CONN->stop_record if $::CONN;
		3106	return unless ref $rec eq 'ARRAY';
		3107	$self->set_command_list ($rec);
		3108	}
		3109
		3110	# if $commit is true, the binding will be set after the user entered a key combo
		3111	sub ask_for_bind {
		3112	my ($self, $commit) = @_;
		3113
		3114	CFClient::Binder::open_binding_dialog (sub {
		3115	my ($mod, $sym) = @_;
		3116	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3117	$self->update_binding_widgets;
		3118	$self->commit if $commit;
		3119	});
		3120	}
		3121
		3122	# $mod and $sym are the modifiers and key symbol
		3123	# $cmds is a array ref of strings (the commands)
		3124	# $cb is the callback that is executed on OK
		3125	# $ccb is the callback that is executed on CANCEL and
		3126	# when the binding was unsuccessful on OK
		3127	sub set_binding {
3036	my ($self, $x, $y, $w, $h) = @_;	3128	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3037		3129
3038	$self->{w} = $w;	3130	$self->clear_command_list;
3039	$self->{h} = $h;	3131	$self->{recording} = 0;
3040	}	3132	$self->{rec_btn}->set_text ("start recording");
3041		3133
3042	sub check_size {	3134	$self->{binding} = [$mod, $sym];
		3135	$self->{commands} = $cmds;
		3136
		3137	$self->{binding_change} = $cb;
		3138	$self->{binding_cancel} = $ccb;
		3139
		3140	$self->update_binding_widgets;
		3141	}
		3142
		3143	# this is a shortcut method that asks for a binding
		3144	# and then just binds it.
		3145	sub do_quick_binding {
3043	my ($self) = @_;	3146	my ($self, $cmds) = @_;
		3147	$self->set_binding (undef, undef, $cmds, sub {
		3148	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3149	});
		3150	$self->ask_for_bind (1);
		3151	}
3044		3152
3045	$self->size_allocate ($self->{w}, $self->{h})	3153	sub update_binding_widgets {
3046	if $self->{w};	3154	my ($self) = @_;
		3155	my ($mod, $sym, $cmds) = $self->get_binding;
		3156	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3157	$self->set_command_list ($cmds);
		3158	}
		3159
		3160	sub get_binding {
		3161	my ($self) = @_;
		3162	return (
		3163	$self->{binding}->[0],
		3164	$self->{binding}->[1],
		3165	[ grep { defined $_ } @{$self->{commands}} ]
		3166	);
		3167	}
		3168
		3169	sub clear_command_list {
		3170	my ($self) = @_;
		3171	$self->{cmdbox}->clear ();
		3172	}
		3173
		3174	sub set_command_list {
		3175	my ($self, $cmds) = @_;
		3176
		3177	$self->{cmdbox}->clear ();
		3178	$self->{commands} = $cmds;
		3179
		3180	my $idx = 0;
		3181
		3182	for (@$cmds) {
		3183	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3184
		3185	my $i = $idx;
		3186	$hb->add (new CFClient::UI::Label text => $_);
		3187	$hb->add (new CFClient::UI::Button
		3188	text => "delete",
		3189	tooltip => "Deletes the action from the record",
		3190	on_activate => sub {
		3191	$self->{cmdbox}->remove ($hb);
		3192	$cmds->[$i] = undef;
		3193	});
		3194
		3195
		3196	$idx++
		3197	}
		3198	}
		3199
		3200	#############################################################################
		3201
		3202	package CFClient::UI::SpellList;
		3203
		3204	our @ISA = CFClient::UI::FancyFrame::;
		3205
		3206	sub new {
		3207	my $class = shift;
		3208
		3209	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3210
		3211	$self->add (new CFClient::UI::ScrolledWindow
		3212	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3213
		3214	$self;
		3215	}
		3216
		3217	# XXX: Do sorting? Argl...
		3218	sub add_spell {
		3219	my ($self, $spell) = @_;
		3220	$self->{spells}->{$spell->{name}} = $spell;
		3221
		3222	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3223	face => $spell->{face},
		3224	can_hover => 1,
		3225	can_events => 1,
		3226	tooltip => $spell->{message});
		3227
		3228	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3229	text => $spell->{name},
		3230	can_hover => 1,
		3231	can_events => 1,
		3232	tooltip => $spell->{message},
		3233	expand => 1);
		3234
		3235	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3236	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3237	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3238	expand => 1);
		3239
		3240	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3241	text => "bind to key",
		3242	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3243	}
		3244
		3245	sub rebuild_spell_list {
		3246	my ($self) = @_;
		3247	$self->{tbl_idx} = 0;
		3248	$self->add_spell ($_) for values %{$self->{spells}};
		3249	}
		3250
		3251	sub remove_spell {
		3252	my ($self, $spell) = @_;
		3253	delete $self->{spells}->{$spell->{name}};
		3254	$self->rebuild_spell_list;
		3255	}
		3256
		3257	#############################################################################
		3258
		3259	package CFClient::UI::Root;
		3260
		3261	our @ISA = CFClient::UI::Container::;
		3262
		3263	use CFClient::OpenGL;
		3264
		3265	sub new {
		3266	my $class = shift;
		3267
		3268	my $self = $class->SUPER::new (
		3269	visible => 1,
		3270	@_,
		3271	);
		3272
		3273	Scalar::Util::weaken ($self->{root} = $self);
		3274
		3275	$self
3047	}	3276	}
3048		3277
3049	sub size_request {	3278	sub size_request {
3050	my ($self) = @_;	3279	my ($self) = @_;
3051		3280
3052	($self->{w}, $self->{h})	3281	($self->{w}, $self->{h})
		3282	}
		3283
		3284	sub _to_pixel {
		3285	my ($coord, $size, $max) = @_;
		3286
		3287	$coord =
		3288	$coord eq "center" ? ($max - $size) * 0.5
		3289	: $coord eq "max" ? $max
		3290	: $coord;
		3291
		3292	$coord = 0 if $coord < 0;
		3293	$coord = $max - $size if $coord > $max - $size;
		3294
		3295	int $coord + 0.5
3053	}	3296	}
3054		3297
3055	sub size_allocate {	3298	sub size_allocate {
3056	my ($self, $w, $h) = @_;	3299	my ($self, $w, $h) = @_;
3057		3300
3058	my $old_w = $self->{old_w}; $self->{old_w} = $w;
3059	my $old_h = $self->{old_h}; $self->{old_h} = $h;
3060
3061	CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
3062	if $old_w && $old_h && ($old_w != $w || $old_h != $h);
3063
3064	for my $child ($self->children) {	3301	for my $child ($self->children) {
3065	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3302	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3066		3303
3067	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3304	$X = $child->{force_x} if exists $child->{force_x};
3068	if exists $child->{req_x};	3305	$Y = $child->{force_y} if exists $child->{force_y};
3069		3306
3070	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3307	$X = _to_pixel $X, $W, $self->{w};
3071	if exists $child->{req_y};	3308	$Y = _to_pixel $Y, $H, $self->{h};
3072
3073	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3074	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3075		3309
3076	$child->configure ($X, $Y, $W, $H);	3310	$child->configure ($X, $Y, $W, $H);
3077	}	3311	}
3078	}	3312	}
3079		3313
…		…
3090	}	3324	}
3091		3325
3092	sub update {	3326	sub update {
3093	my ($self) = @_;	3327	my ($self) = @_;
3094		3328
3095	$self->check_size;
3096	$::WANT_REFRESH++;	3329	$::WANT_REFRESH++;
3097	}	3330	}
3098		3331
3099	sub add {	3332	sub add {
3100	my ($self, @children) = @_;	3333	my ($self, @children) = @_;
3101		3334
3102	for (my @widgets = @children; my $w = pop @widgets; ) {
3103	push @widgets, $w->children;
3104	$w->{root} = $self;
3105	$w->{visible} = 1;
3106	}
3107
3108	for my $child (@children) {
3109	$child->{toplevel} = 1;	3335	$_->{is_toplevel} = 1
3110		3336	for @children;
3111	# integerise window positions
3112	$child->{x} = int $child->{x};
3113	$child->{y} = int $child->{y};
3114	}
3115		3337
3116	$self->SUPER::add (@children);	3338	$self->SUPER::add (@children);
3117	}	3339	}
3118		3340
3119	sub remove {	3341	sub remove {
3120	my ($self, @children) = @_;	3342	my ($self, @children) = @_;
3121		3343
3122	$self->SUPER::remove (@children);	3344	$self->SUPER::remove (@children);
		3345
		3346	delete $self->{is_toplevel}
		3347	for @children;
3123		3348
3124	while (@children) {	3349	while (@children) {
3125	my $w = pop @children;	3350	my $w = pop @children;
3126	push @children, $w->children;	3351	push @children, $w->children;
3127	delete $w->{visible};	3352	$w->set_invisible;
3128	}	3353	}
3129	}	3354	}
3130		3355
3131	sub on_refresh {	3356	sub on_refresh {
3132	my ($self, $id, $cb) = @_;	3357	my ($self, $id, $cb) = @_;
…		…
3146	while ($self->{refresh_hook}) {	3371	while ($self->{refresh_hook}) {
3147	$_->()	3372	$_->()
3148	for values %{delete $self->{refresh_hook}};	3373	for values %{delete $self->{refresh_hook}};
3149	}	3374	}
3150		3375
3151	if ($self->{check_size}) {	3376	if ($self->{realloc}) {
3152	my @queue = ([], []);	3377	my @queue;
3153		3378
3154	for (;;) {	3379	while () {
3155	if ($self->{check_size}) {	3380	if ($self->{realloc}) {
3156	# heuristic: check containers last	3381	#TODO use array-of-depth approach
3157	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3382
3158	for values %{delete $self->{check_size}}	3383	use sort 'stable';
		3384
		3385	@queue = sort { $a->{visible} <=> $b->{visible} }
		3386	@queue, values %{delete $self->{realloc}};
3159	}	3387	}
3160		3388
3161	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3389	my $widget = pop @queue || last;
3162		3390
3163	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3391	$widget->{visible} or last; # do not resize invisible widgets
3164	? @$widget{qw(user_w user_h)}	3392
3165	: $widget->size_request;	3393	my ($w, $h) = $widget->size_request;
3166		3394
		3395	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3396	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3397
		3398	$w = $widget->{force_w} if exists $widget->{force_w};
		3399	$h = $widget->{force_h} if exists $widget->{force_h};
		3400
		3401	if ($widget->{req_w} != $w || $widget->{req_h} != $h
3167	if (delete $widget->{force_alloc}	3402	|| delete $widget->{force_realloc}) {
3168	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3169	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3170
3171	$widget->{req_w} = $w;	3403	$widget->{req_w} = $w;
3172	$widget->{req_h} = $h;	3404	$widget->{req_h} = $h;
3173		3405
3174	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3406	$self->{size_alloc}{$widget+0} = $widget;
3175		3407
3176	$widget->{parent}->check_size
3177	if $widget->{parent};	3408	if (my $parent = $widget->{parent}) {
		3409	$self->{realloc}{$parent+0} = $parent;
		3410	#unshift @queue, $parent;
		3411	$parent->{force_size_alloc} = 1;
		3412	$self->{size_alloc}{$parent+0} = $parent;
		3413	}
3178	}	3414	}
		3415
		3416	delete $self->{realloc}{$widget+0};
3179	}	3417	}
3180	}	3418	}
3181		3419
3182	while ($self->{size_alloc}) {	3420	while (my $size_alloc = delete $self->{size_alloc}) {
3183	for (values %{delete $self->{size_alloc}}) {	3421	my @queue = sort { $b->{visible} <=> $a->{visible} }
3184	my ($widget, $w, $h) = @$_;	3422	values %$size_alloc;
		3423
		3424	while () {
		3425	my $widget = pop @queue || last;
		3426
		3427	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3185		3428
3186	$w = 0 if $w < 0;	3429	$w = 0 if $w < 0;
3187	$h = 0 if $h < 0;	3430	$h = 0 if $h < 0;
3188		3431
		3432	$w = int $w + 0.5;
		3433	$h = int $h + 0.5;
		3434
		3435	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3189	$widget->{w} = $w;	3436	$widget->{w} = $w;
3190	$widget->{h} = $h;	3437	$widget->{h} = $h;
3191	$widget->size_allocate ($w, $h);	3438
3192	$widget->emit (size_allocate => $w, $h);	3439	$widget->emit (size_allocate => $w, $h);
		3440	}
3193	}	3441	}
3194	}	3442	}
3195		3443
3196	while ($self->{post_alloc_hook}) {	3444	while ($self->{post_alloc_hook}) {
3197	$_->()	3445	$_->()
3198	for values %{delete $self->{post_alloc_hook}};	3446	for values %{delete $self->{post_alloc_hook}};
3199	}	3447	}
		3448
3200		3449
3201	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3450	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3202	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3451	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3203	glClear GL_COLOR_BUFFER_BIT;	3452	glClear GL_COLOR_BUFFER_BIT;
3204		3453

Diff Legend

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