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.165 by root, Mon Apr 24 08:22:22 2006 UTC vs.
Revision 1.267 by root, Thu Jun 1 04:10:29 2006 UTC

1	package CFClient::UI;	1	package CFClient::UI;
2		2
		3	use utf8;
3	use strict;	4	use strict;
4		5
5	use Scalar::Util ();	6	use Scalar::Util ();
6	use List::Util ();	7	use List::Util ();
7		8
8	use CFClient;	9	use CFClient;
		10	use CFClient::Texture;
9		11
10	our ($FOCUS, $HOVER, $GRAB); # various widgets	12	our ($FOCUS, $HOVER, $GRAB); # various widgets
11		13
		14	our $LAYOUT;
12	our $ROOT;	15	our $ROOT;
13	our $TOOLTIP;	16	our $TOOLTIP;
14	our $BUTTON_STATE;	17	our $BUTTON_STATE;
15		18
		19	our %WIDGET; # all widgets, weak-referenced
		20
		21	sub get_layout {
		22	my $layout;
		23
		24	for (grep { $_->{name} } values %WIDGET) {
		25	my $win = $layout->{$_->{name}} = { };
		26
		27	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
		28	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
		29	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
		30	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
		31
		32	$win->{show} = $_->{visible} && $_->{is_toplevel};
		33	}
		34
		35	$layout
		36	}
		37
		38	sub set_layout {
		39	my ($layout) = @_;
		40
		41	$LAYOUT = $layout;
		42	}
		43
16	sub check_tooltip {	44	sub check_tooltip {
		45	return if $ENV{CFPLUS_DEBUG} & 8;
		46
17	if (!$GRAB) {	47	if (!$GRAB) {
18	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	48	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
19	if (length $widget->{tooltip}) {	49	if (length $widget->{tooltip}) {
20
21	if ($TOOLTIP->{owner} != $widget) {	50	if ($TOOLTIP->{owner} != $widget) {
		51	$TOOLTIP->hide;
		52
22	$TOOLTIP->{owner} = $widget;	53	$TOOLTIP->{owner} = $widget;
23		54
24	my $tip = $widget->{tooltip};	55	my $tip = $widget->{tooltip};
25		56
26	$tip = $tip->($widget) if CODE:: eq ref $tip;	57	$tip = $tip->($widget) if CODE:: eq ref $tip;
27		58
28	$TOOLTIP->set_markup ($widget->{tooltip});	59	$TOOLTIP->set_tooltip_from ($widget);
29	$TOOLTIP->move ($widget->coord2global ($widget->{w}, 0));
30	$TOOLTIP->show;	60	$TOOLTIP->show;
31	}	61	}
32		62
33	return;	63	return;
34	}	64	}
…		…
39	delete $TOOLTIP->{owner};	69	delete $TOOLTIP->{owner};
40	}	70	}
41		71
42	# class methods for events	72	# class methods for events
43	sub feed_sdl_key_down_event {	73	sub feed_sdl_key_down_event {
44	$FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0])	74	$FOCUS->emit (key_down => $_[0])
45	if $FOCUS;	75	if $FOCUS;
46	}	76	}
47		77
48	sub feed_sdl_key_up_event {	78	sub feed_sdl_key_up_event {
49	$FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0])	79	$FOCUS->emit (key_up => $_[0])
50	if $FOCUS;	80	if $FOCUS;
51	}	81	}
52		82
53	sub feed_sdl_button_down_event {	83	sub feed_sdl_button_down_event {
54	my ($ev) = @_;	84	my ($ev) = @_;
…		…
63	check_tooltip;	93	check_tooltip;
64	}	94	}
65		95
66	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	96	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
67		97
68	if ($GRAB) {	98	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
69	($x, $y) = $GRAB->coord2local ($x, $y);	99	if $GRAB;
70	$GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
71	}
72	}	100	}
73		101
74	sub feed_sdl_button_up_event {	102	sub feed_sdl_button_up_event {
75	my ($ev) = @_;	103	my ($ev) = @_;
76	my ($x, $y) = ($ev->{x}, $ev->{y});	104	my ($x, $y) = ($ev->{x}, $ev->{y});
77		105
78	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	106	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
79		107
80	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	108	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
81		109
82	if ($GRAB) {	110	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
83	($x, $y) = $GRAB->coord2local ($x, $y);	111	if $GRAB;
84	$GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
85	}
86		112
87	if (!$BUTTON_STATE) {	113	if (!$BUTTON_STATE) {
88	my $grab = $GRAB; undef $GRAB;	114	my $grab = $GRAB; undef $GRAB;
89	$grab->update if $grab;	115	$grab->update if $grab;
90	$GRAB->update if $GRAB;	116	$GRAB->update if $GRAB;
…		…
106	$HOVER->update if $HOVER && $HOVER->{can_hover};	132	$HOVER->update if $HOVER && $HOVER->{can_hover};
107		133
108	check_tooltip;	134	check_tooltip;
109	}	135	}
110		136
111	if ($HOVER) {
112	($x, $y) = $HOVER->coord2local ($x, $y);
113	$HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y);	137	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
114	}	138	if $HOVER;
115	}	139	}
116		140
117	# convert position array to integers	141	# convert position array to integers
118	sub harmonize {	142	sub harmonize {
119	my ($vals) = @_;	143	my ($vals) = @_;
…		…
125	$rem += $_ - $i;	149	$rem += $_ - $i;
126	$_ = $i;	150	$_ = $i;
127	}	151	}
128	}	152	}
129		153
		154	sub full_refresh {
		155	# make a copy, otherwise for complains about freed values.
		156	my @widgets = values %WIDGET;
		157
		158	$_->update
		159	for @widgets;
		160	}
		161
		162	sub reconfigure_widgets {
		163	# make a copy, otherwise C<for> complains about freed values.
		164	my @widgets = values %WIDGET;
		165
		166	$_->reconfigure
		167	for @widgets;
		168	}
		169
		170	# call when resolution changes etc.
		171	sub rescale_widgets {
		172	my ($sx, $sy) = @_;
		173
		174	for my $widget (values %WIDGET) {
		175	if ($widget->{is_toplevel}) {
		176	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		177	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		178
		179	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
		180	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
		181	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
		182	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
		183	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
		184	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
		185
		186	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		187	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		188
		189	}
		190	}
		191
		192	reconfigure_widgets;
		193	}
		194
130	#############################################################################	195	#############################################################################
131		196
132	package CFClient::UI::Base;	197	package CFClient::UI::Base;
133		198
134	use strict;	199	use strict;
…		…
137		202
138	sub new {	203	sub new {
139	my $class = shift;	204	my $class = shift;
140		205
141	my $self = bless {	206	my $self = bless {
142	x => 0,	207	x => "center",
143	y => 0,	208	y => "center",
144	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
145	can_events => 1,	212	can_events => 1,
146	@_	213	@_
147	}, $class;	214	}, $class;
148		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		217
149	for (keys %$self) {	218	for (keys %$self) {
150	if (/^connect_(.*)$/) {	219	if (/^on_(.*)$/) {
151	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
152	}	221	}
153	}	222	}
154		223
		224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		227	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		228	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		229
		230	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		231	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		232
		233	$self->show if $layout->{show};
		234	}
		235
155	$self	236	$self
156	}	237	}
157		238
158	sub destroy {	239	sub destroy {
159	my ($self) = @_;	240	my ($self) = @_;
…		…
168	return if $self->{parent};	249	return if $self->{parent};
169		250
170	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
171	}	252	}
172		253
173	sub hide {	254	sub set_visible {
174	my ($self) = @_;	255	my ($self) = @_;
		256
		257	return if $self->{visible};
		258
		259	$self->{root} = $self->{parent}{root};
		260	$self->{visible} = $self->{parent}{visible} + 1;
		261
		262	$self->emit (visibility_change => 1);
		263
		264	$self->realloc if !exists $self->{req_w};
		265
		266	$_->set_visible for $self->children;
		267	}
		268
		269	sub set_invisible {
		270	my ($self) = @_;
		271
		272	return unless $self->{visible};
		273
		274	$_->set_invisible for $self->children;
		275
		276	delete $self->{root};
		277	delete $self->{visible};
175		278
176	undef $GRAB if $GRAB == $self;	279	undef $GRAB if $GRAB == $self;
177	undef $HOVER if $HOVER == $self;	280	undef $HOVER if $HOVER == $self;
178		281
		282	CFClient::UI::check_tooltip
		283	if $TOOLTIP->{owner} == $self;
		284
		285	$self->focus_out;
		286
		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
		307	sub hide {
		308	my ($self) = @_;
		309
		310	$self->set_invisible;
		311
179	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
180	if $self->{parent};	313	if $self->{parent};
181	}	314	}
182		315
183	sub move {	316	sub move_abs {
184	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
185		318
186	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
187	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
188	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
189		322
190	$self->update;	323	$self->update;
191	}	324	}
192		325
193	sub set_size {	326	sub set_size {
194	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
195		328
196	$self->{user_w} = $w;	329	$self->{force_w} = $w;
197	$self->{user_h} = $h;	330	$self->{force_h} = $h;
198		331
199	$self->check_size;	332	$self->realloc;
200	}	333	}
201		334
202	sub size_request {	335	sub size_request {
203	require Carp;	336	require Carp;
204	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
206		339
207	sub configure {	340	sub configure {
208	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
209		342
210	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
211	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
212	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
213		348
214	# use alignment to adjust x, y	349	# use alignment to adjust x, y
215		350
216	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
217	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
218
219	($w, $h) = ($w2, $h2);
220	}	353	}
221		354
222	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
223	$self->{x} = $x;	356	$self->{x} = $x;
224	$self->{y} = $y;	357	$self->{y} = $y;
225	$self->update;	358	$self->update;
226	}	359	}
227		360
228	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
		362	return unless $self->{visible};
		363
229	$self->{w} = $w;	364	$self->{alloc_w} = $w;
230	$self->{h} = $h;	365	$self->{alloc_h} = $h;
231		366
232	$self->size_allocate ($w, $h);	367	$self->{root}{size_alloc}{$self+0} = $self;
233	$self->update;
234	}	368	}
235	}	369	}
236		370
237	sub size_allocate {	371	sub size_allocate {
238	# nothing to be done	372	# nothing to be done
239	}	373	}
240		374
		375	sub children {
		376	}
		377
241	sub set_max_size {	378	sub set_max_size {
242	my ($self, $w, $h) = @_;	379	my ($self, $w, $h) = @_;
243		380
244	delete $self->{max_w}; $self->{max_w} = $w if $w;	381	delete $self->{max_w}; $self->{max_w} = $w if $w;
245	delete $self->{max_h}; $self->{max_h} = $h if $h;	382	delete $self->{max_h}; $self->{max_h} = $h if $h;
246	}	383	}
247		384
248	# return top left coordinates	385	sub set_tooltip {
249	sub _topleft {
250	my ($self, $x, $y) = @_;	386	my ($self, $tooltip) = @_;
251		387
252	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});	388	$tooltip =~ s/^\s+//;
		389	$tooltip =~ s/\s+$//;
		390
		391	return if $self->{tooltip} eq $tooltip;
		392
		393	$self->{tooltip} = $tooltip;
		394
		395	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
		396	delete $CFClient::UI::TOOLTIP->{owner};
		397	CFClient::UI::check_tooltip;
		398	}
253	}	399	}
254		400
255	# translate global coordinates to local coordinate system	401	# translate global coordinates to local coordinate system
256	sub coord2local {	402	sub coord2local {
257	my ($self, $x, $y) = @_;	403	my ($self, $x, $y) = @_;
258		404
259	my ($X, $Y) = $self->_topleft;	405	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
260	($x - $X, $y - $Y)
261	}	406	}
262		407
263	# translate local coordinates to global coordinate system	408	# translate local coordinates to global coordinate system
264	sub coord2global {	409	sub coord2global {
265	my ($self, $x, $y) = @_;	410	my ($self, $x, $y) = @_;
266		411
267	my ($X, $Y) = $self->_topleft;	412	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
268	($x + $X, $y + $Y)
269	}	413	}
270		414
271	sub focus_in {	415	sub focus_in {
272	my ($self) = @_;	416	my ($self) = @_;
273		417
274	return if $FOCUS == $self;	418	return if $FOCUS == $self;
275	return unless $self->{can_focus};	419	return unless $self->{can_focus};
276		420
277	my $focus = $FOCUS; $FOCUS = $self;	421	my $focus = $FOCUS; $FOCUS = $self;
278		422
279	$self->emit (focus_in => $focus);	423	$self->_emit (focus_in => $focus);
280		424
281	$focus->update if $focus;	425	$focus->update if $focus;
282	$FOCUS->update;	426	$FOCUS->update;
283	}	427	}
284		428
…		…
287		431
288	return unless $FOCUS == $self;	432	return unless $FOCUS == $self;
289		433
290	my $focus = $FOCUS; undef $FOCUS;	434	my $focus = $FOCUS; undef $FOCUS;
291		435
292	$self->emit (focus_out => $focus);	436	$self->_emit (focus_out => $focus);
293		437
294	$focus->update if $focus; #?	438	$focus->update if $focus; #?
		439
		440	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		441	unless $FOCUS;
295	}	442	}
296		443
297	sub mouse_motion { }	444	sub mouse_motion { }
298	sub button_up { }	445	sub button_up { }
299	sub key_down { }	446	sub key_down { }
300	sub key_up { }	447	sub key_up { }
301		448
302	sub button_down {	449	sub button_down {
303	my ($self, $ev, $x, $y) = @_;	450	my ($self, $ev, $x, $y) = @_;
304		451
305	$self->focus_in;	452	$self->focus_in;
306	}	453	}
307		454
308	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	455	sub find_widget {
309	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	456	my ($self, $x, $y) = @_;
310	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	457
311	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	458	return () unless $self->{can_events};
312	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	459
		460	return $self
		461	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		462	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		463
		464	()
		465	}
		466
		467	sub set_parent {
		468	my ($self, $parent) = @_;
		469
		470	Scalar::Util::weaken ($self->{parent} = $parent);
		471	$self->set_visible if $parent->{visible};
		472	}
		473
		474	sub connect {
		475	my ($self, $signal, $cb) = @_;
		476
		477	push @{ $self->{signal_cb}{$signal} }, $cb;
		478	}
		479
		480	sub _emit {
		481	my ($self, $signal, @args) = @_;
		482
		483	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		484	}
		485
		486	sub emit {
		487	my ($self, $signal, @args) = @_;
		488
		489	$self->_emit ($signal, @args)
		490	|| $self->$signal (@args);
		491	}
		492
		493	sub visibility_change {
		494	#my ($self, $visible) = @_;
		495	}
		496
		497	sub realloc {
		498	my ($self) = @_;
		499
		500	if ($self->{visible}) {
		501	return if $self->{root}{realloc}{$self+0};
		502
		503	$self->{root}{realloc}{$self+0} = $self;
		504	$self->{root}->update;
		505	} else {
		506	delete $self->{req_w};
		507	delete $self->{req_h};
		508	}
		509	}
		510
		511	sub update {
		512	my ($self) = @_;
		513
		514	$self->{parent}->update
		515	if $self->{parent};
		516	}
		517
		518	sub reconfigure {
		519	my ($self) = @_;
		520
		521	$self->realloc;
		522	$self->update;
		523	}
		524
		525	# using global variables seems a bit hacky, but passing through all drawing
		526	# functions seems pointless.
		527	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
