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

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.195 by root, Thu May 11 23:54:31 2006 UTC vs.
Revision 1.208 by root, Mon May 15 22:52:17 2006 UTC

…		…
11	our ($FOCUS, $HOVER, $GRAB); # various widgets	11	our ($FOCUS, $HOVER, $GRAB); # various widgets
12		12
13	our $ROOT;	13	our $ROOT;
14	our $TOOLTIP;	14	our $TOOLTIP;
15	our $BUTTON_STATE;	15	our $BUTTON_STATE;
		16
		17	our %WIDGET; # all widgets, weak-referenced
16		18
17	sub check_tooltip {	19	sub check_tooltip {
18	if (!$GRAB) {	20	if (!$GRAB) {
19	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	21	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
20	if (length $widget->{tooltip}) {	22	if (length $widget->{tooltip}) {
…		…
24		26
25	my $tip = $widget->{tooltip};	27	my $tip = $widget->{tooltip};
26		28
27	$tip = $tip->($widget) if CODE:: eq ref $tip;	29	$tip = $tip->($widget) if CODE:: eq ref $tip;
28		30
29	$TOOLTIP->set_markup ($widget->{tooltip}, $widget->{tooltip_font});	31	$TOOLTIP->set_tooltip_from ($widget);
30
31	$TOOLTIP->show;	32	$TOOLTIP->show;
32		33
33	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	34	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
34		35
35	if ($x + $TOOLTIP->{w} > $::WIDTH) {
36	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0);	36	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
37	}	37	if $x + $TOOLTIP->{w} > $::WIDTH;
38		38
39	$TOOLTIP->move ($x, $y);	39	$TOOLTIP->move ($x, $y);
		40	$TOOLTIP->check_size;
		41	$TOOLTIP->update;
40	}	42	}
41		43
42	return;	44	return;
43	}	45	}
44	}	46	}
…		…
131		133
132	for (@$vals) {	134	for (@$vals) {
133	my $i = int $_ + $rem;	135	my $i = int $_ + $rem;
134	$rem += $_ - $i;	136	$rem += $_ - $i;
135	$_ = $i;	137	$_ = $i;
		138	}
		139	}
		140
		141	# call when resolution changes etc.
		142	sub rescale_widgets {
		143	my ($sx, $sy) = @_;
		144
		145	for my $widget (values %WIDGET) {
		146	if ($widget->{toplevel}) {
		147	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};
		148	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
		149	$widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};
		150	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
		151	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};
		152	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
		153	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};
		154	$widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h};
		155	}
		156
		157	$widget->reconfigure;
136	}	158	}
137	}	159	}
138		160
139	#############################################################################	161	#############################################################################
140		162
…		…
159	if (/^connect_(.*)$/) {	181	if (/^connect_(.*)$/) {
160	$self->connect ($1 => delete $self->{$_});	182	$self->connect ($1 => delete $self->{$_});
161	}	183	}
162	}	184	}
163		185
		186	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		187
