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.232 by root, Thu May 25 02:23:14 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	}
…		…
152	sub rescale_widgets {	170	sub rescale_widgets {
153	my ($sx, $sy) = @_;	171	my ($sx, $sy) = @_;
154		172
155	for my $widget (values %WIDGET) {	173	for my $widget (values %WIDGET) {
156	if ($widget->{is_toplevel}) {	174	if ($widget->{is_toplevel}) {
		175	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		176	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		177
157	$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.]+$/;
158	$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};
159	$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};
160	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
161	$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.]+$/;
162	$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};
163	$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};
164	$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
165	}	188	}
166	}	189	}
167		190
168	reconfigure_widgets;	191	reconfigure_widgets;
169	}	192	}
…		…
178		201
179	sub new {	202	sub new {
180	my $class = shift;	203	my $class = shift;
181		204
182	my $self = bless {	205	my $self = bless {
183	x => 0,	206	x => "center",
184	y => 0,	207	y => "center",
185	z => 0,	208	z => 0,
		209	w => undef,
		210	h => undef,
186	can_events => 1,	211	can_events => 1,
187	@_	212	@_
188	}, $class;	213	}, $class;
189		214
		215	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		216
190	for (keys %$self) {	217	for (keys %$self) {
191	if (/^connect_(.*)$/) {	218	if (/^on_(.*)$/) {
192	$self->connect ($1 => delete $self->{$_});	219	$self->connect ($1 => delete $self->{$_});
193	}	220	}
194	}	221	}
195		222
196	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	}
197		234
198	$self	235	$self
199	}	236	}
200		237
201	sub destroy {	238	sub destroy {
…		…
205	%$self = ();	242	%$self = ();
206	}	243	}
207		244
208	sub show {	245	sub show {
209	my ($self) = @_;	246	my ($self) = @_;
		247
210	return if $self->{parent};	248	return if $self->{parent};
211		249
212	$CFClient::UI::ROOT->add ($self);	250	$CFClient::UI::ROOT->add ($self);
213	}	251	}
214		252
215	sub show_centered {	253	sub set_visible {
216	my ($self) = @_;	254	my ($self) = @_;
		255
217	return if $self->{parent};	256	return if $self->{visible};
218		257
219	$self->show;	258	$self->{root} = $self->{parent}{root};
		259	$self->{visible} = $self->{parent}{visible} + 1;
220		260
221	$CFClient::UI::ROOT->on_post_alloc (	261	$self->emit (visibility_change => 1);
222	"centered $self" => sub {	262
223	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);	263	$self->realloc if !exists $self->{req_w};
224	},	264
225	);	265	$_->set_visible for $self->children;
226	}	266	}
227		267
228	sub set_invisible {	268	sub set_invisible {
229	my ($self) = @_;	269	my ($self) = @_;
230		270
231	# broken show/hide model	271	return unless $self->{visible};
232		272
		273	$_->set_invisible for $self->children;
		274
		275	delete $self->{root};
233	delete $self->{visible};	276	delete $self->{visible};
234		277
235	undef $GRAB if $GRAB == $self;	278	undef $GRAB if $GRAB == $self;
236	undef $HOVER if $HOVER == $self;	279	undef $HOVER if $HOVER == $self;
237		280
238	CFClient::UI::check_tooltip	281	CFClient::UI::check_tooltip
239	if $CFClient::UI::TOOLTIP->{owner} == $self;	282	if $TOOLTIP->{owner} == $self;
240		283
241	$self->focus_out;	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;
242	}	304	}
243		305
244	sub hide {	306	sub hide {
245	my ($self) = @_;	307	my ($self) = @_;
246		308
…		…
248		310
249	$self->{parent}->remove ($self)	311	$self->{parent}->remove ($self)
250	if $self->{parent};	312	if $self->{parent};
251	}	313	}
252		314
253	sub move {	315	sub move_abs {
254	my ($self, $x, $y, $z) = @_;	316	my ($self, $x, $y, $z) = @_;
255		317
256	$self->{x} = int $x;	318	$self->{x} = List::Util::max 0, int $x;
257	$self->{y} = int $y;	319	$self->{y} = List::Util::max 0, int $y;
258	$self->{z} = $z if defined $z;	320	$self->{z} = $z if defined $z;
259		321
260	$self->update;	322	$self->update;
261	}	323	}
262		324
263	sub set_size {	325	sub set_size {
264	my ($self, $w, $h) = @_;	326	my ($self, $w, $h) = @_;
265		327
266	$self->{user_w} = $w;	328	$self->{force_w} = $w;
267	$self->{user_h} = $h;	329	$self->{force_h} = $h;
268		330
269	$self->check_size;	331	$self->realloc;
270	}	332	}
271		333
272	sub size_request {	334	sub size_request {
273	require Carp;	335	require Carp;
274	Carp::confess "size_request is abstract";	336	Carp::confess "size_request is abstract";
…		…
276		338
277	sub configure {	339	sub configure {
278	my ($self, $x, $y, $w, $h) = @_;	340	my ($self, $x, $y, $w, $h) = @_;
279		341
280	if ($self->{aspect}) {	342	if ($self->{aspect}) {
		343	my ($ow, $oh) = ($w, $h);
		344
281	my $w2 = List::Util::min $w, int $h * $self->{aspect};	345	$w = List::Util::min $w, int $h * $self->{aspect};
282	my $h2 = List::Util::min $h, int $w / $self->{aspect};	346	$h = List::Util::min $h, int $w / $self->{aspect};
283		347
284	# use alignment to adjust x, y	348	# use alignment to adjust x, y
285		349
286	$x += int +($w - $w2) * 0.5;	350	$x += int 0.5 * ($ow - $w);
287	$y += int +($h - $h2) * 0.5;	351	$y += int 0.5 * ($oh - $h);
288
289	($w, $h) = ($w2, $h2);
290	}	352	}
291		353
292	if ($self->{x} != $x || $self->{y} != $y) {	354	if ($self->{x} ne $x || $self->{y} ne $y) {
293	$self->{x} = $x;	355	$self->{x} = $x;
294	$self->{y} = $y;	356	$self->{y} = $y;
295	$self->update;	357	$self->update;
296	}	358	}
297		359
298	if ($self->{w} != $w || $self->{h} != $h) {	360	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
299	$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;
300	}	367	}
301	}	368	}
302		369
303	sub size_allocate {	370	sub size_allocate {
304	# nothing to be done	371	# nothing to be done
305	}	372	}
306		373
307	sub reconfigure {
308	my ($self) = @_;
309
310	$self->check_size (1);
311	$self->update;
312	}
313
314	sub children {	374	sub children {
315	}	375	}
316		376
317	sub set_max_size {	377	sub set_max_size {
318	my ($self, $w, $h) = @_;	378	my ($self, $w, $h) = @_;
…		…
321	delete $self->{max_h}; $self->{max_h} = $h if $h;	381	delete $self->{max_h}; $self->{max_h} = $h if $h;
322	}	382	}
323		383
324	sub set_tooltip {	384	sub set_tooltip {
325	my ($self, $tooltip) = @_;	385	my ($self, $tooltip) = @_;
		386
		387	$tooltip =~ s/^\s+//;
		388	$tooltip =~ s/\s+$//;
		389
		390	return if $self->{tooltip} eq $tooltip;
326		391
327	$self->{tooltip} = $tooltip;	392	$self->{tooltip} = $tooltip;
328		393
329	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	394	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
330	delete $CFClient::UI::TOOLTIP->{owner};	395	delete $CFClient::UI::TOOLTIP->{owner};
…		…
389	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	454	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }
390	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	455	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }
391	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	456	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }
392	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	457	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }
393	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	}
394		529
395	sub draw {	530	sub draw {
396	my ($self) = @_;	531	my ($self) = @_;
397		532
398	return unless $self->{h} && $self->{w};	533	return unless $self->{h} && $self->{w};
…		…
415	glVertex $x , $y + $self->{h};	550	glVertex $x , $y + $self->{h};
416	glEnd;	551	glEnd;
417	glDisable GL_BLEND;	552	glDisable GL_BLEND;
418	}	553	}
419		554
420	if ($ENV{PCLIENT_DEBUG}) {	555	if ($ENV{CFPLUS_DEBUG} & 1) {
421	glPushMatrix;	556	glPushMatrix;
422	glColor 1, 1, 0, 1;	557	glColor 1, 1, 0, 1;
423	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	558	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
424	glBegin GL_LINE_LOOP;	559	glBegin GL_LINE_LOOP;
425	glVertex 0 , 0;	560	glVertex 0 , 0;
426	glVertex $self->{w}, 0;	561	glVertex $self->{w} - 1, 0;
427	glVertex $self->{w}, $self->{h};	562	glVertex $self->{w} - 1, $self->{h} - 1;
428	glVertex 0 , $self->{h};	563	glVertex 0 , $self->{h} - 1;
429	glEnd;	564	glEnd;
430	glPopMatrix;	565	glPopMatrix;
431	#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;
432	}	567	}
433	}	568	}
434		569
435	sub _draw {	570	sub _draw {
436	my ($self) = @_;	571	my ($self) = @_;
437		572
438	warn "no draw defined for $self\n";	573	warn "no draw defined for $self\n";
439	}
440
441	sub find_widget {
442	my ($self, $x, $y) = @_;
443
444	return () unless $self->{can_events};
445
446	return $self
447	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
448	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
449
450	()
451	}
452
453	sub set_parent {
454	my ($self, $parent) = @_;
455
456	Scalar::Util::weaken ($self->{parent} = $parent);
457
458	# TODO: req_w _does_change after ->reconfigure
459	$self->check_size
460	unless exists $self->{req_w};
461
462	$self->show;
463	}
464
465	sub check_size {
466	my ($self, $forced) = @_;
467
468	$self->{force_alloc} = 1 if $forced;
469	$CFClient::UI::ROOT->{check_size}{$self} = $self;
470	}
471
472	sub update {
473	my ($self) = @_;
474
475	$self->{parent}->update
476	if $self->{parent};
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	}	574	}
497		575
498	sub DESTROY {	576	sub DESTROY {
499	my ($self) = @_;	577	my ($self) = @_;
500		578
…		…
558	my ($class, %arg) = @_;	636	my ($class, %arg) = @_;
559	$class->SUPER::new (can_events => 0, %arg);	637	$class->SUPER::new (can_events => 0, %arg);
560	}	638	}
561		639
562	sub size_request {	640	sub size_request {
563	(0, 0)	641	my ($self) = @_;
		642
		643	($self->{w} + 0, $self->{h} + 0)
564	}	644	}
565		645
566	sub draw { }	646	sub draw { }
567		647
568	#############################################################################	648	#############################################################################
…		…
597	$self->{children} = [	677	$self->{children} = [
598	sort { $a->{z} <=> $b->{z} }	678	sort { $a->{z} <=> $b->{z} }
599	@{$self->{children}}, @widgets	679	@{$self->{children}}, @widgets
600	];	680	];
601		681
602	$self->check_size (1);	682	$self->realloc;
603	$self->update;
604	}	683	}
605		684
606	sub children {	685	sub children {
607	@{ $_[0]{children} }	686	@{ $_[0]{children} }
608	}	687	}
…		…
613	delete $child->{parent};	692	delete $child->{parent};
614	$child->hide;	693	$child->hide;
615		694
616	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	695	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
617		696
618	$self->check_size;	697	$self->realloc;
619	$self->update;
620	}	698	}
621		699
622	sub clear {	700	sub clear {
623	my ($self) = @_;	701	my ($self) = @_;
624		702
…		…
628	for (@$children) {	706	for (@$children) {
629	delete $_->{parent};	707	delete $_->{parent};
630	$_->hide;	708	$_->hide;
631	}	709	}
632		710
633	$self->check_size;	711	$self->realloc;
634	$self->update;
635	}	712	}
636		713
637	sub find_widget {	714	sub find_widget {
638	my ($self, $x, $y) = @_;	715	my ($self, $x, $y) = @_;
639		716
…		…
763		840
764	package CFClient::UI::ViewPort;	841	package CFClient::UI::ViewPort;
765		842
766	our @ISA = CFClient::UI::Window::;	843	our @ISA = CFClient::UI::Window::;
767		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
768	sub size_request {	855	sub size_request {
769	my ($self) = @_;	856	my ($self) = @_;
770		857
771	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	858	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
772		859
773	@$self{qw(child_w child_h)}	860	$w = 10 if $self->{scroll_x};
		861	$h = 10 if $self->{scroll_y};
		862
		863	($w, $h)
774	}	864	}
775		865
776	sub size_allocate {	866	sub size_allocate {
777	my ($self, $w, $h) = @_;	867	my ($self, $w, $h) = @_;
778		868
779	my ($cw, $ch) = @$self{qw(child_w child_h)};	869	my $child = $self->child;
780	# $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
781	$self->child->configure (0, 0, $cw, $ch);	874	$self->child->configure (0, 0, $w, $h);
782	$self->update;	875	$self->update;
783	}	876	}
784		877
785	sub set_offset {	878	sub set_offset {
786	my ($self, $x, $y) = @_;	879	my ($self, $x, $y) = @_;
…		…
837	my $class = shift;	930	my $class = shift;
838		931
839	my $self;	932	my $self;
840		933
841	my $slider = new CFClient::UI::Slider	934	my $slider = new CFClient::UI::Slider
842	vertical => 1,	935	vertical => 1,
843	range => [0, 0, 1, 0.01], # HACK fix	936	range => [0, 0, 1, 0.01], # HACK fix
844	connect_changed => sub {	937	on_changed => sub {
845	$self->{vp}->set_offset (0, $_[1]);	938	$self->{vp}->set_offset (0, $_[1]);
846	},	939	},
847	;	940	;
848		941
849	$self = $class->SUPER::new (	942	$self = $class->SUPER::new (
…		…
855	$self->{vp}->add ($self->{scrolled});	948	$self->{vp}->add ($self->{scrolled});
856	$self->add ($self->{vp});	949	$self->add ($self->{vp});
857	$self->add ($self->{slider});	950	$self->add ($self->{slider});
858		951
859	$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]);
860	}	963	}
861		964
862	sub size_allocate {	965	sub size_allocate {
863	my ($self, $w, $h) = @_;	966	my ($self, $w, $h) = @_;
864		967
…		…
917		1020
918	our @ISA = CFClient::UI::Bin::;	1021	our @ISA = CFClient::UI::Bin::;
919		1022
920	use CFClient::OpenGL;	1023	use CFClient::OpenGL;
921		1024
922	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 =
923	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1030	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
924	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);
925		1032
926	sub new {	1033	sub new {
927	my $class = shift;	1034	my $class = shift;
928
929	# TODO: user_x, user_y, overwrite moveto?
930		1035
931	my $self = $class->SUPER::new (	1036	my $self = $class->SUPER::new (
932	bg => [1, 1, 1, 1],	1037	bg => [1, 1, 1, 1],
933	border_bg => [1, 1, 1, 1],	1038	border_bg => [1, 1, 1, 1],
934	border => 0.6,	1039	border => 0.6,
935	is_toplevel => 1,
936	can_events => 1,	1040	can_events => 1,
		1041	min_w => 16,
		1042	min_h => 16,
937	@_	1043	@_
938	);	1044	);
939		1045
940	$self->{title} &&= new CFClient::UI::Label	1046	$self->{title} &&= new CFClient::UI::Label
941	align => 0,	1047	align => 0,
…		…
994	my ($ev, $x, $y) = @_;	1100	my ($ev, $x, $y) = @_;
995		1101
996	my $dx = $ev->{x} - $ox;	1102	my $dx = $ev->{x} - $ox;
997	my $dy = $ev->{y} - $oy;	1103	my $dy = $ev->{y} - $oy;
998		1104
999	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1105	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1000	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1106	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1107
		1108	$self->realloc;
1001	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1109	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1002	$self->check_size;
1003	};	1110	};
1004		1111
1005	} elsif ($lr ^ $td) {	1112	} elsif ($lr ^ $td) {
1006	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1113	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1007	my ($bx, $by) = ($self->{x}, $self->{y});	1114	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1009	$self->{motion} = sub {	1116	$self->{motion} = sub {
1010	my ($ev, $x, $y) = @_;	1117	my ($ev, $x, $y) = @_;
1011		1118
1012	($x, $y) = ($ev->{x}, $ev->{y});	1119	($x, $y) = ($ev->{x}, $ev->{y});
1013		1120
1014	$self->move ($bx + $x - $ox, $by + $y - $oy);	1121	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1015	$self->update;
1016	};	1122	};
1017	}	1123	}
1018	}	1124	}
1019		1125
1020	sub button_up {	1126	sub button_up {
…		…
1039	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1145	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1040		1146
1041	my $border = $self->border;	1147	my $border = $self->border;
1042		1148
1043	glColor @{ $self->{border_bg} };	1149	glColor @{ $self->{border_bg} };
1044	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1150	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1045	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1151	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1046	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1152	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1047	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1153	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1048		1154
1049	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1155	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1050	my $bg = $tex[0];	1156	glColor @{ $self->{bg} };
1051		1157
1052	# TODO: repeat texture not scale	1158	# TODO: repeat texture not scale
		1159	# solve this better(?)
1053	my $rep_x = $cw / $bg->{w};	1160	$bg->{s} = $cw / $bg->{w};
1054	my $rep_y = $ch / $bg->{h};	1161	$bg->{t} = $ch / $bg->{h};
1055
1056	glColor @{ $self->{bg} };
1057
1058	$bg->{s} = $rep_x;
1059	$bg->{t} = $rep_y;
1060	$bg->{wrap_mode} = 1;
1061	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1162	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1062	}	1163	}
1063		1164
1064	glDisable GL_TEXTURE_2D;	1165	glDisable GL_TEXTURE_2D;
1065		1166
…		…
1081	sub new {	1182	sub new {
1082	my $class = shift;	1183	my $class = shift;
1083		1184
1084	$class->SUPER::new (	1185	$class->SUPER::new (
1085	col_expand => [],	1186	col_expand => [],
1086	@_	1187	@_,
1087	)	1188	)
		1189	}
		1190
		1191	sub children {
		1192	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1088	}	1193	}