313		528
314	sub draw {	529	sub draw {
315	my ($self) = @_;	530	my ($self) = @_;
316		531
317	return unless $self->{h} && $self->{w};	532	return unless $self->{h} && $self->{w};
		533
		534	local $draw_x = $draw_x + $self->{x};
		535	local $draw_y = $draw_y + $self->{y};
		536
		537	return if $draw_x + $self->{w} < 0;
		538	return if $draw_x >= $draw_w;
		539	return if $draw_y + $self->{h} < 0;
		540	return if $draw_y >= $draw_h;
318		541
319	glPushMatrix;	542	glPushMatrix;
320	glTranslate $self->{x}, $self->{y}, 0;	543	glTranslate $self->{x}, $self->{y}, 0;
321	$self->_draw;	544	$self->_draw;
322	glPopMatrix;	545	glPopMatrix;
…		…
334	glVertex $x , $y + $self->{h};	557	glVertex $x , $y + $self->{h};
335	glEnd;	558	glEnd;
336	glDisable GL_BLEND;	559	glDisable GL_BLEND;
337	}	560	}
338		561
339	if ($ENV{PCLIENT_DEBUG}) {	562	if ($ENV{CFPLUS_DEBUG} & 1) {
340	glPushMatrix;	563	glPushMatrix;
341	glColor 1, 1, 0, 1;	564	glColor 1, 1, 0, 1;
342	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	565	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
343	glBegin GL_LINE_LOOP;	566	glBegin GL_LINE_LOOP;
344	glVertex 0 , 0;	567	glVertex 0 , 0;
345	glVertex $self->{w}, 0;	568	glVertex $self->{w} - 1, 0;
346	glVertex $self->{w}, $self->{h};	569	glVertex $self->{w} - 1, $self->{h} - 1;
347	glVertex 0 , $self->{h};	570	glVertex 0 , $self->{h} - 1;
348	glEnd;	571	glEnd;
349	glPopMatrix;	572	glPopMatrix;
350	CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	573	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
351	}	574	}
352	}	575	}
353		576
354	sub _draw {	577	sub _draw {
355	my ($self) = @_;	578	my ($self) = @_;
356		579
357	warn "no draw defined for $self\n";	580	warn "no draw defined for $self\n";
358	}	581	}
359		582
360	sub find_widget {
361	my ($self, $x, $y) = @_;
362
363	return () unless $self->{can_events};
364
365	return $self
366	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
367	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
368
369	()
370	}
371
372	sub set_parent {
373	my ($self, $parent) = @_;
374
375	Scalar::Util::weaken ($self->{parent} = $parent);
376	}
377
378	sub check_size {
379	my ($self) = @_;
380
381	$self->{parent}
382	or return 1;
383
384	my ($w, $h) = $self->{user_w} && $self->{user_h}
385	? @$self{qw(user_w user_h)}
386	: $self->size_request;
387
388	if ($w != $self->{req_w} || $h != $self->{req_h}) {
389	$self->{req_w} = $w;
390	$self->{req_h} = $h;
391
392	$self->{parent}->check_size
393	or $self->size_allocate (
394	(List::Util::max $self->{w}, $w),
395	(List::Util::max $self->{h}, $h),
396	);
397
398	1
399	} else {
400	0
401	}
402	}
403
404	sub update {
405	my ($self) = @_;
406
407	$self->{parent}->update
408	if $self->{parent};
409	}
410
411	sub connect {
412	my ($self, $signal, $cb) = @_;
413
414	push @{ $self->{signal_cb}{$signal} }, $cb;
415	}
416
417	sub emit {
418	my ($self, $signal, @args) = @_;
419
420	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
421	}
422
423	sub DESTROY {	583	sub DESTROY {
424	my ($self) = @_;	584	my ($self) = @_;
425		585
		586	delete $WIDGET{$self+0};
426	#$self->deactivate;	587	#$self->deactivate;
427	}	588	}
428		589
429	#############################################################################	590	#############################################################################
430		591
…		…
439	my $class = shift;	600	my $class = shift;
440		601
441	# range [value, low, high, page]	602	# range [value, low, high, page]
442		603
443	$class->SUPER::new (	604	$class->SUPER::new (
444	bg => [0, 0, 0, 0.2],	605	#bg => [0, 0, 0, 0.2],
445	active_bg => [1, 1, 1, 0.5],	606	#active_bg => [1, 1, 1, 0.5],
446	@_	607	@_
447	)	608	)
448	}	609	}
449		610
450	sub _draw {	611	sub _draw {
451	my ($self) = @_;	612	my ($self) = @_;
452		613
		614	my $color = $FOCUS == $self && $self->{active_bg}
		615	? $self->{active_bg}
		616	: $self->{bg};
		617
		618	if ($color && (@$color < 4 || $color->[3])) {
453	my ($w, $h) = @$self{qw(w h)};	619	my ($w, $h) = @$self{qw(w h)};
454		620
455	glEnable GL_BLEND;	621	glEnable GL_BLEND;
456	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	622	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
457	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	623	glColor @$color;
458		624
459	glBegin GL_QUADS;	625	glBegin GL_QUADS;
460	glVertex 0 , 0;	626	glVertex 0 , 0;
461	glVertex 0 , $h;	627	glVertex 0 , $h;
462	glVertex $w, $h;	628	glVertex $w, $h;
463	glVertex $w, 0;	629	glVertex $w, 0;
464	glEnd;	630	glEnd;
465		631
466	glDisable GL_BLEND;	632	glDisable GL_BLEND;
		633	}
467	}	634	}
468		635
469	#############################################################################	636	#############################################################################
470		637
471	package CFClient::UI::Empty;	638	package CFClient::UI::Empty;
…		…
476	my ($class, %arg) = @_;	643	my ($class, %arg) = @_;
477	$class->SUPER::new (can_events => 0, %arg);	644	$class->SUPER::new (can_events => 0, %arg);
478	}	645	}
479		646
480	sub size_request {	647	sub size_request {
481	(0, 0)	648	my ($self) = @_;
		649
		650	($self->{w} + 0, $self->{h} + 0)
482	}	651	}
483		652
484	sub draw { }	653	sub draw { }
485		654
486	#############################################################################	655	#############################################################################
…		…
492	sub new {	661	sub new {
493	my ($class, %arg) = @_;	662	my ($class, %arg) = @_;
494		663
495	my $children = delete $arg{children} || [];	664	my $children = delete $arg{children} || [];
496		665
497	my $self = $class->SUPER::new (children => [], can_events => 0, %arg);	666	my $self = $class->SUPER::new (
		667	children => [],
		668	can_events => 0,
		669	%arg,
		670	);
498	$self->add ($_) for @$children;	671	$self->add ($_) for @$children;
499		672
500	$self	673	$self
501	}	674	}
502		675
503	sub add {	676	sub add {
504	my ($self, $child) = @_;	677	my ($self, @widgets) = @_;
505		678
506	$child->set_parent ($self);	679	$_->set_parent ($self)
		680	for @widgets;
507		681
508	use sort 'stable';	682	use sort 'stable';
509		683
510	$self->{children} = [	684	$self->{children} = [
511	sort { $a->{z} <=> $b->{z} }	685	sort { $a->{z} <=> $b->{z} }
512	@{$self->{children}}, $child	686	@{$self->{children}}, @widgets
513	];	687	];
514		688
515	$child->check_size;	689	$self->realloc;
		690	}
		691
		692	sub children {
		693	@{ $_[0]{children} }
516	}	694	}
517		695
518	sub remove {	696	sub remove {
519	my ($self, $child) = @_;	697	my ($self, $child) = @_;
520		698
521	delete $child->{parent};	699	delete $child->{parent};
522	$child->hide;	700	$child->hide;
523		701
524	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	702	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
525		703
526	$self->check_size;	704	$self->realloc;
527	$self->update;
528	}	705	}
529		706
530	sub clear {	707	sub clear {
531	my ($self) = @_;	708	my ($self) = @_;
532		709
…		…
535		712
536	for (@$children) {	713	for (@$children) {
537	delete $_->{parent};	714	delete $_->{parent};
538	$_->hide;	715	$_->hide;
539	}	716	}
		717
		718	$self->realloc;
540	}	719	}
541		720
542	sub find_widget {	721	sub find_widget {
543	my ($self, $x, $y) = @_;	722	my ($self, $x, $y) = @_;
544		723
…		…
619	}	798	}
620		799
621	sub update {	800	sub update {
622	my ($self) = @_;	801	my ($self) = @_;
623		802
624	# we want to do this delayed...	803	$ROOT->on_post_alloc ($self => sub { $self->render_child });
625	$self->render_chld;
626	$self->SUPER::update;	804	$self->SUPER::update;
627	}
628
629	sub render_chld {
630	my ($self) = @_;
631
632	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
633	glClearColor 0, 0, 0, 1;
634	glClear GL_COLOR_BUFFER_BIT;
635	$self->child->draw;
636	};
637	}	805	}
638		806
639	sub size_allocate {	807	sub size_allocate {
640	my ($self, $w, $h) = @_;	808	my ($self, $w, $h) = @_;
641		809
642	$self->child->configure (0, 0, $w, $h);	810	$self->SUPER::size_allocate ($w, $h);
		811	$self->update;
		812	}
643		813
		814	sub _render {
		815	my ($self) = @_;
		816
		817	$self->{children}[0]->draw;
		818	}
		819
		820	sub render_child {
		821	my ($self) = @_;
		822
		823	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
		824	glClearColor 0, 0, 0, 0;
		825	glClear GL_COLOR_BUFFER_BIT;
		826
		827	{
		828	package CFClient::UI::Base;
		829
		830	($draw_x, $draw_y, $draw_w, $draw_h) =
		831	(0, 0, $self->{w}, $self->{h});
		832	}
		833
644	$self->render_chld;	834	$self->_render;
		835	};
645	}	836	}
646		837
647	sub _draw {	838	sub _draw {
648	my ($self) = @_;	839	my ($self) = @_;
649		840
650	my ($w, $h) = ($self->w, $self->h);	841	my ($w, $h) = @$self{qw(w h)};
651		842
652	my $tex = $self->{texture}	843	my $tex = $self->{texture}
653	or return;	844	or return;
654		845
655	glEnable GL_BLEND;
656	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
657	glEnable GL_TEXTURE_2D;	846	glEnable GL_TEXTURE_2D;
658	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	847	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		848	glColor 1, 1, 1, 1;
659		849
660	$tex->draw_quad (0, 0, $w, $h);	850	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
661		851
662	glDisable GL_BLEND;
663	glDisable GL_TEXTURE_2D;	852	glDisable GL_TEXTURE_2D;
664	}	853	}
665		854
666	#############################################################################	855	#############################################################################
667		856
668	package CFClient::UI::ViewPort;	857	package CFClient::UI::ViewPort;
669		858
670	our @ISA = CFClient::UI::Window::;	859	our @ISA = CFClient::UI::Window::;
671
672	sub new { die }
673
674	sub size_request {
675	my ($self) = @_;
676
677	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
678	$self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
679
680	@$self{qw(child_w child_h)}
681	}
682
683	sub _draw {
684	my ($self) = @_;
685
686	$self->{children}[1]->draw;
687	}
688
689
690	#############################################################################
691
692	package CFClient::UI::Frame;
693
694	our @ISA = CFClient::UI::Bin::;
695
696	use CFClient::OpenGL;
697		860
698	sub new {	861	sub new {
699	my $class = shift;	862	my $class = shift;
700		863
701	my $self = $class->SUPER::new (	864	$class->SUPER::new (
702	bg => [1, 1, 1, 1],	865	scroll_x => 0,
703	border_bg => [1, 1, 1, 1],	866	scroll_y => 1,
704	border => 0.8,
705	@_	867	@_,
706	);	868	)
707
708	$self
709	}	869	}
710		870
711	sub _draw {	871	sub size_request {
		872	my ($self) = @_;
		873
		874	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
		875
		876	$w = 10 if $self->{scroll_x};
		877	$h = 10 if $self->{scroll_y};
		878
		879	($w, $h)
		880	}
		881
		882	sub size_allocate {
712	my ($self) = @_;	883	my ($self, $w, $h) = @_;
713		884
714	my ($w, $h) = ($self->{w}, $self->{h});	885	my $child = $self->child;
715		886
716	glEnable GL_BLEND;	887	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
717	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	888	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
718	glEnable GL_TEXTURE_2D;
719	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
720		889
721	# glBegin GL_QUADS;	890	$self->child->configure (0, 0, $w, $h);
722	# glColor 0, 0, 0, 0;	891	$self->update;
723	# glVertex 0 , 0;	892	}
724	# glVertex 0 , $h;
725	# glVertex $w, $h;
726	# glVertex $w, 0;
727	# glEnd;
728		893
		894	sub set_offset {
		895	my ($self, $x, $y) = @_;
729		896
730	$self->child->draw;	897	$self->{view_x} = int $x;
731	glDisable GL_BLEND;	898	$self->{view_y} = int $y;
732	glDisable GL_TEXTURE_2D;	899
		900	$self->update;
		901	}
		902
		903	# hmm, this does not work for topleft of $self... but we should not ask for that
		904	sub coord2local {
		905	my ($self, $x, $y) = @_;
		906
		907	$self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
		908	}
		909
		910	sub coord2global {
		911	my ($self, $x, $y) = @_;
		912
		913	$x = List::Util::min $self->{w}, $x - $self->{view_x};
		914	$y = List::Util::min $self->{h}, $y - $self->{view_y};
		915
		916	$self->SUPER::coord2global ($x, $y)
		917	}
		918
		919	sub find_widget {
		920	my ($self, $x, $y) = @_;
		921
		922	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
		923	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
		924	) {
		925	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
		926	} else {
		927	$self->CFClient::UI::Base::find_widget ($x, $y)
		928	}
		929	}
		930
		931	sub _render {
		932	my ($self) = @_;
		933
		934	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		935	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		936
		937	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
		938
		939	$self->SUPER::_render;
733	}	940	}
734		941
735	#############################################################################	942	#############################################################################
736		943
737	package CFClient::UI::FancyFrame;	944	package CFClient::UI::ScrolledWindow;
738		945
739	our @ISA = CFClient::UI::Bin::;	946	our @ISA = CFClient::UI::HBox::;
740
741	use CFClient::OpenGL;
742
743	my @tex =
744	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
745	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
746		947
747	sub new {	948	sub new {
748	my $class = shift;	949	my $class = shift;
749		950
750	# TODO: user_x, user_y, overwrite moveto?	951	my $self;
		952
		953	my $slider = new CFClient::UI::Slider
		954	vertical => 1,
		955	range => [0, 0, 1, 0.01], # HACK fix
		956	on_changed => sub {
		957	$self->{vp}->set_offset (0, $_[1]);
		958	},
		959	;
		960
		961	$self = $class->SUPER::new (
		962	vp => (new CFClient::UI::ViewPort expand => 1),
		963	slider => $slider,
		964	@_,
		965	);
		966
		967	$self->{vp}->add ($self->{scrolled});
		968	$self->add ($self->{vp});
		969	$self->add ($self->{slider});
		970
		971	$self
		972	}
		973
		974	sub update {
		975	my ($self) = @_;
		976
		977	$self->SUPER::update;
		978
		979	# todo: overwrite size_allocate of child
		980	my $child = $self->{vp}->child;
		981	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		982	}
		983
		984	sub size_allocate {
		985	my ($self, $w, $h) = @_;
		986
		987	$self->SUPER::size_allocate ($w, $h);
		988
		989	my $child = $self->{vp}->child;
		990	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		991	}
		992
		993	#TODO# update range on size_allocate depending on child
		994	# update viewport offset on scroll
		995
		996	#############################################################################
		997
		998	package CFClient::UI::Frame;
		999
		1000	our @ISA = CFClient::UI::Bin::;
		1001
		1002	use CFClient::OpenGL;
		1003
		1004	sub new {
		1005	my $class = shift;
		1006
		1007	$class->SUPER::new (
		1008	bg => undef,
		1009	@_,
		1010	)
		1011	}
		1012
		1013	sub _draw {
		1014	my ($self) = @_;
		1015
		1016	if ($self->{bg}) {
		1017	my ($w, $h) = @$self{qw(w h)};
		1018
		1019	glEnable GL_BLEND;
		1020	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
		1021	glColor @{ $self->{bg} };
		1022
		1023	glBegin GL_QUADS;
		1024	glVertex 0 , 0;
		1025	glVertex 0 , $h;
		1026	glVertex $w, $h;
		1027	glVertex $w, 0;
		1028	glEnd;
		1029
		1030	glDisable GL_BLEND;
		1031	}
		1032
		1033	$self->SUPER::_draw;
		1034	}
		1035
		1036	#############################################################################
		1037
		1038	package CFClient::UI::FancyFrame;
		1039
		1040	our @ISA = CFClient::UI::Bin::;
		1041
		1042	use CFClient::OpenGL;
		1043
		1044	my $bg =
		1045	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1046	mipmap => 1, wrap => 1;
		1047
		1048	my @border =
		1049	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
		1050	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
		1051
		1052	sub new {
		1053	my $class = shift;
751		1054
752	my $self = $class->SUPER::new (	1055	my $self = $class->SUPER::new (
753	bg => [1, 1, 1, 1],	1056	bg => [1, 1, 1, 1],
754	border_bg => [1, 1, 1, 1],	1057	border_bg => [1, 1, 1, 1],
755	border => 0.8,	1058	border => 0.6,
		1059	can_events => 1,
		1060	min_w => 16,
		1061	min_h => 16,
756	@_	1062	@_
757	);	1063	);
758		1064
759	$self->{title} &&= new CFClient::UI::Label	1065	$self->{title} &&= new CFClient::UI::Label
760	align => 0,	1066	align => 0,
761	valign => 1,	1067	valign => 1,
762	text => $self->{title},	1068	text => $self->{title},
763	fontsize => 1;	1069	fontsize => $self->{border};
764		1070
765	$self	1071	$self
766	}	1072	}
767		1073
768	sub border {	1074	sub border {
…		…
784	my ($self, $w, $h) = @_;	1090	my ($self, $w, $h) = @_;
785		1091
786	$h -= List::Util::max 0, $self->border * 2;	1092	$h -= List::Util::max 0, $self->border * 2;
787	$w -= List::Util::max 0, $self->border * 2;	1093	$w -= List::Util::max 0, $self->border * 2;
788		1094
789	$self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)	1095	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
790	if $self->{title};	1096	if $self->{title};
791		1097
792	$self->child->configure ($self->border, $self->border, $w, $h);	1098	$self->child->configure ($self->border, $self->border, $w, $h);
793	}	1099	}
794		1100
795	sub button_down {	1101	sub button_down {
796	my ($self, $ev, $x, $y) = @_;	1102	my ($self, $ev, $x, $y) = @_;
797		1103
		1104	my ($w, $h) = @$self{qw(w h)};
798	my $border = $self->border;	1105	my $border = $self->border;
799		1106
800	if ($x < $self->{w} && $x >= $self->{w} - $border	1107	my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
801	&& $y < $self->{h} && $y >= $self->{h} - $border) {	1108	my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
802		1109
		1110	if ($lr & $td) {
		1111	my ($wx, $wy) = ($self->{x}, $self->{y});
803	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1112	my ($ox, $oy) = ($ev->{x}, $ev->{y});
804	my ($bw, $bh) = ($self->{w}, $self->{h});	1113	my ($bw, $bh) = ($self->{w}, $self->{h});
805		1114
		1115	my $mx = $x < $border;
		1116	my $my = $y < $border;
		1117
806	$self->{motion} = sub {	1118	$self->{motion} = sub {
807	my ($ev, $x, $y) = @_;	1119	my ($ev, $x, $y) = @_;
808		1120
809	($x, $y) = ($ev->{x}, $ev->{y});	1121	my $dx = $ev->{x} - $ox;
		1122	my $dy = $ev->{y} - $oy;
810		1123
811	$self->{user_w} = $bw + $x - $ox;	1124	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
812	$self->{user_h} = $bh + $y - $oy;	1125	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
813	$self->check_size;	1126
		1127	$self->realloc;
		1128	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
814	};	1129	};
815		1130
816	} elsif ($x >= 0 && $x < $self->{w}	1131	} elsif ($lr ^ $td) {
817	&& $y >= 0 && $y < $border) {
818
819	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1132	my ($ox, $oy) = ($ev->{x}, $ev->{y});
820	my ($bx, $by) = ($self->{x}, $self->{y});	1133	my ($bx, $by) = ($self->{x}, $self->{y});
821		1134
822	$self->{motion} = sub {	1135	$self->{motion} = sub {
823	my ($ev, $x, $y) = @_;	1136	my ($ev, $x, $y) = @_;
824		1137
825	($x, $y) = ($ev->{x}, $ev->{y});	1138	($x, $y) = ($ev->{x}, $ev->{y});
826		1139
827	$self->move ($bx + $x - $ox, $by + $y - $oy);	1140	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
828	$self->update;
829	};	1141	};
830	}	1142	}
831	}	1143	}
832		1144
833	sub button_up {	1145	sub button_up {
…		…
846	my ($self) = @_;	1158	my ($self) = @_;
847		1159
848	my ($w, $h ) = ($self->{w}, $self->{h});	1160	my ($w, $h ) = ($self->{w}, $self->{h});
849	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1161	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
850		1162
851	glEnable GL_BLEND;
852	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
853	glEnable GL_TEXTURE_2D;	1163	glEnable GL_TEXTURE_2D;
854	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1164	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
855		1165
856	my $border = $self->border;	1166	my $border = $self->border;
857		1167
858	glColor @{ $self->{border_bg} };	1168	glColor @{ $self->{border_bg} };
859	$tex[1]->draw_quad (0, 0, $w, $border);	1169	$border[0]->draw_quad_alpha (0, 0, $w, $border);
860	$tex[3]->draw_quad (0, $border, $border, $ch);	1170	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
861	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	1171	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
862	$tex[4]->draw_quad (0, $h - $border, $w, $border);	1172	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
863		1173
864	my $bg = $tex[0];	1174	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
		1175	glColor @{ $self->{bg} };
865		1176
866	# TODO: repeat texture not scale	1177	# TODO: repeat texture not scale
867	my $rep_x = $cw / $bg->{w};	1178	# solve this better(?)
868	my $rep_y = $ch / $bg->{h};	1179	$bg->{s} = $cw / $bg->{w};
869		1180	$bg->{t} = $ch / $bg->{h};
870	glColor @{ $self->{bg} };
871
872	$bg->{s} = $rep_x;
873	$bg->{t} = $rep_y;
874	$bg->{wrap_mode} = 1;
875	$bg->draw_quad ($border, $border, $cw, $ch);	1181	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
		1182	}
876		1183
877	glDisable GL_TEXTURE_2D;	1184	glDisable GL_TEXTURE_2D;
878	glDisable GL_BLEND;
879		1185
880	$self->{title}->draw if $self->{title};	1186	$self->{title}->draw if $self->{title};
		1187
881	$self->child->draw;	1188	$self->child->draw;
882	}	1189	}
883		1190
884	#############################################################################	1191	#############################################################################
885		1192
…		…
894	sub new {	1201	sub new {
895	my $class = shift;	1202	my $class = shift;
896		1203
897	$class->SUPER::new (	1204	$class->SUPER::new (
898	col_expand => [],	1205	col_expand => [],
899	@_	1206	@_,
900	)	1207	)
		1208	}
		1209
		1210	sub children {
		1211	grep $_, map @$_, grep $_, @{ $_[0]{children} }
901	}	1212	}
902		1213
903	sub add {	1214	sub add {
904	my ($self, $x, $y, $child) = @_;	1215	my ($self, $x, $y, $child) = @_;
905		1216
906	$child->set_parent ($self);	1217	$child->set_parent ($self);
907	$self->{children}[$y][$x] = $child;	1218	$self->{children}[$y][$x] = $child;
908		1219
909	$child->check_size;	1220	$self->realloc;
910	}	1221	}
911		1222
912	# TODO: move to container class maybe? send childs a signal on removal?	1223	# TODO: move to container class maybe? send children a signal on removal?
913	sub clear {	1224	sub clear {
914	my ($self) = @_;	1225	my ($self) = @_;
915		1226
916	my $children = delete $self->{children};	1227	my @children = $self->children;
		1228	delete $self->{children};
917		1229
918	for (grep $_, map @$_, grep $_, @$children) {	1230	for (@children) {
919	delete $_->{parent};	1231	delete $_->{parent};
920	$_->hide;	1232	$_->hide;
921	}	1233	}
922		1234
923	$self->update;	1235	$self->realloc;
924	}	1236	}
925		1237
926	sub get_wh {	1238	sub get_wh {
927	my ($self) = @_;	1239	my ($self) = @_;
928		1240
…		…
959	sub size_allocate {	1271	sub size_allocate {
960	my ($self, $w, $h) = @_;	1272	my ($self, $w, $h) = @_;
961		1273
962	my ($ws, $hs) = $self->get_wh;	1274	my ($ws, $hs) = $self->get_wh;
963		1275
964	my $req_w = sum @$ws;	1276	my $req_w = (sum @$ws) || 1;
965	my $req_h = sum @$hs;	1277	my $req_h = (sum @$hs) || 1;
966		1278
967	# TODO: nicer code && do row_expand	1279	# TODO: nicer code && do row_expand
968	my @col_expand = @{$self->{col_expand}};	1280	my @col_expand = @{$self->{col_expand}};
969	@col_expand = (1) x @$ws unless @col_expand;	1281	@col_expand = (1) x @$ws unless @col_expand;
970	my $col_expand = (sum @col_expand) || 1;	1282	my $col_expand = (sum @col_expand) || 1;
…		…
1024	}	1336	}
1025	}	1337	}
1026		1338
1027	#############################################################################	1339	#############################################################################
1028		1340
1029	package CFClient::UI::HBox;	1341	package CFClient::UI::Box;
1030
1031	# TODO: wrap into common Box base class
1032		1342
1033	our @ISA = CFClient::UI::Container::;	1343	our @ISA = CFClient::UI::Container::;
1034		1344
1035	sub size_request {	1345	sub size_request {
1036	my ($self) = @_;	1346	my ($self) = @_;
1037		1347
1038	my @alloc = map [$_->size_request], @{$self->{children}};	1348	$self->{vertical}
1039		1349	? (
1040	(	1350	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1041	(List::Util::sum map $_->[0], @alloc),	1351	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1042	(List::Util::max map $_->[1], @alloc),	1352	)
1043	)	1353	: (
		1354	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1355	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1356	)
1044	}	1357	}
1045		1358
1046	sub size_allocate {	1359	sub size_allocate {
1047	my ($self, $w, $h) = @_;	1360	my ($self, $w, $h) = @_;
1048		1361
1049	($h, $w) = ($w, $h);	1362	my $space = $self->{vertical} ? $h : $w;
1050
1051	my $children = $self->{children};	1363	my $children = $self->{children};
1052		1364
1053	my @h = map $_->{req_w}, @$children;	1365	my @req;
1054		1366
1055	my $req_h = List::Util::sum @h;	1367	if ($self->{homogeneous}) {
1056		1368	@req = ($space / (@$children || 1)) x @$children;
1057	if ($req_h > $h) {
1058	# ah well, not enough space
1059	$_ *= $h / $req_h for @h;
1060	} else {	1369	} else {
		1370	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
		1371	my $req = List::Util::sum @req;
		1372
		1373	if ($req > $space) {
		1374	# ah well, not enough space
		1375	$_ *= $space / $req for @req;
		1376	} else {
1061	my $exp = List::Util::sum map $_->{expand}, @$children;	1377	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1062	$exp ||= 1;
1063		1378
		1379	$space = ($space - $req) / $expand; # remaining space to give away
		1380
		1381	$req[$_] += $space * $children->[$_]{expand}
1064	for (0 .. $#$children) {	1382	for 0 .. $#$children;
1065	my $child = $children->[$_];
1066
1067	my $alloc_h = $h[$_];
1068	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1069	$h[$_] = $alloc_h;
1070	}	1383	}
1071	}	1384	}
1072		1385
1073	CFClient::UI::harmonize \@h;	1386	CFClient::UI::harmonize \@req;
1074		1387
1075	my $y = 0;	1388	my $pos = 0;
1076	for (0 .. $#$children) {	1389	for (0 .. $#$children) {
1077	my $child = $children->[$_];
1078	my $h = $h[$_];	1390	my $alloc = $req[$_];
1079	$child->configure ($y, 0, $h, $w);	1391	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1080		1392
1081	$y += $h;	1393	$pos += $alloc;
1082	}	1394	}
1083		1395
1084	1	1396	1
1085	}	1397	}
1086		1398
1087	#############################################################################	1399	#############################################################################
1088		1400
		1401	package CFClient::UI::HBox;
		1402
		1403	our @ISA = CFClient::UI::Box::;
		1404
		1405	sub new {
		1406	my $class = shift;
		1407
		1408	$class->SUPER::new (
		1409	vertical => 0,
		1410	@_,
		1411	)
		1412	}
		1413
		1414	#############################################################################
		1415