164	$self	188	$self
165	}	189	}
166		190
167	sub destroy {	191	sub destroy {
168	my ($self) = @_;	192	my ($self) = @_;
…		…
241		265
242	sub size_allocate {	266	sub size_allocate {
243	# nothing to be done	267	# nothing to be done
244	}	268	}
245		269
		270	sub reconfigure {
		271	my ($self) = @_;
		272
		273	$self->check_size (1);
		274	$self->update;
		275	}
		276
246	sub children {	277	sub children {
247	}
248
249	# call when resolution changes etc.
250	sub reconfigure {
251	my ($self) = @_;
252
253	$_->reconfigure
254	for $self->children;
255
256	$self->check_size;
257	$CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $self->{w}, $self->{h}];
258	$self->update;
259	}	278	}
260		279
261	sub set_max_size {	280	sub set_max_size {
262	my ($self, $w, $h) = @_;	281	my ($self, $w, $h) = @_;
263		282
…		…
356	glVertex $self->{w}, 0;	375	glVertex $self->{w}, 0;
357	glVertex $self->{w}, $self->{h};	376	glVertex $self->{w}, $self->{h};
358	glVertex 0 , $self->{h};	377	glVertex 0 , $self->{h};
359	glEnd;	378	glEnd;
360	glPopMatrix;	379	glPopMatrix;
361	CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	380	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
362	}	381	}
363	}	382	}
364		383
365	sub _draw {	384	sub _draw {
366	my ($self) = @_;	385	my ($self) = @_;
…		…
383	sub set_parent {	402	sub set_parent {
384	my ($self, $parent) = @_;	403	my ($self, $parent) = @_;
385		404
386	Scalar::Util::weaken ($self->{parent} = $parent);	405	Scalar::Util::weaken ($self->{parent} = $parent);
387		406
		407	# TODO: req_w _does_change after ->reconfigure
388	$self->check_size	408	$self->check_size
389	unless exists $self->{req_w};	409	unless exists $self->{req_w};
390	}	410	}
391		411
392	sub check_size {	412	sub check_size {
393	my ($self) = @_;	413	my ($self, $forced) = @_;
394		414
		415	$self->{force_alloc} = 1 if $forced;
395	$CFClient::UI::ROOT->{check_size}{$self} = $self;	416	$CFClient::UI::ROOT->{check_size}{$self} = $self;
396	}	417	}
397		418
398	sub update {	419	sub update {
399	my ($self) = @_;	420	my ($self) = @_;
…		…
415	}	436	}
416		437
417	sub DESTROY {	438	sub DESTROY {
418	my ($self) = @_;	439	my ($self) = @_;
419		440
		441	delete $WIDGET{$self+0};
420	#$self->deactivate;	442	#$self->deactivate;
421	}	443	}
422		444
423	#############################################################################	445	#############################################################################
424		446
…		…
509	$self->{children} = [	531	$self->{children} = [
510	sort { $a->{z} <=> $b->{z} }	532	sort { $a->{z} <=> $b->{z} }
511	@{$self->{children}}, @widgets	533	@{$self->{children}}, @widgets
512	];	534	];
513		535
514	$self->check_size;	536	$self->check_size (1);
515	$self->update;	537	$self->update;
516	}	538	}
517		539
518	sub children {	540	sub children {
519	@{ $_[0]{children} }	541	@{ $_[0]{children} }
…		…
626	}	648	}
627		649
628	sub update {	650	sub update {
629	my ($self) = @_;	651	my ($self) = @_;
630		652
631	$ROOT->on_refresh ($self => sub { $self->render_child });	653	$ROOT->on_post_alloc ($self => sub { $self->render_child });
632	$self->SUPER::update;	654	$self->SUPER::update;
633	}	655	}
634		656
635	sub size_allocate {	657	sub size_allocate {
636	my ($self, $w, $h) = @_;	658	my ($self, $w, $h) = @_;
…		…
774	$self->add ($self->{slider});	796	$self->add ($self->{slider});
775		797
776	$self	798	$self
777	}	799	}
778		800
779	#TODO# update range on size_allocate depeneing on child	801	#TODO# update range on size_allocate depending on child
780	# update viewport offset on scroll	802	# update viewport offset on scroll
781		803
782	#############################################################################	804	#############################################################################
783		805
784	package CFClient::UI::Frame;	806	package CFClient::UI::Frame;
…		…
788	use CFClient::OpenGL;	810	use CFClient::OpenGL;
789		811
790	sub new {	812	sub new {
791	my $class = shift;	813	my $class = shift;
792		814
793	my $self = $class->SUPER::new (	815	$class->SUPER::new (
794	bg => [1, 1, 1, 1],	816	bg => undef,
795	border_bg => [1, 1, 1, 1],
796	border => 0.8,
797	@_	817	@_,
798	);	818	)
799
800	$self
801	}	819	}
802		820
803	sub _draw {	821	sub _draw {
804	my ($self) = @_;	822	my ($self) = @_;
805		823
806	my ($w, $h) = ($self->{w}, $self->{h});	824	if ($self->{bg}) {
		825	my ($w, $h) = @$self{qw(w h)};
807		826
808	glEnable GL_BLEND;	827	glEnable GL_BLEND;
809	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	828	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
810	glEnable GL_TEXTURE_2D;	829	glColor @{ $self->{bg} };
811	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
812		830
813	# glBegin GL_QUADS;	831	glBegin GL_QUADS;
814	# glColor 0, 0, 0, 0;
815	# glVertex 0 , 0;	832	glVertex 0 , 0;
816	# glVertex 0 , $h;	833	glVertex 0 , $h;
817	# glVertex $w, $h;	834	glVertex $w, $h;
818	# glVertex $w, 0;	835	glVertex $w, 0;
819	# glEnd;	836	glEnd;
820		837
821
822	$self->child->draw;
823	glDisable GL_BLEND;	838	glDisable GL_BLEND;
824	glDisable GL_TEXTURE_2D;	839	}
		840
		841	$self->SUPER::_draw;
825	}	842	}
826		843
827	#############################################################################	844	#############################################################################
828		845
829	package CFClient::UI::FancyFrame;	846	package CFClient::UI::FancyFrame;
…		…
843		860
844	my $self = $class->SUPER::new (	861	my $self = $class->SUPER::new (
845	bg => [1, 1, 1, 1],	862	bg => [1, 1, 1, 1],
846	border_bg => [1, 1, 1, 1],	863	border_bg => [1, 1, 1, 1],
847	border => 0.6,	864	border => 0.6,
		865	toplevel => 1,
848	can_events => 1,	866	can_events => 1,
849	@_	867	@_
850	);	868	);
851		869
852	$self->{title} &&= new CFClient::UI::Label	870	$self->{title} &&= new CFClient::UI::Label
…		…
877	my ($self, $w, $h) = @_;	895	my ($self, $w, $h) = @_;
878		896
879	$h -= List::Util::max 0, $self->border * 2;	897	$h -= List::Util::max 0, $self->border * 2;
880	$w -= List::Util::max 0, $self->border * 2;	898	$w -= List::Util::max 0, $self->border * 2;
881		899
882	$self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)	900	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
883	if $self->{title};	901	if $self->{title};
884		902
885	$self->child->configure ($self->border, $self->border, $w, $h);	903	$self->child->configure ($self->border, $self->border, $w, $h);
886	}	904	}
887		905
…		…
945	my ($self) = @_;	963	my ($self) = @_;
946		964
947	my ($w, $h ) = ($self->{w}, $self->{h});	965	my ($w, $h ) = ($self->{w}, $self->{h});
948	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	966	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
949		967
950	glEnable GL_BLEND;
951	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
952	glEnable GL_TEXTURE_2D;	968	glEnable GL_TEXTURE_2D;
953	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	969	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
954		970
955	my $border = $self->border;	971	my $border = $self->border;
956		972
957	glColor @{ $self->{border_bg} };	973	glColor @{ $self->{border_bg} };
958	$tex[1]->draw_quad (0, 0, $w, $border);	974	$tex[1]->draw_quad_alpha (0, 0, $w, $border);
959	$tex[3]->draw_quad (0, $border, $border, $ch);	975	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);
960	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	976	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
961	$tex[4]->draw_quad (0, $h - $border, $w, $border);	977	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);
962		978
963	if (@{$self->{bg}} < 4 \|\| $self->{bg}[3]) {	979	if (@{$self->{bg}} < 4 \|\| $self->{bg}[3]) {
964	my $bg = $tex[0];	980	my $bg = $tex[0];
965		981
966	# TODO: repeat texture not scale	982	# TODO: repeat texture not scale
…		…
970	glColor @{ $self->{bg} };	986	glColor @{ $self->{bg} };
971		987
972	$bg->{s} = $rep_x;	988	$bg->{s} = $rep_x;
973	$bg->{t} = $rep_y;	989	$bg->{t} = $rep_y;
974	$bg->{wrap_mode} = 1;	990	$bg->{wrap_mode} = 1;
975	$bg->draw_quad ($border, $border, $cw, $ch);	991	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
		992	}
976		993
977	glDisable GL_TEXTURE_2D;	994	glDisable GL_TEXTURE_2D;
978	glDisable GL_BLEND;
979	}
980		995
981	$self->{title}->draw if $self->{title};	996	$self->{title}->draw if $self->{title};
982		997
983	$self->child->draw;	998	$self->child->draw;
984	}	999	}
…		…
1384	$self->{layout}->set_width ($self->{w});	1399	$self->{layout}->set_width ($self->{w});
1385	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);	1400	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);
1386		1401
1387	my $tex = new_from_layout CFClient::Texture $self->{layout};	1402	my $tex = new_from_layout CFClient::Texture $self->{layout};
1388		1403
1389	$self->{ox} = int $self->{align} < 0 ? $self->{padding}	1404	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}
1390	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1405	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1391	: ($self->{w} - $tex->{w}) * 0.5;	1406	: ($self->{w} - $tex->{w}) * 0.5);
1392		1407
1393	$self->{oy} = int $self->{valign} < 0 ? $self->{padding}	1408	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}
1394	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1409	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1395	: ($self->{h} - $tex->{h}) * 0.5;	1410	: ($self->{h} - $tex->{h}) * 0.5);
1396		1411
1397	$tex	1412	$tex
1398	};	1413	};
1399		1414
1400	glEnable GL_TEXTURE_2D;	1415	glEnable GL_TEXTURE_2D;
…		…
1455	sub set_text {	1470	sub set_text {
1456	my ($self, $text) = @_;	1471	my ($self, $text) = @_;
1457		1472
1458	$self->{cursor} = length $text;	1473	$self->{cursor} = length $text;
1459	$self->_set_text ($text);	1474	$self->_set_text ($text);
		1475	$self->update;
1460	$self->check_size;	1476	$self->check_size;
1461	$self->update;
1462	}	1477	}
1463		1478
1464	sub get_text {	1479	sub get_text {
1465	$_[0]{text}	1480	$_[0]{text}
1466	}	1481	}
…		…
1486	my $sym = $ev->{sym};	1501	my $sym = $ev->{sym};
1487	my $uni = $ev->{unicode};	1502	my $uni = $ev->{unicode};
1488		1503
1489	my $text = $self->get_text;	1504	my $text = $self->get_text;
1490		1505
1491	if ($sym == 8) {	1506	if ($uni == 8) {
1492	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1507	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1493	} elsif ($sym == 127) {	1508	} elsif ($uni == 127) {
1494	substr $text, $self->{cursor}, 1, "";	1509	substr $text, $self->{cursor}, 1, "";
1495	} elsif ($sym == CFClient::SDLK_LEFT) {	1510	} elsif ($sym == CFClient::SDLK_LEFT) {
1496	--$self->{cursor} if $self->{cursor};	1511	--$self->{cursor} if $self->{cursor};
1497	} elsif ($sym == CFClient::SDLK_RIGHT) {	1512	} elsif ($sym == CFClient::SDLK_RIGHT) {
1498	++$self->{cursor} if $self->{cursor} < length $self->{text};	1513	++$self->{cursor} if $self->{cursor} < length $self->{text};
1499	} elsif ($sym == CFClient::SDLK_HOME) {	1514	} elsif ($sym == CFClient::SDLK_HOME) {
1500	$self->{cursor} = 0;	1515	$self->{cursor} = 0;
1501	} elsif ($sym == CFClient::SDLK_END) {	1516	} elsif ($sym == CFClient::SDLK_END) {
1502	$self->{cursor} = length $text;	1517	$self->{cursor} = length $text;
1503	} elsif ($sym == 27) {	1518	} elsif ($uni == 27) {
1504	$self->emit ('escape');	1519	$self->emit ('escape');
1505	} elsif ($uni) {	1520	} elsif ($uni) {
1506	substr $text, $self->{cursor}++, 0, chr $uni;	1521	substr $text, $self->{cursor}++, 0, chr $uni;
1507	}	1522	}
1508		1523
1509	$self->_set_text ($text);	1524	$self->_set_text ($text);
1510	$self->update;	1525	$self->update;
		1526	$self->check_size;
