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.162 by root, Mon Apr 24 06:05:35 2006 UTC vs.
Revision 1.310 by root, Fri Jun 23 20:28:20 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 ();
		8	use Event;
7		9
8	use CFClient;	10	use CFClient;
		11	use CFClient::Texture;
9		12
10	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
11		14
		15	our $LAYOUT;
12	our $ROOT;	16	our $ROOT;
13	our $TOOLTIP;	17	our $TOOLTIP;
14	our $BUTTON_STATE;	18	our $BUTTON_STATE;
15		19
16	sub check_tooltip {	20	our %WIDGET; # all widgets, weak-referenced
		21
		22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
17	if (!$GRAB) {	23	if (!$GRAB) {
18	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
19	if (length $widget->{tooltip}) {	25	if (length $widget->{tooltip}) {
20
21	if ($TOOLTIP->{owner} != $widget) {	26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->hide;
		28
22	$TOOLTIP->{owner} = $widget;	29	$TOOLTIP->{owner} = $widget;
		30
		31	return if $ENV{CFPLUS_DEBUG} & 8;
23		32
24	my $tip = $widget->{tooltip};	33	my $tip = $widget->{tooltip};
25		34
26	$tip = $tip->($widget) if CODE:: eq ref $tip;	35	$tip = $tip->($widget) if CODE:: eq ref $tip;
27		36
28	$TOOLTIP->set_markup ($widget->{tooltip});	37	$TOOLTIP->set_tooltip_from ($widget);
29	$TOOLTIP->move ($widget->coord2global ($widget->{w}, 0));
30	$TOOLTIP->show;	38	$TOOLTIP->show;
31	}	39	}
32		40
33	return;	41	return;
34	}	42	}
35	}	43	}
36	}	44	}
37		45
38	$TOOLTIP->hide;	46	$TOOLTIP->hide;
39	delete $TOOLTIP->{owner};	47	delete $TOOLTIP->{owner};
		48	});
		49
		50	sub get_layout {
		51	my $layout;
		52
		53	for (grep { $_->{name} } values %WIDGET) {
		54	my $win = $layout->{$_->{name}} = { };
		55
		56	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
		57	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
		58	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
		59	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
		60
		61	$win->{show} = $_->{visible} && $_->{is_toplevel};
		62	}
		63
		64	$layout
		65	}
		66
		67	sub set_layout {
		68	my ($layout) = @_;
		69
		70	$LAYOUT = $layout;
40	}	71	}
41		72
42	# class methods for events	73	# class methods for events
43	sub feed_sdl_key_down_event {	74	sub feed_sdl_key_down_event {
44	$FOCUS->key_down ($_[0]) if $FOCUS;	75	$FOCUS->emit (key_down => $_[0])
		76	if $FOCUS;
45	}	77	}
46		78
47	sub feed_sdl_key_up_event {	79	sub feed_sdl_key_up_event {
48	$FOCUS->key_up ($_[0]) if $FOCUS;	80	$FOCUS->emit (key_up => $_[0])
		81	if $FOCUS;
49	}	82	}
50		83
51	sub feed_sdl_button_down_event {	84	sub feed_sdl_button_down_event {
52	my ($ev) = @_;	85	my ($ev) = @_;
53	my ($x, $y) = ($ev->{x}, $ev->{y});	86	my ($x, $y) = ($ev->{x}, $ev->{y});
…		…
56	my $widget = $ROOT->find_widget ($x, $y);	89	my $widget = $ROOT->find_widget ($x, $y);
57		90
58	$GRAB = $widget;	91	$GRAB = $widget;
59	$GRAB->update if $GRAB;	92	$GRAB->update if $GRAB;
60		93
61	check_tooltip;	94	$TOOLTIP_WATCHER->cb->();
62	}	95	}
63		96
64	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
65		98
66	$GRAB->button_down ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;	99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
		100	if $GRAB;
67	}	101	}
68		102
69	sub feed_sdl_button_up_event {	103	sub feed_sdl_button_up_event {
70	my ($ev) = @_;	104	my ($ev) = @_;
71	my ($x, $y) = ($ev->{x}, $ev->{y});	105	my ($x, $y) = ($ev->{x}, $ev->{y});
72		106
73	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
74		108
75	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
76		110
77	$GRAB->button_up ($ev, $GRAB->coord2local ($x, $y)) if $GRAB;	111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
		112	if $GRAB;
78		113
79	if (!$BUTTON_STATE) {	114	if (!$BUTTON_STATE) {
80	my $grab = $GRAB; undef $GRAB;	115	my $grab = $GRAB; undef $GRAB;
81	$grab->update if $grab;	116	$grab->update if $grab;
82	$GRAB->update if $GRAB;	117	$GRAB->update if $GRAB;
83		118
84	check_tooltip;	119	$TOOLTIP_WATCHER->cb->();
85	}	120	}
86	}	121	}
87		122
88	sub feed_sdl_motion_event {	123	sub feed_sdl_motion_event {
89	my ($ev) = @_;	124	my ($ev) = @_;
…		…
95	my $hover = $HOVER; $HOVER = $widget;	130	my $hover = $HOVER; $HOVER = $widget;
96		131
97	$hover->update if $hover && $hover->{can_hover};	132	$hover->update if $hover && $hover->{can_hover};
98	$HOVER->update if $HOVER && $HOVER->{can_hover};	133	$HOVER->update if $HOVER && $HOVER->{can_hover};
99		134
100	check_tooltip;	135	$TOOLTIP_WATCHER->start;
101	}	136	}
102		137
103	$HOVER->mouse_motion ($ev, $HOVER->coord2local ($x, $y)) if $HOVER;	138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
		139	if $HOVER;
104	}	140	}
105		141
106	# convert position array to integers	142	# convert position array to integers
107	sub harmonize {	143	sub harmonize {
108	my ($vals) = @_;	144	my ($vals) = @_;
…		…
114	$rem += $_ - $i;	150	$rem += $_ - $i;
115	$_ = $i;	151	$_ = $i;
116	}	152	}
117	}	153	}
118		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 $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		178	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		179
		180	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
		181	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
		182	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
		183	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
		184	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
		185	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
		186
		187	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		188	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		189
		190	}
		191	}
		192
		193	reconfigure_widgets;
		194	}
		195
119	#############################################################################	196	#############################################################################
120		197
121	package CFClient::UI::Base;	198	package CFClient::UI::Base;
122		199
123	use strict;	200	use strict;
…		…
126		203
127	sub new {	204	sub new {
128	my $class = shift;	205	my $class = shift;
129		206
130	my $self = bless {	207	my $self = bless {
131	x => 0,	208	x => "center",
132	y => 0,	209	y => "center",
133	z => 0,	210	z => 0,
		211	w => undef,
		212	h => undef,
134	can_events => 1,	213	can_events => 1,
135	@_	214	@_
136	}, $class;	215	}, $class;
137		216
		217	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		218
138	for (keys %$self) {	219	for (keys %$self) {
139	if (/^connect_(.*)$/) {	220	if (/^on_(.*)$/) {
140	$self->connect ($1 => delete $self->{$_});	221	$self->connect ($1 => delete $self->{$_});
141	}	222	}
142	}	223	}
143		224
		225	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		226	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		227	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		228	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		229	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		230
		231	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		232	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		233
		234	$self->show if $layout->{show};
		235	}
		236
144	$self	237	$self
145	}	238	}
146		239
147	sub destroy {	240	sub destroy {
148	my ($self) = @_;	241	my ($self) = @_;
…		…
157	return if $self->{parent};	250	return if $self->{parent};
158		251
159	$CFClient::UI::ROOT->add ($self);	252	$CFClient::UI::ROOT->add ($self);
160	}	253	}
161		254
		255	sub set_visible {
		256	my ($self) = @_;
		257
		258	return if $self->{visible};
		259
		260	$self->{root} = $self->{parent}{root};
		261	$self->{visible} = $self->{parent}{visible} + 1;
		262
		263	$self->emit (visibility_change => 1);
		264
		265	$self->realloc if !exists $self->{req_w};
		266
		267	$_->set_visible for $self->children;
		268	}
		269
		270	sub set_invisible {
		271	my ($self) = @_;
		272
		273	return unless $self->{visible};
		274
		275	$_->set_invisible for $self->children;
		276
		277	delete $self->{visible};
		278	delete $self->{root};
		279
		280	undef $GRAB if $GRAB == $self;
		281	undef $HOVER if $HOVER == $self;
		282
		283	$CFClient::UI::TOOLTIP_WATCHER->cb->()
		284	if $TOOLTIP->{owner} == $self;
		285
		286	$self->emit ("focus_out");
		287	$self->emit (visibility_change => 0);
		288	}
		289
		290	sub set_visibility {
		291	my ($self, $visible) = @_;
		292
		293	return if $self->{visible} == $visible;
		294
		295	$visible ? $self->hide
		296	: $self->show;
		297	}
		298
		299	sub toggle_visibility {
		300	my ($self) = @_;
		301
		302	$self->{visible}
		303	? $self->hide
		304	: $self->show;
		305	}
		306
162	sub hide {	307	sub hide {
163	my ($self) = @_;	308	my ($self) = @_;
164		309
165	return unless $self->{parent};	310	$self->set_invisible;
166		311
167	$self->{parent}->remove ($self);	312	$self->{parent}->remove ($self)
		313	if $self->{parent};
168	}	314	}
169		315
170	sub move {	316	sub move_abs {
171	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
172		318
173	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
174	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
175	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
176		322
177	$self->update;	323	$self->update;
178	}	324	}
179		325
180	sub set_size {	326	sub set_size {
181	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
182		328
183	$self->{user_w} = $w;	329	$self->{force_w} = $w;
184	$self->{user_h} = $h;	330	$self->{force_h} = $h;
185		331
186	$self->check_size;	332	$self->realloc;
187	}	333	}
188		334
189	sub size_request {	335	sub size_request {
190	require Carp;	336	require Carp;
191	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
193		339
194	sub configure {	340	sub configure {
195	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
196		342
197	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
198	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
199	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
200		348
201	# use alignment to adjust x, y	349	# use alignment to adjust x, y
202		350
203	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
204	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
205
206	($w, $h) = ($w2, $h2);
207	}	353	}
208		354
209	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
210	$self->{x} = $x;	356	$self->{x} = $x;
211	$self->{y} = $y;	357	$self->{y} = $y;
212	$self->update;	358	$self->update;
213	}	359	}
214		360
215	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
		362	return unless $self->{visible};
		363
216	$self->{w} = $w;	364	$self->{alloc_w} = $w;
217	$self->{h} = $h;	365	$self->{alloc_h} = $h;
218		366
219	$self->size_allocate ($w, $h);	367	$self->{root}{size_alloc}{$self+0} = $self;
220	$self->update;
221	}	368	}
222	}	369	}
223		370
224	sub size_allocate {	371	sub children {
225	# nothing to be done	372	# nop
		373	}
		374
		375	sub visible_children {
		376	$_[0]->children
226	}	377	}
227		378
228	sub set_max_size {	379	sub set_max_size {
229	my ($self, $w, $h) = @_;	380	my ($self, $w, $h) = @_;
230		381
231	delete $self->{max_w}; $self->{max_w} = $w if $w;	382	$self->{max_w} = int $w if defined $w;
232	delete $self->{max_h}; $self->{max_h} = $h if $h;	383	$self->{max_h} = int $h if defined $h;
233	}
234		384
235	# return top left coordinates	385	$self->realloc;
236	sub _topleft {	386	}
		387
		388	sub set_tooltip {
237	my ($self, $x, $y) = @_;	389	my ($self, $tooltip) = @_;
238		390
239	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});	391	$tooltip =~ s/^\s+//;
		392	$tooltip =~ s/\s+$//;
		393
		394	return if $self->{tooltip} eq $tooltip;
		395
		396	$self->{tooltip} = $tooltip;
		397
		398	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
		399	delete $CFClient::UI::TOOLTIP->{owner};
		400	$CFClient::UI::TOOLTIP_WATCHER->cb->();
		401	}
240	}	402	}
241		403
242	# translate global coordinates to local coordinate system	404	# translate global coordinates to local coordinate system
243	sub coord2local {	405	sub coord2local {
244	my ($self, $x, $y) = @_;	406	my ($self, $x, $y) = @_;
245		407
246	my ($X, $Y) = $self->_topleft;	408	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
247	($x - $X, $y - $Y)
248	}	409	}
249		410
250	# translate local coordinates to global coordinate system	411	# translate local coordinates to global coordinate system
251	sub coord2global {	412	sub coord2global {
252	my ($self, $x, $y) = @_;	413	my ($self, $x, $y) = @_;
253		414
254	my ($X, $Y) = $self->_topleft;	415	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
255	($x + $X, $y + $Y)
256	}	416	}
257		417
258	sub focus_in {	418	sub invoke_focus_in {
259	my ($self) = @_;	419	my ($self) = @_;
260		420
261	return if $FOCUS == $self;	421	return if $FOCUS == $self;
262	return unless $self->{can_focus};	422	return unless $self->{can_focus};
263		423
264	my $focus = $FOCUS; $FOCUS = $self;	424	my $focus = $FOCUS; $FOCUS = $self;
265		425
266	$self->emit (focus_in => $focus);
267
268	$focus->update if $focus;	426	$focus->update if $focus;
269	$FOCUS->update;	427	$FOCUS->update;
270	}
271		428
		429	0
		430	}
		431
272	sub focus_out {	432	sub invoke_focus_out {
273	my ($self) = @_;	433	my ($self) = @_;
274		434
275	return unless $FOCUS == $self;	435	return unless $FOCUS == $self;
276		436
277	my $focus = $FOCUS; undef $FOCUS;	437	my $focus = $FOCUS; undef $FOCUS;
278		438
279	$self->emit (focus_out => $focus);
280
281	$focus->update if $focus; #?	439	$focus->update if $focus; #?
282	}
283		440
		441	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
		442	unless $FOCUS;
		443
		444	0
		445	}
		446
		447	sub grab_focus {
		448	my ($self) = @_;
		449
		450	$self->emit ("focus_in");
		451	}
		452
