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.250 by root, Sun May 28 02:31:03 2006 UTC vs.
Revision 1.267 by root, Thu Jun 1 04:10:29 2006 UTC

…		…
17	our $BUTTON_STATE;	17	our $BUTTON_STATE;
18		18
19	our %WIDGET; # all widgets, weak-referenced	19	our %WIDGET; # all widgets, weak-referenced
20		20
21	sub get_layout {	21	sub get_layout {
		22	my $layout;
		23
22	for (grep { $_->{name} } values %WIDGET) {	24	for (grep { $_->{name} } values %WIDGET) {
23	$LAYOUT->{$_->{name}} = {	25	my $win = $layout->{$_->{name}} = { };
24	x => $_->{x} / $::WIDTH,
25	y => $_->{y} / $::HEIGHT,
26	w => $_->{w} / $::WIDTH,
27	h => $_->{h} / $::HEIGHT
28	};	26
29	}	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};
30		31
31	return $LAYOUT;	32	$win->{show} = $_->{visible} && $_->{is_toplevel};
		33	}
		34
		35	$layout
32	}	36	}
33		37
34	sub set_layout {	38	sub set_layout {
35	my ($layout) = @_;	39	my ($layout) = @_;
		40
36	$LAYOUT = $layout;	41	$LAYOUT = $layout;
37	}	42	}
38		43
39	sub check_tooltip {	44	sub check_tooltip {
		45	return if $ENV{CFPLUS_DEBUG} & 8;
		46
40	if (!$GRAB) {	47	if (!$GRAB) {
41	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	48	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
42	if (length $widget->{tooltip}) {	49	if (length $widget->{tooltip}) {
43
44	if ($TOOLTIP->{owner} != $widget) {	50	if ($TOOLTIP->{owner} != $widget) {
		51	$TOOLTIP->hide;
		52
45	$TOOLTIP->{owner} = $widget;	53	$TOOLTIP->{owner} = $widget;
46		54
47	my $tip = $widget->{tooltip};	55	my $tip = $widget->{tooltip};
48		56
49	$tip = $tip->($widget) if CODE:: eq ref $tip;	57	$tip = $tip->($widget) if CODE:: eq ref $tip;
50		58
51	$TOOLTIP->set_tooltip_from ($widget);	59	$TOOLTIP->set_tooltip_from ($widget);
52	$TOOLTIP->show;	60	$TOOLTIP->show;
53
54	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
55
56	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
57	if $x + $TOOLTIP->{w} > $::WIDTH;
58
59	$TOOLTIP->move ($x, $y);
60	$TOOLTIP->check_size;
61	$TOOLTIP->update;
62	}	61	}
63		62
64	return;	63	return;
65	}	64	}
66	}	65	}
…		…
172	sub rescale_widgets {	171	sub rescale_widgets {
173	my ($sx, $sy) = @_;	172	my ($sx, $sy) = @_;
174		173
175	for my $widget (values %WIDGET) {	174	for my $widget (values %WIDGET) {
176	if ($widget->{is_toplevel}) {	175	if ($widget->{is_toplevel}) {
		176	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		177	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		178
177	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};	179	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
178	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};	180	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
179	$widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};	181	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
180	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};	182	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
181	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	183	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
182	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};	184	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
		185
		186	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		187	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		188
183	}	189	}
184	}	190	}
185		191
186	reconfigure_widgets;	192	reconfigure_widgets;
187	}	193	}
…		…
196		202
197	sub new {	203	sub new {
198	my $class = shift;	204	my $class = shift;
199		205
200	my $self = bless {	206	my $self = bless {
201	x => 0,	207	x => "center",
202	y => 0,	208	y => "center",
203	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
204	can_events => 1,	212	can_events => 1,
205	@_	213	@_
206	}, $class;	214	}, $class;
		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
207		217
208	for (keys %$self) {	218	for (keys %$self) {
209	if (/^on_(.*)$/) {	219	if (/^on_(.*)$/) {
210	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
211	}	221	}
212	}	222	}
213		223
214	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
215
216	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
217	$self->{req_x} = $layout->{x} * $::WIDTH;	225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
218	$self->{req_y} = $layout->{y} * $::HEIGHT;	226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
219	$self->{def_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH;	227	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
220	$self->{def_h} = ($layout->{h} != 0 ? $layout->{h} : 1) * $::HEIGHT;	228	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		229
		230	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		231	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		232
		233	$self->show if $layout->{show};
221	}	234	}
222		235
223	$self	236	$self
224	}	237	}
225		238
…		…
236	return if $self->{parent};	249	return if $self->{parent};
237		250
238	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
239	}	252	}
240		253
241	sub center {
242	my ($self) = @_;
243
244	$CFClient::UI::ROOT->on_post_alloc (
245	"center_$self" => sub {
246	$self->move (($self->{parent}{w} - $self->{w}) * 0.5, ($self->{parent}{h} - $self->{h}) * 0.5);
247	},
248	);
249
250	$self->update;
251	}
252
253	sub set_visible {	254	sub set_visible {
254	my ($self) = @_;	255	my ($self) = @_;
255		256
256	return if $self->{visible};	257	return if $self->{visible};
257		258
258	$self->{root} = $self->{parent}{root};	259	$self->{root} = $self->{parent}{root};
259	$self->{visible} = $self->{parent}{visible} + 1;	260	$self->{visible} = $self->{parent}{visible} + 1;
260		261
261	$self->emit (visibility_change => 1);	262	$self->emit (visibility_change => 1);
		263
		264	$self->realloc if !exists $self->{req_w};
		265
		266	$_->set_visible for $self->children;
262	}	267	}
263		268
264	sub set_invisible {	269	sub set_invisible {
265	my ($self) = @_;	270	my ($self) = @_;
266		271
267	return unless $self->{visible};	272	return unless $self->{visible};
268		273
269	# broken show/hide model	274	$_->set_invisible for $self->children;
270		275
271	delete $self->{root};	276	delete $self->{root};
272	delete $self->{visible};	277	delete $self->{visible};
273		278
274	undef $GRAB if $GRAB == $self;	279	undef $GRAB if $GRAB == $self;
275	undef $HOVER if $HOVER == $self;	280	undef $HOVER if $HOVER == $self;
276		281
277	CFClient::UI::check_tooltip	282	CFClient::UI::check_tooltip
278	if $CFClient::UI::TOOLTIP->{owner} == $self;	283	if $TOOLTIP->{owner} == $self;
279		284
280	$self->focus_out;	285	$self->focus_out;
281		286
282	$self->emit (visibility_change => 0);	287	$self->emit (visibility_change => 0);
283	}	288	}
…		…
306		311
307	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
308	if $self->{parent};	313	if $self->{parent};
309	}	314	}
310		315
311	sub move {	316	sub move_abs {
312	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
313		318
314	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
315	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
316	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
317		322
318	$self->update;	323	$self->update;
319	}	324	}
320		325
321	sub set_size {	326	sub set_size {
322	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
323		328
324	$self->{def_w} = $w;	329	$self->{force_w} = $w;
325	$self->{def_h} = $h;	330	$self->{force_h} = $h;
326		331
327	$self->check_size;	332	$self->realloc;
328	}	333	}
329		334
330	sub size_request {	335	sub size_request {
331	require Carp;	336	require Carp;
332	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
334		339
335	sub configure {	340	sub configure {
336	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
337		342
338	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
339	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
340	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
341		348
342	# use alignment to adjust x, y	349	# use alignment to adjust x, y
343		350
344	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
345	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
346
347	($w, $h) = ($w2, $h2);
348	}	353	}
349		354
350	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
351	$self->{x} = $x;	356	$self->{x} = $x;
352	$self->{y} = $y;	357	$self->{y} = $y;
353	$self->update;	358	$self->update;
354	}	359	}
355		360
356	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
357	$CFClient::UI::ROOT->{size_alloc}{$self+0} = [$self, $w, $h];	362	return unless $self->{visible};
		363
		364	$self->{alloc_w} = $w;
		365	$self->{alloc_h} = $h;
		366
		367	$self->{root}{size_alloc}{$self+0} = $self;
