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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.163 by root, Mon Apr 24 06:40:29 2006 UTC vs.
Revision 1.174 by root, Tue Apr 25 11:18:49 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	}
…		…
137		145
138	sub new {	146	sub new {
139	my $class = shift;	147	my $class = shift;
140		148
141	my $self = bless {	149	my $self = bless {
142	x => 0,	150	x => 0,
143	y => 0,	151	y => 0,
144	z => 0,	152	z => 0,
145	can_events => 1,	153	can_events => 1,
146	@_	154	@_
147	}, $class;	155	}, $class;
148		156
149	for (keys %$self) {	157	for (keys %$self) {
…		…
236		244
237	sub size_allocate {	245	sub size_allocate {
238	# nothing to be done	246	# nothing to be done
239	}	247	}
240		248
		249	sub children {
		250	}
		251
		252	# call when resoltuion changes etc.
		253	sub reconfigure {
		254	my ($self) = @_;
		255
		256	$_->reconfigure
		257	for $self->children;
		258
		259	$_->check_size;
		260	}
		261
241	sub set_max_size {	262	sub set_max_size {
242	my ($self, $w, $h) = @_;	263	my ($self, $w, $h) = @_;
243		264
244	delete $self->{max_w}; $self->{max_w} = $w if $w;	265	delete $self->{max_w}; $self->{max_w} = $w if $w;
245	delete $self->{max_h}; $self->{max_h} = $h if $h;	266	delete $self->{max_h}; $self->{max_h} = $h if $h;
246	}	267	}
247		268
248	# return top left coordinates	269	# return top left coordinates
249	sub _topleft {	270	sub _topleft {
250	my ($self, $x, $y) = @_;	271	my ($self, $x, $y) = @_;
		272
		273	$self->{parent}
		274	or Carp::confess "no parent widget in _topleft\n";#d#
251		275
252	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});	276	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});
253	}	277	}
254		278
255	# translate global coordinates to local coordinate system	279	# translate global coordinates to local coordinate system
…		…
492	sub new {	516	sub new {
493	my ($class, %arg) = @_;	517	my ($class, %arg) = @_;
494		518
495	my $children = delete $arg{children} \|\| [];	519	my $children = delete $arg{children} \|\| [];
496		520
497	my $self = $class->SUPER::new (children => [], can_events => 0, %arg);	521	my $self = $class->SUPER::new (
		522	children => [],
		523	can_events => 0,
		524	%arg,
		525	);
498	$self->add ($_) for @$children;	526	$self->add ($_) for @$children;
499		527
500	$self	528	$self
501	}	529	}
502		530
…		…
513	];	541	];
514		542
515	$child->check_size;	543	$child->check_size;
516	}	544	}
517		545
		546	sub children {
		547	@{ $_[0]{children} }
		548	}
		549
518	sub remove {	550	sub remove {
519	my ($self, $child) = @_;	551	my ($self, $child) = @_;
520		552
521	delete $child->{parent};	553	delete $child->{parent};
522	$child->hide;	554	$child->hide;
…		…
619	}	651	}
620		652
621	sub update {	653	sub update {
622	my ($self) = @_;	654	my ($self) = @_;
623		655
624	# we want to do this delayed...	656	$ROOT->on_refresh ($self => sub { $self->render_child });
625	$self->render_chld;
626	$self->SUPER::update;	657	$self->SUPER::update;
627	}	658	}
628		659
		660	sub size_allocate {
		661	my ($self, $w, $h) = @_;
		662
		663	$self->SUPER::size_allocate ($w, $h);
		664	$self->update;
		665	}
		666