284	sub mouse_motion { }	453	sub invoke_mouse_motion { 1 }
285	sub button_up { }	454	sub invoke_button_up { 1 }
286	sub key_down { }	455	sub invoke_key_down { 1 }
287	sub key_up { }	456	sub invoke_key_up { 1 }
288		457
289	sub button_down {	458	sub invoke_button_down {
290	my ($self, $ev, $x, $y) = @_;	459	my ($self, $ev, $x, $y) = @_;
291		460
292	$self->focus_in;	461	$self->grab_focus;
293	}
294		462
295	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	463	1
296	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	464	}
297	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	465
298	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	466	sub connect {
299	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	467	my ($self, $signal, $cb) = @_;
		468
		469	push @{ $self->{signal_cb}{$signal} }, $cb;
		470	}
		471
		472	sub emit {
		473	my ($self, $signal, @args) = @_;
		474
		475	#d##TODO# stop propagating at first true, do not use sum
		476	(List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before
		477	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure
		478	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
		479	}
		480
		481	sub find_widget {
		482	my ($self, $x, $y) = @_;
		483
		484	return () unless $self->{can_events};
		485
		486	return $self
		487	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		488	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		489
		490	()
		491	}
		492
		493	sub set_parent {
		494	my ($self, $parent) = @_;
		495
		496	Scalar::Util::weaken ($self->{parent} = $parent);
		497	$self->set_visible if $parent->{visible};
		498	}
		499
		500	sub realloc {
		501	my ($self) = @_;
		502
		503	if ($self->{visible}) {
		504	return if $self->{root}{realloc}{$self+0};
		505
		506	$self->{root}{realloc}{$self+0} = $self;
		507	$self->{root}->update;
		508	} else {
		509	delete $self->{req_w};
		510	delete $self->{req_h};
		511	}
		512	}
		513
		514	sub update {
		515	my ($self) = @_;
		516
		517	$self->{parent}->update
		518	if $self->{parent};
		519	}
		520
		521	sub reconfigure {
		522	my ($self) = @_;
		523
		524	$self->realloc;
		525	$self->update;
		526	}
		527
		528	# using global variables seems a bit hacky, but passing through all drawing
		529	# functions seems pointless.
		530	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
300		531
301	sub draw {	532	sub draw {
302	my ($self) = @_;	533	my ($self) = @_;
303		534
304	return unless $self->{h} && $self->{w};	535	return unless $self->{h} && $self->{w};
		536
		537	# update screen rectangle
		538	local $draw_x = $draw_x + $self->{x};
		539	local $draw_y = $draw_y + $self->{y};
		540	local $draw_w = $draw_x + $self->{w};
		541	local $draw_h = $draw_y + $self->{h};
		542
		543	# skip widgets that are entirely outside the drawing area
		544	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		545	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
305		546
306	glPushMatrix;	547	glPushMatrix;
307	glTranslate $self->{x}, $self->{y}, 0;	548	glTranslate $self->{x}, $self->{y}, 0;
308	$self->_draw;
309	glPopMatrix;
310		549
311	if ($self == $HOVER && $self->{can_hover}) {	550	if ($self == $HOVER && $self->{can_hover}) {
312	my ($x, $y) = @$self{qw(x y)};
313
314	glColor 1, 0.8, 0.5, 0.2;	551	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
315	glEnable GL_BLEND;	552	glEnable GL_BLEND;
316	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	553	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
317	glBegin GL_QUADS;	554	glBegin GL_QUADS;
318	glVertex $x , $y;
319	glVertex $x + $self->{w}, $y;
320	glVertex $x + $self->{w}, $y + $self->{h};
321	glVertex $x , $y + $self->{h};
322	glEnd;
323	glDisable GL_BLEND;
324	}
325
326	if ($ENV{PCLIENT_DEBUG}) {
327	glPushMatrix;
328	glColor 1, 1, 0, 1;
329	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
330	glBegin GL_LINE_LOOP;
331	glVertex 0 , 0;	555	glVertex 0 , 0;
332	glVertex $self->{w}, 0;	556	glVertex $self->{w}, 0;
333	glVertex $self->{w}, $self->{h};	557	glVertex $self->{w}, $self->{h};
334	glVertex 0 , $self->{h};	558	glVertex 0 , $self->{h};
335	glEnd;	559	glEnd;
		560	glDisable GL_BLEND;
		561	}
		562
		563	if ($ENV{CFPLUS_DEBUG} & 1) {
		564	glPushMatrix;
		565	glColor 1, 1, 0, 1;
		566	glTranslate 0.375, 0.375;
		567	glBegin GL_LINE_LOOP;
		568	glVertex 0 , 0;
		569	glVertex $self->{w} - 1, 0;
		570	glVertex $self->{w} - 1, $self->{h} - 1;
		571	glVertex 0 , $self->{h} - 1;
		572	glEnd;
336	glPopMatrix;	573	glPopMatrix;
337	CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	574	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
338	}	575	}
		576
		577	$self->_draw;
		578	glPopMatrix;
339	}	579	}
340		580
341	sub _draw {	581	sub _draw {
342	my ($self) = @_;	582	my ($self) = @_;
343		583
344	warn "no draw defined for $self\n";	584	warn "no draw defined for $self\n";
345	}	585	}
346		586
347	sub find_widget {
348	my ($self, $x, $y) = @_;
349
350	return () unless $self->{can_events};
351
352	return $self
353	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
354	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
355
356	()
357	}
358
359	sub set_parent {
360	my ($self, $parent) = @_;
361
362	Scalar::Util::weaken ($self->{parent} = $parent);
363	}
364
365	sub check_size {
366	my ($self) = @_;
367
368	$self->{parent}
369	or return 1;
370
371	my ($w, $h) = $self->{user_w} && $self->{user_h}
372	? @$self{qw(user_w user_h)}
373	: $self->size_request;
374
375	if ($w != $self->{req_w} || $h != $self->{req_h}) {
376	$self->{req_w} = $w;
377	$self->{req_h} = $h;
378
379	$self->{parent}->check_size
380	or $self->size_allocate (
381	(List::Util::max $self->{w}, $w),
382	(List::Util::max $self->{h}, $h),
383	);
384
385	1
386	} else {
387	0
388	}
389	}
390
391	sub update {
392	my ($self) = @_;
393
394	$self->{parent}->update
395	if $self->{parent};
396	}
397
398	sub connect {
399	my ($self, $signal, $cb) = @_;
400
401	push @{ $self->{signal_cb}{$signal} }, $cb;
402	}
403
404	sub emit {
405	my ($self, $signal, @args) = @_;
406
407	for my $cb (@{$self->{signal_cb}{$signal} || []}) {
408	$cb->($self, @args);
409	}
410	}
411
412	sub DESTROY {	587	sub DESTROY {
413	my ($self) = @_;	588	my ($self) = @_;
414		589
415	#$self->deactivate;	590	delete $WIDGET{$self+0};
		591
		592	eval { $self->destroy };
		593	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
416	}	594	}
417		595
418	#############################################################################	596	#############################################################################
419		597
420	package CFClient::UI::DrawBG;	598	package CFClient::UI::DrawBG;
…		…
428	my $class = shift;	606	my $class = shift;
429		607
430	# range [value, low, high, page]	608	# range [value, low, high, page]
431		609
432	$class->SUPER::new (	610	$class->SUPER::new (
433	bg => [0, 0, 0, 0.2],	611	#bg => [0, 0, 0, 0.2],
434	active_bg => [1, 1, 1, 0.5],	612	#active_bg => [1, 1, 1, 0.5],
435	@_	613	@_
436	)	614	)
437	}	615	}
438		616
439	sub _draw {	617	sub _draw {
440	my ($self) = @_;	618	my ($self) = @_;
441		619
		620	my $color = $FOCUS == $self && $self->{active_bg}
		621	? $self->{active_bg}
		622	: $self->{bg};
		623
		624	if ($color && (@$color < 4 || $color->[3])) {
442	my ($w, $h) = @$self{qw(w h)};	625	my ($w, $h) = @$self{qw(w h)};
443		626
444	glEnable GL_BLEND;	627	glEnable GL_BLEND;
445	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	628	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
446	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	629	glColor_premultiply @$color;
447		630
448	glBegin GL_QUADS;	631	glBegin GL_QUADS;
449	glVertex 0 , 0;	632	glVertex 0 , 0;
450	glVertex 0 , $h;	633	glVertex 0 , $h;
451	glVertex $w, $h;	634	glVertex $w, $h;
452	glVertex $w, 0;	635	glVertex $w, 0;
453	glEnd;	636	glEnd;
454		637
455	glDisable GL_BLEND;	638	glDisable GL_BLEND;
		639	}
456	}	640	}
457		641
458	#############################################################################	642	#############################################################################
459		643
460	package CFClient::UI::Empty;	644	package CFClient::UI::Empty;
…		…
465	my ($class, %arg) = @_;	649	my ($class, %arg) = @_;
466	$class->SUPER::new (can_events => 0, %arg);	650	$class->SUPER::new (can_events => 0, %arg);
467	}	651	}
468		652
469	sub size_request {	653	sub size_request {
470	(0, 0)	654	my ($self) = @_;
		655
		656	($self->{w} + 0, $self->{h} + 0)
471	}	657	}
472		658
473	sub draw { }	659	sub draw { }
474		660
475	#############################################################################	661	#############################################################################
…		…
479	our @ISA = CFClient::UI::Base::;	665	our @ISA = CFClient::UI::Base::;
480		666
481	sub new {	667	sub new {
482	my ($class, %arg) = @_;	668	my ($class, %arg) = @_;
483		669
484	my $children = delete $arg{children} || [];	670	my $children = delete $arg{children};
485		671
486	my $self = $class->SUPER::new (children => [], can_events => 0, %arg);	672	my $self = $class->SUPER::new (
		673	children => [],
		674	can_events => 0,
		675	%arg,
		676	);
		677
487	$self->add ($_) for @$children;	678	$self->add (@$children)
		679	if $children;
488		680
489	$self	681	$self
		682	}
		683
		684	sub add {
		685	my ($self, @widgets) = @_;
		686
		687	$_->set_parent ($self)
		688	for @widgets;
		689
		690	use sort 'stable';
		691
		692	$self->{children} = [
		693	sort { $a->{z} <=> $b->{z} }
		694	@{$self->{children}}, @widgets
		695	];
		696
		697	$self->realloc;
		698	}
		699
		700	sub children {
		701	@{ $_[0]{children} }
		702	}
		703
		704	sub remove {
		705	my ($self, $child) = @_;
		706
		707	delete $child->{parent};
		708	$child->hide;
		709
		710	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
		711
		712	$self->realloc;
		713	}
		714
		715	sub clear {
		716	my ($self) = @_;
		717
		718	my $children = delete $self->{children};
		719	$self->{children} = [];
		720
		721	for (@$children) {
		722	delete $_->{parent};
		723	$_->hide;
		724	}
		725
		726	$self->realloc;
		727	}
		728
		729	sub find_widget {
		730	my ($self, $x, $y) = @_;
		731
		732	$x -= $self->{x};
		733	$y -= $self->{y};
		734
		735	my $res;
		736
		737	for (reverse $self->visible_children) {
		738	$res = $_->find_widget ($x, $y)
		739	and return $res;
		740	}
		741
		742	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
		743	}
		744
		745	sub _draw {
		746	my ($self) = @_;
		747
		748	$_->draw for @{$self->{children}};
		749	}
		750
		751	#############################################################################
		752
		753	package CFClient::UI::Bin;
		754
		755	our @ISA = CFClient::UI::Container::;
		756
		757	sub new {
		758	my ($class, %arg) = @_;
		759
		760	my $child = (delete $arg{child}) || new CFClient::UI::Empty::;
		761
		762	$class->SUPER::new (children => [$child], %arg)
490	}	763	}
491		764
492	sub add {	765	sub add {
493	my ($self, $child) = @_;	766	my ($self, $child) = @_;
494		767
495	$child->set_parent ($self);	768	$self->SUPER::remove ($_) for @{ $self->{children} };
496		769	$self->SUPER::add ($child);
497	use sort 'stable';
498
499	$self->{children} = [
500	sort { $a->{z} <=> $b->{z} }
501	@{$self->{children}}, $child
502	];
503
504	$child->check_size;
505	}	770	}
506		771
507	sub remove {	772	sub remove {
508	my ($self, $child) = @_;	773	my ($self, $widget) = @_;
509		774
510	delete $child->{parent};	775	$self->SUPER::remove ($widget);
511		776
512	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	777	$self->{children} = [new CFClient::UI::Empty]
		778	unless @{$self->{children}};
		779	}
513		780
514	$self->check_size;	781	sub child { $_[0]->{children}[0] }
		782
		783	sub size_request {
		784	$_[0]{children}[0]->size_request
		785	}
		786
		787	sub invoke_size_allocate {
		788	my ($self, $w, $h) = @_;
		789
		790	$self->{children}[0]->configure (0, 0, $w, $h);
		791
		792	1
		793	}
		794
		795	#############################################################################
		796
		797	# back-buffered drawing area
		798
		799	package CFClient::UI::Window;
		800
		801	our @ISA = CFClient::UI::Bin::;
		802
		803	use CFClient::OpenGL;
		804
		805	sub new {
		806	my ($class, %arg) = @_;
		807
		808	my $self = $class->SUPER::new (%arg);
		809	}
		810
		811	sub update {
		812	my ($self) = @_;
		813
		814	$ROOT->on_post_alloc ($self => sub { $self->render_child });
		815	$self->SUPER::update;
		816	}
		817
		818	sub invoke_size_allocate {
		819	my ($self, $w, $h) = @_;
		820
515	$self->update;	821	$self->update;
516	}
517		822
518	sub clear {	823	$self->SUPER::invoke_size_allocate ($w, $h)
		824	}
		825
		826	sub _render {
		827	my ($self) = @_;
		828
		829	$self->{children}[0]->draw;
		830	}
		831
		832	sub render_child {
		833	my ($self) = @_;
		834
		835	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
		836	glClearColor 0, 0, 0, 0;
		837	glClear GL_COLOR_BUFFER_BIT;
		838
		839	{
		840	package CFClient::UI::Base;
		841
		842	($draw_x, $draw_y, $draw_w, $draw_h) =
		843	(0, 0, $self->{w}, $self->{h});
		844	}
		845
		846	$self->_render;
		847	};
		848	}
		849
		850	sub _draw {
		851	my ($self) = @_;
		852
		853	my ($w, $h) = @$self{qw(w h)};
		854
		855	my $tex = $self->{texture}
		856	or return;
		857
		858	glEnable GL_TEXTURE_2D;
		859	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		860	glColor 0, 0, 0, 1;
		861
		862	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
		863
		864	glDisable GL_TEXTURE_2D;
		865	}
		866
		867	#############################################################################
		868
		869	package CFClient::UI::ViewPort;
		870
		871	our @ISA = CFClient::UI::Window::;
		872
		873	sub new {
		874	my $class = shift;
		875
		876	$class->SUPER::new (
		877	scroll_x => 0,
		878	scroll_y => 1,
		879	@_,
		880	)
		881	}
		882
		883	sub size_request {
		884	my ($self) = @_;
		885
		886	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
		887
		888	$w = 10 if $self->{scroll_x};
		889	$h = 10 if $self->{scroll_y};
		890
		891	($w, $h)
		892	}
		893
		894	sub invoke_size_allocate {
519	my ($self) = @_;	895	my ($self, $w, $h) = @_;
520		896
521	delete $_->{parent}	897	my $child = $self->child;
522	for @{ delete $self->{children} };
523		898
524	$self->{children} = [];	899	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
		900	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
		901
		902	$self->child->configure (0, 0, $w, $h);
		903	$self->update;
		904
		905	1
		906	}
		907
		908	sub set_offset {
		909	my ($self, $x, $y) = @_;
		910
		911	$self->{view_x} = int $x;
		912	$self->{view_y} = int $y;
		913
		914	$self->update;
		915	}
		916
		917	# hmm, this does not work for topleft of $self... but we should not ask for that
		918	sub coord2local {
		919	my ($self, $x, $y) = @_;
		920
		921	$self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
		922	}
		923
		924	sub coord2global {
		925	my ($self, $x, $y) = @_;
		926
		927	$x = List::Util::min $self->{w}, $x - $self->{view_x};
		928	$y = List::Util::min $self->{h}, $y - $self->{view_y};
		929
		930	$self->SUPER::coord2global ($x, $y)
525	}	931	}
526		932
527	sub find_widget {	933	sub find_widget {
528	my ($self, $x, $y) = @_;	934	my ($self, $x, $y) = @_;
529		935
530	$x -= $self->{x};	936	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
531	$y -= $self->{y};	937	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
532		938	) {
533	my $res;
534
535	for (reverse @{ $self->{children} }) {
536	$res = $_->find_widget ($x, $y)
537	and return $res;
538	}
539
540	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	939	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
		940	} else {
		941	$self->CFClient::UI::Base::find_widget ($x, $y)
		942	}
541	}	943	}
542		944
543	sub _draw {	945	sub _render {
544	my ($self) = @_;	946	my ($self) = @_;
545		947
546	$_->draw for @{$self->{children}};	948	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		949	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		950
		951	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
		952
		953	$self->SUPER::_render;
547	}	954	}
548		955
549	#############################################################################	956	#############################################################################
550		957
551	package CFClient::UI::Bin;	958	package CFClient::UI::ScrolledWindow;
552		959
553	our @ISA = CFClient::UI::Container::;	960	our @ISA = CFClient::UI::HBox::;
554		961
555	sub new {	962	sub new {
556	my ($class, %arg) = @_;	963	my ($class, %arg) = @_;
557		964
558	my $child = (delete $arg{child}) || new CFClient::UI::Empty::;	965	my $child = delete $arg{child};
559		966
560	$class->SUPER::new (children => [$child], %arg)	967	my $self;
		968
		969	my $slider = new CFClient::UI::Slider
		970	vertical => 1,
		971	range => [0, 0, 1, 0.01], # HACK fix
		972	on_changed => sub {
		973	$self->{vp}->set_offset (0, $_[1]);
		974	},
		975	;
		976
		977	$self = $class->SUPER::new (
		978	vp => (new CFClient::UI::ViewPort expand => 1),
		979	slider => $slider,
		980	%arg,
		981	);
		982
		983	$self->SUPER::add ($self->{vp}, $self->{slider});
		984	$self->add ($child) if $child;
		985
		986	$self
561	}	987	}
562		988
563	sub add {	989	sub add {
564	my ($self, $child) = @_;
565
566	$self->{children} = [];
567
568	$self->SUPER::add ($child);
569	}
570
571	sub remove {
572	my ($self, $widget) = @_;	990	my ($self, $widget) = @_;
573		991
574	$self->SUPER::remove ($widget);	992	$self->{vp}->add ($self->{child} = $widget);
575
576	$self->{children} = [new CFClient::UI::Empty]
577	unless @{$self->{children}};
578	}	993	}
579		994
580	sub child { $_[0]->{children}[0] }	995	sub update {
		996	my ($self) = @_;
581		997
582	sub size_request {	998	$self->SUPER::update;
583	$_[0]{children}[0]->size_request
584	}
585		999
		1000	# todo: overwrite size_allocate of child
		1001	my $child = $self->{vp}->child;
		1002	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		1003	}
		1004
586	sub size_allocate {	1005	sub invoke_size_allocate {
587	my ($self, $w, $h) = @_;	1006	my ($self, $w, $h) = @_;
588		1007
589	$self->{children}[0]->configure (0, 0, $w, $h);	1008	my $child = $self->{vp}->child;
		1009	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		1010
		1011	$self->SUPER::invoke_size_allocate ($w, $h)
590	}	1012	}
		1013
		1014	#TODO# update range on size_allocate depending on child
		1015	# update viewport offset on scroll
591		1016
592	#############################################################################	1017	#############################################################################
593		1018
594	package CFClient::UI::Window;	1019	package CFClient::UI::Frame;
595		1020
596	our @ISA = CFClient::UI::Bin::;	1021	our @ISA = CFClient::UI::Bin::;
597		1022
598	use CFClient::OpenGL;	1023	use CFClient::OpenGL;
		1024
		1025	sub new {
		1026	my $class = shift;
		1027
		1028	$class->SUPER::new (
		1029	bg => undef,
		1030	@_,
		1031	)
		1032	}
		1033
		1034	sub _draw {
		1035	my ($self) = @_;
		1036
		1037	if ($self->{bg}) {
		1038	my ($w, $h) = @$self{qw(w h)};
		1039
		1040	glEnable GL_BLEND;
		1041	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		1042	glColor_premultiply @{ $self->{bg} };
		1043
		1044	glBegin GL_QUADS;
		1045	glVertex 0 , 0;
		1046	glVertex 0 , $h;
		1047	glVertex $w, $h;
		1048	glVertex $w, 0;
		1049	glEnd;
		1050
		1051	glDisable GL_BLEND;
		1052	}
		1053
		1054	$self->SUPER::_draw;
		1055	}
		1056
		1057	#############################################################################
		1058
		1059	package CFClient::UI::FancyFrame;
		1060
		1061	our @ISA = CFClient::UI::Bin::;
		1062
		1063	use CFClient::OpenGL;
		1064
		1065	my $bg =
		1066	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1067	mipmap => 1, wrap => 1;
		1068
		1069	my @border =
		1070	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
		1071	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
