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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.165 by root, Mon Apr 24 08:22:22 2006 UTC vs.
Revision 1.184 by root, Wed May 3 19:56:05 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	}
…		…
229	$self->{w} = $w;	237	$self->{w} = $w;
230	$self->{h} = $h;	238	$self->{h} = $h;
231		239
232	$self->size_allocate ($w, $h);	240	$self->size_allocate ($w, $h);
233	$self->update;	241	$self->update;
		242	$self->emit (size_allocate => $w, $h);
234	}	243	}
235	}	244	}
236		245
237	sub size_allocate {	246	sub size_allocate {
238	# nothing to be done	247	# nothing to be done
		248	}
		249
		250	sub children {
		251	}
		252
		253	# call when resolution changes etc.
		254	sub reconfigure {
		255	my ($self) = @_;
		256
		257	$_->reconfigure
		258	for $self->children;
		259
		260	$_->check_size;
239	}	261	}
240		262
241	sub set_max_size {	263	sub set_max_size {
242	my ($self, $w, $h) = @_;	264	my ($self, $w, $h) = @_;
243		265
…		…
246	}	268	}
247		269
248	# return top left coordinates	270	# return top left coordinates
249	sub _topleft {	271	sub _topleft {
250	my ($self, $x, $y) = @_;	272	my ($self, $x, $y) = @_;
		273
		274	$self->{parent}
		275	or Carp::confess "no parent widget in _topleft\n";#d#
251		276
252	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});	277	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});
253	}	278	}
254		279
255	# translate global coordinates to local coordinate system	280	# translate global coordinates to local coordinate system
…		…
492	sub new {	517	sub new {
493	my ($class, %arg) = @_;	518	my ($class, %arg) = @_;
494		519
495	my $children = delete $arg{children} \|\| [];	520	my $children = delete $arg{children} \|\| [];
496		521
497	my $self = $class->SUPER::new (children => [], can_events => 0, %arg);	522	my $self = $class->SUPER::new (
		523	children => [],
		524	can_events => 0,
		525	%arg,
		526	);
498	$self->add ($_) for @$children;	527	$self->add ($_) for @$children;
499		528
500	$self	529	$self
501	}	530	}
502		531
…		…
511	sort { $a->{z} <=> $b->{z} }	540	sort { $a->{z} <=> $b->{z} }
512	@{$self->{children}}, $child	541	@{$self->{children}}, $child
513	];	542	];
514		543
515	$child->check_size;	544	$child->check_size;
		545	$self->update;
		546	}
		547
		548	sub children {
		549	@{ $_[0]{children} }
516	}	550	}
517		551
518	sub remove {	552	sub remove {
519	my ($self, $child) = @_;	553	my ($self, $child) = @_;
520		554
…		…
535		569
536	for (@$children) {	570	for (@$children) {
537	delete $_->{parent};	571	delete $_->{parent};
538	$_->hide;	572	$_->hide;
539	}	573	}
		574
		575	$self->check_size;
		576	$self->update;
540	}	577	}
541		578
542	sub find_widget {	579	sub find_widget {
543	my ($self, $x, $y) = @_;	580	my ($self, $x, $y) = @_;
544		581
…		…
619	}	656	}
620		657
621	sub update {	658	sub update {
622	my ($self) = @_;	659	my ($self) = @_;
623		660
624	# we want to do this delayed...	661	$ROOT->on_refresh ($self => sub { $self->render_child });
625	$self->render_chld;
626	$self->SUPER::update;	662	$self->SUPER::update;
627	}
628
629	sub render_chld {
630	my ($self) = @_;
631
632	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
633	glClearColor 0, 0, 0, 1;
634	glClear GL_COLOR_BUFFER_BIT;
635	$self->child->draw;
636	};
637	}	663	}
638		664
639	sub size_allocate {	665	sub size_allocate {
640	my ($self, $w, $h) = @_;	666	my ($self, $w, $h) = @_;
641		667
642	$self->child->configure (0, 0, $w, $h);	668	$self->SUPER::size_allocate ($w, $h);
		669	$self->update;
		670	}
643		671
		672	sub _render {
		673	$_[0]{children}[0]->draw;
		674	}
		675
		676	sub render_child {
		677	my ($self) = @_;
		678
		679	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
		680	glClearColor 0, 0, 0, 0;
		681	glClear GL_COLOR_BUFFER_BIT;
		682
644	$self->render_chld;	683	$self->_render;
		684	# glColorMask 1, 1, 1, 0;
		685	# glEnable GL_BLEND;
		686	# glBlendFunc GL_SRC_ALPHA, GL_ZERO;
		687	# glRasterPos 0, 0;
		688	# glCopyPixels 0, 0, $self->{w}, $self->{h};
		689	# glDisable GL_BLEND;
		690	# glColorMask 1, 1, 1, 1;
		691	};
645	}	692	}
646		693
647	sub _draw {	694	sub _draw {
648	my ($self) = @_;	695	my ($self) = @_;
649		696
…		…
651		698
652	my $tex = $self->{texture}	699	my $tex = $self->{texture}
653	or return;	700	or return;
654		701
655	glEnable GL_BLEND;	702	glEnable GL_BLEND;
656	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	703	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
657	glEnable GL_TEXTURE_2D;	704	glEnable GL_TEXTURE_2D;
658	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	705	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		706	glColor 0, 0, 0, 1;
659		707
660	$tex->draw_quad (0, 0, $w, $h);	708	$tex->draw_quad (0, 0, $w, $h);
661		709
662	glDisable GL_BLEND;	710	glDisable GL_BLEND;
663	glDisable GL_TEXTURE_2D;	711	glDisable GL_TEXTURE_2D;
…		…
667		715
668	package CFClient::UI::ViewPort;	716	package CFClient::UI::ViewPort;
669		717
670	our @ISA = CFClient::UI::Window::;	718	our @ISA = CFClient::UI::Window::;
671		719
672	sub new { die }
673
674	sub size_request {	720	sub size_request {
675	my ($self) = @_;	721	my ($self) = @_;
676		722
677	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	723	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
678	$self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});	724	$self->child->configure (0, 0, @$self{qw(child_w child_h)});
679		725
680	@$self{qw(child_w child_h)}	726	@$self{qw(child_w child_h)}
681	}	727	}
682		728
683	sub _draw {	729	sub size_allocate {
684	my ($self) = @_;	730	my ($self, $w, $h) = @_;
685		731
686	$self->{children}[1]->draw;	732	$self->update;
687	}	733	}
688		734
		735	sub set_offset {
		736	my ($self, $x, $y) = @_;
		737
		738	$self->{view_x} = int $x;
		739	$self->{view_y} = int $y;
		740
		741	$self->update;
		742	}
		743
		744	# hmm, this does not work for topleft of $self... but we should not aks for that
		745	sub _topleft {
		746	my ($self, $x, $y) = @_;
		747
		748	$self->SUPER::_topleft ($x - $self->{view_x}, $y - $self->{view_y})
		749	}
		750
		751	sub find_widget {
		752	my ($self, $x, $y) = @_;
		753
		754	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
		755	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
		756	) {
		757	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
		758	} else {
		759	$self->CFClient::UI::Base::find_widget ($x, $y)
		760	}
		761	}
		762
		763	sub _render {
		764	my ($self) = @_;
		765
		766	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
		767
		768	$self->SUPER::_render;
		769	}
		770
		771	#############################################################################
		772
		773	package CFClient::UI::ScrolledWindow;
		774
		775	our @ISA = CFClient::UI::HBox::;
		776
		777	sub new {
		778	my $class = shift;
		779
		780	my $self;
		781
		782	my $slider = new CFClient::UI::Slider
		783	vertical => 1,
		784	range => [0, 0, 1, 0.01], # HACK fix
		785	connect_changed => sub {
		786	$self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h}));
		787	},
		788	;
		789
		790	$self = $class->SUPER::new (
		791	vp => (new CFClient::UI::ViewPort),
		792	slider => $slider,
		793	@_,
		794	);
		795
		796	$self->{vp}->add ($self->{scrolled});
		797	$self->add ($self->{vp});
		798	$self->add ($self->{slider});
		799
		800	$self
		801	}
		802
		803	#TODO# update range on size_allocate depeneing on child
		804	# update viewport offset on scroll
