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.174 by root, Tue Apr 25 11:18:49 2006 UTC vs.
Revision 1.268 by root, Thu Jun 1 05:04:41 2006 UTC

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

Diff Legend

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