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.169 by elmex, Mon Apr 24 10:43:39 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	#############################################################################
…		…
503		672
504	$self	673	$self
505	}	674	}
506		675
507	sub add {	676	sub add {
508	my ($self, $child) = @_;	677	my ($self, @widgets) = @_;
509		678
510	$child->set_parent ($self);	679	$_->set_parent ($self)
		680	for @widgets;
511		681
512	use sort 'stable';	682	use sort 'stable';
513		683
514	$self->{children} = [	684	$self->{children} = [
515	sort { $a->{z} <=> $b->{z} }	685	sort { $a->{z} <=> $b->{z} }
516	@{$self->{children}}, $child	686	@{$self->{children}}, @widgets
517	];	687	];
518		688
519	$child->check_size;	689	$self->realloc;
		690	}
		691
		692	sub children {
		693	@{ $_[0]{children} }
520	}	694	}
521		695
522	sub remove {	696	sub remove {
523	my ($self, $child) = @_;	697	my ($self, $child) = @_;
524		698
525	delete $child->{parent};	699	delete $child->{parent};
526	$child->hide;	700	$child->hide;
527		701
528	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	702	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
529		703
530	$self->check_size;	704	$self->realloc;
531	$self->update;
532	}	705	}
533		706
534	sub clear {	707	sub clear {
535	my ($self) = @_;	708	my ($self) = @_;
536		709
…		…
539		712
540	for (@$children) {	713	for (@$children) {
541	delete $_->{parent};	714	delete $_->{parent};
542	$_->hide;	715	$_->hide;
543	}	716	}
		717
		718	$self->realloc;
544	}	719	}
545		720
546	sub find_widget {	721	sub find_widget {
547	my ($self, $x, $y) = @_;	722	my ($self, $x, $y) = @_;
548		723
…		…
623	}	798	}
624		799
625	sub update {	800	sub update {
626	my ($self) = @_;	801	my ($self) = @_;
627		802
628	# we want to do this delayed...	803	$ROOT->on_post_alloc ($self => sub { $self->render_child });
629	$self->render_chld;
630	$self->SUPER::update;	804	$self->SUPER::update;
631	}
632
633	sub render_chld {
634	my ($self) = @_;
635
636	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
637	glClearColor 0, 0, 0, 1;
638	glClear GL_COLOR_BUFFER_BIT;
639	$self->child->draw;
640	};
641	}	805	}
642		806
643	sub size_allocate {	807	sub size_allocate {
644	my ($self, $w, $h) = @_;	808	my ($self, $w, $h) = @_;
645		809
646	$self->child->configure (0, 0, $w, $h);	810	$self->SUPER::size_allocate ($w, $h);
		811	$self->update;
		812	}
647		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
648	$self->render_chld;	834	$self->_render;
		835	};
649	}	836	}
650		837
651	sub _draw {	838	sub _draw {
652	my ($self) = @_;	839	my ($self) = @_;
653		840
654	my ($w, $h) = ($self->w, $self->h);	841	my ($w, $h) = @$self{qw(w h)};
655		842
656	my $tex = $self->{texture}	843	my $tex = $self->{texture}
657	or return;	844	or return;
658		845
659	glEnable GL_BLEND;
660	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
661	glEnable GL_TEXTURE_2D;	846	glEnable GL_TEXTURE_2D;
662	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;
663		849
664	$tex->draw_quad (0, 0, $w, $h);	850	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
665		851
666	glDisable GL_BLEND;
667	glDisable GL_TEXTURE_2D;	852	glDisable GL_TEXTURE_2D;
668	}	853	}
669		854
670	#############################################################################	855	#############################################################################
671		856
672	package CFClient::UI::ViewPort;	857	package CFClient::UI::ViewPort;
673		858
674	our @ISA = CFClient::UI::Window::;	859	our @ISA = CFClient::UI::Window::;
675
676	sub new { die }
677
678	sub size_request {
679	my ($self) = @_;
680
681	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
682	$self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
683
684	@$self{qw(child_w child_h)}
685	}
686
687	sub _draw {
688	my ($self) = @_;
689
690	$self->{children}[1]->draw;
691	}
692
693
694	#############################################################################
695
696	package CFClient::UI::Frame;
697
698	our @ISA = CFClient::UI::Bin::;
699
700	use CFClient::OpenGL;
701		860
702	sub new {	861	sub new {
703	my $class = shift;	862	my $class = shift;
704		863
705	my $self = $class->SUPER::new (	864	$class->SUPER::new (
706	bg => [1, 1, 1, 1],	865	scroll_x => 0,
707	border_bg => [1, 1, 1, 1],	866	scroll_y => 1,
708	border => 0.8,
709	@_	867	@_,
710	);	868	)
711
712	$self
713	}	869	}
714		870
715	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 {
716	my ($self) = @_;	883	my ($self, $w, $h) = @_;
717		884
718	my ($w, $h) = ($self->{w}, $self->{h});	885	my $child = $self->child;
719		886
720	glEnable GL_BLEND;	887	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
721	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	888	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
722	glEnable GL_TEXTURE_2D;
723	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
724		889
725	# glBegin GL_QUADS;	890	$self->child->configure (0, 0, $w, $h);
726	# glColor 0, 0, 0, 0;	891	$self->update;
727	# glVertex 0 , 0;	892	}
728	# glVertex 0 , $h;
729	# glVertex $w, $h;
730	# glVertex $w, 0;
731	# glEnd;
732		893
		894	sub set_offset {
		895	my ($self, $x, $y) = @_;
733		896
734	$self->child->draw;	897	$self->{view_x} = int $x;
735	glDisable GL_BLEND;	898	$self->{view_y} = int $y;
736	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;
737	}	940	}
738		941
739	#############################################################################	942	#############################################################################
740		943
741	package CFClient::UI::FancyFrame;	944	package CFClient::UI::ScrolledWindow;
742		945
743	our @ISA = CFClient::UI::Bin::;	946	our @ISA = CFClient::UI::HBox::;
744
745	use CFClient::OpenGL;
746
747	my @tex =
748	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
749	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
750		947
751	sub new {	948	sub new {
752	my $class = shift;	949	my $class = shift;
753		950
754	# 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;
755		1054
756	my $self = $class->SUPER::new (	1055	my $self = $class->SUPER::new (
757	bg => [1, 1, 1, 1],	1056	bg => [1, 1, 1, 1],
758	border_bg => [1, 1, 1, 1],	1057	border_bg => [1, 1, 1, 1],
759	border => 0.8,	1058	border => 0.6,
760	can_events => 1,	1059	can_events => 1,
		1060	min_w => 16,
		1061	min_h => 16,
761	@_	1062	@_
762	);	1063	);
763		1064
764	$self->{title} &&= new CFClient::UI::Label	1065	$self->{title} &&= new CFClient::UI::Label
765	align => 0,	1066	align => 0,
766	valign => 1,	1067	valign => 1,
767	text => $self->{title},	1068	text => $self->{title},
768	fontsize => 1;	1069	fontsize => $self->{border};
769		1070
770	$self	1071	$self
771	}	1072	}
772		1073
773	sub border {	1074	sub border {
…		…
789	my ($self, $w, $h) = @_;	1090	my ($self, $w, $h) = @_;
790		1091
791	$h -= List::Util::max 0, $self->border * 2;	1092	$h -= List::Util::max 0, $self->border * 2;
792	$w -= List::Util::max 0, $self->border * 2;	1093	$w -= List::Util::max 0, $self->border * 2;
793		1094
794	$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)
795	if $self->{title};	1096	if $self->{title};
796		1097
797	$self->child->configure ($self->border, $self->border, $w, $h);	1098	$self->child->configure ($self->border, $self->border, $w, $h);
798	}	1099	}
799		1100
800	sub button_down {	1101	sub button_down {
801	my ($self, $ev, $x, $y) = @_;	1102	my ($self, $ev, $x, $y) = @_;
802		1103
		1104	my ($w, $h) = @$self{qw(w h)};
803	my $border = $self->border;	1105	my $border = $self->border;
804		1106
805	if ($x < $self->{w} && $x >= $self->{w} - $border	1107	my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
806	&& $y < $self->{h} && $y >= $self->{h} - $border) {	1108	my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
807		1109
		1110	if ($lr & $td) {
		1111	my ($wx, $wy) = ($self->{x}, $self->{y});
808	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1112	my ($ox, $oy) = ($ev->{x}, $ev->{y});
809	my ($bw, $bh) = ($self->{w}, $self->{h});	1113	my ($bw, $bh) = ($self->{w}, $self->{h});
810		1114
		1115	my $mx = $x < $border;
		1116	my $my = $y < $border;
		1117
811	$self->{motion} = sub {	1118	$self->{motion} = sub {
812	my ($ev, $x, $y) = @_;	1119	my ($ev, $x, $y) = @_;
813		1120
814	($x, $y) = ($ev->{x}, $ev->{y});	1121	my $dx = $ev->{x} - $ox;
		1122	my $dy = $ev->{y} - $oy;
815		1123
816	$self->{user_w} = $bw + $x - $ox;	1124	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
817	$self->{user_h} = $bh + $y - $oy;	1125	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
818	$self->check_size;	1126
		1127	$self->realloc;
		1128	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
819	};	1129	};
820		1130
821	} elsif ($x >= 0 && $x < $self->{w}	1131	} elsif ($lr ^ $td) {
822	&& $y >= 0 && $y < $border) {
823
824	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1132	my ($ox, $oy) = ($ev->{x}, $ev->{y});
825	my ($bx, $by) = ($self->{x}, $self->{y});	1133	my ($bx, $by) = ($self->{x}, $self->{y});
826		1134
827	$self->{motion} = sub {	1135	$self->{motion} = sub {
828	my ($ev, $x, $y) = @_;	1136	my ($ev, $x, $y) = @_;
829		1137
830	($x, $y) = ($ev->{x}, $ev->{y});	1138	($x, $y) = ($ev->{x}, $ev->{y});
831		1139
832	$self->move ($bx + $x - $ox, $by + $y - $oy);	1140	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
833	$self->update;
834	};	1141	};
835	}	1142	}
836	}	1143	}
837		1144
838	sub button_up {	1145	sub button_up {
…		…
851	my ($self) = @_;	1158	my ($self) = @_;
852		1159
853	my ($w, $h ) = ($self->{w}, $self->{h});	1160	my ($w, $h ) = ($self->{w}, $self->{h});
854	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1161	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});
855		1162
856	glEnable GL_BLEND;
857	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
858	glEnable GL_TEXTURE_2D;	1163	glEnable GL_TEXTURE_2D;
859	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1164	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
860		1165
861	my $border = $self->border;	1166	my $border = $self->border;
862		1167
863	glColor @{ $self->{border_bg} };	1168	glColor @{ $self->{border_bg} };
864	$tex[1]->draw_quad (0, 0, $w, $border);	1169	$border[0]->draw_quad_alpha (0, 0, $w, $border);
865	$tex[3]->draw_quad (0, $border, $border, $ch);	1170	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
866	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	1171	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
867	$tex[4]->draw_quad (0, $h - $border, $w, $border);	1172	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
868		1173
869	my $bg = $tex[0];	1174	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
		1175	glColor @{ $self->{bg} };