358	}	368	}
359	}	369	}
360		370
361	sub size_allocate {	371	sub size_allocate {
362	# nothing to be done	372	# nothing to be done
363	}
364
365	sub reconfigure {
366	my ($self) = @_;
367
368	$self->check_size (1);
369	$self->update;
370	}	373	}
371		374
372	sub children {	375	sub children {
373	}	376	}
374		377
…		…
447	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
448		451
449	$self->focus_in;	452	$self->focus_in;
450	}	453	}
451		454
452	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	455	sub find_widget {
453	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	456	my ($self, $x, $y) = @_;
454	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	457
455	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	458	return () unless $self->{can_events};
456	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	459
		460	return $self
		461	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		462	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		463
		464	()
		465	}
		466
		467	sub set_parent {
		468	my ($self, $parent) = @_;
		469
		470	Scalar::Util::weaken ($self->{parent} = $parent);
		471	$self->set_visible if $parent->{visible};
		472	}
		473
		474	sub connect {
		475	my ($self, $signal, $cb) = @_;
		476
		477	push @{ $self->{signal_cb}{$signal} }, $cb;
		478	}
		479
		480	sub _emit {
		481	my ($self, $signal, @args) = @_;
		482
		483	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		484	}
		485
		486	sub emit {
		487	my ($self, $signal, @args) = @_;
		488
		489	$self->_emit ($signal, @args)
		490	|| $self->$signal (@args);
		491	}
		492
		493	sub visibility_change {
		494	#my ($self, $visible) = @_;
		495	}
		496
		497	sub realloc {
		498	my ($self) = @_;
		499
		500	if ($self->{visible}) {
		501	return if $self->{root}{realloc}{$self+0};
		502
		503	$self->{root}{realloc}{$self+0} = $self;
		504	$self->{root}->update;
		505	} else {
		506	delete $self->{req_w};
		507	delete $self->{req_h};
		508	}
		509	}
		510
		511	sub update {
		512	my ($self) = @_;
		513
		514	$self->{parent}->update
		515	if $self->{parent};
		516	}
		517
		518	sub reconfigure {
		519	my ($self) = @_;
		520
		521	$self->realloc;
		522	$self->update;
		523	}
		524
		525	# using global variables seems a bit hacky, but passing through all drawing
		526	# functions seems pointless.
		527	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
