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

Diff Legend

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