629	sub render_chld {	667	sub render_child {
630	my ($self) = @_;	668	my ($self) = @_;
631		669
632	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	670	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
633	glClearColor 0, 0, 0, 1;	671	glClearColor 0, 0, 0, 0;
634	glClear GL_COLOR_BUFFER_BIT;	672	glClear GL_COLOR_BUFFER_BIT;
635	$self->child->draw;	673	$self->child->draw;
636	};	674	};
637	}	675	}
638		676
639	sub size_allocate {
640	my ($self, $w, $h) = @_;
641
642	$self->child->configure (0, 0, $w, $h);
643
644	$self->render_chld;
645	}
646
647	sub _draw {	677	sub _draw {
648	my ($self) = @_;	678	my ($self) = @_;
649		679
650	my ($w, $h) = ($self->w, $self->h);	680	my ($w, $h) = ($self->w, $self->h);
651		681
652	my $tex = $self->{texture}	682	my $tex = $self->{texture}
653	or return;	683	or return;
654		684
655	glEnable GL_BLEND;	685	glEnable GL_BLEND;
656	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	686	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
657	glEnable GL_TEXTURE_2D;	687	glEnable GL_TEXTURE_2D;
658	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	688	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		689	glColor 0, 0, 0, 1;
659		690
660	$tex->draw_quad (0, 0, $w, $h);	691	$tex->draw_quad (0, 0, $w, $h);
661		692
662	glDisable GL_BLEND;	693	glDisable GL_BLEND;
663	glDisable GL_TEXTURE_2D;	694	glDisable GL_TEXTURE_2D;
…		…
748	my $class = shift;	779	my $class = shift;
749		780
750	# TODO: user_x, user_y, overwrite moveto?	781	# TODO: user_x, user_y, overwrite moveto?
751		782
752	my $self = $class->SUPER::new (	783	my $self = $class->SUPER::new (
753	bg => [1, 1, 1, 1],	784	bg => [1, 1, 1, 1],
754	border_bg => [1, 1, 1, 1],	785	border_bg => [1, 1, 1, 1],
755	border => 0.8,	786	border => 0.8,
756	can_events => 1,	787	can_events => 1,
757	@_	788	@_
758	);	789	);
759		790
760	$self->{title} &&= new CFClient::UI::Label	791	$self->{title} &&= new CFClient::UI::Label
…		…
908	$self->{children}[$y][$x] = $child;	939	$self->{children}[$y][$x] = $child;
909		940
910	$child->check_size;	941	$child->check_size;
911	}	942	}
912		943
		944	sub children {
		945	grep $_, map @$_, grep $_, @{ $_[0]{children} }
		946	}
		947
