[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.162 by root, Mon Apr 24 06:05:35 2006 UTC vs.
Revision 1.193 by root, Wed May 10 21:12:26 2006 UTC

…		…
24	my $tip = $widget->{tooltip};	24	my $tip = $widget->{tooltip};
25		25
26	$tip = $tip->($widget) if CODE:: eq ref $tip;	26	$tip = $tip->($widget) if CODE:: eq ref $tip;
27		27
28	$TOOLTIP->set_markup ($widget->{tooltip});	28	$TOOLTIP->set_markup ($widget->{tooltip});
29	$TOOLTIP->move ($widget->coord2global ($widget->{w}, 0));	29
30	$TOOLTIP->show;	30	$TOOLTIP->show;
		31
		32	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		33
		34	if ($x + $TOOLTIP->{w} > $::WIDTH) {
		35	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0);
		36	}
		37
		38	$TOOLTIP->move ($x, $y);
31	}	39	}
32		40
33	return;	41	return;
34	}	42	}
35	}	43	}
…		…
39	delete $TOOLTIP->{owner};	47	delete $TOOLTIP->{owner};
40	}	48	}
41		49
42	# class methods for events	50	# class methods for events
43	sub feed_sdl_key_down_event {	51	sub feed_sdl_key_down_event {
44	$FOCUS->key_down ($_[0]) if $FOCUS;	52	$FOCUS->emit (key_down => $_[0]) \|\| $FOCUS->key_down ($_[0])
		53	if $FOCUS;
45	}	54	}
46		55
47	sub feed_sdl_key_up_event {	56	sub feed_sdl_key_up_event {
48	$FOCUS->key_up ($_[0]) if $FOCUS;	57	$FOCUS->emit (key_up => $_[0]) \|\| $FOCUS->key_up ($_[0])
		58	if $FOCUS;
49	}	59	}
50		60
51	sub feed_sdl_button_down_event {	61	sub feed_sdl_button_down_event {
52	my ($ev) = @_;	62	my ($ev) = @_;
53	my ($x, $y) = ($ev->{x}, $ev->{y});	63	my ($x, $y) = ($ev->{x}, $ev->{y});
…		…
61	check_tooltip;	71	check_tooltip;
62	}	72	}
63		73
64	$BUTTON_STATE \|= 1 << ($ev->{button} - 1);	74	$BUTTON_STATE \|= 1 << ($ev->{button} - 1);
65		75
66	$GRAB->button_down ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;	76	if ($GRAB) {
		77	($x, $y) = $GRAB->coord2local ($x, $y);
		78	$GRAB->emit (button_down => $ev, $x, $y) \|\| $GRAB->button_down ($ev, $x, $y);
		79	}
67	}	80	}
68		81
69	sub feed_sdl_button_up_event {	82	sub feed_sdl_button_up_event {
70	my ($ev) = @_;	83	my ($ev) = @_;
71	my ($x, $y) = ($ev->{x}, $ev->{y});	84	my ($x, $y) = ($ev->{x}, $ev->{y});
72		85
73	my $widget = $GRAB \|\| $ROOT->find_widget ($x, $y);	86	my $widget = $GRAB \|\| $ROOT->find_widget ($x, $y);
74		87
75	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	88	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
76		89
77	$GRAB->button_up ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;	90	if ($GRAB) {
		91	($x, $y) = $GRAB->coord2local ($x, $y);
		92	$GRAB->emit (button_up => $ev, $x, $y) \|\| $GRAB->button_up ($ev, $x, $y);
		93	}
78		94
79	if (!$BUTTON_STATE) {	95	if (!$BUTTON_STATE) {
80	my $grab = $GRAB; undef $GRAB;	96	my $grab = $GRAB; undef $GRAB;
81	$grab->update if $grab;	97	$grab->update if $grab;
82	$GRAB->update if $GRAB;	98	$GRAB->update if $GRAB;
…		…
98	$HOVER->update if $HOVER && $HOVER->{can_hover};	114	$HOVER->update if $HOVER && $HOVER->{can_hover};
99		115
100	check_tooltip;	116	check_tooltip;
101	}	117	}
102		118
103	$HOVER->mouse_motion ($ev, $HOVER->coord2local ($x, $y)) if $HOVER;	119	if ($HOVER) {
		120	($x, $y) = $HOVER->coord2local ($x, $y);
		121	$HOVER->emit (mouse_motion => $ev, $x, $y) \|\| $HOVER->mouse_motion ($ev, $x, $y);
		122	}
104	}	123	}
105		124
106	# convert position array to integers	125	# convert position array to integers
107	sub harmonize {	126	sub harmonize {
108	my ($vals) = @_;	127	my ($vals) = @_;
…		…
126		145
127	sub new {	146	sub new {
128	my $class = shift;	147	my $class = shift;
129		148
130	my $self = bless {	149	my $self = bless {
131	x => 0,	150	x => 0,
132	y => 0,	151	y => 0,
133	z => 0,	152	z => 0,
134	can_events => 1,	153	can_events => 1,
135	@_	154	@_
136	}, $class;	155	}, $class;
137		156
138	for (keys %$self) {	157	for (keys %$self) {
…		…
160	}	179	}
161		180
162	sub hide {	181	sub hide {
163	my ($self) = @_;	182	my ($self) = @_;
164		183
165	return unless $self->{parent};	184	undef $GRAB if $GRAB == $self;
		185	undef $HOVER if $HOVER == $self;
166		186
167	$self->{parent}->remove ($self);	187	$self->{parent}->remove ($self)
		188	if $self->{parent};
168	}	189	}
169		190
170	sub move {	191	sub move {
171	my ($self, $x, $y, $z) = @_;	192	my ($self, $x, $y, $z) = @_;
172		193
…		…
211	$self->{y} = $y;	232	$self->{y} = $y;
212	$self->update;	233	$self->update;
213	}	234	}
214		235
215	if ($self->{w} != $w \|\| $self->{h} != $h) {	236	if ($self->{w} != $w \|\| $self->{h} != $h) {
216	$self->{w} = $w;	237	$CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h];
217	$self->{h} = $h;
218
219	$self->size_allocate ($w, $h);
220	$self->update;
221	}	238	}
222	}	239	}
223		240
224	sub size_allocate {	241	sub size_allocate {
225	# nothing to be done	242	# nothing to be done
226	}	243	}
227		244
		245	sub children {
		246	}
		247
		248	# call when resolution changes etc.
		249	sub reconfigure {
		250	my ($self) = @_;
		251
		252	$_->reconfigure
		253	for $self->children;
		254
		255	$self->check_size;
		256	$CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $self->{w}, $self->{h}];
		257	$self->update;
		258	}
		259