1089		1194
1090	sub add {	1195	sub add {
1091	my ($self, $x, $y, $child) = @_;	1196	my ($self, $x, $y, $child) = @_;
1092		1197
1093	$child->set_parent ($self);	1198	$child->set_parent ($self);
1094	$self->{children}[$y][$x] = $child;	1199	$self->{children}[$y][$x] = $child;
1095		1200
1096	$child->check_size;	1201	$self->realloc;
1097	}	1202	}
1098		1203
1099	sub children {
1100	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1101	}
1102
1103	# 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?
1104	sub clear {	1205	sub clear {
1105	my ($self) = @_;	1206	my ($self) = @_;
1106		1207
1107	my @children = $self->children;	1208	my @children = $self->children;
1108	delete $self->{children};	1209	delete $self->{children};
…		…
1110	for (@children) {	1211	for (@children) {
1111	delete $_->{parent};	1212	delete $_->{parent};
1112	$_->hide;	1213	$_->hide;
1113	}	1214	}
1114		1215
1115	$self->update;	1216	$self->realloc;
1116	}	1217	}
1117		1218
1118	sub get_wh {	1219	sub get_wh {
1119	my ($self) = @_;	1220	my ($self) = @_;
1120		1221
…		…
1151	sub size_allocate {	1252	sub size_allocate {
1152	my ($self, $w, $h) = @_;	1253	my ($self, $w, $h) = @_;
1153		1254
1154	my ($ws, $hs) = $self->get_wh;	1255	my ($ws, $hs) = $self->get_wh;
1155		1256
1156	my $req_w = sum @$ws;	1257	my $req_w = (sum @$ws) || 1;
1157	my $req_h = sum @$hs;	1258	my $req_h = (sum @$hs) || 1;
1158		1259
1159	# TODO: nicer code && do row_expand	1260	# TODO: nicer code && do row_expand
1160	my @col_expand = @{$self->{col_expand}};	1261	my @col_expand = @{$self->{col_expand}};
1161	@col_expand = (1) x @$ws unless @col_expand;	1262	@col_expand = (1) x @$ws unless @col_expand;
1162	my $col_expand = (sum @col_expand) || 1;	1263	my $col_expand = (sum @col_expand) || 1;
…		…
1216	}	1317	}
1217	}	1318	}
1218		1319
1219	#############################################################################	1320	#############################################################################
1220		1321
1221	package CFClient::UI::HBox;	1322	package CFClient::UI::Box;
1222
1223	# TODO: wrap into common Box base class
1224		1323
1225	our @ISA = CFClient::UI::Container::;	1324	our @ISA = CFClient::UI::Container::;
1226		1325
1227	sub size_request {	1326	sub size_request {
1228	my ($self) = @_;	1327	my ($self) = @_;
1229		1328
1230	my @alloc = map [$_->size_request], @{$self->{children}};	1329	$self->{vertical}
1231		1330	? (
1232	(	1331	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1233	(List::Util::sum map $_->[0], @alloc),	1332	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1234	(List::Util::max map $_->[1], @alloc),	1333	)
1235	)	1334	: (
		1335	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1336	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1337	)
1236	}	1338	}
1237		1339
1238	sub size_allocate {	1340	sub size_allocate {
1239	my ($self, $w, $h) = @_;	1341	my ($self, $w, $h) = @_;
1240		1342
1241	($h, $w) = ($w, $h);	1343	my $space = $self->{vertical} ? $h : $w;
1242
1243	my $children = $self->{children};	1344	my $children = $self->{children};
1244		1345
1245	my @h = map $_->{req_w}, @$children;	1346	my @req;
1246		1347
1247	my $req_h = List::Util::sum @h;	1348	if ($self->{homogeneous}) {
1248		1349	@req = ($space / (@$children || 1)) x @$children;
1249	if ($req_h > $h) {
1250	# ah well, not enough space
1251	$_ *= $h / $req_h for @h;
1252	} 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 {
1253	my $exp = List::Util::sum map $_->{expand}, @$children;	1358	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1254	$exp ||= 1;
1255		1359
		1360	$space = ($space - $req) / $expand; # remaining space to give away
		1361
		1362	$req[$_] += $space * $children->[$_]{expand}
1256	for (0 .. $#$children) {	1363	for 0 .. $#$children;
1257	my $child = $children->[$_];
1258
1259	my $alloc_h = $h[$_];
1260	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1261	$h[$_] = $alloc_h;
1262	}	1364	}
1263	}	1365	}
1264		1366
1265	CFClient::UI::harmonize \@h;	1367	CFClient::UI::harmonize \@req;
1266		1368
1267	my $y = 0;	1369	my $pos = 0;
1268	for (0 .. $#$children) {	1370	for (0 .. $#$children) {
1269	my $child = $children->[$_];
1270	my $h = $h[$_];	1371	my $alloc = $req[$_];
1271	$child->configure ($y, 0, $h, $w);	1372	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1272		1373
1273	$y += $h;	1374	$pos += $alloc;
1274	}	1375	}
1275		1376
1276	1	1377	1
1277	}	1378	}
1278		1379
1279	#############################################################################	1380	#############################################################################
1280		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
1281	package CFClient::UI::VBox;	1397	package CFClient::UI::VBox;
1282		1398
1283	# TODO: wrap into common Box base class
1284
1285	our @ISA = CFClient::UI::Container::;	1399	our @ISA = CFClient::UI::Box::;
1286		1400
1287	sub size_request {	1401	sub new {
1288	my ($self) = @_;	1402	my $class = shift;
1289		1403
1290	my @alloc = map [$_->size_request], @{$self->{children}};	1404	$class->SUPER::new (
1291		1405	vertical => 1,
1292	(	1406	@_,
1293	(List::Util::max map $_->[0], @alloc),
1294	(List::Util::sum map $_->[1], @alloc),
1295	)	1407	)
1296	}
1297
1298	sub size_allocate {
1299	my ($self, $w, $h) = @_;
1300
1301	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1302
1303	my $children = $self->{children};
1304
1305	my @h = map $_->{req_h}, @$children;
1306
1307	my $req_h = List::Util::sum @h;
1308
1309	if ($req_h > $h) {
1310	# ah well, not enough space
1311	$_ *= $h / $req_h for @h;
1312	} else {
1313	my $exp = List::Util::sum map $_->{expand}, @$children;
1314	$exp ||= 1;
1315
1316	for (0 .. $#$children) {
1317	my $child = $children->[$_];
1318
1319	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1320	}
1321	}
1322
1323	CFClient::UI::harmonize \@h;
1324
1325	my $y = 0;
1326	for (0 .. $#$children) {
1327	my $child = $children->[$_];
1328	my $h = $h[$_];
1329	$child->configure (0, $y, $w, $h);
1330
1331	$y += $h;
1332	}
1333
1334	1
1335	}	1408	}
1336		1409
1337	#############################################################################	1410	#############################################################################
1338		1411
1339	package CFClient::UI::Label;	1412	package CFClient::UI::Label;
…		…
1356	ellipsise => 3, # end	1429	ellipsise => 3, # end
1357	layout => (new CFClient::Layout),	1430	layout => (new CFClient::Layout),
1358	fontsize => 1,	1431	fontsize => 1,
1359	align => -1,	1432	align => -1,
1360	valign => -1,	1433	valign => -1,
1361	padding => 2,	1434	padding_x => 2,
		1435	padding_y => 2,
