ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.146 by elmex, Fri Apr 21 15:03:46 2006 UTC vs.
Revision 1.244 by root, Sat May 27 21:06:09 2006 UTC

1	package CFClient::UI;	1	package CFClient::UI;
2		2
		3	use utf8;
3	use strict;	4	use strict;
4		5
5	use Scalar::Util ();	6	use Scalar::Util ();
6	use List::Util ();	7	use List::Util ();
7		8
8	use CFClient;	9	use CFClient;
		10	use CFClient::Texture;
9		11
10	our ($FOCUS, $HOVER, $GRAB); # various widgets	12	our ($FOCUS, $HOVER, $GRAB); # various widgets
11		13
		14	our $LAYOUT;
12	our $ROOT;	15	our $ROOT;
		16	our $TOOLTIP;
13	our $BUTTON_STATE;	17	our $BUTTON_STATE;
		18
		19	our %WIDGET; # all widgets, weak-referenced
		20
		21	sub get_layout {
		22	for (grep { $_->{name} } values %WIDGET) {
		23	$LAYOUT->{$_->{name}} = {
		24	x => $_->{x} / $::WIDTH,
		25	y => $_->{y} / $::HEIGHT,
		26	w => $_->{w} / $::WIDTH,
		27	h => $_->{h} / $::HEIGHT
		28	};
		29	}
		30
		31	return $LAYOUT;
		32	}
		33
		34	sub set_layout {
		35	my ($layout) = @_;
		36	$LAYOUT = $layout;
		37	}
		38
		39	sub check_tooltip {
		40	if (!$GRAB) {
		41	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
		42	if (length $widget->{tooltip}) {
		43
		44	if ($TOOLTIP->{owner} != $widget) {
		45	$TOOLTIP->{owner} = $widget;
		46
		47	my $tip = $widget->{tooltip};
		48
		49	$tip = $tip->($widget) if CODE:: eq ref $tip;
		50
		51	$TOOLTIP->set_tooltip_from ($widget);
		52	$TOOLTIP->show;
		53
		54	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		55
		56	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
		57	if $x + $TOOLTIP->{w} > $::WIDTH;
		58
		59	$TOOLTIP->move ($x, $y);
		60	$TOOLTIP->check_size;
		61	$TOOLTIP->update;
		62	}
		63
		64	return;
		65	}
		66	}
		67	}
		68
		69	$TOOLTIP->hide;
		70	delete $TOOLTIP->{owner};
		71	}
14		72
15	# class methods for events	73	# class methods for events
16	sub feed_sdl_key_down_event {	74	sub feed_sdl_key_down_event {
17	$FOCUS->key_down ($_[0]) if $FOCUS;	75	$FOCUS->emit (key_down => $_[0])
		76	if $FOCUS;
18	}	77	}
19		78
20	sub feed_sdl_key_up_event {	79	sub feed_sdl_key_up_event {
21	$FOCUS->key_up ($_[0]) if $FOCUS;	80	$FOCUS->emit (key_up => $_[0])
		81	if $FOCUS;
22	}	82	}
23		83
24	sub feed_sdl_button_down_event {	84	sub feed_sdl_button_down_event {
25	my ($ev) = @_;	85	my ($ev) = @_;
26	my ($x, $y) = ($ev->{x}, $ev->{y});	86	my ($x, $y) = ($ev->{x}, $ev->{y});
…		…
28	if (!$BUTTON_STATE) {	88	if (!$BUTTON_STATE) {
29	my $widget = $ROOT->find_widget ($x, $y);	89	my $widget = $ROOT->find_widget ($x, $y);
30		90
31	$GRAB = $widget;	91	$GRAB = $widget;
32	$GRAB->update if $GRAB;	92	$GRAB->update if $GRAB;
		93
		94	check_tooltip;
33	}	95	}
34		96
35	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
36		98
37	$GRAB->button_down ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;	99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
		100	if $GRAB;
38	}	101	}
39		102
40	sub feed_sdl_button_up_event {	103	sub feed_sdl_button_up_event {
41	my ($ev) = @_;	104	my ($ev) = @_;
42	my ($x, $y) = ($ev->{x}, $ev->{y});	105	my ($x, $y) = ($ev->{x}, $ev->{y});
43		106
44	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
45		108
46	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
47		110
48	$GRAB->button_up ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;	111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
		112	if $GRAB;
49		113
50	if (!$BUTTON_STATE) {	114	if (!$BUTTON_STATE) {
51	my $grab = $GRAB; undef $GRAB;	115	my $grab = $GRAB; undef $GRAB;
52	$grab->update if $grab;	116	$grab->update if $grab;
53	$GRAB->update if $GRAB;	117	$GRAB->update if $GRAB;
		118
		119	check_tooltip;
54	}	120	}
55	}	121	}
56		122
57	sub feed_sdl_motion_event {	123	sub feed_sdl_motion_event {
58	my ($ev) = @_;	124	my ($ev) = @_;
…		…
63	if ($widget != $HOVER) {	129	if ($widget != $HOVER) {
64	my $hover = $HOVER; $HOVER = $widget;	130	my $hover = $HOVER; $HOVER = $widget;
65		131
66	$hover->update if $hover && $hover->{can_hover};	132	$hover->update if $hover && $hover->{can_hover};
67	$HOVER->update if $HOVER && $HOVER->{can_hover};	133	$HOVER->update if $HOVER && $HOVER->{can_hover};
68	}
69		134
		135	check_tooltip;
		136	}
		137
70	$HOVER->mouse_motion ($ev, $HOVER->coord2local ($x, $y)) if $HOVER;	138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
		139	if $HOVER;
71	}	140	}
72		141
73	# convert position array to integers	142	# convert position array to integers
74	sub harmonize {	143	sub harmonize {
75	my ($vals) = @_;	144	my ($vals) = @_;
…		…
81	$rem += $_ - $i;	150	$rem += $_ - $i;
82	$_ = $i;	151	$_ = $i;
83	}	152	}
84	}	153	}
85		154
		155	sub full_refresh {
		156	# make a copy, otherwise for complains about freed values.
		157	my @widgets = values %WIDGET;
		158
		159	$_->update
		160	for @widgets;
		161	}
		162
		163	sub reconfigure_widgets {
		164	# make a copy, otherwise C<for> complains about freed values.
		165	my @widgets = values %WIDGET;
		166
		167	$_->reconfigure
		168	for @widgets;
		169	}
		170
		171	# call when resolution changes etc.
		172	sub rescale_widgets {
		173	my ($sx, $sy) = @_;
		174
		175	for my $widget (values %WIDGET) {
		176	if ($widget->{is_toplevel}) {
		177	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};
		178	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
		179	$widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};
		180	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
		181	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};
		182	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
		183	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};
		184	$widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h};
		185	}
		186	}
		187
		188	reconfigure_widgets;
		189	}
		190
86	#############################################################################	191	#############################################################################
87		192
88	package CFClient::UI::Base;	193	package CFClient::UI::Base;
89		194
90	use strict;	195	use strict;
…		…
93		198
94	sub new {	199	sub new {
95	my $class = shift;	200	my $class = shift;
96		201
97	my $self = bless {	202	my $self = bless {
98	x => 0,	203	x => 0,
99	y => 0,	204	y => 0,
100	z => 0,	205	z => 0,
		206	can_events => 1,
101	@_	207	@_
102	}, $class;	208	}, $class;
103		209
104	for (keys %$self) {	210	for (keys %$self) {
105	if (/^connect_(.*)$/) {	211	if (/^on_(.*)$/) {
106	$self->connect ($1 => delete $self->{$_});	212	$self->connect ($1 => delete $self->{$_});
107	}	213	}
108	}	214	}
109		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		217
		218	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		219	$self->{user_x} = $layout->{x} * $::WIDTH;
		220	$self->{user_y} = $layout->{y} * $::HEIGHT;
		221	$self->{user_w} = ($layout->{w} != 0 ? $layout->{w} : 1) * $::WIDTH;
		222	$self->{user_h} = ($layout->{h} != 0 ? $layout->{h} : 1) * $::HEIGHT;
		223	}
		224
110	$self	225	$self
111	}	226	}
112		227
		228	sub destroy {
		229	my ($self) = @_;
		230
		231	$self->hide;
		232	%$self = ();
		233	}
		234
113	sub show {	235	sub show {
114	my ($self) = @_;	236	my ($self) = @_;
115
116	return if $self->{parent};	237	return if $self->{parent};
117		238
118	$CFClient::UI::ROOT->add ($self);	239	$CFClient::UI::ROOT->add ($self);
119	}	240	}
120		241
		242	sub show_centered {
		243	my ($self) = @_;
		244	return if $self->{parent};
		245
		246	$self->show;
		247
		248	$CFClient::UI::ROOT->on_post_alloc (
		249	"centered $self" => sub {
		250	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);
		251	},
		252	);
		253	}
		254
		255	sub set_invisible {
		256	my ($self) = @_;
		257
		258	return unless $self->{visible};
		259
		260	# broken show/hide model
		261
		262	delete $self->{root};
		263	delete $self->{visible};
		264
		265	undef $GRAB if $GRAB == $self;
		266	undef $HOVER if $HOVER == $self;
		267
		268	CFClient::UI::check_tooltip
		269	if $CFClient::UI::TOOLTIP->{owner} == $self;
		270
		271	$self->focus_out;
		272
		273	$self->emit (visibility_change => 0);
		274	}
		275
121	sub hide {	276	sub hide {
122	my ($self) = @_;	277	my ($self) = @_;
123		278
124	return unless $self->{parent};	279	$self->set_invisible;
125		280
126	$self->{parent}->remove ($self);	281	$self->{parent}->remove ($self)
		282	if $self->{parent};
127	}	283	}
128		284
129	sub move {	285	sub move {
130	my ($self, $x, $y, $z) = @_;	286	my ($self, $x, $y, $z) = @_;
131		287
…		…
134	$self->{z} = $z if defined $z;	290	$self->{z} = $z if defined $z;
135		291
136	$self->update;	292	$self->update;
137	}	293	}
138		294
139	sub needs_redraw {	295	sub set_size {
140	0	296	my ($self, $w, $h) = @_;
		297
		298	$self->{user_w} = $w;
		299	$self->{user_h} = $h;
		300
		301	$self->check_size;
141	}	302	}
142		303
143	sub size_request {	304	sub size_request {
144	require Carp;	305	require Carp;
145	Carp::confess "size_request is abtract";	306	Carp::confess "size_request is abstract";
146	}	307	}
147		308
148	sub configure {	309	sub configure {
149	my ($self, $x, $y, $w, $h) = @_;	310	my ($self, $x, $y, $w, $h) = @_;
150		311
…		…
152	my $w2 = List::Util::min $w, int $h * $self->{aspect};	313	my $w2 = List::Util::min $w, int $h * $self->{aspect};
153	my $h2 = List::Util::min $h, int $w / $self->{aspect};	314	my $h2 = List::Util::min $h, int $w / $self->{aspect};
154		315
155	# use alignment to adjust x, y	316	# use alignment to adjust x, y
156		317
157	$x += ($w - $w2) * 0.5;	318	$x += int +($w - $w2) * 0.5;
158	$y += ($h - $h2) * 0.5;	319	$y += int +($h - $h2) * 0.5;
159		320
160	($w, $h) = ($w2, $h2);	321	($w, $h) = ($w2, $h2);
161	}	322	}
162		323
163	if ($self->{x} != $x || $self->{y} != $y) {	324	if ($self->{x} != $x || $self->{y} != $y) {
…		…
165	$self->{y} = $y;	326	$self->{y} = $y;
166	$self->update;	327	$self->update;
167	}	328	}
168		329
169	if ($self->{w} != $w || $self->{h} != $h) {	330	if ($self->{w} != $w || $self->{h} != $h) {
170	$self->{w} = $w;	331	$CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h];
171	$self->{h} = $h;
172
173	$self->size_allocate ($w, $h);
174	$self->update;
175	}	332	}
176	}	333	}
177		334
178	sub size_allocate {	335	sub size_allocate {
179	# nothing to be done	336	# nothing to be done
180	}	337	}
181		338
182	# return top left coordinates	339	sub reconfigure {
183	sub _topleft {	340	my ($self) = @_;
		341
		342	$self->check_size (1);
		343	$self->update;
		344	}
		345
		346	sub children {
		347	}
		348
		349	sub set_max_size {
184	my ($self, $x, $y) = @_;	350	my ($self, $w, $h) = @_;
185		351
186	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});	352	delete $self->{max_w}; $self->{max_w} = $w if $w;
		353	delete $self->{max_h}; $self->{max_h} = $h if $h;
		354	}
		355
		356	sub set_tooltip {
		357	my ($self, $tooltip) = @_;
		358
		359	$tooltip =~ s/^\s+//;
		360	$tooltip =~ s/\s+$//;
		361
		362	return if $self->{tooltip} eq $tooltip;
		363
		364	$self->{tooltip} = $tooltip;
		365
		366	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
		367	delete $CFClient::UI::TOOLTIP->{owner};
		368	CFClient::UI::check_tooltip;
		369	}