870		1176
871	# TODO: repeat texture not scale	1177	# TODO: repeat texture not scale
872	my $rep_x = $cw / $bg->{w};	1178	# solve this better(?)
873	my $rep_y = $ch / $bg->{h};	1179	$bg->{s} = $cw / $bg->{w};
874		1180	$bg->{t} = $ch / $bg->{h};
875	glColor @{ $self->{bg} };
876
877	$bg->{s} = $rep_x;
878	$bg->{t} = $rep_y;
879	$bg->{wrap_mode} = 1;
880	$bg->draw_quad ($border, $border, $cw, $ch);	1181	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
		1182	}
881		1183
882	glDisable GL_TEXTURE_2D;	1184	glDisable GL_TEXTURE_2D;
883	glDisable GL_BLEND;
884		1185
885	$self->{title}->draw if $self->{title};	1186	$self->{title}->draw if $self->{title};
		1187
886	$self->child->draw;	1188	$self->child->draw;
887	}	1189	}
888		1190
889	#############################################################################	1191	#############################################################################
890		1192
…		…
899	sub new {	1201	sub new {
900	my $class = shift;	1202	my $class = shift;
901		1203
902	$class->SUPER::new (	1204	$class->SUPER::new (
903	col_expand => [],	1205	col_expand => [],
904	@_	1206	@_,
905	)	1207	)
		1208	}
		1209
		1210	sub children {
		1211	grep $_, map @$_, grep $_, @{ $_[0]{children} }
906	}	1212	}
907		1213
908	sub add {	1214	sub add {
909	my ($self, $x, $y, $child) = @_;	1215	my ($self, $x, $y, $child) = @_;
910		1216
911	$child->set_parent ($self);	1217	$child->set_parent ($self);
912	$self->{children}[$y][$x] = $child;	1218	$self->{children}[$y][$x] = $child;
913		1219
914	$child->check_size;	1220	$self->realloc;
915	}	1221	}
916		1222
917	# 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?
918	sub clear {	1224	sub clear {
919	my ($self) = @_;	1225	my ($self) = @_;
920		1226
921	my $children = delete $self->{children};	1227	my @children = $self->children;
		1228	delete $self->{children};
922		1229
923	for (grep $_, map @$_, grep $_, @$children) {	1230	for (@children) {
924	delete $_->{parent};	1231	delete $_->{parent};
925	$_->hide;	1232	$_->hide;
926	}	1233	}
927		1234
928	$self->update;	1235	$self->realloc;
929	}	1236	}
930		1237
931	sub get_wh {	1238	sub get_wh {
932	my ($self) = @_;	1239	my ($self) = @_;
933		1240
…		…
964	sub size_allocate {	1271	sub size_allocate {
965	my ($self, $w, $h) = @_;	1272	my ($self, $w, $h) = @_;
966		1273
967	my ($ws, $hs) = $self->get_wh;	1274	my ($ws, $hs) = $self->get_wh;
968		1275
969	my $req_w = sum @$ws;	1276	my $req_w = (sum @$ws) || 1;
970	my $req_h = sum @$hs;	1277	my $req_h = (sum @$hs) || 1;
971		1278
972	# TODO: nicer code && do row_expand	1279	# TODO: nicer code && do row_expand
973	my @col_expand = @{$self->{col_expand}};	1280	my @col_expand = @{$self->{col_expand}};
974	@col_expand = (1) x @$ws unless @col_expand;	1281	@col_expand = (1) x @$ws unless @col_expand;
975	my $col_expand = (sum @col_expand) || 1;	1282	my $col_expand = (sum @col_expand) || 1;
…		…
1029	}	1336	}
1030	}	1337	}
1031		1338
1032	#############################################################################	1339	#############################################################################
1033		1340
1034	package CFClient::UI::HBox;	1341	package CFClient::UI::Box;
1035
1036	# TODO: wrap into common Box base class
1037		1342
1038	our @ISA = CFClient::UI::Container::;	1343	our @ISA = CFClient::UI::Container::;
1039		1344
1040	sub size_request {	1345	sub size_request {
1041	my ($self) = @_;	1346	my ($self) = @_;
1042		1347
1043	my @alloc = map [$_->size_request], @{$self->{children}};	1348	$self->{vertical}
1044		1349	? (
1045	(	1350	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1046	(List::Util::sum map $_->[0], @alloc),	1351	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1047	(List::Util::max map $_->[1], @alloc),	1352	)
1048	)	1353	: (
		1354	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1355	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1356	)
1049	}	1357	}
1050		1358
1051	sub size_allocate {	1359	sub size_allocate {
1052	my ($self, $w, $h) = @_;	1360	my ($self, $w, $h) = @_;
1053		1361
1054	($h, $w) = ($w, $h);	1362	my $space = $self->{vertical} ? $h : $w;
1055
1056	my $children = $self->{children};	1363	my $children = $self->{children};
1057		1364
1058	my @h = map $_->{req_w}, @$children;	1365	my @req;
1059		1366
1060	my $req_h = List::Util::sum @h;	1367	if ($self->{homogeneous}) {
1061		1368	@req = ($space / (@$children || 1)) x @$children;
1062	if ($req_h > $h) {
1063	# ah well, not enough space
1064	$_ *= $h / $req_h for @h;
1065	} 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 {
1066	my $exp = List::Util::sum map $_->{expand}, @$children;	1377	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1067	$exp ||= 1;
1068		1378
		1379	$space = ($space - $req) / $expand; # remaining space to give away
		1380
		1381	$req[$_] += $space * $children->[$_]{expand}
1069	for (0 .. $#$children) {	1382	for 0 .. $#$children;
1070	my $child = $children->[$_];
1071
1072	my $alloc_h = $h[$_];
1073	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1074	$h[$_] = $alloc_h;
1075	}	1383	}
1076	}	1384	}
1077		1385
1078	CFClient::UI::harmonize \@h;	1386	CFClient::UI::harmonize \@req;
1079		1387
1080	my $y = 0;	1388	my $pos = 0;
1081	for (0 .. $#$children) {	1389	for (0 .. $#$children) {
1082	my $child = $children->[$_];
1083	my $h = $h[$_];	1390	my $alloc = $req[$_];
1084	$child->configure ($y, 0, $h, $w);	1391	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1085		1392
1086	$y += $h;	1393	$pos += $alloc;
1087	}	1394	}
1088		1395
1089	1	1396	1
1090	}	1397	}
1091		1398
1092	#############################################################################	1399	#############################################################################
1093		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
1094	package CFClient::UI::VBox;	1416	package CFClient::UI::VBox;
1095		1417
1096	# TODO: wrap into common Box base class
1097
1098	our @ISA = CFClient::UI::Container::;	1418	our @ISA = CFClient::UI::Box::;
1099		1419
1100	sub size_request {	1420	sub new {
1101	my ($self) = @_;	1421	my $class = shift;
1102		1422
1103	my @alloc = map [$_->size_request], @{$self->{children}};	1423	$class->SUPER::new (
1104		1424	vertical => 1,
1105	(	1425	@_,
1106	(List::Util::max map $_->[0], @alloc),
1107	(List::Util::sum map $_->[1], @alloc),
1108	)	1426	)
1109	}	1427	}
1110		1428
1111	sub size_allocate {
1112	my ($self, $w, $h) = @_;
1113
1114	my $children = $self->{children};
1115
1116	my @h = map $_->{req_h}, @$children;
1117
1118	my $req_h = List::Util::sum @h;
1119
1120	if ($req_h > $h) {
1121	# ah well, not enough space
1122	$_ *= $h / $req_h for @h;
1123	} else {
1124	my $exp = List::Util::sum map $_->{expand}, @$children;
1125	$exp ||= 1;
1126
1127	for (0 .. $#$children) {
1128	my $child = $children->[$_];
1129
1130	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1131	}
1132	}
1133
1134	CFClient::UI::harmonize \@h;
1135
1136	my $y = 0;
1137	for (0 .. $#$children) {
1138	my $child = $children->[$_];
1139	my $h = $h[$_];
1140	$child->configure (0, $y, $w, $h);
1141
1142	$y += $h;
1143	}
1144
1145	1
1146	}
1147
1148	#############################################################################	1429	#############################################################################
1149		1430
1150	package CFClient::UI::Label;	1431	package CFClient::UI::Label;
1151		1432
1152	our @ISA = CFClient::UI::Base::;	1433	our @ISA = CFClient::UI::DrawBG::;
1153		1434
1154	use CFClient::OpenGL;	1435	use CFClient::OpenGL;
1155		1436
1156	sub new {	1437	sub new {
1157	my ($class, %arg) = @_;	1438	my ($class, %arg) = @_;
1158		1439
1159	my $self = $class->SUPER::new (	1440	my $self = $class->SUPER::new (
1160	fg => [1, 1, 1],	1441	fg => [1, 1, 1],
		1442	#bg => none
		1443	#active_bg => none
1161	#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),
1162	fontsize => 1,	1450	fontsize => 1,
1163	text => "",
1164	align => -1,	1451	align => -1,
1165	valign => -1,	1452	valign => -1,
1166	padding => 2,	1453	padding_x => 2,
1167	layout => new CFClient::Layout,	1454	padding_y => 2,
1168	can_events => 0,	1455	can_events => 0,
1169	%arg	1456	%arg
1170	);	1457	);
1171		1458
1172	if (exists $self->{template}) {	1459	if (exists $self->{template}) {
1173	my $layout = new CFClient::Layout;	1460	my $layout = new CFClient::Layout;
1174	$layout->set_text (delete $self->{template});	1461	$layout->set_text (delete $self->{template});
1175	$self->{template} = $layout;	1462	$self->{template} = $layout;
1176	}	1463	}
1177		1464
1178	$self->set_text (delete $self->{text}) if exists $self->{text};	1465	if (exists $self->{markup}) {
1179	$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	}
1180		1470
1181	$self	1471	$self
1182	}	1472	}
1183		1473
1184	sub escape {	1474	sub escape($) {
1185	local $_ = $_[1];	1475	local $_ = $_[0];
1186		1476
1187	s/&/&amp;/g;	1477	s/&/&amp;/g;
1188	s/>/&gt;/g;	1478	s/>/&gt;/g;
1189	s/</&lt;/g;	1479	s/</&lt;/g;
1190		1480
1191	$_[1]	1481	$_
		1482	}
		1483
		1484	sub update {
		1485	my ($self) = @_;
		1486
		1487	delete $self->{texture};
		1488	$self->SUPER::update;
1192	}	1489	}
1193		1490
1194	sub set_text {	1491	sub set_text {
1195	my ($self, $text) = @_;	1492	my ($self, $text) = @_;
1196		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;
1197	$self->{layout}->set_text ($text);	1498	$self->{layout}->set_text ($text);
1198		1499
1199	delete $self->{texture};	1500	$self->realloc;
1200	$self->check_size;
1201	$self->update;	1501	$self->update;
1202	}	1502	}
1203		1503
1204	sub set_markup {	1504	sub set_markup {
1205	my ($self, $markup) = @_;	1505	my ($self, $markup) = @_;
1206		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;
1207	$self->{layout}->set_markup ($markup);	1513	$self->{layout}->set_markup ($markup);
1208		1514
1209	delete $self->{texture};	1515	$self->realloc;
1210	$self->check_size;
1211	$self->update;	1516	$self->update;
1212	}	1517	}
1213		1518
1214	sub size_request {	1519	sub size_request {
1215	my ($self) = @_;	1520	my ($self) = @_;
1216		1521
1217	$self->{layout}->set_font ($self->{font}) if $self->{font};	1522	$self->{layout}->set_font ($self->{font}) if $self->{font};
1218	$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});
1219	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1526	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1220		1527
1221	my ($w, $h) = $self->{layout}->size;	1528	my ($w, $h) = $self->{layout}->size;
1222		1529
1223	if (exists $self->{template}) {	1530	if (exists $self->{template}) {
…		…
1228		1535
1229	$w = List::Util::max $w, $w2;	1536	$w = List::Util::max $w, $w2;
1230	$h = List::Util::max $h, $h2;	1537	$h = List::Util::max $h, $h2;
1231	}	1538	}
1232		1539
1233	(	1540	($w, $h)
1234	$w + $self->{padding} * 2,
1235	$h + $self->{padding} * 2,
1236	)
1237	}	1541	}
1238		1542
1239	sub size_allocate {	1543	sub size_allocate {
1240	my ($self, $w, $h) = @_;	1544	my ($self, $w, $h) = @_;
1241		1545
1242	delete $self->{texture};	1546	delete $self->{texture}
		1547	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1243	}	1548	}