1089	package CFClient::UI::VBox;	1416	package CFClient::UI::VBox;
1090		1417
1091	# TODO: wrap into common Box base class
1092
1093	our @ISA = CFClient::UI::Container::;	1418	our @ISA = CFClient::UI::Box::;
1094		1419
1095	sub size_request {	1420	sub new {
1096	my ($self) = @_;	1421	my $class = shift;
1097		1422
1098	my @alloc = map [$_->size_request], @{$self->{children}};	1423	$class->SUPER::new (
1099		1424	vertical => 1,
1100	(	1425	@_,
1101	(List::Util::max map $_->[0], @alloc),
1102	(List::Util::sum map $_->[1], @alloc),
1103	)	1426	)
1104	}	1427	}
1105		1428
1106	sub size_allocate {
1107	my ($self, $w, $h) = @_;
1108
1109	my $children = $self->{children};
1110
1111	my @h = map $_->{req_h}, @$children;
1112
1113	my $req_h = List::Util::sum @h;
1114
1115	if ($req_h > $h) {
1116	# ah well, not enough space
1117	$_ *= $h / $req_h for @h;
1118	} else {
1119	my $exp = List::Util::sum map $_->{expand}, @$children;
1120	$exp ||= 1;
1121
1122	for (0 .. $#$children) {
1123	my $child = $children->[$_];
1124
1125	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1126	}
1127	}
1128
1129	CFClient::UI::harmonize \@h;
1130
1131	my $y = 0;
1132	for (0 .. $#$children) {
1133	my $child = $children->[$_];
1134	my $h = $h[$_];
1135	$child->configure (0, $y, $w, $h);
1136
1137	$y += $h;
1138	}
1139
1140	1
1141	}
1142
1143	#############################################################################	1429	#############################################################################
1144		1430
1145	package CFClient::UI::Label;	1431	package CFClient::UI::Label;
1146		1432
1147	our @ISA = CFClient::UI::Base::;	1433	our @ISA = CFClient::UI::DrawBG::;
1148		1434
1149	use CFClient::OpenGL;	1435	use CFClient::OpenGL;
1150		1436
1151	sub new {	1437	sub new {
1152	my ($class, %arg) = @_;	1438	my ($class, %arg) = @_;
1153		1439
1154	my $self = $class->SUPER::new (	1440	my $self = $class->SUPER::new (
1155	fg => [1, 1, 1],	1441	fg => [1, 1, 1],
		1442	#bg => none
		1443	#active_bg => none
1156	#font => default_font	1444	#font => default_font
		1445	#text => initial text
		1446	#markup => initial narkup
		1447	#max_w => maximum pixel width
		1448	ellipsise => 3, # end
		1449	layout => (new CFClient::Layout),
1157	fontsize => 1,	1450	fontsize => 1,
1158	text => "",
1159	align => -1,	1451	align => -1,
1160	valign => -1,	1452	valign => -1,
1161	padding => 2,	1453	padding_x => 2,
1162	layout => new CFClient::Layout,	1454	padding_y => 2,
1163	can_events => 0,	1455	can_events => 0,
1164	%arg	1456	%arg
1165	);	1457	);
1166		1458
1167	if (exists $self->{template}) {	1459	if (exists $self->{template}) {
1168	my $layout = new CFClient::Layout;	1460	my $layout = new CFClient::Layout;
1169	$layout->set_text (delete $self->{template});	1461	$layout->set_text (delete $self->{template});
1170	$self->{template} = $layout;	1462	$self->{template} = $layout;
1171	}	1463	}
1172		1464
1173	$self->set_text (delete $self->{text}) if exists $self->{text};	1465	if (exists $self->{markup}) {
1174	$self->set_markup (delete $self->{markup}) if exists $self->{markup};	1466	$self->set_markup (delete $self->{markup});
		1467	} else {
		1468	$self->set_text (delete $self->{text});
		1469	}
1175		1470
1176	$self	1471	$self
1177	}	1472	}
1178		1473
1179	sub escape {	1474	sub escape($) {
1180	local $_ = $_[1];	1475	local $_ = $_[0];
1181		1476
1182	s/&/&amp;/g;	1477	s/&/&amp;/g;
1183	s/>/&gt;/g;	1478	s/>/&gt;/g;
1184	s/</&lt;/g;	1479	s/</&lt;/g;
1185		1480
1186	$_[1]	1481	$_
		1482	}
		1483
		1484	sub update {
		1485	my ($self) = @_;
		1486
		1487	delete $self->{texture};
		1488	$self->SUPER::update;
1187	}	1489	}
1188		1490
1189	sub set_text {	1491	sub set_text {
1190	my ($self, $text) = @_;	1492	my ($self, $text) = @_;
1191		1493
		1494	return if $self->{text} eq "T$text";
		1495	$self->{text} = "T$text";
		1496
		1497	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1192	$self->{layout}->set_text ($text);	1498	$self->{layout}->set_text ($text);
1193		1499
1194	delete $self->{texture};	1500	$self->realloc;
1195	$self->check_size;
1196	$self->update;	1501	$self->update;
1197	}	1502	}
1198		1503
1199	sub set_markup {	1504	sub set_markup {
1200	my ($self, $markup) = @_;	1505	my ($self, $markup) = @_;
1201		1506
		1507	return if $self->{text} eq "M$markup";
		1508	$self->{text} = "M$markup";
		1509
		1510	my $rgba = $markup =~ /span.*(?:foreground|background)/;
		1511
		1512	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1202	$self->{layout}->set_markup ($markup);	1513	$self->{layout}->set_markup ($markup);
1203		1514
1204	delete $self->{texture};	1515	$self->realloc;
1205	$self->check_size;
1206	$self->update;	1516	$self->update;
1207	}	1517	}
1208		1518
1209	sub size_request {	1519	sub size_request {
1210	my ($self) = @_;	1520	my ($self) = @_;
1211		1521
1212	$self->{layout}->set_font ($self->{font}) if $self->{font};	1522	$self->{layout}->set_font ($self->{font}) if $self->{font};
1213	$self->{layout}->set_width ($self->{max_w} || -1);	1523	$self->{layout}->set_width ($self->{max_w} || -1);
		1524	$self->{layout}->set_ellipsise ($self->{ellipsise});
		1525	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1214	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1526	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1215		1527
1216	my ($w, $h) = $self->{layout}->size;	1528	my ($w, $h) = $self->{layout}->size;
1217		1529
1218	if (exists $self->{template}) {	1530	if (exists $self->{template}) {
…		…
1223		1535
1224	$w = List::Util::max $w, $w2;	1536	$w = List::Util::max $w, $w2;
1225	$h = List::Util::max $h, $h2;	1537	$h = List::Util::max $h, $h2;
1226	}	1538	}
1227		1539
1228	(	1540	($w, $h)
1229	$w + $self->{padding} * 2,
1230	$h + $self->{padding} * 2,
1231	)
1232	}	1541	}
1233		1542
1234	sub size_allocate {	1543	sub size_allocate {
1235	my ($self, $w, $h) = @_;	1544	my ($self, $w, $h) = @_;
1236		1545
1237	delete $self->{texture};	1546	delete $self->{texture}
		1547	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1238	}	1548	}