187	}	370	}
188		371
189	# translate global coordinates to local coordinate system	372	# translate global coordinates to local coordinate system
190	sub coord2local {	373	sub coord2local {
191	my ($self, $x, $y) = @_;	374	my ($self, $x, $y) = @_;
192		375
193	my ($X, $Y) = $self->_topleft;	376	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
194	($x - $X, $y - $Y)
195	}	377	}
196		378
197	# translate local coordinates to global coordinate system	379	# translate local coordinates to global coordinate system
198	sub coord2global {	380	sub coord2global {
199	my ($self, $x, $y) = @_;	381	my ($self, $x, $y) = @_;
200		382
201	my ($X, $Y) = $self->_topleft;	383	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
202	($x + $X, $y + $Y)
203	}	384	}
204		385
205	sub focus_in {	386	sub focus_in {
206	my ($self) = @_;	387	my ($self) = @_;
207		388
208	return if $FOCUS == $self;	389	return if $FOCUS == $self;
209	return unless $self->{can_focus};	390	return unless $self->{can_focus};
210		391
211	my $focus = $FOCUS; $FOCUS = $self;	392	my $focus = $FOCUS; $FOCUS = $self;
212		393
213	$self->emit (focus_in => $focus);	394	$self->_emit (focus_in => $focus);
214		395
215	$focus->update if $focus;	396	$focus->update if $focus;
216	$FOCUS->update;	397	$FOCUS->update;
217	}	398	}
218		399
…		…
221		402
222	return unless $FOCUS == $self;	403	return unless $FOCUS == $self;
223		404
224	my $focus = $FOCUS; undef $FOCUS;	405	my $focus = $FOCUS; undef $FOCUS;
225		406
226	$self->emit (focus_out => $focus);	407	$self->_emit (focus_out => $focus);
227		408
228	$focus->update if $focus; #?	409	$focus->update if $focus; #?
		410
		411	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		412	unless $FOCUS;
229	}	413	}
230		414
231	sub mouse_motion { }	415	sub mouse_motion { }
232	sub button_up { }	416	sub button_up { }
233	sub key_down { }	417	sub key_down { }
234	sub key_up { }	418	sub key_up { }
235		419
236	sub button_down {	420	sub button_down {
237	my ($self, $ev, $x, $y) = @_;	421	my ($self, $ev, $x, $y) = @_;
238		422
239	$self->focus_in;	423	$self->focus_in;
…		…
267	glVertex $x + $self->{w}, $y + $self->{h};	451	glVertex $x + $self->{w}, $y + $self->{h};
268	glVertex $x , $y + $self->{h};	452	glVertex $x , $y + $self->{h};
269	glEnd;	453	glEnd;
270	glDisable GL_BLEND;	454	glDisable GL_BLEND;
271	}	455	}
		456
		457	if ($ENV{PCLIENT_DEBUG}) {
		458	glPushMatrix;
		459	glColor 1, 1, 0, 1;
		460	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
		461	glBegin GL_LINE_LOOP;
		462	glVertex 0 , 0;
		463	glVertex $self->{w} - 1, 0;
		464	glVertex $self->{w} - 1, $self->{h} - 1;
		465	glVertex 0 , $self->{h} - 1;
		466	glEnd;
		467	glPopMatrix;
		468	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
		469	}
272	}	470	}
273		471
274	sub _draw {	472	sub _draw {
275	my ($self) = @_;	473	my ($self) = @_;
276		474
277	warn "no draw defined for $self\n";	475	warn "no draw defined for $self\n";
278	}	476	}
279		477
280	sub find_widget {	478	sub find_widget {
281	my ($self, $x, $y) = @_;	479	my ($self, $x, $y) = @_;
		480
		481	return () unless $self->{can_events};
282		482
283	return $self	483	return $self
284	if $x >= $self->{x} && $x < $self->{x} + $self->{w}	484	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
285	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};	485	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
286		486
…		…
289		489
290	sub set_parent {	490	sub set_parent {
291	my ($self, $parent) = @_;	491	my ($self, $parent) = @_;
292		492
293	Scalar::Util::weaken ($self->{parent} = $parent);	493	Scalar::Util::weaken ($self->{parent} = $parent);
		494
		495	if ($parent->{visible} || 1) {
		496	$self->{root} = $parent->{root};
		497	$self->{visible} = $parent->{visible} + 1;
		498
		499	$self->emit (visibility_change => 1)
		500	unless $self->{parent}{visible};
		501	}
		502
		503	# TODO: req_w _does_change after ->reconfigure
		504	$self->check_size
		505	unless exists $self->{req_w};
		506
		507	$self->show;
294	}	508	}
295		509
296	sub check_size {	510	sub check_size {
297	my ($self) = @_;	511	my ($self, $forced) = @_;
298		512
299	my ($w, $h) = $self->size_request;	513	$self->{force_alloc} = 1 if $forced;
300		514	$CFClient::UI::ROOT->{check_size}{$self} = $self;
301	if ($w != $self->{req_w} || $h != $self->{req_h}) {
302	$self->{req_w} = $w;
303	$self->{req_h} = $h;
304
305	$self->{parent}->check_size
306	if $self->{parent};
307	}
308	}	515	}
309		516
310	sub update {	517	sub update {
311	my ($self) = @_;	518	my ($self) = @_;
312		519
…		…
318	my ($self, $signal, $cb) = @_;	525	my ($self, $signal, $cb) = @_;
319		526
320	push @{ $self->{signal_cb}{$signal} }, $cb;	527	push @{ $self->{signal_cb}{$signal} }, $cb;
321	}	528	}
322		529
		530	sub _emit {
		531	my ($self, $signal, @args) = @_;
		532
		533	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		534	}
		535
323	sub emit {	536	sub emit {
324	my ($self, $signal, @args) = @_;	537	my ($self, $signal, @args) = @_;
325		538
326	for my $cb (@{$self->{signal_cb}{$signal} || []}) {	539	$self->_emit ($signal, @args)
327	$cb->($self, @args);	540	|| $self->$signal (@args);
328	}	541	}
		542
		543	sub visibility_change {
		544	#my ($self, $visible) = @_;
329	}	545	}
330		546
331	sub DESTROY {	547	sub DESTROY {
332	my ($self) = @_;	548	my ($self) = @_;
333		549
		550	delete $WIDGET{$self+0};
334	#$self->deactivate;	551	#$self->deactivate;
335	}	552	}
336		553
337	#############################################################################	554	#############################################################################
338		555
…		…
347	my $class = shift;	564	my $class = shift;
348		565
349	# range [value, low, high, page]	566	# range [value, low, high, page]
350		567
351	$class->SUPER::new (	568	$class->SUPER::new (
352	bg => [0, 0, 0, 0.2],	569	#bg => [0, 0, 0, 0.2],
353	active_bg => [1, 1, 1, 0.5],	570	#active_bg => [1, 1, 1, 0.5],
354	@_	571	@_
355	)	572	)
356	}	573	}
357		574
358	sub _draw {	575	sub _draw {
359	my ($self) = @_;	576	my ($self) = @_;
360		577
		578	my $color = $FOCUS == $self && $self->{active_bg}
		579	? $self->{active_bg}
		580	: $self->{bg};
		581
		582	if ($color && (@$color < 4 || $color->[3])) {
361	my ($w, $h) = @$self{qw(w h)};	583	my ($w, $h) = @$self{qw(w h)};
362		584
363	glEnable GL_BLEND;	585	glEnable GL_BLEND;
364	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	586	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
365	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	587	glColor @$color;
366		588
367	glBegin GL_QUADS;	589	glBegin GL_QUADS;
368	glVertex 0 , 0;	590	glVertex 0 , 0;
369	glVertex 0 , $h;	591	glVertex 0 , $h;
370	glVertex $w, $h;	592	glVertex $w, $h;
371	glVertex $w, 0;	593	glVertex $w, 0;
372	glEnd;	594	glEnd;
373		595
374	glDisable GL_BLEND;	596	glDisable GL_BLEND;
		597	}
375	}	598	}
376		599
377	#############################################################################	600	#############################################################################
378		601
379	package CFClient::UI::Empty;	602	package CFClient::UI::Empty;
380		603
381	our @ISA = CFClient::UI::Base::;	604	our @ISA = CFClient::UI::Base::;
		605
		606	sub new {
		607	my ($class, %arg) = @_;
		608	$class->SUPER::new (can_events => 0, %arg);
		609	}
382		610
383	sub size_request {	611	sub size_request {
384	(0, 0)	612	(0, 0)
385	}	613	}
386		614
…		…
395	sub new {	623	sub new {
396	my ($class, %arg) = @_;	624	my ($class, %arg) = @_;
397		625
398	my $children = delete $arg{children} || [];	626	my $children = delete $arg{children} || [];
399		627
400	my $self = $class->SUPER::new (children => [], %arg);	628	my $self = $class->SUPER::new (
		629	children => [],
		630	can_events => 0,
		631	%arg,
		632	);
401	$self->add ($_) for @$children;	633	$self->add ($_) for @$children;
402		634
403	$self	635	$self
404	}	636	}
405		637
406	sub add {	638	sub add {
407	my ($self, $child) = @_;	639	my ($self, @widgets) = @_;
408		640
409	$child->set_parent ($self);	641	$_->set_parent ($self)
		642	for @widgets;
410		643
411	use sort 'stable';	644	use sort 'stable';
412		645
413	$self->{children} = [	646	$self->{children} = [
414	sort { $a->{z} <=> $b->{z} }	647	sort { $a->{z} <=> $b->{z} }
415	@{$self->{children}}, $child	648	@{$self->{children}}, @widgets
416	];	649	];
417		650
418	$child->check_size;	651	$self->check_size (1);
		652	$self->update;
		653	}
		654
		655	sub children {
		656	@{ $_[0]{children} }
419	}	657	}
420		658
421	sub remove {	659	sub remove {
422	my ($self, $child) = @_;	660	my ($self, $child) = @_;
423		661
424	delete $child->{parent};	662	delete $child->{parent};
		663	$child->hide;
425		664
426	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	665	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
427		666
		667	$self->check_size (1);
		668	$self->update;
		669	}
		670
		671	sub clear {
		672	my ($self) = @_;
		673
		674	my $children = delete $self->{children};
		675	$self->{children} = [];
		676
		677	for (@$children) {
		678	delete $_->{parent};
		679	$_->hide;
		680	}
		681
428	$self->check_size;	682	$self->check_size;
		683	$self->update;
429	}	684	}
430		685
431	sub find_widget {	686	sub find_widget {
432	my ($self, $x, $y) = @_;	687	my ($self, $x, $y) = @_;
433		688
…		…
508	}	763	}
509		764
510	sub update {	765	sub update {
511	my ($self) = @_;	766	my ($self) = @_;
512		767
513	# we want to do this delayed...	768	$ROOT->on_post_alloc ($self => sub { $self->render_child });
514	$self->render_chld;
515	$self->SUPER::update;	769	$self->SUPER::update;
516	}
517
518	sub render_chld {
519	my ($self) = @_;
520
521	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
522	glClearColor 0, 0, 0, 1;
523	glClear GL_COLOR_BUFFER_BIT;
524	$self->child->draw;
525	};
526	}	770	}
527		771
528	sub size_allocate {	772	sub size_allocate {
529	my ($self, $w, $h) = @_;	773	my ($self, $w, $h) = @_;
530		774
531	$self->child->configure (0, 0, $w, $h);	775	$self->SUPER::size_allocate ($w, $h);
		776	$self->update;
		777	}
532		778
		779	sub _render {
		780	$_[0]{children}[0]->draw;
		781	}
		782
		783	sub render_child {
		784	my ($self) = @_;
		785
		786	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
		787	glClearColor 0, 0, 0, 0;
		788	glClear GL_COLOR_BUFFER_BIT;
		789
533	$self->render_chld;	790	$self->_render;
		791	};
534	}	792	}
535		793
536	sub _draw {	794	sub _draw {
537	my ($self) = @_;	795	my ($self) = @_;
538		796
539	my ($w, $h) = ($self->w, $self->h);	797	my ($w, $h) = ($self->w, $self->h);
540		798
541	my $tex = $self->{texture}	799	my $tex = $self->{texture}
542	or return;	800	or return;
543		801
544	glEnable GL_BLEND;
545	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
546	glEnable GL_TEXTURE_2D;	802	glEnable GL_TEXTURE_2D;
547	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	803	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		804	glColor 1, 1, 1, 1;
548		805
549	$tex->draw_quad (0, 0, $w, $h);	806	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
550		807
551	glDisable GL_BLEND;
552	glDisable GL_TEXTURE_2D;	808	glDisable GL_TEXTURE_2D;
553	}	809	}
554		810
555	#############################################################################	811	#############################################################################
556		812
557	package CFClient::UI::ViewPort;	813	package CFClient::UI::ViewPort;
558		814
559	our @ISA = CFClient::UI::Window::;	815	our @ISA = CFClient::UI::Window::;
560		816
561	sub new { die }	817	sub new {
		818	my $class = shift;
		819
		820	$class->SUPER::new (
		821	scroll_x => 0,
		822	scroll_y => 1,
		823	@_,
		824	)
		825	}