599		1072
600	sub new {	1073	sub new {
601	my ($class, %arg) = @_;	1074	my ($class, %arg) = @_;
602		1075
603	my $self = $class->SUPER::new (%arg);
604	}
605
606	sub update {
607	my ($self) = @_;
608
609	# we want to do this delayed...
610	$self->render_chld;
611	$self->SUPER::update;
612	}
613
614	sub render_chld {
615	my ($self) = @_;
616
617	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
618	glClearColor 0, 0, 0, 1;
619	glClear GL_COLOR_BUFFER_BIT;
620	$self->child->draw;
621	};
622	}
623
624	sub size_allocate {
625	my ($self, $w, $h) = @_;
626
627	$self->child->configure (0, 0, $w, $h);
628
629	$self->render_chld;
630	}
631
632	sub _draw {
633	my ($self) = @_;
634
635	my ($w, $h) = ($self->w, $self->h);
636
637	my $tex = $self->{texture}
638	or return;
639
640	glEnable GL_BLEND;
641	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
642	glEnable GL_TEXTURE_2D;
643	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
644
645	$tex->draw_quad (0, 0, $w, $h);
646
647	glDisable GL_BLEND;
648	glDisable GL_TEXTURE_2D;
649	}
650
651	#############################################################################
652
653	package CFClient::UI::ViewPort;
654
655	our @ISA = CFClient::UI::Window::;
656
657	sub new { die }
658
659	sub size_request {
660	my ($self) = @_;
661
662	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
663	$self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
664
665	@$self{qw(child_w child_h)}
666	}
667
668	sub _draw {
669	my ($self) = @_;
670
671	$self->{children}[1]->draw;
672	}
673
674
675	#############################################################################
676
677	package CFClient::UI::Frame;
678
679	our @ISA = CFClient::UI::Bin::;
680
681	use CFClient::OpenGL;
682
683	sub new {
684	my $class = shift;
685
686	my $self = $class->SUPER::new (	1076	my $self = $class->SUPER::new (
687	bg => [1, 1, 1, 1],	1077	bg => [1, 1, 1, 1],
688	border_bg => [1, 1, 1, 1],	1078	border_bg => [1, 1, 1, 1],
689	border => 0.8,	1079	border => 0.6,
690	@_	1080	can_events => 1,
		1081	min_w => 16,
		1082	min_h => 16,
		1083	%arg,
691	);	1084	);
692		1085
693	$self
694	}
695
696	sub _draw {
697	my ($self) = @_;
698
699	my ($w, $h) = ($self->{w}, $self->{h});
700
701	glEnable GL_BLEND;
702	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
703	glEnable GL_TEXTURE_2D;
704	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
705
706	# glBegin GL_QUADS;
707	# glColor 0, 0, 0, 0;
708	# glVertex 0 , 0;
709	# glVertex 0 , $h;
710	# glVertex $w, $h;
711	# glVertex $w, 0;
712	# glEnd;
713
714
715	$self->child->draw;
716	glDisable GL_BLEND;
717	glDisable GL_TEXTURE_2D;
718	}
719
720	#############################################################################
721
722	package CFClient::UI::FancyFrame;
723
724	our @ISA = CFClient::UI::Bin::;
725
726	use CFClient::OpenGL;
727
728	my @tex =
729	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
730	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
731
732	sub new {
733	my $class = shift;
734
735	# TODO: user_x, user_y, overwrite moveto?
736
737	my $self = $class->SUPER::new (
738	bg => [1, 1, 1, 1],
739	border_bg => [1, 1, 1, 1],
740	border => 0.8,
741	can_events => 1,
742	@_
743	);
744
745	$self->{title} &&= new CFClient::UI::Label	1086	$self->{title_widget} = new CFClient::UI::Label
746	align => 0,	1087	align => 0,
747	valign => 1,	1088	valign => 1,
748	text => $self->{title},	1089	text => $self->{title},
749	fontsize => 1;	1090	fontsize => $self->{border},
		1091	if exists $self->{title};
		1092
		1093	if ($self->{has_close_button}) {
		1094	$self->{close_button} =
		1095	new CFClient::UI::ImageButton
		1096	path => 'x1_close.png',
		1097	on_activate => sub { $self->hide };
		1098
		1099	$self->CFClient::UI::Container::add ($self->{close_button});
		1100	}
750		1101
751	$self	1102	$self
		1103	}
		1104
		1105	sub add {
		1106	my ($self, @widgets) = @_;
		1107
		1108	$self->SUPER::add (@widgets);
		1109	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
		1110	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
752	}	1111	}
753		1112
754	sub border {	1113	sub border {
755	int $_[0]{border} * $::FONTSIZE	1114	int $_[0]{border} * $::FONTSIZE
756	}	1115	}
757		1116
758	sub size_request {	1117	sub size_request {
759	my ($self) = @_;	1118	my ($self) = @_;
		1119
		1120	$self->{title_widget}->size_request
		1121	if $self->{title_widget};
		1122
		1123	$self->{close_button}->size_request
		1124	if $self->{close_button};
760		1125
761	my ($w, $h) = $self->SUPER::size_request;	1126	my ($w, $h) = $self->SUPER::size_request;
762		1127
763	(	1128	(
764	$w + $self->border * 2,	1129	$w + $self->border * 2,
765	$h + $self->border * 2,	1130	$h + $self->border * 2,
766	)	1131	)
767	}	1132	}
768		1133
769	sub size_allocate {	1134	sub invoke_size_allocate {
770	my ($self, $w, $h) = @_;	1135	my ($self, $w, $h) = @_;
771		1136
		1137	if ($self->{title_widget}) {
		1138	$self->{title_widget}{w} = $w;
		1139	$self->{title_widget}{h} = $h;
		1140	$self->{title_widget}->invoke_size_allocate ($w, $h);
		1141	}
		1142
		1143	my $border = $self->border;
		1144
772	$h -= List::Util::max 0, $self->border * 2;	1145	$h -= List::Util::max 0, $border * 2;
773	$w -= List::Util::max 0, $self->border * 2;	1146	$w -= List::Util::max 0, $border * 2;
774		1147
775	$self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)
776	if $self->{title};
777
778	$self->child->configure ($self->border, $self->border, $w, $h);	1148	$self->child->configure ($border, $border, $w, $h);
779	}
780		1149
		1150	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1151	if $self->{close_button};
		1152
		1153	1
		1154	}
		1155
781	sub button_down {	1156	sub invoke_button_down {
782	my ($self, $ev, $x, $y) = @_;	1157	my ($self, $ev, $x, $y) = @_;
783		1158
		1159	my ($w, $h) = @$self{qw(w h)};
784	my $border = $self->border;	1160	my $border = $self->border;
785		1161
786	if ($x < $self->{w} && $x >= $self->{w} - $border	1162	my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
787	&& $y < $self->{h} && $y >= $self->{h} - $border) {	1163	my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
788		1164
		1165	if ($lr & $td) {
		1166	my ($wx, $wy) = ($self->{x}, $self->{y});
789	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1167	my ($ox, $oy) = ($ev->{x}, $ev->{y});
790	my ($bw, $bh) = ($self->{w}, $self->{h});	1168	my ($bw, $bh) = ($self->{w}, $self->{h});
791		1169
		1170	my $mx = $x < $border;
		1171	my $my = $y < $border;
		1172
792	$self->{motion} = sub {	1173	$self->{motion} = sub {
793	my ($ev, $x, $y) = @_;	1174	my ($ev, $x, $y) = @_;
794		1175
795	($x, $y) = ($ev->{x}, $ev->{y});	1176	my $dx = $ev->{x} - $ox;
		1177	my $dy = $ev->{y} - $oy;
796		1178
797	$self->{user_w} = $bw + $x - $ox;	1179	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
798	$self->{user_h} = $bh + $y - $oy;	1180	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
799	$self->check_size;	1181
		1182	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
		1183	$self->realloc;
800	};	1184	};
801		1185
802	} elsif ($x >= 0 && $x < $self->{w}	1186	} elsif ($lr ^ $td) {
803	&& $y >= 0 && $y < $border) {
804
805	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1187	my ($ox, $oy) = ($ev->{x}, $ev->{y});
806	my ($bx, $by) = ($self->{x}, $self->{y});	1188	my ($bx, $by) = ($self->{x}, $self->{y});
807		1189
808	$self->{motion} = sub {	1190	$self->{motion} = sub {
809	my ($ev, $x, $y) = @_;	1191	my ($ev, $x, $y) = @_;
810		1192
811	($x, $y) = ($ev->{x}, $ev->{y});	1193	($x, $y) = ($ev->{x}, $ev->{y});
812		1194
813	$self->move ($bx + $x - $ox, $by + $y - $oy);	1195	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
814	$self->update;	1196	# HACK: the next line is required to enforce placement
		1197	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
815	};	1198	};
		1199	} else {
		1200	return 0;
		1201	}
		1202
816	}	1203	1
817	}	1204	}
818		1205
819	sub button_up {	1206	sub invoke_button_up {
820	my ($self, $ev, $x, $y) = @_;	1207	my ($self, $ev, $x, $y) = @_;
821		1208
822	delete $self->{motion};	1209	! ! delete $self->{motion}
823	}	1210	}
824		1211
825	sub mouse_motion {	1212	sub invoke_mouse_motion {
826	my ($self, $ev, $x, $y) = @_;	1213	my ($self, $ev, $x, $y) = @_;
827		1214
828	$self->{motion}->($ev, $x, $y) if $self->{motion};	1215	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1216
		1217	! ! $self->{motion}
829	}	1218	}
830		1219
831	sub _draw {	1220	sub _draw {
832	my ($self) = @_;	1221	my ($self) = @_;
833		1222
		1223	my $child = $self->{children}[0];
		1224
834	my ($w, $h ) = ($self->{w}, $self->{h});	1225	my ($w, $h ) = ($self->{w}, $self->{h});
835	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1226	my ($cw, $ch) = ($child->{w}, $child->{h});
836		1227
837	glEnable GL_BLEND;
838	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
839	glEnable GL_TEXTURE_2D;	1228	glEnable GL_TEXTURE_2D;
840	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1229	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
841		1230
842	my $border = $self->border;	1231	my $border = $self->border;
843		1232
844	glColor @{ $self->{border_bg} };	1233	glColor @{ $self->{border_bg} };
845	$tex[1]->draw_quad (0, 0, $w, $border);	1234	$border[0]->draw_quad_alpha (0, 0, $w, $border);
846	$tex[3]->draw_quad (0, $border, $border, $ch);	1235	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
847	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	1236	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
848	$tex[4]->draw_quad (0, $h - $border, $w, $border);	1237	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
849		1238
850	my $bg = $tex[0];	1239	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
		1240	glColor @{ $self->{bg} };
851		1241
852	# TODO: repeat texture not scale	1242	# TODO: repeat texture not scale
853	my $rep_x = $cw / $bg->{w};	1243	# solve this better(?)
854	my $rep_y = $ch / $bg->{h};	1244	$bg->{s} = $cw / $bg->{w};
855		1245	$bg->{t} = $ch / $bg->{h};
856	glColor @{ $self->{bg} };
857
858	$bg->{s} = $rep_x;
859	$bg->{t} = $rep_y;
860	$bg->{wrap_mode} = 1;
861	$bg->draw_quad ($border, $border, $cw, $ch);	1246	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
		1247	}
862		1248
863	glDisable GL_TEXTURE_2D;	1249	glDisable GL_TEXTURE_2D;
864	glDisable GL_BLEND;
865		1250
866	$self->{title}->draw if $self->{title};
867	$self->child->draw;	1251	$child->draw;
		1252
		1253	if ($self->{title_widget}) {
		1254	glTranslate 0, $border - $self->{h};
		1255	$self->{title_widget}->_draw;
		1256
		1257	glTranslate 0, - ($border - $self->{h});
		1258	}
		1259
		1260	$self->{close_button}->draw
		1261	if $self->{close_button};
868	}	1262	}
869		1263
870	#############################################################################	1264	#############################################################################
871		1265
872	package CFClient::UI::Table;	1266	package CFClient::UI::Table;
…		…
880	sub new {	1274	sub new {
881	my $class = shift;	1275	my $class = shift;
882		1276
883	$class->SUPER::new (	1277	$class->SUPER::new (
884	col_expand => [],	1278	col_expand => [],
885	@_	1279	@_,
886	)	1280	)
		1281	}
		1282
		1283	sub children {
		1284	grep $_, map @$_, grep $_, @{ $_[0]{children} }
887	}	1285	}
888		1286
889	sub add {	1287	sub add {
890	my ($self, $x, $y, $child) = @_;	1288	my ($self, $x, $y, $child) = @_;
891		1289
892	$child->set_parent ($self);	1290	$child->set_parent ($self);
893	$self->{children}[$y][$x] = $child;	1291	$self->{children}[$y][$x] = $child;
894		1292
895	$child->check_size;	1293	$self->realloc;
896	}	1294	}
897		1295
		1296	sub remove {
		1297	my ($self, $child) = @_;
		1298
		1299	# TODO: not yet implemented
		1300	}
		1301
898	# TODO: move to container class maybe? send childs a signal on removal?	1302	# TODO: move to container class maybe? send children a signal on removal?
899	sub clear {	1303	sub clear {
900	my ($self) = @_;	1304	my ($self) = @_;
901		1305
		1306	my @children = $self->children;
902	delete $self->{children};	1307	delete $self->{children};
903	$self->update;	1308
		1309	for (@children) {
		1310	delete $_->{parent};
		1311	$_->hide;
		1312	}
		1313
		1314	$self->realloc;
904	}	1315	}
905		1316
906	sub get_wh {	1317	sub get_wh {
907	my ($self) = @_;	1318	my ($self) = @_;
908		1319
…		…
934	(sum @$ws),	1345	(sum @$ws),
935	(sum @$hs),	1346	(sum @$hs),
936	)	1347	)
937	}	1348	}
938		1349
939	sub size_allocate {	1350	sub invoke_size_allocate {
940	my ($self, $w, $h) = @_;	1351	my ($self, $w, $h) = @_;
941		1352
942	my ($ws, $hs) = $self->get_wh;	1353	my ($ws, $hs) = $self->get_wh;
943		1354
944	my $req_w = sum @$ws;	1355	my $req_w = (sum @$ws) || 1;
945	my $req_h = sum @$hs;	1356	my $req_h = (sum @$hs) || 1;
946		1357
947	# TODO: nicer code && do row_expand	1358	# TODO: nicer code && do row_expand
948	my @col_expand = @{$self->{col_expand}};	1359	my @col_expand = @{$self->{col_expand}};
949	@col_expand = (1) x @$ws unless @col_expand;	1360	@col_expand = (1) x @$ws unless @col_expand;
950	my $col_expand = (sum @col_expand) || 1;	1361	my $col_expand = (sum @col_expand) || 1;
…		…
976	}	1387	}
977		1388
978	$y += $row_h;	1389	$y += $row_h;
979	}	1390	}
980		1391
		1392	1
981	}	1393	}
982		1394
983	sub find_widget {	1395	sub find_widget {
984	my ($self, $x, $y) = @_;	1396	my ($self, $x, $y) = @_;
985		1397
…		…
1004	}	1416	}
1005	}	1417	}
1006		1418
1007	#############################################################################	1419	#############################################################################
1008		1420
		1421	package CFClient::UI::Box;
		1422
		1423	our @ISA = CFClient::UI::Container::;
		1424
		1425	sub size_request {
		1426	my ($self) = @_;
		1427
		1428	$self->{vertical}
		1429	? (
		1430	(List::Util::max map $_->{req_w}, @{$self->{children}}),
		1431	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
		1432	)
		1433	: (
		1434	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1435	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1436	)
		1437	}
		1438
		1439	sub invoke_size_allocate {
		1440	my ($self, $w, $h) = @_;
		1441
		1442	my $space = $self->{vertical} ? $h : $w;
		1443	my @children = $self->visible_children;
		1444
		1445	my @req;
		1446
		1447	if ($self->{homogeneous}) {
		1448	@req = ($space / (@children || 1)) x @children;
		1449	} else {
		1450	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
		1451	my $req = List::Util::sum @req;
		1452
		1453	if ($req > $space) {
		1454	# ah well, not enough space
		1455	$_ *= $space / $req for @req;
		1456	} else {
		1457	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
		1458
		1459	$space = ($space - $req) / $expand; # remaining space to give away
		1460
		1461	$req[$_] += $space * $children[$_]{expand}
		1462	for 0 .. $#children;
		1463	}
		1464	}
		1465
		1466	CFClient::UI::harmonize \@req;
		1467
		1468	my $pos = 0;
		1469	for (0 .. $#children) {
		1470	my $alloc = $req[$_];
		1471	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
		1472
		1473	$pos += $alloc;
		1474	}
		1475
		1476	1
		1477	}
		1478
		1479	#############################################################################
		1480