1239		1549
1240	sub set_fontsize {	1550	sub set_fontsize {
1241	my ($self, $fontsize) = @_;	1551	my ($self, $fontsize) = @_;
1242		1552
1243	$self->{fontsize} = $fontsize;	1553	$self->{fontsize} = $fontsize;
1244	delete $self->{texture};	1554	delete $self->{texture};
1245	$self->check_size;	1555
1246	$self->update;	1556	$self->realloc;
1247	}	1557	}
1248		1558
1249	sub _draw {	1559	sub _draw {
1250	my ($self) = @_;	1560	my ($self) = @_;
1251		1561
		1562	$self->SUPER::_draw; # draw background, if applicable
		1563
1252	my $tex = $self->{texture} ||= do {	1564	my $tex = $self->{texture} ||= do {
		1565	$self->{layout}->set_foreground (@{$self->{fg}});
1253	$self->{layout}->set_font ($self->{font}) if $self->{font};	1566	$self->{layout}->set_font ($self->{font}) if $self->{font};
1254	$self->{layout}->set_width ($self->{w});	1567	$self->{layout}->set_width ($self->{w});
		1568	$self->{layout}->set_ellipsise ($self->{ellipsise});
		1569	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1255	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);	1570	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
		1571
1256	new_from_layout CFClient::Texture $self->{layout}	1572	my $tex = new_from_layout CFClient::Texture $self->{layout};
		1573
		1574	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
		1575	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
		1576	: ($self->{w} - $tex->{w}) * 0.5);
		1577
		1578	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
		1579	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
		1580	: ($self->{h} - $tex->{h}) * 0.5);
		1581
		1582	$tex
1257	};	1583	};
1258		1584
1259	glEnable GL_BLEND;
1260	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1261	glEnable GL_TEXTURE_2D;	1585	glEnable GL_TEXTURE_2D;
1262	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1586	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1263		1587
		1588	if ($tex->{format} == GL_ALPHA) {
1264	glColor @{$self->{fg}};	1589	glColor @{$self->{fg}};
1265
1266	$self->{ox} = int (
1267	$self->{align} < 0 ? $self->{padding}
1268	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1269	: ($self->{w} - $tex->{w}) * 0.5
1270	);
1271
1272	$self->{oy} = int (
1273	$self->{valign} < 0 ? $self->{padding}
1274	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1275	: ($self->{h} - $tex->{h}) * 0.5
1276	);
1277
1278	$tex->draw_quad ($self->{ox}, $self->{oy});	1590	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
		1591	} else {
		1592	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
		1593	}
1279		1594
1280	glDisable GL_TEXTURE_2D;	1595	glDisable GL_TEXTURE_2D;
1281	glDisable GL_BLEND;
1282	}	1596	}
1283		1597
1284	#############################################################################	1598	#############################################################################
1285		1599
1286	package CFClient::UI::EntryBase;	1600	package CFClient::UI::EntryBase;
…		…
1299	active_fg => [0, 0, 0],	1613	active_fg => [0, 0, 0],
1300	can_hover => 1,	1614	can_hover => 1,
1301	can_focus => 1,	1615	can_focus => 1,
1302	valign => 0,	1616	valign => 0,
1303	can_events => 1,	1617	can_events => 1,
		1618	#text => ...