562		826
563	sub size_request {	827	sub size_request {
564	my ($self) = @_;	828	my ($self) = @_;
565		829
566	@$self{qw(child_w child_h)} = $self->child->size_request;	830	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
567	$self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
568		831
569	@$self{qw(child_w child_h)}	832	@$self{qw(child_w child_h)}
570	}	833	}
571		834
		835	sub size_allocate {
		836	my ($self, $w, $h) = @_;
		837
		838	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};
		839	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};
		840
		841	$self->child->configure (0, 0, $w, $h);
		842	$self->update;
		843	}
		844
		845	sub set_offset {
		846	my ($self, $x, $y) = @_;
		847
		848	$self->{view_x} = int $x;
		849	$self->{view_y} = int $y;
		850
		851	$self->update;
		852	}
		853
		854	# hmm, this does not work for topleft of $self... but we should not ask for that
		855	sub coord2local {
		856	my ($self, $x, $y) = @_;
		857
		858	$self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
		859	}
		860
		861	sub coord2global {
		862	my ($self, $x, $y) = @_;
		863
		864	$x = List::Util::min $self->{w}, $x - $self->{view_x};
		865	$y = List::Util::min $self->{h}, $y - $self->{view_y};
		866
		867	$self->SUPER::coord2global ($x, $y)
		868	}
		869
		870	sub find_widget {
		871	my ($self, $x, $y) = @_;
		872
		873	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
		874	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
		875	) {
		876	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
		877	} else {
		878	$self->CFClient::UI::Base::find_widget ($x, $y)
		879	}
		880	}
		881
		882	sub _render {
		883	my ($self) = @_;
		884
		885	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
		886
		887	$self->SUPER::_render;
		888	}
		889
		890	#############################################################################
		891
		892	package CFClient::UI::ScrolledWindow;
		893
		894	our @ISA = CFClient::UI::HBox::;
		895
		896	sub new {
		897	my $class = shift;
		898
		899	my $self;
		900
		901	my $slider = new CFClient::UI::Slider
		902	vertical => 1,
		903	range => [0, 0, 1, 0.01], # HACK fix
		904	on_changed => sub {
		905	$self->{vp}->set_offset (0, $_[1]);
		906	},
		907	;
		908
		909	$self = $class->SUPER::new (
		910	vp => (new CFClient::UI::ViewPort expand => 1),
		911	slider => $slider,
		912	@_,
		913	);
		914
		915	$self->{vp}->add ($self->{scrolled});
		916	$self->add ($self->{vp});
		917	$self->add ($self->{slider});
		918
		919	$self
		920	}
		921
		922	sub update {
		923	my ($self) = @_;
		924
		925	$self->SUPER::update;
		926
		927	# todo: overwrite size_allocate of child
		928	my $child = $self->{vp}->child;
		929	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		930	}
		931
		932	sub size_allocate {
		933	my ($self, $w, $h) = @_;
		934
		935	$self->SUPER::size_allocate ($w, $h);
		936
		937	my $child = $self->{vp}->child;
		938	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		939	}
		940
		941	#TODO# update range on size_allocate depending on child
		942	# update viewport offset on scroll
		943
		944	#############################################################################
		945
		946	package CFClient::UI::Frame;
		947
		948	our @ISA = CFClient::UI::Bin::;
		949
		950	use CFClient::OpenGL;
		951
		952	sub new {
		953	my $class = shift;
		954
		955	$class->SUPER::new (
		956	bg => undef,
		957	@_,
		958	)
		959	}
		960
572	sub _draw {	961	sub _draw {
573	my ($self) = @_;	962	my ($self) = @_;
574		963
575	$self->{children}[1]->draw;	964	if ($self->{bg}) {
576	}	965	my ($w, $h) = @$self{qw(w h)};
577		966
		967	glEnable GL_BLEND;
		968	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
		969	glColor @{ $self->{bg} };
578		970
579	#############################################################################
580
581	package CFClient::UI::Frame;
582
583	our @ISA = CFClient::UI::Bin::;
584
585	use CFClient::OpenGL;
586
587	sub size_request {
588	my ($self) = @_;
589	my $chld = $self->child
590	or return (0, 0);
591
592	$chld->move (2, 2);
593
594	map { $_ + 4 } $chld->size_request;
595	}
596
597	sub size_allocate {
598	my ($self, $x, $y, $w, $h) = @_;
599
600	$self->child->configure (2, 2, $w - 4, $h - 4);
601	}
602
603	sub _draw {
604	my ($self) = @_;
605
606	my $chld = $self->child;
607
608	my ($w, $h) = $chld->size_request;
609
610	glBegin GL_QUADS;	971	glBegin GL_QUADS;
611	glColor 0, 0, 0;
612	glVertex 0 , 0;	972	glVertex 0 , 0;
613	glVertex 0 , $h + 4;	973	glVertex 0 , $h;
614	glVertex $w + 4 , $h + 4;	974	glVertex $w, $h;
615	glVertex $w + 4 , 0;	975	glVertex $w, 0;
616	glEnd;	976	glEnd;
617		977
618	$chld->draw;	978	glDisable GL_BLEND;
		979	}
		980
		981	$self->SUPER::_draw;
619	}	982	}
620		983
621	#############################################################################	984	#############################################################################
622		985
623	package CFClient::UI::FancyFrame;	986	package CFClient::UI::FancyFrame;
…		…
634	my $class = shift;	997	my $class = shift;
635		998
636	# TODO: user_x, user_y, overwrite moveto?	999	# TODO: user_x, user_y, overwrite moveto?
637		1000
638	my $self = $class->SUPER::new (	1001	my $self = $class->SUPER::new (
639	bg => [1, 1, 1, 1],	1002	bg => [1, 1, 1, 1],
640	border_bg => [1, 1, 1, 1],	1003	border_bg => [1, 1, 1, 1],
641	border => 0.8,	1004	border => 0.6,
		1005	is_toplevel => 1,
		1006	can_events => 1,
642	@_	1007	@_
643	);	1008	);
644		1009
645	$self->{title} &&= new CFClient::UI::Label	1010	$self->{title} &&= new CFClient::UI::Label
646	align => 0,	1011	align => 0,
647	valign => 1,	1012	valign => 1,
648	text => $self->{title},	1013	text => $self->{title},
649	fontsize => 1;	1014	fontsize => $self->{border};
650		1015
651	$self	1016	$self
652	}	1017	}
653		1018
654	sub border {	1019	sub border {
655	int $_[0]{border} * $::FONTSIZE	1020	int $_[0]{border} * $::FONTSIZE
656	}	1021	}
657		1022
658	sub size_request {	1023	sub size_request {
659	my ($self) = @_;	1024	my ($self) = @_;
660
661	return ($self->{user_w}, $self->{user_h}) if $self->{user_w} && $self->{user_h};
662		1025
663	my ($w, $h) = $self->SUPER::size_request;	1026	my ($w, $h) = $self->SUPER::size_request;
664		1027
665	(	1028	(
666	$w + $self->border * 2,	1029	$w + $self->border * 2,
…		…
672	my ($self, $w, $h) = @_;	1035	my ($self, $w, $h) = @_;
673		1036
674	$h -= List::Util::max 0, $self->border * 2;	1037	$h -= List::Util::max 0, $self->border * 2;
675	$w -= List::Util::max 0, $self->border * 2;	1038	$w -= List::Util::max 0, $self->border * 2;
676		1039
677	$self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)	1040	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
678	if $self->{title};	1041	if $self->{title};
679		1042
680	$self->child->configure ($self->border, $self->border, $w, $h);	1043	$self->child->configure ($self->border, $self->border, $w, $h);
681	}	1044	}
682		1045
683	sub button_down {	1046	sub button_down {
684	my ($self, $ev, $x, $y) = @_;	1047	my ($self, $ev, $x, $y) = @_;
685		1048
		1049	my ($w, $h) = @$self{qw(w h)};
686	my $border = $self->border;	1050	my $border = $self->border;
687		1051
688	if ($x < $self->{w} && $x >= $self->{w} - $border	1052	my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
689	&& $y < $self->{h} && $y >= $self->{h} - $border) {	1053	my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
690		1054
		1055	if ($lr & $td) {
		1056	my ($wx, $wy) = ($self->{x}, $self->{y});
691	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1057	my ($ox, $oy) = ($ev->{x}, $ev->{y});
692	my ($bw, $bh) = ($self->{w}, $self->{h});	1058	my ($bw, $bh) = ($self->{w}, $self->{h});
693		1059
		1060	my $mx = $x < $border;
		1061	my $my = $y < $border;
		1062
694	$self->{motion} = sub {	1063	$self->{motion} = sub {
695	my ($ev, $x, $y) = @_;	1064	my ($ev, $x, $y) = @_;
696		1065
697	($x, $y) = ($ev->{x}, $ev->{y});	1066	my $dx = $ev->{x} - $ox;
		1067	my $dy = $ev->{y} - $oy;
698		1068
699	$self->{user_w} = $bw + $x - $ox;	1069	$self->{user_x} = $wx + $dx * $mx;
700	$self->{user_h} = $bh + $y - $oy;	1070	$self->{user_y} = $wy + $dy * $my;
		1071	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);
		1072	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);
		1073	$self->move ($self->{user_x}, $self->{user_y});
701	$self->check_size;	1074	$self->check_size;
702	};	1075	};
703		1076
704	} elsif ($x >= 0 && $x < $self->{w}	1077	} elsif ($lr ^ $td) {
705	&& $y >= 0 && $y < $border) {
706
707	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1078	my ($ox, $oy) = ($ev->{x}, $ev->{y});
708	my ($bx, $by) = ($self->{x}, $self->{y});	1079	my ($bx, $by) = ($self->{x}, $self->{y});
709		1080
710	$self->{motion} = sub {	1081	$self->{motion} = sub {
711	my ($ev, $x, $y) = @_;	1082	my ($ev, $x, $y) = @_;
712		1083
713	($x, $y) = ($ev->{x}, $ev->{y});	1084	($x, $y) = ($ev->{x}, $ev->{y});
714		1085
715	$self->move ($bx + $x - $ox, $by + $y - $oy);	1086	$self->{user_x} = $bx + $x - $ox;
		1087	$self->{user_y} = $by + $y - $oy;
		1088	$self->move ($self->{user_x}, $self->{user_y});
716	$self->update;	1089	$self->update;
717	};	1090	};
718	}	1091	}
719	}	1092	}
720		1093
…		…
734	my ($self) = @_;	1107	my ($self) = @_;
735		1108
736	my ($w, $h ) = ($self->{w}, $self->{h});	1109	my ($w, $h ) = ($self->{w}, $self->{h});
737	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1110	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
738		1111
739	glEnable GL_BLEND;
740	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
741	glEnable GL_TEXTURE_2D;	1112	glEnable GL_TEXTURE_2D;
742	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1113	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
743		1114
744	my $border = $self->border;	1115	my $border = $self->border;
745		1116
746	glColor @{ $self->{border_bg} };	1117	glColor @{ $self->{border_bg} };
747	$tex[1]->draw_quad (0, 0, $w, $border);	1118	$tex[1]->draw_quad_alpha (0, 0, $w, $border);
748	$tex[3]->draw_quad (0, $border, $border, $ch);	1119	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);
749	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	1120	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
750	$tex[4]->draw_quad (0, $h - $border, $w, $border);	1121	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);
751		1122
		1123	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
752	my $bg = $tex[0];	1124	my $bg = $tex[0];
753		1125
754	# TODO: repeat texture not scale	1126	# TODO: repeat texture not scale
755	my $rep_x = $cw / $bg->{w};	1127	my $rep_x = $cw / $bg->{w};
756	my $rep_y = $ch / $bg->{h};	1128	my $rep_y = $ch / $bg->{h};
757		1129
758	glColor @{ $self->{bg} };	1130	glColor @{ $self->{bg} };
759		1131
760	$bg->{s} = $rep_x;	1132	$bg->{s} = $rep_x;
761	$bg->{t} = $rep_y;	1133	$bg->{t} = $rep_y;
762	$bg->{wrap_mode} = 1;	1134	$bg->{wrap_mode} = 1;
763	$bg->draw_quad ($border, $border, $cw, $ch);	1135	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
		1136	}
764		1137
765	glDisable GL_TEXTURE_2D;	1138	glDisable GL_TEXTURE_2D;
766	glDisable GL_BLEND;
767		1139
768	$self->{title}->draw if $self->{title};	1140	$self->{title}->draw if $self->{title};
		1141