1511	}	1527	}
1512		1528
1513	sub focus_in {	1529	sub focus_in {
1514	my ($self) = @_;	1530	my ($self) = @_;
1515		1531
…		…
1735		1751
1736	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1752	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;
1737		1753
1738	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1754	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1739		1755
		1756	my $tex = $self->{state} ? $tex[1] : $tex[0];
		1757
1740	glEnable GL_TEXTURE_2D;	1758	glEnable GL_TEXTURE_2D;
1741
1742	my $tex = $self->{state} ? $tex[1] : $tex[0];
1743
1744	$tex->draw_quad_alpha (0, 0, $s, $s);	1759	$tex->draw_quad_alpha (0, 0, $s, $s);
1745
1746	glDisable GL_TEXTURE_2D;	1760	glDisable GL_TEXTURE_2D;
1747	}	1761	}
1748		1762
1749	#############################################################################	1763	#############################################################################
1750		1764
…		…
1997	qw(s1_slider.png s1_slider_bg.png);	2011	qw(s1_slider.png s1_slider_bg.png);
1998		2012
1999	sub new {	2013	sub new {
2000	my $class = shift;	2014	my $class = shift;
2001		2015
2002	# range [value, low, high, page]	2016	# range [value, low, high, page, unit]
2003		2017
2004	# TODO: 0-width page	2018	# TODO: 0-width page
2005	# TODO: req_w/h are wrong with vertical	2019	# TODO: req_w/h are wrong with vertical
2006	# TODO: calculations are off	2020	# TODO: calculations are off
2007	my $self = $class->SUPER::new (	2021	my $self = $class->SUPER::new (
…		…
2010	range => [0, 0, 100, 10],	2024	range => [0, 0, 100, 10],
2011	req_w => $::WIDTH / 80,	2025	req_w => $::WIDTH / 80,
2012	req_h => $::WIDTH / 80,	2026	req_h => $::WIDTH / 80,
2013	vertical => 0,	2027	vertical => 0,
2014	can_hover => 1,	2028	can_hover => 1,
2015	inner_pad => 5,	2029	inner_pad => .05,
2016	@_	2030	@_
2017	);	2031	);
2018		2032
		2033	$self->set_value ($self->{range}[0]);
		2034	$self->update;
		2035
2019	$self	2036	$self
		2037	}
		2038
		2039	sub set_value {
		2040	my ($self, $value) = @_;
		2041
		2042	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
		2043
		2044	$hi = $lo + 1 if $hi <= $lo;
		2045
		2046	$value = $lo if $value < $lo;
		2047	$value = $hi if $value > $hi;
		2048
		2049	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
		2050	if $unit;
		2051
		2052	$page = $hi - $lo if $page > $hi - $lo;
		2053
		2054	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
		2055
		2056	if ($value != $old_value) {
		2057	$self->emit (changed => $value);
		2058	$self->update;
		2059	}
2020	}	2060	}
2021		2061
2022	sub size_request {	2062	sub size_request {
2023	my ($self) = @_;	2063	my ($self) = @_;
2024		2064
…		…
2037		2077
2038	sub mouse_motion {	2078	sub mouse_motion {
2039	my ($self, $ev, $x, $y) = @_;	2079	my ($self, $ev, $x, $y) = @_;
2040		2080
2041	if ($GRAB == $self) {	2081	if ($GRAB == $self) {
		2082	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
		2083
		2084	my (undef, $lo, $hi, $page) = @{$self->{range}};
		2085
		2086	$x = $x / ($w * (1 - 2 * $self->{inner_pad})) - $self->{inner_pad};
		2087
		2088	$self->set_value ($x * ($hi - $lo) + $lo);
		2089	}
		2090	}
		2091
		2092	sub update {
		2093	my ($self) = @_;
		2094
		2095	$CFClient::UI::ROOT->on_post_alloc ($self => sub {
		2096	$self->set_value ($self->{range}[0]);
		2097
2042	my ($value, $lo, $hi, $page) = @{$self->{range}};	2098	my ($value, $lo, $hi, $page) = @{$self->{range}};
2043		2099
2044	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2100	my $inner_w = 1 - 2 * $self->{inner_pad};
2045		2101
2046	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2102	$self->{scale} = ($inner_w / ($hi - $lo)) \|\| 1;
2047	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
2048		2103
2049	$x -= $inner_pad_px; # substract the padding	2104	$page = $self->{scale} * $page \|\| 10 / ($self->{w} \|\| 1);
2050	$x = $x * ($hi - $lo) / $inner_w + $lo;	2105	$value = $self->{scale} * ($value - $lo);
2051	$x = $lo if $x < $lo;
2052	$x = $hi - $page if $x > $hi - $page;
2053	$self->{range}[0] = $x;
2054		2106
2055	$self->emit (changed => $x);	2107	$value = $self->{inner_pad} + ($value - $page * 0.5);
2056	$self->update;	2108
		2109	$value = 0 if $value < 0;
		2110	$page = 1 - $value if $value + $page > 1;
		2111
		2112	$self->{knob_x} = $value;
		2113	$self->{knob_w} = $page;
2057	}	2114	});
2058	}
2059		2115
2060	# the inner_* stuff is for generating a padding for the slider handle,	2116	$self->SUPER::update;
2061	# so that the handle doesn't leave the texture. This calculation isn't 100%
2062	# correct propably, but it does the job for now
2063	sub _calc_inner_pad_px {
2064	my ($self, $w) = @_;
2065	($w / 100) * $self->{inner_pad} # % to pixels
2066	}	2117	}
2067		2118
2068	sub _draw {	2119	sub _draw {
2069	my ($self) = @_;	2120	my ($self) = @_;
2070		2121
2071	$self->SUPER::_draw ();	2122	$self->SUPER::_draw ();
2072		2123
2073	my ($w, $h) = @$self{qw(w h)};	2124	glScale $self->{w}, $self->{h};
2074		2125
2075	if ($self->{vertical}) {	2126	if ($self->{vertical}) {
2076	# draw a vertical slider like a rotated horizontal slider	2127	# draw a vertical slider like a rotated horizontal slider
2077		2128
2078	glRotate 90, 0, 0, 1;	2129	glRotate 90, 0, 0, 1;
2079	glTranslate 0, -$self->{w}, 0;	2130	glTranslate 0, 1, 0;
2080
2081	($w, $h) = ($h, $w);
2082	}	2131	}
2083		2132
2084	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2133	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2085	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2134	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2086		2135
2087	my ($value, $lo, $hi, $page) = @{$self->{range}};
2088
2089	$hi = $value + 1 if $lo == $hi;
2090
2091	my $inner_pad_px = $self->_calc_inner_pad_px ($w);
2092	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
2093
2094	$page = int $page * $inner_w / ($hi - $lo);
2095	$value = int +($value - $lo) * $inner_w / ($hi - $lo);
2096
2097	$w -= $page;
2098	$page &= ~1;
2099	glTranslate $page * 0.5, 0, 0;
2100	$page \|\|= 2;
2101
2102	my $knob_a = $inner_pad_px + ($value - $page * 0.5);
2103	my $knob_b = $inner_pad_px + ($value + $page * 0.5);
2104
2105	glEnable GL_TEXTURE_2D;	2136	glEnable GL_TEXTURE_2D;
2106	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2137	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2107		2138
2108	# draw background	2139	# draw background
2109	$tex[1]->draw_quad_alpha (0, 0, $w, $h);	2140	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
2110		2141
2111	# draw handle	2142	# draw handle
2112	$tex[0]->draw_quad_alpha ($knob_a, 0, $knob_b - $knob_a, $h);	2143	$tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2113		2144
2114	glDisable GL_TEXTURE_2D;	2145	glDisable GL_TEXTURE_2D;
2115	}	2146	}
2116		2147
2117	#############################################################################	2148	#############################################################################
…		…
2205		2236
2206	return unless $self->{h} > 0;	2237	return unless $self->{h} > 0;
2207		2238
2208	delete $self->{texture};	2239	delete $self->{texture};
2209		2240
2210	$ROOT->on_refresh ($self, sub {	2241	$ROOT->on_post_alloc ($self, sub {
2211	if (delete $self->{need_reflow}) {	2242	if (delete $self->{need_reflow}) {
2212	my $height = 0;	2243	my $height = 0;
2213		2244
2214	$height += $_->[0] = $self->text_height ($_->[2])	2245	$height += $_->[0] = $self->text_height ($_->[2])
2215	for @{$self->{par}};	2246	for @{$self->{par}};
…		…
2367	@_,	2398	@_,
2368	can_events => 0,	2399	can_events => 0,
2369	)	2400	)
2370	}	2401	}
2371		2402
2372	sub set_markup {	2403	sub set_tooltip_from {
2373	my ($self, $text, $font) = @_;	2404	my ($self, $widget) = @_;
2374		2405
2375	$self->{label} = new CFClient::UI::Label	2406	$self->add (new CFClient::UI::Label
		2407	markup => $widget->{tooltip},
		2408	max_w => ($widget->{tooltip_width} \|\| 0.25) * $::WIDTH,
2376	fontsize => 0.8,	2409	fontsize => 0.8,
2377	fg => [0, 0, 0],	2410	fg => [0, 0, 0, 1],
2378	font => ($font \|\| $::FONT_PROP);	2411	font => ($widget->{tooltip_font} \|\| $::FONT_PROP),
2379		2412	);
2380	$self->{label}->set_max_size ($::WIDTH * 0.3);
2381	$self->{label}->set_markup ($text);
2382	$self->add ($self->{label});
2383	}	2413	}
2384		2414
2385	sub size_request {	2415	sub size_request {
2386	my ($self) = @_;	2416	my ($self) = @_;
2387		2417
…		…
2397	}	2427	}
2398		2428
2399	sub _draw {	2429	sub _draw {
2400	my ($self) = @_;	2430	my ($self) = @_;
2401		2431
2402	glPushMatrix;
2403	glTranslate 0.375, 0.375;	2432	glTranslate 0.375, 0.375;
2404		2433
2405	my ($w, $h) = @$self{qw(w h)};	2434	my ($w, $h) = @$self{qw(w h)};
2406		2435
2407	glColor 1, 0.8, 0.4;	2436	glColor 1, 0.8, 0.4;
…		…
2418	glVertex 0 , $h;	2447	glVertex 0 , $h;
2419	glVertex $w, $h;	2448	glVertex $w, $h;
2420	glVertex $w, 0;	2449	glVertex $w, 0;
2421	glEnd;	2450	glEnd;
2422		2451
2423	glPopMatrix;	2452	glTranslate 2 - 0.375, 2 - 0.375;
2424
2425	glTranslate 2, 2;
2426	$self->SUPER::_draw;	2453	$self->SUPER::_draw;
2427	}	2454	}
2428		2455
2429	#############################################################################	2456	#############################################################################
2430		2457
…		…
2478		2505
2479	my $desc = $item->{nrof} < 2	2506	my $desc = $item->{nrof} < 2
2480	? $item->{name}	2507	? $item->{name}
2481	: "$item->{nrof} $item->{name_pl}";	2508	: "$item->{nrof} $item->{name_pl}";
2482		2509
		2510	$item->{flags} & Crossfire::Protocol::F_OPEN
		2511	and $desc .= " (open)";
		2512	$item->{flags} & Crossfire::Protocol::F_APPLIED
		2513	and $desc .= " (applied)";
		2514	$item->{flags} & Crossfire::Protocol::F_UNPAID
		2515	and $desc .= " (unpaid)";
		2516	$item->{flags} & Crossfire::Protocol::F_MAGIC
		2517	and $desc .= " (magic)";
		2518	$item->{flags} & Crossfire::Protocol::F_CURSED
		2519	and $desc .= " (cursed)";
		2520	$item->{flags} & Crossfire::Protocol::F_DAMNED
		2521	and $desc .= " (damned)";
		2522	$item->{flags} & Crossfire::Protocol::F_LOCKED
		2523	and $desc .= " *";
2483		2524
2484	my $self = $class->SUPER::new (	2525	my $self = $class->SUPER::new (
2485	can_hover => 1,	2526	can_hover => 1,
2486	can_events => 1,	2527	can_events => 1,
2487	tooltip => (CFClient::UI::Label->escape ($desc)	2528	tooltip => (CFClient::UI::Label->escape ($desc)
…		…
2493	if ($ev->{button} == 1) {	2534	if ($ev->{button} == 1) {
2494	$::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");	2535	$::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
2495	} elsif ($ev->{button} == 2) {	2536	} elsif ($ev->{button} == 2) {
2496	$::CONN->send ("apply $item->{tag}");	2537	$::CONN->send ("apply $item->{tag}");
2497	} elsif ($ev->{button} == 3) {	2538	} elsif ($ev->{button} == 3) {
2498	CFClient::UI::Menu->new (	2539	my @menu_items = (
2499	items => [
2500	["examine", sub { $::CONN->send ("examine $item->{tag}") }],	2540	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
		2541	["mark", sub { $::CONN->send ("mark $item->{tag}") }],
		2542	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
		2543	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2501	[	2544	[
2502	$item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",	2545	$item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
2503	sub { $::CONN->send ("lock $item->{tag}") },	2546	sub { $::CONN->send ("lock ". () ."$item->{tag}") },
2504	],
2505	["mark", sub { $::CONN->send ("mark $item->{tag}") }],
2506	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2507	["drop", sub { $::CONN->send ("move 0 $item->{tag} 0") }],
2508	],	2547	],
2509	)->popup ($ev);	2548	);
		2549
		2550	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2510	}	2551	}
2511		2552
2512	1	2553	1
2513	},	2554	},
2514	%args	2555	%args
…		…
2550	my ($self, $items) = @_;	2591	my ($self, $items) = @_;
2551		2592
2552	$self->{scrolled}->clear;	2593	$self->{scrolled}->clear;
2553	return unless $items;	2594	return unless $items;
2554		2595
2555	my @items = sort { $a->{type} <=> $b->{type} } @$items;	2596	my @items = sort {
		2597	($a->{type} <=> $b->{type})
		2598	or ($a->{name} cmp $b->{name})
		2599	} @$items;
2556		2600
2557	$self->{real_items} = \@items;	2601	$self->{real_items} = \@items;
2558		2602
2559	for my $item (@items) {	2603	for my $item (@items) {
2560	my $desc = $item->{nrof} < 2	2604	my $desc = $item->{nrof} < 2
2561	? $item->{name}	2605	? $item->{name}
2562	: "$item->{nrof} $item->{name_pl}";	2606	: "$item->{nrof} $item->{name_pl}";
2563		2607
2564	$self->{scrolled}->add ($item->{widget} \|\|= new CFClient::UI::InventoryItem item => $item);	2608	$item = $item->{widget} \|\|= new CFClient::UI::InventoryItem item => $item;
2565	}	2609	}
		2610
		2611	$self->{scrolled}->add (@items);
2566		2612
2567	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];	2613	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2568	}	2614	}
2569		2615
2570	sub size_request {	2616	sub size_request {
…		…
2657	while (my ($k, $v) = each %{ $self->{item} }) {	2703	while (my ($k, $v) = each %{ $self->{item} }) {
2658	delete $self->{item}{$k} if $v->{timeout} < $NOW;	2704	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2659	}	2705	}
2660		2706
2661	my @widgets;	2707	my @widgets;
2662	my @items = sort { $a->{time} <=> $b->{time} } values %{ $self->{item} };	2708
		2709	my @items = sort {
		2710	$a->{pri} <=> $b->{pri}
		2711	or $b->{id} <=> $a->{id}
		2712	} values %{ $self->{item} };
		2713
2663	my $count = 10 + 1;	2714	my $count = 10 + 1;
2664	for my $item (@items) {	2715	for my $item (@items) {
2665	last unless --$count;	2716	last unless --$count;
2666		2717
2667	push @widgets, $item->{label} \|\|= do {	2718	push @widgets, $item->{label} \|\|= do {
2668	# TODO: doesn't handle markup well (read as: at all)	2719	# TODO: doesn't handle markup well (read as: at all)
2669	my $short = delete $item->{text};	2720	my $short = $item->{count} > 1
		2721	? "<b>$item->{count} ×</b> $item->{text}"
		2722	: $item->{text};
		2723
2670	for ($short) {	2724	for ($short) {
2671	s/^\s+//;	2725	s/^\s+//;
2672	s/\012.*//s;	2726	s/\s+/ /g;
2673	my $len = int 30 / $item->{fontsize};	2727	my $len = int 40 / $item->{fontsize};
2674	substr $_, $len, length, "…" if $len < length;	2728	substr $_, $len, length, "…" if $len < length;
2675	}	2729	}
2676		2730
2677	new CFClient::UI::Label	2731	new CFClient::UI::Label
2678	markup => $short,	2732	markup => $short,
2679	tooltip => delete $item->{tooltip},	2733	tooltip => $item->{tooltip},
		2734	tooltip_font => $::FONT_PROP,
		2735	tooltip_width => 0.67,
2680	fontsize => delete $item->{fontsize},	2736	fontsize => $item->{fontsize},
2681	color => delete $item->{color},	2737	fg => $item->{fg},
2682	can_events => 1,	2738	can_events => 1,
2683	can_hover => 1,	2739	can_hover => 1
2684	};	2740	};
2685	}	2741	}
2686		2742
2687	$self->clear;	2743	$self->clear;
2688	$self->SUPER::add (@widgets);	2744	$self->SUPER::add (reverse @widgets);
2689	}	2745	}
2690		2746
2691	sub add {	2747	sub add {
2692	my ($self, $text, %arg) = @_;	2748	my ($self, $text, %arg) = @_;
2693		2749
2694	my $item = {	2750	$text =~ s/^\s+//;
2695	time => time,	2751	$text =~ s/\s+$//;
		2752
		2753	my $timeout = time + ((delete $arg{timeout}) \|\| 60);
		2754
		2755	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
		2756
		2757	if (my $item = $self->{item}{$group}) {
		2758	if ($item->{text} eq $text) {
		2759	$item->{count}++;
		2760	} else {
		2761	$item->{count} = 1;
		2762	$item->{text} = $item->{tooltip} = $text;
		2763	}
		2764	$item->{id} = ++$self->{id};
		2765	$item->{timeout} = $timeout;
		2766	delete $item->{label};
		2767	} else {
		2768	$self->{item}{$group} = {
		2769	id => ++$self->{id},
2696	text => $text,	2770	text => $text,
2697	timeout => 60,	2771	timeout => $timeout,
2698	tooltip => $text,	2772	tooltip => $text,
2699	fontsize => 0.8,	2773	fontsize => 0.8,
2700	color => [0.8, 0.8, 0.8, 0.8],	2774	fg => [0.8, 0.8, 0.8, 0.8],
		2775	pri => 0,
		2776	count => 1,
2701	%arg,	2777	%arg,
		2778	};
2702	};	2779	}
2703
2704	$item->{timeout} += time;
2705	$item->{group} \|\|= $item+0;
2706
2707	$item = $self->{item}{$item->{group}} \|\|= $item;
2708		2780
2709	$self->reorder;	2781	$self->reorder;
2710	}	2782	}
2711		2783
2712	#############################################################################	2784	#############################################################################
…		…
2746	}	2818	}
2747		2819
2748	sub size_allocate {	2820	sub size_allocate {
2749	my ($self, $w, $h) = @_;	2821	my ($self, $w, $h) = @_;
2750		2822
2751	my $old_w = $self->{old_w};	2823	my $old_w = $self->{old_w}; $self->{old_w} = $w;
2752	my $old_h = $self->{old_h};	2824	my $old_h = $self->{old_h}; $self->{old_h} = $h;
2753		2825
2754	if ($old_w && $old_h) {	2826	CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
2755	for my $child ($self->children) {	2827	if $old_w && $old_h && ($old_w != $w \|\| $old_h != $h);
2756	$child->{x} = int 0.5 + $child->{x} * $w / $old_w;
2757	$child->{w} = int 0.5 + $child->{w} * $w / $old_w;
2758	$child->{req_w} = int 0.5 + $child->{req_w} * $w / $old_w if exists $child->{req_w};
2759	$child->{user_w} = int 0.5 + $child->{user_w} * $w / $old_w if exists $child->{user_w};
2760	$child->{y} = int 0.5 + $child->{y} * $h / $old_h;
2761	$child->{h} = int 0.5 + $child->{h} * $h / $old_h;
2762	$child->{req_h} = int 0.5 + $child->{req_h} * $h / $old_h if exists $child->{req_h};
2763	$child->{user_h} = int 0.5 + $child->{user_h} * $h / $old_h if exists $child->{user_h};
2764	}
2765	}
2766		2828
2767	for my $child ($self->children) {	2829	for my $child ($self->children) {
2768	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	2830	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2769		2831
		2832	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1
		2833	if exists $child->{req_x};
		2834
		2835	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1
		2836	if exists $child->{req_y};
		2837
2770	$X = List::Util::max 0, List::Util::min $w - $W, $X;	2838	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
2771	$Y = List::Util::max 0, List::Util::min $h - $H, $Y;	2839	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
		2840
2772	$child->configure ($X, $Y, $W, $H);	2841	$child->configure ($X, $Y, $W, $H);
2773	}	2842	}
2774
2775	$self->{old_w} = $w;
2776	$self->{old_h} = $h;
2777	}	2843	}
2778		2844
2779	sub coord2local {	2845	sub coord2local {
2780	my ($self, $x, $y) = @_;	2846	my ($self, $x, $y) = @_;
2781		2847
…		…
2794	$self->check_size;	2860	$self->check_size;
2795	$::WANT_REFRESH++;	2861	$::WANT_REFRESH++;
2796	}	2862	}
2797		2863
2798	sub add {	2864	sub add {
2799	my ($self, $child) = @_;	2865	my ($self, @children) = @_;
2800		2866
		2867	for my $child (@children) {
		2868	$child->{toplevel} = 1;
		2869
2801	# integerise window positions	2870	# integerise window positions
2802	$child->{x} = int $child->{x};	2871	$child->{x} = int $child->{x};
2803	$child->{y} = int $child->{y};	2872	$child->{y} = int $child->{y};
		2873	}
2804		2874
2805	$self->SUPER::add ($child);	2875	$self->SUPER::add (@children);
2806	}	2876	}
2807		2877
2808	sub on_refresh {	2878	sub on_refresh {
2809	my ($self, $id, $cb) = @_;	2879	my ($self, $id, $cb) = @_;
2810		2880
2811	$self->{refresh_hook}{$id} = $cb;	2881	$self->{refresh_hook}{$id} = $cb;
2812	}	2882	}
2813		2883
		2884	sub on_post_alloc {
		2885	my ($self, $id, $cb) = @_;
		2886
		2887	$self->{post_alloc_hook}{$id} = $cb;
		2888	}
		2889
2814	sub draw {	2890	sub draw {
2815	my ($self) = @_;	2891	my ($self) = @_;
		2892
		2893	while ($self->{refresh_hook}) {
		2894	$_->()
		2895	for values %{delete $self->{refresh_hook}};
		2896	}
2816		2897
2817	if ($self->{check_size}) {	2898	if ($self->{check_size}) {
2818	my @queue = ([], []);	2899	my @queue = ([], []);
2819		2900
2820	for (;;) {	2901	for (;;) {
…		…
2828		2909
2829	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	2910	my ($w, $h) = $widget->{user_w} && $widget->{user_h}
2830	? @$widget{qw(user_w user_h)}	2911	? @$widget{qw(user_w user_h)}
2831	: $widget->size_request;	2912	: $widget->size_request;
2832		2913
		2914	if (delete $widget->{force_alloc}
2833	if ($w != $widget->{req_w} \|\| $h != $widget->{req_h}) {	2915	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
2834	Carp::confess "$widget: size_request is negative" if $w < 0 \|\| $h < 0;#d#	2916	Carp::confess "$widget: size_request is negative" if $w < 0 \|\| $h < 0;#d#
2835		2917
2836	$widget->{req_w} = $w;	2918	$widget->{req_w} = $w;
2837	$widget->{req_h} = $h;	2919	$widget->{req_h} = $h;
2838		2920
2839	$self->{size_alloc}{$widget} = [$widget, $widget->{w}, $widget->{h}];	2921	$self->{size_alloc}{$widget} = [$widget, $widget->{w} \|\| $w, $widget->{h} \|\| $h];
2840		2922
2841	$widget->{parent}->check_size	2923	$widget->{parent}->check_size
2842	if $widget->{parent};	2924	if $widget->{parent};
2843	}	2925	}
2844	}	2926	}
…		…
2856	$widget->size_allocate ($w, $h);	2938	$widget->size_allocate ($w, $h);
2857	$widget->emit (size_allocate => $w, $h);	2939	$widget->emit (size_allocate => $w, $h);
2858	}	2940	}
2859	}	2941	}
2860		2942
2861	while ($self->{refresh_hook}) {	2943	while ($self->{post_alloc_hook}) {
2862	$_->()	2944	$_->()
2863	for values %{delete $self->{refresh_hook}};	2945	for values %{delete $self->{post_alloc_hook}};
2864	}	2946	}
2865		2947
2866	glViewport 0, 0, $::WIDTH, $::HEIGHT;	2948	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2867	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	2949	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2868	glClear GL_COLOR_BUFFER_BIT;	2950	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.195 by root, Thu May 11 23:54:31 2006 UTC vs. Revision 1.208 by root, Mon May 15 22:52:17 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.195 by root, Thu May 11 23:54:31 2006 UTC vs.
Revision 1.208 by root, Mon May 15 22:52:17 2006 UTC