689		805
690	#############################################################################	806	#############################################################################
691		807
692	package CFClient::UI::Frame;	808	package CFClient::UI::Frame;
693		809
…		…
750	# TODO: user_x, user_y, overwrite moveto?	866	# TODO: user_x, user_y, overwrite moveto?
751		867
752	my $self = $class->SUPER::new (	868	my $self = $class->SUPER::new (
753	bg => [1, 1, 1, 1],	869	bg => [1, 1, 1, 1],
754	border_bg => [1, 1, 1, 1],	870	border_bg => [1, 1, 1, 1],
755	border => 0.8,	871	border => 0.6,
		872	can_events => 1,
756	@_	873	@_
757	);	874	);
758		875
759	$self->{title} &&= new CFClient::UI::Label	876	$self->{title} &&= new CFClient::UI::Label
760	align => 0,	877	align => 0,
761	valign => 1,	878	valign => 1,
762	text => $self->{title},	879	text => $self->{title},
763	fontsize => 1;	880	fontsize => $self->{border};
764		881
765	$self	882	$self
766	}	883	}
767		884
768	sub border {	885	sub border {
…		…
793	}	910	}
794		911
795	sub button_down {	912	sub button_down {
796	my ($self, $ev, $x, $y) = @_;	913	my ($self, $ev, $x, $y) = @_;
797		914
		915	my ($w, $h) = @$self{qw(w h)};
798	my $border = $self->border;	916	my $border = $self->border;
799		917
800	if ($x < $self->{w} && $x >= $self->{w} - $border	918	my $lr = ($x >= 0 && $x < $border) \|\| ($x > $w - $border && $x < $w);
801	&& $y < $self->{h} && $y >= $self->{h} - $border) {	919	my $td = ($y >= 0 && $y < $border) \|\| ($y > $h - $border && $y < $h);
802		920
		921	if ($lr & $td) {
		922	my ($wx, $wy) = ($self->{x}, $self->{y});
803	my ($ox, $oy) = ($ev->{x}, $ev->{y});	923	my ($ox, $oy) = ($ev->{x}, $ev->{y});
804	my ($bw, $bh) = ($self->{w}, $self->{h});	924	my ($bw, $bh) = ($self->{w}, $self->{h});
805		925
		926	my $mx = $x < $border;
		927	my $my = $y < $border;
		928
806	$self->{motion} = sub {	929	$self->{motion} = sub {
807	my ($ev, $x, $y) = @_;	930	my ($ev, $x, $y) = @_;
808		931
809	($x, $y) = ($ev->{x}, $ev->{y});	932	my $dx = $ev->{x} - $ox;
		933	my $dy = $ev->{y} - $oy;
810		934
811	$self->{user_w} = $bw + $x - $ox;	935	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);
812	$self->{user_h} = $bh + $y - $oy;	936	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);
		937	$self->move ($wx + $dx * $mx, $wy + $dy * $my);
813	$self->check_size;	938	$self->check_size;
814	};	939	};
815		940
816	} elsif ($x >= 0 && $x < $self->{w}	941	} elsif ($lr ^ $td) {
817	&& $y >= 0 && $y < $border) {
818
819	my ($ox, $oy) = ($ev->{x}, $ev->{y});	942	my ($ox, $oy) = ($ev->{x}, $ev->{y});
820	my ($bx, $by) = ($self->{x}, $self->{y});	943	my ($bx, $by) = ($self->{x}, $self->{y});
821		944
822	$self->{motion} = sub {	945	$self->{motion} = sub {
823	my ($ev, $x, $y) = @_;	946	my ($ev, $x, $y) = @_;
…		…
859	$tex[1]->draw_quad (0, 0, $w, $border);	982	$tex[1]->draw_quad (0, 0, $w, $border);
860	$tex[3]->draw_quad (0, $border, $border, $ch);	983	$tex[3]->draw_quad (0, $border, $border, $ch);
861	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	984	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);
862	$tex[4]->draw_quad (0, $h - $border, $w, $border);	985	$tex[4]->draw_quad (0, $h - $border, $w, $border);
863		986
		987	if (@{$self->{bg}} < 4 \|\| $self->{bg}[3]) {
864	my $bg = $tex[0];	988	my $bg = $tex[0];
865		989
866	# TODO: repeat texture not scale	990	# TODO: repeat texture not scale
867	my $rep_x = $cw / $bg->{w};	991	my $rep_x = $cw / $bg->{w};
868	my $rep_y = $ch / $bg->{h};	992	my $rep_y = $ch / $bg->{h};
869		993
870	glColor @{ $self->{bg} };	994	glColor @{ $self->{bg} };
871		995
872	$bg->{s} = $rep_x;	996	$bg->{s} = $rep_x;
873	$bg->{t} = $rep_y;	997	$bg->{t} = $rep_y;
874	$bg->{wrap_mode} = 1;	998	$bg->{wrap_mode} = 1;
875	$bg->draw_quad ($border, $border, $cw, $ch);	999	$bg->draw_quad ($border, $border, $cw, $ch);
876		1000
877	glDisable GL_TEXTURE_2D;	1001	glDisable GL_TEXTURE_2D;
878	glDisable GL_BLEND;	1002	glDisable GL_BLEND;
		1003	}
879		1004
880	$self->{title}->draw if $self->{title};	1005	$self->{title}->draw if $self->{title};
		1006
881	$self->child->draw;	1007	$self->child->draw;
882	}	1008	}
883		1009
884	#############################################################################	1010	#############################################################################
885		1011
…		…
907	$self->{children}[$y][$x] = $child;	1033	$self->{children}[$y][$x] = $child;
908		1034
909	$child->check_size;	1035	$child->check_size;
910	}	1036	}
911		1037
		1038	sub children {
		1039	grep $_, map @$_, grep $_, @{ $_[0]{children} }
		1040	}
		1041