1009	package CFClient::UI::HBox;	1481	package CFClient::UI::HBox;
1010		1482
1011	# TODO: wrap into common Box base class
1012
1013	our @ISA = CFClient::UI::Container::;	1483	our @ISA = CFClient::UI::Box::;
1014		1484
1015	sub size_request {	1485	sub new {
1016	my ($self) = @_;	1486	my $class = shift;
1017		1487
1018	my @alloc = map [$_->size_request], @{$self->{children}};	1488	$class->SUPER::new (
1019		1489	vertical => 0,
1020	(	1490	@_,
1021	(List::Util::sum map $_->[0], @alloc),
1022	(List::Util::max map $_->[1], @alloc),
1023	)	1491	)
1024	}	1492	}
1025		1493
1026	sub size_allocate {
1027	my ($self, $w, $h) = @_;
1028
1029	($h, $w) = ($w, $h);
1030
1031	my $children = $self->{children};
1032
1033	my @h = map $_->{req_w}, @$children;
1034
1035	my $req_h = List::Util::sum @h;
1036
1037	if ($req_h > $h) {
1038	# ah well, not enough space
1039	$_ *= $h / $req_h for @h;
1040	} else {
1041	my $exp = List::Util::sum map $_->{expand}, @$children;
1042	$exp ||= 1;
1043
1044	for (0 .. $#$children) {
1045	my $child = $children->[$_];
1046
1047	my $alloc_h = $h[$_];
1048	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1049	$h[$_] = $alloc_h;
1050	}
1051	}
1052
1053	CFClient::UI::harmonize \@h;
1054
1055	my $y = 0;
1056	for (0 .. $#$children) {
1057	my $child = $children->[$_];
1058	my $h = $h[$_];
1059	$child->configure ($y, 0, $h, $w);
1060
1061	$y += $h;
1062	}
1063
1064	1
1065	}
1066
1067	#############################################################################	1494	#############################################################################
1068		1495
1069	package CFClient::UI::VBox;	1496	package CFClient::UI::VBox;
1070		1497
1071	# TODO: wrap into common Box base class
1072
1073	our @ISA = CFClient::UI::Container::;	1498	our @ISA = CFClient::UI::Box::;
1074		1499
1075	sub size_request {	1500	sub new {
1076	my ($self) = @_;	1501	my $class = shift;
1077		1502
1078	my @alloc = map [$_->size_request], @{$self->{children}};	1503	$class->SUPER::new (
1079		1504	vertical => 1,
1080	(	1505	@_,
1081	(List::Util::max map $_->[0], @alloc),
1082	(List::Util::sum map $_->[1], @alloc),
1083	)	1506	)
1084	}	1507	}
1085		1508
1086	sub size_allocate {
1087	my ($self, $w, $h) = @_;
1088
1089	my $children = $self->{children};
1090
1091	my @h = map $_->{req_h}, @$children;
1092
1093	my $req_h = List::Util::sum @h;
1094
1095	if ($req_h > $h) {
1096	# ah well, not enough space
1097	$_ *= $h / $req_h for @h;
1098	} else {
1099	my $exp = List::Util::sum map $_->{expand}, @$children;
1100	$exp ||= 1;
1101
1102	for (0 .. $#$children) {
1103	my $child = $children->[$_];
1104
1105	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1106	}
1107	}
1108
1109	CFClient::UI::harmonize \@h;
1110
1111	my $y = 0;
1112	for (0 .. $#$children) {
1113	my $child = $children->[$_];
1114	my $h = $h[$_];
1115	$child->configure (0, $y, $w, $h);
1116
1117	$y += $h;
1118	}
1119
1120	1
1121	}
1122
1123	#############################################################################	1509	#############################################################################
1124		1510
1125	package CFClient::UI::Label;	1511	package CFClient::UI::Label;
1126		1512
1127	our @ISA = CFClient::UI::Base::;	1513	our @ISA = CFClient::UI::DrawBG::;
1128		1514
1129	use CFClient::OpenGL;	1515	use CFClient::OpenGL;
1130		1516
1131	sub new {	1517	sub new {
1132	my ($class, %arg) = @_;	1518	my ($class, %arg) = @_;
1133		1519
1134	my $self = $class->SUPER::new (	1520	my $self = $class->SUPER::new (
1135	fg => [1, 1, 1],	1521	fg => [1, 1, 1],
		1522	#bg => none
		1523	#active_bg => none
1136	#font => default_font	1524	#font => default_font
		1525	#text => initial text
		1526	#markup => initial narkup
		1527	#max_w => maximum pixel width
		1528	ellipsise => 3, # end
		1529	layout => (new CFClient::Layout),
1137	fontsize => 1,	1530	fontsize => 1,
1138	text => "",
1139	align => -1,	1531	align => -1,
1140	valign => -1,	1532	valign => -1,
1141	padding => 2,	1533	padding_x => 2,
1142	layout => new CFClient::Layout,	1534	padding_y => 2,
1143	can_events => 0,	1535	can_events => 0,
1144	%arg	1536	%arg
1145	);	1537	);
1146		1538
1147	if (exists $self->{template}) {	1539	if (exists $self->{template}) {
1148	my $layout = new CFClient::Layout;	1540	my $layout = new CFClient::Layout;
1149	$layout->set_text (delete $self->{template});	1541	$layout->set_text (delete $self->{template});
1150	$self->{template} = $layout;	1542	$self->{template} = $layout;
1151	}	1543	}
1152		1544
1153	$self->set_text (delete $self->{text}) if exists $self->{text};	1545	if (exists $self->{markup}) {
1154	$self->set_markup (delete $self->{markup}) if exists $self->{markup};	1546	$self->set_markup (delete $self->{markup});
		1547	} else {
		1548	$self->set_text (delete $self->{text});
		1549	}
1155		1550
1156	$self	1551	$self
1157	}	1552	}
1158		1553
1159	sub escape {	1554	sub escape($) {
1160	local $_ = $_[1];	1555	local $_ = $_[0];
1161		1556
1162	s/&/&amp;/g;	1557	s/&/&amp;/g;
1163	s/>/&gt;/g;	1558	s/>/&gt;/g;
1164	s/</&lt;/g;	1559	s/</&lt;/g;
1165		1560
1166	$_[1]	1561	$_
		1562	}
		1563
		1564	sub update {
		1565	my ($self) = @_;
		1566
		1567	delete $self->{texture};
		1568	$self->SUPER::update;
		1569	}
		1570
		1571	sub realloc {
		1572	my ($self) = @_;
		1573
		1574	delete $self->{ox};
		1575	$self->SUPER::realloc;
1167	}	1576	}
1168		1577
1169	sub set_text {	1578	sub set_text {
1170	my ($self, $text) = @_;	1579	my ($self, $text) = @_;
1171		1580
		1581	return if $self->{text} eq "T$text";
		1582	$self->{text} = "T$text";
		1583
		1584	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1172	$self->{layout}->set_text ($text);	1585	$self->{layout}->set_text ($text);
1173		1586
1174	delete $self->{texture};	1587	delete $self->{size_req};
1175	$self->check_size;	1588	$self->realloc;
1176	$self->update;	1589	$self->update;
1177	}	1590	}
1178		1591
1179	sub set_markup {	1592	sub set_markup {
1180	my ($self, $markup) = @_;	1593	my ($self, $markup) = @_;
1181		1594
		1595	return if $self->{text} eq "M$markup";
		1596	$self->{text} = "M$markup";
		1597
		1598	my $rgba = $markup =~ /span.*(?:foreground|background)/;
		1599
		1600	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1182	$self->{layout}->set_markup ($markup);	1601	$self->{layout}->set_markup ($markup);
1183		1602
1184	delete $self->{texture};	1603	delete $self->{size_req};
1185	$self->check_size;	1604	$self->realloc;
1186	$self->update;	1605	$self->update;
1187	}	1606	}
1188		1607
1189	sub size_request {	1608	sub size_request {
1190	my ($self) = @_;	1609	my ($self) = @_;
1191		1610
		1611	$self->{size_req} ||= do {
1192	$self->{layout}->set_font ($self->{font}) if $self->{font};	1612	$self->{layout}->set_font ($self->{font}) if $self->{font};
1193	$self->{layout}->set_width ($self->{max_w} || -1);	1613	$self->{layout}->set_width ($self->{max_w} || -1);
		1614	$self->{layout}->set_ellipsise ($self->{ellipsise});
		1615	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1194	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1616	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1195		1617
1196	my ($w, $h) = $self->{layout}->size;	1618	my ($w, $h) = $self->{layout}->size;
1197		1619
1198	if (exists $self->{template}) {	1620	if (exists $self->{template}) {
1199	$self->{template}->set_font ($self->{font}) if $self->{font};	1621	$self->{template}->set_font ($self->{font}) if $self->{font};
1200	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1622	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1201		1623
1202	my ($w2, $h2) = $self->{template}->size;	1624	my ($w2, $h2) = $self->{template}->size;
1203		1625
1204	$w = List::Util::max $w, $w2;	1626	$w = List::Util::max $w, $w2;
1205	$h = List::Util::max $h, $h2;	1627	$h = List::Util::max $h, $h2;
		1628	}
		1629
		1630	[$w, $h]
1206	}	1631	};
1207		1632
1208	(	1633	@{ $self->{size_req} }
1209	$w + $self->{padding} * 2,
1210	$h + $self->{padding} * 2,
1211	)
1212	}	1634	}
1213		1635
1214	sub size_allocate {	1636	sub invoke_size_allocate {
1215	my ($self, $w, $h) = @_;	1637	my ($self, $w, $h) = @_;
1216		1638
		1639	delete $self->{ox};
		1640
1217	delete $self->{texture};	1641	delete $self->{texture}
		1642	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1643
		1644	1
1218	}	1645	}
1219		1646
1220	sub set_fontsize {	1647	sub set_fontsize {
1221	my ($self, $fontsize) = @_;	1648	my ($self, $fontsize) = @_;
1222		1649
1223	$self->{fontsize} = $fontsize;	1650	$self->{fontsize} = $fontsize;
1224	delete $self->{texture};	1651	delete $self->{texture};
1225	$self->check_size;	1652
1226	$self->update;	1653	$self->realloc;
		1654	}
		1655
		1656	sub reconfigure {
		1657	my ($self) = @_;
		1658
		1659	delete $self->{size_req};
		1660
		1661	$self->SUPER::reconfigure;
1227	}	1662	}
1228		1663
1229	sub _draw {	1664	sub _draw {
1230	my ($self) = @_;	1665	my ($self) = @_;
1231		1666
		1667	$self->SUPER::_draw; # draw background, if applicable
		1668
1232	my $tex = $self->{texture} ||= do {	1669	my $tex = $self->{texture} ||= do {
		1670	$self->{layout}->set_foreground (@{$self->{fg}});
1233	$self->{layout}->set_font ($self->{font}) if $self->{font};	1671	$self->{layout}->set_font ($self->{font}) if $self->{font};
1234	$self->{layout}->set_width ($self->{w});	1672	$self->{layout}->set_width ($self->{w});
		1673	$self->{layout}->set_ellipsise ($self->{ellipsise});
		1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1235	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);	1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
		1676
1236	new_from_layout CFClient::Texture $self->{layout}	1677	new_from_layout CFClient::Texture $self->{layout}
1237	};	1678	};
1238		1679
1239	glEnable GL_BLEND;	1680	unless (exists $self->{ox}) {
1240	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
		1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
		1683	: ($self->{w} - $tex->{w}) * 0.5);
		1684
		1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
		1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
		1687	: ($self->{h} - $tex->{h}) * 0.5);
		1688	};
		1689
1241	glEnable GL_TEXTURE_2D;	1690	glEnable GL_TEXTURE_2D;
		1691
		1692	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1693	my $h = List::Util::min $self->{h} + 2, $tex->{h};
		1694
		1695	if ($tex->{format} == GL_ALPHA) {
		1696	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
		1697	glColor @{$self->{fg}};
		1698	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
		1699	} else {
1242	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1700	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1243		1701	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1244	glColor @{$self->{fg}};	1702	}
1245
1246	$self->{ox} = int (
1247	$self->{align} < 0 ? $self->{padding}
1248	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1249	: ($self->{w} - $tex->{w}) * 0.5
1250	);
1251
1252	$self->{oy} = int (
1253	$self->{valign} < 0 ? $self->{padding}
1254	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1255	: ($self->{h} - $tex->{h}) * 0.5
1256	);
1257
1258	$tex->draw_quad ($self->{ox}, $self->{oy});
1259		1703
1260	glDisable GL_TEXTURE_2D;	1704	glDisable GL_TEXTURE_2D;
1261	glDisable GL_BLEND;
1262	}	1705	}
1263		1706
1264	#############################################################################	1707	#############################################################################
1265		1708
1266	package CFClient::UI::EntryBase;	1709	package CFClient::UI::EntryBase;
…		…
1271		1714
1272	sub new {	1715	sub new {
1273	my $class = shift;	1716	my $class = shift;
1274		1717
1275	$class->SUPER::new (	1718	$class->SUPER::new (
1276	fg => [1, 1, 1],	1719	fg => [1, 1, 1],
1277	bg => [0, 0, 0, 0.2],	1720	bg => [0, 0, 0, 0.2],
1278	active_bg => [1, 1, 1, 0.5],	1721	active_bg => [1, 1, 1, 0.5],
1279	active_fg => [0, 0, 0],	1722	active_fg => [0, 0, 0],
1280	can_hover => 1,	1723	can_hover => 1,
1281	can_focus => 1,	1724	can_focus => 1,
1282	valign => 0,	1725	valign => 0,
1283	can_events => 1,	1726	can_events => 1,
		1727	#text => ...
		1728	#hidden => "*",
1284	@_	1729	@_
1285	)	1730	)
1286	}	1731	}
1287		1732
1288	sub _set_text {	1733	sub _set_text {
…		…
1290		1735
1291	delete $self->{cur_h};	1736	delete $self->{cur_h};
1292		1737
1293	return if $self->{text} eq $text;	1738	return if $self->{text} eq $text;
1294		1739
1295	delete $self->{texture};
1296
1297	$self->{last_activity} = $::NOW;	1740	$self->{last_activity} = $::NOW;
1298	$self->{text} = $text;	1741	$self->{text} = $text;
1299		1742
1300	$text =~ s/./*/g if $self->{hidden};	1743	$text =~ s/./*/g if $self->{hidden};
1301	$self->{layout}->set_text ("$text ");	1744	$self->{layout}->set_text ("$text ");
		1745	delete $self->{size_req};
1302		1746
1303	$self->emit (changed => $self->{text});	1747	$self->emit (changed => $self->{text});
		1748
		1749	$self->realloc;
		1750	$self->update;
		1751	}
		1752
		1753	sub set_text {
		1754	my ($self, $text) = @_;
		1755
		1756	$self->{cursor} = length $text;
		1757	$self->_set_text ($text);
1304	}	1758	}
1305		1759
1306	sub get_text {	1760	sub get_text {
1307	$_[0]{text}	1761	$_[0]{text}
1308	}	1762	}
…		…
1313	my ($w, $h) = $self->SUPER::size_request;	1767	my ($w, $h) = $self->SUPER::size_request;
1314		1768
1315	($w + 1, $h) # add 1 for cursor	1769	($w + 1, $h) # add 1 for cursor
1316	}	1770	}
1317		1771
1318	sub size_allocate {
1319	my ($self, $w, $h) = @_;
1320
1321	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1322	}
1323
1324	sub set_text {
1325	my ($self, $text) = @_;
1326
1327	$self->{cursor} = length $text;
1328	$self->_set_text ($text);
1329	$self->update;
1330	}
1331
1332	sub key_down {	1772	sub invoke_key_down {
1333	my ($self, $ev) = @_;	1773	my ($self, $ev) = @_;
1334		1774
1335	my $mod = $ev->{mod};	1775	my $mod = $ev->{mod};
1336	my $sym = $ev->{sym};	1776	my $sym = $ev->{sym};
1337	my $uni = $ev->{unicode};	1777	my $uni = $ev->{unicode};
1338		1778
1339	my $text = $self->get_text;	1779	my $text = $self->get_text;
1340		1780
1341	if ($sym == 8) {	1781	if ($uni == 8) {
1342	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1782	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1343	} elsif ($sym == 127) {	1783	} elsif ($uni == 127) {
1344	substr $text, $self->{cursor}, 1, "";	1784	substr $text, $self->{cursor}, 1, "";
1345	} elsif ($sym == CFClient::SDLK_LEFT) {	1785	} elsif ($sym == CFClient::SDLK_LEFT) {
1346	--$self->{cursor} if $self->{cursor};	1786	--$self->{cursor} if $self->{cursor};
1347	} elsif ($sym == CFClient::SDLK_RIGHT) {	1787	} elsif ($sym == CFClient::SDLK_RIGHT) {
1348	++$self->{cursor} if $self->{cursor} < length $self->{text};	1788	++$self->{cursor} if $self->{cursor} < length $self->{text};
1349	} elsif ($sym == CFClient::SDLK_HOME) {	1789	} elsif ($sym == CFClient::SDLK_HOME) {
1350	$self->{cursor} = 0;	1790	$self->{cursor} = 0;
1351	} elsif ($sym == CFClient::SDLK_END) {	1791	} elsif ($sym == CFClient::SDLK_END) {
1352	$self->{cursor} = length $text;	1792	$self->{cursor} = length $text;
1353	} elsif ($sym == 27) {	1793	} elsif ($uni == 27) {
1354	$self->emit ('escape');	1794	$self->emit ('escape');
1355	} elsif ($uni) {	1795	} elsif ($uni) {
1356	substr $text, $self->{cursor}++, 0, chr $uni;	1796	substr $text, $self->{cursor}++, 0, chr $uni;
		1797	} else {
		1798	return 0;
1357	}	1799	}
1358		1800
1359	$self->_set_text ($text);	1801	$self->_set_text ($text);
1360	$self->update;
1361	}
1362		1802
		1803	$self->realloc;
		1804
		1805	1
		1806	}
		1807