457		528
458	sub draw {	529	sub draw {
459	my ($self) = @_;	530	my ($self) = @_;
460		531
461	return unless $self->{h} && $self->{w};	532	return unless $self->{h} && $self->{w};
		533
		534	local $draw_x = $draw_x + $self->{x};
		535	local $draw_y = $draw_y + $self->{y};
		536
		537	return if $draw_x + $self->{w} < 0;
		538	return if $draw_x >= $draw_w;
		539	return if $draw_y + $self->{h} < 0;
		540	return if $draw_y >= $draw_h;
462		541
463	glPushMatrix;	542	glPushMatrix;
464	glTranslate $self->{x}, $self->{y}, 0;	543	glTranslate $self->{x}, $self->{y}, 0;
465	$self->_draw;	544	$self->_draw;
466	glPopMatrix;	545	glPopMatrix;
…		…
478	glVertex $x , $y + $self->{h};	557	glVertex $x , $y + $self->{h};
479	glEnd;	558	glEnd;
480	glDisable GL_BLEND;	559	glDisable GL_BLEND;
481	}	560	}
482		561
483	if ($ENV{PCLIENT_DEBUG}) {	562	if ($ENV{CFPLUS_DEBUG} & 1) {
484	glPushMatrix;	563	glPushMatrix;
485	glColor 1, 1, 0, 1;	564	glColor 1, 1, 0, 1;
486	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	565	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
487	glBegin GL_LINE_LOOP;	566	glBegin GL_LINE_LOOP;
488	glVertex 0 , 0;	567	glVertex 0 , 0;
…		…
499	my ($self) = @_;	578	my ($self) = @_;
500		579
501	warn "no draw defined for $self\n";	580	warn "no draw defined for $self\n";
502	}	581	}
503		582
504	sub find_widget {
505	my ($self, $x, $y) = @_;
506
507	return () unless $self->{can_events};
508
509	return $self
510	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
511	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
512
513	()
514	}
515
516	sub set_parent {
517	my ($self, $parent) = @_;
518
519	Scalar::Util::weaken ($self->{parent} = $parent);
520
521	$self->set_visible; #TODO why breakssssss borked damn if $parent->{visible};
522
523	$self->check_size;
524	}
525
526	sub check_size {
527	my ($self, $forced) = @_;
528
529	$self->{force_alloc} = 1 if $forced;
530	$CFClient::UI::ROOT->{check_size}{$self} = $self;
531	}
532
533	sub update {
534	my ($self) = @_;
535
536	$self->{parent}->update
537	if $self->{parent};
538	}
539
540	sub connect {
541	my ($self, $signal, $cb) = @_;
542
543	push @{ $self->{signal_cb}{$signal} }, $cb;
544	}
545
546	sub _emit {
547	my ($self, $signal, @args) = @_;
548
549	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
550	}
551
552	sub emit {
553	my ($self, $signal, @args) = @_;
554
555	$self->_emit ($signal, @args)
556	|| $self->$signal (@args);
557	}
558
559	sub visibility_change {
560	#my ($self, $visible) = @_;
561	}
562
563	sub DESTROY {	583	sub DESTROY {
564	my ($self) = @_;	584	my ($self) = @_;
565		585
566	delete $WIDGET{$self+0};	586	delete $WIDGET{$self+0};
567	#$self->deactivate;	587	#$self->deactivate;
…		…
623	my ($class, %arg) = @_;	643	my ($class, %arg) = @_;
624	$class->SUPER::new (can_events => 0, %arg);	644	$class->SUPER::new (can_events => 0, %arg);
625	}	645	}
626		646
627	sub size_request {	647	sub size_request {
628	(0, 0)	648	my ($self) = @_;
		649
		650	($self->{w} + 0, $self->{h} + 0)
629	}	651	}
630		652
631	sub draw { }	653	sub draw { }
632		654
633	#############################################################################	655	#############################################################################
…		…
662	$self->{children} = [	684	$self->{children} = [
663	sort { $a->{z} <=> $b->{z} }	685	sort { $a->{z} <=> $b->{z} }
664	@{$self->{children}}, @widgets	686	@{$self->{children}}, @widgets
665	];	687	];
666		688
667	$self->check_size (1);	689	$self->realloc;
668	$self->update;
669	}	690	}
670		691
671	sub children {	692	sub children {
672	@{ $_[0]{children} }	693	@{ $_[0]{children} }
673	}	694	}
…		…
678	delete $child->{parent};	699	delete $child->{parent};
679	$child->hide;	700	$child->hide;
680		701
681	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	702	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
682		703
683	$self->check_size (1);	704	$self->realloc;
684	$self->update;
685	}	705	}
686		706
687	sub clear {	707	sub clear {
688	my ($self) = @_;	708	my ($self) = @_;
689		709
…		…
693	for (@$children) {	713	for (@$children) {
694	delete $_->{parent};	714	delete $_->{parent};
695	$_->hide;	715	$_->hide;
696	}	716	}
697		717
698	$self->check_size;	718	$self->realloc;
699	$self->update;
700	}	719	}
701		720
702	sub find_widget {	721	sub find_widget {
703	my ($self, $x, $y) = @_;	722	my ($self, $x, $y) = @_;
704		723
…		…
791	$self->SUPER::size_allocate ($w, $h);	810	$self->SUPER::size_allocate ($w, $h);
792	$self->update;	811	$self->update;
793	}	812	}
794		813
795	sub _render {	814	sub _render {
		815	my ($self) = @_;
		816
796	$_[0]{children}[0]->draw;	817	$self->{children}[0]->draw;
797	}	818	}
798		819
799	sub render_child {	820	sub render_child {
800	my ($self) = @_;	821	my ($self) = @_;
801		822
802	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	823	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
803	glClearColor 0, 0, 0, 0;	824	glClearColor 0, 0, 0, 0;
804	glClear GL_COLOR_BUFFER_BIT;	825	glClear GL_COLOR_BUFFER_BIT;
805		826
		827	{
		828	package CFClient::UI::Base;
		829
		830	($draw_x, $draw_y, $draw_w, $draw_h) =
		831	(0, 0, $self->{w}, $self->{h});
		832	}
		833
806	$self->_render;	834	$self->_render;
807	};	835	};
808	}	836	}
809		837
810	sub _draw {	838	sub _draw {
811	my ($self) = @_;	839	my ($self) = @_;
812		840
813	my ($w, $h) = ($self->w, $self->h);	841	my ($w, $h) = @$self{qw(w h)};
814		842
815	my $tex = $self->{texture}	843	my $tex = $self->{texture}
816	or return;	844	or return;
817		845
818	glEnable GL_TEXTURE_2D;	846	glEnable GL_TEXTURE_2D;
…		…
841	}	869	}
842		870
843	sub size_request {	871	sub size_request {
844	my ($self) = @_;	872	my ($self) = @_;
845		873
846	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	874	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
847		875
848	$w = 10 if $self->{scroll_x};	876	$w = 10 if $self->{scroll_x};
849	$h = 10 if $self->{scroll_y};	877	$h = 10 if $self->{scroll_y};
850		878
851	($w, $h)	879	($w, $h)
852	}	880	}
853		881
854	sub size_allocate {	882	sub size_allocate {
855	my ($self, $w, $h) = @_;	883	my ($self, $w, $h) = @_;
856		884
		885	my $child = $self->child;
		886
857	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	887	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
858	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	888	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
859		889
860	$self->child->configure (0, 0, $w, $h);	890	$self->child->configure (0, 0, $w, $h);
861	$self->update;	891	$self->update;
862	}	892	}
863		893
…		…
898	}	928	}
899	}	929	}
900		930
901	sub _render {	931	sub _render {
902	my ($self) = @_;	932	my ($self) = @_;
		933
		934	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		935	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
903		936
904	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	937	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
905		938
906	$self->SUPER::_render;	939	$self->SUPER::_render;
907	}	940	}
…		…
1006		1039
1007	our @ISA = CFClient::UI::Bin::;	1040	our @ISA = CFClient::UI::Bin::;
1008		1041
1009	use CFClient::OpenGL;	1042	use CFClient::OpenGL;
1010		1043
1011	my @tex =	1044	my $bg =
		1045	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1046	mipmap => 1, wrap => 1;
		1047
		1048	my @border =
1012	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1049	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1013	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1050	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1014		1051
1015	sub new {	1052	sub new {
1016	my $class = shift;	1053	my $class = shift;
1017		1054
1018	my $self = $class->SUPER::new (	1055	my $self = $class->SUPER::new (
1019	bg => [1, 1, 1, 1],	1056	bg => [1, 1, 1, 1],
1020	border_bg => [1, 1, 1, 1],	1057	border_bg => [1, 1, 1, 1],
1021	border => 0.6,	1058	border => 0.6,
1022	is_toplevel => 1,
1023	can_events => 1,	1059	can_events => 1,
		1060	min_w => 16,
		1061	min_h => 16,
1024	@_	1062	@_
1025	);	1063	);
1026		1064
1027	$self->{title} &&= new CFClient::UI::Label	1065	$self->{title} &&= new CFClient::UI::Label
1028	align => 0,	1066	align => 0,
…		…
1081	my ($ev, $x, $y) = @_;	1119	my ($ev, $x, $y) = @_;
1082		1120
1083	my $dx = $ev->{x} - $ox;	1121	my $dx = $ev->{x} - $ox;
1084	my $dy = $ev->{y} - $oy;	1122	my $dy = $ev->{y} - $oy;
1085		1123
1086	$self->{user_x} = $wx + $dx * $mx;
1087	$self->{user_y} = $wy + $dy * $my;
1088	$self->{def_w} = $bw + $dx * ($mx ? -1 : 1);	1124	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1089	$self->{def_h} = $bh + $dy * ($my ? -1 : 1);	1125	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1090	$self->move ($self->{user_x}, $self->{user_y});	1126
1091	$self->check_size;	1127	$self->realloc;
		1128	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1092	};	1129	};