769	$self->child->draw;	1142	$self->child->draw;
770	}	1143	}
771		1144
772	#############################################################################	1145	#############################################################################
773		1146
…		…
782	sub new {	1155	sub new {
783	my $class = shift;	1156	my $class = shift;
784		1157
785	$class->SUPER::new (	1158	$class->SUPER::new (
786	col_expand => [],	1159	col_expand => [],
787	@_	1160	@_,
788	)	1161	)
		1162	}
		1163
		1164	sub children {
		1165	grep $_, map @$_, grep $_, @{ $_[0]{children} }
789	}	1166	}
790		1167
791	sub add {	1168	sub add {
792	my ($self, $x, $y, $child) = @_;	1169	my ($self, $x, $y, $child) = @_;
793		1170
794	$child->set_parent ($self);	1171	$child->set_parent ($self);
795	$self->{children}[$y][$x] = $child;	1172	$self->{children}[$y][$x] = $child;
796		1173
797	$child->check_size;	1174	$self->check_size (1);
798	}	1175	}
799		1176
800	# TODO: move to container class maybe? send childs a signal on removal?	1177	# TODO: move to container class maybe? send children a signal on removal?
801	sub clear {	1178	sub clear {
802	my ($self) = @_;	1179	my ($self) = @_;
803		1180
		1181	my @children = $self->children;
804	delete $self->{children};	1182	delete $self->{children};
		1183
		1184	for (@children) {
		1185	delete $_->{parent};
		1186	$_->hide;
		1187	}
		1188
		1189	$self->check_size (1);
805	$self->update;	1190	$self->update;
806	}	1191	}
807		1192
808	sub get_wh {	1193	sub get_wh {
809	my ($self) = @_;	1194	my ($self) = @_;
…		…
815	or next;	1200	or next;
816		1201
817	for my $x (0 .. $#$row) {	1202	for my $x (0 .. $#$row) {
818	my $widget = $row->[$x]	1203	my $widget = $row->[$x]
819	or next;	1204	or next;
820	my ($w, $h) = $widget->size_request;	1205	my ($w, $h) = @$widget{qw(req_w req_h)};
821		1206
822	$w[$x] = max $w[$x], $w;	1207	$w[$x] = max $w[$x], $w;
823	$h[$y] = max $h[$y], $h;	1208	$h[$y] = max $h[$y], $h;
824	}	1209	}
825	}	1210	}
…		…
841	sub size_allocate {	1226	sub size_allocate {
842	my ($self, $w, $h) = @_;	1227	my ($self, $w, $h) = @_;
843		1228
844	my ($ws, $hs) = $self->get_wh;	1229	my ($ws, $hs) = $self->get_wh;
845		1230
846	my $req_w = sum @$ws;	1231	my $req_w = (sum @$ws) || 1;
847	my $req_h = sum @$hs;	1232	my $req_h = (sum @$hs) || 1;
848		1233
849	# TODO: nicer code && do row_expand	1234	# TODO: nicer code && do row_expand
850	my @col_expand = @{$self->{col_expand}};	1235	my @col_expand = @{$self->{col_expand}};
851	@col_expand = (1) x @$ws unless @col_expand;	1236	@col_expand = (1) x @$ws unless @col_expand;
852	my $col_expand = (sum @col_expand) || 1;	1237	my $col_expand = (sum @col_expand) || 1;
…		…
930		1315
931	($h, $w) = ($w, $h);	1316	($h, $w) = ($w, $h);
932		1317
933	my $children = $self->{children};	1318	my $children = $self->{children};
934		1319
935	my @h = map +($_->size_request)[0], @$children;	1320	my @h = map $_->{req_w}, @$children;
936		1321
937	my $req_h = List::Util::sum @h;	1322	my $req_h = List::Util::sum @h;
938		1323
939	if ($req_h > $h) {	1324	if ($req_h > $h) {
940	# ah well, not enough space	1325	# ah well, not enough space
…		…
986	}	1371	}
987		1372
988	sub size_allocate {	1373	sub size_allocate {
989	my ($self, $w, $h) = @_;	1374	my ($self, $w, $h) = @_;
990		1375
		1376	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
		1377
991	my $children = $self->{children};	1378	my $children = $self->{children};
992		1379
993	my @h = map +($_->size_request)[1], @$children;	1380	my @h = map $_->{req_h}, @$children;
994		1381
995	my $req_h = List::Util::sum @h;	1382	my $req_h = List::Util::sum @h;
996		1383
997	if ($req_h > $h) {	1384	if ($req_h > $h) {
998	# ah well, not enough space	1385	# ah well, not enough space
…		…
1024		1411
1025	#############################################################################	1412	#############################################################################
1026		1413
1027	package CFClient::UI::Label;	1414	package CFClient::UI::Label;
1028		1415
1029	our @ISA = CFClient::UI::Base::;	1416	our @ISA = CFClient::UI::DrawBG::;
1030		1417
1031	use CFClient::OpenGL;	1418	use CFClient::OpenGL;
1032		1419
1033	sub new {	1420	sub new {
1034	my ($class, %arg) = @_;	1421	my ($class, %arg) = @_;
1035		1422
1036	my $self = $class->SUPER::new (	1423	my $self = $class->SUPER::new (
1037	fg => [1, 1, 1],	1424	fg => [1, 1, 1],
		1425	#bg => none
		1426	#active_bg => none
		1427	#font => default_font
		1428	#text => initial text
		1429	#markup => initial narkup
		1430	#max_w => maximum pixel width
		1431	ellipsise => 3, # end
		1432	layout => (new CFClient::Layout),
1038	fontsize => 1,	1433	fontsize => 1,
1039	text => "",
1040	align => -1,	1434	align => -1,
1041	valign => -1,	1435	valign => -1,
1042	padding => 2,	1436	padding => 2,
1043	layout => new CFClient::Layout,	1437	can_events => 0,
1044	%arg	1438	%arg
1045	);	1439	);
1046		1440
1047	if (exists $self->{template}) {	1441	if (exists $self->{template}) {
1048	my $layout = new CFClient::Layout;	1442	my $layout = new CFClient::Layout;
1049	$layout->set_text (delete $self->{template});	1443	$layout->set_text (delete $self->{template});
1050	$self->{template} = $layout;	1444	$self->{template} = $layout;
1051	}	1445	}
1052		1446
1053	$self->set_text (delete $self->{text}) if exists $self->{text};	1447	if (exists $self->{markup}) {
1054	$self->set_markup (delete $self->{markup}) if exists $self->{markup};	1448	$self->set_markup (delete $self->{markup});
		1449	} else {
		1450	$self->set_text (delete $self->{text});
		1451	}
1055		1452
1056	$self	1453	$self
1057	}	1454	}
1058		1455
1059	sub escape_text {	1456	sub escape($) {
1060	local $_ = $_[1];	1457	local $_ = $_[0];
1061		1458
1062	s/&/&amp;/g;	1459	s/&/&amp;/g;
1063	s/>/&gt;/g;	1460	s/>/&gt;/g;
1064	s/</&lt;/g;	1461	s/</&lt;/g;
1065		1462
1066	$_[1]	1463	$_
		1464	}
		1465
		1466	sub update {
		1467	my ($self) = @_;
		1468
		1469	delete $self->{texture};
		1470	$self->SUPER::update;
1067	}	1471	}
1068		1472
1069	sub set_text {	1473	sub set_text {
1070	my ($self, $text) = @_;	1474	my ($self, $text) = @_;
1071		1475
		1476	return if $self->{text} eq "T$text";
		1477	$self->{text} = "T$text";
		1478
		1479	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1072	$self->{layout}->set_text ($text);	1480	$self->{layout}->set_text ($text);
1073		1481
1074	delete $self->{texture};
1075	$self->update;	1482	$self->update;
		1483	$self->check_size;
1076	}	1484	}
1077		1485
1078	sub set_markup {	1486	sub set_markup {
1079	my ($self, $markup) = @_;	1487	my ($self, $markup) = @_;
1080		1488
		1489	return if $self->{text} eq "M$markup";
		1490	$self->{text} = "M$markup";
		1491
		1492	my $rgba = $markup =~ /span.*(?:foreground|background)/;
		1493
		1494	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1081	$self->{layout}->set_markup ($markup);	1495	$self->{layout}->set_markup ($markup);
1082		1496
1083	delete $self->{texture};
1084	$self->update;	1497	$self->update;
		1498	$self->check_size;
1085	}	1499	}
1086		1500
1087	sub size_request {	1501	sub size_request {
1088	my ($self) = @_;	1502	my ($self) = @_;
1089		1503
1090	$self->{layout}->set_width;	1504	$self->{layout}->set_font ($self->{font}) if $self->{font};
		1505	$self->{layout}->set_width ($self->{max_w} || -1);
		1506	$self->{layout}->set_ellipsise ($self->{ellipsise});
		1507	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1091	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1508	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1092		1509
1093	my ($w, $h) = $self->{layout}->size;	1510	my ($w, $h) = $self->{layout}->size;
1094		1511
1095	if (exists $self->{template}) {	1512	if (exists $self->{template}) {
		1513	$self->{template}->set_font ($self->{font}) if $self->{font};
1096	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1514	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1097		1515
1098	my ($w2, $h2) = $self->{template}->size;	1516	my ($w2, $h2) = $self->{template}->size;
1099		1517
1100	$w = List::Util::max $w, $w2;	1518	$w = List::Util::max $w, $w2;
…		…
1115		1533
1116	sub set_fontsize {	1534	sub set_fontsize {
1117	my ($self, $fontsize) = @_;	1535	my ($self, $fontsize) = @_;
1118		1536
1119	$self->{fontsize} = $fontsize;	1537	$self->{fontsize} = $fontsize;
		1538	delete $self->{texture};
		1539
1120	$self->update;	1540	$self->update;
		1541	$self->check_size;
1121	}	1542	}
1122		1543
1123	sub _draw {	1544	sub _draw {
1124	my ($self) = @_;	1545	my ($self) = @_;
1125		1546
		1547	$self->SUPER::_draw; # draw background, if applicable
		1548
1126	my $tex = $self->{texture} ||= do {	1549	my $tex = $self->{texture} ||= do {
		1550	$self->{layout}->set_foreground (@{$self->{fg}});
		1551	$self->{layout}->set_font ($self->{font}) if $self->{font};
1127	$self->{layout}->set_width ($self->{w});	1552	$self->{layout}->set_width ($self->{w});
		1553	$self->{layout}->set_ellipsise ($self->{ellipsise});
		1554	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1128	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);	1555	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
		1556
1129	new_from_layout CFClient::Texture $self->{layout}	1557	my $tex = new_from_layout CFClient::Texture $self->{layout};
		1558
		1559	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}
		1560	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
		1561	: ($self->{w} - $tex->{w}) * 0.5);
		1562
		1563	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}
		1564	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
		1565	: ($self->{h} - $tex->{h}) * 0.5);
		1566
		1567	$tex
1130	};	1568	};
1131		1569
1132	glEnable GL_BLEND;
1133	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1134	glEnable GL_TEXTURE_2D;	1570	glEnable GL_TEXTURE_2D;
1135	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1571	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1136		1572
		1573	if ($tex->{format} == GL_ALPHA) {
1137	glColor @{$self->{fg}};	1574	glColor @{$self->{fg}};
1138
1139	$self->{ox} = int (
1140	$self->{align} < 0 ? $self->{padding}
1141	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1142	: ($self->{w} - $tex->{w}) * 0.5
1143	);
1144
1145	$self->{oy} = int (
1146	$self->{valign} < 0 ? $self->{padding}
1147	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1148	: ($self->{h} - $tex->{h}) * 0.5
1149	);
1150
1151	$tex->draw_quad ($self->{ox}, $self->{oy});	1575	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
		1576	} else {
		1577	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
		1578	}
1152		1579
1153	glDisable GL_TEXTURE_2D;	1580	glDisable GL_TEXTURE_2D;
1154	glDisable GL_BLEND;
1155	}	1581	}
1156		1582
1157	#############################################################################	1583	#############################################################################
1158		1584
1159	package CFClient::UI::EntryBase;	1585	package CFClient::UI::EntryBase;
…		…
1164		1590
1165	sub new {	1591	sub new {
1166	my $class = shift;	1592	my $class = shift;
1167		1593
1168	$class->SUPER::new (	1594	$class->SUPER::new (
1169	fg => [1, 1, 1],	1595	fg => [1, 1, 1],
1170	bg => [0, 0, 0, 0.2],	1596	bg => [0, 0, 0, 0.2],
1171	active_bg => [1, 1, 1, 0.5],	1597	active_bg => [1, 1, 1, 0.5],
1172	active_fg => [0, 0, 0],	1598	active_fg => [0, 0, 0],
1173	can_hover => 1,	1599	can_hover => 1,
1174	can_focus => 1,	1600	can_focus => 1,
1175	valign => 0,	1601	valign => 0,
		1602	can_events => 1,
		1603	#text => ...
1176	@_	1604	@_
1177	)	1605	)
1178	}	1606	}
1179		1607
1180	sub _set_text {	1608	sub _set_text {
…		…
1190	$self->{text} = $text;	1618	$self->{text} = $text;
1191		1619
1192	$text =~ s/./*/g if $self->{hidden};	1620	$text =~ s/./*/g if $self->{hidden};
1193	$self->{layout}->set_text ("$text ");	1621	$self->{layout}->set_text ("$text ");
1194		1622
1195	$self->emit (changed => $self->{text});	1623	$self->_emit (changed => $self->{text});
1196	}
1197
1198	sub get_text {
1199	$_[0]{text}
1200	}
1201
1202	sub size_request {
1203	my ($self) = @_;
1204
1205	my ($w, $h) = $self->SUPER::size_request;
1206
1207	($w + 1, $h) # add 1 for cursor
1208	}
1209
1210	sub size_allocate {
1211	my ($self, $w, $h) = @_;
1212
1213	$self->_set_text ($self->{text});
1214	}	1624	}
1215		1625
1216	sub set_text {	1626	sub set_text {
1217	my ($self, $text) = @_;	1627	my ($self, $text) = @_;
1218		1628
1219	$self->{cursor} = length $text;	1629	$self->{cursor} = length $text;
1220	$self->_set_text ($text);	1630	$self->_set_text ($text);
1221	$self->update;	1631	$self->update;
		1632	$self->check_size;
		1633	}
		1634
		1635	sub get_text {
		1636	$_[0]{text}
		1637	}
		1638
		1639	sub size_request {
		1640	my ($self) = @_;
		1641
		1642	my ($w, $h) = $self->SUPER::size_request;
		1643
		1644	($w + 1, $h) # add 1 for cursor
1222	}	1645	}
1223		1646
1224	sub key_down {	1647	sub key_down {
1225	my ($self, $ev) = @_;	1648	my ($self, $ev) = @_;
1226		1649
…		…
1228	my $sym = $ev->{sym};	1651	my $sym = $ev->{sym};
1229	my $uni = $ev->{unicode};	1652	my $uni = $ev->{unicode};
1230		1653
1231	my $text = $self->get_text;	1654	my $text = $self->get_text;
1232		1655
1233	if ($sym == 8) {	1656	if ($uni == 8) {
1234	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1657	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1235	} elsif ($sym == 127) {	1658	} elsif ($uni == 127) {
1236	substr $text, $self->{cursor}, 1, "";	1659	substr $text, $self->{cursor}, 1, "";
1237	} elsif ($sym == CFClient::SDLK_LEFT) {	1660	} elsif ($sym == CFClient::SDLK_LEFT) {
1238	--$self->{cursor} if $self->{cursor};	1661	--$self->{cursor} if $self->{cursor};
1239	} elsif ($sym == CFClient::SDLK_RIGHT) {	1662	} elsif ($sym == CFClient::SDLK_RIGHT) {
1240	++$self->{cursor} if $self->{cursor} < length $self->{text};	1663	++$self->{cursor} if $self->{cursor} < length $self->{text};
1241	} elsif ($sym == CFClient::SDLK_HOME) {	1664	} elsif ($sym == CFClient::SDLK_HOME) {
1242	$self->{cursor} = 0;	1665	$self->{cursor} = 0;
1243	} elsif ($sym == CFClient::SDLK_END) {	1666	} elsif ($sym == CFClient::SDLK_END) {
1244	$self->{cursor} = length $text;	1667	$self->{cursor} = length $text;
1245	} elsif ($sym == 27) {	1668	} elsif ($uni == 27) {
1246	$self->emit ('escape');	1669	$self->_emit ('escape');
1247	} elsif ($uni) {	1670	} elsif ($uni) {
1248	substr $text, $self->{cursor}++, 0, chr $uni;	1671	substr $text, $self->{cursor}++, 0, chr $uni;
1249	}	1672	}
1250		1673
1251	$self->_set_text ($text);	1674	$self->_set_text ($text);
1252	$self->update;	1675	$self->update;
		1676	$self->check_size;
1253	}	1677	}
1254		1678
1255	sub focus_in {	1679	sub focus_in {
1256	my ($self) = @_;	1680	my ($self) = @_;
1257		1681
…		…
1333	my ($self, $ev) = @_;	1757	my ($self, $ev) = @_;
1334		1758
1335	my $sym = $ev->{sym};	1759	my $sym = $ev->{sym};
1336		1760
1337	if ($sym == 13) {	1761	if ($sym == 13) {
		1762	unshift @{$self->{history}},
		1763	my $txt = $self->get_text;
		1764	$self->{history_pointer} = -1;
		1765	$self->{history_saveback} = '';
1338	$self->emit (activate => $self->get_text);	1766	$self->_emit (activate => $txt);
1339	$self->update;	1767	$self->update;
		1768
		1769	} elsif ($sym == CFClient::SDLK_UP) {
		1770	if ($self->{history_pointer} < 0) {
		1771	$self->{history_saveback} = $self->get_text;
		1772	}
		1773	if (@{$self->{history} || []} > 0) {
		1774	$self->{history_pointer}++;
		1775	if ($self->{history_pointer} >= @{$self->{history} || []}) {
		1776	$self->{history_pointer} = @{$self->{history} || []} - 1;
		1777	}
		1778	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1779	}
		1780
		1781	} elsif ($sym == CFClient::SDLK_DOWN) {
		1782	$self->{history_pointer}--;
		1783	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
		1784
		1785	if ($self->{history_pointer} >= 0) {
		1786	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1787	} else {
		1788	$self->set_text ($self->{history_saveback});
		1789	}
1340		1790
1341	} else {	1791	} else {
1342	$self->SUPER::key_down ($ev);	1792	$self->SUPER::key_down ($ev);
1343	}	1793	}
1344		1794
…		…
1358		1808
1359	sub new {	1809	sub new {
1360	my $class = shift;	1810	my $class = shift;
1361		1811
1362	$class->SUPER::new (	1812	$class->SUPER::new (
1363	padding => 4,	1813	padding => 4,
1364	fg => [1, 1, 1],	1814	fg => [1, 1, 1],
1365	bg => [1, 1, 1, 0.2],
1366	active_fg => [0, 0, 1],	1815	active_fg => [0, 0, 1],
1367	can_hover => 1,	1816	can_hover => 1,
1368	align => 0,	1817	align => 0,
1369	valign => 0,	1818	valign => 0,
		1819	can_events => 1,
1370	@_	1820	@_
1371	)	1821	)
1372	}	1822	}
1373		1823
		1824	sub activate { }
		1825
1374	sub button_up {	1826	sub button_up {
1375	my ($self, $ev, $x, $y) = @_;	1827	my ($self, $ev, $x, $y) = @_;
1376		1828
		1829	$self->emit ("activate")
1377	if ($x >= 0 && $x < $self->{w}	1830	if $x >= 0 && $x < $self->{w}
1378	&& $y >= 0 && $y < $self->{h}) {	1831	&& $y >= 0 && $y < $self->{h};
1379	$self->emit ("activate");
1380	}
1381	}	1832	}
1382		1833
1383	sub _draw {	1834	sub _draw {
1384	my ($self) = @_;	1835	my ($self) = @_;
1385		1836
…		…
1387		1838
1388	if ($GRAB == $self) {	1839	if ($GRAB == $self) {
1389	$self->{fg} = $self->{active_fg};	1840	$self->{fg} = $self->{active_fg};
1390	}	1841	}
1391		1842
1392	glEnable GL_BLEND;
1393	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1394	glEnable GL_TEXTURE_2D;	1843	glEnable GL_TEXTURE_2D;
1395	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1844	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1396	glColor 0, 0, 0, 1;	1845	glColor 0, 0, 0, 1;
1397		1846
1398	$tex[0]->draw_quad (0, 0, $self->{w}, $self->{h});	1847	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1399		1848
1400	glDisable GL_TEXTURE_2D;	1849	glDisable GL_TEXTURE_2D;
1401	glDisable GL_BLEND;
1402		1850
1403	$self->SUPER::_draw;	1851	$self->SUPER::_draw;
1404	}	1852	}
1405		1853
1406	#############################################################################	1854	#############################################################################
…		…
1420		1868
1421	$class->SUPER::new (	1869	$class->SUPER::new (
1422	padding => 2,	1870	padding => 2,
1423	fg => [1, 1, 1],	1871	fg => [1, 1, 1],
1424	active_fg => [1, 1, 0],	1872	active_fg => [1, 1, 0],
		1873	bg => [0, 0, 0, 0.2],
		1874	active_bg => [1, 1, 1, 0.5],
1425	state => 0,	1875	state => 0,
1426	can_hover => 1,	1876	can_hover => 1,
1427	@_	1877	@_
1428	)	1878	)
1429	}	1879	}
…		…
1438	my ($self, $ev, $x, $y) = @_;	1888	my ($self, $ev, $x, $y) = @_;
1439		1889
1440	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1890	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}
1441	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1891	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {
1442	$self->{state} = !$self->{state};	1892	$self->{state} = !$self->{state};
1443	$self->emit (changed => $self->{state});	1893	$self->_emit (changed => $self->{state});
1444	}	1894	}
1445	}	1895	}
1446		1896
1447	sub _draw {	1897	sub _draw {
1448	my ($self) = @_;	1898	my ($self) = @_;
…		…
1453		1903
1454	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1904	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;
1455		1905
1456	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1906	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1457		1907
1458	glEnable GL_BLEND;	1908	my $tex = $self->{state} ? $tex[1] : $tex[0];
		1909
1459	glEnable GL_TEXTURE_2D;	1910	glEnable GL_TEXTURE_2D;
1460	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1461
1462	my $tex = $self->{state} ? $tex[1] : $tex[0];
1463
1464	$tex->draw_quad (0, 0, $s, $s);	1911	$tex->draw_quad_alpha (0, 0, $s, $s);
1465
1466	glDisable GL_TEXTURE_2D;	1912	glDisable GL_TEXTURE_2D;
1467	glDisable GL_BLEND;
1468	}	1913	}
1469		1914
1470	#############################################################################	1915	#############################################################################
1471		1916
1472	package CFClient::UI::Image;	1917	package CFClient::UI::Image;
…		…
1479	our %loaded_images;	1924	our %loaded_images;
1480		1925
1481	sub new {	1926	sub new {
1482	my $class = shift;	1927	my $class = shift;
1483		1928
1484	my $self = $class->SUPER::new (@_);	1929	my $self = $class->SUPER::new (can_events => 0, @_);
1485		1930
1486	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	1931	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";
1487		1932
1488	$loaded_images{$self->{image}} ||=	1933	$loaded_images{$self->{image}} ||=
1489	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	1934	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;
1490		1935
1491	my $tex = $self->{tex} = $loaded_images{$self->{image}};	1936	my $tex = $self->{tex} = $loaded_images{$self->{image}};
		1937
		1938	Scalar::Util::weaken $loaded_images{$self->{image}};
1492		1939
1493	$self->{aspect} = $tex->{w} / $tex->{h};	1940	$self->{aspect} = $tex->{w} / $tex->{h};
1494		1941
1495	$self	1942	$self
1496	}	1943	}
…		…
1513	glTranslate 0, -$self->{w}, 0;	1960	glTranslate 0, -$self->{w}, 0;
1514		1961
1515	($w, $h) = ($h, $w);	1962	($w, $h) = ($h, $w);
1516	}	1963	}
1517		1964
1518	glEnable GL_BLEND;
1519	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1520	glEnable GL_TEXTURE_2D;	1965	glEnable GL_TEXTURE_2D;
1521	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1966	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1522		1967
1523	$tex->draw_quad (0, 0, $w, $h);	1968	$tex->draw_quad_alpha (0, 0, $w, $h);
1524		1969
1525	glDisable GL_BLEND;
1526	glDisable GL_TEXTURE_2D;	1970	glDisable GL_TEXTURE_2D;
1527	}	1971	}
1528		1972
1529	#############################################################################	1973	#############################################################################
1530		1974
1531	package CFClient::UI::VGauge;	1975	package CFClient::UI::VGauge;
1532		1976
1533	our @ISA = CFClient::UI::Base::;	1977	our @ISA = CFClient::UI::Base::;
		1978
		1979	use List::Util qw(min max);