1244		1549
1245	sub set_fontsize {	1550	sub set_fontsize {
1246	my ($self, $fontsize) = @_;	1551	my ($self, $fontsize) = @_;
1247		1552
1248	$self->{fontsize} = $fontsize;	1553	$self->{fontsize} = $fontsize;
1249	delete $self->{texture};	1554	delete $self->{texture};
1250	$self->check_size;	1555
1251	$self->update;	1556	$self->realloc;
1252	}	1557	}
1253		1558
1254	sub _draw {	1559	sub _draw {
1255	my ($self) = @_;	1560	my ($self) = @_;
1256		1561
		1562	$self->SUPER::_draw; # draw background, if applicable
		1563
1257	my $tex = $self->{texture} ||= do {	1564	my $tex = $self->{texture} ||= do {
		1565	$self->{layout}->set_foreground (@{$self->{fg}});
1258	$self->{layout}->set_font ($self->{font}) if $self->{font};	1566	$self->{layout}->set_font ($self->{font}) if $self->{font};
1259	$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});
1260	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);	1570	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
		1571
1261	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
1262	};	1583	};
1263		1584
1264	glEnable GL_BLEND;
1265	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1266	glEnable GL_TEXTURE_2D;	1585	glEnable GL_TEXTURE_2D;
1267	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1586	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1268		1587
		1588	if ($tex->{format} == GL_ALPHA) {
1269	glColor @{$self->{fg}};	1589	glColor @{$self->{fg}};
1270
1271	$self->{ox} = int (
1272	$self->{align} < 0 ? $self->{padding}
1273	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1274	: ($self->{w} - $tex->{w}) * 0.5
1275	);
1276
1277	$self->{oy} = int (
1278	$self->{valign} < 0 ? $self->{padding}
1279	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1280	: ($self->{h} - $tex->{h}) * 0.5
1281	);
1282
1283	$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	}
1284		1594
1285	glDisable GL_TEXTURE_2D;	1595	glDisable GL_TEXTURE_2D;
1286	glDisable GL_BLEND;
1287	}	1596	}
1288		1597
1289	#############################################################################	1598	#############################################################################
1290		1599
1291	package CFClient::UI::EntryBase;	1600	package CFClient::UI::EntryBase;
…		…
1304	active_fg => [0, 0, 0],	1613	active_fg => [0, 0, 0],
1305	can_hover => 1,	1614	can_hover => 1,
1306	can_focus => 1,	1615	can_focus => 1,
1307	valign => 0,	1616	valign => 0,
1308	can_events => 1,	1617	can_events => 1,
		1618	#text => ...