912	# TODO: move to container class maybe? send childs a signal on removal?	1042	# TODO: move to container class maybe? send childs a signal on removal?
913	sub clear {	1043	sub clear {
914	my ($self) = @_;	1044	my ($self) = @_;
915		1045
916	my $children = delete $self->{children};	1046	my @children = $self->children;
		1047	delete $self->{children};
917		1048
918	for (grep $_, map @$_, grep $_, @$children) {	1049	for (@children) {
919	delete $_->{parent};	1050	delete $_->{parent};
920	$_->hide;	1051	$_->hide;
921	}	1052	}
922		1053
923	$self->update;	1054	$self->update;
…		…
1184	s/</</g;	1315	s/</</g;
1185		1316
1186	$_[1]	1317	$_[1]
1187	}	1318	}
1188		1319
		1320	sub update {
		1321	my ($self) = @_;
		1322
		1323	delete $self->{texture};
		1324	$self->SUPER::update;
		1325	}
		1326
		1327	sub reconfigure {
		1328	my ($self) = @_;
		1329
		1330	delete $self->{texture};
		1331	}
		1332
1189	sub set_text {	1333	sub set_text {
1190	my ($self, $text) = @_;	1334	my ($self, $text) = @_;
1191		1335
		1336	return if $self->{text} eq "T$text";
		1337	$self->{text} = "T$text";
		1338
1192	$self->{layout}->set_text ($text);	1339	$self->{layout}->set_text ($text);
1193		1340
1194	delete $self->{texture};	1341	delete $self->{texture};
		1342	$self->update;
1195	$self->check_size;	1343	$self->check_size;
1196	$self->update;
1197	}	1344	}
1198		1345
1199	sub set_markup {	1346	sub set_markup {
1200	my ($self, $markup) = @_;	1347	my ($self, $markup) = @_;
1201		1348
		1349	return if $self->{text} eq "M$markup";
		1350	$self->{text} = "M$markup";
		1351
1202	$self->{layout}->set_markup ($markup);	1352	$self->{layout}->set_markup ($markup);
1203		1353
1204	delete $self->{texture};	1354	delete $self->{texture};
		1355	$self->update;
1205	$self->check_size;	1356	$self->check_size;
1206	$self->update;
1207	}	1357	}
1208		1358
1209	sub size_request {	1359	sub size_request {
1210	my ($self) = @_;	1360	my ($self) = @_;
1211		1361
…		…
1461	my ($self, $ev) = @_;	1611	my ($self, $ev) = @_;
1462		1612
1463	my $sym = $ev->{sym};	1613	my $sym = $ev->{sym};
1464		1614
1465	if ($sym == 13) {	1615	if ($sym == 13) {
		1616	unshift @{$self->{history}},
		1617	my $txt = $self->get_text;
		1618	$self->{history_pointer} = -1;
		1619	$self->{history_saveback} = '';
1466	$self->emit (activate => $self->get_text);	1620	$self->emit (activate => $txt);
1467	$self->update;	1621	$self->update;
		1622
		1623	} elsif ($sym == CFClient::SDLK_UP) {
		1624	if ($self->{history_pointer} < 0) {
		1625	$self->{history_saveback} = $self->get_text;
		1626	}
		1627	if (@{$self->{history} \|\| []} > 0) {
		1628	$self->{history_pointer}++;
		1629	if ($self->{history_pointer} >= @{$self->{history} \|\| []}) {
		1630	$self->{history_pointer} = @{$self->{history} \|\| []} - 1;
		1631	}
		1632	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1633	}
		1634
		1635	} elsif ($sym == CFClient::SDLK_DOWN) {
		1636	$self->{history_pointer}--;
		1637	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
		1638
		1639	if ($self->{history_pointer} >= 0) {
		1640	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1641	} else {
		1642	$self->set_text ($self->{history_saveback});
		1643	}
1468		1644
1469	} else {	1645	} else {
1470	$self->SUPER::key_down ($ev);	1646	$self->SUPER::key_down ($ev);
1471	}	1647	}
1472		1648
…		…
1709	}	1885	}
1710		1886
1711	sub set_max {	1887	sub set_max {
1712	my ($self, $max) = @_;	1888	my ($self, $max) = @_;
1713		1889
		1890	return if $self->{max_val} == $max;
		1891
1714	$self->{max_val} = $max;	1892	$self->{max_val} = $max;
		1893	$self->update;
1715	}	1894	}
1716		1895
1717	sub set_value {	1896	sub set_value {
1718	my ($self, $val, $max) = @_;	1897	my ($self, $val, $max) = @_;
1719		1898
1720	$self->set_max ($max)	1899	$self->set_max ($max)
1721	if defined $max;	1900	if defined $max;
1722		1901
1723	$max = $self->{max_val};	1902	return if $self->{val} == $val;
		1903
1724	$self->{val} = $val;	1904	$self->{val} = $val;
1725
1726	$self->update;	1905	$self->update;
1727	}	1906	}
1728		1907
1729	sub _draw {	1908	sub _draw {
1730	my ($self) = @_;	1909	my ($self) = @_;
…		…
1793		1972
1794	sub new {	1973	sub new {
1795	my ($class, %arg) = @_;	1974	my ($class, %arg) = @_;
1796		1975
1797	my $self = $class->SUPER::new (	1976	my $self = $class->SUPER::new (
1798	tooltip => $arg{type},	1977	tooltip => $arg{type},
1799	can_hover => 1,	1978	can_hover => 1,
		1979	can_events => 1,
1800	%arg,	1980	%arg,
1801	);	1981	);
1802		1982
1803	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	1983	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1804	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	1984	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
…		…
1812		1992
1813	$self->{value}->set_fontsize ($fsize);	1993	$self->{value}->set_fontsize ($fsize);
1814	$self->{max} ->set_fontsize ($fsize);	1994	$self->{max} ->set_fontsize ($fsize);
1815	}	1995	}
1816		1996
		1997	sub set_max {
		1998	my ($self, $max) = @_;
		1999
		2000	$self->{gauge}->set_max ($max);
		2001	$self->{max}->set_text ($max);
		2002	}
		2003
1817	sub set_value {	2004	sub set_value {
1818	my ($self, $val, $max) = @_;	2005	my ($self, $val, $max) = @_;
1819		2006
1820	$self->set_max ($max)	2007	$self->set_max ($max)
1821	if defined $max;	2008	if defined $max;
1822		2009
1823	$self->{gauge}->set_value ($val, $max);	2010	$self->{gauge}->set_value ($val, $max);
1824	$self->{value}->set_text ($val);	2011	$self->{value}->set_text ($val);
1825	}
1826
1827	sub set_max {
1828	my ($self, $max) = @_;
1829
1830	$self->{gauge}->set_max ($max);
1831	$self->{max}->set_text ($max);
1832	}	2012	}
1833		2013
1834	#############################################################################	2014	#############################################################################
1835		2015
1836	package CFClient::UI::Slider;	2016	package CFClient::UI::Slider;
…		…
1855	# TODO: calculations are off	2035	# TODO: calculations are off
1856	my $self = $class->SUPER::new (	2036	my $self = $class->SUPER::new (
1857	fg => [1, 1, 1],	2037	fg => [1, 1, 1],
1858	active_fg => [0, 0, 0],	2038	active_fg => [0, 0, 0],
1859	range => [0, 0, 100, 10],	2039	range => [0, 0, 100, 10],
1860	req_w => 20,	2040	req_w => $::WIDTH / 80,
1861	req_h => 20,	2041	req_h => $::WIDTH / 80,
1862	vertical => 0,	2042	vertical => 0,
1863	can_hover => 1,	2043	can_hover => 1,
1864	inner_pad => 5,	2044	inner_pad => 5,
1865	@_	2045	@_
1866	);	2046	);
…		…
1990	(new CFClient::UI::Empty expand => 1),	2170	(new CFClient::UI::Empty expand => 1),
1991	(new CFClient::UI::Slider vertical => 1),	2171	(new CFClient::UI::Slider vertical => 1),
1992	],	2172	],
1993	);	2173	);
1994		2174
1995	$self->{children}[1]->connect (changed => sub {	2175	$self->{children}[1]->connect (changed => sub { $self->update });
1996	$self->update;
1997	});
1998		2176
1999	$self	2177	$self
2000	}	2178	}
2001		2179
2002	sub set_fontsize {	2180	sub set_fontsize {
…		…
2010	my ($self, $text) = @_;	2188	my ($self, $text) = @_;
2011		2189
2012	my $layout = $self->{layout};	2190	my $layout = $self->{layout};
2013		2191
2014	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2192	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2015	$layout->set_width ($self->{w});	2193	$layout->set_width ($self->{children}[0]{w});
2016	$layout->set_text ($text);	2194	$layout->set_text ($text);
2017		2195
2018	($layout->size)[1]	2196	($layout->size)[1]
2019	}	2197	}
2020		2198
…		…
2073	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2251	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];
2074		2252
2075	delete $self->{texture};	2253	delete $self->{texture};
2076	}	2254	}
2077		2255
2078	$self->{texture} \|\|= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	2256	$self->{texture} \|\|= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {
2079	glClearColor 0, 0, 0, 1;	2257	glClearColor 0, 0, 0, 0;
2080	glClear GL_COLOR_BUFFER_BIT;	2258	glClear GL_COLOR_BUFFER_BIT;
2081		2259
2082	glEnable GL_BLEND;	2260	glEnable GL_BLEND;
2083	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2261	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2084	glEnable GL_TEXTURE_2D;	2262	glEnable GL_TEXTURE_2D;
…		…
2116	}	2294	}
2117		2295
2118	sub _draw {	2296	sub _draw {
2119	my ($self) = @_;	2297	my ($self) = @_;
2120		2298
2121	if ($self->{texture}) {	2299	glEnable GL_BLEND;
		2300	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2122	glEnable GL_TEXTURE_2D;	2301	glEnable GL_TEXTURE_2D;
2123	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2302	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2303	glColor 1, 1, 1, 1;
2124	$self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});	2304	$self->{texture}->draw_quad (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2125	glDisable GL_TEXTURE_2D;	2305	glDisable GL_TEXTURE_2D;
2126	}	2306	glDisable GL_BLEND;
2127		2307
2128	$self->{children}[1]->draw;	2308	$self->{children}[1]->draw;
2129		2309
2130	}	2310	}
2131		2311
…		…
2300		2480
2301	sub size_request {	2481	sub size_request {
2302	(32, 8)	2482	(32, 8)
2303	}	2483	}
2304		2484
2305	sub draw {	2485	sub _draw {
2306	my ($self) = @_;	2486	my ($self) = @_;
2307		2487
2308	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	2488	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];
2309		2489
		2490	# TODO animation
2310	if ($tex) {	2491	if ($tex) {
2311	glEnable GL_BLEND;	2492	glEnable GL_BLEND;
2312	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2493	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2313	glEnable GL_TEXTURE_2D;	2494	glEnable GL_TEXTURE_2D;
2314	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2495	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
…		…
2319	}	2500	}
2320	}	2501	}
2321		2502
2322	#############################################################################	2503	#############################################################################
2323		2504
		2505	package CFClient::UI::Menu;
		2506
		2507	our @ISA = CFClient::UI::FancyFrame::;
		2508
		2509	use CFClient::OpenGL;
		2510
		2511	sub new {
		2512	my $class = shift;
		2513
		2514	my $self = $class->SUPER::new (
		2515	items => [],
		2516	z => 100,
		2517	@_,
		2518	);
		2519
		2520	$self->add ($self->{vbox} = new CFClient::UI::VBox);
		2521
		2522	for my $item (@{ $self->{items} }) {
		2523	my ($widget, $cb) = @$item;
		2524
		2525	# handle various types of items, only text for now
		2526	if (!ref $widget) {
		2527	$widget = new CFClient::UI::Label
		2528	can_hover => 1,
		2529	can_events => 1,
		2530	text => $widget;
		2531	}
		2532
		2533	$self->{item}{$widget} = $item;
		2534
		2535	$self->{vbox}->add ($widget);
		2536	}
		2537
		2538	$self
		2539	}
		2540
		2541	# popup given the event (must be a mouse button down event currently)
		2542	sub popup {
		2543	my ($self, $ev) = @_;
		2544
		2545	$self->emit ("popdown");
		2546
		2547	# maybe save $GRAB? must be careful about events...
		2548	$GRAB = $self;
		2549	$self->{button} = $ev->{button};
		2550
		2551	$self->show;
		2552	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
		2553	}
		2554
		2555	sub mouse_motion {
		2556	my ($self, $ev, $x, $y) = @_;
		2557
		2558	# TODO: should use vbox->find_widget or so
		2559	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
		2560	$self->{hover} = $self->{item}{$HOVER};
		2561	}
		2562
		2563	sub button_up {
		2564	my ($self, $ev, $x, $y) = @_;
		2565
		2566	if ($ev->{button} == $self->{button}) {
		2567	undef $GRAB;
		2568	$self->hide;
		2569
		2570	$self->emit ("popdown");
		2571	$self->{hover}[1]->() if $self->{hover};
		2572	}
		2573	}
		2574
		2575	#############################################################################
		2576