1363	sub focus_in {	1808	sub invoke_focus_in {
1364	my ($self) = @_;	1809	my ($self) = @_;
1365		1810
1366	$self->{last_activity} = $::NOW;	1811	$self->{last_activity} = $::NOW;
1367		1812
1368	$self->SUPER::focus_in;	1813	$self->SUPER::invoke_focus_in
1369	}	1814	}
1370		1815
1371	sub button_down {	1816	sub invoke_button_down {
1372	my ($self, $ev, $x, $y) = @_;	1817	my ($self, $ev, $x, $y) = @_;
1373		1818
1374	$self->SUPER::button_down ($ev, $x, $y);	1819	$self->SUPER::invoke_button_down ($ev, $x, $y);
1375		1820
1376	my $idx = $self->{layout}->xy_to_index ($x, $y);	1821	my $idx = $self->{layout}->xy_to_index ($x, $y);
1377		1822
1378	# byte-index to char-index	1823	# byte-index to char-index
1379	my $text = $self->{text};	1824	my $text = $self->{text};
1380	utf8::encode $text;	1825	utf8::encode $text;
1381	$self->{cursor} = length substr $text, 0, $idx;	1826	$self->{cursor} = length substr $text, 0, $idx;
1382		1827
1383	$self->_set_text ($self->{text});	1828	$self->_set_text ($self->{text});
1384	$self->update;	1829	$self->update;
		1830
		1831	1
1385	}	1832	}
1386		1833
1387	sub mouse_motion {	1834	sub invoke_mouse_motion {
1388	my ($self, $ev, $x, $y) = @_;	1835	my ($self, $ev, $x, $y) = @_;
1389	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1836	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1837
		1838	1
1390	}	1839	}
1391		1840
1392	sub _draw {	1841	sub _draw {
1393	my ($self) = @_;	1842	my ($self) = @_;
1394		1843
1395	local $self->{fg} = $self->{fg};	1844	local $self->{fg} = $self->{fg};
1396		1845
1397	if ($FOCUS == $self) {	1846	if ($FOCUS == $self) {
1398	glColor @{$self->{active_bg}};	1847	glColor_premultiply @{$self->{active_bg}};
1399	$self->{fg} = $self->{active_fg};	1848	$self->{fg} = $self->{active_fg};
1400	} else {	1849	} else {
1401	glColor @{$self->{bg}};	1850	glColor_premultiply @{$self->{bg}};
1402	}	1851	}
1403		1852
1404	glEnable GL_BLEND;	1853	glEnable GL_BLEND;
1405	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1854	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1406	glBegin GL_QUADS;	1855	glBegin GL_QUADS;
1407	glVertex 0 , 0;	1856	glVertex 0 , 0;
1408	glVertex 0 , $self->{h};	1857	glVertex 0 , $self->{h};
1409	glVertex $self->{w}, $self->{h};	1858	glVertex $self->{w}, $self->{h};
1410	glVertex $self->{w}, 0;	1859	glVertex $self->{w}, 0;
…		…
1435		1884
1436	our @ISA = CFClient::UI::EntryBase::;	1885	our @ISA = CFClient::UI::EntryBase::;
1437		1886
1438	use CFClient::OpenGL;	1887	use CFClient::OpenGL;
1439		1888
1440	sub key_down {	1889	sub invoke_key_down {
1441	my ($self, $ev) = @_;	1890	my ($self, $ev) = @_;
1442		1891
1443	my $sym = $ev->{sym};	1892	my $sym = $ev->{sym};
1444		1893
1445	if ($sym == 13) {	1894	if ($sym == 13) {
		1895	unshift @{$self->{history}},
		1896	my $txt = $self->get_text;
		1897
		1898	$self->{history_pointer} = -1;
		1899	$self->{history_saveback} = '';
1446	$self->emit (activate => $self->get_text);	1900	$self->emit (activate => $txt);
1447	$self->update;	1901	$self->update;
1448		1902
		1903	} elsif ($sym == CFClient::SDLK_UP) {
		1904	if ($self->{history_pointer} < 0) {
		1905	$self->{history_saveback} = $self->get_text;
		1906	}
		1907	if (@{$self->{history} || []} > 0) {
		1908	$self->{history_pointer}++;
		1909	if ($self->{history_pointer} >= @{$self->{history} || []}) {
		1910	$self->{history_pointer} = @{$self->{history} || []} - 1;
		1911	}
		1912	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1913	}
		1914
		1915	} elsif ($sym == CFClient::SDLK_DOWN) {
		1916	$self->{history_pointer}--;
		1917	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
		1918
		1919	if ($self->{history_pointer} >= 0) {
		1920	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1921	} else {
		1922	$self->set_text ($self->{history_saveback});
		1923	}
		1924
1449	} else {	1925	} else {
1450	$self->SUPER::key_down ($ev);	1926	return $self->SUPER::invoke_key_down ($ev)
		1927	}
		1928
1451	}	1929	1
1452
1453	}	1930	}
1454		1931
1455	#############################################################################	1932	#############################################################################
1456		1933
1457	package CFClient::UI::Button;	1934	package CFClient::UI::Button;
…		…
1466		1943
1467	sub new {	1944	sub new {
1468	my $class = shift;	1945	my $class = shift;
1469		1946
1470	$class->SUPER::new (	1947	$class->SUPER::new (
1471	padding => 4,	1948	padding_x => 4,
		1949	padding_y => 4,
1472	fg => [1, 1, 1],	1950	fg => [1, 1, 1],
1473	bg => [1, 1, 1, 0.2],
1474	active_fg => [0, 0, 1],	1951	active_fg => [0, 0, 1],
1475	can_hover => 1,	1952	can_hover => 1,
1476	align => 0,	1953	align => 0,
1477	valign => 0,	1954	valign => 0,
1478	can_events => 1,	1955	can_events => 1,
1479	@_	1956	@_
1480	)	1957	)
1481	}	1958	}
1482		1959
1483	sub button_up {	1960	sub invoke_button_up {
1484	my ($self, $ev, $x, $y) = @_;	1961	my ($self, $ev, $x, $y) = @_;
1485		1962
		1963	$self->emit ("activate")
1486	if ($x >= 0 && $x < $self->{w}	1964	if $x >= 0 && $x < $self->{w}
1487	&& $y >= 0 && $y < $self->{h}) {	1965	&& $y >= 0 && $y < $self->{h};
1488	$self->emit ("activate");	1966
1489	}	1967	1
1490	}	1968	}
1491		1969
1492	sub _draw {	1970	sub _draw {
1493	my ($self) = @_;	1971	my ($self) = @_;
1494		1972
1495	local $self->{fg} = $self->{fg};	1973	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1496		1974
1497	if ($GRAB == $self) {
1498	$self->{fg} = $self->{active_fg};
1499	}
1500
1501	glEnable GL_BLEND;
1502	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1503	glEnable GL_TEXTURE_2D;	1975	glEnable GL_TEXTURE_2D;
1504	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1976	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1505	glColor 0, 0, 0, 1;	1977	glColor 0, 0, 0, 1;
1506		1978
1507	$tex[0]->draw_quad (0, 0, $self->{w}, $self->{h});	1979	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1508		1980
1509	glDisable GL_TEXTURE_2D;	1981	glDisable GL_TEXTURE_2D;
1510	glDisable GL_BLEND;
1511		1982
1512	$self->SUPER::_draw;	1983	$self->SUPER::_draw;
		1984	}
		1985
		1986	#############################################################################
		1987
		1988	package CFClient::UI::ImageButton;
		1989
		1990	our @ISA = CFClient::UI::Image::;
		1991
		1992	use CFClient::OpenGL;
		1993
		1994	my %textures;
		1995
		1996	sub new {
		1997	my $class = shift;
		1998
		1999	my $self = $class->SUPER::new (
		2000	padding_x => 4,
		2001	padding_y => 4,
		2002	fg => [1, 1, 1],
		2003	active_fg => [0, 0, 1],
		2004	can_hover => 1,
		2005	align => 0,
		2006	valign => 0,
		2007	can_events => 1,
		2008	@_
		2009	);
		2010	}
		2011
		2012	sub invoke_button_up {
		2013	my ($self, $ev, $x, $y) = @_;
		2014
		2015	$self->emit ("activate")
		2016	if $x >= 0 && $x < $self->{w}
		2017	&& $y >= 0 && $y < $self->{h};
		2018
		2019	1
1513	}	2020	}
1514		2021
1515	#############################################################################	2022	#############################################################################
1516		2023
1517	package CFClient::UI::CheckBox;	2024	package CFClient::UI::CheckBox;
…		…
1526		2033
1527	sub new {	2034	sub new {
1528	my $class = shift;	2035	my $class = shift;
1529		2036
1530	$class->SUPER::new (	2037	$class->SUPER::new (
1531	padding => 2,	2038	padding_x => 2,
		2039	padding_y => 2,
1532	fg => [1, 1, 1],	2040	fg => [1, 1, 1],
1533	active_fg => [1, 1, 0],	2041	active_fg => [1, 1, 0],
		2042	bg => [0, 0, 0, 0.2],
		2043	active_bg => [1, 1, 1, 0.5],
1534	state => 0,	2044	state => 0,
1535	can_hover => 1,	2045	can_hover => 1,
1536	@_	2046	@_
1537	)	2047	)
1538	}	2048	}
1539		2049
1540	sub size_request {	2050	sub size_request {
1541	my ($self) = @_;	2051	my ($self) = @_;
1542		2052
1543	($self->{padding} * 2 + 6) x 2	2053	(6) x 2
1544	}	2054	}
1545		2055
1546	sub button_down {	2056	sub invoke_button_down {
1547	my ($self, $ev, $x, $y) = @_;	2057	my ($self, $ev, $x, $y) = @_;
1548		2058
1549	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	2059	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1550	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	2060	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1551	$self->{state} = !$self->{state};	2061	$self->{state} = !$self->{state};
1552	$self->emit (changed => $self->{state});	2062	$self->emit (changed => $self->{state});
		2063	} else {
		2064	return 0
		2065	}
		2066
1553	}	2067	1
1554	}	2068	}
1555		2069
1556	sub _draw {	2070	sub _draw {
1557	my ($self) = @_;	2071	my ($self) = @_;
1558		2072
1559	$self->SUPER::_draw;	2073	$self->SUPER::_draw;
1560		2074
1561	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2075	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1562		2076
1563	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	2077	my ($w, $h) = @$self{qw(w h)};
		2078
		2079	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1564		2080
1565	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2081	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1566		2082
1567	glEnable GL_BLEND;	2083	my $tex = $self->{state} ? $tex[1] : $tex[0];
		2084
1568	glEnable GL_TEXTURE_2D;	2085	glEnable GL_TEXTURE_2D;
1569	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1570
1571	my $tex = $self->{state} ? $tex[1] : $tex[0];
1572
1573	$tex->draw_quad (0, 0, $s, $s);	2086	$tex->draw_quad_alpha (0, 0, $s, $s);
1574
1575	glDisable GL_TEXTURE_2D;	2087	glDisable GL_TEXTURE_2D;
1576	glDisable GL_BLEND;
1577	}	2088	}
1578		2089
1579	#############################################################################	2090	#############################################################################
1580		2091
1581	package CFClient::UI::Image;	2092	package CFClient::UI::Image;
1582		2093
1583	our @ISA = CFClient::UI::Base::;	2094	our @ISA = CFClient::UI::Base::;
1584		2095
1585	use CFClient::OpenGL;	2096	use CFClient::OpenGL;
1586	use Carp qw/confess/;
1587		2097
1588	our %loaded_images;	2098	our %texture_cache;
1589		2099
1590	sub new {	2100	sub new {
1591	my $class = shift;	2101	my $class = shift;
1592		2102
1593	my $self = $class->SUPER::new (can_events => 0, @_);	2103	my $self = $class->SUPER::new (
		2104	can_events => 0,
		2105	@_,
		2106	);
1594		2107
1595	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2108	$self->{path}
		2109	or Carp::croak "required attribute 'path' not set";
1596		2110
1597	$loaded_images{$self->{image}} ||=	2111	$self->{tex} = $texture_cache{$self->{path}} ||=
1598	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2112	new_from_file CFClient::Texture CFClient::find_rcfile $self->{path}, mipmap => 1;
1599		2113
1600	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2114	Scalar::Util::weaken $texture_cache{$self->{path}};
1601		2115
1602	Scalar::Util::weaken $loaded_images{$self->{image}};	2116	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
1603
1604	$self->{aspect} = $tex->{w} / $tex->{h};
1605		2117
1606	$self	2118	$self
1607	}	2119	}
1608		2120
1609	sub size_request {	2121	sub size_request {
1610	my ($self) = @_;	2122	my ($self) = @_;
1611		2123
1612	($self->{tex}->{w}, $self->{tex}->{h})	2124	($self->{tex}{w}, $self->{tex}{h})
1613	}	2125	}
1614		2126
1615	sub _draw {	2127	sub _draw {
1616	my ($self) = @_;	2128	my ($self) = @_;
1617		2129
…		…
1624	glTranslate 0, -$self->{w}, 0;	2136	glTranslate 0, -$self->{w}, 0;
1625		2137
1626	($w, $h) = ($h, $w);	2138	($w, $h) = ($h, $w);
1627	}	2139	}
1628		2140
1629	glEnable GL_BLEND;
1630	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1631	glEnable GL_TEXTURE_2D;	2141	glEnable GL_TEXTURE_2D;
1632	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2142	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1633		2143
1634	$tex->draw_quad (0, 0, $w, $h);	2144	$tex->draw_quad_alpha (0, 0, $w, $h);
1635		2145
1636	glDisable GL_BLEND;
1637	glDisable GL_TEXTURE_2D;	2146	glDisable GL_TEXTURE_2D;
1638	}	2147	}
1639		2148
1640	#############################################################################	2149	#############################################################################
1641		2150
…		…
1689	}	2198	}
1690		2199
1691	sub set_max {	2200	sub set_max {
1692	my ($self, $max) = @_;	2201	my ($self, $max) = @_;
1693		2202
		2203	return if $self->{max_val} == $max;
		2204
1694	$self->{max_val} = $max;	2205	$self->{max_val} = $max;
		2206	$self->update;
1695	}	2207	}
1696		2208
1697	sub set_value {	2209	sub set_value {
1698	my ($self, $val, $max) = @_;	2210	my ($self, $val, $max) = @_;
1699		2211
1700	$self->set_max ($max)	2212	$self->set_max ($max)
1701	if defined $max;	2213	if defined $max;
1702		2214
1703	$max = $self->{max_val};	2215	return if $self->{val} == $val;
		2216
1704	$self->{val} = $val;	2217	$self->{val} = $val;
1705
1706	$self->update;	2218	$self->update;
1707	}	2219	}
1708		2220
1709	sub _draw {	2221	sub _draw {
1710	my ($self) = @_;	2222	my ($self) = @_;
…		…
1728		2240
1729	my $h1 = $self->{h} * (1 - $ycut1);	2241	my $h1 = $self->{h} * (1 - $ycut1);
1730	my $h2 = $self->{h} * (1 - $ycut2);	2242	my $h2 = $self->{h} * (1 - $ycut2);
1731		2243
1732	glEnable GL_BLEND;	2244	glEnable GL_BLEND;
1733	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2245	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2246	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1734	glEnable GL_TEXTURE_2D;	2247	glEnable GL_TEXTURE_2D;
1735	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2248	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1736		2249
1737	glBindTexture GL_TEXTURE_2D, $t1->{name};	2250	glBindTexture GL_TEXTURE_2D, $t1->{name};
1738	glBegin GL_QUADS;	2251	glBegin GL_QUADS;
…		…
1773		2286
1774	sub new {	2287	sub new {
1775	my ($class, %arg) = @_;	2288	my ($class, %arg) = @_;
1776		2289
1777	my $self = $class->SUPER::new (	2290	my $self = $class->SUPER::new (
1778	tooltip => $arg{type},	2291	tooltip => $arg{type},
		2292	can_hover => 1,
1779	can_events => 1,	2293	can_events => 1,
1780	can_hover => 1,
1781	%arg,	2294	%arg,
1782	);	2295	);
1783		2296
1784	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2297	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1785	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	2298	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
…		…
1793		2306
1794	$self->{value}->set_fontsize ($fsize);	2307	$self->{value}->set_fontsize ($fsize);
1795	$self->{max} ->set_fontsize ($fsize);	2308	$self->{max} ->set_fontsize ($fsize);
1796	}	2309	}
1797		2310
		2311	sub set_max {
		2312	my ($self, $max) = @_;
		2313
		2314	$self->{gauge}->set_max ($max);
		2315	$self->{max}->set_text ($max);
		2316	}
		2317
1798	sub set_value {	2318	sub set_value {
1799	my ($self, $val, $max) = @_;	2319	my ($self, $val, $max) = @_;
1800		2320
1801	$self->set_max ($max)	2321	$self->set_max ($max)
1802	if defined $max;	2322	if defined $max;
1803		2323
1804	$self->{gauge}->set_value ($val, $max);	2324	$self->{gauge}->set_value ($val, $max);
1805	$self->{value}->set_text ($val);	2325	$self->{value}->set_text ($val);
1806	}
1807
1808	sub set_max {
1809	my ($self, $max) = @_;
1810
1811	$self->{gauge}->set_max ($max);
1812	$self->{max}->set_text ($max);
1813	}	2326	}
1814		2327
1815	#############################################################################	2328	#############################################################################
1816		2329
1817	package CFClient::UI::Slider;	2330	package CFClient::UI::Slider;
…		…
1827	qw(s1_slider.png s1_slider_bg.png);	2340	qw(s1_slider.png s1_slider_bg.png);
1828		2341
1829	sub new {	2342	sub new {
1830	my $class = shift;	2343	my $class = shift;
1831		2344
1832	# range [value, low, high, page]	2345	# range [value, low, high, page, unit]
1833		2346
1834	# TODO: 0-width page	2347	# TODO: 0-width page
1835	# TODO: req_w/h are wrong with vertical	2348	# TODO: req_w/h are wrong with vertical
1836	# TODO: calculations are off	2349	# TODO: calculations are off
1837	my $self = $class->SUPER::new (	2350	my $self = $class->SUPER::new (
1838	fg => [1, 1, 1],	2351	fg => [1, 1, 1],
1839	active_fg => [0, 0, 0],	2352	active_fg => [0, 0, 0],
		2353	bg => [0, 0, 0, 0.2],
		2354	active_bg => [1, 1, 1, 0.5],
1840	range => [0, 0, 100, 10],	2355	range => [0, 0, 100, 10, 0],
1841	req_w => 20,	2356	min_w => $::WIDTH / 80,
1842	req_h => 20,	2357	min_h => $::WIDTH / 80,
1843	vertical => 0,	2358	vertical => 0,
1844	can_hover => 1,	2359	can_hover => 1,
1845	inner_pad => 5,	2360	inner_pad => 0.02,
1846	@_	2361	@_
1847	);	2362	);
1848		2363
		2364	$self->set_value ($self->{range}[0]);
		2365	$self->update;
		2366
1849	$self	2367	$self
1850	}	2368	}
1851		2369
		2370	sub set_range {
		2371	my ($self, $range) = @_;
		2372
		2373	($range, $self->{range}) = ($self->{range}, $range);
		2374
		2375	if ("@$range" ne "@{$self->{range}}") {
		2376	$self->update;
		2377	$self->set_value ($self->{range}[0]);
		2378	}
		2379	}
		2380
		2381	sub set_value {
		2382	my ($self, $value) = @_;
		2383
		2384	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
		2385
		2386	$hi = $lo + 1 if $hi <= $lo;
		2387
		2388	$page = $hi - $lo if $page > $hi - $lo;
		2389
		2390	$value = $lo if $value < $lo;
		2391	$value = $hi - $page if $value > $hi - $page;
		2392
		2393	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
		2394	if $unit;
		2395
		2396	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
		2397
		2398	if ($value != $old_value) {
		2399	$self->emit (changed => $value);
		2400	$self->update;
		2401	}
		2402	}
		2403
1852	sub size_request {	2404	sub size_request {
1853	my ($self) = @_;	2405	my ($self) = @_;
1854		2406
1855	my $w = $self->{req_w};	2407	($self->{req_w}, $self->{req_h})
1856	my $h = $self->{req_h};
1857
1858	$self->{vertical} ? ($h, $w) : ($w, $h)
1859	}	2408	}
1860		2409
1861	sub button_down {	2410	sub invoke_button_down {
1862	my ($self, $ev, $x, $y) = @_;	2411	my ($self, $ev, $x, $y) = @_;
1863		2412
1864	$self->SUPER::button_down ($ev, $x, $y);	2413	$self->SUPER::invoke_button_down ($ev, $x, $y);
		2414
		2415	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
		2416
1865	$self->mouse_motion ($ev, $x, $y);	2417	$self->invoke_mouse_motion ($ev, $x, $y)
1866	}	2418	}
1867		2419
1868	sub mouse_motion {	2420	sub invoke_mouse_motion {
1869	my ($self, $ev, $x, $y) = @_;	2421	my ($self, $ev, $x, $y) = @_;
1870		2422
1871	if ($GRAB == $self) {	2423	if ($GRAB == $self) {
		2424	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
		2425
		2426	my (undef, $lo, $hi, $page) = @{$self->{range}};
		2427
		2428	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
		2429
		2430	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2431	} else {
		2432	return 0;
		2433	}
		2434
		2435	1
		2436	}
		2437
		2438	sub update {
		2439	my ($self) = @_;
		2440
		2441	delete $self->{knob_w};
		2442	$self->SUPER::update;
		2443	}
		2444
		2445	sub _draw {
		2446	my ($self) = @_;
		2447
		2448	unless ($self->{knob_w}) {
		2449	$self->set_value ($self->{range}[0]);
		2450
1872	my ($value, $lo, $hi, $page) = @{$self->{range}};	2451	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2452	my $range = ($hi - $page - $lo) || 1e-100;
1873		2453
1874	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2454	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
1875		2455
1876	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2456	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
1877	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right	2457	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
1878		2458
1879	$x -= $inner_pad_px; # substract the padding	2459	$value = ($value - $lo) / $range;
1880	$x = $x * ($hi - $lo) / $inner_w + $lo;	2460	$value = $value * $self->{scale} + $self->{offset};
1881	$x = $lo if $x < $lo;
1882	$x = $hi - $page if $x > $hi - $page;
1883	$self->{range}[0] = $x;
1884		2461
1885	$self->emit (changed => $x);	2462	$self->{knob_x} = $value - $knob_w * 0.5;
1886	$self->update;	2463	$self->{knob_w} = $knob_w;
1887	}	2464	}
1888	}
1889
1890	# the inner_* stuff is for generating a padding for the slider handle,
1891	# so that the handle doesn't leave the texture. This calculation isn't 100%
1892	# correct propably, but it does the job for now
1893	sub _calc_inner_pad_px {
1894	my ($self, $w) = @_;
1895	($w / 100) * $self->{inner_pad} # % to pixels
1896	}
1897
1898	sub _draw {
1899	my ($self) = @_;
1900		2465
1901	$self->SUPER::_draw ();	2466	$self->SUPER::_draw ();
1902		2467
1903	my ($w, $h) = @$self{qw(w h)};	2468	glScale $self->{w}, $self->{h};
1904		2469
1905	if ($self->{vertical}) {	2470	if ($self->{vertical}) {
1906	# draw a vertical slider like a rotated horizontal slider	2471	# draw a vertical slider like a rotated horizontal slider
1907		2472
		2473	glTranslate 1, 0, 0;
1908	glRotate 90, 0, 0, 1;	2474	glRotate 90, 0, 0, 1;
1909	glTranslate 0, -$self->{w}, 0;
1910
1911	($w, $h) = ($h, $w);
1912	}	2475	}
1913		2476
1914	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2477	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
1915	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2478	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
1916		2479
1917	my ($value, $lo, $hi, $page) = @{$self->{range}};
1918
1919	$hi = $value + 1 if $lo == $hi;
1920
1921	my $inner_pad_px = $self->_calc_inner_pad_px ($w);
1922	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
1923
1924	$page = int $page * $inner_w / ($hi - $lo);
1925	$value = int +($value - $lo) * $inner_w / ($hi - $lo);
1926
1927	$w -= $page;
1928	$page &= ~1;
1929	glTranslate $page * 0.5, 0, 0;
1930	$page ||= 2;
1931
1932	my $knob_a = $inner_pad_px + ($value - $page * 0.5);
1933	my $knob_b = $inner_pad_px + ($value + $page * 0.5);
1934
1935	glEnable GL_BLEND;
1936	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1937	glEnable GL_TEXTURE_2D;	2480	glEnable GL_TEXTURE_2D;
1938	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2481	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1939		2482
1940	# draw background	2483	# draw background
1941	$tex[1]->draw_quad (0, 0, $w, $h);	2484	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
1942		2485
1943	# draw handle	2486	# draw handle
1944	$tex[0]->draw_quad ($knob_a, 0, $knob_b - $knob_a, $h);	2487	$tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
1945		2488
1946	glDisable GL_BLEND;
1947	glDisable GL_TEXTURE_2D;	2489	glDisable GL_TEXTURE_2D;
1948	}	2490	}
1949		2491
1950	#############################################################################	2492	#############################################################################
1951		2493
		2494	package CFClient::UI::ValSlider;
		2495
		2496	our @ISA = CFClient::UI::HBox::;
		2497
		2498	sub new {
		2499	my ($class, %arg) = @_;
		2500
		2501	my $range = delete $arg{range};
		2502
		2503	my $self = $class->SUPER::new (
		2504	slider => (new CFClient::UI::Slider expand => 1, range => $range),
		2505	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
		2506	to_value => sub { shift },
		2507	from_value => sub { shift },
		2508	%arg,
		2509	);
		2510
		2511	$self->{slider}->connect (changed => sub {
		2512	my ($self, $value) = @_;
		2513	$self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
		2514	$self->{parent}->emit (changed => $value);
		2515	});
		2516
		2517	# $self->{entry}->connect (changed => sub {
		2518	# my ($self, $value) = @_;
		2519	# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
		2520	# $self->{parent}->emit (changed => $value);
		2521	# });
		2522
		2523	$self->add ($self->{slider}, $self->{entry});
		2524
		2525	$self->{slider}->emit (changed => $self->{slider}{range}[0]);
		2526
		2527	$self
		2528	}
		2529
		2530	sub set_range { shift->{slider}->set_range (@_) }
		2531	sub set_value { shift->{slider}->set_value (@_) }
		2532
		2533	#############################################################################
		2534
1952	package CFClient::UI::TextView;	2535	package CFClient::UI::TextScroller;
1953		2536
1954	our @ISA = CFClient::UI::HBox::;	2537	our @ISA = CFClient::UI::HBox::;
1955		2538
1956	use CFClient::OpenGL;	2539	use CFClient::OpenGL;
1957		2540
1958	sub new {	2541	sub new {
1959	my $class = shift;	2542	my $class = shift;
1960		2543
1961	my $self = $class->SUPER::new (	2544	my $self = $class->SUPER::new (
1962	fontsize => 1,	2545	fontsize => 1,
		2546	can_events => 0,
		2547	indent => 0,
1963	#font => default_font	2548	#font => default_font
1964	@_,	2549	@_,
1965		2550
1966	layout => (new CFClient::Layout),	2551	layout => (new CFClient::Layout 1),
1967	par => [],	2552	par => [],
1968	height => 0,	2553	height => 0,
1969	children => [	2554	children => [
1970	(new CFClient::UI::Empty expand => 1),	2555	(new CFClient::UI::Empty expand => 1),
1971	(new CFClient::UI::Slider vertical => 1),	2556	(new CFClient::UI::Slider vertical => 1),
1972	],	2557	],
1973	);	2558	);
1974		2559
1975	$self->{children}[1]->connect (changed => sub {	2560	$self->{children}[1]->connect (changed => sub { $self->update });
1976	$self->update;
1977	});
1978		2561
1979	$self	2562	$self
1980	}	2563	}
1981		2564
1982	sub set_fontsize {	2565	sub set_fontsize {
…		…
1984		2567
1985	$self->{fontsize} = $fontsize;	2568	$self->{fontsize} = $fontsize;
1986	$self->reflow;	2569	$self->reflow;
1987	}	2570	}
1988		2571
1989	sub text_height {	2572	sub visible_children {
1990	my ($self, $text) = @_;	2573	my ($self) = @_;
1991		2574
1992	my $layout = $self->{layout};	2575	@{$self->{children}}[0,1]
1993
1994	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
1995	$layout->set_width ($self->{w});
1996	$layout->set_text ($text);
1997
1998	($layout->size)[1]
1999	}	2576	}
2000		2577
2001	sub reflow {
2002	my ($self) = @_;
2003
2004	$self->{need_reflow}++;
2005	$self->update;
2006	}
2007
2008	sub size_allocate {	2578	sub invoke_size_allocate {
2009	my ($self, $w, $h) = @_;	2579	my ($self, $w, $h) = @_;
2010		2580
2011	$self->SUPER::size_allocate ($w, $h);	2581	my (undef, undef, @other) = @{ $self->{children} };
		2582	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2012		2583
2013	$self->{layout}->set_font ($self->{font}) if $self->{font};	2584	$self->{layout}->set_font ($self->{font}) if $self->{font};
2014	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2585	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2015	$self->{layout}->set_width ($self->{children}[0]{w});	2586	$self->{layout}->set_width ($self->{children}[0]{w});
		2587	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2016		2588
2017	$self->reflow;	2589	$self->reflow;
		2590
		2591	$self->SUPER::invoke_size_allocate ($w, $h)
		2592	}
		2593
		2594	sub get_layout {
		2595	my ($self, $para) = @_;
		2596
		2597	my $layout = $self->{layout};
		2598
		2599	$layout->set_font ($self->{font}) if $self->{font};
		2600	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2601	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
		2602	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
		2603	$layout->set_markup ($para->{markup});
		2604	$layout->set_shapes (map +($_->{req_w}, $_->{req_h}), @{$para->{widget}});
		2605
		2606	$layout
		2607	}
		2608
		2609	sub reflow {
		2610	my ($self) = @_;
		2611
		2612	$self->{need_reflow}++;
		2613	$self->update;
		2614	}
		2615
		2616	sub set_offset {
		2617	my ($self, $offset) = @_;
		2618
		2619	# todo: base offset on lines or so, not on pixels
		2620	$self->{children}[1]->set_value ($offset);
		2621	}
		2622
		2623	sub clear {
		2624	my ($self) = @_;
		2625
		2626	my (undef, undef, @other) = @{ $self->{children} };
		2627	$self->remove ($_) for @other;
		2628
		2629	$self->{par} = [];
		2630	$self->{height} = 0;
		2631	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2018	}	2632	}
2019		2633
2020	sub add_paragraph {	2634	sub add_paragraph {
2021	my ($self, $color, $text) = @_;	2635	my ($self, $color, $para, $indent) = @_;
2022		2636
2023	#TODO: intelligently "reformat" paragraph	2637	my ($text, @w) = ref $para ? @$para : $para;
2024		2638
2025	my $height = $self->text_height ($text);	2639	$para = {
		2640	w => 1e10,
		2641	wrapped => 1,
		2642	fg => $color,
		2643	indent => $indent,
		2644	markup => $text,
		2645	widget => \@w,
		2646	};
2026		2647
2027	$self->{height} += $height;	2648	$self->add (@w) if @w;
		2649	push @{$self->{par}}, $para;
2028		2650
2029	push @{$self->{par}}, [$height, $color, $text];	2651	$self->{need_reflow}++;
		2652	$self->update;
		2653	}
2030		2654
2031	$self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}];	2655	sub scroll_to_bottom {
2032	$self->{children}[1]->update;	2656	my ($self) = @_;
		2657
		2658	$self->{scroll_to_bottom} = 1;
		2659	$self->update;
2033	}	2660	}
2034		2661
2035	sub update {	2662	sub update {
2036	my ($self) = @_;	2663	my ($self) = @_;
2037		2664
…		…
2039		2666
2040	return unless $self->{h} > 0;	2667	return unless $self->{h} > 0;
2041		2668
2042	delete $self->{texture};	2669	delete $self->{texture};
2043		2670
2044	$ROOT->on_refresh ($self, sub {	2671	$ROOT->on_post_alloc ($self => sub {
		2672	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2673
2045	if (delete $self->{need_reflow}) {	2674	if (delete $self->{need_reflow}) {
2046	my $height = 0;	2675	my $height = 0;
2047		2676
2048	$height += $_->[0] = $self->text_height ($_->[2])
2049	for @{$self->{par}};	2677	for my $para (@{$self->{par}}) {
		2678	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		2679	my $layout = $self->get_layout ($para);
		2680	my ($w, $h) = $layout->size;
		2681
		2682	$para->{w} = $w + $para->{indent};
		2683	$para->{h} = $h;
		2684	$para->{wrapped} = $layout->has_wrapped;
		2685	}
		2686
		2687	$height += $para->{h};
		2688	}
2050		2689
2051	$self->{height} = $height;	2690	$self->{height} = $height;
2052		2691
2053	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2692	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2054		2693
2055	delete $self->{texture};	2694	delete $self->{texture};
2056	}	2695	}
2057		2696
		2697	if (delete $self->{scroll_to_bottom}) {
		2698	$self->{children}[1]->set_value (1e10);
		2699	}
		2700
2058	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	2701	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2059	glClearColor 0, 0, 0, 1;	2702	glClearColor 0, 0, 0, 0;
2060	glClear GL_COLOR_BUFFER_BIT;	2703	glClear GL_COLOR_BUFFER_BIT;
2061		2704
		2705	my $top = int $self->{children}[1]{range}[0];
		2706
		2707	my $y0 = $top;
		2708	my $y1 = $top + $H;
		2709
		2710	my $y = 0;
		2711
2062	glEnable GL_BLEND;	2712	glEnable GL_BLEND;
		2713	#TODO# not correct in windows where rgba is forced off
2063	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2714	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2064	glEnable GL_TEXTURE_2D;
2065	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2066		2715
2067	my $top = int $self->{children}[1]{range}[0];
2068
2069	my $y0 = $top;
2070	my $y1 = $top + $self->{h};
2071
2072	my $y = 0;
2073
2074	my $layout = $self->{layout};
2075
2076	$layout->set_font ($self->{font}) if $self->{font};
2077
2078	for my $par (@{$self->{par}}) {	2716	for my $para (@{$self->{par}}) {
2079	my $h = $par->[0];	2717	my $h = $para->{h};
2080		2718
2081	if ($y0 < $y + $h && $y < $y1) {	2719	if ($y0 < $y + $h && $y < $y1) {
2082	$layout->set_text ($par->[2]);
2083		2720
2084	glColor @{ $par->[1] };	2721	my $layout = $self->get_layout ($para);
2085	my ($W, $H) = $layout->size;	2722
2086	CFClient::Texture->new_from_layout ($layout)->draw_quad (0, $y - $y0);	2723	my ($w, $h, $data, $format, $internalformat) = $layout->render;
		2724
		2725	glRasterPos $para->{indent}, $y - $y0;
		2726	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
		2727
		2728	if (my @w = @{ $para->{widget} }) {
		2729	my @s = $layout->get_shapes;
		2730
		2731	for (@w) {
		2732	my ($dx, $dy) = splice @s, 0, 2, ();
		2733
		2734	$_->{x} = $dx + $para->{indent};
		2735	$_->{y} = $dy + $y - $y0;
		2736
		2737	$_->draw;
		2738	}
		2739	}
2087	}	2740	}
2088		2741
2089	$y += $h;	2742	$y += $h;
2090	}	2743	}
2091		2744
2092	glDisable GL_TEXTURE_2D;
2093	glDisable GL_BLEND;	2745	glDisable GL_BLEND;
2094	};	2746	};
2095	});	2747	});
2096	}	2748	}
2097		2749
		2750	sub reconfigure {
		2751	my ($self) = @_;
		2752
		2753	$self->SUPER::reconfigure;
		2754
		2755	$_->{w} = 1e10 for @{ $self->{par} };
		2756	$self->reflow;
		2757	}
		2758