228	sub set_max_size {	260	sub set_max_size {
229	my ($self, $w, $h) = @_;	261	my ($self, $w, $h) = @_;
230		262
231	delete $self->{max_w}; $self->{max_w} = $w if $w;	263	delete $self->{max_w}; $self->{max_w} = $w if $w;
232	delete $self->{max_h}; $self->{max_h} = $h if $h;	264	delete $self->{max_h}; $self->{max_h} = $h if $h;
233	}
234
235	# return top left coordinates
236	sub _topleft {
237	my ($self, $x, $y) = @_;
238
239	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});
240	}	265	}
241		266
242	# translate global coordinates to local coordinate system	267	# translate global coordinates to local coordinate system
243	sub coord2local {	268	sub coord2local {
244	my ($self, $x, $y) = @_;	269	my ($self, $x, $y) = @_;
245		270
246	my ($X, $Y) = $self->_topleft;	271	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
247	($x - $X, $y - $Y)
248	}	272	}
249		273
250	# translate local coordinates to global coordinate system	274	# translate local coordinates to global coordinate system
251	sub coord2global {	275	sub coord2global {
252	my ($self, $x, $y) = @_;	276	my ($self, $x, $y) = @_;
253		277
254	my ($X, $Y) = $self->_topleft;	278	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
255	($x + $X, $y + $Y)
256	}	279	}
257		280
258	sub focus_in {	281	sub focus_in {
259	my ($self) = @_;	282	my ($self) = @_;
260		283
…		…
358		381
359	sub set_parent {	382	sub set_parent {
360	my ($self, $parent) = @_;	383	my ($self, $parent) = @_;
361		384
362	Scalar::Util::weaken ($self->{parent} = $parent);	385	Scalar::Util::weaken ($self->{parent} = $parent);
		386
		387	$self->check_size
		388	unless exists $self->{req_w};
363	}	389	}
364		390
365	sub check_size {	391	sub check_size {
366	my ($self) = @_;	392	my ($self) = @_;
367		393
368	$self->{parent}	394	$CFClient::UI::ROOT->{check_size}{$self} = $self;
369	or return 1;
370
371	my ($w, $h) = $self->{user_w} && $self->{user_h}
372	? @$self{qw(user_w user_h)}
373	: $self->size_request;
374
375	if ($w != $self->{req_w} \|\| $h != $self->{req_h}) {
376	$self->{req_w} = $w;
377	$self->{req_h} = $h;
378
379	$self->{parent}->check_size
380	or $self->size_allocate (
381	(List::Util::max $self->{w}, $w),
382	(List::Util::max $self->{h}, $h),
383	);
384
385	1
386	} else {
387	0
388	}
389	}	395	}
390		396
391	sub update {	397	sub update {
392	my ($self) = @_;	398	my ($self) = @_;
393		399
…		…
402	}	408	}
403		409
404	sub emit {	410	sub emit {
405	my ($self, $signal, @args) = @_;	411	my ($self, $signal, @args) = @_;
406		412
407	for my $cb (@{$self->{signal_cb}{$signal} \|\| []}) {	413	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} \|\| []}
408	$cb->($self, @args);
409	}
410	}	414	}
411		415
412	sub DESTROY {	416	sub DESTROY {
413	my ($self) = @_;	417	my ($self) = @_;
414		418
…		…
481	sub new {	485	sub new {
482	my ($class, %arg) = @_;	486	my ($class, %arg) = @_;
483		487
484	my $children = delete $arg{children} \|\| [];	488	my $children = delete $arg{children} \|\| [];
485		489
486	my $self = $class->SUPER::new (children => [], can_events => 0, %arg);	490	my $self = $class->SUPER::new (
		491	children => [],
		492	can_events => 0,
		493	%arg,
		494	);
487	$self->add ($_) for @$children;	495	$self->add ($_) for @$children;
488		496
489	$self	497	$self
490	}	498	}
491		499
492	sub add {	500	sub add {
493	my ($self, $child) = @_;	501	my ($self, @widgets) = @_;
494		502
495	$child->set_parent ($self);	503	$_->set_parent ($self)
		504	for @widgets;
496		505
497	use sort 'stable';	506	use sort 'stable';
498		507
499	$self->{children} = [	508	$self->{children} = [
500	sort { $a->{z} <=> $b->{z} }	509	sort { $a->{z} <=> $b->{z} }
501	@{$self->{children}}, $child	510	@{$self->{children}}, @widgets
502	];	511	];
503		512
504	$child->check_size;	513	$self->check_size;
		514	$self->update;
		515	}
		516
		517	sub children {
		518	@{ $_[0]{children} }
505	}	519	}
506		520
507	sub remove {	521	sub remove {
508	my ($self, $child) = @_;	522	my ($self, $child) = @_;
509		523
510	delete $child->{parent};	524	delete $child->{parent};
		525	$child->hide;
511		526
512	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	527	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
513		528
514	$self->check_size;	529	$self->check_size;
515	$self->update;	530	$self->update;
516	}	531	}
517		532
518	sub clear {	533	sub clear {
519	my ($self) = @_;	534	my ($self) = @_;
520		535
521	delete $_->{parent}	536	my $children = delete $self->{children};
522	for @{ delete $self->{children} };
523
524	$self->{children} = [];	537	$self->{children} = [];
		538
		539	for (@$children) {
		540	delete $_->{parent};
		541	$_->hide;
		542	}
		543
		544	$self->check_size;
		545	$self->update;
525	}	546	}
526		547
527	sub find_widget {	548	sub find_widget {
528	my ($self, $x, $y) = @_;	549	my ($self, $x, $y) = @_;
529		550
…		…
604	}	625	}
605		626
606	sub update {	627	sub update {
607	my ($self) = @_;	628	my ($self) = @_;
608		629
609	# we want to do this delayed...	630	$ROOT->on_refresh ($self => sub { $self->render_child });
610	$self->render_chld;
611	$self->SUPER::update;	631	$self->SUPER::update;
612	}
613
614	sub render_chld {
615	my ($self) = @_;
616
617	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
618	glClearColor 0, 0, 0, 1;
619	glClear GL_COLOR_BUFFER_BIT;
620	$self->child->draw;
621	};
622	}	632	}
623		633
624	sub size_allocate {	634	sub size_allocate {
625	my ($self, $w, $h) = @_;	635	my ($self, $w, $h) = @_;
626		636
627	$self->child->configure (0, 0, $w, $h);	637	$self->SUPER::size_allocate ($w, $h);
		638	$self->update;
		639	}
628		640
		641	sub _render {
		642	$_[0]{children}[0]->draw;
		643	}
		644
		645	sub render_child {
		646	my ($self) = @_;
		647
		648	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
		649	glClearColor 0, 0, 0, 0;
		650	glClear GL_COLOR_BUFFER_BIT;
		651
629	$self->render_chld;	652	$self->_render;
		653	# glColorMask 1, 1, 1, 0;
		654	# glEnable GL_BLEND;
		655	# glBlendFunc GL_SRC_ALPHA, GL_ZERO;
		656	# glRasterPos 0, 0;
		657	# glCopyPixels 0, 0, $self->{w}, $self->{h};
		658	# glDisable GL_BLEND;
		659	# glColorMask 1, 1, 1, 1;
		660	};
630	}	661	}
631		662
632	sub _draw {	663	sub _draw {
633	my ($self) = @_;	664	my ($self) = @_;
634		665
…		…
636		667
637	my $tex = $self->{texture}	668	my $tex = $self->{texture}
638	or return;	669	or return;
639		670
640	glEnable GL_BLEND;	671	glEnable GL_BLEND;
641	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	672	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
642	glEnable GL_TEXTURE_2D;	673	glEnable GL_TEXTURE_2D;
643	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	674	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		675	glColor 0, 0, 0, 1;
644		676
645	$tex->draw_quad (0, 0, $w, $h);	677	$tex->draw_quad (0, 0, $w, $h);
646		678
647	glDisable GL_BLEND;	679	glDisable GL_BLEND;
648	glDisable GL_TEXTURE_2D;	680	glDisable GL_TEXTURE_2D;
…		…
652		684
653	package CFClient::UI::ViewPort;	685	package CFClient::UI::ViewPort;
654		686
655	our @ISA = CFClient::UI::Window::;	687	our @ISA = CFClient::UI::Window::;
656		688
657	sub new { die }
658
659	sub size_request {	689	sub size_request {
660	my ($self) = @_;	690	my ($self) = @_;
661		691
662	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	692	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
663	$self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});	693	$self->child->configure (0, 0, @$self{qw(child_w child_h)});
664		694
665	@$self{qw(child_w child_h)}	695	@$self{qw(child_w child_h)}
666	}	696	}
667		697
668	sub _draw {	698	sub size_allocate {
669	my ($self) = @_;	699	my ($self, $w, $h) = @_;
670		700
671	$self->{children}[1]->draw;	701	$self->update;
672	}	702	}
673		703
		704	sub set_offset {
		705	my ($self, $x, $y) = @_;
		706
		707	$self->{view_x} = int $x;
		708	$self->{view_y} = int $y;
		709
		710	$self->update;
		711	}
		712
		713	# hmm, this does not work for topleft of $self... but we should not ask for that
		714	sub coord2local {
		715	my ($self, $x, $y) = @_;
		716
		717	$self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
		718	}
		719
		720	sub coord2global {
		721	my ($self, $x, $y) = @_;
		722
		723	$x = List::Util::min $self->{w}, $x - $self->{view_x};
		724	$y = List::Util::min $self->{h}, $y - $self->{view_y};
		725
		726	$self->SUPER::coord2global ($x, $y)
		727	}
		728
		729	sub find_widget {
		730	my ($self, $x, $y) = @_;
		731
		732	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
		733	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
		734	) {
		735	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
		736	} else {
		737	$self->CFClient::UI::Base::find_widget ($x, $y)
		738	}
		739	}
		740
		741	sub _render {
		742	my ($self) = @_;
		743
		744	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
		745
		746	$self->SUPER::_render;
		747	}
		748
		749	#############################################################################
		750
		751	package CFClient::UI::ScrolledWindow;
		752
		753	our @ISA = CFClient::UI::HBox::;
		754
		755	sub new {
		756	my $class = shift;
		757
		758	my $self;
		759
		760	my $slider = new CFClient::UI::Slider
		761	vertical => 1,
		762	range => [0, 0, 1, 0.01], # HACK fix
		763	connect_changed => sub {
		764	$self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h}));
		765	},
		766	;
		767
		768	$self = $class->SUPER::new (
		769	vp => (new CFClient::UI::ViewPort),
		770	slider => $slider,
		771	@_,
		772	);
		773
		774	$self->{vp}->add ($self->{scrolled});
		775	$self->add ($self->{vp});
		776	$self->add ($self->{slider});
		777
		778	$self
		779	}
		780
		781	#TODO# update range on size_allocate depeneing on child
		782	# update viewport offset on scroll