2324	package CFClient::UI::Root;	2577	package CFClient::UI::Root;
2325		2578
2326	our @ISA = CFClient::UI::Container::;	2579	our @ISA = CFClient::UI::Container::;
2327		2580
2328	use CFClient::OpenGL;	2581	use CFClient::OpenGL;
…		…
2400	$self->_draw;	2653	$self->_draw;
2401	}	2654	}
2402		2655
2403	#############################################################################	2656	#############################################################################
2404		2657
		2658	package CFClient::UI::InventoryItem;
		2659
		2660	our @ISA = CFClient::UI::HBox::;
		2661
		2662	sub new {
		2663	my $class = shift;
		2664
		2665	my %args = @_;
		2666
		2667	my $item = $args{item};
		2668
		2669	my $desc = $item->{nrof} < 2
		2670	? $item->{name}
		2671	: "$item->{nrof} $item->{name_pl}";
		2672
		2673
		2674	my $self = $class->SUPER::new (
		2675	can_hover => 1,
		2676	can_events => 1,
		2677	tooltip => (CFClient::UI::Label->escape ($desc)
		2678	. "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
		2679	connect_button_down => sub {
		2680	my ($self, $ev, $x, $y) = @_;
		2681
		2682	# todo: maybe put examine on 1? but should just be a tooltip :(
		2683	if ($ev->{button} == 1) {
		2684	$::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
		2685	} elsif ($ev->{button} == 2) {
		2686	$::CONN->send ("apply $item->{tag}");
		2687	} elsif ($ev->{button} == 3) {
		2688	CFClient::UI::Menu->new (
		2689	items => [
		2690	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
		2691	[
		2692	$item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
		2693	sub { $::CONN->send ("lock $item->{tag}") },
		2694	],
		2695	["mark", sub { $::CONN->send ("mark $item->{tag}") }],
		2696	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
		2697	["drop", sub { $::CONN->send ("move 0 $item->{tag} 0") }],
		2698	],
		2699	)->popup ($ev);
		2700	}
		2701
		2702	1
		2703	},
		2704	%args
		2705	);
		2706	$self->add(new CFClient::UI::Face
		2707	can_events => 0,
		2708	face => $item->{face},
		2709	anim => $item->{anim},
		2710	animspeed => $item->{animspeed});
		2711	$self->add(new CFClient::UI::Label
		2712	can_events => 0,
		2713	text => $desc);
		2714
		2715	$self
		2716	}
		2717
		2718	#############################################################################
		2719
		2720	package CFClient::UI::Inventory;
		2721
		2722	our @ISA = CFClient::UI::ScrolledWindow::;
		2723
		2724	sub new {
		2725	my $class = shift;
		2726
		2727	my $self = $class->SUPER::new (
		2728	scrolled => (new CFClient::UI::VBox),
		2729	@_,
		2730	);
		2731
		2732	$self
		2733	}
		2734
		2735	sub set_items {
		2736	my ($self, $items) = @_;
		2737
		2738	$self->{scrolled}->clear;
		2739	return unless $items;
		2740
		2741	my @items = sort { $a->{type} <=> $b->{type} } @$items;
		2742
		2743	$self->{real_items} = \@items;
		2744
		2745	for my $item (@items) {
		2746	my $desc = $item->{nrof} < 2
		2747	? $item->{name}
		2748	: "$item->{nrof} $item->{name_pl}";
		2749
		2750	$self->{scrolled}->add (new CFClient::UI::InventoryItem item => $item);
		2751	}
		2752
		2753	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
		2754	}
		2755
		2756	sub size_request {
		2757	my ($self) = @_;
		2758	($self->{req_w}, $self->{req_h});
		2759	}
		2760
		2761	#############################################################################
		2762
2405	package CFClient::UI;	2763	package CFClient::UI;
2406		2764
2407	$ROOT = new CFClient::UI::Root;	2765	$ROOT = new CFClient::UI::Root;
2408	$TOOLTIP = new CFClient::UI::Tooltip;	2766	$TOOLTIP = new CFClient::UI::Tooltip;
2409		2767

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.165 by root, Mon Apr 24 08:22:22 2006 UTC vs. Revision 1.184 by root, Wed May 3 19:56:05 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.165 by root, Mon Apr 24 08:22:22 2006 UTC vs.
Revision 1.184 by root, Wed May 3 19:56:05 2006 UTC