2098	sub _draw {	2759	sub _draw {
2099	my ($self) = @_;	2760	my ($self) = @_;
2100		2761
2101	if ($self->{texture}) {
2102	glEnable GL_TEXTURE_2D;	2762	glEnable GL_TEXTURE_2D;
2103	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2763	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2104	$self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});	2764	glColor 0, 0, 0, 1;
		2765	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2105	glDisable GL_TEXTURE_2D;	2766	glDisable GL_TEXTURE_2D;
2106	}
2107		2767
2108	$self->{children}[1]->draw;	2768	$self->{children}[1]->draw;
2109
2110	}	2769	}
2111		2770
2112	#############################################################################	2771	#############################################################################
2113		2772
2114	package CFClient::UI::Animator;	2773	package CFClient::UI::Animator;
…		…
2159		2818
2160	sub new {	2819	sub new {
2161	my $class = shift;	2820	my $class = shift;
2162		2821
2163	my $self = $class->SUPER::new (	2822	my $self = $class->SUPER::new (
2164	state => 0,	2823	state => 0,
2165	connect_activate => \&toggle_flopper,	2824	on_activate => \&toggle_flopper,
2166	can_events => 1,
2167	@_	2825	@_
2168	);	2826	);
2169		2827
2170	if ($self->{state}) {
2171	$self->{state} = 0;
2172	$self->toggle_flopper;
2173	}
2174
2175	$self	2828	$self
2176	}	2829	}
2177		2830
2178	sub toggle_flopper {	2831	sub toggle_flopper {
2179	my ($self) = @_;	2832	my ($self) = @_;
2180		2833
2181	# TODO: use animation	2834	$self->{other}->toggle_visibility;
2182	if ($self->{state} = !$self->{state}) {
2183	$CFClient::UI::ROOT->add ($self->{other});
2184	$self->{other}->move ($self->coord2global (0, $self->{h}));
2185	$self->emit ("open");
2186	} else {
2187	$CFClient::UI::ROOT->remove ($self->{other});
2188	$self->emit ("close");
2189	}
2190
2191	$self->emit (changed => $self->{state});
2192	}	2835	}
2193		2836
2194	#############################################################################	2837	#############################################################################
2195		2838
2196	package CFClient::UI::Tooltip;	2839	package CFClient::UI::Tooltip;
…		…
2206	@_,	2849	@_,
2207	can_events => 0,	2850	can_events => 0,
2208	)	2851	)
2209	}	2852	}
2210		2853
2211	sub set_markup {	2854	sub set_tooltip_from {
2212	my ($self, $text) = @_;	2855	my ($self, $widget) = @_;
2213		2856
2214	$self->{label} ||= new CFClient::UI::Label fontsize => 0.8, fg => [0, 0, 0];	2857	my $tooltip = $widget->{tooltip};
2215	$self->{label}->set_markup ($text);	2858
2216	$self->add ($self->{label});	2859	if ($ENV{CFPLUS_DEBUG} & 2) {
		2860	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2861	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2862	. "req $widget->{req_w} $widget->{req_h}\n"
		2863	. "visible $widget->{visible}";
		2864	}
		2865
		2866	$tooltip =~ s/^\n+//;
		2867	$tooltip =~ s/\n+$//;
		2868
		2869	$self->add (new CFClient::UI::Label
		2870	markup => $tooltip,
		2871	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
		2872	fontsize => 0.8,
		2873	fg => [0, 0, 0, 1],
		2874	ellipsise => 0,
		2875	font => ($widget->{tooltip_font} || $::FONT_PROP),
		2876	);
2217	}	2877	}
2218		2878
2219	sub size_request {	2879	sub size_request {
2220	my ($self) = @_;	2880	my ($self) = @_;
2221		2881
2222	$self->child->set_max_size ($::WIDTH * 0.3);
2223
2224	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2882	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2225		2883
2226	($w + 4, $h + 4)	2884	($w + 4, $h + 4)
2227	}	2885	}
2228		2886
2229	sub size_allocate {	2887	sub invoke_size_allocate {
2230	my ($self, $w, $h) = @_;	2888	my ($self, $w, $h) = @_;
2231		2889
2232	$self->SUPER::size_allocate ($w - 4, $h - 4);	2890	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
		2891	}
		2892
		2893	sub invoke_visibility_change {
		2894	my ($self, $visible) = @_;
		2895
		2896	return unless $visible;
		2897
		2898	$self->{root}->on_post_alloc ("move_$self" => sub {
		2899	my $widget = $self->{owner}
		2900	or return;
		2901
		2902	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2903
		2904	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2905	if $x + $self->{w} > $self->{root}{w};
		2906
		2907	$self->move_abs ($x, $y);
		2908	});
2233	}	2909	}
2234		2910
2235	sub _draw {	2911	sub _draw {
2236	my ($self) = @_;	2912	my ($self) = @_;
2237		2913
2238	glPushMatrix;
2239	glTranslate 0.375, 0.375;	2914	glTranslate 0.375, 0.375;
2240		2915
2241	my ($w, $h) = @$self{qw(w h)};	2916	my ($w, $h) = @$self{qw(w h)};
2242		2917
2243	glColor 1, 0.8, 0.4;	2918	glColor 1, 0.8, 0.4;
…		…
2254	glVertex 0 , $h;	2929	glVertex 0 , $h;
2255	glVertex $w, $h;	2930	glVertex $w, $h;
2256	glVertex $w, 0;	2931	glVertex $w, 0;
2257	glEnd;	2932	glEnd;
2258		2933
2259	glPopMatrix;	2934	glTranslate 2 - 0.375, 2 - 0.375;
2260		2935
2261	glTranslate 2, 2;
2262	$self->SUPER::_draw;	2936	$self->SUPER::_draw;
2263	}	2937	}
2264		2938
2265	#############################################################################	2939	#############################################################################
2266		2940
…		…
2271	use CFClient::OpenGL;	2945	use CFClient::OpenGL;
2272		2946
2273	sub new {	2947	sub new {
2274	my $class = shift;	2948	my $class = shift;
2275		2949
2276	$class->SUPER::new (	2950	my $self = $class->SUPER::new (
2277	aspect => 1,	2951	aspect => 1,
		2952	can_events => 0,
		2953	@_,
		2954	);
		2955
		2956	if ($self->{anim} && $self->{animspeed}) {
		2957	Scalar::Util::weaken (my $widget = $self);
		2958
		2959	$self->{timer} = Event->timer (
		2960	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
		2961	hard => 1,
		2962	interval => $self->{animspeed},
		2963	cb => sub {
		2964	++$widget->{frame};
		2965	$widget->update;
		2966	},
		2967	);
		2968	}
		2969
		2970	$self
		2971	}
		2972
		2973	sub size_request {
		2974	(32, 8)
		2975	}
		2976
		2977	sub update {
		2978	my ($self) = @_;
		2979
		2980	return unless $self->{visible};
		2981
		2982	$self->SUPER::update;
		2983	}
		2984
		2985	sub _draw {
		2986	my ($self) = @_;
		2987
		2988	return unless $::CONN;
		2989
		2990	my $face;
		2991
		2992	if ($self->{frame}) {
		2993	my $anim = $::CONN->{anim}[$self->{anim}];
		2994
		2995	$face = $anim->[ $self->{frame} % @$anim ]
		2996	if $anim && @$anim;
		2997	}
		2998
		2999	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
		3000
		3001	if ($tex) {
		3002	glEnable GL_TEXTURE_2D;
		3003	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		3004	glColor 0, 0, 0, 1;
		3005	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
		3006	glDisable GL_TEXTURE_2D;
		3007	}
		3008	}
		3009
		3010	sub destroy {
		3011	my ($self) = @_;
		3012
		3013	$self->{timer}->cancel
		3014	if $self->{timer};
		3015
		3016	$self->SUPER::destroy;
		3017	}
		3018
		3019	#############################################################################
		3020
		3021	package CFClient::UI::Buttonbar;
		3022
		3023	our @ISA = CFClient::UI::HBox::;
		3024
		3025	# TODO: should actualyl wrap buttons and other goodies.
		3026
		3027	#############################################################################
		3028
		3029	package CFClient::UI::Menu;
		3030
		3031	our @ISA = CFClient::UI::FancyFrame::;
		3032
		3033	use CFClient::OpenGL;
		3034
		3035	sub new {
		3036	my $class = shift;
		3037
		3038	my $self = $class->SUPER::new (
		3039	items => [],
		3040	z => 100,
		3041	@_,
		3042	);
		3043
		3044	$self->add ($self->{vbox} = new CFClient::UI::VBox);
		3045
		3046	for my $item (@{ $self->{items} }) {
		3047	my ($widget, $cb, $tooltip) = @$item;
		3048
		3049	# handle various types of items, only text for now
		3050	if (!ref $widget) {
		3051	$widget = new CFClient::UI::Label
		3052	can_hover => 1,
		3053	can_events => 1,
		3054	markup => $widget,
		3055	tooltip => $tooltip
		3056	}
		3057
		3058	$self->{item}{$widget} = $item;
		3059
		3060	$self->{vbox}->add ($widget);
		3061	}
		3062
		3063	$self
		3064	}
		3065
		3066	# popup given the event (must be a mouse button down event currently)
		3067	sub popup {
		3068	my ($self, $ev) = @_;
		3069
		3070	$self->emit ("popdown");
		3071
		3072	# maybe save $GRAB? must be careful about events...
		3073	$GRAB = $self;
		3074	$self->{button} = $ev->{button};
		3075
		3076	$self->show;
		3077	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
		3078	}
		3079
		3080	sub invoke_mouse_motion {
		3081	my ($self, $ev, $x, $y) = @_;
		3082
		3083	# TODO: should use vbox->find_widget or so
		3084	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
		3085	$self->{hover} = $self->{item}{$HOVER};
		3086
		3087	0
		3088	}
		3089
		3090	sub invoke_button_up {
		3091	my ($self, $ev, $x, $y) = @_;
		3092
		3093	if ($ev->{button} == $self->{button}) {
		3094	undef $GRAB;
		3095	$self->hide;
		3096
		3097	$self->emit ("popdown");
		3098	$self->{hover}[1]->() if $self->{hover};
		3099	} else {
		3100	return 0
		3101	}
		3102
		3103	1
		3104	}
		3105
		3106	#############################################################################
		3107
		3108	package CFClient::UI::Multiplexer;
		3109
		3110	our @ISA = CFClient::UI::Container::;
		3111
		3112	sub new {
		3113	my $class = shift;
		3114
		3115	my $self = $class->SUPER::new (
		3116	@_,
		3117	);
		3118
		3119	$self->{current} = $self->{children}[0]
		3120	if @{ $self->{children} };
		3121
		3122	$self
		3123	}
		3124
		3125	sub add {
		3126	my ($self, @widgets) = @_;
		3127
		3128	$self->SUPER::add (@widgets);
		3129
		3130	$self->{current} = $self->{children}[0]
		3131	if @{ $self->{children} };
		3132	}
		3133
		3134	sub set_current_page {
		3135	my ($self, $page_or_widget) = @_;
		3136
		3137	my $widget = ref $page_or_widget
		3138	? $page_or_widget
		3139	: $self->{children}[$page_or_widget];
		3140
		3141	$self->{current} = $widget;
		3142	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3143
		3144	$self->emit (page_changed => $self->{current});
		3145
		3146	$self->realloc;
		3147	}
		3148
		3149	sub visible_children {
		3150	$_[0]{current}
		3151	}
		3152
		3153	sub size_request {
		3154	my ($self) = @_;
		3155
		3156	$self->{current}->size_request
		3157	}
		3158
		3159	sub invoke_size_allocate {
		3160	my ($self, $w, $h) = @_;
		3161
		3162	$self->{current}->configure (0, 0, $w, $h);
		3163
		3164	1
		3165	}
		3166
		3167	sub _draw {
		3168	my ($self) = @_;
		3169
		3170	$self->{current}->draw;
		3171	}
		3172
		3173	#############################################################################
		3174
		3175	package CFClient::UI::Notebook;
		3176
		3177	our @ISA = CFClient::UI::VBox::;
		3178
		3179	sub new {
		3180	my $class = shift;
		3181
		3182	my $self = $class->SUPER::new (
		3183	buttonbar => (new CFClient::UI::Buttonbar),
		3184	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3185	# filter => # will be put between multiplexer and $self
		3186	@_,
		3187	);
		3188
		3189	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3190	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3191
		3192	$self
		3193	}
		3194
		3195	sub add {
		3196	my ($self, $title, $widget, $tooltip) = @_;
		3197
		3198	Scalar::Util::weaken $self;
		3199
		3200	$self->{buttonbar}->add (new CFClient::UI::Button
		3201	markup => $title,
		3202	tooltip => $tooltip,
		3203	on_activate => sub { $self->set_current_page ($widget) },
		3204	);
		3205
		3206	$self->{multiplexer}->add ($widget);
		3207	}
		3208
		3209	sub set_current_page {
		3210	my ($self, $page) = @_;
		3211
		3212	$self->{multiplexer}->set_current_page ($page);
		3213	$self->emit (page_changed => $self->{multiplexer}{current});
		3214	}
		3215
		3216	#############################################################################
		3217
		3218	package CFClient::UI::Combobox;
		3219
		3220	use utf8;
		3221
		3222	our @ISA = CFClient::UI::Button::;
		3223
		3224	sub new {
		3225	my $class = shift;
		3226
		3227	my $self = $class->SUPER::new (
		3228	options => [], # [value, title, longdesc], ...
		3229	value => undef,
		3230	@_,
		3231	);
		3232
		3233	$self->_set_value ($self->{value});
		3234
		3235	$self
		3236	}
		3237
		3238	sub invoke_button_down {
		3239	my ($self, $ev) = @_;
		3240
		3241	my @menu_items;
		3242
		3243	for (@{ $self->{options} }) {
		3244	my ($value, $title, $tooltip) = @$_;
		3245
		3246	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3247	}
		3248
		3249	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3250	}
		3251
		3252	sub _set_value {
		3253	my ($self, $value) = @_;
		3254
		3255	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3256	or return;
		3257
		3258	$self->{value} = $item->[0];
		3259	$self->set_markup ("$item->[1] ⇓");
		3260	$self->set_tooltip ($item->[2]);
		3261	}
		3262
		3263	sub set_value {
		3264	my ($self, $value) = @_;
		3265
		3266	return unless $self->{value} ne $value;
		3267
		3268	$self->_set_value ($value);
		3269	$self->emit (changed => $value);
		3270	}
		3271
		3272	#############################################################################
		3273
		3274	package CFClient::UI::Statusbox;
		3275
		3276	our @ISA = CFClient::UI::VBox::;
		3277
		3278	sub new {
		3279	my $class = shift;
		3280
		3281	my $self = $class->SUPER::new (
		3282	fontsize => 0.8,
		3283	@_,
		3284	);
		3285
		3286	Scalar::Util::weaken (my $this = $self);
		3287
		3288	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3289
		3290	$self
		3291	}
		3292
		3293	sub reorder {
		3294	my ($self) = @_;
		3295	my $NOW = Time::HiRes::time;
		3296
		3297	# freeze display when hovering over any label
		3298	return if $CFClient::UI::TOOLTIP->{owner}
		3299	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3300	values %{ $self->{item} };
		3301
		3302	while (my ($k, $v) = each %{ $self->{item} }) {
		3303	delete $self->{item}{$k} if $v->{timeout} < $NOW;
		3304	}
		3305
		3306	my @widgets;
		3307
		3308	my @items = sort {
		3309	$a->{pri} <=> $b->{pri}
		3310	or $b->{id} <=> $a->{id}
		3311	} values %{ $self->{item} };
		3312
		3313	$self->{timer}->interval (1);
		3314
		3315	my $count = 10 + 1;
		3316	for my $item (@items) {
		3317	last unless --$count;
		3318
		3319	my $label = $item->{label} ||= do {
		3320	# TODO: doesn't handle markup well (read as: at all)
		3321	my $short = $item->{count} > 1
		3322	? "<b>$item->{count} ×</b> $item->{text}"
		3323	: $item->{text};
		3324
		3325	for ($short) {
		3326	s/^\s+//;
		3327	s/\s+/ /g;
		3328	}
		3329
		3330	new CFClient::UI::Label
		3331	markup => $short,
		3332	tooltip => $item->{tooltip},
		3333	tooltip_font => $::FONT_PROP,
		3334	tooltip_width => 0.67,
		3335	fontsize => $item->{fontsize} || $self->{fontsize},
		3336	max_w => $::WIDTH * 0.44,
		3337	fg => [@{ $item->{fg} }],
		3338	can_events => 1,
		3339	can_hover => 1
		3340	};
		3341
		3342	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3343	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3344	$label->update;
		3345	$label->set_max_size (undef, $label->{req_h} * $diff)
		3346	if $diff < 1;
		3347	$self->{timer}->interval (1/30);
		3348	} else {
		3349	$label->{fg}[3] = $item->{fg}[3] || 1;
		3350	}
		3351
		3352	push @widgets, $label;
		3353	}
		3354
		3355	$self->clear;
		3356	$self->SUPER::add (reverse @widgets);
		3357	}
		3358
		3359	sub add {
		3360	my ($self, $text, %arg) = @_;
		3361
		3362	$text =~ s/^\s+//;
		3363	$text =~ s/\s+$//;
		3364
		3365	return unless $text;
		3366
		3367	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
		3368
		3369	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
		3370
		3371	if (my $item = $self->{item}{$group}) {
		3372	if ($item->{text} eq $text) {
		3373	$item->{count}++;
		3374	} else {
		3375	$item->{count} = 1;
		3376	$item->{text} = $item->{tooltip} = $text;
		3377	}
		3378	$item->{id} += 0.2;#d#
		3379	$item->{timeout} = $timeout;
		3380	delete $item->{label};
		3381	} else {
		3382	$self->{item}{$group} = {
		3383	id => ++$self->{id},
		3384	text => $text,
		3385	timeout => $timeout,
		3386	tooltip => $text,
		3387	fg => [0.8, 0.8, 0.8, 0.8],
		3388	pri => 0,
		3389	count => 1,
		3390	%arg,
		3391	};
		3392	}
		3393
		3394	$self->reorder;
		3395	}
		3396
		3397	sub reconfigure {
		3398	my ($self) = @_;
		3399
		3400	delete $_->{label}
		3401	for values %{ $self->{item} || {} };
		3402
		3403	$self->reorder;
		3404	$self->SUPER::reconfigure;
		3405	}
		3406
		3407	sub destroy {
		3408	my ($self) = @_;
		3409
		3410	$self->{timer}->cancel;
		3411
		3412	$self->SUPER::destroy;
		3413	}
		3414
		3415	#############################################################################
		3416
		3417	package CFClient::UI::Inventory;
		3418
		3419	our @ISA = CFClient::UI::ScrolledWindow::;
		3420
		3421	sub new {
		3422	my $class = shift;
		3423
		3424	my $self = $class->SUPER::new (
		3425	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3426	@_,
		3427	);
		3428
		3429	$self
		3430	}
		3431
		3432	sub set_items {
		3433	my ($self, $items) = @_;
		3434
		3435	$self->{child}->clear;
		3436	return unless $items;
		3437
		3438	my @items = sort {
		3439	($a->{type} <=> $b->{type})
		3440	or ($a->{name} cmp $b->{name})
		3441	} @$items;
		3442
		3443	$self->{real_items} = \@items;
		3444
		3445	my $row = 0;
		3446	for my $item (@items) {
		3447	CFClient::Item::update_widgets $item;
		3448
		3449	$self->{child}->add (0, $row, $item->{face_widget});
		3450	$self->{child}->add (1, $row, $item->{desc_widget});
		3451	$self->{child}->add (2, $row, $item->{weight_widget});
		3452
		3453	$row++;
		3454	}
		3455	}
		3456
		3457	#############################################################################
		3458
		3459	package CFClient::UI::BindEditor;
		3460
		3461	our @ISA = CFClient::UI::FancyFrame::;
		3462
		3463	sub new {
		3464	my $class = shift;
		3465
		3466	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3467
		3468	$self->add (my $vb = new CFClient::UI::VBox);
		3469
		3470
		3471	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3472	text => "start recording",
		3473	tooltip => "Start/Stops recording of actions."
		3474	."All subsequent actions after the recording started will be captured."
		3475	."The actions are displayed after the record was stopped."
		3476	."To bind the action you have to click on the 'Bind' button",
		3477	on_activate => sub {
		3478	unless ($self->{recording}) {
		3479	$self->start;
		3480	} else {
		3481	$self->stop;
		3482	}
		3483	});
		3484
		3485	$vb->add (new CFClient::UI::Label text => "Actions:");
		3486	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3487
		3488	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3489	$vb->add (my $hb = new CFClient::UI::HBox);
		3490	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3491	$hb->add (new CFClient::UI::Button
		3492	text => "bind",
		3493	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3494	on_activate => sub {
		3495	$self->ask_for_bind;
		3496	});
		3497
		3498	$vb->add (my $hb = new CFClient::UI::HBox);
		3499	$hb->add (new CFClient::UI::Button
		3500	text => "ok",
		3501	expand => 1,
		3502	tooltip => "This closes the binding editor and saves the binding",
		3503	on_activate => sub {
		3504	$self->hide;
		3505	$self->commit;
		3506	});
		3507
		3508	$hb->add (new CFClient::UI::Button
		3509	text => "cancel",
		3510	expand => 1,
		3511	tooltip => "This closes the binding editor without saving",
		3512	on_activate => sub {
		3513	$self->hide;
		3514	$self->{binding_cancel}->()
		3515	if $self->{binding_cancel};
		3516	});
		3517
		3518	$self->update_binding_widgets;
		3519
		3520	$self
		3521	}
		3522
		3523	sub cfg_bind {
		3524	my ($self, $mod, $sym, $cmds) = @_;
		3525	$::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
		3526	::update_bindings ();
		3527	}
		3528
		3529	sub cfg_unbind {
		3530	my ($self, $mod, $sym, $cmds) = @_;
		3531	delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
		3532	::update_bindings ();
		3533	}
		3534
		3535	sub commit {
		3536	my ($self) = @_;
		3537	my ($mod, $sym, $cmds) = $self->get_binding;
		3538	if ($sym != 0 && @$cmds > 0) {
		3539	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3540	."'. Don't forget 'Save Config'!");
		3541	$self->{binding_change}->($mod, $sym, $cmds)
		3542	if $self->{binding_change};
		3543	} else {
		3544	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3545	$self->{binding_cancel}->()
		3546	if $self->{binding_cancel};
		3547	}
		3548	}
		3549
		3550	sub start {
		3551	my ($self) = @_;
		3552
		3553	$self->{rec_btn}->set_text ("stop recording");
		3554	$self->{recording} = 1;
		3555	$self->clear_command_list;
		3556	$::CONN->start_record if $::CONN;
		3557	}
		3558
		3559	sub stop {
		3560	my ($self) = @_;
		3561
		3562	$self->{rec_btn}->set_text ("start recording");
		3563	$self->{recording} = 0;
		3564
		3565	my $rec;
		3566	$rec = $::CONN->stop_record if $::CONN;
		3567	return unless ref $rec eq 'ARRAY';
		3568	$self->set_command_list ($rec);
		3569	}
		3570
		3571
		3572	sub ask_for_bind_and_commit {
		3573	my ($self) = @_;
		3574	$self->ask_for_bind (1);
		3575	}
		3576
		3577	sub ask_for_bind {
		3578	my ($self, $commit, $end_cb) = @_;
		3579
		3580	CFClient::Binder::open_binding_dialog (sub {
		3581	my ($mod, $sym) = @_;
		3582	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3583	$self->update_binding_widgets;
		3584	$self->commit if $commit;
		3585	$end_cb->() if $end_cb;
		3586	});
		3587	}
		3588
		3589	# $mod and $sym are the modifiers and key symbol
		3590	# $cmds is a array ref of strings (the commands)
		3591	# $cb is the callback that is executed on OK
		3592	# $ccb is the callback that is executed on CANCEL and
		3593	# when the binding was unsuccessful on OK
		3594	sub set_binding {
		3595	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3596
		3597	$self->clear_command_list;
		3598	$self->{recording} = 0;
		3599	$self->{rec_btn}->set_text ("start recording");
		3600
		3601	$self->{binding} = [$mod, $sym];
		3602	$self->{commands} = $cmds;
		3603
		3604	$self->{binding_change} = $cb;
		3605	$self->{binding_cancel} = $ccb;
		3606
		3607	$self->update_binding_widgets;
		3608	}
		3609
		3610	# this is a shortcut method that asks for a binding
		3611	# and then just binds it.
		3612	sub do_quick_binding {
		3613	my ($self, $cmds, $end_cb) = @_;
		3614	$self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
		3615	$self->ask_for_bind (1, $end_cb);
		3616	}
		3617
		3618	sub update_binding_widgets {
		3619	my ($self) = @_;
		3620	my ($mod, $sym, $cmds) = $self->get_binding;
		3621	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3622	$self->set_command_list ($cmds);
		3623	}
		3624
		3625	sub get_binding {
		3626	my ($self) = @_;
		3627	return (
		3628	$self->{binding}->[0],
		3629	$self->{binding}->[1],
		3630	[ grep { defined $_ } @{$self->{commands}} ]
		3631	);
		3632	}
		3633
		3634	sub clear_command_list {
		3635	my ($self) = @_;
		3636	$self->{cmdbox}->clear ();
		3637	}
		3638
		3639	sub set_command_list {
		3640	my ($self, $cmds) = @_;
		3641
		3642	$self->{cmdbox}->clear ();
		3643	$self->{commands} = $cmds;
		3644
		3645	my $idx = 0;
		3646
		3647	for (@$cmds) {
		3648	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3649
		3650	my $i = $idx;
		3651	$hb->add (new CFClient::UI::Label text => $_);
		3652	$hb->add (new CFClient::UI::Button
		3653	text => "delete",
		3654	tooltip => "Deletes the action from the record",
		3655	on_activate => sub {
		3656	$self->{cmdbox}->remove ($hb);
		3657	$cmds->[$i] = undef;
		3658	});
		3659
		3660
		3661	$idx++
		3662	}
		3663	}
		3664
		3665	#############################################################################
		3666
		3667	package CFClient::UI::SpellList;
		3668
		3669	our @ISA = CFClient::UI::Table::;
		3670
		3671	sub new {
		3672	my $class = shift;
		3673
		3674	my $self = $class->SUPER::new (
		3675	binding => [],
		3676	commands => [],
2278	@_,	3677	@_,
2279	)	3678	)
2280	}	3679	}
2281		3680
		3681	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3682
		3683	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3684	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3685	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3686	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3687	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3688	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3689	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3690	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3691	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3692	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3693
		3694	sub rebuild_spell_list {
		3695	my ($self) = @_;
		3696
		3697	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3698	$self->clear;
		3699
		3700	return unless $::CONN;
		3701
		3702	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3703	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3704	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3705	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3706	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3707
		3708	my $row = 0;
		3709
		3710	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3711	my $spell = $self->{spell}{$_};
		3712
		3713	$row++;
		3714
		3715	my $spell_cb = sub {
		3716	my ($widget, $ev) = @_;
		3717
		3718	if ($ev->{button} == 1) {
		3719	$::CONN->user_send ("cast $spell->{name}");
		3720	} elsif ($ev->{button} == 2) {
		3721	$::CONN->user_send ("invoke $spell->{name}");
		3722	} elsif ($ev->{button} == 3) {
		3723	(new CFClient::UI::Menu
		3724	items => [
		3725	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3726	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3727	],
		3728	)->popup ($ev);
		3729	} else {
		3730	return 0;
		3731	}
		3732
		3733	1
		3734	};
		3735
		3736	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3737
		3738	#TODO: add path info to tooltip
		3739	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3740
		3741	$self->add (0, $row, new CFClient::UI::Face
		3742	face => $spell->{face},
		3743	can_hover => 1,
		3744	can_events => 1,
		3745	tooltip => $tooltip,
		3746	on_button_down => $spell_cb,
		3747	);
		3748
		3749	$self->add (1, $row, new CFClient::UI::Label
		3750	expand => 1,
		3751	text => $spell->{name},
		3752	can_hover => 1,
		3753	can_events => 1,
		3754	tooltip => $tooltip,
		3755	on_button_down => $spell_cb,
		3756	);
		3757
		3758	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3759	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3760	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3761	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3762	}
		3763	});
		3764	}
		3765
		3766	sub add_spell {
		3767	my ($self, $spell) = @_;
		3768
		3769	$self->{spell}->{$spell->{name}} = $spell;
		3770	$self->rebuild_spell_list;
		3771	}
		3772
		3773	sub remove_spell {
		3774	my ($self, $spell) = @_;
		3775
		3776	delete $self->{spell}->{$spell->{name}};
		3777	$self->rebuild_spell_list;
		3778	}
		3779
		3780	sub clear_spells {
		3781	my ($self) = @_;
		3782
		3783	$self->{spell} = {};
		3784	$self->rebuild_spell_list;
		3785	}
		3786
		3787	#############################################################################
		3788
		3789	package CFClient::UI::Root;
		3790
		3791	our @ISA = CFClient::UI::Container::;
		3792
		3793	use List::Util qw(min max);
		3794
		3795	use CFClient::OpenGL;
		3796
		3797	sub new {
		3798	my $class = shift;
		3799
		3800	my $self = $class->SUPER::new (
		3801	visible => 1,
		3802	@_,
		3803	);
		3804
		3805	Scalar::Util::weaken ($self->{root} = $self);
		3806
		3807	$self
		3808	}
		3809