674		783
675	#############################################################################	784	#############################################################################
676		785
677	package CFClient::UI::Frame;	786	package CFClient::UI::Frame;
678		787
…		…
733	my $class = shift;	842	my $class = shift;
734		843
735	# TODO: user_x, user_y, overwrite moveto?	844	# TODO: user_x, user_y, overwrite moveto?
736		845
737	my $self = $class->SUPER::new (	846	my $self = $class->SUPER::new (
738	bg => [1, 1, 1, 1],	847	bg => [1, 1, 1, 1],
739	border_bg => [1, 1, 1, 1],	848	border_bg => [1, 1, 1, 1],
740	border => 0.8,	849	border => 0.6,
741	can_events => 1,	850	can_events => 1,
742	@_	851	@_
743	);	852	);
744		853
745	$self->{title} &&= new CFClient::UI::Label	854	$self->{title} &&= new CFClient::UI::Label
746	align => 0,	855	align => 0,
747	valign => 1,	856	valign => 1,
748	text => $self->{title},	857	text => $self->{title},
749	fontsize => 1;	858	fontsize => $self->{border};
750		859
751	$self	860	$self
752	}	861	}
753		862
754	sub border {	863	sub border {
…		…
779	}	888	}
780		889
781	sub button_down {	890	sub button_down {
782	my ($self, $ev, $x, $y) = @_;	891	my ($self, $ev, $x, $y) = @_;
783		892
		893	my ($w, $h) = @$self{qw(w h)};
784	my $border = $self->border;	894	my $border = $self->border;
785		895
786	if ($x < $self->{w} && $x >= $self->{w} - $border	896	my $lr = ($x >= 0 && $x < $border) \|\| ($x > $w - $border && $x < $w);
787	&& $y < $self->{h} && $y >= $self->{h} - $border) {	897	my $td = ($y >= 0 && $y < $border) \|\| ($y > $h - $border && $y < $h);
788		898
		899	if ($lr & $td) {
		900	my ($wx, $wy) = ($self->{x}, $self->{y});
789	my ($ox, $oy) = ($ev->{x}, $ev->{y});	901	my ($ox, $oy) = ($ev->{x}, $ev->{y});
790	my ($bw, $bh) = ($self->{w}, $self->{h});	902	my ($bw, $bh) = ($self->{w}, $self->{h});
791		903
		904	my $mx = $x < $border;
		905	my $my = $y < $border;
		906
792	$self->{motion} = sub {	907	$self->{motion} = sub {
793	my ($ev, $x, $y) = @_;	908	my ($ev, $x, $y) = @_;
794		909
795	($x, $y) = ($ev->{x}, $ev->{y});	910	my $dx = $ev->{x} - $ox;
		911	my $dy = $ev->{y} - $oy;
796		912
797	$self->{user_w} = $bw + $x - $ox;	913	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);
798	$self->{user_h} = $bh + $y - $oy;	914	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);
		915	$self->move ($wx + $dx * $mx, $wy + $dy * $my);
799	$self->check_size;	916	$self->check_size;
800	};	917	};
801		918
802	} elsif ($x >= 0 && $x < $self->{w}	919	} elsif ($lr ^ $td) {
803	&& $y >= 0 && $y < $border) {
804
805	my ($ox, $oy) = ($ev->{x}, $ev->{y});	920	my ($ox, $oy) = ($ev->{x}, $ev->{y});
806	my ($bx, $by) = ($self->{x}, $self->{y});	921	my ($bx, $by) = ($self->{x}, $self->{y});
807		922
808	$self->{motion} = sub {	923	$self->{motion} = sub {
809	my ($ev, $x, $y) = @_;	924	my ($ev, $x, $y) = @_;
…		…
845	$tex[1]->draw_quad (0, 0, $w, $border);	960	$tex[1]->draw_quad (0, 0, $w, $border);
846	$tex[3]->draw_quad (0, $border, $border, $ch);	961	$tex[3]->draw_quad (0, $border, $border, $ch);
847	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	962	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);
848	$tex[4]->draw_quad (0, $h - $border, $w, $border);	963	$tex[4]->draw_quad (0, $h - $border, $w, $border);
849		964
		965	if (@{$self->{bg}} < 4 \|\| $self->{bg}[3]) {
850	my $bg = $tex[0];	966	my $bg = $tex[0];
851		967
852	# TODO: repeat texture not scale	968	# TODO: repeat texture not scale
853	my $rep_x = $cw / $bg->{w};	969	my $rep_x = $cw / $bg->{w};
854	my $rep_y = $ch / $bg->{h};	970	my $rep_y = $ch / $bg->{h};
855		971
856	glColor @{ $self->{bg} };	972	glColor @{ $self->{bg} };
857		973
858	$bg->{s} = $rep_x;	974	$bg->{s} = $rep_x;
859	$bg->{t} = $rep_y;	975	$bg->{t} = $rep_y;
860	$bg->{wrap_mode} = 1;	976	$bg->{wrap_mode} = 1;
861	$bg->draw_quad ($border, $border, $cw, $ch);	977	$bg->draw_quad ($border, $border, $cw, $ch);
862		978
863	glDisable GL_TEXTURE_2D;	979	glDisable GL_TEXTURE_2D;
864	glDisable GL_BLEND;	980	glDisable GL_BLEND;
		981	}
865		982
866	$self->{title}->draw if $self->{title};	983	$self->{title}->draw if $self->{title};
		984
867	$self->child->draw;	985	$self->child->draw;
868	}	986	}
869		987
870	#############################################################################	988	#############################################################################
871		989
…		…
893	$self->{children}[$y][$x] = $child;	1011	$self->{children}[$y][$x] = $child;
894		1012
895	$child->check_size;	1013	$child->check_size;
896	}	1014	}
897		1015
		1016	sub children {
		1017	grep $_, map @$_, grep $_, @{ $_[0]{children} }
		1018	}
		1019