1304	@_	1619	@_
1305	)	1620	)
1306	}	1621	}
1307		1622
1308	sub _set_text {	1623	sub _set_text {
…		…
1318	$self->{text} = $text;	1633	$self->{text} = $text;
1319		1634
1320	$text =~ s/./*/g if $self->{hidden};	1635	$text =~ s/./*/g if $self->{hidden};
1321	$self->{layout}->set_text ("$text ");	1636	$self->{layout}->set_text ("$text ");
1322		1637
1323	$self->emit (changed => $self->{text});	1638	$self->_emit (changed => $self->{text});
		1639	}
		1640
		1641	sub set_text {
		1642	my ($self, $text) = @_;
		1643
		1644	$self->{cursor} = length $text;
		1645	$self->_set_text ($text);
		1646
		1647	$self->realloc;
1324	}	1648	}
1325		1649
1326	sub get_text {	1650	sub get_text {
1327	$_[0]{text}	1651	$_[0]{text}
1328	}	1652	}
…		…
1331	my ($self) = @_;	1655	my ($self) = @_;
1332		1656
1333	my ($w, $h) = $self->SUPER::size_request;	1657	my ($w, $h) = $self->SUPER::size_request;
1334		1658
1335	($w + 1, $h) # add 1 for cursor	1659	($w + 1, $h) # add 1 for cursor
1336	}
1337
1338	sub size_allocate {
1339	my ($self, $w, $h) = @_;
1340
1341	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1342	}
1343
1344	sub set_text {
1345	my ($self, $text) = @_;
1346
1347	$self->{cursor} = length $text;
1348	$self->_set_text ($text);
1349	$self->update;
1350	}	1660	}
1351		1661
1352	sub key_down {	1662	sub key_down {
1353	my ($self, $ev) = @_;	1663	my ($self, $ev) = @_;
1354		1664
…		…
1356	my $sym = $ev->{sym};	1666	my $sym = $ev->{sym};
1357	my $uni = $ev->{unicode};	1667	my $uni = $ev->{unicode};
1358		1668
1359	my $text = $self->get_text;	1669	my $text = $self->get_text;
1360		1670
1361	if ($sym == 8) {	1671	if ($uni == 8) {
1362	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1672	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1363	} elsif ($sym == 127) {	1673	} elsif ($uni == 127) {
1364	substr $text, $self->{cursor}, 1, "";	1674	substr $text, $self->{cursor}, 1, "";
1365	} elsif ($sym == CFClient::SDLK_LEFT) {	1675	} elsif ($sym == CFClient::SDLK_LEFT) {
1366	--$self->{cursor} if $self->{cursor};	1676	--$self->{cursor} if $self->{cursor};
1367	} elsif ($sym == CFClient::SDLK_RIGHT) {	1677	} elsif ($sym == CFClient::SDLK_RIGHT) {
1368	++$self->{cursor} if $self->{cursor} < length $self->{text};	1678	++$self->{cursor} if $self->{cursor} < length $self->{text};
1369	} elsif ($sym == CFClient::SDLK_HOME) {	1679	} elsif ($sym == CFClient::SDLK_HOME) {
1370	$self->{cursor} = 0;	1680	$self->{cursor} = 0;
1371	} elsif ($sym == CFClient::SDLK_END) {	1681	} elsif ($sym == CFClient::SDLK_END) {
1372	$self->{cursor} = length $text;	1682	$self->{cursor} = length $text;
1373	} elsif ($sym == 27) {	1683	} elsif ($uni == 27) {
1374	$self->emit ('escape');	1684	$self->_emit ('escape');
1375	} elsif ($uni) {	1685	} elsif ($uni) {
1376	substr $text, $self->{cursor}++, 0, chr $uni;	1686	substr $text, $self->{cursor}++, 0, chr $uni;
1377	}	1687	}
1378		1688
1379	$self->_set_text ($text);	1689	$self->_set_text ($text);
1380	$self->update;	1690
		1691	$self->realloc;
1381	}	1692	}
1382		1693
1383	sub focus_in {	1694	sub focus_in {
1384	my ($self) = @_;	1695	my ($self) = @_;
1385		1696
…		…
1461	my ($self, $ev) = @_;	1772	my ($self, $ev) = @_;
1462		1773
1463	my $sym = $ev->{sym};	1774	my $sym = $ev->{sym};
1464		1775
1465	if ($sym == 13) {	1776	if ($sym == 13) {
		1777	unshift @{$self->{history}},
		1778	my $txt = $self->get_text;
		1779	$self->{history_pointer} = -1;
		1780	$self->{history_saveback} = '';
1466	$self->emit (activate => $self->get_text);	1781	$self->_emit (activate => $txt);
1467	$self->update;	1782	$self->update;
		1783
		1784	} elsif ($sym == CFClient::SDLK_UP) {
		1785	if ($self->{history_pointer} < 0) {
		1786	$self->{history_saveback} = $self->get_text;
		1787	}
		1788	if (@{$self->{history} || []} > 0) {
		1789	$self->{history_pointer}++;
		1790	if ($self->{history_pointer} >= @{$self->{history} || []}) {
		1791	$self->{history_pointer} = @{$self->{history} || []} - 1;
		1792	}
		1793	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1794	}
		1795
		1796	} elsif ($sym == CFClient::SDLK_DOWN) {
		1797	$self->{history_pointer}--;
		1798	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
		1799
		1800	if ($self->{history_pointer} >= 0) {
		1801	$self->set_text ($self->{history}->[$self->{history_pointer}]);
		1802	} else {
		1803	$self->set_text ($self->{history_saveback});
		1804	}
1468		1805
1469	} else {	1806	} else {
1470	$self->SUPER::key_down ($ev);	1807	$self->SUPER::key_down ($ev);
1471	}	1808	}
1472		1809
…		…
1486		1823
1487	sub new {	1824	sub new {
1488	my $class = shift;	1825	my $class = shift;
1489		1826
1490	$class->SUPER::new (	1827	$class->SUPER::new (
1491	padding => 4,	1828	padding_x => 4,
		1829	padding_y => 4,
1492	fg => [1, 1, 1],	1830	fg => [1, 1, 1],
1493	bg => [1, 1, 1, 0.2],
1494	active_fg => [0, 0, 1],	1831	active_fg => [0, 0, 1],
1495	can_hover => 1,	1832	can_hover => 1,
1496	align => 0,	1833	align => 0,
1497	valign => 0,	1834	valign => 0,
1498	can_events => 1,	1835	can_events => 1,
1499	@_	1836	@_
1500	)	1837	)
1501	}	1838	}
1502		1839
		1840	sub activate { }
		1841
1503	sub button_up {	1842	sub button_up {
1504	my ($self, $ev, $x, $y) = @_;	1843	my ($self, $ev, $x, $y) = @_;
1505		1844
		1845	$self->emit ("activate")
1506	if ($x >= 0 && $x < $self->{w}	1846	if $x >= 0 && $x < $self->{w}
1507	&& $y >= 0 && $y < $self->{h}) {	1847	&& $y >= 0 && $y < $self->{h};
1508	$self->emit ("activate");
1509	}
1510	}	1848	}
1511		1849
1512	sub _draw {	1850	sub _draw {
1513	my ($self) = @_;	1851	my ($self) = @_;
1514		1852
…		…
1516		1854
1517	if ($GRAB == $self) {	1855	if ($GRAB == $self) {
1518	$self->{fg} = $self->{active_fg};	1856	$self->{fg} = $self->{active_fg};
1519	}	1857	}
1520		1858
1521	glEnable GL_BLEND;
1522	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1523	glEnable GL_TEXTURE_2D;	1859	glEnable GL_TEXTURE_2D;
1524	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1860	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1525	glColor 0, 0, 0, 1;	1861	glColor 0, 0, 0, 1;
1526		1862
1527	$tex[0]->draw_quad (0, 0, $self->{w}, $self->{h});	1863	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1528		1864
1529	glDisable GL_TEXTURE_2D;	1865	glDisable GL_TEXTURE_2D;
1530	glDisable GL_BLEND;
1531		1866
1532	$self->SUPER::_draw;	1867	$self->SUPER::_draw;
1533	}	1868	}
1534		1869
1535	#############################################################################	1870	#############################################################################
…		…
1546		1881
1547	sub new {	1882	sub new {
1548	my $class = shift;	1883	my $class = shift;
1549		1884
1550	$class->SUPER::new (	1885	$class->SUPER::new (
1551	padding => 2,	1886	padding_x => 2,
		1887	padding_y => 2,
1552	fg => [1, 1, 1],	1888	fg => [1, 1, 1],
1553	active_fg => [1, 1, 0],	1889	active_fg => [1, 1, 0],
		1890	bg => [0, 0, 0, 0.2],
		1891	active_bg => [1, 1, 1, 0.5],
1554	state => 0,	1892	state => 0,
1555	can_hover => 1,	1893	can_hover => 1,
1556	@_	1894	@_
1557	)	1895	)
1558	}	1896	}
1559		1897
1560	sub size_request {	1898	sub size_request {
1561	my ($self) = @_;	1899	my ($self) = @_;
1562		1900
1563	($self->{padding} * 2 + 6) x 2	1901	(6) x 2
1564	}	1902	}
1565		1903
1566	sub button_down {	1904	sub button_down {
1567	my ($self, $ev, $x, $y) = @_;	1905	my ($self, $ev, $x, $y) = @_;
1568		1906
1569	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1907	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1570	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1908	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1571	$self->{state} = !$self->{state};	1909	$self->{state} = !$self->{state};
1572	$self->emit (changed => $self->{state});	1910	$self->_emit (changed => $self->{state});
1573	}	1911	}
1574	}	1912	}
1575		1913
1576	sub _draw {	1914	sub _draw {
1577	my ($self) = @_;	1915	my ($self) = @_;
1578		1916
1579	$self->SUPER::_draw;	1917	$self->SUPER::_draw;
1580		1918
1581	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1919	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1582		1920
1583	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	1921	my ($w, $h) = @$self{qw(w h)};
		1922
		1923	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1584		1924
1585	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1925	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1586		1926
1587	glEnable GL_BLEND;	1927	my $tex = $self->{state} ? $tex[1] : $tex[0];
		1928
1588	glEnable GL_TEXTURE_2D;	1929	glEnable GL_TEXTURE_2D;
1589	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1590
1591	my $tex = $self->{state} ? $tex[1] : $tex[0];
1592
1593	$tex->draw_quad (0, 0, $s, $s);	1930	$tex->draw_quad_alpha (0, 0, $s, $s);
1594
1595	glDisable GL_TEXTURE_2D;	1931	glDisable GL_TEXTURE_2D;
1596	glDisable GL_BLEND;
1597	}	1932	}
1598		1933
1599	#############################################################################	1934	#############################################################################
1600		1935
1601	package CFClient::UI::Image;	1936	package CFClient::UI::Image;
…		…
1644	glTranslate 0, -$self->{w}, 0;	1979	glTranslate 0, -$self->{w}, 0;
1645		1980
1646	($w, $h) = ($h, $w);	1981	($w, $h) = ($h, $w);
1647	}	1982	}
1648		1983
1649	glEnable GL_BLEND;
1650	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1651	glEnable GL_TEXTURE_2D;	1984	glEnable GL_TEXTURE_2D;
1652	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1985	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1653		1986
1654	$tex->draw_quad (0, 0, $w, $h);	1987	$tex->draw_quad_alpha (0, 0, $w, $h);
1655		1988
1656	glDisable GL_BLEND;
1657	glDisable GL_TEXTURE_2D;	1989	glDisable GL_TEXTURE_2D;
1658	}	1990	}
1659		1991
1660	#############################################################################	1992	#############################################################################
1661		1993
…		…
1709	}	2041	}
1710		2042
1711	sub set_max {	2043	sub set_max {
1712	my ($self, $max) = @_;	2044	my ($self, $max) = @_;
1713		2045
		2046	return if $self->{max_val} == $max;
		2047
1714	$self->{max_val} = $max;	2048	$self->{max_val} = $max;
		2049	$self->update;
1715	}	2050	}
1716		2051
1717	sub set_value {	2052	sub set_value {
1718	my ($self, $val, $max) = @_;	2053	my ($self, $val, $max) = @_;
1719		2054
1720	$self->set_max ($max)	2055	$self->set_max ($max)
1721	if defined $max;	2056	if defined $max;
1722		2057
1723	$max = $self->{max_val};	2058	return if $self->{val} == $val;
		2059
1724	$self->{val} = $val;	2060	$self->{val} = $val;
1725
1726	$self->update;	2061	$self->update;
1727	}	2062	}
1728		2063
1729	sub _draw {	2064	sub _draw {
1730	my ($self) = @_;	2065	my ($self) = @_;
…		…
1793		2128
1794	sub new {	2129	sub new {
1795	my ($class, %arg) = @_;	2130	my ($class, %arg) = @_;
1796		2131
1797	my $self = $class->SUPER::new (	2132	my $self = $class->SUPER::new (
1798	tooltip => $arg{type},	2133	tooltip => $arg{type},
1799	can_hover => 1,	2134	can_hover => 1,
		2135	can_events => 1,
1800	%arg,	2136	%arg,
1801	);	2137	);
1802		2138
1803	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2139	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");
1804	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	2140	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
…		…
1812		2148
1813	$self->{value}->set_fontsize ($fsize);	2149	$self->{value}->set_fontsize ($fsize);
1814	$self->{max} ->set_fontsize ($fsize);	2150	$self->{max} ->set_fontsize ($fsize);
1815	}	2151	}
1816		2152
		2153	sub set_max {
		2154	my ($self, $max) = @_;
		2155
		2156	$self->{gauge}->set_max ($max);
		2157	$self->{max}->set_text ($max);
		2158	}
		2159
1817	sub set_value {	2160	sub set_value {
1818	my ($self, $val, $max) = @_;	2161	my ($self, $val, $max) = @_;
1819		2162
1820	$self->set_max ($max)	2163	$self->set_max ($max)
1821	if defined $max;	2164	if defined $max;
1822		2165
1823	$self->{gauge}->set_value ($val, $max);	2166	$self->{gauge}->set_value ($val, $max);
1824	$self->{value}->set_text ($val);	2167	$self->{value}->set_text ($val);
1825	}
1826
1827	sub set_max {
1828	my ($self, $max) = @_;
1829
1830	$self->{gauge}->set_max ($max);
1831	$self->{max}->set_text ($max);
1832	}	2168	}
1833		2169
1834	#############################################################################	2170	#############################################################################
1835		2171
1836	package CFClient::UI::Slider;	2172	package CFClient::UI::Slider;
…		…
1846	qw(s1_slider.png s1_slider_bg.png);	2182	qw(s1_slider.png s1_slider_bg.png);
1847		2183
1848	sub new {	2184	sub new {
1849	my $class = shift;	2185	my $class = shift;
1850		2186
1851	# range [value, low, high, page]	2187	# range [value, low, high, page, unit]
1852		2188
1853	# TODO: 0-width page	2189	# TODO: 0-width page
1854	# TODO: req_w/h are wrong with vertical	2190	# TODO: req_w/h are wrong with vertical
1855	# TODO: calculations are off	2191	# TODO: calculations are off
1856	my $self = $class->SUPER::new (	2192	my $self = $class->SUPER::new (
1857	fg => [1, 1, 1],	2193	fg => [1, 1, 1],
1858	active_fg => [0, 0, 0],	2194	active_fg => [0, 0, 0],
		2195	bg => [0, 0, 0, 0.2],
		2196	active_bg => [1, 1, 1, 0.5],
1859	range => [0, 0, 100, 10],	2197	range => [0, 0, 100, 10, 0],
1860	req_w => 20,	2198	min_w => $::WIDTH / 80,
1861	req_h => 20,	2199	min_h => $::WIDTH / 80,
1862	vertical => 0,	2200	vertical => 0,
1863	can_hover => 1,	2201	can_hover => 1,
1864	inner_pad => 5,	2202	inner_pad => 0.02,
1865	@_	2203	@_
1866	);	2204	);
1867		2205
		2206	$self->set_value ($self->{range}[0]);
		2207	$self->update;
		2208
1868	$self	2209	$self
1869	}	2210	}
1870		2211
		2212	sub changed { }
		2213
		2214	sub set_range {
		2215	my ($self, $range) = @_;
		2216
		2217	($range, $self->{range}) = ($self->{range}, $range);
		2218
		2219	$self->update
		2220	if "@$range" ne "@{$self->{range}}";
		2221	}
		2222
		2223	sub set_value {
		2224	my ($self, $value) = @_;
		2225
		2226	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
		2227
		2228	$hi = $lo + 1 if $hi <= $lo;
		2229
		2230	$page = $hi - $lo if $page > $hi - $lo;
		2231
		2232	$value = $lo if $value < $lo;
		2233	$value = $hi - $page if $value > $hi - $page;
		2234
		2235	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
		2236	if $unit;
		2237
		2238	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
		2239
		2240	if ($value != $old_value) {
		2241	$self->_emit (changed => $value);
		2242	$self->update;
		2243	}
		2244	}
		2245
1871	sub size_request {	2246	sub size_request {
1872	my ($self) = @_;	2247	my ($self) = @_;
1873		2248
1874	my $w = $self->{req_w};	2249	($self->{req_w}, $self->{req_h})
1875	my $h = $self->{req_h};
1876
1877	$self->{vertical} ? ($h, $w) : ($w, $h)
1878	}	2250	}
1879		2251
1880	sub button_down {	2252	sub button_down {
1881	my ($self, $ev, $x, $y) = @_;	2253	my ($self, $ev, $x, $y) = @_;
1882		2254
1883	$self->SUPER::button_down ($ev, $x, $y);	2255	$self->SUPER::button_down ($ev, $x, $y);
		2256
		2257	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
		2258
1884	$self->mouse_motion ($ev, $x, $y);	2259	$self->mouse_motion ($ev, $x, $y);
1885	}	2260	}
1886		2261
1887	sub mouse_motion {	2262	sub mouse_motion {
1888	my ($self, $ev, $x, $y) = @_;	2263	my ($self, $ev, $x, $y) = @_;
1889		2264
1890	if ($GRAB == $self) {	2265	if ($GRAB == $self) {
		2266	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
		2267
		2268	my (undef, $lo, $hi, $page) = @{$self->{range}};
		2269
		2270	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
		2271
		2272	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2273	}
		2274	}
		2275
		2276	sub update {
		2277	my ($self) = @_;
		2278
		2279	$CFClient::UI::ROOT->on_post_alloc ($self => sub {
		2280	$self->set_value ($self->{range}[0]);
		2281
1891	my ($value, $lo, $hi, $page) = @{$self->{range}};	2282	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2283	my $range = ($hi - $page - $lo) || 1e-100;
1892		2284
1893	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2285	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
1894		2286
1895	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2287	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
1896	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right	2288	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
1897		2289
1898	$x -= $inner_pad_px; # substract the padding	2290	$value = ($value - $lo) / $range;
1899	$x = $x * ($hi - $lo) / $inner_w + $lo;	2291	$value = $value * $self->{scale} + $self->{offset};
1900	$x = $lo if $x < $lo;
1901	$x = $hi - $page if $x > $hi - $page;
1902	$self->{range}[0] = $x;
1903		2292
1904	$self->emit (changed => $x);	2293	$self->{knob_x} = $value - $knob_w * 0.5;
1905	$self->update;	2294	$self->{knob_w} = $knob_w;
1906	}	2295	});
1907	}
1908		2296
1909	# the inner_* stuff is for generating a padding for the slider handle,	2297	$self->SUPER::update;
1910	# so that the handle doesn't leave the texture. This calculation isn't 100%
1911	# correct propably, but it does the job for now
1912	sub _calc_inner_pad_px {
1913	my ($self, $w) = @_;
1914	($w / 100) * $self->{inner_pad} # % to pixels
1915	}	2298	}
1916		2299
1917	sub _draw {	2300	sub _draw {
1918	my ($self) = @_;	2301	my ($self) = @_;
1919		2302
1920	$self->SUPER::_draw ();	2303	$self->SUPER::_draw ();
1921		2304
1922	my ($w, $h) = @$self{qw(w h)};	2305	glScale $self->{w}, $self->{h};
1923		2306
1924	if ($self->{vertical}) {	2307	if ($self->{vertical}) {
1925	# draw a vertical slider like a rotated horizontal slider	2308	# draw a vertical slider like a rotated horizontal slider
1926		2309
		2310	glTranslate 1, 0, 0;
1927	glRotate 90, 0, 0, 1;	2311	glRotate 90, 0, 0, 1;
1928	glTranslate 0, -$self->{w}, 0;
1929
1930	($w, $h) = ($h, $w);
1931	}	2312	}
1932		2313
1933	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2314	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
1934	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2315	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
1935		2316
1936	my ($value, $lo, $hi, $page) = @{$self->{range}};
1937
1938	$hi = $value + 1 if $lo == $hi;
1939
1940	my $inner_pad_px = $self->_calc_inner_pad_px ($w);
1941	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
1942
1943	$page = int $page * $inner_w / ($hi - $lo);
1944	$value = int +($value - $lo) * $inner_w / ($hi - $lo);
1945
1946	$w -= $page;
1947	$page &= ~1;
1948	glTranslate $page * 0.5, 0, 0;
1949	$page ||= 2;
1950
1951	my $knob_a = $inner_pad_px + ($value - $page * 0.5);
1952	my $knob_b = $inner_pad_px + ($value + $page * 0.5);
1953
1954	glEnable GL_BLEND;
1955	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1956	glEnable GL_TEXTURE_2D;	2317	glEnable GL_TEXTURE_2D;
1957	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2318	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1958		2319
1959	# draw background	2320	# draw background
1960	$tex[1]->draw_quad (0, 0, $w, $h);	2321	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
1961		2322
1962	# draw handle	2323	# draw handle
1963	$tex[0]->draw_quad ($knob_a, 0, $knob_b - $knob_a, $h);	2324	$tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
1964		2325
1965	glDisable GL_BLEND;
1966	glDisable GL_TEXTURE_2D;	2326	glDisable GL_TEXTURE_2D;
1967	}	2327	}
		2328
		2329	#############################################################################
		2330
		2331	package CFClient::UI::ValSlider;
		2332
		2333	our @ISA = CFClient::UI::HBox::;
		2334
		2335	sub new {
		2336	my ($class, %arg) = @_;
		2337
		2338	my $range = delete $arg{range};
		2339
		2340	my $self = $class->SUPER::new (
		2341	slider => (new CFClient::UI::Slider expand => 1, range => $range),
		2342	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
		2343	to_value => sub { shift },
		2344	from_value => sub { shift },
		2345	%arg,
		2346	);
		2347
		2348	$self->{slider}->connect (changed => sub {
		2349	my ($self, $value) = @_;
		2350	$self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
		2351	$self->{parent}->emit (changed => $value);
		2352	});
		2353
		2354	# $self->{entry}->connect (changed => sub {
		2355	# my ($self, $value) = @_;
		2356	# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
		2357	# $self->{parent}->emit (changed => $value);
		2358	# });
		2359
		2360	$self->add ($self->{slider}, $self->{entry});
		2361
		2362	$self->{slider}->emit (changed => $self->{slider}{range}[0]);
		2363
		2364	$self
		2365	}
		2366
		2367	sub set_range { shift->{slider}->set_range (@_) }
		2368	sub set_value { shift->{slider}->set_value (@_) }
1968		2369
1969	#############################################################################	2370	#############################################################################
1970		2371
1971	package CFClient::UI::TextView;	2372	package CFClient::UI::TextView;
1972		2373
…		…
1981	fontsize => 1,	2382	fontsize => 1,
1982	can_events => 0,	2383	can_events => 0,
1983	#font => default_font	2384	#font => default_font
1984	@_,	2385	@_,
1985		2386
1986	layout => (new CFClient::Layout),	2387	layout => (new CFClient::Layout 1),
1987	par => [],	2388	par => [],
1988	height => 0,	2389	height => 0,
1989	children => [	2390	children => [
1990	(new CFClient::UI::Empty expand => 1),	2391	(new CFClient::UI::Empty expand => 1),
1991	(new CFClient::UI::Slider vertical => 1),	2392	(new CFClient::UI::Slider vertical => 1),
1992	],	2393	],
1993	);	2394	);
1994		2395
1995	$self->{children}[1]->connect (changed => sub {	2396	$self->{children}[1]->connect (changed => sub { $self->update });
1996	$self->update;
1997	});
1998		2397
1999	$self	2398	$self
2000	}	2399	}
2001		2400
2002	sub set_fontsize {	2401	sub set_fontsize {
2003	my ($self, $fontsize) = @_;	2402	my ($self, $fontsize) = @_;
2004		2403
2005	$self->{fontsize} = $fontsize;	2404	$self->{fontsize} = $fontsize;
2006	$self->reflow;	2405	$self->reflow;
2007	}
2008
2009	sub text_height {
2010	my ($self, $text) = @_;
2011
2012	my $layout = $self->{layout};
2013
2014	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2015	$layout->set_width ($self->{w});
2016	$layout->set_text ($text);
2017
2018	($layout->size)[1]
2019	}
2020
2021	sub reflow {
2022	my ($self) = @_;
2023
2024	$self->{need_reflow}++;
2025	$self->update;
2026	}	2406	}
2027		2407
2028	sub size_allocate {	2408	sub size_allocate {
2029	my ($self, $w, $h) = @_;	2409	my ($self, $w, $h) = @_;
2030		2410
…		…
2035	$self->{layout}->set_width ($self->{children}[0]{w});	2415	$self->{layout}->set_width ($self->{children}[0]{w});
2036		2416
2037	$self->reflow;	2417	$self->reflow;
2038	}	2418	}
2039		2419
		2420	sub text_size {
		2421	my ($self, $text, $indent) = @_;
		2422
		2423	my $layout = $self->{layout};
		2424
		2425	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2426	$layout->set_width ($self->{children}[0]{w} - $indent);
		2427	$layout->set_markup ($text);
		2428
		2429	$layout->size
		2430	}
		2431
		2432	sub reflow {
		2433	my ($self) = @_;
		2434
		2435	$self->{need_reflow}++;
		2436	$self->update;
		2437	}
		2438
		2439	sub set_offset {
		2440	my ($self, $offset) = @_;
		2441
		2442	# todo: base offset on lines or so, not on pixels
		2443	$self->{children}[1]->set_value ($offset);
		2444	}
		2445
		2446	sub clear {
		2447	my ($self) = @_;
		2448
		2449	$self->{par} = [];
		2450	$self->{height} = 0;
		2451	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
		2452	}
		2453