2282	sub size_request {	3810	sub size_request {
2283	(32, 8)
2284	}
2285
2286	sub draw {
2287	my ($self) = @_;	3811	my ($self) = @_;
2288		3812
2289	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	3813	($self->{w}, $self->{h})
2290
2291	if ($tex) {
2292	glEnable GL_BLEND;
2293	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2294	glEnable GL_TEXTURE_2D;
2295	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2296	glColor 1, 1, 1, 1;
2297	$tex->draw_quad (0, 0, $self->{w}, $self->{h});
2298	glDisable GL_TEXTURE_2D;
2299	glDisable GL_BLEND;
2300	}
2301	}	3814	}
2302		3815
2303	#############################################################################	3816	sub _to_pixel {
		3817	my ($coord, $size, $max) = @_;
2304		3818
2305	package CFClient::UI::Root;	3819	$coord =
		3820	$coord eq "center" ? ($max - $size) * 0.5
		3821	: $coord eq "max" ? $max
		3822	: $coord;
2306		3823
2307	our @ISA = CFClient::UI::Container::;	3824	$coord = 0 if $coord < 0;
		3825	$coord = $max - $size if $coord > $max - $size;
2308		3826
2309	use CFClient::OpenGL;	3827	int $coord + 0.5
2310
2311	sub check_size {
2312	my ($self) = @_;
2313
2314	$self->configure (0, 0, $::WIDTH, $::HEIGHT);
2315	}	3828	}
2316		3829
2317	sub size_request {	3830	sub invoke_size_allocate {
2318	($::WIDTH, $::HEIGHT)
2319	}
2320
2321	sub configure {
2322	my ($self, $x, $y, $w, $h) = @_;	3831	my ($self, $w, $h) = @_;
2323		3832
2324	$self->SUPER::configure ($x, $y, $w, $h);
2325
2326	for my $child (@{$self->{children}}) {	3833	for my $child ($self->children) {
2327	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3834	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2328		3835
2329	$X = List::Util::max 0, List::Util::min $w - $W, $X;	3836	$X = $child->{force_x} if exists $child->{force_x};
2330	$Y = List::Util::max 0, List::Util::min $h - $H, $Y;	3837	$Y = $child->{force_y} if exists $child->{force_y};
		3838
		3839	$X = _to_pixel $X, $W, $self->{w};
		3840	$Y = _to_pixel $Y, $H, $self->{h};
		3841
2331	$child->configure ($X, $Y, $W,$H);	3842	$child->configure ($X, $Y, $W, $H);
		3843	}
		3844
2332	}	3845	1
2333	}	3846	}
2334		3847
2335	sub _topleft {	3848	sub coord2local {
2336	my ($self, $x, $y) = @_;	3849	my ($self, $x, $y) = @_;
2337		3850
2338	($x, $y)	3851	($x, $y)
2339	}	3852	}
2340		3853
		3854	sub coord2global {
		3855	my ($self, $x, $y) = @_;
		3856
		3857	($x, $y)
		3858	}
		3859