898	# TODO: move to container class maybe? send childs a signal on removal?	1020	# TODO: move to container class maybe? send childs a signal on removal?
899	sub clear {	1021	sub clear {
900	my ($self) = @_;	1022	my ($self) = @_;
901		1023
		1024	my @children = $self->children;
902	delete $self->{children};	1025	delete $self->{children};
		1026
		1027	for (@children) {
		1028	delete $_->{parent};
		1029	$_->hide;
		1030	}
		1031
903	$self->update;	1032	$self->update;
904	}	1033	}
905		1034
906	sub get_wh {	1035	sub get_wh {
907	my ($self) = @_;	1036	my ($self) = @_;
…		…
1084	}	1213	}
1085		1214
1086	sub size_allocate {	1215	sub size_allocate {
1087	my ($self, $w, $h) = @_;	1216	my ($self, $w, $h) = @_;
1088		1217
		1218	Carp::confess "negative size" if $w < 0 \|\| $h < 0;#d#
		1219
1089	my $children = $self->{children};	1220	my $children = $self->{children};
1090		1221
1091	my @h = map $_->{req_h}, @$children;	1222	my @h = map $_->{req_h}, @$children;
1092		1223
1093	my $req_h = List::Util::sum @h;	1224	my $req_h = List::Util::sum @h;
…		…
1130		1261
1131	sub new {	1262	sub new {
1132	my ($class, %arg) = @_;	1263	my ($class, %arg) = @_;
1133		1264
1134	my $self = $class->SUPER::new (	1265	my $self = $class->SUPER::new (
1135	fg => [1, 1, 1],	1266	fg => [1, 1, 1],
1136	#font => default_font	1267	#font => default_font
1137	fontsize => 1,	1268	fontsize => 1,
1138	text => "",	1269	text => "",
1139	align => -1,	1270	align => -1,
1140	valign => -1,	1271	valign => -1,
1141	padding => 2,	1272	padding => 2,
1142	layout => new CFClient::Layout,	1273	layout => new CFClient::Layout,
1143	can_events => 0,	1274	can_events => 0,
1144	%arg	1275	%arg
1145	);	1276	);
1146		1277
1147	if (exists $self->{template}) {	1278	if (exists $self->{template}) {
…		…
1164	s/</</g;	1295	s/</</g;
1165		1296
1166	$_[1]	1297	$_[1]
1167	}	1298	}
1168		1299
		1300	sub update {
		1301	my ($self) = @_;
		1302
		1303	delete $self->{texture};
		1304	$self->SUPER::update;
		1305	}
		1306
1169	sub set_text {	1307	sub set_text {
1170	my ($self, $text) = @_;	1308	my ($self, $text) = @_;
1171		1309
		1310	return if $self->{text} eq "T$text";
		1311	$self->{text} = "T$text";
		1312
1172	$self->{layout}->set_text ($text);	1313	$self->{layout}->set_text ($text);
1173		1314
1174	delete $self->{texture};	1315	$self->update;
1175	$self->check_size;	1316	$self->check_size;
1176	$self->update;
1177	}	1317	}
1178		1318
1179	sub set_markup {	1319	sub set_markup {
1180	my ($self, $markup) = @_;	1320	my ($self, $markup) = @_;
1181		1321
		1322	return if $self->{text} eq "M$markup";
		1323	$self->{text} = "M$markup";
		1324
1182	$self->{layout}->set_markup ($markup);	1325	$self->{layout}->set_markup ($markup);
1183		1326
1184	delete $self->{texture};	1327	$self->update;
1185	$self->check_size;	1328	$self->check_size;
1186	$self->update;
1187	}	1329	}
1188		1330
1189	sub size_request {	1331	sub size_request {
1190	my ($self) = @_;	1332	my ($self) = @_;
1191		1333
…		…
1220	sub set_fontsize {	1362	sub set_fontsize {
1221	my ($self, $fontsize) = @_;	1363	my ($self, $fontsize) = @_;
1222		1364
1223	$self->{fontsize} = $fontsize;	1365	$self->{fontsize} = $fontsize;
1224	delete $self->{texture};	1366	delete $self->{texture};
		1367
		1368	$self->update;
1225	$self->check_size;	1369	$self->check_size;
1226	$self->update;
1227	}	1370	}
1228		1371
1229	sub _draw {	1372	sub _draw {
1230	my ($self) = @_;	1373	my ($self) = @_;
1231		1374
…		…
1271		1414
1272	sub new {	1415	sub new {
1273	my $class = shift;	1416	my $class = shift;
1274		1417
1275	$class->SUPER::new (	1418	$class->SUPER::new (
1276	fg => [1, 1, 1],	1419	fg => [1, 1, 1],
1277	bg => [0, 0, 0, 0.2],	1420	bg => [0, 0, 0, 0.2],
1278	active_bg => [1, 1, 1, 0.5],	1421	active_bg => [1, 1, 1, 0.5],
1279	active_fg => [0, 0, 0],	1422	active_fg => [0, 0, 0],
1280	can_hover => 1,	1423	can_hover => 1,
1281	can_focus => 1,	1424	can_focus => 1,
1282	valign => 0,	1425	valign => 0,
1283	can_events => 1,	1426	can_events => 1,
1284	@_	1427	@_
1285	)	1428	)
1286	}	1429	}
1287		1430
…		…
1441	my ($self, $ev) = @_;	1584	my ($self, $ev) = @_;
1442		1585
1443	my $sym = $ev->{sym};	1586	my $sym = $ev->{sym};
1444		1587
1445	if ($sym == 13) {	1588	if ($sym == 13) {
		1589	unshift @{$self->{history}},
		1590	my $txt = $self->get_text;
		1591	$self->{history_pointer} = -1;
		1592	$self->{history_saveback} = '';
1446	$self->emit (activate => $self->get_text);	1593	$self->emit (activate => $txt);
1447	$self->update;	1594	$self->update;
		1595
		1596	} elsif ($sym == CFClient::SDLK_UP) {
		1597	if ($self->{history_pointer} < 0) {
		1598	$self->{history_saveback} = $self->get_text;
		1599	}
		1600	if (@{$self->{history} \|\| []} > 0) {
		1601	$self->{history_pointer}++;
		1602	if ($self->{history_pointer} >= @{$self->{history} \|\| []}) {
		1603	$self->{history_pointer} = @{$self->{history} \|\| []} - 1;
		1604	}
		1605	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1606	}
		1607
		1608	} elsif ($sym == CFClient::SDLK_DOWN) {
		1609	$self->{history_pointer}--;
		1610	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
		1611
		1612	if ($self->{history_pointer} >= 0) {
		1613	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1614	} else {
		1615	$self->set_text ($self->{history_saveback});
		1616	}
1448		1617
1449	} else {	1618	} else {
1450	$self->SUPER::key_down ($ev);	1619	$self->SUPER::key_down ($ev);
1451	}	1620	}
1452		1621
…		…
1466		1635
1467	sub new {	1636	sub new {
1468	my $class = shift;	1637	my $class = shift;
1469		1638
1470	$class->SUPER::new (	1639	$class->SUPER::new (
1471	padding => 4,	1640	padding => 4,
1472	fg => [1, 1, 1],	1641	fg => [1, 1, 1],
1473	bg => [1, 1, 1, 0.2],	1642	bg => [1, 1, 1, 0.2],
1474	active_fg => [0, 0, 1],	1643	active_fg => [0, 0, 1],
1475	can_hover => 1,	1644	can_hover => 1,
1476	align => 0,	1645	align => 0,
1477	valign => 0,	1646	valign => 0,
1478	can_events => 1,	1647	can_events => 1,
1479	@_	1648	@_
1480	)	1649	)
1481	}	1650	}
1482		1651
…		…
1689	}	1858	}
1690		1859
1691	sub set_max {	1860	sub set_max {
1692	my ($self, $max) = @_;	1861	my ($self, $max) = @_;
1693		1862
		1863	return if $self->{max_val} == $max;
		1864
1694	$self->{max_val} = $max;	1865	$self->{max_val} = $max;
		1866	$self->update;
1695	}	1867	}
1696		1868
1697	sub set_value {	1869	sub set_value {
1698	my ($self, $val, $max) = @_;	1870	my ($self, $val, $max) = @_;
1699		1871
1700	$self->set_max ($max)	1872	$self->set_max ($max)
1701	if defined $max;	1873	if defined $max;
1702		1874
1703	$max = $self->{max_val};	1875	return if $self->{val} == $val;
		1876
1704	$self->{val} = $val;	1877	$self->{val} = $val;
1705
1706	$self->update;	1878	$self->update;
1707	}	1879	}
1708		1880
1709	sub _draw {	1881	sub _draw {
1710	my ($self) = @_;	1882	my ($self) = @_;
…		…
1773		1945
1774	sub new {	1946	sub new {
1775	my ($class, %arg) = @_;	1947	my ($class, %arg) = @_;
1776		1948
1777	my $self = $class->SUPER::new (	1949	my $self = $class->SUPER::new (
1778	tooltip => $arg{type},	1950	tooltip => $arg{type},
		1951	can_hover => 1,
1779	can_events => 1,	1952	can_events => 1,
1780	can_hover => 1,
1781	%arg,	1953	%arg,
1782	);	1954	);
1783		1955
1784	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	1956	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1785	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	1957	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
…		…
1793		1965
1794	$self->{value}->set_fontsize ($fsize);	1966	$self->{value}->set_fontsize ($fsize);
1795	$self->{max} ->set_fontsize ($fsize);	1967	$self->{max} ->set_fontsize ($fsize);
1796	}	1968	}
1797		1969
		1970	sub set_max {
		1971	my ($self, $max) = @_;
		1972
		1973	$self->{gauge}->set_max ($max);
		1974	$self->{max}->set_text ($max);
		1975	}
		1976
1798	sub set_value {	1977	sub set_value {
1799	my ($self, $val, $max) = @_;	1978	my ($self, $val, $max) = @_;
1800		1979
1801	$self->set_max ($max)	1980	$self->set_max ($max)
1802	if defined $max;	1981	if defined $max;
1803		1982
1804	$self->{gauge}->set_value ($val, $max);	1983	$self->{gauge}->set_value ($val, $max);
1805	$self->{value}->set_text ($val);	1984	$self->{value}->set_text ($val);
1806	}
1807
1808	sub set_max {
1809	my ($self, $max) = @_;
1810
1811	$self->{gauge}->set_max ($max);
1812	$self->{max}->set_text ($max);
1813	}	1985	}
1814		1986
1815	#############################################################################	1987	#############################################################################
1816		1988
1817	package CFClient::UI::Slider;	1989	package CFClient::UI::Slider;
…		…
1836	# TODO: calculations are off	2008	# TODO: calculations are off
1837	my $self = $class->SUPER::new (	2009	my $self = $class->SUPER::new (
1838	fg => [1, 1, 1],	2010	fg => [1, 1, 1],
1839	active_fg => [0, 0, 0],	2011	active_fg => [0, 0, 0],
1840	range => [0, 0, 100, 10],	2012	range => [0, 0, 100, 10],
1841	req_w => 20,	2013	req_w => $::WIDTH / 80,
1842	req_h => 20,	2014	req_h => $::WIDTH / 80,
1843	vertical => 0,	2015	vertical => 0,
1844	can_hover => 1,	2016	can_hover => 1,
1845	inner_pad => 5,	2017	inner_pad => 5,
1846	@_	2018	@_
1847	);	2019	);
…		…
1957		2129
1958	sub new {	2130	sub new {
1959	my $class = shift;	2131	my $class = shift;
1960		2132
1961	my $self = $class->SUPER::new (	2133	my $self = $class->SUPER::new (
1962	fontsize => 1,	2134	fontsize => 1,
		2135	can_events => 0,
1963	#font => default_font	2136	#font => default_font
1964	@_,	2137	@_,
1965		2138
1966	layout => (new CFClient::Layout),	2139	layout => (new CFClient::Layout),
1967	par => [],	2140	par => [],
1968	height => 0,	2141	height => 0,
1969	children => [	2142	children => [
1970	(new CFClient::UI::Empty expand => 1),	2143	(new CFClient::UI::Empty expand => 1),
1971	(new CFClient::UI::Slider vertical => 1),	2144	(new CFClient::UI::Slider vertical => 1),
1972	],	2145	],
1973	);	2146	);
1974		2147
1975	$self->{children}[1]->connect (changed => sub {	2148	$self->{children}[1]->connect (changed => sub { $self->update });
1976	$self->update;
1977	});
1978		2149
1979	$self	2150	$self
1980	}	2151	}
1981		2152
1982	sub set_fontsize {	2153	sub set_fontsize {
…		…
1990	my ($self, $text) = @_;	2161	my ($self, $text) = @_;
1991		2162
1992	my $layout = $self->{layout};	2163	my $layout = $self->{layout};
1993		2164
1994	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2165	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
1995	$layout->set_width ($self->{w});	2166	$layout->set_width ($self->{children}[0]{w});
1996	$layout->set_text ($text);	2167	$layout->set_text ($text);
1997		2168
1998	($layout->size)[1]	2169	($layout->size)[1]
1999	}	2170	}
2000		2171
…		…
2053	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2224	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];
2054		2225
2055	delete $self->{texture};	2226	delete $self->{texture};
2056	}	2227	}
2057		2228
2058	$self->{texture} \|\|= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	2229	$self->{texture} \|\|= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {
2059	glClearColor 0, 0, 0, 1;	2230	glClearColor 0, 0, 0, 0;
2060	glClear GL_COLOR_BUFFER_BIT;	2231	glClear GL_COLOR_BUFFER_BIT;
2061		2232
2062	glEnable GL_BLEND;	2233	glEnable GL_BLEND;
2063	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2234	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2064	glEnable GL_TEXTURE_2D;	2235	glEnable GL_TEXTURE_2D;
…		…
2096	}	2267	}
2097		2268
2098	sub _draw {	2269	sub _draw {
2099	my ($self) = @_;	2270	my ($self) = @_;
2100		2271
2101	if ($self->{texture}) {	2272	glEnable GL_BLEND;
		2273	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2102	glEnable GL_TEXTURE_2D;	2274	glEnable GL_TEXTURE_2D;
2103	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2275	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2276	glColor 1, 1, 1, 1;
2104	$self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});	2277	$self->{texture}->draw_quad (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2105	glDisable GL_TEXTURE_2D;	2278	glDisable GL_TEXTURE_2D;
2106	}	2279	glDisable GL_BLEND;
2107		2280
2108	$self->{children}[1]->draw;	2281	$self->{children}[1]->draw;
2109		2282
2110	}	2283	}
2111		2284
…		…
2159		2332
2160	sub new {	2333	sub new {
2161	my $class = shift;	2334	my $class = shift;
2162		2335
2163	my $self = $class->SUPER::new (	2336	my $self = $class->SUPER::new (
2164	state => 0,	2337	state => 0,
2165	connect_activate => \&toggle_flopper,	2338	connect_activate => \&toggle_flopper,
2166	can_events => 1,
2167	@_	2339	@_
2168	);	2340	);
2169		2341
2170	if ($self->{state}) {	2342	if ($self->{state}) {
2171	$self->{state} = 0;	2343	$self->{state} = 0;
…		…
2281		2453
2282	sub size_request {	2454	sub size_request {
2283	(32, 8)	2455	(32, 8)
2284	}	2456	}
2285		2457
2286	sub draw {	2458	sub _draw {
2287	my ($self) = @_;	2459	my ($self) = @_;
2288		2460
		2461	return unless $::CONN;#d# manage and cache textures differently
2289	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	2462	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];
2290		2463
		2464	# TODO animation
2291	if ($tex) {	2465	if ($tex) {
2292	glEnable GL_BLEND;	2466	glEnable GL_BLEND;
2293	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2467	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2294	glEnable GL_TEXTURE_2D;	2468	glEnable GL_TEXTURE_2D;
2295	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2469	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
…		…
2300	}	2474	}
2301	}	2475	}
2302		2476
2303	#############################################################################	2477	#############################################################################
2304		2478
		2479	package CFClient::UI::InventoryItem;
		2480
		2481	our @ISA = CFClient::UI::HBox::;
		2482
		2483	sub new {
		2484	my $class = shift;
		2485
		2486	my %args = @_;
		2487
		2488	my $item = delete $args{item};
		2489
		2490	my $desc = $item->{nrof} < 2
		2491	? $item->{name}
		2492	: "$item->{nrof} $item->{name_pl}";
		2493
		2494
		2495	my $self = $class->SUPER::new (
		2496	can_hover => 1,
		2497	can_events => 1,
		2498	tooltip => (CFClient::UI::Label->escape ($desc)
		2499	. "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
		2500	connect_button_down => sub {
		2501	my ($self, $ev, $x, $y) = @_;
		2502
		2503	# todo: maybe put examine on 1? but should just be a tooltip :(
		2504	if ($ev->{button} == 1) {
		2505	$::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
		2506	} elsif ($ev->{button} == 2) {
		2507	$::CONN->send ("apply $item->{tag}");
		2508	} elsif ($ev->{button} == 3) {
		2509	CFClient::UI::Menu->new (
		2510	items => [
		2511	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
		2512	[
		2513	$item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
		2514	sub { $::CONN->send ("lock $item->{tag}") },
		2515	],
		2516	["mark", sub { $::CONN->send ("mark $item->{tag}") }],
		2517	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
		2518	["drop", sub { $::CONN->send ("move 0 $item->{tag} 0") }],
		2519	],
		2520	)->popup ($ev);
		2521	}
		2522
		2523	1
		2524	},
		2525	%args
		2526	);
		2527
		2528	$self->add (new CFClient::UI::Face
		2529	can_events => 0,
		2530	face => $item->{face},
		2531	anim => $item->{anim},
		2532	animspeed => $item->{animspeed},
		2533	);
		2534
		2535	$self->add (new CFClient::UI::Label
		2536	can_events => 0,
		2537	text => $desc,
		2538	);
		2539
		2540	$self
		2541	}
		2542
		2543	#############################################################################
		2544
		2545	package CFClient::UI::Inventory;
		2546
		2547	our @ISA = CFClient::UI::ScrolledWindow::;
		2548
		2549	sub new {
		2550	my $class = shift;
		2551
		2552	my $self = $class->SUPER::new (
		2553	scrolled => (new CFClient::UI::VBox),
		2554	@_,
		2555	);
		2556
		2557	$self
		2558	}
		2559
		2560	sub set_items {
		2561	my ($self, $items) = @_;
		2562
		2563	$self->{scrolled}->clear;
		2564	return unless $items;
		2565
		2566	my @items = sort { $a->{type} <=> $b->{type} } @$items;
		2567
		2568	$self->{real_items} = \@items;
		2569
		2570	for my $item (@items) {
		2571	my $desc = $item->{nrof} < 2
		2572	? $item->{name}
		2573	: "$item->{nrof} $item->{name_pl}";
		2574
		2575	$self->{scrolled}->add ($item->{widget} \|\|= new CFClient::UI::InventoryItem item => $item);
		2576	}
		2577
		2578	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
		2579	}
		2580
		2581	sub size_request {
		2582	my ($self) = @_;
		2583	($self->{req_w}, $self->{req_h});
		2584	}
		2585
		2586	#############################################################################
		2587
		2588	package CFClient::UI::Menu;
		2589
		2590	our @ISA = CFClient::UI::FancyFrame::;
		2591
		2592	use CFClient::OpenGL;
		2593
		2594	sub new {
		2595	my $class = shift;
		2596
		2597	my $self = $class->SUPER::new (
		2598	items => [],
		2599	z => 100,
		2600	@_,
		2601	);
		2602
		2603	$self->add ($self->{vbox} = new CFClient::UI::VBox);
		2604
		2605	for my $item (@{ $self->{items} }) {
		2606	my ($widget, $cb) = @$item;
		2607
		2608	# handle various types of items, only text for now
		2609	if (!ref $widget) {
		2610	$widget = new CFClient::UI::Label
		2611	can_hover => 1,
		2612	can_events => 1,
		2613	text => $widget;
		2614	}
		2615
		2616	$self->{item}{$widget} = $item;
		2617
		2618	$self->{vbox}->add ($widget);
		2619	}
		2620
		2621	$self
		2622	}
		2623
		2624	# popup given the event (must be a mouse button down event currently)
		2625	sub popup {
		2626	my ($self, $ev) = @_;
		2627
		2628	$self->emit ("popdown");
		2629
		2630	# maybe save $GRAB? must be careful about events...
		2631	$GRAB = $self;
		2632	$self->{button} = $ev->{button};
		2633
		2634	$self->show;
		2635	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
		2636	}
		2637
		2638	sub mouse_motion {
		2639	my ($self, $ev, $x, $y) = @_;
		2640
		2641	# TODO: should use vbox->find_widget or so
		2642	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
		2643	$self->{hover} = $self->{item}{$HOVER};
		2644	}
		2645
		2646	sub button_up {
		2647	my ($self, $ev, $x, $y) = @_;
		2648
		2649	if ($ev->{button} == $self->{button}) {
		2650	undef $GRAB;
		2651	$self->hide;
		2652
		2653	$self->emit ("popdown");
		2654	$self->{hover}[1]->() if $self->{hover};
		2655	}
		2656	}
		2657
		2658	#############################################################################
		2659
2305	package CFClient::UI::Root;	2660	package CFClient::UI::Root;
2306		2661
2307	our @ISA = CFClient::UI::Container::;	2662	our @ISA = CFClient::UI::Container::;
2308		2663
2309	use CFClient::OpenGL;	2664	use CFClient::OpenGL;
2310		2665
2311	sub check_size {	2666	sub new {
2312	my ($self) = @_;	2667	my $class = shift;
2313		2668
2314	$self->configure (0, 0, $::WIDTH, $::HEIGHT);	2669	$class->SUPER::new (
2315	}	2670	@_,
2316		2671	)
2317	sub size_request {
2318	($::WIDTH, $::HEIGHT)
2319	}	2672	}
2320		2673
2321	sub configure {	2674	sub configure {
2322	my ($self, $x, $y, $w, $h) = @_;	2675	my ($self, $x, $y, $w, $h) = @_;
2323		2676
2324	$self->SUPER::configure ($x, $y, $w, $h);	2677	$self->{w} = $w;
		2678	$self->{h} = $h;
		2679	}
2325		2680
		2681	sub check_size {
		2682	my ($self) = @_;
		2683
		2684	$self->size_allocate ($self->{w}, $self->{h})
		2685	if $self->{w};
		2686	}
		2687
		2688	sub size_request {
		2689	my ($self) = @_;
		2690
		2691	($self->{w}, $self->{h})
		2692	}
		2693
		2694	sub size_allocate {
		2695	my ($self, $w, $h) = @_;
		2696
		2697	my $old_w = $self->{old_w};
		2698	my $old_h = $self->{old_h};
		2699
		2700	if ($old_w && $old_h) {
		2701	for my $child ($self->children) {
		2702	$child->{x} = int 0.5 + $child->{x} * $w / $old_w;
		2703	$child->{w} = int 0.5 + $child->{w} * $w / $old_w;
		2704	$child->{req_w} = int 0.5 + $child->{req_w} * $w / $old_w if exists $child->{req_w};
		2705	$child->{user_w} = int 0.5 + $child->{user_w} * $w / $old_w if exists $child->{user_w};
		2706	$child->{y} = int 0.5 + $child->{y} * $h / $old_h;
		2707	$child->{h} = int 0.5 + $child->{h} * $h / $old_h;
		2708	$child->{req_h} = int 0.5 + $child->{req_h} * $h / $old_h if exists $child->{req_h};
		2709	$child->{user_h} = int 0.5 + $child->{user_h} * $h / $old_h if exists $child->{user_h};
		2710	}
		2711	}
		2712
2326	for my $child (@{$self->{children}}) {	2713	for my $child ($self->children) {
2327	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	2714	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2328		2715
2329	$X = List::Util::max 0, List::Util::min $w - $W, $X;	2716	$X = List::Util::max 0, List::Util::min $w - $W, $X;
2330	$Y = List::Util::max 0, List::Util::min $h - $H, $Y;	2717	$Y = List::Util::max 0, List::Util::min $h - $H, $Y;
2331	$child->configure ($X, $Y, $W,$H);	2718	$child->configure ($X, $Y, $W, $H);
2332	}	2719	}
2333	}
2334		2720
2335	sub _topleft {	2721	$self->{old_w} = $w;
		2722	$self->{old_h} = $h;
		2723	}
		2724
		2725	sub coord2local {
2336	my ($self, $x, $y) = @_;	2726	my ($self, $x, $y) = @_;
2337		2727
2338	($x, $y)	2728	($x, $y)
2339	}	2729	}
2340		2730
		2731	sub coord2global {
		2732	my ($self, $x, $y) = @_;
		2733
		2734	($x, $y)
		2735	}
		2736
2341	sub update {	2737	sub update {
2342	my ($self) = @_;	2738	my ($self) = @_;
2343		2739
2344	$self->check_size;	2740	$self->check_size;
2345	::refresh ();	2741	$::WANT_REFRESH++;
2346	}	2742	}
2347		2743
2348	sub add {	2744	sub add {
2349	my ($self, $child) = @_;	2745	my ($self, $child) = @_;
2350		2746
2351	# integerize window positions	2747	# integerise window positions
2352	$child->{x} = int $child->{x};	2748	$child->{x} = int $child->{x};
2353	$child->{y} = int $child->{y};	2749	$child->{y} = int $child->{y};
2354		2750
2355	$self->SUPER::add ($child);	2751	$self->SUPER::add ($child);
2356	}	2752	}
…		…
2359	my ($self, $id, $cb) = @_;	2755	my ($self, $id, $cb) = @_;
2360		2756
2361	$self->{refresh_hook}{$id} = $cb;	2757	$self->{refresh_hook}{$id} = $cb;
2362	}	2758	}
2363		2759
2364	sub draw {	2760	sub draw {
2365	my ($self) = @_;	2761	my ($self) = @_;
2366		2762
		2763	if ($self->{check_size}) {
		2764	my @queue = ([], []);
		2765
		2766	for (;;) {
		2767	if ($self->{check_size}) {
		2768	# heuristic: check containers last
		2769	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_
		2770	for values %{delete $self->{check_size}}
		2771	}
		2772
		2773	my $widget = (pop @{ $queue[0] }) \|\| (pop @{ $queue[1] }) \|\| last;
		2774
		2775	my ($w, $h) = $widget->{user_w} && $widget->{user_h}
		2776	? @$widget{qw(user_w user_h)}
		2777	: $widget->size_request;
		2778
		2779	if ($w != $widget->{req_w} \|\| $h != $widget->{req_h}) {
		2780	Carp::confess "$widget: size_request is negative" if $w < 0 \|\| $h < 0;#d#
		2781
		2782	$widget->{req_w} = $w;
		2783	$widget->{req_h} = $h;
		2784
		2785	$self->{size_alloc}{$widget} = [$widget, $widget->{w}, $widget->{h}];
		2786
		2787	$widget->{parent}->check_size
		2788	if $widget->{parent};
		2789	}
		2790	}
		2791	}
		2792
		2793	while ($self->{size_alloc}) {
		2794	for (values %{delete $self->{size_alloc}}) {
		2795	my ($widget, $w, $h) = @$_;
		2796
		2797	$w = 0 if $w < 0;
		2798	$h = 0 if $h < 0;
		2799
		2800	$widget->{w} = $w;
		2801	$widget->{h} = $h;
		2802	$widget->size_allocate ($w, $h);
		2803	$widget->emit (size_allocate => $w, $h);
		2804	}
		2805	}
		2806
2367	while (my $rcb = delete $self->{refresh_hook}) {	2807	while ($self->{refresh_hook}) {
2368	$_->() for values %$rcb;	2808	$_->()
		2809	for values %{delete $self->{refresh_hook}};
2369	}	2810	}
2370		2811
2371	glViewport 0, 0, $::WIDTH, $::HEIGHT;	2812	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2372	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	2813	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2373	glClear GL_COLOR_BUFFER_BIT;	2814	glClear GL_COLOR_BUFFER_BIT;

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.162 by root, Mon Apr 24 06:05:35 2006 UTC vs. Revision 1.193 by root, Wed May 10 21:12:26 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.162 by root, Mon Apr 24 06:05:35 2006 UTC vs.
Revision 1.193 by root, Wed May 10 21:12:26 2006 UTC