2040	sub add_paragraph {	2454	sub add_paragraph {
2041	my ($self, $color, $text) = @_;	2455	my ($self, $color, $text, $indent) = @_;
2042		2456
2043	#TODO: intelligently "reformat" paragraph	2457	for my $line (split /\n/, $text) {
2044		2458	my ($w, $h) = $self->text_size ($line);
2045	my $height = $self->text_height ($text);
2046
2047	$self->{height} += $height;	2459	$self->{height} += $h;
		2460	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
		2461	}
2048		2462
2049	push @{$self->{par}}, [$height, $color, $text];
2050
2051	$self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}];	2463	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2052	$self->{children}[1]->update;
2053	}	2464	}
2054		2465
2055	sub update {	2466	sub update {
2056	my ($self) = @_;	2467	my ($self) = @_;
2057		2468
…		…
2059		2470
2060	return unless $self->{h} > 0;	2471	return unless $self->{h} > 0;
2061		2472
2062	delete $self->{texture};	2473	delete $self->{texture};
2063		2474
2064	$ROOT->on_refresh ($self, sub {	2475	$ROOT->on_post_alloc ($self, sub {
		2476	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2477
2065	if (delete $self->{need_reflow}) {	2478	if (delete $self->{need_reflow}) {
2066	my $height = 0;	2479	my $height = 0;
2067		2480
2068	$height += $_->[0] = $self->text_height ($_->[2])	2481	my $layout = $self->{layout};
		2482
		2483	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2484
2069	for @{$self->{par}};	2485	for (@{$self->{par}}) {
		2486	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
		2487	$layout->set_width ($W - $_->[3]);
		2488	$layout->set_markup ($_->[4]);
		2489	my ($w, $h) = $layout->size;
		2490	$_->[0] = $w + $_->[3];
		2491	$_->[1] = $h;
		2492	}
		2493
		2494	$height += $_->[1];
		2495	}
2070		2496
2071	$self->{height} = $height;	2497	$self->{height} = $height;
2072		2498
2073	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2499	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2074		2500
2075	delete $self->{texture};	2501	delete $self->{texture};
2076	}	2502	}
2077		2503
2078	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	2504	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2079	glClearColor 0, 0, 0, 1;	2505	glClearColor 0.5, 0.5, 0.5, 0;
2080	glClear GL_COLOR_BUFFER_BIT;	2506	glClear GL_COLOR_BUFFER_BIT;
2081		2507
		2508	my $top = int $self->{children}[1]{range}[0];
		2509
		2510	my $y0 = $top;
		2511	my $y1 = $top + $H;
		2512
		2513	my $y = 0;
		2514
		2515	my $layout = $self->{layout};
		2516
		2517	$layout->set_font ($self->{font}) if $self->{font};
		2518
2082	glEnable GL_BLEND;	2519	glEnable GL_BLEND;
		2520	#TODO# not correct in windows where rgba is forced off
2083	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2521	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2084	glEnable GL_TEXTURE_2D;
2085	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2086
2087	my $top = int $self->{children}[1]{range}[0];
2088
2089	my $y0 = $top;
2090	my $y1 = $top + $self->{h};
2091
2092	my $y = 0;
2093
2094	my $layout = $self->{layout};
2095
2096	$layout->set_font ($self->{font}) if $self->{font};
2097		2522
2098	for my $par (@{$self->{par}}) {	2523	for my $par (@{$self->{par}}) {
2099	my $h = $par->[0];	2524	my $h = $par->[1];
2100		2525
2101	if ($y0 < $y + $h && $y < $y1) {	2526	if ($y0 < $y + $h && $y < $y1) {
		2527	$layout->set_foreground (@{ $par->[2] });
		2528	$layout->set_width ($W - $par->[3]);
2102	$layout->set_text ($par->[2]);	2529	$layout->set_markup ($par->[4]);
2103		2530
2104	glColor @{ $par->[1] };	2531	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2105	my ($W, $H) = $layout->size;	2532
2106	CFClient::Texture->new_from_layout ($layout)->draw_quad (0, $y - $y0);	2533	glRasterPos $par->[3], $y - $y0;
		2534	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2107	}	2535	}
2108		2536
2109	$y += $h;	2537	$y += $h;
2110	}	2538	}
2111		2539
2112	glDisable GL_TEXTURE_2D;
2113	glDisable GL_BLEND;	2540	glDisable GL_BLEND;
2114	};	2541	};
2115	});	2542	});
2116	}	2543	}
2117		2544
2118	sub _draw {	2545	sub _draw {
2119	my ($self) = @_;	2546	my ($self) = @_;
2120		2547
2121	if ($self->{texture}) {
2122	glEnable GL_TEXTURE_2D;	2548	glEnable GL_TEXTURE_2D;
2123	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2549	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2550	glColor 1, 1, 1, 1;
2124	$self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});	2551	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2125	glDisable GL_TEXTURE_2D;	2552	glDisable GL_TEXTURE_2D;
2126	}
2127		2553
2128	$self->{children}[1]->draw;	2554	$self->{children}[1]->draw;
2129		2555
2130	}	2556	}
2131		2557
…		…
2179		2605
2180	sub new {	2606	sub new {
2181	my $class = shift;	2607	my $class = shift;
2182		2608
2183	my $self = $class->SUPER::new (	2609	my $self = $class->SUPER::new (
2184	state => 0,	2610	state => 0,
2185	connect_activate => \&toggle_flopper,	2611	on_activate => \&toggle_flopper,
2186	@_	2612	@_
2187	);	2613	);
2188		2614
2189	if ($self->{state}) {
2190	$self->{state} = 0;
2191	$self->toggle_flopper;
2192	}
2193
2194	$self	2615	$self
2195	}	2616	}
2196		2617
2197	sub toggle_flopper {	2618	sub toggle_flopper {
2198	my ($self) = @_;	2619	my ($self) = @_;
2199		2620
2200	# TODO: use animation	2621	$self->{other}->toggle_visibility;
2201	if ($self->{state} = !$self->{state}) {
2202	$CFClient::UI::ROOT->add ($self->{other});
2203	$self->{other}->move ($self->coord2global (0, $self->{h}));
2204	$self->emit ("open");
2205	} else {
2206	$CFClient::UI::ROOT->remove ($self->{other});
2207	$self->emit ("close");
2208	}
2209
2210	$self->emit (changed => $self->{state});
2211	}	2622	}
2212		2623
2213	#############################################################################	2624	#############################################################################
2214		2625
2215	package CFClient::UI::Tooltip;	2626	package CFClient::UI::Tooltip;
…		…
2225	@_,	2636	@_,
2226	can_events => 0,	2637	can_events => 0,
2227	)	2638	)
2228	}	2639	}
2229		2640
2230	sub set_markup {	2641	sub set_tooltip_from {
2231	my ($self, $text) = @_;	2642	my ($self, $widget) = @_;
2232		2643
2233	$self->{label} ||= new CFClient::UI::Label fontsize => 0.8, fg => [0, 0, 0];	2644	my $tooltip = $widget->{tooltip};
2234	$self->{label}->set_markup ($text);	2645
2235	$self->add ($self->{label});	2646	if ($ENV{CFPLUS_DEBUG} & 2) {
		2647	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2648	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2649	. "req $widget->{req_w} $widget->{req_h}\n"
		2650	. "visible $widget->{visible}";
		2651	}
		2652
		2653	$self->add (new CFClient::UI::Label
		2654	markup => $tooltip,
		2655	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
		2656	fontsize => 0.8,
		2657	fg => [0, 0, 0, 1],
		2658	ellipsise => 0,
		2659	font => ($widget->{tooltip_font} || $::FONT_PROP),
		2660	);
2236	}	2661	}
2237		2662
2238	sub size_request {	2663	sub size_request {
2239	my ($self) = @_;	2664	my ($self) = @_;
2240
2241	$self->child->set_max_size ($::WIDTH * 0.3);
2242		2665
2243	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2666	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2244		2667
2245	($w + 4, $h + 4)	2668	($w + 4, $h + 4)
2246	}	2669	}
…		…
2249	my ($self, $w, $h) = @_;	2672	my ($self, $w, $h) = @_;
2250		2673
2251	$self->SUPER::size_allocate ($w - 4, $h - 4);	2674	$self->SUPER::size_allocate ($w - 4, $h - 4);
2252	}	2675	}
2253		2676
		2677	sub visibility_change {
		2678	my ($self, $visible) = @_;
		2679
		2680	return unless $visible;
		2681
		2682	$self->{root}->on_post_alloc ("move_$self" => sub {
		2683	my $widget = $self->{owner}
		2684	or return;
		2685
		2686	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2687
		2688	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2689	if $x + $self->{w} > $::WIDTH;
		2690
		2691	$self->move_abs ($x, $y);
		2692	});
		2693	}
		2694