2341	sub update {	3860	sub update {
2342	my ($self) = @_;	3861	my ($self) = @_;
2343		3862
2344	$self->check_size;	3863	$::WANT_REFRESH++;
2345	::refresh ();
2346	}	3864	}
2347		3865
2348	sub add {	3866	sub add {
2349	my ($self, $child) = @_;	3867	my ($self, @children) = @_;
2350		3868
2351	# integerize window positions	3869	$_->{is_toplevel} = 1
2352	$child->{x} = int $child->{x};	3870	for @children;
2353	$child->{y} = int $child->{y};
2354		3871
2355	$self->SUPER::add ($child);	3872	$self->SUPER::add (@children);
		3873	}
		3874
		3875	sub remove {
		3876	my ($self, @children) = @_;
		3877
		3878	$self->SUPER::remove (@children);
		3879
		3880	delete $self->{is_toplevel}
		3881	for @children;
		3882
		3883	while (@children) {
		3884	my $w = pop @children;
		3885	push @children, $w->children;
		3886	$w->set_invisible;
		3887	}
2356	}	3888	}
2357		3889
2358	sub on_refresh {	3890	sub on_refresh {
2359	my ($self, $id, $cb) = @_;	3891	my ($self, $id, $cb) = @_;
2360		3892
2361	$self->{refresh_hook}{$id} = $cb;	3893	$self->{refresh_hook}{$id} = $cb;
2362	}	3894	}
2363		3895
		3896	sub on_post_alloc {
		3897	my ($self, $id, $cb) = @_;
		3898
		3899	$self->{post_alloc_hook}{$id} = $cb;
		3900	}
		3901
2364	sub draw {	3902	sub draw {
2365	my ($self) = @_;	3903	my ($self) = @_;
2366		3904
2367	while (my $rcb = delete $self->{refresh_hook}) {	3905	while ($self->{refresh_hook}) {
2368	$_->() for values %$rcb;	3906	$_->()
		3907	for values %{delete $self->{refresh_hook}};
2369	}	3908	}
		3909
		3910	if ($self->{realloc}) {
		3911	my %queue;
		3912	my @queue;
		3913	my $widget;
		3914
		3915	outer:
		3916	while () {
		3917	if (my $realloc = delete $self->{realloc}) {
		3918	for $widget (values %$realloc) {
		3919	$widget->{visible} or next; # do not resize invisible widgets
		3920
		3921	$queue{$widget+0}++ and next; # duplicates are common
		3922
		3923	push @{ $queue[$widget->{visible}] }, $widget;
		3924	}
		3925	}
		3926
		3927	while () {
		3928	@queue or last outer;
		3929
		3930	$widget = pop @{ $queue[-1] || [] }
		3931	and last;
		3932
		3933	pop @queue;
		3934	}
		3935
		3936	delete $queue{$widget+0};
		3937
		3938	my ($w, $h) = $widget->size_request;
		3939
		3940	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3941	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3942
		3943	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3944	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3945
		3946	$w = $widget->{force_w} if exists $widget->{force_w};
		3947	$h = $widget->{force_h} if exists $widget->{force_h};
		3948
		3949	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3950	|| delete $widget->{force_realloc}) {
		3951	$widget->{req_w} = $w;
		3952	$widget->{req_h} = $h;
		3953
		3954	$self->{size_alloc}{$widget+0} = $widget;
		3955
		3956	if (my $parent = $widget->{parent}) {
		3957	$self->{realloc}{$parent+0} = $parent
		3958	unless $queue{$parent+0};
		3959
		3960	$parent->{force_size_alloc} = 1;
		3961	$self->{size_alloc}{$parent+0} = $parent;
		3962	}
		3963	}
		3964
		3965	delete $self->{realloc}{$widget+0};
		3966	}
		3967	}
		3968
		3969	while (my $size_alloc = delete $self->{size_alloc}) {
		3970	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3971	values %$size_alloc;
		3972
		3973	while () {
		3974	my $widget = pop @queue || last;
		3975
		3976	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
		3977
		3978	$w = 0 if $w < 0;
		3979	$h = 0 if $h < 0;
		3980
		3981	$w = int $w + 0.5;
		3982	$h = int $h + 0.5;
		3983
		3984	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3985	$widget->{old_w} = $widget->{w};
		3986	$widget->{old_h} = $widget->{h};
		3987
		3988	$widget->{w} = $w;
		3989	$widget->{h} = $h;
		3990
		3991	$widget->emit (size_allocate => $w, $h);
		3992	}
		3993	}
		3994	}
		3995
		3996	while ($self->{post_alloc_hook}) {
		3997	$_->()
		3998	for values %{delete $self->{post_alloc_hook}};
		3999	}
		4000
2370		4001
2371	glViewport 0, 0, $::WIDTH, $::HEIGHT;	4002	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2372	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	4003	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2373	glClear GL_COLOR_BUFFER_BIT;	4004	glClear GL_COLOR_BUFFER_BIT;
2374		4005
2375	glMatrixMode GL_PROJECTION;	4006	glMatrixMode GL_PROJECTION;
2376	glLoadIdentity;	4007	glLoadIdentity;
2377	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;	4008	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2378	glMatrixMode GL_MODELVIEW;	4009	glMatrixMode GL_MODELVIEW;
2379	glLoadIdentity;	4010	glLoadIdentity;
2380		4011
		4012	{
		4013	package CFClient::UI::Base;
		4014
		4015	($draw_x, $draw_y, $draw_w, $draw_h) =
		4016	(0, 0, $self->{w}, $self->{h});
		4017	}
		4018
2381	$self->_draw;	4019	$self->_draw;
2382	}	4020	}
2383		4021
2384	#############################################################################	4022	#############################################################################
2385		4023
2386	package CFClient::UI;	4024	package CFClient::UI;
2387		4025
2388	$ROOT = new CFClient::UI::Root;	4026	$ROOT = new CFClient::UI::Root;
2389	$TOOLTIP = new CFClient::UI::Tooltip;	4027	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2390		4028
2391	1	4029	1
2392		4030

Diff Legend

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