1534		1980
1535	use CFClient::OpenGL;	1981	use CFClient::OpenGL;
1536		1982
1537	my %tex = (	1983	my %tex = (
1538	food => [	1984	food => [
1539	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1985	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1540	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	1986	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
1541	],	1987	],
1542	grace => [	1988	grace => [
1543	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1989	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1544	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png/	1990	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
1545	],	1991	],
1546	hp => [	1992	hp => [
1547	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1993	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1548	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	1994	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
1549	],	1995	],
1550	mana => [	1996	mana => [
1551	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1997	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1552	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png/	1998	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
1553	],	1999	],
1554	);	2000	);
1555		2001
1556	# eg. VGauge->new (gauge => 'food'), default gauge: food	2002	# eg. VGauge->new (gauge => 'food'), default gauge: food
1557	sub new {	2003	sub new {
…		…
1576	}	2022	}
1577		2023
1578	sub set_max {	2024	sub set_max {
1579	my ($self, $max) = @_;	2025	my ($self, $max) = @_;
1580		2026
		2027	return if $self->{max_val} == $max;
		2028
1581	$self->{max_val} = $max;	2029	$self->{max_val} = $max;
		2030	$self->update;
1582	}	2031	}
1583		2032
1584	sub set_value {	2033	sub set_value {
1585	my ($self, $val, $max) = @_;	2034	my ($self, $val, $max) = @_;
1586		2035
1587	$self->set_max ($max)	2036	$self->set_max ($max)
1588	if defined $max;	2037	if defined $max;
1589		2038
1590	$max = $self->{max_val};	2039	return if $self->{val} == $val;
		2040
1591	$self->{val} = $val;	2041	$self->{val} = $val;
1592
1593	$self->update;	2042	$self->update;
1594	}	2043	}
1595		2044
1596	sub _draw {	2045	sub _draw {
1597	my ($self) = @_;	2046	my ($self) = @_;
1598		2047
1599	my $tex = $tex{$self->{type}};	2048	my $tex = $tex{$self->{type}};
		2049	my ($t1, $t2, $t3) = @$tex;
1600		2050
1601	my ($w, $h) = ($self->{w}, $self->{h});	2051	my ($w, $h) = ($self->{w}, $self->{h});
1602		2052
1603	if ($self->{vertical}) {	2053	if ($self->{vertical}) {
1604	glRotate 90, 0, 0, 1;	2054	glRotate 90, 0, 0, 1;
…		…
1606		2056
1607	($w, $h) = ($h, $w);	2057	($w, $h) = ($h, $w);
1608	}	2058	}
1609		2059
1610	my $ycut = $self->{val} / ($self->{max_val} || 1);	2060	my $ycut = $self->{val} / ($self->{max_val} || 1);
1611	$ycut = 1 if $self->{val} > $self->{max_val};
1612		2061
1613	my $t1 = $tex->[0];	2062	my $ycut1 = max 0, min 1, $ycut;
1614	my $t2 = $tex->[1];	2063	my $ycut2 = max 0, min 1, $ycut - 1;
		2064
		2065	my $h1 = $self->{h} * (1 - $ycut1);
		2066	my $h2 = $self->{h} * (1 - $ycut2);
1615		2067
1616	glEnable GL_BLEND;	2068	glEnable GL_BLEND;
1617	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2069	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1618	glEnable GL_TEXTURE_2D;	2070	glEnable GL_TEXTURE_2D;
1619	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2071	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1620		2072
1621	my $h1 = $self->{h} - $ycut * $self->{h};
1622	my $h2 = $ycut * $self->{h};
1623
1624	glBindTexture GL_TEXTURE_2D, $t1->{name};	2073	glBindTexture GL_TEXTURE_2D, $t1->{name};
1625	glBegin GL_QUADS;	2074	glBegin GL_QUADS;
1626	glTexCoord 0 , 0; glVertex 0 , 0;	2075	glTexCoord 0 , 0; glVertex 0 , 0;
1627	glTexCoord 0 , $t1->{t} * (1 - $ycut); glVertex 0 , $h1;	2076	glTexCoord 0 , $t1->{t} * (1 - $ycut1); glVertex 0 , $h1;
1628	glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut); glVertex $w, $h1;	2077	glTexCoord $t1->{s}, $t1->{t} * (1 - $ycut1); glVertex $w, $h1;
1629	glTexCoord $t1->{s}, 0; glVertex $w, 0;	2078	glTexCoord $t1->{s}, 0; glVertex $w, 0;
1630	glEnd;	2079	glEnd;
1631		2080
		2081	my $ycut1 = List::Util::min 1, $ycut;
1632	glBindTexture GL_TEXTURE_2D, $t2->{name};	2082	glBindTexture GL_TEXTURE_2D, $t2->{name};
1633	glBegin GL_QUADS;	2083	glBegin GL_QUADS;
1634	glTexCoord 0 , $t2->{t} * (1 - $ycut); glVertex 0 , $h1;	2084	glTexCoord 0 , $t2->{t} * (1 - $ycut1); glVertex 0 , $h1;
1635	glTexCoord 0 , $t2->{t}; glVertex 0 , $h1 + $h2;	2085	glTexCoord 0 , $t2->{t} * (1 - $ycut2); glVertex 0 , $h2;
1636	glTexCoord $t2->{s}, $t2->{t}; glVertex $w, $h1 + $h2;	2086	glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut2); glVertex $w, $h2;
1637	glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut); glVertex $w, $h1;	2087	glTexCoord $t2->{s}, $t2->{t} * (1 - $ycut1); glVertex $w, $h1;
1638	glEnd;	2088	glEnd;
		2089
		2090	if ($t3) {
		2091	glBindTexture GL_TEXTURE_2D, $t3->{name};
		2092	glBegin GL_QUADS;
		2093	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
		2094	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};
		2095	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};
		2096	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
		2097	glEnd;
		2098	}