2254	sub _draw {	2695	sub _draw {
2255	my ($self) = @_;	2696	my ($self) = @_;
2256		2697
2257	glPushMatrix;
2258	glTranslate 0.375, 0.375;	2698	glTranslate 0.375, 0.375;
2259		2699
2260	my ($w, $h) = @$self{qw(w h)};	2700	my ($w, $h) = @$self{qw(w h)};
2261		2701
2262	glColor 1, 0.8, 0.4;	2702	glColor 1, 0.8, 0.4;
…		…
2273	glVertex 0 , $h;	2713	glVertex 0 , $h;
2274	glVertex $w, $h;	2714	glVertex $w, $h;
2275	glVertex $w, 0;	2715	glVertex $w, 0;
2276	glEnd;	2716	glEnd;
2277		2717
2278	glPopMatrix;	2718	glTranslate 2 - 0.375, 2 - 0.375;
2279		2719
2280	glTranslate 2, 2;
2281	$self->SUPER::_draw;	2720	$self->SUPER::_draw;
2282	}	2721	}
2283		2722
2284	#############################################################################	2723	#############################################################################
2285		2724
…		…
2290	use CFClient::OpenGL;	2729	use CFClient::OpenGL;
2291		2730
2292	sub new {	2731	sub new {
2293	my $class = shift;	2732	my $class = shift;
2294		2733
2295	$class->SUPER::new (	2734	my $self = $class->SUPER::new (
2296	aspect => 1,	2735	aspect => 1,
		2736	can_events => 0,
2297	@_,	2737	@_,
2298	)	2738	);
		2739
		2740	if ($self->{anim} && $self->{animspeed}) {
		2741	Scalar::Util::weaken (my $widget = $self);
		2742
		2743	$self->{timer} = Event->timer (
		2744	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
		2745	hard => 1,
		2746	interval => $self->{animspeed},
		2747	cb => sub {
		2748	++$widget->{frame};
		2749	$widget->update;
		2750	},
		2751	);
		2752	}
		2753
		2754	$self
2299	}	2755	}
2300		2756
2301	sub size_request {	2757	sub size_request {
2302	(32, 8)	2758	(32, 8)
2303	}	2759	}
2304		2760
		2761	sub update {
		2762	my ($self) = @_;
		2763
		2764	return unless $self->{visible};
		2765
		2766	$self->SUPER::update;
		2767	}
		2768
2305	sub draw {	2769	sub _draw {
2306	my ($self) = @_;	2770	my ($self) = @_;
2307		2771
		2772	return unless $::CONN;
		2773
		2774	my $face;
		2775
		2776	if ($self->{frame}) {
		2777	my $anim = $::CONN->{anim}[$self->{anim}];
		2778
		2779	$face = $anim->[ $self->{frame} % @$anim ]
		2780	if $anim && @$anim;
		2781	}
		2782
2308	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	2783	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2309		2784
2310	if ($tex) {	2785	if ($tex) {
2311	glEnable GL_BLEND;
2312	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2313	glEnable GL_TEXTURE_2D;	2786	glEnable GL_TEXTURE_2D;
2314	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2787	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2315	glColor 1, 1, 1, 1;	2788	glColor 1, 1, 1, 1;
2316	$tex->draw_quad (0, 0, $self->{w}, $self->{h});	2789	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2317	glDisable GL_TEXTURE_2D;	2790	glDisable GL_TEXTURE_2D;
2318	glDisable GL_BLEND;
2319	}	2791	}
		2792	}
		2793
		2794	sub DESTROY {
		2795	my ($self) = @_;
		2796
		2797	$self->{timer}->cancel
		2798	if $self->{timer};
		2799
		2800	$self->SUPER::DESTROY;
2320	}	2801	}
2321		2802
2322	#############################################################################	2803	#############################################################################
2323		2804
		2805	package CFClient::UI::Menu;
		2806
		2807	our @ISA = CFClient::UI::FancyFrame::;
		2808
		2809	use CFClient::OpenGL;
		2810
		2811	sub new {
		2812	my $class = shift;
		2813
		2814	my $self = $class->SUPER::new (
		2815	items => [],
		2816	z => 100,
		2817	@_,
		2818	);
		2819
		2820	$self->add ($self->{vbox} = new CFClient::UI::VBox);
		2821
		2822	for my $item (@{ $self->{items} }) {
		2823	my ($widget, $cb) = @$item;
		2824
		2825	# handle various types of items, only text for now
		2826	if (!ref $widget) {
		2827	$widget = new CFClient::UI::Label
		2828	can_hover => 1,
		2829	can_events => 1,
		2830	text => $widget;
		2831	}
		2832
		2833	$self->{item}{$widget} = $item;
		2834
		2835	$self->{vbox}->add ($widget);
		2836	}
		2837
		2838	$self
		2839	}
		2840
		2841	# popup given the event (must be a mouse button down event currently)
		2842	sub popup {
		2843	my ($self, $ev) = @_;
		2844
		2845	$self->_emit ("popdown");
		2846
		2847	# maybe save $GRAB? must be careful about events...
		2848	$GRAB = $self;
		2849	$self->{button} = $ev->{button};
		2850
		2851	$self->show;
		2852	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
		2853	}
		2854
		2855	sub mouse_motion {
		2856	my ($self, $ev, $x, $y) = @_;
		2857
		2858	# TODO: should use vbox->find_widget or so
		2859	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
		2860	$self->{hover} = $self->{item}{$HOVER};
		2861	}
		2862
		2863	sub button_up {
		2864	my ($self, $ev, $x, $y) = @_;
		2865
		2866	if ($ev->{button} == $self->{button}) {
		2867	undef $GRAB;
		2868	$self->hide;
		2869
		2870	$self->_emit ("popdown");
		2871	$self->{hover}[1]->() if $self->{hover};
		2872	}
		2873	}
		2874
		2875	#############################################################################
		2876
		2877	package CFClient::UI::Statusbox;
		2878
		2879	our @ISA = CFClient::UI::VBox::;
		2880
		2881	sub new {
		2882	my $class = shift;
		2883
		2884	$class->SUPER::new (
		2885	fontsize => 0.8,
		2886	@_,
		2887	)
		2888	}
		2889
		2890	sub reorder {
		2891	my ($self) = @_;
		2892	my $NOW = time;
		2893
		2894	while (my ($k, $v) = each %{ $self->{item} }) {
		2895	delete $self->{item}{$k} if $v->{timeout} < $NOW;
		2896	}
		2897
		2898	my @widgets;
		2899
		2900	my @items = sort {
		2901	$a->{pri} <=> $b->{pri}
		2902	or $b->{id} <=> $a->{id}
		2903	} values %{ $self->{item} };
		2904
		2905	my $count = 10 + 1;
		2906	for my $item (@items) {
		2907	last unless --$count;
		2908
		2909	push @widgets, $item->{label} ||= do {
		2910	# TODO: doesn't handle markup well (read as: at all)
		2911	my $short = $item->{count} > 1
		2912	? "<b>$item->{count} ×</b> $item->{text}"
		2913	: $item->{text};
		2914
		2915	for ($short) {
		2916	s/^\s+//;
		2917	s/\s+/ /g;
		2918	}
		2919
		2920	new CFClient::UI::Label
		2921	markup => $short,
		2922	tooltip => $item->{tooltip},
		2923	tooltip_font => $::FONT_PROP,
		2924	tooltip_width => 0.67,
		2925	fontsize => $item->{fontsize} || $self->{fontsize},
		2926	max_w => $::WIDTH * 0.44,
		2927	fg => $item->{fg},
		2928	can_events => 1,
		2929	can_hover => 1
		2930	};
		2931	}
		2932
		2933	$self->clear;
		2934	$self->SUPER::add (reverse @widgets);
		2935	}
		2936
		2937	sub add {
		2938	my ($self, $text, %arg) = @_;
		2939
		2940	$text =~ s/^\s+//;
		2941	$text =~ s/\s+$//;
		2942
		2943	return unless $text;
		2944
		2945	my $timeout = time + ((delete $arg{timeout}) || 60);
		2946
		2947	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
		2948
		2949	if (my $item = $self->{item}{$group}) {
		2950	if ($item->{text} eq $text) {
		2951	$item->{count}++;
		2952	} else {
		2953	$item->{count} = 1;
		2954	$item->{text} = $item->{tooltip} = $text;
		2955	}
		2956	$item->{id} = ++$self->{id};
		2957	$item->{timeout} = $timeout;
		2958	delete $item->{label};
		2959	} else {
		2960	$self->{item}{$group} = {
		2961	id => ++$self->{id},
		2962	text => $text,
		2963	timeout => $timeout,
		2964	tooltip => $text,
		2965	fg => [0.8, 0.8, 0.8, 0.8],
		2966	pri => 0,
		2967	count => 1,
		2968	%arg,
		2969	};
		2970	}
		2971
		2972	$self->reorder;
		2973	}
		2974
		2975	sub reconfigure {
		2976	my ($self) = @_;
		2977
		2978	delete $_->{label}
		2979	for values %{ $self->{item} || {} };
		2980
		2981	$self->reorder;
		2982	$self->SUPER::reconfigure;
		2983	}
		2984
		2985	#############################################################################
		2986
		2987	package CFClient::UI::Inventory;
		2988
		2989	our @ISA = CFClient::UI::ScrolledWindow::;
		2990
		2991	sub new {
		2992	my $class = shift;
		2993
		2994	my $self = $class->SUPER::new (
		2995	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		2996	@_,
		2997	);
		2998
		2999	$self
		3000	}
		3001
		3002	sub set_items {
		3003	my ($self, $items) = @_;
		3004
		3005	$self->{scrolled}->clear;
		3006	return unless $items;
		3007
		3008	my @items = sort {
		3009	($a->{type} <=> $b->{type})
		3010	or ($a->{name} cmp $b->{name})
		3011	} @$items;
		3012
		3013	$self->{real_items} = \@items;
		3014
		3015	my $row = 0;
		3016	for my $item (@items) {
		3017	CFClient::Item::update_widgets $item;
		3018
		3019	$self->{scrolled}->add (0, $row, $item->{face_widget});
		3020	$self->{scrolled}->add (1, $row, $item->{desc_widget});
		3021	$self->{scrolled}->add (2, $row, $item->{weight_widget});
		3022
		3023	$row++;
		3024	}
		3025	}
		3026
		3027	#############################################################################
		3028
		3029	package CFClient::UI::BindEditor;
		3030
		3031	our @ISA = CFClient::UI::FancyFrame::;
		3032
		3033	sub new {
		3034	my $class = shift;
		3035
		3036	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3037
		3038	$self->add (my $vb = new CFClient::UI::VBox);
		3039
		3040
		3041	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3042	text => "start recording",
		3043	tooltip => "Start/Stops recording of actions."
		3044	."All subsequent actions after the recording started will be captured."
		3045	."The actions are displayed after the record was stopped."
		3046	."To bind the action you have to click on the 'Bind' button",
		3047	on_activate => sub {
		3048	unless ($self->{recording}) {
		3049	$self->start;
		3050	} else {
		3051	$self->stop;
		3052	}
		3053	});
		3054
		3055	$vb->add (new CFClient::UI::Label text => "Actions:");
		3056	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3057
		3058	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3059	$vb->add (my $hb = new CFClient::UI::HBox);
		3060	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3061	$hb->add (new CFClient::UI::Button
		3062	text => "bind",
		3063	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3064	on_activate => sub {
		3065	$self->ask_for_bind;
		3066	});
		3067
		3068	$vb->add (my $hb = new CFClient::UI::HBox);
		3069	$hb->add (new CFClient::UI::Button
		3070	text => "ok",
		3071	expand => 1,
		3072	tooltip => "This closes the binding editor and saves the binding",
		3073	on_activate => sub {
		3074	$self->hide;
		3075	$self->commit;
		3076	});
		3077
		3078	$hb->add (new CFClient::UI::Button
		3079	text => "cancel",
		3080	expand => 1,
		3081	tooltip => "This closes the binding editor without saving",
		3082	on_activate => sub {
		3083	$self->hide;
		3084	$self->{binding_cancel}->()
		3085	if $self->{binding_cancel};
		3086	});
		3087
		3088	$self->update_binding_widgets;
		3089
		3090	$self
		3091	}
		3092
		3093	sub commit {
		3094	my ($self) = @_;
		3095	my ($mod, $sym, $cmds) = $self->get_binding;
		3096	if ($sym != 0 && @$cmds > 0) {
		3097	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3098	."'. Don't forget 'Save Config'!");
		3099	$self->{binding_change}->($mod, $sym, $cmds)
		3100	if $self->{binding_change};
		3101	} else {
		3102	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3103	$self->{binding_cancel}->()
		3104	if $self->{binding_cancel};
		3105	}
		3106	}
		3107
		3108	sub start {
		3109	my ($self) = @_;
		3110
		3111	$self->{rec_btn}->set_text ("stop recording");
		3112	$self->{recording} = 1;
		3113	$self->clear_command_list;
		3114	$::CONN->start_record if $::CONN;
		3115	}
		3116
		3117	sub stop {
		3118	my ($self) = @_;
		3119
		3120	$self->{rec_btn}->set_text ("start recording");
		3121	$self->{recording} = 0;
		3122
		3123	my $rec;
		3124	$rec = $::CONN->stop_record if $::CONN;
		3125	return unless ref $rec eq 'ARRAY';
		3126	$self->set_command_list ($rec);
		3127	}
		3128
		3129	# if $commit is true, the binding will be set after the user entered a key combo
		3130	sub ask_for_bind {
		3131	my ($self, $commit) = @_;
		3132
		3133	CFClient::Binder::open_binding_dialog (sub {
		3134	my ($mod, $sym) = @_;
		3135	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3136	$self->update_binding_widgets;
		3137	$self->commit if $commit;
		3138	});
		3139	}
		3140
		3141	# $mod and $sym are the modifiers and key symbol
		3142	# $cmds is a array ref of strings (the commands)
		3143	# $cb is the callback that is executed on OK
		3144	# $ccb is the callback that is executed on CANCEL and
		3145	# when the binding was unsuccessful on OK
		3146	sub set_binding {
		3147	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3148
		3149	$self->clear_command_list;
		3150	$self->{recording} = 0;
		3151	$self->{rec_btn}->set_text ("start recording");
		3152
		3153	$self->{binding} = [$mod, $sym];
		3154	$self->{commands} = $cmds;
		3155
		3156	$self->{binding_change} = $cb;
		3157	$self->{binding_cancel} = $ccb;
		3158
		3159	$self->update_binding_widgets;
		3160	}
		3161
		3162	# this is a shortcut method that asks for a binding
		3163	# and then just binds it.
		3164	sub do_quick_binding {
		3165	my ($self, $cmds) = @_;
		3166	$self->set_binding (undef, undef, $cmds, sub {
		3167	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3168	});
		3169	$self->ask_for_bind (1);
		3170	}
		3171
		3172	sub update_binding_widgets {
		3173	my ($self) = @_;
		3174	my ($mod, $sym, $cmds) = $self->get_binding;
		3175	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3176	$self->set_command_list ($cmds);
		3177	}
		3178
		3179	sub get_binding {
		3180	my ($self) = @_;
		3181	return (
		3182	$self->{binding}->[0],
		3183	$self->{binding}->[1],
		3184	[ grep { defined $_ } @{$self->{commands}} ]
		3185	);
		3186	}
		3187
		3188	sub clear_command_list {
		3189	my ($self) = @_;
		3190	$self->{cmdbox}->clear ();
		3191	}
		3192
		3193	sub set_command_list {
		3194	my ($self, $cmds) = @_;
		3195
		3196	$self->{cmdbox}->clear ();
		3197	$self->{commands} = $cmds;
		3198
		3199	my $idx = 0;
		3200
		3201	for (@$cmds) {
		3202	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3203
		3204	my $i = $idx;
		3205	$hb->add (new CFClient::UI::Label text => $_);
		3206	$hb->add (new CFClient::UI::Button
		3207	text => "delete",
		3208	tooltip => "Deletes the action from the record",
		3209	on_activate => sub {
		3210	$self->{cmdbox}->remove ($hb);
		3211	$cmds->[$i] = undef;
		3212	});
		3213
		3214
		3215	$idx++
		3216	}
		3217	}
		3218
		3219	#############################################################################
		3220
		3221	package CFClient::UI::SpellList;
		3222
		3223	our @ISA = CFClient::UI::FancyFrame::;
		3224
		3225	sub new {
		3226	my $class = shift;
		3227
		3228	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3229
		3230	$self->add (new CFClient::UI::ScrolledWindow
		3231	scrolled => $self->{spellbox} = new CFClient::UI::Table);
		3232
		3233	$self;
		3234	}
		3235
		3236	# XXX: Do sorting? Argl...
		3237	sub add_spell {
		3238	my ($self, $spell) = @_;
		3239	$self->{spells}->{$spell->{name}} = $spell;
		3240
		3241	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
		3242	face => $spell->{face},
		3243	can_hover => 1,
		3244	can_events => 1,
		3245	tooltip => $spell->{message});
		3246
		3247	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3248	text => $spell->{name},
		3249	can_hover => 1,
		3250	can_events => 1,
		3251	tooltip => $spell->{message},
		3252	expand => 1);
		3253
		3254	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3255	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3256	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3257	expand => 1);
		3258
		3259	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3260	text => "bind to key",
		3261	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3262	}
		3263
		3264	sub rebuild_spell_list {
		3265	my ($self) = @_;
		3266	$self->{tbl_idx} = 0;
		3267	$self->add_spell ($_) for values %{$self->{spells}};
		3268	}
		3269
		3270	sub remove_spell {
		3271	my ($self, $spell) = @_;
		3272	delete $self->{spells}->{$spell->{name}};
		3273	$self->rebuild_spell_list;
		3274	}
		3275
		3276	#############################################################################
		3277