1309	@_	1619	@_
1310	)	1620	)
1311	}	1621	}
1312		1622
1313	sub _set_text {	1623	sub _set_text {
…		…
1323	$self->{text} = $text;	1633	$self->{text} = $text;
1324		1634
1325	$text =~ s/./*/g if $self->{hidden};	1635	$text =~ s/./*/g if $self->{hidden};
1326	$self->{layout}->set_text ("$text ");	1636	$self->{layout}->set_text ("$text ");
1327		1637
1328	$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;
1329	}	1648	}
1330		1649
1331	sub get_text {	1650	sub get_text {
1332	$_[0]{text}	1651	$_[0]{text}
1333	}	1652	}
…		…
1336	my ($self) = @_;	1655	my ($self) = @_;
1337		1656
1338	my ($w, $h) = $self->SUPER::size_request;	1657	my ($w, $h) = $self->SUPER::size_request;
1339		1658
1340	($w + 1, $h) # add 1 for cursor	1659	($w + 1, $h) # add 1 for cursor
1341	}
1342
1343	sub size_allocate {
1344	my ($self, $w, $h) = @_;
1345
1346	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1347	}
1348
1349	sub set_text {
1350	my ($self, $text) = @_;
1351
1352	$self->{cursor} = length $text;
1353	$self->_set_text ($text);
1354	$self->update;
1355	}	1660	}
1356		1661
1357	sub key_down {	1662	sub key_down {
1358	my ($self, $ev) = @_;	1663	my ($self, $ev) = @_;
1359		1664
…		…
1361	my $sym = $ev->{sym};	1666	my $sym = $ev->{sym};
1362	my $uni = $ev->{unicode};	1667	my $uni = $ev->{unicode};
1363		1668
1364	my $text = $self->get_text;	1669	my $text = $self->get_text;
1365		1670
1366	if ($sym == 8) {	1671	if ($uni == 8) {
1367	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1672	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1368	} elsif ($sym == 127) {	1673	} elsif ($uni == 127) {
1369	substr $text, $self->{cursor}, 1, "";	1674	substr $text, $self->{cursor}, 1, "";
1370	} elsif ($sym == CFClient::SDLK_LEFT) {	1675	} elsif ($sym == CFClient::SDLK_LEFT) {
1371	--$self->{cursor} if $self->{cursor};	1676	--$self->{cursor} if $self->{cursor};
1372	} elsif ($sym == CFClient::SDLK_RIGHT) {	1677	} elsif ($sym == CFClient::SDLK_RIGHT) {
1373	++$self->{cursor} if $self->{cursor} < length $self->{text};	1678	++$self->{cursor} if $self->{cursor} < length $self->{text};
1374	} elsif ($sym == CFClient::SDLK_HOME) {	1679	} elsif ($sym == CFClient::SDLK_HOME) {
1375	$self->{cursor} = 0;	1680	$self->{cursor} = 0;
1376	} elsif ($sym == CFClient::SDLK_END) {	1681	} elsif ($sym == CFClient::SDLK_END) {
1377	$self->{cursor} = length $text;	1682	$self->{cursor} = length $text;
1378	} elsif ($sym == 27) {	1683	} elsif ($uni == 27) {
1379	$self->emit ('escape');	1684	$self->_emit ('escape');
1380	} elsif ($uni) {	1685	} elsif ($uni) {
1381	substr $text, $self->{cursor}++, 0, chr $uni;	1686	substr $text, $self->{cursor}++, 0, chr $uni;
1382	}	1687	}
1383		1688
1384	$self->_set_text ($text);	1689	$self->_set_text ($text);
1385	$self->update;	1690
		1691	$self->realloc;
1386	}	1692	}
1387		1693
1388	sub focus_in {	1694	sub focus_in {
1389	my ($self) = @_;	1695	my ($self) = @_;
1390		1696
…		…
1470	if ($sym == 13) {	1776	if ($sym == 13) {
1471	unshift @{$self->{history}},	1777	unshift @{$self->{history}},
1472	my $txt = $self->get_text;	1778	my $txt = $self->get_text;
1473	$self->{history_pointer} = -1;	1779	$self->{history_pointer} = -1;
1474	$self->{history_saveback} = '';	1780	$self->{history_saveback} = '';
1475	$self->emit (activate => $txt);	1781	$self->_emit (activate => $txt);
1476	$self->update;	1782	$self->update;
1477		1783
1478	} elsif ($sym == CFClient::SDLK_UP) {	1784	} elsif ($sym == CFClient::SDLK_UP) {
1479	if ($self->{history_pointer} < 0) {	1785	if ($self->{history_pointer} < 0) {
1480	$self->{history_saveback} = $self->get_text;	1786	$self->{history_saveback} = $self->get_text;
…		…
1517		1823
1518	sub new {	1824	sub new {
1519	my $class = shift;	1825	my $class = shift;
1520		1826
1521	$class->SUPER::new (	1827	$class->SUPER::new (
1522	padding => 4,	1828	padding_x => 4,
		1829	padding_y => 4,
1523	fg => [1, 1, 1],	1830	fg => [1, 1, 1],
1524	bg => [1, 1, 1, 0.2],
1525	active_fg => [0, 0, 1],	1831	active_fg => [0, 0, 1],
1526	can_hover => 1,	1832	can_hover => 1,
1527	align => 0,	1833	align => 0,
1528	valign => 0,	1834	valign => 0,
1529	can_events => 1,	1835	can_events => 1,
1530	@_	1836	@_
1531	)	1837	)
1532	}	1838	}
1533		1839
		1840	sub activate { }
		1841
1534	sub button_up {	1842	sub button_up {
1535	my ($self, $ev, $x, $y) = @_;	1843	my ($self, $ev, $x, $y) = @_;
1536		1844
		1845	$self->emit ("activate")
1537	if ($x >= 0 && $x < $self->{w}	1846	if $x >= 0 && $x < $self->{w}
1538	&& $y >= 0 && $y < $self->{h}) {	1847	&& $y >= 0 && $y < $self->{h};
1539	$self->emit ("activate");
1540	}
1541	}	1848	}
1542		1849
1543	sub _draw {	1850	sub _draw {
1544	my ($self) = @_;	1851	my ($self) = @_;
1545		1852
…		…
1547		1854
1548	if ($GRAB == $self) {	1855	if ($GRAB == $self) {
1549	$self->{fg} = $self->{active_fg};	1856	$self->{fg} = $self->{active_fg};
1550	}	1857	}
1551		1858
1552	glEnable GL_BLEND;
1553	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1554	glEnable GL_TEXTURE_2D;	1859	glEnable GL_TEXTURE_2D;
1555	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1860	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1556	glColor 0, 0, 0, 1;	1861	glColor 0, 0, 0, 1;
1557		1862
1558	$tex[0]->draw_quad (0, 0, $self->{w}, $self->{h});	1863	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1559		1864
1560	glDisable GL_TEXTURE_2D;	1865	glDisable GL_TEXTURE_2D;
1561	glDisable GL_BLEND;
1562		1866
1563	$self->SUPER::_draw;	1867	$self->SUPER::_draw;
1564	}	1868	}
1565		1869
1566	#############################################################################	1870	#############################################################################
…		…
1577		1881
1578	sub new {	1882	sub new {
1579	my $class = shift;	1883	my $class = shift;
1580		1884
1581	$class->SUPER::new (	1885	$class->SUPER::new (
1582	padding => 2,	1886	padding_x => 2,
		1887	padding_y => 2,
1583	fg => [1, 1, 1],	1888	fg => [1, 1, 1],
1584	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],
1585	state => 0,	1892	state => 0,
1586	can_hover => 1,	1893	can_hover => 1,
1587	@_	1894	@_
1588	)	1895	)
1589	}	1896	}
1590		1897
1591	sub size_request {	1898	sub size_request {
1592	my ($self) = @_;	1899	my ($self) = @_;
1593		1900
1594	($self->{padding} * 2 + 6) x 2	1901	(6) x 2
1595	}	1902	}
1596		1903
1597	sub button_down {	1904	sub button_down {
1598	my ($self, $ev, $x, $y) = @_;	1905	my ($self, $ev, $x, $y) = @_;
1599		1906
1600	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1907	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1601	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1908	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1602	$self->{state} = !$self->{state};	1909	$self->{state} = !$self->{state};
1603	$self->emit (changed => $self->{state});	1910	$self->_emit (changed => $self->{state});
1604	}	1911	}
1605	}	1912	}
1606		1913
1607	sub _draw {	1914	sub _draw {
1608	my ($self) = @_;	1915	my ($self) = @_;
1609		1916
1610	$self->SUPER::_draw;	1917	$self->SUPER::_draw;
1611		1918
1612	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1919	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1613		1920
1614	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;
1615		1924
1616	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1925	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1617		1926
1618	glEnable GL_BLEND;	1927	my $tex = $self->{state} ? $tex[1] : $tex[0];
		1928
1619	glEnable GL_TEXTURE_2D;	1929	glEnable GL_TEXTURE_2D;
1620	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1621
1622	my $tex = $self->{state} ? $tex[1] : $tex[0];
1623
1624	$tex->draw_quad (0, 0, $s, $s);	1930	$tex->draw_quad_alpha (0, 0, $s, $s);
1625
1626	glDisable GL_TEXTURE_2D;	1931	glDisable GL_TEXTURE_2D;
1627	glDisable GL_BLEND;
1628	}	1932	}
1629		1933
1630	#############################################################################	1934	#############################################################################
1631		1935
1632	package CFClient::UI::Image;	1936	package CFClient::UI::Image;
…		…
1675	glTranslate 0, -$self->{w}, 0;	1979	glTranslate 0, -$self->{w}, 0;
1676		1980
1677	($w, $h) = ($h, $w);	1981	($w, $h) = ($h, $w);
1678	}	1982	}
1679		1983
1680	glEnable GL_BLEND;
1681	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1682	glEnable GL_TEXTURE_2D;	1984	glEnable GL_TEXTURE_2D;
1683	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1985	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1684		1986
1685	$tex->draw_quad (0, 0, $w, $h);	1987	$tex->draw_quad_alpha (0, 0, $w, $h);
1686		1988
1687	glDisable GL_BLEND;
1688	glDisable GL_TEXTURE_2D;	1989	glDisable GL_TEXTURE_2D;
1689	}	1990	}
1690		1991
1691	#############################################################################	1992	#############################################################################
1692		1993
…		…
1740	}	2041	}
1741		2042
1742	sub set_max {	2043	sub set_max {
1743	my ($self, $max) = @_;	2044	my ($self, $max) = @_;
1744		2045
		2046	return if $self->{max_val} == $max;
		2047
1745	$self->{max_val} = $max;	2048	$self->{max_val} = $max;
		2049	$self->update;
1746	}	2050	}
1747		2051
1748	sub set_value {	2052	sub set_value {
1749	my ($self, $val, $max) = @_;	2053	my ($self, $val, $max) = @_;
1750		2054
1751	$self->set_max ($max)	2055	$self->set_max ($max)
1752	if defined $max;	2056	if defined $max;
1753		2057
1754	$max = $self->{max_val};	2058	return if $self->{val} == $val;
		2059
1755	$self->{val} = $val;	2060	$self->{val} = $val;
1756
1757	$self->update;	2061	$self->update;
1758	}	2062	}
1759		2063
1760	sub _draw {	2064	sub _draw {
1761	my ($self) = @_;	2065	my ($self) = @_;
…		…
1824		2128
1825	sub new {	2129	sub new {
1826	my ($class, %arg) = @_;	2130	my ($class, %arg) = @_;
1827		2131
1828	my $self = $class->SUPER::new (	2132	my $self = $class->SUPER::new (
1829	tooltip => $arg{type},	2133	tooltip => $arg{type},
1830	can_hover => 1,	2134	can_hover => 1,
		2135	can_events => 1,
1831	%arg,	2136	%arg,
1832	);	2137	);
1833		2138
1834	$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");
1835	$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);
…		…
1843		2148
1844	$self->{value}->set_fontsize ($fsize);	2149	$self->{value}->set_fontsize ($fsize);
1845	$self->{max} ->set_fontsize ($fsize);	2150	$self->{max} ->set_fontsize ($fsize);
1846	}	2151	}
1847		2152
		2153	sub set_max {
		2154	my ($self, $max) = @_;
		2155
		2156	$self->{gauge}->set_max ($max);
		2157	$self->{max}->set_text ($max);
		2158	}
		2159
1848	sub set_value {	2160	sub set_value {
1849	my ($self, $val, $max) = @_;	2161	my ($self, $val, $max) = @_;
1850		2162
1851	$self->set_max ($max)	2163	$self->set_max ($max)
1852	if defined $max;	2164	if defined $max;
1853		2165
1854	$self->{gauge}->set_value ($val, $max);	2166	$self->{gauge}->set_value ($val, $max);
1855	$self->{value}->set_text ($val);	2167	$self->{value}->set_text ($val);
1856	}
1857
1858	sub set_max {
1859	my ($self, $max) = @_;
1860
1861	$self->{gauge}->set_max ($max);
1862	$self->{max}->set_text ($max);
1863	}	2168	}
1864		2169
1865	#############################################################################	2170	#############################################################################
1866		2171
1867	package CFClient::UI::Slider;	2172	package CFClient::UI::Slider;
…		…
1877	qw(s1_slider.png s1_slider_bg.png);	2182	qw(s1_slider.png s1_slider_bg.png);
1878		2183
1879	sub new {	2184	sub new {
1880	my $class = shift;	2185	my $class = shift;
1881		2186
1882	# range [value, low, high, page]	2187	# range [value, low, high, page, unit]
1883		2188
1884	# TODO: 0-width page	2189	# TODO: 0-width page
1885	# TODO: req_w/h are wrong with vertical	2190	# TODO: req_w/h are wrong with vertical
1886	# TODO: calculations are off	2191	# TODO: calculations are off
1887	my $self = $class->SUPER::new (	2192	my $self = $class->SUPER::new (
1888	fg => [1, 1, 1],	2193	fg => [1, 1, 1],
1889	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],
1890	range => [0, 0, 100, 10],	2197	range => [0, 0, 100, 10, 0],
1891	req_w => 20,	2198	min_w => $::WIDTH / 80,
1892	req_h => 20,	2199	min_h => $::WIDTH / 80,
1893	vertical => 0,	2200	vertical => 0,
1894	can_hover => 1,	2201	can_hover => 1,
1895	inner_pad => 5,	2202	inner_pad => 0.02,
1896	@_	2203	@_
1897	);	2204	);
1898		2205
		2206	$self->set_value ($self->{range}[0]);
		2207	$self->update;
		2208
1899	$self	2209	$self
1900	}	2210	}
1901		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
1902	sub size_request {	2246	sub size_request {
1903	my ($self) = @_;	2247	my ($self) = @_;
1904		2248
1905	my $w = $self->{req_w};	2249	($self->{req_w}, $self->{req_h})
1906	my $h = $self->{req_h};
1907
1908	$self->{vertical} ? ($h, $w) : ($w, $h)
1909	}	2250	}
1910		2251
1911	sub button_down {	2252	sub button_down {
1912	my ($self, $ev, $x, $y) = @_;	2253	my ($self, $ev, $x, $y) = @_;
1913		2254
1914	$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
1915	$self->mouse_motion ($ev, $x, $y);	2259	$self->mouse_motion ($ev, $x, $y);
1916	}	2260	}
1917		2261
1918	sub mouse_motion {	2262	sub mouse_motion {
1919	my ($self, $ev, $x, $y) = @_;	2263	my ($self, $ev, $x, $y) = @_;
1920		2264
1921	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
1922	my ($value, $lo, $hi, $page) = @{$self->{range}};	2282	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2283	my $range = ($hi - $page - $lo) || 1e-100;
1923		2284
1924	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2285	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
1925		2286
1926	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2287	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
1927	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right	2288	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
1928		2289
1929	$x -= $inner_pad_px; # substract the padding	2290	$value = ($value - $lo) / $range;
1930	$x = $x * ($hi - $lo) / $inner_w + $lo;	2291	$value = $value * $self->{scale} + $self->{offset};
1931	$x = $lo if $x < $lo;
1932	$x = $hi - $page if $x > $hi - $page;
1933	$self->{range}[0] = $x;
1934		2292
1935	$self->emit (changed => $x);	2293	$self->{knob_x} = $value - $knob_w * 0.5;
1936	$self->update;	2294	$self->{knob_w} = $knob_w;
1937	}	2295	});
1938	}
1939		2296
1940	# the inner_* stuff is for generating a padding for the slider handle,	2297	$self->SUPER::update;
1941	# so that the handle doesn't leave the texture. This calculation isn't 100%
1942	# correct propably, but it does the job for now
1943	sub _calc_inner_pad_px {
1944	my ($self, $w) = @_;
1945	($w / 100) * $self->{inner_pad} # % to pixels
1946	}	2298	}
1947		2299
1948	sub _draw {	2300	sub _draw {
1949	my ($self) = @_;	2301	my ($self) = @_;
1950		2302
1951	$self->SUPER::_draw ();	2303	$self->SUPER::_draw ();
1952		2304
1953	my ($w, $h) = @$self{qw(w h)};	2305	glScale $self->{w}, $self->{h};
1954		2306
1955	if ($self->{vertical}) {	2307	if ($self->{vertical}) {
1956	# draw a vertical slider like a rotated horizontal slider	2308	# draw a vertical slider like a rotated horizontal slider
1957		2309
		2310	glTranslate 1, 0, 0;
1958	glRotate 90, 0, 0, 1;	2311	glRotate 90, 0, 0, 1;
1959	glTranslate 0, -$self->{w}, 0;
1960
1961	($w, $h) = ($h, $w);
1962	}	2312	}
1963		2313
1964	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2314	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
1965	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2315	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
1966		2316
1967	my ($value, $lo, $hi, $page) = @{$self->{range}};
1968
1969	$hi = $value + 1 if $lo == $hi;
1970
1971	my $inner_pad_px = $self->_calc_inner_pad_px ($w);
1972	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
1973
1974	$page = int $page * $inner_w / ($hi - $lo);
1975	$value = int +($value - $lo) * $inner_w / ($hi - $lo);
1976
1977	$w -= $page;
1978	$page &= ~1;
1979	glTranslate $page * 0.5, 0, 0;
1980	$page ||= 2;
1981
1982	my $knob_a = $inner_pad_px + ($value - $page * 0.5);
1983	my $knob_b = $inner_pad_px + ($value + $page * 0.5);
1984
1985	glEnable GL_BLEND;
1986	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1987	glEnable GL_TEXTURE_2D;	2317	glEnable GL_TEXTURE_2D;
1988	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2318	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1989		2319
1990	# draw background	2320	# draw background
1991	$tex[1]->draw_quad (0, 0, $w, $h);	2321	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
1992		2322
1993	# draw handle	2323	# draw handle
1994	$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);
1995		2325
1996	glDisable GL_BLEND;
1997	glDisable GL_TEXTURE_2D;	2326	glDisable GL_TEXTURE_2D;
1998	}	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 (@_) }
1999		2369
2000	#############################################################################	2370	#############################################################################
2001		2371
2002	package CFClient::UI::TextView;	2372	package CFClient::UI::TextView;
2003		2373
…		…
2012	fontsize => 1,	2382	fontsize => 1,
2013	can_events => 0,	2383	can_events => 0,
2014	#font => default_font	2384	#font => default_font
2015	@_,	2385	@_,
2016		2386
2017	layout => (new CFClient::Layout),	2387	layout => (new CFClient::Layout 1),
2018	par => [],	2388	par => [],
2019	height => 0,	2389	height => 0,
2020	children => [	2390	children => [
2021	(new CFClient::UI::Empty expand => 1),	2391	(new CFClient::UI::Empty expand => 1),
2022	(new CFClient::UI::Slider vertical => 1),	2392	(new CFClient::UI::Slider vertical => 1),
2023	],	2393	],
2024	);	2394	);
2025		2395
2026	$self->{children}[1]->connect (changed => sub {	2396	$self->{children}[1]->connect (changed => sub { $self->update });
2027	$self->update;
2028	});
2029		2397
2030	$self	2398	$self
2031	}	2399	}
2032		2400
2033	sub set_fontsize {	2401	sub set_fontsize {
2034	my ($self, $fontsize) = @_;	2402	my ($self, $fontsize) = @_;
2035		2403
2036	$self->{fontsize} = $fontsize;	2404	$self->{fontsize} = $fontsize;
2037	$self->reflow;	2405	$self->reflow;
2038	}
2039
2040	sub text_height {
2041	my ($self, $text) = @_;
2042
2043	my $layout = $self->{layout};
2044
2045	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2046	$layout->set_width ($self->{w});
2047	$layout->set_text ($text);
2048
2049	($layout->size)[1]
2050	}
2051
2052	sub reflow {
2053	my ($self) = @_;
2054
2055	$self->{need_reflow}++;
2056	$self->update;
2057	}	2406	}
2058		2407
2059	sub size_allocate {	2408	sub size_allocate {
2060	my ($self, $w, $h) = @_;	2409	my ($self, $w, $h) = @_;
2061		2410
…		…
2066	$self->{layout}->set_width ($self->{children}[0]{w});	2415	$self->{layout}->set_width ($self->{children}[0]{w});
2067		2416
2068	$self->reflow;	2417	$self->reflow;
2069	}	2418	}
2070		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
2071	sub add_paragraph {	2454	sub add_paragraph {
2072	my ($self, $color, $text) = @_;	2455	my ($self, $color, $text, $indent) = @_;
2073		2456
2074	#TODO: intelligently "reformat" paragraph	2457	for my $line (split /\n/, $text) {
2075		2458	my ($w, $h) = $self->text_size ($line);
2076	my $height = $self->text_height ($text);
2077
2078	$self->{height} += $height;	2459	$self->{height} += $h;
		2460	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
		2461	}
2079		2462
2080	push @{$self->{par}}, [$height, $color, $text];
2081
2082	$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]);
2083	$self->{children}[1]->update;
2084	}	2464	}
2085		2465
2086	sub update {	2466	sub update {
2087	my ($self) = @_;	2467	my ($self) = @_;
2088		2468
…		…
2090		2470
2091	return unless $self->{h} > 0;	2471	return unless $self->{h} > 0;
2092		2472
2093	delete $self->{texture};	2473	delete $self->{texture};
2094		2474
2095	$ROOT->on_refresh ($self, sub {	2475	$ROOT->on_post_alloc ($self, sub {
		2476	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2477
2096	if (delete $self->{need_reflow}) {	2478	if (delete $self->{need_reflow}) {
2097	my $height = 0;	2479	my $height = 0;
2098		2480
2099	$height += $_->[0] = $self->text_height ($_->[2])	2481	my $layout = $self->{layout};
		2482
		2483	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2484
2100	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	}
2101		2496
2102	$self->{height} = $height;	2497	$self->{height} = $height;
2103		2498
2104	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2499	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2105		2500
2106	delete $self->{texture};	2501	delete $self->{texture};
2107	}	2502	}
2108		2503
2109	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	2504	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2110	glClearColor 0, 0, 0, 1;	2505	glClearColor 0.5, 0.5, 0.5, 0;
2111	glClear GL_COLOR_BUFFER_BIT;	2506	glClear GL_COLOR_BUFFER_BIT;
2112		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
2113	glEnable GL_BLEND;	2519	glEnable GL_BLEND;
		2520	#TODO# not correct in windows where rgba is forced off
2114	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2521	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2115	glEnable GL_TEXTURE_2D;
2116	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2117
2118	my $top = int $self->{children}[1]{range}[0];
2119
2120	my $y0 = $top;
2121	my $y1 = $top + $self->{h};
2122
2123	my $y = 0;
2124
2125	my $layout = $self->{layout};
2126
2127	$layout->set_font ($self->{font}) if $self->{font};
2128		2522
2129	for my $par (@{$self->{par}}) {	2523	for my $par (@{$self->{par}}) {
2130	my $h = $par->[0];	2524	my $h = $par->[1];
2131		2525
2132	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]);
2133	$layout->set_text ($par->[2]);	2529	$layout->set_markup ($par->[4]);
2134		2530
2135	glColor @{ $par->[1] };	2531	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2136	my ($W, $H) = $layout->size;	2532
2137	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;
2138	}	2535	}
2139		2536
2140	$y += $h;	2537	$y += $h;
2141	}	2538	}
2142		2539
2143	glDisable GL_TEXTURE_2D;
2144	glDisable GL_BLEND;	2540	glDisable GL_BLEND;
2145	};	2541	};
2146	});	2542	});
2147	}	2543	}
2148		2544
2149	sub _draw {	2545	sub _draw {
2150	my ($self) = @_;	2546	my ($self) = @_;
2151		2547
2152	if ($self->{texture}) {
2153	glEnable GL_TEXTURE_2D;	2548	glEnable GL_TEXTURE_2D;
2154	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;
2155	$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});
2156	glDisable GL_TEXTURE_2D;	2552	glDisable GL_TEXTURE_2D;
2157	}
2158		2553
2159	$self->{children}[1]->draw;	2554	$self->{children}[1]->draw;
2160		2555
2161	}	2556	}
2162		2557
…		…
2210		2605
2211	sub new {	2606	sub new {
2212	my $class = shift;	2607	my $class = shift;
2213		2608
2214	my $self = $class->SUPER::new (	2609	my $self = $class->SUPER::new (
2215	state => 0,	2610	state => 0,
2216	connect_activate => \&toggle_flopper,	2611	on_activate => \&toggle_flopper,
2217	@_	2612	@_
2218	);	2613	);
2219		2614
2220	if ($self->{state}) {
2221	$self->{state} = 0;
2222	$self->toggle_flopper;
2223	}
2224
2225	$self	2615	$self
2226	}	2616	}
2227		2617
2228	sub toggle_flopper {	2618	sub toggle_flopper {
2229	my ($self) = @_;	2619	my ($self) = @_;
2230		2620
2231	# TODO: use animation	2621	$self->{other}->toggle_visibility;
2232	if ($self->{state} = !$self->{state}) {
2233	$CFClient::UI::ROOT->add ($self->{other});
2234	$self->{other}->move ($self->coord2global (0, $self->{h}));
2235	$self->emit ("open");
2236	} else {
2237	$CFClient::UI::ROOT->remove ($self->{other});
2238	$self->emit ("close");
2239	}
2240
2241	$self->emit (changed => $self->{state});
2242	}	2622	}
2243		2623
2244	#############################################################################	2624	#############################################################################
2245		2625
2246	package CFClient::UI::Tooltip;	2626	package CFClient::UI::Tooltip;
…		…
2256	@_,	2636	@_,
2257	can_events => 0,	2637	can_events => 0,
2258	)	2638	)
2259	}	2639	}
2260		2640
2261	sub set_markup {	2641	sub set_tooltip_from {
2262	my ($self, $text) = @_;	2642	my ($self, $widget) = @_;
2263		2643
2264	$self->{label} ||= new CFClient::UI::Label fontsize => 0.8, fg => [0, 0, 0];	2644	my $tooltip = $widget->{tooltip};
2265	$self->{label}->set_markup ($text);	2645
2266	$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	);
2267	}	2661	}
2268		2662
2269	sub size_request {	2663	sub size_request {
2270	my ($self) = @_;	2664	my ($self) = @_;
2271
2272	$self->child->set_max_size ($::WIDTH * 0.3);
2273		2665
2274	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2666	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2275		2667
2276	($w + 4, $h + 4)	2668	($w + 4, $h + 4)
2277	}	2669	}
…		…
2280	my ($self, $w, $h) = @_;	2672	my ($self, $w, $h) = @_;
2281		2673
2282	$self->SUPER::size_allocate ($w - 4, $h - 4);	2674	$self->SUPER::size_allocate ($w - 4, $h - 4);
2283	}	2675	}
2284		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
2285	sub _draw {	2695	sub _draw {
2286	my ($self) = @_;	2696	my ($self) = @_;
2287		2697
2288	glPushMatrix;
2289	glTranslate 0.375, 0.375;	2698	glTranslate 0.375, 0.375;
2290		2699
2291	my ($w, $h) = @$self{qw(w h)};	2700	my ($w, $h) = @$self{qw(w h)};
2292		2701
2293	glColor 1, 0.8, 0.4;	2702	glColor 1, 0.8, 0.4;
…		…
2304	glVertex 0 , $h;	2713	glVertex 0 , $h;
2305	glVertex $w, $h;	2714	glVertex $w, $h;
2306	glVertex $w, 0;	2715	glVertex $w, 0;
2307	glEnd;	2716	glEnd;
2308		2717
2309	glPopMatrix;	2718	glTranslate 2 - 0.375, 2 - 0.375;
2310		2719
2311	glTranslate 2, 2;
2312	$self->SUPER::_draw;	2720	$self->SUPER::_draw;
2313	}	2721	}
2314		2722
2315	#############################################################################	2723	#############################################################################
2316		2724
…		…
2321	use CFClient::OpenGL;	2729	use CFClient::OpenGL;
2322		2730
2323	sub new {	2731	sub new {
2324	my $class = shift;	2732	my $class = shift;
2325		2733
2326	$class->SUPER::new (	2734	my $self = $class->SUPER::new (
2327	aspect => 1,	2735	aspect => 1,
		2736	can_events => 0,
2328	@_,	2737	@_,
2329	)	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
2330	}	2755	}
2331		2756
2332	sub size_request {	2757	sub size_request {
2333	(32, 8)	2758	(32, 8)
2334	}	2759	}
2335		2760
		2761	sub update {
		2762	my ($self) = @_;
		2763
		2764	return unless $self->{visible};
		2765
		2766	$self->SUPER::update;
		2767	}
		2768
2336	sub draw {	2769	sub _draw {
2337	my ($self) = @_;	2770	my ($self) = @_;
2338		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
2339	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	2783	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2340		2784
2341	if ($tex) {	2785	if ($tex) {
2342	glEnable GL_BLEND;
2343	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2344	glEnable GL_TEXTURE_2D;	2786	glEnable GL_TEXTURE_2D;
2345	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2787	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2346	glColor 1, 1, 1, 1;	2788	glColor 1, 1, 1, 1;
2347	$tex->draw_quad (0, 0, $self->{w}, $self->{h});	2789	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2348	glDisable GL_TEXTURE_2D;	2790	glDisable GL_TEXTURE_2D;
2349	glDisable GL_BLEND;
2350	}	2791	}
		2792	}
		2793
		2794	sub DESTROY {
		2795	my ($self) = @_;
		2796
		2797	$self->{timer}->cancel
		2798	if $self->{timer};
		2799
		2800	$self->SUPER::DESTROY;
2351	}	2801	}
2352		2802
2353	#############################################################################	2803	#############################################################################
2354		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
2355	package CFClient::UI::Root;	3278	package CFClient::UI::Root;
2356		3279
2357	our @ISA = CFClient::UI::Container::;	3280	our @ISA = CFClient::UI::Container::;
2358		3281
2359	use CFClient::OpenGL;	3282	use CFClient::OpenGL;
2360		3283
2361	sub check_size {	3284	sub new {
2362	my ($self) = @_;	3285	my $class = shift;
2363		3286
2364	$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
2365	}	3295	}
2366		3296
2367	sub size_request {	3297	sub size_request {
2368	($::WIDTH, $::HEIGHT)	3298	my ($self) = @_;
2369	}
2370		3299
2371	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 {
2372	my ($self, $x, $y, $w, $h) = @_;	3318	my ($self, $w, $h) = @_;
2373		3319
2374	$self->SUPER::configure ($x, $y, $w, $h);
2375
2376	for my $child (@{$self->{children}}) {	3320	for my $child ($self->children) {
2377	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)};
2378		3322
2379	$X = List::Util::max 0, List::Util::min $w - $W, $X;	3323	$X = $child->{force_x} if exists $child->{force_x};
2380	$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
2381	$child->configure ($X, $Y, $W,$H);	3329	$child->configure ($X, $Y, $W, $H);
2382	}	3330	}
2383	}	3331	}
2384		3332
2385	sub _topleft {	3333	sub coord2local {
2386	my ($self, $x, $y) = @_;	3334	my ($self, $x, $y) = @_;
2387		3335
2388	($x, $y)	3336	($x, $y)
2389	}	3337	}
2390		3338
		3339	sub coord2global {
		3340	my ($self, $x, $y) = @_;
		3341
		3342	($x, $y)
		3343	}
		3344