1639		2099
1640	glDisable GL_BLEND;	2100	glDisable GL_BLEND;
1641	glDisable GL_TEXTURE_2D;	2101	glDisable GL_TEXTURE_2D;
1642	}	2102	}
1643		2103
…		…
1646	package CFClient::UI::Gauge;	2106	package CFClient::UI::Gauge;
1647		2107
1648	our @ISA = CFClient::UI::VBox::;	2108	our @ISA = CFClient::UI::VBox::;
1649		2109
1650	sub new {	2110	sub new {
1651	my ($class, %arg) = shift;	2111	my ($class, %arg) = @_;
1652		2112
1653	my $self = $class->SUPER::new (	2113	my $self = $class->SUPER::new (
1654	@_,	2114	tooltip => $arg{type},
		2115	can_hover => 1,
		2116	can_events => 1,
		2117	%arg,
1655	);	2118	);
1656		2119
1657	$self->add ($self->{value} = new CFClient::UI::Label valign => 1, align => 0, template => "999");	2120	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1658	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1);	2121	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
1659	$self->add ($self->{max} = new CFClient::UI::Label valign => 1, align => 0, template => "999");	2122	$self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");
1660		2123
1661	$self	2124	$self
1662	}	2125	}
1663		2126
1664	sub set_fontsize {	2127	sub set_fontsize {
1665	my ($self, $fsize) = @_;	2128	my ($self, $fsize) = @_;
1666		2129
1667	$self->{value}->set_fontsize ($fsize);	2130	$self->{value}->set_fontsize ($fsize);
1668	$self->{max} ->set_fontsize ($fsize);	2131	$self->{max} ->set_fontsize ($fsize);
1669	$self->update;	2132	}
		2133
		2134	sub set_max {
		2135	my ($self, $max) = @_;
		2136
		2137	$self->{gauge}->set_max ($max);
		2138	$self->{max}->set_text ($max);
1670	}	2139	}
1671		2140
1672	sub set_value {	2141	sub set_value {
1673	my ($self, $val, $max) = @_;	2142	my ($self, $val, $max) = @_;
1674		2143
1675	$self->set_max ($max)	2144	$self->set_max ($max)
1676	if defined $max;	2145	if defined $max;
1677		2146
1678	$self->{gauge}->set_value ($val, $max);	2147	$self->{gauge}->set_value ($val, $max);
1679	$self->{value}->set_text ($val);	2148	$self->{value}->set_text ($val);
1680	}
1681
1682	sub set_max {
1683	my ($self, $max) = @_;
1684
1685	$self->{gauge}->set_max ($max);
1686	$self->{max}->set_text ($max);
1687	}	2149	}
1688		2150
1689	#############################################################################	2151	#############################################################################
1690		2152
1691	package CFClient::UI::Slider;	2153	package CFClient::UI::Slider;
…		…
1701	qw(s1_slider.png s1_slider_bg.png);	2163	qw(s1_slider.png s1_slider_bg.png);
1702		2164
1703	sub new {	2165	sub new {
1704	my $class = shift;	2166	my $class = shift;
1705		2167
1706	# range [value, low, high, page]	2168	# range [value, low, high, page, unit]
1707		2169
1708	# TODO: 0-width page	2170	# TODO: 0-width page
1709	# TODO: req_w/h are wrong with vertical	2171	# TODO: req_w/h are wrong with vertical
1710	# TODO: calculations are off	2172	# TODO: calculations are off
1711	my $self = $class->SUPER::new (	2173	my $self = $class->SUPER::new (
1712	fg => [1, 1, 1],	2174	fg => [1, 1, 1],
1713	active_fg => [0, 0, 0],	2175	active_fg => [0, 0, 0],
		2176	bg => [0, 0, 0, 0.2],
		2177	active_bg => [1, 1, 1, 0.5],
1714	range => [0, 0, 100, 10],	2178	range => [0, 0, 100, 10, 0],
1715	req_w => 20,	2179	req_w => $::WIDTH / 80,
1716	req_h => 20,	2180	req_h => $::WIDTH / 80,
1717	vertical => 0,	2181	vertical => 0,
1718	can_hover => 1,	2182	can_hover => 1,
1719	inner_pad => 5,	2183	inner_pad => 0.02,
1720	@_	2184	@_
1721	);	2185	);
1722		2186
		2187	$self->set_value ($self->{range}[0]);
		2188	$self->update;
		2189
1723	$self	2190	$self
		2191	}
		2192
		2193	sub set_range {
		2194	my ($self, $range) = @_;
		2195
		2196	($range, $self->{range}) = ($self->{range}, $range);
		2197
		2198	$self->update
		2199	if "@$range" ne "@{$self->{range}}";
		2200	}
		2201
		2202	sub set_value {
		2203	my ($self, $value) = @_;
		2204
		2205	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
		2206
		2207	$hi = $lo + 1 if $hi <= $lo;
		2208
		2209	$page = $hi - $lo if $page > $hi - $lo;
		2210
		2211	$value = $lo if $value < $lo;
		2212	$value = $hi - $page if $value > $hi - $page;
		2213
		2214	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
		2215	if $unit;
		2216
		2217	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
		2218
		2219	if ($value != $old_value) {
		2220	$self->_emit (changed => $value);
		2221	$self->update;
		2222	}
1724	}	2223	}
1725		2224
1726	sub size_request {	2225	sub size_request {
1727	my ($self) = @_;	2226	my ($self) = @_;
1728		2227
…		…
1734		2233
1735	sub button_down {	2234	sub button_down {
1736	my ($self, $ev, $x, $y) = @_;	2235	my ($self, $ev, $x, $y) = @_;
1737		2236
1738	$self->SUPER::button_down ($ev, $x, $y);	2237	$self->SUPER::button_down ($ev, $x, $y);
		2238
		2239	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
		2240
1739	$self->mouse_motion ($ev, $x, $y);	2241	$self->mouse_motion ($ev, $x, $y);
1740	}	2242	}
1741		2243
1742	sub mouse_motion {	2244	sub mouse_motion {
1743	my ($self, $ev, $x, $y) = @_;	2245	my ($self, $ev, $x, $y) = @_;
1744		2246
1745	if ($GRAB == $self) {	2247	if ($GRAB == $self) {
		2248	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
		2249
		2250	my (undef, $lo, $hi, $page) = @{$self->{range}};
		2251
		2252	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
		2253
		2254	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2255	}
		2256	}
		2257
		2258	sub update {
		2259	my ($self) = @_;
		2260
		2261	$CFClient::UI::ROOT->on_post_alloc ($self => sub {
		2262	$self->set_value ($self->{range}[0]);
		2263
1746	my ($value, $lo, $hi, $page) = @{$self->{range}};	2264	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2265	my $range = ($hi - $page - $lo) || 1e-100;
1747		2266
1748	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2267	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
1749		2268
1750	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2269	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
1751	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right	2270	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
1752		2271
1753	$x -= $inner_pad_px; # substract the padding	2272	$value = ($value - $lo) / $range;
1754	$x = $x * ($hi - $lo) / $inner_w + $lo;	2273	$value = $value * $self->{scale} + $self->{offset};
1755	$x = $lo if $x < $lo;
1756	$x = $hi - $page if $x > $hi - $page;
1757	$self->{range}[0] = $x;
1758		2274
1759	$self->emit (changed => $x);	2275	$self->{knob_x} = $value - $knob_w * 0.5;
1760	$self->update;	2276	$self->{knob_w} = $knob_w;
1761	}	2277	});
1762	}
1763		2278
1764	# the inner_* stuff is for generating a padding for the slider handle,	2279	$self->SUPER::update;
1765	# so that the handle doesn't leave the texture. This calculation isn't 100%
1766	# correct propably, but it does the job for now
1767	sub _calc_inner_pad_px {
1768	my ($self, $w) = @_;
1769	($w / 100) * $self->{inner_pad} # % to pixels
1770	}	2280	}
1771		2281
1772	sub _draw {	2282	sub _draw {
1773	my ($self) = @_;	2283	my ($self) = @_;
1774		2284
1775	$self->SUPER::_draw ();	2285	$self->SUPER::_draw ();
1776		2286
1777	my ($w, $h) = @$self{qw(w h)};	2287	glScale $self->{w}, $self->{h};
1778		2288
1779	if ($self->{vertical}) {	2289	if ($self->{vertical}) {
1780	# draw a vertical slider like a rotated horizontal slider	2290	# draw a vertical slider like a rotated horizontal slider
1781		2291
		2292	glTranslate 1, 0, 0;
1782	glRotate 90, 0, 0, 1;	2293	glRotate 90, 0, 0, 1;
1783	glTranslate 0, -$self->{w}, 0;
1784
1785	($w, $h) = ($h, $w);
1786	}	2294	}
1787		2295
1788	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2296	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
1789	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2297	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
1790		2298
1791	my ($value, $lo, $hi, $page) = @{$self->{range}};
1792
1793	$hi = $value + 1 if $lo == $hi;
1794
1795	my $inner_pad_px = $self->_calc_inner_pad_px ($w);
1796	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
1797
1798	$page = int $page * $inner_w / ($hi - $lo);
1799	$value = int +($value - $lo) * $inner_w / ($hi - $lo);
1800
1801	$w -= $page;
1802	$page &= ~1;
1803	glTranslate $page * 0.5, 0, 0;
1804	$page ||= 2;
1805
1806	my $knob_a = $inner_pad_px + ($value - $page * 0.5);
1807	my $knob_b = $inner_pad_px + ($value + $page * 0.5);
1808
1809	glEnable GL_BLEND;
1810	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1811	glEnable GL_TEXTURE_2D;	2299	glEnable GL_TEXTURE_2D;
1812	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2300	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1813		2301
1814	# draw background	2302	# draw background
1815	$tex[1]->draw_quad (0, 0, $w, $h);	2303	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
1816		2304
1817	# draw handle	2305	# draw handle
1818	$tex[0]->draw_quad ($knob_a, 0, $knob_b - $knob_a, $h);	2306	$tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
1819		2307
1820	glDisable GL_BLEND;
1821	glDisable GL_TEXTURE_2D;	2308	glDisable GL_TEXTURE_2D;
1822	}	2309	}
		2310
		2311	#############################################################################
		2312
		2313	package CFClient::UI::ValSlider;
		2314
		2315	our @ISA = CFClient::UI::HBox::;
		2316
		2317	sub new {
		2318	my ($class, %arg) = @_;
		2319
		2320	my $range = delete $arg{range};
		2321
		2322	my $self = $class->SUPER::new (
		2323	slider => (new CFClient::UI::Slider expand => 1, range => $range),
		2324	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
		2325	to_value => sub { shift },
		2326	from_value => sub { shift },
		2327	%arg,
		2328	);
		2329
		2330	$self->{slider}->connect (changed => sub {
		2331	my ($self, $value) = @_;
		2332	$self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
		2333	$self->{parent}->emit (changed => $value);
		2334	});
		2335
		2336	# $self->{entry}->connect (changed => sub {
		2337	# my ($self, $value) = @_;
		2338	# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
		2339	# $self->{parent}->emit (changed => $value);
		2340	# });
		2341
		2342	$self->add ($self->{slider}, $self->{entry});
		2343
		2344	$self->{slider}->emit (changed => $self->{slider}{range}[0]);
		2345
		2346	$self
		2347	}
		2348
		2349	sub set_range { shift->{slider}->set_range (@_) }
		2350	sub set_value { shift->{slider}->set_value (@_) }
1823		2351
1824	#############################################################################	2352	#############################################################################
1825		2353
1826	package CFClient::UI::TextView;	2354	package CFClient::UI::TextView;
1827		2355
…		…
1831		2359
1832	sub new {	2360	sub new {
1833	my $class = shift;	2361	my $class = shift;
1834		2362
1835	my $self = $class->SUPER::new (	2363	my $self = $class->SUPER::new (
1836	fontsize => 1,	2364	fontsize => 1,
		2365	can_events => 0,
		2366	#font => default_font
1837	@_,	2367	@_,
1838		2368
1839	layout => (new CFClient::Layout),	2369	layout => (new CFClient::Layout 1),
1840	par => [],	2370	par => [],
1841	height => 0,	2371	height => 0,
1842	children => [	2372	children => [
1843	(new CFClient::UI::Empty expand => 1),	2373	(new CFClient::UI::Empty expand => 1),
1844	(new CFClient::UI::Slider vertical => 1),	2374	(new CFClient::UI::Slider vertical => 1),
1845	],	2375	],
1846	);	2376	);
1847		2377
1848	$self->{children}[1]->connect (changed => sub {	2378	$self->{children}[1]->connect (changed => sub { $self->update });
1849	$self->update;
1850	});
1851		2379
1852	$self	2380	$self
1853	}	2381	}
1854		2382
1855	sub set_fontsize {	2383	sub set_fontsize {
…		…
1857		2385
1858	$self->{fontsize} = $fontsize;	2386	$self->{fontsize} = $fontsize;
1859	$self->reflow;	2387	$self->reflow;
1860	}	2388	}
1861		2389
		2390	sub size_allocate {
		2391	my ($self, $w, $h) = @_;
		2392
		2393	$self->SUPER::size_allocate ($w, $h);
		2394
		2395	$self->{layout}->set_font ($self->{font}) if $self->{font};
		2396	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
		2397	$self->{layout}->set_width ($self->{children}[0]{w});
		2398
		2399	$self->reflow;
		2400	}
		2401
1862	sub text_height {	2402	sub text_size {
1863	my ($self, $text) = @_;	2403	my ($self, $text, $indent) = @_;
1864		2404
1865	my $layout = $self->{layout};	2405	my $layout = $self->{layout};
1866		2406
1867	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2407	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
1868	$layout->set_width ($self->{w});	2408	$layout->set_width ($self->{children}[0]{w} - $indent);
1869	$layout->set_text ($text);	2409	$layout->set_markup ($text);
1870		2410
1871	($layout->size)[1]	2411	$layout->size
1872	}	2412	}
1873		2413
1874	sub reflow {	2414	sub reflow {
1875	my ($self) = @_;	2415	my ($self) = @_;
1876		2416
1877	$self->{need_reflow}++;	2417	$self->{need_reflow}++;
1878	$self->update;	2418	$self->update;
1879	}	2419	}
1880		2420
1881	sub size_allocate {	2421	sub set_offset {
		2422	my ($self, $offset) = @_;
		2423
		2424	# todo: base offset on lines or so, not on pixels
		2425	$self->{children}[1]->set_value ($offset);
		2426	}
		2427
		2428	sub clear {
1882	my ($self, $w, $h) = @_;	2429	my ($self) = @_;
1883		2430
1884	$self->SUPER::size_allocate ($w, $h);	2431	$self->{par} = [];
1885		2432	$self->{height} = 0;
1886	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2433	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
1887	$self->{layout}->set_width ($self->{children}[0]{w});
1888
1889	$self->reflow;
1890	}	2434	}
1891		2435
1892	sub add_paragraph {	2436	sub add_paragraph {
1893	my ($self, $color, $text) = @_;	2437	my ($self, $color, $text, $indent) = @_;
1894		2438
1895	#TODO: intelligently "reformat" paragraph	2439	for my $line (split /\n/, $text) {
1896		2440	my ($w, $h) = $self->text_size ($line);
1897	my $height = $self->text_height ($text);
1898
1899	$self->{height} += $height;	2441	$self->{height} += $h;
		2442	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
		2443	}
1900		2444
1901	push @{$self->{par}}, [$height, $color, $text];
1902
1903	$self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}];	2445	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
1904	$self->{children}[1]->update;
1905	}	2446	}
1906		2447
1907	sub update {	2448	sub update {
1908	my ($self) = @_;	2449	my ($self) = @_;
1909		2450
…		…
1911		2452
1912	return unless $self->{h} > 0;	2453	return unless $self->{h} > 0;
1913		2454
1914	delete $self->{texture};	2455	delete $self->{texture};
1915		2456
1916	$ROOT->on_refresh ($self, sub {	2457	$ROOT->on_post_alloc ($self, sub {
		2458	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2459
1917	if (delete $self->{need_reflow}) {	2460	if (delete $self->{need_reflow}) {
1918	my $height = 0;	2461	my $height = 0;
1919		2462
1920	$height += $_->[0] = $self->text_height ($_->[2])	2463	my $layout = $self->{layout};
		2464
		2465	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2466
1921	for @{$self->{par}};	2467	for (@{$self->{par}}) {
		2468	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
		2469	$layout->set_width ($W - $_->[3]);
		2470	$layout->set_markup ($_->[4]);
		2471	my ($w, $h) = $layout->size;
		2472	$_->[0] = $w + $_->[3];
		2473	$_->[1] = $h;
		2474	}
		2475
		2476	$height += $_->[1];
		2477	}
1922		2478
1923	$self->{height} = $height;	2479	$self->{height} = $height;
1924		2480
1925	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2481	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
1926		2482
1927	delete $self->{texture};	2483	delete $self->{texture};
1928	}	2484	}
1929		2485
1930	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	2486	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
1931	glClearColor 0, 0, 0, 1;	2487	glClearColor 0.5, 0.5, 0.5, 0;
1932	glClear GL_COLOR_BUFFER_BIT;	2488	glClear GL_COLOR_BUFFER_BIT;
1933		2489
		2490	my $top = int $self->{children}[1]{range}[0];
		2491
		2492	my $y0 = $top;
		2493	my $y1 = $top + $H;
		2494
		2495	my $y = 0;
		2496
		2497	my $layout = $self->{layout};
		2498
		2499	$layout->set_font ($self->{font}) if $self->{font};
		2500
1934	glEnable GL_BLEND;	2501	glEnable GL_BLEND;
		2502	#TODO# not correct in windows where rgba is forced off
1935	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2503	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1936	glEnable GL_TEXTURE_2D;
1937	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1938
1939	my $top = int $self->{children}[1]{range}[0];
1940
1941	my $y0 = $top;
1942	my $y1 = $top + $self->{h};
1943
1944	my $y = 0;
1945
1946	my $layout = $self->{layout};
1947		2504
1948	for my $par (@{$self->{par}}) {	2505	for my $par (@{$self->{par}}) {
1949	my $h = $par->[0];	2506	my $h = $par->[1];
1950		2507
1951	if ($y0 < $y + $h && $y < $y1) {	2508	if ($y0 < $y + $h && $y < $y1) {
		2509	$layout->set_foreground (@{ $par->[2] });
		2510	$layout->set_width ($W - $par->[3]);
1952	$layout->set_text ($par->[2]);	2511	$layout->set_markup ($par->[4]);
1953		2512
1954	glColor @{ $par->[1] };	2513	my ($w, $h, $data, $format, $internalformat) = $layout->render;
1955	my ($W, $H) = $layout->size;	2514
1956	CFClient::Texture->new_from_layout ($layout)->draw_quad (0, $y - $y0);	2515	glRasterPos $par->[3], $y - $y0;
		2516	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
1957	}	2517	}
1958		2518
1959	$y += $h;	2519	$y += $h;
1960	}	2520	}
1961		2521
1962	glDisable GL_TEXTURE_2D;
1963	glDisable GL_BLEND;	2522	glDisable GL_BLEND;
1964	};	2523	};
1965	});	2524	});
1966	}	2525	}
1967		2526
1968	sub _draw {	2527	sub _draw {
1969	my ($self) = @_;	2528	my ($self) = @_;
1970		2529
1971	if ($self->{texture}) {
1972	glEnable GL_TEXTURE_2D;	2530	glEnable GL_TEXTURE_2D;
1973	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2531	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2532	glColor 1, 1, 1, 1;
1974	$self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});	2533	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
1975	glDisable GL_TEXTURE_2D;	2534	glDisable GL_TEXTURE_2D;
1976	}
1977		2535
1978	$self->{children}[1]->draw;	2536	$self->{children}[1]->draw;
1979		2537
1980	}	2538	}
1981		2539
…		…
2029		2587
2030	sub new {	2588	sub new {
2031	my $class = shift;	2589	my $class = shift;
2032		2590
2033	my $self = $class->SUPER::new (	2591	my $self = $class->SUPER::new (
2034	state => 0,	2592	state => 0,
2035	connect_activate => \&toggle_flopper,	2593	on_activate => \&toggle_flopper,
2036	@_	2594	@_
2037	);	2595	);
2038		2596
2039	if ($self->{state}) {	2597	if ($self->{state}) {
2040	$self->{state} = 0;	2598	$self->{state} = 0;
…		…
2049		2607
2050	# TODO: use animation	2608	# TODO: use animation
2051	if ($self->{state} = !$self->{state}) {	2609	if ($self->{state} = !$self->{state}) {
2052	$CFClient::UI::ROOT->add ($self->{other});	2610	$CFClient::UI::ROOT->add ($self->{other});
2053	$self->{other}->move ($self->coord2global (0, $self->{h}));	2611	$self->{other}->move ($self->coord2global (0, $self->{h}));
2054	$self->emit ("open");	2612	$self->_emit ("open");
2055	} else {	2613	} else {
2056	$CFClient::UI::ROOT->remove ($self->{other});	2614	$CFClient::UI::ROOT->remove ($self->{other});
2057	$self->emit ("close");	2615	$self->_emit ("close");
2058	}	2616	}
2059		2617
2060	$self->emit (changed => $self->{state});	2618	$self->_emit (changed => $self->{state});
2061	}	2619	}
2062		2620
2063	#############################################################################	2621	#############################################################################
2064		2622
		2623	package CFClient::UI::Tooltip;
		2624
		2625	our @ISA = CFClient::UI::Bin::;
		2626
		2627	use CFClient::OpenGL;
		2628
		2629	sub new {
		2630	my $class = shift;
		2631
		2632	$class->SUPER::new (
		2633	@_,
		2634	can_events => 0,
		2635	)
		2636	}
		2637
		2638	sub set_tooltip_from {
		2639	my ($self, $widget) = @_;
		2640
		2641	$self->add (new CFClient::UI::Label
		2642	markup => $widget->{tooltip},
		2643	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
		2644	fontsize => 0.8,
		2645	fg => [0, 0, 0, 1],
		2646	ellipsise => 0,
		2647	font => ($widget->{tooltip_font} || $::FONT_PROP),
		2648	);
		2649	}
		2650
		2651	sub size_request {
		2652	my ($self) = @_;
		2653
		2654	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
		2655
		2656	($w + 4, $h + 4)
		2657	}
		2658
		2659	sub size_allocate {
		2660	my ($self, $w, $h) = @_;
		2661
		2662	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2663	}
		2664
		2665	sub _draw {
		2666	my ($self) = @_;
		2667
		2668	glTranslate 0.375, 0.375;
		2669
		2670	my ($w, $h) = @$self{qw(w h)};
		2671
		2672	glColor 1, 0.8, 0.4;
		2673	glBegin GL_QUADS;
		2674	glVertex 0 , 0;
		2675	glVertex 0 , $h;
		2676	glVertex $w, $h;
		2677	glVertex $w, 0;
		2678	glEnd;
		2679
		2680	glColor 0, 0, 0;
		2681	glBegin GL_LINE_LOOP;
		2682	glVertex 0 , 0;
		2683	glVertex 0 , $h;
		2684	glVertex $w, $h;
		2685	glVertex $w, 0;
		2686	glEnd;
		2687
		2688	glTranslate 2 - 0.375, 2 - 0.375;
		2689	$self->SUPER::_draw;
		2690	}
		2691
		2692	#############################################################################
		2693
		2694	package CFClient::UI::Face;
		2695
		2696	our @ISA = CFClient::UI::Base::;
		2697
		2698	use CFClient::OpenGL;
		2699
		2700	sub new {
		2701	my $class = shift;
		2702
		2703	my $self = $class->SUPER::new (
		2704	aspect => 1,
		2705	can_events => 0,
		2706	@_,
		2707	);
		2708
		2709	if ($self->{anim} && $self->{animspeed}) {
		2710	Scalar::Util::weaken (my $widget = $self);
		2711
		2712	$self->{timer} = Event->timer (
		2713	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
		2714	hard => 1,
		2715	interval => $self->{animspeed},
		2716	cb => sub {
		2717	++$widget->{frame};
		2718	$widget->update;
		2719	},
		2720	);
		2721	}
		2722
		2723	$self
		2724	}
		2725
		2726	sub size_request {
		2727	(32, 8)
		2728	}
		2729
		2730	sub update {
		2731	my ($self) = @_;
		2732
		2733	return unless $self->{visible};
		2734
		2735	$self->SUPER::update;
		2736	}
		2737
		2738	sub _draw {
		2739	my ($self) = @_;
		2740
		2741	return unless $::CONN;
		2742
		2743	my $face;
		2744
		2745	if ($self->{frame}) {
		2746	my $anim = $::CONN->{anim}[$self->{anim}];
		2747
		2748	$face = $anim->[ $self->{frame} % @$anim ]
		2749	if $anim && @$anim;
		2750	}
		2751
		2752	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
		2753
		2754	if ($tex) {
		2755	glEnable GL_TEXTURE_2D;
		2756	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2757	glColor 1, 1, 1, 1;
		2758	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
		2759	glDisable GL_TEXTURE_2D;
		2760	}
		2761	}
		2762
		2763	sub DESTROY {
		2764	my ($self) = @_;
		2765
		2766	$self->{timer}->cancel
		2767	if $self->{timer};
		2768
		2769	$self->SUPER::DESTROY;
		2770	}
		2771
		2772	#############################################################################
		2773
		2774	package CFClient::UI::Inventory;
		2775
		2776	our @ISA = CFClient::UI::ScrolledWindow::;
		2777
		2778	sub new {
		2779	my $class = shift;
		2780
		2781	my $self = $class->SUPER::new (
		2782	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		2783	@_,
		2784	);
		2785
		2786	$self
		2787	}
		2788
		2789	sub set_items {
		2790	my ($self, $items) = @_;
		2791
		2792	$self->{scrolled}->clear;
		2793	return unless $items;
		2794
		2795	my @items = sort {
		2796	($a->{type} <=> $b->{type})
		2797	or ($a->{name} cmp $b->{name})
		2798	} @$items;
		2799
		2800	$self->{real_items} = \@items;
		2801
		2802	my $row = 0;
		2803	for my $item (@items) {
		2804	CFClient::Item::update_widgets $item;
		2805
		2806	$self->{scrolled}->add (0, $row, $item->{face_widget});
		2807	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		2808	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		2809
		2810	$row++;
		2811	}
		2812	}
		2813
		2814	sub size_request {
		2815	my ($self) = @_;
		2816	($self->{req_w}, $self->{req_h});
		2817	}
		2818
		2819	#############################################################################
		2820
		2821	package CFClient::UI::Menu;
		2822
		2823	our @ISA = CFClient::UI::FancyFrame::;
		2824
		2825	use CFClient::OpenGL;
		2826
		2827	sub new {
		2828	my $class = shift;
		2829
		2830	my $self = $class->SUPER::new (
		2831	items => [],
		2832	z => 100,
		2833	@_,
		2834	);
		2835
		2836	$self->add ($self->{vbox} = new CFClient::UI::VBox);
		2837
		2838	for my $item (@{ $self->{items} }) {
		2839	my ($widget, $cb) = @$item;
		2840
		2841	# handle various types of items, only text for now
		2842	if (!ref $widget) {
		2843	$widget = new CFClient::UI::Label
		2844	can_hover => 1,
		2845	can_events => 1,
		2846	text => $widget;
		2847	}
		2848
		2849	$self->{item}{$widget} = $item;
		2850
		2851	$self->{vbox}->add ($widget);
		2852	}
		2853
		2854	$self
		2855	}
		2856
		2857	# popup given the event (must be a mouse button down event currently)
		2858	sub popup {
		2859	my ($self, $ev) = @_;
		2860
		2861	$self->_emit ("popdown");
		2862
		2863	# maybe save $GRAB? must be careful about events...
		2864	$GRAB = $self;
		2865	$self->{button} = $ev->{button};
		2866
		2867	$self->show;
		2868	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
		2869	}
		2870
		2871	sub mouse_motion {
		2872	my ($self, $ev, $x, $y) = @_;
		2873
		2874	# TODO: should use vbox->find_widget or so
		2875	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
		2876	$self->{hover} = $self->{item}{$HOVER};
		2877	}
		2878
		2879	sub button_up {
		2880	my ($self, $ev, $x, $y) = @_;
		2881
		2882	if ($ev->{button} == $self->{button}) {
		2883	undef $GRAB;
		2884	$self->hide;
		2885
		2886	$self->_emit ("popdown");
		2887	$self->{hover}[1]->() if $self->{hover};
		2888	}
		2889	}
		2890
		2891	#############################################################################
		2892
		2893	package CFClient::UI::Statusbox;
		2894
		2895	our @ISA = CFClient::UI::VBox::;
		2896
		2897	sub new {
		2898	my $class = shift;
		2899
		2900	$class->SUPER::new (
		2901	fontsize => 0.8,
		2902	@_,
		2903	)
		2904	}
		2905
		2906	sub reorder {
		2907	my ($self) = @_;
		2908	my $NOW = time;
		2909
		2910	while (my ($k, $v) = each %{ $self->{item} }) {
		2911	delete $self->{item}{$k} if $v->{timeout} < $NOW;
		2912	}
		2913
		2914	my @widgets;
		2915
		2916	my @items = sort {
		2917	$a->{pri} <=> $b->{pri}
		2918	or $b->{id} <=> $a->{id}
		2919	} values %{ $self->{item} };
		2920
		2921	my $count = 10 + 1;
		2922	for my $item (@items) {
		2923	last unless --$count;
		2924
		2925	push @widgets, $item->{label} ||= do {
		2926	# TODO: doesn't handle markup well (read as: at all)
		2927	my $short = $item->{count} > 1
		2928	? "<b>$item->{count} ×</b> $item->{text}"
		2929	: $item->{text};
		2930
		2931	for ($short) {
		2932	s/^\s+//;
		2933	s/\s+/ /g;
		2934	}
		2935
		2936	new CFClient::UI::Label
		2937	markup => $short,
		2938	tooltip => $item->{tooltip},
		2939	tooltip_font => $::FONT_PROP,
		2940	tooltip_width => 0.67,
		2941	fontsize => $item->{fontsize} || $self->{fontsize},
		2942	max_w => $::WIDTH * 0.44,
		2943	fg => $item->{fg},
		2944	can_events => 1,
		2945	can_hover => 1
		2946	};
		2947	}
		2948
		2949	$self->clear;
		2950	$self->SUPER::add (reverse @widgets);
		2951	}
		2952
		2953	sub add {
		2954	my ($self, $text, %arg) = @_;
		2955
		2956	$text =~ s/^\s+//;
		2957	$text =~ s/\s+$//;
		2958
		2959	return unless $text;
		2960
		2961	my $timeout = time + ((delete $arg{timeout}) || 60);
		2962
		2963	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
		2964
		2965	if (my $item = $self->{item}{$group}) {
		2966	if ($item->{text} eq $text) {
		2967	$item->{count}++;
		2968	} else {
		2969	$item->{count} = 1;
		2970	$item->{text} = $item->{tooltip} = $text;
		2971	}
		2972	$item->{id} = ++$self->{id};
		2973	$item->{timeout} = $timeout;
		2974	delete $item->{label};
		2975	} else {
		2976	$self->{item}{$group} = {
		2977	id => ++$self->{id},
		2978	text => $text,
		2979	timeout => $timeout,
		2980	tooltip => $text,
		2981	fg => [0.8, 0.8, 0.8, 0.8],
		2982	pri => 0,
		2983	count => 1,
		2984	%arg,
		2985	};
		2986	}
		2987
		2988	$self->reorder;
		2989	}
		2990
		2991	sub reconfigure {
		2992	my ($self) = @_;
		2993
		2994	delete $_->{label}
		2995	for values %{ $self->{item} || {} };
		2996
		2997	$self->reorder;
		2998	$self->SUPER::reconfigure;
		2999	}
		3000
		3001	#############################################################################
		3002
2065	package CFClient::UI::Root;	3003	package CFClient::UI::Root;
2066		3004
2067	our @ISA = CFClient::UI::Container::;	3005	our @ISA = CFClient::UI::Container::;
2068		3006
2069	use CFClient::OpenGL;	3007	use CFClient::OpenGL;
2070		3008
2071	sub check_size {	3009	sub new {
2072	my ($self) = @_;	3010	my $class = shift;
2073		3011
2074	$self->configure (0, 0, $::WITH, $::HEIGHT);	3012	$class->SUPER::new (
2075	}	3013	visible => 1,
2076		3014	@_,
2077	sub size_request {	3015	)
2078	($::WIDTH, $::HEIGHT)
2079	}	3016	}
2080		3017
2081	sub configure {	3018	sub configure {
2082	my ($self, $x, $y, $w, $h) = @_;	3019	my ($self, $x, $y, $w, $h) = @_;
2083		3020
2084	$self->SUPER::configure ($x, $y, $w, $h);	3021	$self->{w} = $w;
2085		3022	$self->{h} = $h;
2086	$_->configure ($_->{x}, $_->{y}, $_->size_request)
2087	for @{$self->{children}};
2088	}	3023	}
2089		3024
2090	sub _topleft {	3025	sub check_size {
		3026	my ($self) = @_;
		3027
		3028	$self->size_allocate ($self->{w}, $self->{h})
		3029	if $self->{w};
		3030	}
		3031
		3032	sub size_request {
		3033	my ($self) = @_;
		3034
		3035	($self->{w}, $self->{h})
		3036	}
		3037
		3038	sub size_allocate {
		3039	my ($self, $w, $h) = @_;
		3040
		3041	for my $child ($self->children) {
		3042	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
		3043
		3044	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1
		3045	if exists $child->{req_x};
		3046
		3047	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1
		3048	if exists $child->{req_y};
		3049
		3050	$X = $self->{user_x} if exists $self->{user_x};
		3051	$Y = $self->{user_y} if exists $self->{user_y};
		3052
		3053	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
		3054	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
		3055
		3056	$child->configure ($X, $Y, $W, $H);
		3057	}
		3058	}
		3059
		3060	sub coord2local {
2091	my ($self, $x, $y) = @_;	3061	my ($self, $x, $y) = @_;
2092		3062
2093	($x, $y)	3063	($x, $y)
2094	}	3064	}
2095		3065
		3066	sub coord2global {
		3067	my ($self, $x, $y) = @_;
		3068
		3069	($x, $y)
		3070	}
		3071
2096	sub update {	3072	sub update {
2097	my ($self) = @_;	3073	my ($self) = @_;
2098		3074
2099	$self->check_size;	3075	$self->check_size;
2100	::refresh ();	3076	$::WANT_REFRESH++;
2101	}	3077	}
2102		3078
2103	sub add {	3079	sub add {
2104	my ($self, $child) = @_;	3080	my ($self, @children) = @_;
2105		3081
		3082	for (my @widgets = @children; my $w = pop @widgets; ) {
		3083	push @widgets, $w->children;
		3084	$w->{root} = $self;
		3085	$w->{visible} = $self->{visible} + 1;
		3086	}
		3087
		3088	for my $child (@children) {
		3089	$child->{is_toplevel} = 1;
		3090
2106	# integerize window positions	3091	# integerise window positions
2107	$child->{x} = int $child->{x};	3092	$child->{x} = int $child->{x};
2108	$child->{y} = int $child->{y};	3093	$child->{y} = int $child->{y};
		3094	}
2109		3095
2110	$self->SUPER::add ($child);	3096	$self->SUPER::add (@children);
		3097	}
		3098
		3099	sub remove {
		3100	my ($self, @children) = @_;
		3101
		3102	$self->SUPER::remove (@children);
		3103
		3104	while (@children) {
		3105	my $w = pop @children;
		3106	push @children, $w->children;
		3107	$w->set_invisible;
		3108	}
2111	}	3109	}
2112		3110
2113	sub on_refresh {	3111	sub on_refresh {
2114	my ($self, $id, $cb) = @_;	3112	my ($self, $id, $cb) = @_;
2115		3113
2116	$self->{refresh_hook}{$id} = $cb;	3114	$self->{refresh_hook}{$id} = $cb;
2117	}	3115	}
2118		3116
		3117	sub on_post_alloc {
		3118	my ($self, $id, $cb) = @_;
		3119
		3120	$self->{post_alloc_hook}{$id} = $cb;
		3121	}
		3122
2119	sub draw {	3123	sub draw {
2120	my ($self) = @_;	3124	my ($self) = @_;
2121		3125
2122	while (my $rcb = delete $self->{refresh_hook}) {	3126	while ($self->{refresh_hook}) {
2123	$_->() for values %$rcb;	3127	$_->()
		3128	for values %{delete $self->{refresh_hook}};
		3129	}
		3130
		3131	if ($self->{check_size}) {
		3132	my @queue;
		3133
		3134	for (;;) {
		3135	if ($self->{check_size}) {
		3136	#TODO use array-of-depth approach
		3137
		3138	@queue = sort { $a->{visible} <=> $b->{visible} }
		3139	@queue, values %{delete $self->{check_size}};
		3140	}
		3141
		3142	my $widget = pop @queue || last;
		3143
		3144	defined $widget->{visible} or last; # do not resize invisible widgets
		3145
		3146	my ($w, $h) = $widget->{user_w} && $widget->{user_h}
		3147	? @$widget{qw(user_w user_h)}
		3148	: $widget->size_request;
		3149
		3150	if (delete $widget->{force_alloc}
		3151	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
		3152	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
		3153
		3154	$widget->{req_w} = $w;
		3155	$widget->{req_h} = $h;
		3156
		3157	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];
		3158
		3159	$widget->{parent}->check_size
		3160	if $widget->{parent};
		3161	}
		3162	}
		3163	}
		3164
		3165	while ($self->{size_alloc}) {
		3166	for (values %{delete $self->{size_alloc}}) {
		3167	my ($widget, $w, $h) = @$_;
		3168
		3169	$w = 0 if $w < 0;
		3170	$h = 0 if $h < 0;
		3171
		3172	$widget->{w} = $w;
		3173	$widget->{h} = $h;
		3174	$widget->emit (size_allocate => $w, $h);
		3175	}
		3176	}
		3177
		3178	while ($self->{post_alloc_hook}) {
		3179	$_->()
		3180	for values %{delete $self->{post_alloc_hook}};
2124	}	3181	}
2125		3182
2126	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3183	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2127	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3184	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2128	glClear GL_COLOR_BUFFER_BIT;	3185	glClear GL_COLOR_BUFFER_BIT;
2129		3186
2130	glMatrixMode GL_PROJECTION;	3187	glMatrixMode GL_PROJECTION;
2131	glLoadIdentity;	3188	glLoadIdentity;
2132	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;	3189	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2133	glMatrixMode GL_MODELVIEW;	3190	glMatrixMode GL_MODELVIEW;
2134	glLoadIdentity;	3191	glLoadIdentity;
2135		3192
2136	$self->_draw;	3193	$self->_draw;
2137	}	3194	}
…		…
2139	#############################################################################	3196	#############################################################################
2140		3197
2141	package CFClient::UI;	3198	package CFClient::UI;
2142		3199
2143	$ROOT = new CFClient::UI::Root;	3200	$ROOT = new CFClient::UI::Root;
		3201	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2144		3202
2145	1	3203	1
2146		3204

Diff Legend

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