1362	can_events => 0,	1436	can_events => 0,
1363	%arg	1437	%arg
1364	);	1438	);
1365		1439
1366	if (exists $self->{template}) {	1440	if (exists $self->{template}) {
…		…
1402	$self->{text} = "T$text";	1476	$self->{text} = "T$text";
1403		1477
1404	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1478	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1405	$self->{layout}->set_text ($text);	1479	$self->{layout}->set_text ($text);
1406		1480
		1481	$self->realloc;
1407	$self->update;	1482	$self->update;
1408	$self->check_size;
1409	}	1483	}
1410		1484
1411	sub set_markup {	1485	sub set_markup {
1412	my ($self, $markup) = @_;	1486	my ($self, $markup) = @_;
1413		1487
…		…
1417	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1491	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1418		1492
1419	$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;
1420	$self->{layout}->set_markup ($markup);	1494	$self->{layout}->set_markup ($markup);
1421		1495
		1496	$self->realloc;
1422	$self->update;	1497	$self->update;
1423	$self->check_size;
1424	}	1498	}
1425		1499
1426	sub size_request {	1500	sub size_request {
1427	my ($self) = @_;	1501	my ($self) = @_;
1428		1502
…		…
1442		1516
1443	$w = List::Util::max $w, $w2;	1517	$w = List::Util::max $w, $w2;
1444	$h = List::Util::max $h, $h2;	1518	$h = List::Util::max $h, $h2;
1445	}	1519	}
1446		1520
1447	(	1521	($w, $h)
1448	$w + $self->{padding} * 2,
1449	$h + $self->{padding} * 2,
1450	)
1451	}	1522	}
1452		1523
1453	sub size_allocate {	1524	sub size_allocate {
1454	my ($self, $w, $h) = @_;	1525	my ($self, $w, $h) = @_;
1455		1526
…		…
1460	my ($self, $fontsize) = @_;	1531	my ($self, $fontsize) = @_;
1461		1532
1462	$self->{fontsize} = $fontsize;	1533	$self->{fontsize} = $fontsize;
1463	delete $self->{texture};	1534	delete $self->{texture};
1464		1535
1465	$self->update;	1536	$self->realloc;
1466	$self->check_size;
1467	}	1537	}
1468		1538
1469	sub _draw {	1539	sub _draw {
1470	my ($self) = @_;	1540	my ($self) = @_;
1471		1541
…		…
1479	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1549	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1480	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1550	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1481		1551
1482	my $tex = new_from_layout CFClient::Texture $self->{layout};	1552	my $tex = new_from_layout CFClient::Texture $self->{layout};
1483		1553
1484	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1554	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1485	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1555	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1486	: ($self->{w} - $tex->{w}) * 0.5);	1556	: ($self->{w} - $tex->{w}) * 0.5);
1487		1557
1488	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1558	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1489	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1559	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1490	: ($self->{h} - $tex->{h}) * 0.5);	1560	: ($self->{h} - $tex->{h}) * 0.5);
1491		1561
1492	$tex	1562	$tex
1493	};	1563	};
1494		1564
…		…
1551	sub set_text {	1621	sub set_text {
1552	my ($self, $text) = @_;	1622	my ($self, $text) = @_;
1553		1623
1554	$self->{cursor} = length $text;	1624	$self->{cursor} = length $text;
1555	$self->_set_text ($text);	1625	$self->_set_text ($text);
1556	$self->update;	1626
1557	$self->check_size;	1627	$self->realloc;
1558	}	1628	}
1559		1629
1560	sub get_text {	1630	sub get_text {
1561	$_[0]{text}	1631	$_[0]{text}
1562	}	1632	}
…		…
1595	} elsif ($uni) {	1665	} elsif ($uni) {
1596	substr $text, $self->{cursor}++, 0, chr $uni;	1666	substr $text, $self->{cursor}++, 0, chr $uni;
1597	}	1667	}
1598		1668
1599	$self->_set_text ($text);	1669	$self->_set_text ($text);
1600	$self->update;	1670
1601	$self->check_size;	1671	$self->realloc;
1602	}	1672	}
1603		1673
1604	sub focus_in {	1674	sub focus_in {
1605	my ($self) = @_;	1675	my ($self) = @_;
1606		1676
…		…
1733		1803
1734	sub new {	1804	sub new {
1735	my $class = shift;	1805	my $class = shift;
1736		1806
1737	$class->SUPER::new (	1807	$class->SUPER::new (
1738	padding => 4,	1808	padding_x => 4,
		1809	padding_y => 4,
1739	fg => [1, 1, 1],	1810	fg => [1, 1, 1],
1740	active_fg => [0, 0, 1],	1811	active_fg => [0, 0, 1],
1741	can_hover => 1,	1812	can_hover => 1,
1742	align => 0,	1813	align => 0,
1743	valign => 0,	1814	valign => 0,
…		…
1790		1861
1791	sub new {	1862	sub new {
1792	my $class = shift;	1863	my $class = shift;
1793		1864
1794	$class->SUPER::new (	1865	$class->SUPER::new (
1795	padding => 2,	1866	padding_x => 2,
		1867	padding_y => 2,
1796	fg => [1, 1, 1],	1868	fg => [1, 1, 1],
1797	active_fg => [1, 1, 0],	1869	active_fg => [1, 1, 0],
1798	bg => [0, 0, 0, 0.2],	1870	bg => [0, 0, 0, 0.2],
1799	active_bg => [1, 1, 1, 0.5],	1871	active_bg => [1, 1, 1, 0.5],
1800	state => 0,	1872	state => 0,
…		…
1804	}	1876	}
1805		1877
1806	sub size_request {	1878	sub size_request {
1807	my ($self) = @_;	1879	my ($self) = @_;
1808		1880
1809	($self->{padding} * 2 + 6) x 2	1881	(6) x 2
1810	}	1882	}
1811		1883
1812	sub button_down {	1884	sub button_down {
1813	my ($self, $ev, $x, $y) = @_;	1885	my ($self, $ev, $x, $y) = @_;
1814		1886
1815	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1816	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1817	$self->{state} = !$self->{state};	1889	$self->{state} = !$self->{state};
1818	$self->_emit (changed => $self->{state});	1890	$self->_emit (changed => $self->{state});
1819	}	1891	}
1820	}	1892	}
1821		1893
1822	sub _draw {	1894	sub _draw {
1823	my ($self) = @_;	1895	my ($self) = @_;
1824		1896
1825	$self->SUPER::_draw;	1897	$self->SUPER::_draw;
1826		1898
1827	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1899	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1828		1900
1829	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;
1830		1904
1831	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1905	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1832		1906
1833	my $tex = $self->{state} ? $tex[1] : $tex[0];	1907	my $tex = $self->{state} ? $tex[1] : $tex[0];
1834		1908
…		…
2099	fg => [1, 1, 1],	2173	fg => [1, 1, 1],
2100	active_fg => [0, 0, 0],	2174	active_fg => [0, 0, 0],
2101	bg => [0, 0, 0, 0.2],	2175	bg => [0, 0, 0, 0.2],
2102	active_bg => [1, 1, 1, 0.5],	2176	active_bg => [1, 1, 1, 0.5],
2103	range => [0, 0, 100, 10, 0],	2177	range => [0, 0, 100, 10, 0],
2104	req_w => $::WIDTH / 80,	2178	min_w => $::WIDTH / 80,
2105	req_h => $::WIDTH / 80,	2179	min_h => $::WIDTH / 80,
2106	vertical => 0,	2180	vertical => 0,
2107	can_hover => 1,	2181	can_hover => 1,
2108	inner_pad => 0.02,	2182	inner_pad => 0.02,
2109	@_	2183	@_
2110	);	2184	);
…		…
2113	$self->update;	2187	$self->update;
2114		2188
2115	$self	2189	$self
2116	}	2190	}
2117		2191
		2192	sub changed { }
		2193
2118	sub set_range {	2194	sub set_range {
2119	my ($self, $range) = @_;	2195	my ($self, $range) = @_;
2120		2196
2121	$self->{range} = $range;	2197	($range, $self->{range}) = ($self->{range}, $range);
2122		2198
2123	$self->update;	2199	$self->update
		2200	if "@$range" ne "@{$self->{range}}";
2124	}	2201	}
2125		2202
2126	sub set_value {	2203	sub set_value {
2127	my ($self, $value) = @_;	2204	my ($self, $value) = @_;
2128		2205
…		…
2147	}	2224	}
2148		2225
2149	sub size_request {	2226	sub size_request {
2150	my ($self) = @_;	2227	my ($self) = @_;
2151		2228
2152	my $w = $self->{req_w};	2229	($self->{req_w}, $self->{req_h})
2153	my $h = $self->{req_h};
2154
2155	$self->{vertical} ? ($h, $w) : ($w, $h)
2156	}	2230	}
2157		2231
2158	sub button_down {	2232	sub button_down {
2159	my ($self, $ev, $x, $y) = @_;	2233	my ($self, $ev, $x, $y) = @_;
2160		2234
…		…
2511		2585
2512	sub new {	2586	sub new {
2513	my $class = shift;	2587	my $class = shift;
2514		2588
2515	my $self = $class->SUPER::new (	2589	my $self = $class->SUPER::new (
2516	state => 0,	2590	state => 0,
2517	connect_activate => \&toggle_flopper,	2591	on_activate => \&toggle_flopper,
2518	@_	2592	@_
2519	);	2593	);
2520		2594
2521	if ($self->{state}) {
2522	$self->{state} = 0;
2523	$self->toggle_flopper;
2524	}
2525
2526	$self	2595	$self
2527	}	2596	}
2528		2597
2529	sub toggle_flopper {	2598	sub toggle_flopper {
2530	my ($self) = @_;	2599	my ($self) = @_;
2531		2600
2532	# TODO: use animation	2601	$self->{other}->toggle_visibility;
2533	if ($self->{state} = !$self->{state}) {
2534	$CFClient::UI::ROOT->add ($self->{other});
2535	$self->{other}->move ($self->coord2global (0, $self->{h}));
2536	$self->_emit ("open");
2537	} else {
2538	$CFClient::UI::ROOT->remove ($self->{other});
2539	$self->_emit ("close");
2540	}
2541
2542	$self->_emit (changed => $self->{state});
2543	}	2602	}
2544		2603
2545	#############################################################################	2604	#############################################################################
2546		2605
2547	package CFClient::UI::Tooltip;	2606	package CFClient::UI::Tooltip;
…		…
2560	}	2619	}
2561		2620
2562	sub set_tooltip_from {	2621	sub set_tooltip_from {
2563	my ($self, $widget) = @_;	2622	my ($self, $widget) = @_;
2564		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
2565	$self->add (new CFClient::UI::Label	2633	$self->add (new CFClient::UI::Label
2566	markup => $widget->{tooltip},	2634	markup => $tooltip,
2567	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2635	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2568	fontsize => 0.8,	2636	fontsize => 0.8,
2569	fg => [0, 0, 0, 1],	2637	fg => [0, 0, 0, 1],
2570	ellipsise => 0,	2638	ellipsise => 0,
2571	font => ($widget->{tooltip_font} || $::FONT_PROP),	2639	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2582		2650
2583	sub size_allocate {	2651	sub size_allocate {
2584	my ($self, $w, $h) = @_;	2652	my ($self, $w, $h) = @_;
2585		2653
2586	$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	});
2587	}	2673	}
2588		2674
2589	sub _draw {	2675	sub _draw {
2590	my ($self) = @_;	2676	my ($self) = @_;
2591		2677
…		…
2608	glVertex $w, $h;	2694	glVertex $w, $h;
2609	glVertex $w, 0;	2695	glVertex $w, 0;
2610	glEnd;	2696	glEnd;
2611		2697
2612	glTranslate 2 - 0.375, 2 - 0.375;	2698	glTranslate 2 - 0.375, 2 - 0.375;
		2699
2613	$self->SUPER::_draw;	2700	$self->SUPER::_draw;
2614	}	2701	}
2615		2702
2616	#############################################################################	2703	#############################################################################
2617		2704
…		…
2623		2710
2624	sub new {	2711	sub new {
2625	my $class = shift;	2712	my $class = shift;
2626		2713
2627	my $self = $class->SUPER::new (	2714	my $self = $class->SUPER::new (
2628	aspect => 1,	2715	aspect => 1,
		2716	can_events => 0,
2629	@_,	2717	@_,
2630	);	2718	);
2631		2719
2632	if ($self->{anim} && $self->{animspeed}) {	2720	if ($self->{anim} && $self->{animspeed}) {
2633	Scalar::Util::weaken (my $widget = $self);	2721	Scalar::Util::weaken (my $widget = $self);
…		…
2692	$self->SUPER::DESTROY;	2780	$self->SUPER::DESTROY;
2693	}	2781	}
2694		2782
2695	#############################################################################	2783	#############################################################################
2696		2784
2697	package CFClient::UI::InventoryItem;	2785	package CFClient::UI::Inventory;
2698		2786
2699	our @ISA = CFClient::UI::HBox::;	2787	our @ISA = CFClient::UI::ScrolledWindow::;
2700
2701	sub _item_to_desc {
2702	my ($item) = @_;
2703
2704	my $desc =
2705	$item->{nrof} < 2
2706	? $item->{name}
2707	: "$item->{nrof} × $item->{name_pl}";
2708
2709	$item->{flags} & Crossfire::Protocol::F_OPEN
2710	and $desc .= " (open)";
2711	$item->{flags} & Crossfire::Protocol::F_APPLIED
2712	and $desc .= " (applied)";
2713	$item->{flags} & Crossfire::Protocol::F_UNPAID
2714	and $desc .= " (unpaid)";
2715	$item->{flags} & Crossfire::Protocol::F_MAGIC
2716	and $desc .= " (magic)";
2717	$item->{flags} & Crossfire::Protocol::F_CURSED
2718	and $desc .= " (cursed)";
2719	$item->{flags} & Crossfire::Protocol::F_DAMNED
2720	and $desc .= " (damned)";
2721	$item->{flags} & Crossfire::Protocol::F_LOCKED
2722	and $desc .= " *";
2723
2724	$desc
2725	}
2726		2788
2727	sub new {	2789	sub new {
2728	my $class = shift;	2790	my $class = shift;
2729		2791
2730	my %args = @_;
2731
2732	my $item = delete $args{item};
2733
2734	my $desc = _item_to_desc ($item);
2735
2736	my $self = $class->SUPER::new (	2792	my $self = $class->SUPER::new (
2737	can_hover => 1,
2738	can_events => 1,
2739	tooltip => ((CFClient::UI::Label::escape $desc)
2740	. "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2741	connect_button_down => sub {
2742	my ($self, $ev, $x, $y) = @_;
2743
2744	# todo: maybe put examine on 1? but should just be a tooltip :(
2745	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2746	my $targ = $::CONN->{player}{tag};
2747
2748	if ($item->{container} == $::CONN->{player}{tag}) {
2749	$targ = $main::OPENCONT;
2750	}
2751
2752	$::CONN->send ("move $targ $item->{tag} 0");
2753	} elsif ($ev->{button} == 1) {
2754	$::CONN->send ("examine $item->{tag}");
2755	} elsif ($ev->{button} == 2) {
2756	$::CONN->send ("apply $item->{tag}");
2757	} elsif ($ev->{button} == 3) {
2758	my @menu_items = (
2759	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2760	["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2761	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2762	(
2763	$item->{flags} & Crossfire::Protocol::F_LOCKED
2764	? (
2765	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2766	)
2767	: (
2768	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2769	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2770	)
2771	),
2772	);
2773
2774	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2775	}
2776
2777	1
2778	},
2779	%args
2780	);
2781
2782
2783	$self->add (new CFClient::UI::Face
2784	can_events => 0,
2785	face => $item->{face},
2786	anim => $item->{anim},
2787	animspeed => $item->{animspeed},
2788	);
2789
2790	$self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2791
2792	$self->{item} = $item;
2793
2794	$self->update_item;
2795
2796	$self
2797	}
2798
2799	sub update_item {
2800	my ($self) = @_;
2801
2802	my $desc = _item_to_desc ($self->{item});
2803
2804	$self->{name_lbl}->set_text ($desc);
2805	}
2806
2807	#############################################################################
2808
2809	package CFClient::UI::Inventory;
2810
2811	our @ISA = CFClient::UI::ScrolledWindow::;
2812
2813	sub new {
2814	my $class = shift;
2815
2816	my $self = $class->SUPER::new (
2817	scrolled => (new CFClient::UI::Table),	2793	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2818	@_,	2794	@_,
2819	);	2795	);
2820		2796
2821	$self	2797	$self
2822	}	2798	}
…		…
2832	or ($a->{name} cmp $b->{name})	2808	or ($a->{name} cmp $b->{name})
2833	} @$items;	2809	} @$items;
2834		2810
2835	$self->{real_items} = \@items;	2811	$self->{real_items} = \@items;
2836		2812
		2813	my $row = 0;
2837	for my $item (@items) {	2814	for my $item (@items) {
2838	$item->{item} = $item;	2815	CFClient::Item::update_widgets $item;
2839	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2840	$item->update_item ();
2841	}
2842		2816
2843	my $i = 0;	2817	$self->{scrolled}->add (0, $row, $item->{face_widget});
2844	for (@items) {	2818	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2845	$self->{scrolled}->add (0, $i, $_);	2819	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2846	my $nrof = $_->{item}->{nrof} || 1;
2847	$self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2848	}
2849		2820
2850	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];	2821	$row++;
2851	}	2822	}
2852
2853	sub size_request {
2854	my ($self) = @_;
2855	($self->{req_w}, $self->{req_h});
2856	}	2823	}
2857		2824
2858	#############################################################################	2825	#############################################################################
2859		2826
2860	package CFClient::UI::Menu;	2827	package CFClient::UI::Menu;
…		…
2902	# maybe save $GRAB? must be careful about events...	2869	# maybe save $GRAB? must be careful about events...
2903	$GRAB = $self;	2870	$GRAB = $self;
2904	$self->{button} = $ev->{button};	2871	$self->{button} = $ev->{button};
2905		2872
2906	$self->show;	2873	$self->show;
2907	$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);
2908	}	2875	}
2909		2876
2910	sub mouse_motion {	2877	sub mouse_motion {
2911	my ($self, $ev, $x, $y) = @_;	2878	my ($self, $ev, $x, $y) = @_;
2912		2879
…		…
2992	sub add {	2959	sub add {
2993	my ($self, $text, %arg) = @_;	2960	my ($self, $text, %arg) = @_;
2994		2961
2995	$text =~ s/^\s+//;	2962	$text =~ s/^\s+//;
2996	$text =~ s/\s+$//;	2963	$text =~ s/\s+$//;
		2964
		2965	return unless $text;
2997		2966
2998	my $timeout = time + ((delete $arg{timeout}) || 60);	2967	my $timeout = time + ((delete $arg{timeout}) || 60);
2999		2968
3000	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	2969	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
3001		2970
…		…
3044	use CFClient::OpenGL;	3013	use CFClient::OpenGL;
3045		3014
3046	sub new {	3015	sub new {
3047	my $class = shift;	3016	my $class = shift;
3048		3017
3049	$class->SUPER::new (	3018	my $self = $class->SUPER::new (
		3019	visible => 1,
3050	@_,	3020	@_,
3051	)	3021	);
3052	}
3053		3022
3054	sub configure {	3023	Scalar::Util::weaken ($self->{root} = $self);
3055	my ($self, $x, $y, $w, $h) = @_;
3056		3024
3057	$self->{w} = $w;	3025	$self
3058	$self->{h} = $h;
3059	}
3060
3061	sub check_size {
3062	my ($self) = @_;
3063
3064	$self->size_allocate ($self->{w}, $self->{h})
3065	if $self->{w};
3066	}	3026	}
3067		3027
3068	sub size_request {	3028	sub size_request {
3069	my ($self) = @_;	3029	my ($self) = @_;
3070		3030
3071	($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
3072	}	3046	}
3073		3047
3074	sub size_allocate {	3048	sub size_allocate {
3075	my ($self, $w, $h) = @_;	3049	my ($self, $w, $h) = @_;
3076		3050
3077	for my $child ($self->children) {	3051	for my $child ($self->children) {
3078	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)};
3079		3053
3080	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3054	$X = $child->{force_x} if exists $child->{force_x};
3081	if exists $child->{req_x};	3055	$Y = $child->{force_y} if exists $child->{force_y};
3082		3056
3083	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3057	$X = _to_pixel $X, $W, $self->{w};
3084	if exists $child->{req_y};	3058	$Y = _to_pixel $Y, $H, $self->{h};
3085
3086	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3087	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3088		3059
3089	$child->configure ($X, $Y, $W, $H);	3060	$child->configure ($X, $Y, $W, $H);
3090	}	3061	}
3091	}	3062	}
3092		3063
…		…
3103	}	3074	}
3104		3075
3105	sub update {	3076	sub update {
3106	my ($self) = @_;	3077	my ($self) = @_;
3107		3078
3108	$self->check_size;
3109	$::WANT_REFRESH++;	3079	$::WANT_REFRESH++;
3110	}	3080	}
3111		3081
3112	sub add {	3082	sub add {
3113	my ($self, @children) = @_;	3083	my ($self, @children) = @_;
3114		3084
3115	for (my @widgets = @children; my $w = pop @widgets; ) {
3116	push @widgets, $w->children;
3117	$w->{root} = $self;
3118	$w->{visible} = 1;
3119	}
3120
3121	for my $child (@children) {
3122	$child->{is_toplevel} = 1;	3085	$_->{is_toplevel} = 1
3123		3086	for @children;
3124	# integerise window positions
3125	$child->{x} = int $child->{x};
3126	$child->{y} = int $child->{y};
3127	}
3128		3087
3129	$self->SUPER::add (@children);	3088	$self->SUPER::add (@children);
3130	}	3089	}
3131		3090
3132	sub remove {	3091	sub remove {
3133	my ($self, @children) = @_;	3092	my ($self, @children) = @_;
3134		3093
3135	$self->SUPER::remove (@children);	3094	$self->SUPER::remove (@children);
		3095
		3096	delete $self->{is_toplevel}
		3097	for @children;
3136		3098
3137	while (@children) {	3099	while (@children) {
3138	my $w = pop @children;	3100	my $w = pop @children;
3139	push @children, $w->children;	3101	push @children, $w->children;
3140	$w->set_invisible;	3102	$w->set_invisible;
…		…
3159	while ($self->{refresh_hook}) {	3121	while ($self->{refresh_hook}) {
3160	$_->()	3122	$_->()
3161	for values %{delete $self->{refresh_hook}};	3123	for values %{delete $self->{refresh_hook}};
3162	}	3124	}
3163		3125
3164	if ($self->{check_size}) {	3126	if ($self->{realloc}) {
3165	my @queue = ([], []);	3127	my @queue;
3166		3128
3167	for (;;) {	3129	while () {
3168	if ($self->{check_size}) {	3130	if ($self->{realloc}) {
3169	# heuristic: check containers last	3131	#TODO use array-of-depth approach
3170	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3132
3171	for values %{delete $self->{check_size}}	3133	use sort 'stable';
		3134
		3135	@queue = sort { $a->{visible} <=> $b->{visible} }
		3136	@queue, values %{delete $self->{realloc}};
3172	}	3137	}
3173		3138
3174	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3139	my $widget = pop @queue || last;
3175		3140
3176	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3141	$widget->{visible} or last; # do not resize invisible widgets
3177	? @$widget{qw(user_w user_h)}	3142
3178	: $widget->size_request;	3143	my ($w, $h) = $widget->size_request;
3179		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
3180	if (delete $widget->{force_alloc}	3152	|| delete $widget->{force_realloc}) {
3181	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3182	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3183
3184	$widget->{req_w} = $w;	3153	$widget->{req_w} = $w;
3185	$widget->{req_h} = $h;	3154	$widget->{req_h} = $h;
3186		3155
3187	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3156	$self->{size_alloc}{$widget+0} = $widget;
3188		3157
3189	$widget->{parent}->check_size
3190	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	}
3191	}	3164	}
		3165
		3166	delete $self->{realloc}{$widget+0};
3192	}	3167	}
3193	}	3168	}
3194		3169
3195	while ($self->{size_alloc}) {	3170	while (my $size_alloc = delete $self->{size_alloc}) {
3196	for (values %{delete $self->{size_alloc}}) {	3171	my @queue = sort { $b->{visible} <=> $a->{visible} }
3197	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)};
3198		3178
3199	$w = 0 if $w < 0;	3179	$w = 0 if $w < 0;
3200	$h = 0 if $h < 0;	3180	$h = 0 if $h < 0;
3201		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}) {
3202	$widget->{w} = $w;	3186	$widget->{w} = $w;
3203	$widget->{h} = $h;	3187	$widget->{h} = $h;
		3188
3204	$widget->emit (size_allocate => $w, $h);	3189	$widget->emit (size_allocate => $w, $h);
		3190	}
3205	}	3191	}
3206	}	3192	}
3207		3193
3208	while ($self->{post_alloc_hook}) {	3194	while ($self->{post_alloc_hook}) {
3209	$_->()	3195	$_->()
3210	for values %{delete $self->{post_alloc_hook}};	3196	for values %{delete $self->{post_alloc_hook}};
3211	}	3197	}
		3198
3212		3199
3213	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3200	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3214	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3201	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3215	glClear GL_COLOR_BUFFER_BIT;	3202	glClear GL_COLOR_BUFFER_BIT;
3216		3203
…		…
3223	$self->_draw;	3210	$self->_draw;
3224	}	3211	}
3225		3212
3226	#############################################################################	3213	#############################################################################
3227		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
3228	package CFClient::UI;	3465	package CFClient::UI;
3229		3466
3230	$ROOT = new CFClient::UI::Root;	3467	$ROOT = new CFClient::UI::Root;
3231	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	3468	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
3232		3469

Diff Legend

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