2391	sub update {	3345	sub update {
2392	my ($self) = @_;	3346	my ($self) = @_;
2393		3347
2394	$self->check_size;	3348	$::WANT_REFRESH++;
2395	::refresh ();
2396	}	3349	}
2397		3350
2398	sub add {	3351	sub add {
2399	my ($self, $child) = @_;	3352	my ($self, @children) = @_;
2400		3353
2401	# integerize window positions	3354	$_->{is_toplevel} = 1
2402	$child->{x} = int $child->{x};	3355	for @children;
2403	$child->{y} = int $child->{y};
2404		3356
2405	$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	}
2406	}	3373	}
2407		3374
2408	sub on_refresh {	3375	sub on_refresh {
2409	my ($self, $id, $cb) = @_;	3376	my ($self, $id, $cb) = @_;
2410		3377
2411	$self->{refresh_hook}{$id} = $cb;	3378	$self->{refresh_hook}{$id} = $cb;
2412	}	3379	}
2413		3380
		3381	sub on_post_alloc {
		3382	my ($self, $id, $cb) = @_;
		3383
		3384	$self->{post_alloc_hook}{$id} = $cb;
		3385	}
		3386
2414	sub draw {	3387	sub draw {
2415	my ($self) = @_;	3388	my ($self) = @_;
2416		3389
2417	while (my $rcb = delete $self->{refresh_hook}) {	3390	while ($self->{refresh_hook}) {
2418	$_->() for values %$rcb;	3391	$_->()
		3392	for values %{delete $self->{refresh_hook}};
2419	}	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
2420		3483
2421	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3484	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2422	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3485	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2423	glClear GL_COLOR_BUFFER_BIT;	3486	glClear GL_COLOR_BUFFER_BIT;
2424		3487
2425	glMatrixMode GL_PROJECTION;	3488	glMatrixMode GL_PROJECTION;
2426	glLoadIdentity;	3489	glLoadIdentity;
2427	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;	3490	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2428	glMatrixMode GL_MODELVIEW;	3491	glMatrixMode GL_MODELVIEW;
2429	glLoadIdentity;	3492	glLoadIdentity;
2430		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
2431	$self->_draw;	3501	$self->_draw;
2432	}	3502	}
2433		3503
2434	#############################################################################	3504	#############################################################################
2435		3505
2436	package CFClient::UI;	3506	package CFClient::UI;
2437		3507
2438	$ROOT = new CFClient::UI::Root;	3508	$ROOT = new CFClient::UI::Root;
2439	$TOOLTIP = new CFClient::UI::Tooltip;	3509	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2440		3510
2441	1	3511	1
2442		3512

Diff Legend

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