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.173 by root, Tue Apr 25 10:30:48 2006 UTC vs.
Revision 1.272 by root, Sat Jun 3 01:47:14 2006 UTC

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

Diff Legend

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