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.175 by root, Tue Apr 25 11:48:31 2006 UTC vs.
Revision 1.267 by root, Thu Jun 1 04:10:29 2006 UTC

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

Diff Legend

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