1093		1130
1094	} elsif ($lr ^ $td) {	1131	} elsif ($lr ^ $td) {
1095	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1132	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1096	my ($bx, $by) = ($self->{x}, $self->{y});	1133	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1098	$self->{motion} = sub {	1135	$self->{motion} = sub {
1099	my ($ev, $x, $y) = @_;	1136	my ($ev, $x, $y) = @_;
1100		1137
1101	($x, $y) = ($ev->{x}, $ev->{y});	1138	($x, $y) = ($ev->{x}, $ev->{y});
1102		1139
1103	$self->{user_x} = $bx + $x - $ox;	1140	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
1104	$self->{user_y} = $by + $y - $oy;
1105
1106	$self->move ($self->{user_x}, $self->{user_y});
1107	$self->update;
1108	};	1141	};
1109	}	1142	}
1110	}	1143	}
1111		1144
1112	sub button_up {	1145	sub button_up {
…		…
1131	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1164	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1132		1165
1133	my $border = $self->border;	1166	my $border = $self->border;
1134		1167
1135	glColor @{ $self->{border_bg} };	1168	glColor @{ $self->{border_bg} };
1136	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1169	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1137	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1170	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1138	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1171	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1139	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1172	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1140		1173
1141	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1174	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1142	my $bg = $tex[0];	1175	glColor @{ $self->{bg} };
1143		1176
1144	# TODO: repeat texture not scale	1177	# TODO: repeat texture not scale
		1178	# solve this better(?)
1145	my $rep_x = $cw / $bg->{w};	1179	$bg->{s} = $cw / $bg->{w};
1146	my $rep_y = $ch / $bg->{h};	1180	$bg->{t} = $ch / $bg->{h};
1147
1148	glColor @{ $self->{bg} };
1149
1150	$bg->{s} = $rep_x;
1151	$bg->{t} = $rep_y;
1152	$bg->{wrap_mode} = 1;
1153	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1181	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1154	}	1182	}
1155		1183
1156	glDisable GL_TEXTURE_2D;	1184	glDisable GL_TEXTURE_2D;
1157		1185
…		…
1187	my ($self, $x, $y, $child) = @_;	1215	my ($self, $x, $y, $child) = @_;
1188		1216
1189	$child->set_parent ($self);	1217	$child->set_parent ($self);
1190	$self->{children}[$y][$x] = $child;	1218	$self->{children}[$y][$x] = $child;
1191		1219
1192	$self->check_size (1);	1220	$self->realloc;
1193	}	1221	}
1194		1222
1195	# TODO: move to container class maybe? send children a signal on removal?	1223	# TODO: move to container class maybe? send children a signal on removal?
1196	sub clear {	1224	sub clear {
1197	my ($self) = @_;	1225	my ($self) = @_;
…		…
1202	for (@children) {	1230	for (@children) {
1203	delete $_->{parent};	1231	delete $_->{parent};
1204	$_->hide;	1232	$_->hide;
1205	}	1233	}
1206		1234
1207	$self->check_size (1);	1235	$self->realloc;
1208	$self->update;
1209	}	1236	}
1210		1237
1211	sub get_wh {	1238	sub get_wh {
1212	my ($self) = @_;	1239	my ($self) = @_;
1213		1240
…		…
1421	ellipsise => 3, # end	1448	ellipsise => 3, # end
1422	layout => (new CFClient::Layout),	1449	layout => (new CFClient::Layout),
1423	fontsize => 1,	1450	fontsize => 1,
1424	align => -1,	1451	align => -1,
1425	valign => -1,	1452	valign => -1,
1426	padding => 2,	1453	padding_x => 2,
		1454	padding_y => 2,
1427	can_events => 0,	1455	can_events => 0,
1428	%arg	1456	%arg
1429	);	1457	);
1430		1458
1431	if (exists $self->{template}) {	1459	if (exists $self->{template}) {
…		…
1467	$self->{text} = "T$text";	1495	$self->{text} = "T$text";
1468		1496
1469	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1497	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1470	$self->{layout}->set_text ($text);	1498	$self->{layout}->set_text ($text);
1471		1499
		1500	$self->realloc;
1472	$self->update;	1501	$self->update;
1473	$self->check_size;
1474	}	1502	}
1475		1503
1476	sub set_markup {	1504	sub set_markup {
1477	my ($self, $markup) = @_;	1505	my ($self, $markup) = @_;
1478		1506
…		…
1482	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1510	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1483		1511
1484	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1512	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1485	$self->{layout}->set_markup ($markup);	1513	$self->{layout}->set_markup ($markup);
1486		1514
		1515	$self->realloc;
1487	$self->update;	1516	$self->update;
1488	$self->check_size;
1489	}	1517	}
1490		1518
1491	sub size_request {	1519	sub size_request {
1492	my ($self) = @_;	1520	my ($self) = @_;
1493		1521
…		…
1507		1535
1508	$w = List::Util::max $w, $w2;	1536	$w = List::Util::max $w, $w2;
1509	$h = List::Util::max $h, $h2;	1537	$h = List::Util::max $h, $h2;
1510	}	1538	}
1511		1539
1512	(	1540	($w, $h)
1513	$w + $self->{padding} * 2,
1514	$h + $self->{padding} * 2,
1515	)
1516	}	1541	}
1517		1542
1518	sub size_allocate {	1543	sub size_allocate {
1519	my ($self, $w, $h) = @_;	1544	my ($self, $w, $h) = @_;
1520		1545
1521	delete $self->{texture};	1546	delete $self->{texture}
		1547	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1522	}	1548	}