913	# TODO: move to container class maybe? send childs a signal on removal?	948	# TODO: move to container class maybe? send childs a signal on removal?
914	sub clear {	949	sub clear {
915	my ($self) = @_;	950	my ($self) = @_;
916		951
917	my $children = delete $self->{children};	952	my @children = $self->children;
		953	delete $self->{children};
918		954
919	for (grep $_, map @$_, grep $_, @$children) {	955	for (@children) {
920	delete $_->{parent};	956	delete $_->{parent};
921	$_->hide;	957	$_->hide;
922	}	958	}
923		959
924	$self->update;	960	$self->update;
…		…
1151		1187
1152	sub new {	1188	sub new {
1153	my ($class, %arg) = @_;	1189	my ($class, %arg) = @_;
1154		1190
1155	my $self = $class->SUPER::new (	1191	my $self = $class->SUPER::new (
1156	fg => [1, 1, 1],	1192	fg => [1, 1, 1],
1157	#font => default_font	1193	#font => default_font
1158	fontsize => 1,	1194	fontsize => 1,
1159	text => "",	1195	text => "",
1160	align => -1,	1196	align => -1,
1161	valign => -1,	1197	valign => -1,
1162	padding => 2,	1198	padding => 2,
1163	layout => new CFClient::Layout,	1199	layout => new CFClient::Layout,
1164	can_events => 0,	1200	can_events => 0,
1165	%arg	1201	%arg
1166	);	1202	);
1167		1203
1168	if (exists $self->{template}) {	1204	if (exists $self->{template}) {
…		…
1185	s/</</g;	1221	s/</</g;
1186		1222
1187	$_[1]	1223	$_[1]
1188	}	1224	}
1189		1225
		1226	sub update {
		1227	my ($self) = @_;
		1228
		1229	delete $self->{texture};
		1230	$self->SUPER::update;
		1231	}
		1232
		1233	sub reconfigure {
		1234	my ($self) = @_;
		1235
		1236	delete $self->{texture};
		1237	}
		1238
1190	sub set_text {	1239	sub set_text {
1191	my ($self, $text) = @_;	1240	my ($self, $text) = @_;
1192		1241
		1242	return if $self->{text} eq "T$text";
		1243	$self->{text} = "T$text";
		1244
1193	$self->{layout}->set_text ($text);	1245	$self->{layout}->set_text ($text);
1194		1246
1195	delete $self->{texture};	1247	delete $self->{texture};
		1248	$self->update;
1196	$self->check_size;	1249	$self->check_size;
1197	$self->update;
1198	}	1250	}
1199		1251
1200	sub set_markup {	1252	sub set_markup {
1201	my ($self, $markup) = @_;	1253	my ($self, $markup) = @_;
1202		1254
		1255	return if $self->{text} eq "M$markup";
		1256	$self->{text} = "M$markup";
		1257
1203	$self->{layout}->set_markup ($markup);	1258	$self->{layout}->set_markup ($markup);
1204		1259
1205	delete $self->{texture};	1260	delete $self->{texture};
		1261	$self->update;
1206	$self->check_size;	1262	$self->check_size;
1207	$self->update;
1208	}	1263	}
1209		1264
1210	sub size_request {	1265	sub size_request {
1211	my ($self) = @_;	1266	my ($self) = @_;
1212		1267
…		…
1292		1347
1293	sub new {	1348	sub new {
1294	my $class = shift;	1349	my $class = shift;
1295		1350
1296	$class->SUPER::new (	1351	$class->SUPER::new (
1297	fg => [1, 1, 1],	1352	fg => [1, 1, 1],
1298	bg => [0, 0, 0, 0.2],	1353	bg => [0, 0, 0, 0.2],
1299	active_bg => [1, 1, 1, 0.5],	1354	active_bg => [1, 1, 1, 0.5],
1300	active_fg => [0, 0, 0],	1355	active_fg => [0, 0, 0],
1301	can_hover => 1,	1356	can_hover => 1,
1302	can_focus => 1,	1357	can_focus => 1,
1303	valign => 0,	1358	valign => 0,
1304	can_events => 1,	1359	can_events => 1,
1305	@_	1360	@_
1306	)	1361	)
1307	}	1362	}
1308		1363
…		…
1462	my ($self, $ev) = @_;	1517	my ($self, $ev) = @_;
1463		1518
1464	my $sym = $ev->{sym};	1519	my $sym = $ev->{sym};
1465		1520
1466	if ($sym == 13) {	1521	if ($sym == 13) {
		1522	unshift @{$self->{history}},
		1523	my $txt = $self->get_text;
		1524	$self->{history_pointer} = -1;
		1525	$self->{history_saveback} = '';
1467	$self->emit (activate => $self->get_text);	1526	$self->emit (activate => $txt);
1468	$self->update;	1527	$self->update;
		1528
		1529	} elsif ($sym == CFClient::SDLK_UP) {
		1530	if ($self->{history_pointer} < 0) {
		1531	$self->{history_saveback} = $self->get_text;
		1532	}
		1533	if (@{$self->{history} \|\| []} > 0) {
		1534	$self->{history_pointer}++;
		1535	if ($self->{history_pointer} >= @{$self->{history} \|\| []}) {
		1536	$self->{history_pointer} = @{$self->{history} \|\| []} - 1;
		1537	}
		1538	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1539	}
		1540
		1541	} elsif ($sym == CFClient::SDLK_DOWN) {
		1542	$self->{history_pointer}--;
		1543	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
		1544
		1545	if ($self->{history_pointer} >= 0) {
		1546	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1547	} else {
		1548	$self->set_text ($self->{history_saveback});
		1549	}
1469		1550
1470	} else {	1551	} else {
1471	$self->SUPER::key_down ($ev);	1552	$self->SUPER::key_down ($ev);
1472	}	1553	}
1473		1554
…		…
1487		1568
1488	sub new {	1569	sub new {
1489	my $class = shift;	1570	my $class = shift;
1490		1571
1491	$class->SUPER::new (	1572	$class->SUPER::new (
1492	padding => 4,	1573	padding => 4,
1493	fg => [1, 1, 1],	1574	fg => [1, 1, 1],
1494	bg => [1, 1, 1, 0.2],	1575	bg => [1, 1, 1, 0.2],
1495	active_fg => [0, 0, 1],	1576	active_fg => [0, 0, 1],
1496	can_hover => 1,	1577	can_hover => 1,
1497	align => 0,	1578	align => 0,
1498	valign => 0,	1579	valign => 0,
1499	can_events => 1,	1580	can_events => 1,
1500	@_	1581	@_
1501	)	1582	)
1502	}	1583	}
1503		1584
…		…
1710	}	1791	}
1711		1792
1712	sub set_max {	1793	sub set_max {
1713	my ($self, $max) = @_;	1794	my ($self, $max) = @_;
1714		1795
		1796	return if $self->{max_val} == $max;
		1797
1715	$self->{max_val} = $max;	1798	$self->{max_val} = $max;
		1799	$self->update;
1716	}	1800	}
1717		1801
1718	sub set_value {	1802	sub set_value {
1719	my ($self, $val, $max) = @_;	1803	my ($self, $val, $max) = @_;
1720		1804
1721	$self->set_max ($max)	1805	$self->set_max ($max)
1722	if defined $max;	1806	if defined $max;
1723		1807
1724	$max = $self->{max_val};	1808	return if $self->{val} == $val;
		1809
1725	$self->{val} = $val;	1810	$self->{val} = $val;
1726
1727	$self->update;	1811	$self->update;
1728	}	1812	}
1729		1813
1730	sub _draw {	1814	sub _draw {
1731	my ($self) = @_;	1815	my ($self) = @_;
…		…
1794		1878
1795	sub new {	1879	sub new {
1796	my ($class, %arg) = @_;	1880	my ($class, %arg) = @_;
1797		1881
1798	my $self = $class->SUPER::new (	1882	my $self = $class->SUPER::new (
1799	tooltip => $arg{type},	1883	tooltip => $arg{type},
		1884	can_hover => 1,
1800	can_events => 1,	1885	can_events => 1,
1801	can_hover => 1,
1802	%arg,	1886	%arg,
1803	);	1887	);
1804		1888
1805	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	1889	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1806	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	1890	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
…		…
1814		1898
1815	$self->{value}->set_fontsize ($fsize);	1899	$self->{value}->set_fontsize ($fsize);
1816	$self->{max} ->set_fontsize ($fsize);	1900	$self->{max} ->set_fontsize ($fsize);
1817	}	1901	}
1818		1902
		1903	sub set_max {
		1904	my ($self, $max) = @_;
		1905
		1906	$self->{gauge}->set_max ($max);
		1907	$self->{max}->set_text ($max);
		1908	}
		1909
1819	sub set_value {	1910	sub set_value {
1820	my ($self, $val, $max) = @_;	1911	my ($self, $val, $max) = @_;
1821		1912
1822	$self->set_max ($max)	1913	$self->set_max ($max)
1823	if defined $max;	1914	if defined $max;
1824		1915
1825	$self->{gauge}->set_value ($val, $max);	1916	$self->{gauge}->set_value ($val, $max);
1826	$self->{value}->set_text ($val);	1917	$self->{value}->set_text ($val);
1827	}
1828
1829	sub set_max {
1830	my ($self, $max) = @_;
1831
1832	$self->{gauge}->set_max ($max);
1833	$self->{max}->set_text ($max);
1834	}	1918	}
1835		1919
1836	#############################################################################	1920	#############################################################################
1837		1921
1838	package CFClient::UI::Slider;	1922	package CFClient::UI::Slider;
…		…
1978		2062
1979	sub new {	2063	sub new {
1980	my $class = shift;	2064	my $class = shift;
1981		2065
1982	my $self = $class->SUPER::new (	2066	my $self = $class->SUPER::new (
1983	fontsize => 1,	2067	fontsize => 1,
		2068	can_events => 0,
1984	#font => default_font	2069	#font => default_font
1985	@_,	2070	@_,
1986		2071
1987	layout => (new CFClient::Layout),	2072	layout => (new CFClient::Layout),
1988	par => [],	2073	par => [],
1989	height => 0,	2074	height => 0,
1990	children => [	2075	children => [
1991	(new CFClient::UI::Empty expand => 1),	2076	(new CFClient::UI::Empty expand => 1),
1992	(new CFClient::UI::Slider vertical => 1),	2077	(new CFClient::UI::Slider vertical => 1),
1993	],	2078	],
1994	);	2079	);
1995		2080
…		…
2120	my ($self) = @_;	2205	my ($self) = @_;
2121		2206
2122	if ($self->{texture}) {	2207	if ($self->{texture}) {
2123	glEnable GL_TEXTURE_2D;	2208	glEnable GL_TEXTURE_2D;
2124	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2209	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2210	glColor 1, 1, 1, 1;
2125	$self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});	2211	$self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});
2126	glDisable GL_TEXTURE_2D;	2212	glDisable GL_TEXTURE_2D;
2127	}	2213	}
2128		2214
2129	$self->{children}[1]->draw;	2215	$self->{children}[1]->draw;
…		…
2180		2266
2181	sub new {	2267	sub new {
2182	my $class = shift;	2268	my $class = shift;
2183		2269
2184	my $self = $class->SUPER::new (	2270	my $self = $class->SUPER::new (
2185	state => 0,	2271	state => 0,
2186	connect_activate => \&toggle_flopper,	2272	connect_activate => \&toggle_flopper,
2187	can_events => 1,
2188	@_	2273	@_
2189	);	2274	);
2190		2275
2191	if ($self->{state}) {	2276	if ($self->{state}) {
2192	$self->{state} = 0;	2277	$self->{state} = 0;

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents): Revision 1.163 by root, Mon Apr 24 06:40:29 2006 UTC vs. Revision 1.174 by root, Tue Apr 25 11:18:49 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.163 by root, Mon Apr 24 06:40:29 2006 UTC vs.
Revision 1.174 by root, Tue Apr 25 11:18:49 2006 UTC