2324	package CFClient::UI::Root;	3278	package CFClient::UI::Root;
2325		3279
2326	our @ISA = CFClient::UI::Container::;	3280	our @ISA = CFClient::UI::Container::;
2327		3281
2328	use CFClient::OpenGL;	3282	use CFClient::OpenGL;
2329		3283
2330	sub check_size {	3284	sub new {
2331	my ($self) = @_;	3285	my $class = shift;
2332		3286
2333	$self->configure (0, 0, $::WIDTH, $::HEIGHT);	3287	my $self = $class->SUPER::new (
		3288	visible => 1,
		3289	@_,
		3290	);
		3291
		3292	Scalar::Util::weaken ($self->{root} = $self);
		3293
		3294	$self
2334	}	3295	}
2335		3296
2336	sub size_request {	3297	sub size_request {
2337	($::WIDTH, $::HEIGHT)	3298	my ($self) = @_;
2338	}
2339		3299
2340	sub configure {	3300	($self->{w}, $self->{h})
		3301	}
		3302
		3303	sub _to_pixel {
		3304	my ($coord, $size, $max) = @_;
		3305
		3306	$coord =
		3307	$coord eq "center" ? ($max - $size) * 0.5
		3308	: $coord eq "max" ? $max
		3309	: $coord;
		3310
		3311	$coord = 0 if $coord < 0;
		3312	$coord = $max - $size if $coord > $max - $size;
		3313
		3314	int $coord + 0.5
		3315	}
		3316
		3317	sub size_allocate {
2341	my ($self, $x, $y, $w, $h) = @_;	3318	my ($self, $w, $h) = @_;
2342		3319
2343	$self->SUPER::configure ($x, $y, $w, $h);
2344
2345	for my $child (@{$self->{children}}) {	3320	for my $child ($self->children) {
2346	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3321	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2347		3322
2348	$X = List::Util::max 0, List::Util::min $w - $W, $X;	3323	$X = $child->{force_x} if exists $child->{force_x};
2349	$Y = List::Util::max 0, List::Util::min $h - $H, $Y;	3324	$Y = $child->{force_y} if exists $child->{force_y};
		3325
		3326	$X = _to_pixel $X, $W, $self->{w};
		3327	$Y = _to_pixel $Y, $H, $self->{h};
		3328
2350	$child->configure ($X, $Y, $W,$H);	3329	$child->configure ($X, $Y, $W, $H);
2351	}	3330	}
2352	}	3331	}
2353		3332
2354	sub _topleft {	3333	sub coord2local {
2355	my ($self, $x, $y) = @_;	3334	my ($self, $x, $y) = @_;
2356		3335
2357	($x, $y)	3336	($x, $y)
2358	}	3337	}
2359		3338
		3339	sub coord2global {
		3340	my ($self, $x, $y) = @_;
		3341
		3342	($x, $y)
		3343	}
		3344
2360	sub update {	3345	sub update {
2361	my ($self) = @_;	3346	my ($self) = @_;
2362		3347
2363	$self->check_size;	3348	$::WANT_REFRESH++;
2364	::refresh ();
2365	}	3349	}
2366		3350
2367	sub add {	3351	sub add {
2368	my ($self, $child) = @_;	3352	my ($self, @children) = @_;
2369		3353
2370	# integerize window positions	3354	$_->{is_toplevel} = 1
2371	$child->{x} = int $child->{x};	3355	for @children;
2372	$child->{y} = int $child->{y};
2373		3356
2374	$self->SUPER::add ($child);	3357	$self->SUPER::add (@children);
		3358	}
		3359
		3360	sub remove {
		3361	my ($self, @children) = @_;
		3362
		3363	$self->SUPER::remove (@children);
		3364
		3365	delete $self->{is_toplevel}
		3366	for @children;
		3367
		3368	while (@children) {
		3369	my $w = pop @children;
		3370	push @children, $w->children;
		3371	$w->set_invisible;
		3372	}
2375	}	3373	}
2376		3374
2377	sub on_refresh {	3375	sub on_refresh {
2378	my ($self, $id, $cb) = @_;	3376	my ($self, $id, $cb) = @_;
2379		3377
2380	$self->{refresh_hook}{$id} = $cb;	3378	$self->{refresh_hook}{$id} = $cb;
2381	}	3379	}
2382		3380
		3381	sub on_post_alloc {
		3382	my ($self, $id, $cb) = @_;
		3383
		3384	$self->{post_alloc_hook}{$id} = $cb;
		3385	}
		3386
2383	sub draw {	3387	sub draw {
2384	my ($self) = @_;	3388	my ($self) = @_;
2385		3389
2386	while (my $rcb = delete $self->{refresh_hook}) {	3390	while ($self->{refresh_hook}) {
2387	$_->() for values %$rcb;	3391	$_->()
		3392	for values %{delete $self->{refresh_hook}};
2388	}	3393	}
		3394
		3395	if ($self->{realloc}) {
		3396	my %queue;
		3397	my @queue;
		3398	my $widget;
		3399
		3400	outer:
		3401	while () {
		3402	if (my $realloc = delete $self->{realloc}) {
		3403	for $widget (values %$realloc) {
		3404	$widget->{visible} or next; # do not resize invisible widgets
		3405
		3406	$queue{$widget+0}++ and next; # duplicates are common
		3407
		3408	push @{ $queue[$widget->{visible}] }, $widget;
		3409	}
		3410	}
		3411
		3412	while () {
		3413	@queue or last outer;
		3414
		3415	$widget = pop @{ $queue[-1] || [] }
		3416	and last;
		3417
		3418	pop @queue;
		3419	}
		3420
		3421	delete $queue{$widget+0};
		3422
		3423	my ($w, $h) = $widget->size_request;
		3424
		3425	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3426	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3427
		3428	$w = $widget->{force_w} if exists $widget->{force_w};
		3429	$h = $widget->{force_h} if exists $widget->{force_h};
		3430
		3431	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3432	|| delete $widget->{force_realloc}) {
		3433	$widget->{req_w} = $w;
		3434	$widget->{req_h} = $h;
		3435
		3436	$self->{size_alloc}{$widget+0} = $widget;
		3437
		3438	if (my $parent = $widget->{parent}) {
		3439	$self->{realloc}{$parent+0} = $parent
		3440	unless $queue{$parent+0};
		3441
		3442	$parent->{force_size_alloc} = 1;
		3443	$self->{size_alloc}{$parent+0} = $parent;
		3444	}
		3445	}
		3446
		3447	delete $self->{realloc}{$widget+0};
		3448	}
		3449	}
		3450
		3451	while (my $size_alloc = delete $self->{size_alloc}) {
		3452	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3453	values %$size_alloc;
		3454
		3455	while () {
		3456	my $widget = pop @queue || last;
		3457
		3458	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
		3459
		3460	$w = 0 if $w < 0;
		3461	$h = 0 if $h < 0;
		3462
		3463	$w = int $w + 0.5;
		3464	$h = int $h + 0.5;
		3465
		3466	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3467	$widget->{old_w} = $widget->{w};
		3468	$widget->{old_h} = $widget->{h};
		3469
		3470	$widget->{w} = $w;
		3471	$widget->{h} = $h;
		3472
		3473	$widget->emit (size_allocate => $w, $h);
		3474	}
		3475	}
		3476	}
		3477
		3478	while ($self->{post_alloc_hook}) {
		3479	$_->()
		3480	for values %{delete $self->{post_alloc_hook}};
		3481	}
		3482
2389		3483
2390	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3484	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2391	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3485	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2392	glClear GL_COLOR_BUFFER_BIT;	3486	glClear GL_COLOR_BUFFER_BIT;
2393		3487
2394	glMatrixMode GL_PROJECTION;	3488	glMatrixMode GL_PROJECTION;
2395	glLoadIdentity;	3489	glLoadIdentity;
2396	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;	3490	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2397	glMatrixMode GL_MODELVIEW;	3491	glMatrixMode GL_MODELVIEW;
2398	glLoadIdentity;	3492	glLoadIdentity;
2399		3493
		3494	{
		3495	package CFClient::UI::Base;
		3496
		3497	($draw_x, $draw_y, $draw_w, $draw_h) =
		3498	(0, 0, $self->{w}, $self->{h});
		3499	}
		3500
2400	$self->_draw;	3501	$self->_draw;
2401	}	3502	}
2402		3503
2403	#############################################################################	3504	#############################################################################
2404		3505
2405	package CFClient::UI;	3506	package CFClient::UI;
2406		3507
2407	$ROOT = new CFClient::UI::Root;	3508	$ROOT = new CFClient::UI::Root;
2408	$TOOLTIP = new CFClient::UI::Tooltip;	3509	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2409		3510
2410	1	3511	1
2411		3512

Diff Legend

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