1523		1549
1524	sub set_fontsize {	1550	sub set_fontsize {
1525	my ($self, $fontsize) = @_;	1551	my ($self, $fontsize) = @_;
1526		1552
1527	$self->{fontsize} = $fontsize;	1553	$self->{fontsize} = $fontsize;
1528	delete $self->{texture};	1554	delete $self->{texture};
1529		1555
1530	$self->update;	1556	$self->realloc;
1531	$self->check_size;
1532	}	1557	}
1533		1558
1534	sub _draw {	1559	sub _draw {
1535	my ($self) = @_;	1560	my ($self) = @_;
1536		1561
…		…
1544	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1569	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1545	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1570	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1546		1571
1547	my $tex = new_from_layout CFClient::Texture $self->{layout};	1572	my $tex = new_from_layout CFClient::Texture $self->{layout};
1548		1573
1549	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1574	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1550	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1575	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1551	: ($self->{w} - $tex->{w}) * 0.5);	1576	: ($self->{w} - $tex->{w}) * 0.5);
1552		1577
1553	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1578	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1554	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1579	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1555	: ($self->{h} - $tex->{h}) * 0.5);	1580	: ($self->{h} - $tex->{h}) * 0.5);
1556		1581
1557	$tex	1582	$tex
1558	};	1583	};
1559		1584
…		…
1616	sub set_text {	1641	sub set_text {
1617	my ($self, $text) = @_;	1642	my ($self, $text) = @_;
1618		1643
1619	$self->{cursor} = length $text;	1644	$self->{cursor} = length $text;
1620	$self->_set_text ($text);	1645	$self->_set_text ($text);
1621	$self->update;	1646
1622	$self->check_size;	1647	$self->realloc;
1623	}	1648	}
1624		1649
1625	sub get_text {	1650	sub get_text {
1626	$_[0]{text}	1651	$_[0]{text}
1627	}	1652	}
…		…
1660	} elsif ($uni) {	1685	} elsif ($uni) {
1661	substr $text, $self->{cursor}++, 0, chr $uni;	1686	substr $text, $self->{cursor}++, 0, chr $uni;
1662	}	1687	}
1663		1688
1664	$self->_set_text ($text);	1689	$self->_set_text ($text);
1665	$self->update;	1690
1666	$self->check_size;	1691	$self->realloc;
1667	}	1692	}
1668		1693
1669	sub focus_in {	1694	sub focus_in {
1670	my ($self) = @_;	1695	my ($self) = @_;
1671		1696
…		…
1798		1823
1799	sub new {	1824	sub new {
1800	my $class = shift;	1825	my $class = shift;
1801		1826
1802	$class->SUPER::new (	1827	$class->SUPER::new (
1803	padding => 4,	1828	padding_x => 4,
		1829	padding_y => 4,
1804	fg => [1, 1, 1],	1830	fg => [1, 1, 1],
1805	active_fg => [0, 0, 1],	1831	active_fg => [0, 0, 1],
1806	can_hover => 1,	1832	can_hover => 1,
1807	align => 0,	1833	align => 0,
1808	valign => 0,	1834	valign => 0,
…		…
1855		1881
1856	sub new {	1882	sub new {
1857	my $class = shift;	1883	my $class = shift;
1858		1884
1859	$class->SUPER::new (	1885	$class->SUPER::new (
1860	padding => 2,	1886	padding_x => 2,
		1887	padding_y => 2,
1861	fg => [1, 1, 1],	1888	fg => [1, 1, 1],
1862	active_fg => [1, 1, 0],	1889	active_fg => [1, 1, 0],
1863	bg => [0, 0, 0, 0.2],	1890	bg => [0, 0, 0, 0.2],
1864	active_bg => [1, 1, 1, 0.5],	1891	active_bg => [1, 1, 1, 0.5],
1865	state => 0,	1892	state => 0,
…		…
1869	}	1896	}
1870		1897
1871	sub size_request {	1898	sub size_request {
1872	my ($self) = @_;	1899	my ($self) = @_;
1873		1900
1874	($self->{padding} * 2 + 6) x 2	1901	(6) x 2
1875	}	1902	}
1876		1903
1877	sub button_down {	1904	sub button_down {
1878	my ($self, $ev, $x, $y) = @_;	1905	my ($self, $ev, $x, $y) = @_;
1879		1906
1880	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1907	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1881	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1908	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1882	$self->{state} = !$self->{state};	1909	$self->{state} = !$self->{state};
1883	$self->_emit (changed => $self->{state});	1910	$self->_emit (changed => $self->{state});
1884	}	1911	}
1885	}	1912	}
1886		1913
1887	sub _draw {	1914	sub _draw {
1888	my ($self) = @_;	1915	my ($self) = @_;
1889		1916
1890	$self->SUPER::_draw;	1917	$self->SUPER::_draw;
1891		1918
1892	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1919	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1893		1920
1894	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1921	my ($w, $h) = @$self{qw(w h)};
		1922
		1923	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1895		1924
1896	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1925	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1897		1926
1898	my $tex = $self->{state} ? $tex[1] : $tex[0];	1927	my $tex = $self->{state} ? $tex[1] : $tex[0];
1899		1928
…		…
2164	fg => [1, 1, 1],	2193	fg => [1, 1, 1],
2165	active_fg => [0, 0, 0],	2194	active_fg => [0, 0, 0],
2166	bg => [0, 0, 0, 0.2],	2195	bg => [0, 0, 0, 0.2],
2167	active_bg => [1, 1, 1, 0.5],	2196	active_bg => [1, 1, 1, 0.5],
2168	range => [0, 0, 100, 10, 0],	2197	range => [0, 0, 100, 10, 0],
2169	req_w => $::WIDTH / 80,	2198	min_w => $::WIDTH / 80,
2170	req_h => $::WIDTH / 80,	2199	min_h => $::WIDTH / 80,
2171	vertical => 0,	2200	vertical => 0,
2172	can_hover => 1,	2201	can_hover => 1,
2173	inner_pad => 0.02,	2202	inner_pad => 0.02,
2174	@_	2203	@_
2175	);	2204	);
…		…
2178	$self->update;	2207	$self->update;
2179		2208
2180	$self	2209	$self
2181	}	2210	}
2182		2211
		2212	sub changed { }
		2213
2183	sub set_range {	2214	sub set_range {
2184	my ($self, $range) = @_;	2215	my ($self, $range) = @_;
2185		2216
2186	($range, $self->{range}) = ($self->{range}, $range);	2217	($range, $self->{range}) = ($self->{range}, $range);
2187		2218
…		…
2213	}	2244	}
2214		2245
2215	sub size_request {	2246	sub size_request {
2216	my ($self) = @_;	2247	my ($self) = @_;
2217		2248
2218	my $w = $self->{req_w};	2249	($self->{req_w}, $self->{req_h})
2219	my $h = $self->{req_h};
2220
2221	$self->{vertical} ? ($h, $w) : ($w, $h)
2222	}	2250	}
2223		2251
2224	sub button_down {	2252	sub button_down {
2225	my ($self, $ev, $x, $y) = @_;	2253	my ($self, $ev, $x, $y) = @_;
2226		2254
…		…
2611	}	2639	}
2612		2640
2613	sub set_tooltip_from {	2641	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2642	my ($self, $widget) = @_;
2615		2643
		2644	my $tooltip = $widget->{tooltip};
		2645
		2646	if ($ENV{CFPLUS_DEBUG} & 2) {
		2647	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2648	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2649	. "req $widget->{req_w} $widget->{req_h}\n"
		2650	. "visible $widget->{visible}";
		2651	}
		2652
2616	$self->add (new CFClient::UI::Label	2653	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2654	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2655	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2656	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2657	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2658	ellipsise => 0,
2622	font => ($widget->{tooltip_font} || $::FONT_PROP),	2659	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2633		2670
2634	sub size_allocate {	2671	sub size_allocate {
2635	my ($self, $w, $h) = @_;	2672	my ($self, $w, $h) = @_;
2636		2673
2637	$self->SUPER::size_allocate ($w - 4, $h - 4);	2674	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2675	}
		2676
		2677	sub visibility_change {
		2678	my ($self, $visible) = @_;
		2679
		2680	return unless $visible;
		2681
		2682	$self->{root}->on_post_alloc ("move_$self" => sub {
		2683	my $widget = $self->{owner}
		2684	or return;
		2685
		2686	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2687
		2688	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2689	if $x + $self->{w} > $::WIDTH;
		2690
		2691	$self->move_abs ($x, $y);
		2692	});
2638	}	2693	}
2639		2694
2640	sub _draw {	2695	sub _draw {
2641	my ($self) = @_;	2696	my ($self) = @_;
2642		2697
…		…
2659	glVertex $w, $h;	2714	glVertex $w, $h;
2660	glVertex $w, 0;	2715	glVertex $w, 0;
2661	glEnd;	2716	glEnd;
2662		2717
2663	glTranslate 2 - 0.375, 2 - 0.375;	2718	glTranslate 2 - 0.375, 2 - 0.375;
		2719
2664	$self->SUPER::_draw;	2720	$self->SUPER::_draw;
2665	}	2721	}
2666		2722
2667	#############################################################################	2723	#############################################################################
2668		2724
…		…
2744	$self->SUPER::DESTROY;	2800	$self->SUPER::DESTROY;
2745	}	2801	}
2746		2802
2747	#############################################################################	2803	#############################################################################
2748		2804
2749	package CFClient::UI::Inventory;
2750
2751	our @ISA = CFClient::UI::ScrolledWindow::;
2752
2753	sub new {
2754	my $class = shift;
2755
2756	my $self = $class->SUPER::new (
2757	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2758	@_,
2759	);
2760
2761	$self
2762	}
2763
2764	sub set_items {
2765	my ($self, $items) = @_;
2766
2767	$self->{scrolled}->clear;
2768	return unless $items;
2769
2770	my @items = sort {
2771	($a->{type} <=> $b->{type})
2772	or ($a->{name} cmp $b->{name})
2773	} @$items;
2774
2775	$self->{real_items} = \@items;
2776
2777	my $row = 0;
2778	for my $item (@items) {
2779	CFClient::Item::update_widgets $item;
2780
2781	$self->{scrolled}->add (0, $row, $item->{face_widget});
2782	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2783	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2784
2785	$row++;
2786	}
2787	}
2788
2789	#############################################################################
2790
2791	package CFClient::UI::Menu;	2805	package CFClient::UI::Menu;
2792		2806
2793	our @ISA = CFClient::UI::FancyFrame::;	2807	our @ISA = CFClient::UI::FancyFrame::;
2794		2808
2795	use CFClient::OpenGL;	2809	use CFClient::OpenGL;
…		…
2833	# maybe save $GRAB? must be careful about events...	2847	# maybe save $GRAB? must be careful about events...
2834	$GRAB = $self;	2848	$GRAB = $self;
2835	$self->{button} = $ev->{button};	2849	$self->{button} = $ev->{button};
2836		2850
2837	$self->show;	2851	$self->show;
2838	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2852	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2839	}	2853	}
2840		2854
2841	sub mouse_motion {	2855	sub mouse_motion {
2842	my ($self, $ev, $x, $y) = @_;	2856	my ($self, $ev, $x, $y) = @_;
2843		2857
…		…
2968	$self->SUPER::reconfigure;	2982	$self->SUPER::reconfigure;
2969	}	2983	}
2970		2984
2971	#############################################################################	2985	#############################################################################
2972		2986
2973	package CFClient::UI::Root;	2987	package CFClient::UI::Inventory;
2974		2988
2975	our @ISA = CFClient::UI::Container::;	2989	our @ISA = CFClient::UI::ScrolledWindow::;
2976
2977	use CFClient::OpenGL;
2978		2990
2979	sub new {	2991	sub new {
2980	my $class = shift;	2992	my $class = shift;
2981		2993
2982	$class->SUPER::new (	2994	my $self = $class->SUPER::new (
		2995	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		2996	@_,
		2997	);
		2998
		2999	$self
		3000	}
		3001
		3002	sub set_items {
		3003	my ($self, $items) = @_;
		3004
		3005	$self->{scrolled}->clear;
		3006	return unless $items;
		3007
		3008	my @items = sort {
		3009	($a->{type} <=> $b->{type})
		3010	or ($a->{name} cmp $b->{name})
		3011	} @$items;
		3012
		3013	$self->{real_items} = \@items;
		3014
		3015	my $row = 0;
		3016	for my $item (@items) {
		3017	CFClient::Item::update_widgets $item;
		3018
		3019	$self->{scrolled}->add (0, $row, $item->{face_widget});
		3020	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		3021	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		3022
		3023	$row++;
		3024	}
		3025	}
		3026
		3027	#############################################################################
		3028
		3029	package CFClient::UI::BindEditor;
		3030
		3031	our @ISA = CFClient::UI::FancyFrame::;
		3032
		3033	sub new {
		3034	my $class = shift;
		3035
		3036	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3037
		3038	$self->add (my $vb = new CFClient::UI::VBox);
		3039
		3040
		3041	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3042	text => "start recording",
		3043	tooltip => "Start/Stops recording of actions."
		3044	."All subsequent actions after the recording started will be captured."
		3045	."The actions are displayed after the record was stopped."
		3046	."To bind the action you have to click on the 'Bind' button",
		3047	on_activate => sub {
		3048	unless ($self->{recording}) {
		3049	$self->start;
		3050	} else {
		3051	$self->stop;
		3052	}
		3053	});
		3054
		3055	$vb->add (new CFClient::UI::Label text => "Actions:");
		3056	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3057
		3058	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3059	$vb->add (my $hb = new CFClient::UI::HBox);
		3060	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3061	$hb->add (new CFClient::UI::Button
		3062	text => "bind",
		3063	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3064	on_activate => sub {
		3065	$self->ask_for_bind;
		3066	});
		3067
		3068	$vb->add (my $hb = new CFClient::UI::HBox);
		3069	$hb->add (new CFClient::UI::Button
		3070	text => "ok",
		3071	expand => 1,
		3072	tooltip => "This closes the binding editor and saves the binding",
		3073	on_activate => sub {
		3074	$self->hide;
		3075	$self->commit;
		3076	});
		3077
		3078	$hb->add (new CFClient::UI::Button
		3079	text => "cancel",
		3080	expand => 1,
		3081	tooltip => "This closes the binding editor without saving",
		3082	on_activate => sub {
		3083	$self->hide;
		3084	$self->{binding_cancel}->()
		3085	if $self->{binding_cancel};
		3086	});
		3087
		3088	$self->update_binding_widgets;
		3089
		3090	$self
		3091	}
		3092
		3093	sub commit {
		3094	my ($self) = @_;
		3095	my ($mod, $sym, $cmds) = $self->get_binding;
		3096	if ($sym != 0 && @$cmds > 0) {
		3097	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3098	."'. Don't forget 'Save Config'!");
		3099	$self->{binding_change}->($mod, $sym, $cmds)
		3100	if $self->{binding_change};
		3101	} else {
		3102	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3103	$self->{binding_cancel}->()
		3104	if $self->{binding_cancel};
		3105	}
		3106	}
		3107
		3108	sub start {
		3109	my ($self) = @_;
		3110
		3111	$self->{rec_btn}->set_text ("stop recording");
		3112	$self->{recording} = 1;
		3113	$self->clear_command_list;
		3114	$::CONN->start_record if $::CONN;
		3115	}
		3116
		3117	sub stop {
		3118	my ($self) = @_;
		3119
		3120	$self->{rec_btn}->set_text ("start recording");
		3121	$self->{recording} = 0;
		3122
		3123	my $rec;
		3124	$rec = $::CONN->stop_record if $::CONN;
		3125	return unless ref $rec eq 'ARRAY';
		3126	$self->set_command_list ($rec);
		3127	}
		3128
		3129	# if $commit is true, the binding will be set after the user entered a key combo
		3130	sub ask_for_bind {
		3131	my ($self, $commit) = @_;
		3132
		3133	CFClient::Binder::open_binding_dialog (sub {
		3134	my ($mod, $sym) = @_;
		3135	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3136	$self->update_binding_widgets;
		3137	$self->commit if $commit;
		3138	});
		3139	}
		3140
		3141	# $mod and $sym are the modifiers and key symbol
		3142	# $cmds is a array ref of strings (the commands)
		3143	# $cb is the callback that is executed on OK
		3144	# $ccb is the callback that is executed on CANCEL and
		3145	# when the binding was unsuccessful on OK
		3146	sub set_binding {
		3147	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3148
		3149	$self->clear_command_list;
		3150	$self->{recording} = 0;
		3151	$self->{rec_btn}->set_text ("start recording");
		3152
		3153	$self->{binding} = [$mod, $sym];
		3154	$self->{commands} = $cmds;
		3155
		3156	$self->{binding_change} = $cb;
		3157	$self->{binding_cancel} = $ccb;
		3158
		3159	$self->update_binding_widgets;
		3160	}
		3161
		3162	# this is a shortcut method that asks for a binding
		3163	# and then just binds it.
		3164	sub do_quick_binding {
		3165	my ($self, $cmds) = @_;
		3166	$self->set_binding (undef, undef, $cmds, sub {
		3167	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3168	});
		3169	$self->ask_for_bind (1);
		3170	}
		3171
		3172	sub update_binding_widgets {
		3173	my ($self) = @_;
		3174	my ($mod, $sym, $cmds) = $self->get_binding;
		3175	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3176	$self->set_command_list ($cmds);
		3177	}
		3178
		3179	sub get_binding {
		3180	my ($self) = @_;
		3181	return (
		3182	$self->{binding}->[0],
		3183	$self->{binding}->[1],
		3184	[ grep { defined $_ } @{$self->{commands}} ]
		3185	);
		3186	}
		3187
		3188	sub clear_command_list {
		3189	my ($self) = @_;
		3190	$self->{cmdbox}->clear ();
		3191	}
		3192
		3193	sub set_command_list {
		3194	my ($self, $cmds) = @_;
		3195
		3196	$self->{cmdbox}->clear ();
		3197	$self->{commands} = $cmds;
		3198
		3199	my $idx = 0;
		3200
		3201	for (@$cmds) {
		3202	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3203
		3204	my $i = $idx;
		3205	$hb->add (new CFClient::UI::Label text => $_);
		3206	$hb->add (new CFClient::UI::Button
		3207	text => "delete",
		3208	tooltip => "Deletes the action from the record",
		3209	on_activate => sub {
		3210	$self->{cmdbox}->remove ($hb);
		3211	$cmds->[$i] = undef;
		3212	});
		3213
		3214
		3215	$idx++
		3216	}
		3217	}
		3218
		3219	#############################################################################
		3220
		3221	package CFClient::UI::SpellList;
		3222
		3223	our @ISA = CFClient::UI::FancyFrame::;
		3224
		3225	sub new {
		3226	my $class = shift;
		3227
		3228	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3229
		3230	$self->add (new CFClient::UI::ScrolledWindow
		3231	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3232
		3233	$self;
		3234	}
		3235
		3236	# XXX: Do sorting? Argl...
		3237	sub add_spell {
		3238	my ($self, $spell) = @_;
		3239	$self->{spells}->{$spell->{name}} = $spell;
		3240
		3241	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3242	face => $spell->{face},
		3243	can_hover => 1,
		3244	can_events => 1,
		3245	tooltip => $spell->{message});
		3246
		3247	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3248	text => $spell->{name},
		3249	can_hover => 1,
		3250	can_events => 1,
		3251	tooltip => $spell->{message},
		3252	expand => 1);
		3253
		3254	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3255	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3256	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3257	expand => 1);
		3258
		3259	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3260	text => "bind to key",
		3261	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3262	}
		3263
		3264	sub rebuild_spell_list {
		3265	my ($self) = @_;
		3266	$self->{tbl_idx} = 0;
		3267	$self->add_spell ($_) for values %{$self->{spells}};
		3268	}
		3269
		3270	sub remove_spell {
		3271	my ($self, $spell) = @_;
		3272	delete $self->{spells}->{$spell->{name}};
		3273	$self->rebuild_spell_list;
		3274	}
		3275
		3276	#############################################################################
		3277
		3278	package CFClient::UI::Root;
		3279
		3280	our @ISA = CFClient::UI::Container::;
		3281
		3282	use CFClient::OpenGL;
		3283
		3284	sub new {
		3285	my $class = shift;
		3286
		3287	my $self = $class->SUPER::new (
2983	visible => 1,	3288	visible => 1,
2984	@_,	3289	@_,
2985	)	3290	);
2986	}
2987		3291
2988	sub configure {	3292	Scalar::Util::weaken ($self->{root} = $self);
2989	my ($self, $x, $y, $w, $h) = @_;
2990		3293
2991	$self->{w} = $w;	3294	$self
2992	$self->{h} = $h;
2993	}
2994
2995	sub check_size {
2996	my ($self) = @_;
2997
2998	$self->size_allocate ($self->{w}, $self->{h})
2999	if $self->{w};
3000	}	3295	}
3001		3296
3002	sub size_request {	3297	sub size_request {
3003	my ($self) = @_;	3298	my ($self) = @_;
3004		3299
3005	($self->{w}, $self->{h})	3300	($self->{w}, $self->{h})
		3301	}
		3302
		3303	sub _to_pixel {
		3304	my ($coord, $size, $max) = @_;
		3305
		3306	$coord =
		3307	$coord eq "center" ? ($max - $size) * 0.5
		3308	: $coord eq "max" ? $max
		3309	: $coord;
		3310
		3311	$coord = 0 if $coord < 0;
		3312	$coord = $max - $size if $coord > $max - $size;
		3313
		3314	int $coord + 0.5
3006	}	3315	}
3007		3316
3008	sub size_allocate {	3317	sub size_allocate {
3009	my ($self, $w, $h) = @_;	3318	my ($self, $w, $h) = @_;
3010		3319
3011	for my $child ($self->children) {	3320	for my $child ($self->children) {
3012	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3321	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3013		3322
3014	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3323	$X = $child->{force_x} if exists $child->{force_x};
3015	if exists $child->{req_x};	3324	$Y = $child->{force_y} if exists $child->{force_y};
3016		3325
3017	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3326	$X = _to_pixel $X, $W, $self->{w};
3018	if exists $child->{req_y};	3327	$Y = _to_pixel $Y, $H, $self->{h};
3019
3020	#delete @$child{qw(req_x req_y)};#d# def_x, def_y
3021
3022	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3023	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3024		3328
3025	$child->configure ($X, $Y, $W, $H);	3329	$child->configure ($X, $Y, $W, $H);
3026	}	3330	}
3027	}	3331	}
3028		3332
…		…
3039	}	3343	}
3040		3344
3041	sub update {	3345	sub update {
3042	my ($self) = @_;	3346	my ($self) = @_;
3043		3347
3044	$self->check_size;
3045	$::WANT_REFRESH++;	3348	$::WANT_REFRESH++;
3046	}	3349	}
3047		3350
3048	sub add {	3351	sub add {
3049	my ($self, @children) = @_;	3352	my ($self, @children) = @_;
3050		3353
3051	for my $child (@children) {
3052	$child->{is_toplevel} = 1;	3354	$_->{is_toplevel} = 1
3053		3355	for @children;
3054	# integerise window positions
3055	$child->{x} = int $child->{x};
3056	$child->{y} = int $child->{y};
3057	}
3058		3356
3059	$self->SUPER::add (@children);	3357	$self->SUPER::add (@children);
3060
3061	for (my @widgets = @children; my $w = pop @widgets; ) {
3062	push @widgets, $w->children;
3063	$w->set_visible;
3064	}
3065
3066	}	3358	}
3067		3359
3068	sub remove {	3360	sub remove {
3069	my ($self, @children) = @_;	3361	my ($self, @children) = @_;
3070		3362
3071	$self->SUPER::remove (@children);	3363	$self->SUPER::remove (@children);
		3364
		3365	delete $self->{is_toplevel}
		3366	for @children;
3072		3367
3073	while (@children) {	3368	while (@children) {
3074	my $w = pop @children;	3369	my $w = pop @children;
3075	push @children, $w->children;	3370	push @children, $w->children;
3076	$w->set_invisible;	3371	$w->set_invisible;
…		…
3095	while ($self->{refresh_hook}) {	3390	while ($self->{refresh_hook}) {
3096	$_->()	3391	$_->()
3097	for values %{delete $self->{refresh_hook}};	3392	for values %{delete $self->{refresh_hook}};
3098	}	3393	}
3099		3394
3100	if ($self->{check_size}) {	3395	if ($self->{realloc}) {
		3396	my %queue;
3101	my @queue;	3397	my @queue;
		3398	my $widget;
3102		3399
		3400	outer:
3103	while () {	3401	while () {
3104	if ($self->{check_size}) {	3402	if (my $realloc = delete $self->{realloc}) {
3105	#TODO use array-of-depth approach	3403	for $widget (values %$realloc) {
		3404	$widget->{visible} or next; # do not resize invisible widgets
3106		3405
3107	@queue = sort { $a->{visible} <=> $b->{visible} }	3406	$queue{$widget+0}++ and next; # duplicates are common
3108	@queue, values %{delete $self->{check_size}};	3407
		3408	push @{ $queue[$widget->{visible}] }, $widget;
		3409	}
3109	}	3410	}
3110		3411
		3412	while () {
		3413	@queue or last outer;
		3414
3111	my $widget = pop @queue || last;	3415	$widget = pop @{ $queue[-1] || [] }
3112		3416	and last;
3113	defined $widget->{visible} or last; # do not resize invisible widgets
3114
3115	my ($w, $h) = $widget->{def_w} && $widget->{def_h}
3116	? @$widget{qw(def_w def_h)}
3117	: $widget->size_request;
3118
3119	if (delete $widget->{force_alloc}
3120	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3121	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3122		3417
		3418	pop @queue;
		3419	}
		3420
		3421	delete $queue{$widget+0};
		3422
		3423	my ($w, $h) = $widget->size_request;
		3424
		3425	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3426	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3427
		3428	$w = $widget->{force_w} if exists $widget->{force_w};
		3429	$h = $widget->{force_h} if exists $widget->{force_h};
		3430
		3431	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3432	|| delete $widget->{force_realloc}) {
3123	$widget->{req_w} = $w;	3433	$widget->{req_w} = $w;
3124	$widget->{req_h} = $h;	3434	$widget->{req_h} = $h;
3125		3435
3126	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3436	$self->{size_alloc}{$widget+0} = $widget;
3127		3437
3128	$widget->{parent}->check_size
3129	if $widget->{parent};	3438	if (my $parent = $widget->{parent}) {
		3439	$self->{realloc}{$parent+0} = $parent
		3440	unless $queue{$parent+0};
		3441
		3442	$parent->{force_size_alloc} = 1;
		3443	$self->{size_alloc}{$parent+0} = $parent;
		3444	}
3130	}	3445	}
		3446
		3447	delete $self->{realloc}{$widget+0};
3131	}	3448	}
3132	}	3449	}
3133		3450
3134	while (my $size_alloc = delete $self->{size_alloc}) {	3451	while (my $size_alloc = delete $self->{size_alloc}) {
3135	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3452	my @queue = sort { $b->{visible} <=> $a->{visible} }
3136	values %$size_alloc;	3453	values %$size_alloc;
3137		3454
3138	while () {	3455	while () {
3139	my ($widget, $w, $h) = @{ pop @queue or last };	3456	my $widget = pop @queue || last;
		3457
		3458	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3140		3459
3141	$w = 0 if $w < 0;	3460	$w = 0 if $w < 0;
3142	$h = 0 if $h < 0;	3461	$h = 0 if $h < 0;
3143		3462
		3463	$w = int $w + 0.5;
		3464	$h = int $h + 0.5;
		3465
		3466	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3467	$widget->{old_w} = $widget->{w};
		3468	$widget->{old_h} = $widget->{h};
		3469
3144	$widget->{w} = $w;	3470	$widget->{w} = $w;
3145	$widget->{h} = $h;	3471	$widget->{h} = $h;
		3472
3146	$widget->emit (size_allocate => $w, $h);	3473	$widget->emit (size_allocate => $w, $h);
		3474	}
3147	}	3475	}
3148	}	3476	}
3149		3477
3150	while ($self->{post_alloc_hook}) {	3478	while ($self->{post_alloc_hook}) {
3151	$_->()	3479	$_->()
3152	for values %{delete $self->{post_alloc_hook}};	3480	for values %{delete $self->{post_alloc_hook}};
3153	}	3481	}
		3482
3154		3483
3155	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3484	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3156	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3485	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3157	glClear GL_COLOR_BUFFER_BIT;	3486	glClear GL_COLOR_BUFFER_BIT;
3158		3487
…		…
3160	glLoadIdentity;	3489	glLoadIdentity;
3161	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3490	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3162	glMatrixMode GL_MODELVIEW;	3491	glMatrixMode GL_MODELVIEW;
3163	glLoadIdentity;	3492	glLoadIdentity;
3164		3493
		3494	{
		3495	package CFClient::UI::Base;
		3496
		3497	($draw_x, $draw_y, $draw_w, $draw_h) =
		3498	(0, 0, $self->{w}, $self->{h});
		3499	}
		3500
3165	$self->_draw;	3501	$self->_draw;
3166	}	3502	}
3167		3503
3168	#############################################################################	3504	#############################################################################
3169		3505

Diff Legend

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