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.179 by elmex, Fri Apr 28 05:17:21 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
30	$TOOLTIP->show;	60	$TOOLTIP->show;
31
32	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
33
34	if ($x + $TOOLTIP->{w} > $::WIDTH) {
35	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0);
36	}
37
38	$TOOLTIP->move ($x, $y);
39	}	61	}
40		62
41	return;	63	return;
42	}	64	}
43	}	65	}
…		…
47	delete $TOOLTIP->{owner};	69	delete $TOOLTIP->{owner};
48	}	70	}
49		71
50	# class methods for events	72	# class methods for events
51	sub feed_sdl_key_down_event {	73	sub feed_sdl_key_down_event {
52	$FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0])	74	$FOCUS->emit (key_down => $_[0])
53	if $FOCUS;	75	if $FOCUS;
54	}	76	}
55		77
56	sub feed_sdl_key_up_event {	78	sub feed_sdl_key_up_event {
57	$FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0])	79	$FOCUS->emit (key_up => $_[0])
58	if $FOCUS;	80	if $FOCUS;
59	}	81	}
60		82
61	sub feed_sdl_button_down_event {	83	sub feed_sdl_button_down_event {
62	my ($ev) = @_;	84	my ($ev) = @_;
…		…
71	check_tooltip;	93	check_tooltip;
72	}	94	}
73		95
74	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	96	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
75		97
76	if ($GRAB) {	98	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
77	($x, $y) = $GRAB->coord2local ($x, $y);	99	if $GRAB;
78	$GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
79	}
80	}	100	}
81		101
82	sub feed_sdl_button_up_event {	102	sub feed_sdl_button_up_event {
83	my ($ev) = @_;	103	my ($ev) = @_;
84	my ($x, $y) = ($ev->{x}, $ev->{y});	104	my ($x, $y) = ($ev->{x}, $ev->{y});
85		105
86	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	106	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
87		107
88	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	108	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
89		109
90	if ($GRAB) {	110	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
91	($x, $y) = $GRAB->coord2local ($x, $y);	111	if $GRAB;
92	$GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
93	}
94		112
95	if (!$BUTTON_STATE) {	113	if (!$BUTTON_STATE) {
96	my $grab = $GRAB; undef $GRAB;	114	my $grab = $GRAB; undef $GRAB;
97	$grab->update if $grab;	115	$grab->update if $grab;
98	$GRAB->update if $GRAB;	116	$GRAB->update if $GRAB;
…		…
114	$HOVER->update if $HOVER && $HOVER->{can_hover};	132	$HOVER->update if $HOVER && $HOVER->{can_hover};
115		133
116	check_tooltip;	134	check_tooltip;
117	}	135	}
118		136
119	if ($HOVER) {
120	($x, $y) = $HOVER->coord2local ($x, $y);
121	$HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y);	137	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
122	}	138	if $HOVER;
123	}	139	}
124		140
125	# convert position array to integers	141	# convert position array to integers
126	sub harmonize {	142	sub harmonize {
127	my ($vals) = @_;	143	my ($vals) = @_;
…		…
133	$rem += $_ - $i;	149	$rem += $_ - $i;
134	$_ = $i;	150	$_ = $i;
135	}	151	}
136	}	152	}
137		153
		154	sub full_refresh {
		155	# make a copy, otherwise for complains about freed values.
		156	my @widgets = values %WIDGET;
		157
		158	$_->update
		159	for @widgets;
		160	}
		161
		162	sub reconfigure_widgets {
		163	# make a copy, otherwise C<for> complains about freed values.
		164	my @widgets = values %WIDGET;
		165
		166	$_->reconfigure
		167	for @widgets;
		168	}
		169
		170	# call when resolution changes etc.
		171	sub rescale_widgets {
		172	my ($sx, $sy) = @_;
		173
		174	for my $widget (values %WIDGET) {
		175	if ($widget->{is_toplevel}) {
		176	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		177	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		178
		179	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
		180	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
		181	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
		182	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
		183	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
		184	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
		185
		186	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		187	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		188
		189	}
		190	}
		191
		192	reconfigure_widgets;
		193	}
		194
138	#############################################################################	195	#############################################################################
139		196
140	package CFClient::UI::Base;	197	package CFClient::UI::Base;
141		198
142	use strict;	199	use strict;
…		…
145		202
146	sub new {	203	sub new {
147	my $class = shift;	204	my $class = shift;
148		205
149	my $self = bless {	206	my $self = bless {
150	x => 0,	207	x => "center",
151	y => 0,	208	y => "center",
152	z => 0,	209	z => 0,
		210	w => undef,
		211	h => undef,
153	can_events => 1,	212	can_events => 1,
154	@_	213	@_
155	}, $class;	214	}, $class;
156		215
		216	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		217
157	for (keys %$self) {	218	for (keys %$self) {
158	if (/^connect_(.*)$/) {	219	if (/^on_(.*)$/) {
159	$self->connect ($1 => delete $self->{$_});	220	$self->connect ($1 => delete $self->{$_});
160	}	221	}
161	}	222	}
162		223
		224	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		225	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		226	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		227	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		228	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		229
		230	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		231	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		232
		233	$self->show if $layout->{show};
		234	}
		235
163	$self	236	$self
164	}	237	}
165		238
166	sub destroy {	239	sub destroy {
167	my ($self) = @_;	240	my ($self) = @_;
…		…
176	return if $self->{parent};	249	return if $self->{parent};
177		250
178	$CFClient::UI::ROOT->add ($self);	251	$CFClient::UI::ROOT->add ($self);
179	}	252	}
180		253
181	sub hide {	254	sub set_visible {
182	my ($self) = @_;	255	my ($self) = @_;
		256
		257	return if $self->{visible};
		258
		259	$self->{root} = $self->{parent}{root};
		260	$self->{visible} = $self->{parent}{visible} + 1;
		261
		262	$self->emit (visibility_change => 1);
		263
		264	$self->realloc if !exists $self->{req_w};
		265
		266	$_->set_visible for $self->children;
		267	}
		268
		269	sub set_invisible {
		270	my ($self) = @_;
		271
		272	return unless $self->{visible};
		273
		274	$_->set_invisible for $self->children;
		275
		276	delete $self->{root};
		277	delete $self->{visible};
183		278
184	undef $GRAB if $GRAB == $self;	279	undef $GRAB if $GRAB == $self;
185	undef $HOVER if $HOVER == $self;	280	undef $HOVER if $HOVER == $self;
186		281
		282	CFClient::UI::check_tooltip
		283	if $TOOLTIP->{owner} == $self;
		284
		285	$self->focus_out;
		286
		287	$self->emit (visibility_change => 0);
		288	}
		289
		290	sub set_visibility {
		291	my ($self, $visible) = @_;
		292
		293	return if $self->{visible} == $visible;
		294
		295	$visible ? $self->hide
		296	: $self->show;
		297	}
		298
		299	sub toggle_visibility {
		300	my ($self) = @_;
		301
		302	$self->{visible}
		303	? $self->hide
		304	: $self->show;
		305	}
		306
		307	sub hide {
		308	my ($self) = @_;
		309
		310	$self->set_invisible;
		311
187	$self->{parent}->remove ($self)	312	$self->{parent}->remove ($self)
188	if $self->{parent};	313	if $self->{parent};
189	}	314	}
190		315
191	sub move {	316	sub move_abs {
192	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
193		318
194	$self->{x} = int $x;	319	$self->{x} = List::Util::max 0, int $x;
195	$self->{y} = int $y;	320	$self->{y} = List::Util::max 0, int $y;
196	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
197		322
198	$self->update;	323	$self->update;
199	}	324	}
200		325
201	sub set_size {	326	sub set_size {
202	my ($self, $w, $h) = @_;	327	my ($self, $w, $h) = @_;
203		328
204	$self->{user_w} = $w;	329	$self->{force_w} = $w;
205	$self->{user_h} = $h;	330	$self->{force_h} = $h;
206		331
207	$self->check_size;	332	$self->realloc;
208	}	333	}
209		334
210	sub size_request {	335	sub size_request {
211	require Carp;	336	require Carp;
212	Carp::confess "size_request is abstract";	337	Carp::confess "size_request is abstract";
…		…
214		339
215	sub configure {	340	sub configure {
216	my ($self, $x, $y, $w, $h) = @_;	341	my ($self, $x, $y, $w, $h) = @_;
217		342
218	if ($self->{aspect}) {	343	if ($self->{aspect}) {
		344	my ($ow, $oh) = ($w, $h);
		345
219	my $w2 = List::Util::min $w, int $h * $self->{aspect};	346	$w = List::Util::min $w, int $h * $self->{aspect};
220	my $h2 = List::Util::min $h, int $w / $self->{aspect};	347	$h = List::Util::min $h, int $w / $self->{aspect};
221		348
222	# use alignment to adjust x, y	349	# use alignment to adjust x, y
223		350
224	$x += int +($w - $w2) * 0.5;	351	$x += int 0.5 * ($ow - $w);
225	$y += int +($h - $h2) * 0.5;	352	$y += int 0.5 * ($oh - $h);
226
227	($w, $h) = ($w2, $h2);
228	}	353	}
229		354
230	if ($self->{x} != $x || $self->{y} != $y) {	355	if ($self->{x} ne $x || $self->{y} ne $y) {
231	$self->{x} = $x;	356	$self->{x} = $x;
232	$self->{y} = $y;	357	$self->{y} = $y;
233	$self->update;	358	$self->update;
234	}	359	}
235		360
236	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
		362	return unless $self->{visible};
		363
237	$self->{w} = $w;	364	$self->{alloc_w} = $w;
238	$self->{h} = $h;	365	$self->{alloc_h} = $h;
239		366
240	$self->size_allocate ($w, $h);	367	$self->{root}{size_alloc}{$self+0} = $self;
241	$self->update;
242	}	368	}
243	}	369	}
244		370
245	sub size_allocate {	371	sub size_allocate {
246	# nothing to be done	372	# nothing to be done
247	}	373	}
248		374
249	sub children {	375	sub children {
		376	# nop
250	}	377	}
251		378
252	# call when resoltuion changes etc.	379	sub visible_children {
253	sub reconfigure {	380	$_[0]->children
254	my ($self) = @_;
255
256	$_->reconfigure
257	for $self->children;
258
259	$_->check_size;
260	}	381	}
261		382
262	sub set_max_size {	383	sub set_max_size {
263	my ($self, $w, $h) = @_;	384	my ($self, $w, $h) = @_;
264		385
265	delete $self->{max_w}; $self->{max_w} = $w if $w;	386	delete $self->{max_w}; $self->{max_w} = $w if $w;
266	delete $self->{max_h}; $self->{max_h} = $h if $h;	387	delete $self->{max_h}; $self->{max_h} = $h if $h;
267	}	388	}
268		389
269	# return top left coordinates	390	sub set_tooltip {
270	sub _topleft {
271	my ($self, $x, $y) = @_;	391	my ($self, $tooltip) = @_;
272		392
273	$self->{parent}	393	$tooltip =~ s/^\s+//;
274	or Carp::confess "no parent widget in _topleft\n";#d#	394	$tooltip =~ s/\s+$//;
275		395
276	$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	}
277	}	404	}
278		405
279	# translate global coordinates to local coordinate system	406	# translate global coordinates to local coordinate system
280	sub coord2local {	407	sub coord2local {
281	my ($self, $x, $y) = @_;	408	my ($self, $x, $y) = @_;
282		409
283	my ($X, $Y) = $self->_topleft;	410	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
284	($x - $X, $y - $Y)
285	}	411	}
286		412
287	# translate local coordinates to global coordinate system	413	# translate local coordinates to global coordinate system
288	sub coord2global {	414	sub coord2global {
289	my ($self, $x, $y) = @_;	415	my ($self, $x, $y) = @_;
290		416
291	my ($X, $Y) = $self->_topleft;	417	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
292	($x + $X, $y + $Y)
293	}	418	}
294		419
295	sub focus_in {	420	sub focus_in {
296	my ($self) = @_;	421	my ($self) = @_;
297		422
298	return if $FOCUS == $self;	423	return if $FOCUS == $self;
299	return unless $self->{can_focus};	424	return unless $self->{can_focus};
300		425
301	my $focus = $FOCUS; $FOCUS = $self;	426	my $focus = $FOCUS; $FOCUS = $self;
302		427
303	$self->emit (focus_in => $focus);	428	$self->_emit (focus_in => $focus);
304		429
305	$focus->update if $focus;	430	$focus->update if $focus;
306	$FOCUS->update;	431	$FOCUS->update;
307	}	432	}
308		433
…		…
311		436
312	return unless $FOCUS == $self;	437	return unless $FOCUS == $self;
313		438
314	my $focus = $FOCUS; undef $FOCUS;	439	my $focus = $FOCUS; undef $FOCUS;
315		440
316	$self->emit (focus_out => $focus);	441	$self->_emit (focus_out => $focus);
317		442
318	$focus->update if $focus; #?	443	$focus->update if $focus; #?
319	}
320		444
		445	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		446	unless $FOCUS;
		447	}
		448
321	sub mouse_motion { }	449	sub mouse_motion { 0 }
322	sub button_up { }	450	sub button_up { 0 }
323	sub key_down { }	451	sub key_down { 0 }
324	sub key_up { }	452	sub key_up { 0 }
325		453
326	sub button_down {	454	sub button_down {
327	my ($self, $ev, $x, $y) = @_;	455	my ($self, $ev, $x, $y) = @_;
328		456
329	$self->focus_in;	457	$self->focus_in;
330	}
331		458
332	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	459	0
333	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	460	}
334	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	461
335	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	462	sub find_widget {
336	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
337		535
338	sub draw {	536	sub draw {
339	my ($self) = @_;	537	my ($self) = @_;
340		538
341	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);
342		550
343	glPushMatrix;	551	glPushMatrix;
344	glTranslate $self->{x}, $self->{y}, 0;	552	glTranslate $self->{x}, $self->{y}, 0;
345	$self->_draw;	553	$self->_draw;
346	glPopMatrix;	554	glPopMatrix;
…		…
358	glVertex $x , $y + $self->{h};	566	glVertex $x , $y + $self->{h};
359	glEnd;	567	glEnd;
360	glDisable GL_BLEND;	568	glDisable GL_BLEND;
361	}	569	}
362		570
363	if ($ENV{PCLIENT_DEBUG}) {	571	if ($ENV{CFPLUS_DEBUG} & 1) {
364	glPushMatrix;	572	glPushMatrix;
365	glColor 1, 1, 0, 1;	573	glColor 1, 1, 0, 1;
366	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	574	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
367	glBegin GL_LINE_LOOP;	575	glBegin GL_LINE_LOOP;
368	glVertex 0 , 0;	576	glVertex 0 , 0;
369	glVertex $self->{w}, 0;	577	glVertex $self->{w} - 1, 0;
370	glVertex $self->{w}, $self->{h};	578	glVertex $self->{w} - 1, $self->{h} - 1;
371	glVertex 0 , $self->{h};	579	glVertex 0 , $self->{h} - 1;
372	glEnd;	580	glEnd;
373	glPopMatrix;	581	glPopMatrix;
374	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;
375	}	583	}
376	}	584	}
377		585
378	sub _draw {	586	sub _draw {
379	my ($self) = @_;	587	my ($self) = @_;
380		588
381	warn "no draw defined for $self\n";	589	warn "no draw defined for $self\n";
382	}	590	}
383		591
384	sub find_widget {
385	my ($self, $x, $y) = @_;
386
387	return () unless $self->{can_events};
388
389	return $self
390	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
391	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
392
393	()
394	}
395
396	sub set_parent {
397	my ($self, $parent) = @_;
398
399	Scalar::Util::weaken ($self->{parent} = $parent);
400	}
401
402	sub check_size {
403	my ($self) = @_;
404
405	$self->{parent}
406	or return 1;
407
408	my ($w, $h) = $self->{user_w} && $self->{user_h}
409	? @$self{qw(user_w user_h)}
410	: $self->size_request;
411
412	if ($w != $self->{req_w} || $h != $self->{req_h}) {
413	$self->{req_w} = $w;
414	$self->{req_h} = $h;
415
416	$self->{parent}->check_size
417	or $self->size_allocate (
418	(List::Util::max $self->{w}, $w),
419	(List::Util::max $self->{h}, $h),
420	);
421
422	1
423	} else {
424	0
425	}
426	}
427
428	sub update {
429	my ($self) = @_;
430
431	$self->{parent}->update
432	if $self->{parent};
433	}
434
435	sub connect {
436	my ($self, $signal, $cb) = @_;
437
438	push @{ $self->{signal_cb}{$signal} }, $cb;
439	}
440
441	sub emit {
442	my ($self, $signal, @args) = @_;
443
444	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
445	}
446
447	sub DESTROY {	592	sub DESTROY {
448	my ($self) = @_;	593	my ($self) = @_;
449		594
		595	delete $WIDGET{$self+0};
450	#$self->deactivate;	596	#$self->deactivate;
451	}	597	}
452		598
453	#############################################################################	599	#############################################################################
454		600
…		…
463	my $class = shift;	609	my $class = shift;
464		610
465	# range [value, low, high, page]	611	# range [value, low, high, page]
466		612
467	$class->SUPER::new (	613	$class->SUPER::new (
468	bg => [0, 0, 0, 0.2],	614	#bg => [0, 0, 0, 0.2],
469	active_bg => [1, 1, 1, 0.5],	615	#active_bg => [1, 1, 1, 0.5],
470	@_	616	@_
471	)	617	)
472	}	618	}
473		619
474	sub _draw {	620	sub _draw {
475	my ($self) = @_;	621	my ($self) = @_;
476		622
		623	my $color = $FOCUS == $self && $self->{active_bg}
		624	? $self->{active_bg}
		625	: $self->{bg};
		626
		627	if ($color && (@$color < 4 || $color->[3])) {
477	my ($w, $h) = @$self{qw(w h)};	628	my ($w, $h) = @$self{qw(w h)};
478		629
479	glEnable GL_BLEND;	630	glEnable GL_BLEND;
480	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	631	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
481	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	632	glColor @$color;
482		633
483	glBegin GL_QUADS;	634	glBegin GL_QUADS;
484	glVertex 0 , 0;	635	glVertex 0 , 0;
485	glVertex 0 , $h;	636	glVertex 0 , $h;
486	glVertex $w, $h;	637	glVertex $w, $h;
487	glVertex $w, 0;	638	glVertex $w, 0;
488	glEnd;	639	glEnd;
489		640
490	glDisable GL_BLEND;	641	glDisable GL_BLEND;
		642	}
491	}	643	}
492		644
493	#############################################################################	645	#############################################################################
494		646
495	package CFClient::UI::Empty;	647	package CFClient::UI::Empty;
…		…
500	my ($class, %arg) = @_;	652	my ($class, %arg) = @_;
501	$class->SUPER::new (can_events => 0, %arg);	653	$class->SUPER::new (can_events => 0, %arg);
502	}	654	}
503		655
504	sub size_request {	656	sub size_request {
505	(0, 0)	657	my ($self) = @_;
		658
		659	($self->{w} + 0, $self->{h} + 0)
506	}	660	}
507		661
508	sub draw { }	662	sub draw { }
509		663
510	#############################################################################	664	#############################################################################
…		…
514	our @ISA = CFClient::UI::Base::;	668	our @ISA = CFClient::UI::Base::;
515		669
516	sub new {	670	sub new {
517	my ($class, %arg) = @_;	671	my ($class, %arg) = @_;
518		672
519	my $children = delete $arg{children} || [];	673	my $children = delete $arg{children};
520		674
521	my $self = $class->SUPER::new (	675	my $self = $class->SUPER::new (
522	children => [],	676	children => [],
523	can_events => 0,	677	can_events => 0,
524	%arg,	678	%arg,
525	);	679	);
		680
526	$self->add ($_) for @$children;	681	$self->add (@$children)
		682	if $children;
527		683
528	$self	684	$self
529	}	685	}
530		686
531	sub add {	687	sub add {
532	my ($self, $child) = @_;	688	my ($self, @widgets) = @_;
533		689
534	$child->set_parent ($self);	690	$_->set_parent ($self)
		691	for @widgets;
535		692
536	use sort 'stable';	693	use sort 'stable';
537		694
538	$self->{children} = [	695	$self->{children} = [
539	sort { $a->{z} <=> $b->{z} }	696	sort { $a->{z} <=> $b->{z} }
540	@{$self->{children}}, $child	697	@{$self->{children}}, @widgets
541	];	698	];
542		699
543	$child->check_size;	700	$self->realloc;
544	}	701	}
545		702
546	sub children {	703	sub children {
547	@{ $_[0]{children} }	704	@{ $_[0]{children} }
548	}	705	}
…		…
553	delete $child->{parent};	710	delete $child->{parent};
554	$child->hide;	711	$child->hide;
555		712
556	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	713	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
557		714
558	$self->check_size;	715	$self->realloc;
559	$self->update;
560	}	716	}
561		717
562	sub clear {	718	sub clear {
563	my ($self) = @_;	719	my ($self) = @_;
564		720
…		…
567		723
568	for (@$children) {	724	for (@$children) {
569	delete $_->{parent};	725	delete $_->{parent};
570	$_->hide;	726	$_->hide;
571	}	727	}
		728
		729	$self->realloc;
572	}	730	}
573		731
574	sub find_widget {	732	sub find_widget {
575	my ($self, $x, $y) = @_;	733	my ($self, $x, $y) = @_;
576		734
577	$x -= $self->{x};	735	$x -= $self->{x};
578	$y -= $self->{y};	736	$y -= $self->{y};
579		737
580	my $res;	738	my $res;
581		739
582	for (reverse @{ $self->{children} }) {	740	for (reverse $self->visible_children) {
583	$res = $_->find_widget ($x, $y)	741	$res = $_->find_widget ($x, $y)
584	and return $res;	742	and return $res;
585	}	743	}
586		744
587	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	745	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
651	}	809	}
652		810
653	sub update {	811	sub update {
654	my ($self) = @_;	812	my ($self) = @_;
655		813
656	$ROOT->on_refresh ($self => sub { $self->render_child });	814	$ROOT->on_post_alloc ($self => sub { $self->render_child });
657	$self->SUPER::update;	815	$self->SUPER::update;
658	}	816	}
659		817
660	sub size_allocate {	818	sub size_allocate {
661	my ($self, $w, $h) = @_;	819	my ($self, $w, $h) = @_;
662		820
663	$self->SUPER::size_allocate ($w, $h);	821	$self->SUPER::size_allocate ($w, $h);
664	$self->update;	822	$self->update;
		823	}
		824
		825	sub _render {
		826	my ($self) = @_;
		827
		828	$self->{children}[0]->draw;
665	}	829	}
666		830
667	sub render_child {	831	sub render_child {
668	my ($self) = @_;	832	my ($self) = @_;
669		833
670	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	834	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
671	glClearColor 0, 0, 0, 0;	835	glClearColor 0, 0, 0, 0;
672	glClear GL_COLOR_BUFFER_BIT;	836	glClear GL_COLOR_BUFFER_BIT;
673	$self->child->draw;	837
674	# glColorMask 1, 1, 1, 0;	838	{
675	# glEnable GL_BLEND;	839	package CFClient::UI::Base;
676	# glBlendFunc GL_SRC_ALPHA, GL_ZERO;	840
677	# glRasterPos 0, 0;	841	($draw_x, $draw_y, $draw_w, $draw_h) =
678	# glCopyPixels 0, 0, $self->{w}, $self->{h};	842	(0, 0, $self->{w}, $self->{h});
679	# glDisable GL_BLEND;	843	}
680	# glColorMask 1, 1, 1, 1;	844
		845	$self->_render;
681	};	846	};
682	}	847	}
683		848
684	sub _draw {	849	sub _draw {
685	my ($self) = @_;	850	my ($self) = @_;
686		851
687	my ($w, $h) = ($self->w, $self->h);	852	my ($w, $h) = @$self{qw(w h)};
688		853
689	my $tex = $self->{texture}	854	my $tex = $self->{texture}
690	or return;	855	or return;
691		856
692	glEnable GL_BLEND;
693	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
694	glEnable GL_TEXTURE_2D;	857	glEnable GL_TEXTURE_2D;
695	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	858	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
696	glColor 0, 0, 0, 1;	859	glColor 1, 1, 1, 1;
697		860
698	$tex->draw_quad (0, 0, $w, $h);	861	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
699		862
700	glDisable GL_BLEND;
701	glDisable GL_TEXTURE_2D;	863	glDisable GL_TEXTURE_2D;
702	}	864	}
703		865
704	#############################################################################	866	#############################################################################
705		867
706	package CFClient::UI::ViewPort;	868	package CFClient::UI::ViewPort;
707		869
708	our @ISA = CFClient::UI::Window::;	870	our @ISA = CFClient::UI::Window::;
709
710	sub new { die }
711
712	sub size_request {
713	my ($self) = @_;
714
715	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
716	$self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
717
718	@$self{qw(child_w child_h)}
719	}
720
721	sub _draw {
722	my ($self) = @_;
723
724	$self->{children}[1]->draw;
725	}
726
727
728	#############################################################################
729
730	package CFClient::UI::Frame;
731
732	our @ISA = CFClient::UI::Bin::;
733
734	use CFClient::OpenGL;
735		871
736	sub new {	872	sub new {
737	my $class = shift;	873	my $class = shift;
738		874
739	my $self = $class->SUPER::new (	875	$class->SUPER::new (
740	bg => [1, 1, 1, 1],	876	scroll_x => 0,
741	border_bg => [1, 1, 1, 1],	877	scroll_y => 1,
742	border => 0.8,
743	@_	878	@_,
744	);	879	)
745
746	$self
747	}	880	}
748		881
749	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 {
750	my ($self) = @_;	894	my ($self, $w, $h) = @_;
751		895
752	my ($w, $h) = ($self->{w}, $self->{h});	896	my $child = $self->child;
753		897
754	glEnable GL_BLEND;	898	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
755	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	899	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
756	glEnable GL_TEXTURE_2D;
757	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
758		900
759	# glBegin GL_QUADS;	901	$self->child->configure (0, 0, $w, $h);
760	# glColor 0, 0, 0, 0;	902	$self->update;
761	# glVertex 0 , 0;
762	# glVertex 0 , $h;
763	# glVertex $w, $h;
764	# glVertex $w, 0;
765	# glEnd;
766
767
768	$self->child->draw;
769	glDisable GL_BLEND;
770	glDisable GL_TEXTURE_2D;
771	}	903	}
772		904
773	#############################################################################	905	sub set_offset {
		906	my ($self, $x, $y) = @_;
774		907
775	package CFClient::UI::FancyFrame;	908	$self->{view_x} = int $x;
		909	$self->{view_y} = int $y;
776		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
777	our @ISA = CFClient::UI::Bin::;	957	our @ISA = CFClient::UI::HBox::;
778
779	use CFClient::OpenGL;
780
781	my @tex =
782	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
783	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
784		958
785	sub new {	959	sub new {
786	my $class = shift;	960	my $class = shift;
787		961
788	# 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};
789		1067
790	my $self = $class->SUPER::new (	1068	my $self = $class->SUPER::new (
791	bg => [1, 1, 1, 1],	1069	bg => [1, 1, 1, 1],
792	border_bg => [1, 1, 1, 1],	1070	border_bg => [1, 1, 1, 1],
793	border => 0.6,	1071	border => 0.6,
794	can_events => 1,	1072	can_events => 1,
795	@_	1073	min_w => 16,
		1074	min_h => 16,
		1075	%arg,
796	);	1076	);
797		1077
798	$self->{title} &&= new CFClient::UI::Label	1078	$self->{title} = new CFClient::UI::Label
799	align => 0,	1079	align => 0,
800	valign => 1,	1080	valign => 1,
801	text => $self->{title},	1081	text => $title,
802	fontsize => $self->{border};	1082	fontsize => $self->{border}
		1083	if defined $title;
803		1084
804	$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};
805	}	1093	}
806		1094
807	sub border {	1095	sub border {
808	int $_[0]{border} * $::FONTSIZE	1096	int $_[0]{border} * $::FONTSIZE
809	}	1097	}
810		1098
811	sub size_request {	1099	sub size_request {
812	my ($self) = @_;	1100	my ($self) = @_;
		1101
		1102	$self->{title}->size_request
		1103	if $self->{title};
813		1104
814	my ($w, $h) = $self->SUPER::size_request;	1105	my ($w, $h) = $self->SUPER::size_request;
815		1106
816	(	1107	(
817	$w + $self->border * 2,	1108	$w + $self->border * 2,
…		…
820	}	1111	}
821		1112
822	sub size_allocate {	1113	sub size_allocate {
823	my ($self, $w, $h) = @_;	1114	my ($self, $w, $h) = @_;
824		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
825	$h -= List::Util::max 0, $self->border * 2;	1124	$h -= List::Util::max 0, $border * 2;
826	$w -= List::Util::max 0, $self->border * 2;	1125	$w -= List::Util::max 0, $border * 2;
827		1126
828	$self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)
829	if $self->{title};
830
831	$self->child->configure ($self->border, $self->border, $w, $h);	1127	$self->child->configure ($border, $border, $w, $h);
832	}	1128	}
833		1129
834	sub button_down {	1130	sub button_down {
835	my ($self, $ev, $x, $y) = @_;	1131	my ($self, $ev, $x, $y) = @_;
836		1132
…		…
852	my ($ev, $x, $y) = @_;	1148	my ($ev, $x, $y) = @_;
853		1149
854	my $dx = $ev->{x} - $ox;	1150	my $dx = $ev->{x} - $ox;
855	my $dy = $ev->{y} - $oy;	1151	my $dy = $ev->{y} - $oy;
856		1152
857	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1153	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
858	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1154	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1155
		1156	$self->realloc;
859	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1157	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
860	$self->check_size;
861	};	1158	};
862		1159
863	} elsif ($lr ^ $td) {	1160	} elsif ($lr ^ $td) {
864	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1161	my ($ox, $oy) = ($ev->{x}, $ev->{y});
865	my ($bx, $by) = ($self->{x}, $self->{y});	1162	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
867	$self->{motion} = sub {	1164	$self->{motion} = sub {
868	my ($ev, $x, $y) = @_;	1165	my ($ev, $x, $y) = @_;
869		1166
870	($x, $y) = ($ev->{x}, $ev->{y});	1167	($x, $y) = ($ev->{x}, $ev->{y});
871		1168
872	$self->move ($bx + $x - $ox, $by + $y - $oy);	1169	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
873	$self->update;
874	};	1170	};
		1171	} else {
		1172	return 0;
		1173	}
		1174
875	}	1175	1
876	}	1176	}
877		1177
878	sub button_up {	1178	sub button_up {
879	my ($self, $ev, $x, $y) = @_;	1179	my ($self, $ev, $x, $y) = @_;
880		1180
881	delete $self->{motion};	1181	!!delete $self->{motion}
882	}	1182	}
883		1183
884	sub mouse_motion {	1184	sub mouse_motion {
885	my ($self, $ev, $x, $y) = @_;	1185	my ($self, $ev, $x, $y) = @_;
886		1186
887	$self->{motion}->($ev, $x, $y) if $self->{motion};	1187	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1188
		1189	!!$self->{motion}
888	}	1190	}
889		1191
890	sub _draw {	1192	sub _draw {
891	my ($self) = @_;	1193	my ($self) = @_;
892		1194
		1195	my $child = $self->{children}[0];
		1196
893	my ($w, $h ) = ($self->{w}, $self->{h});	1197	my ($w, $h ) = ($self->{w}, $self->{h});
894	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1198	my ($cw, $ch) = ($child->{w}, $child->{h});
895		1199
896	glEnable GL_BLEND;
897	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
898	glEnable GL_TEXTURE_2D;	1200	glEnable GL_TEXTURE_2D;
899	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1201	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
900		1202
901	my $border = $self->border;	1203	my $border = $self->border;
902		1204
903	glColor @{ $self->{border_bg} };	1205	glColor @{ $self->{border_bg} };
904	$tex[1]->draw_quad (0, 0, $w, $border);	1206	$border[0]->draw_quad_alpha (0, 0, $w, $border);
905	$tex[3]->draw_quad (0, $border, $border, $ch);	1207	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
906	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	1208	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
907	$tex[4]->draw_quad (0, $h - $border, $w, $border);	1209	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
908		1210
909	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1211	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
910	my $bg = $tex[0];	1212	glColor @{ $self->{bg} };
911		1213
912	# TODO: repeat texture not scale	1214	# TODO: repeat texture not scale
		1215	# solve this better(?)
913	my $rep_x = $cw / $bg->{w};	1216	$bg->{s} = $cw / $bg->{w};
914	my $rep_y = $ch / $bg->{h};	1217	$bg->{t} = $ch / $bg->{h};
915
916	glColor @{ $self->{bg} };
917
918	$bg->{s} = $rep_x;
919	$bg->{t} = $rep_y;
920	$bg->{wrap_mode} = 1;
921	$bg->draw_quad ($border, $border, $cw, $ch);	1218	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
		1219	}
922		1220
923	glDisable GL_TEXTURE_2D;	1221	glDisable GL_TEXTURE_2D;
924	glDisable GL_BLEND;
925	}
926		1222
927	$self->{title}->draw if $self->{title};
928
929	$self->child->draw;	1223	$child->draw;
		1224
		1225	if ($self->{title}) {
		1226	glTranslate 0, $border - $self->{h};
		1227	$self->{title}->_draw;
		1228	}
930	}	1229	}
931		1230
932	#############################################################################	1231	#############################################################################
933		1232
934	package CFClient::UI::Table;	1233	package CFClient::UI::Table;
…		…
942	sub new {	1241	sub new {
943	my $class = shift;	1242	my $class = shift;
944		1243
945	$class->SUPER::new (	1244	$class->SUPER::new (
946	col_expand => [],	1245	col_expand => [],
947	@_	1246	@_,
948	)	1247	)
		1248	}
		1249
		1250	sub children {
		1251	grep $_, map @$_, grep $_, @{ $_[0]{children} }
949	}	1252	}
950		1253
951	sub add {	1254	sub add {
952	my ($self, $x, $y, $child) = @_;	1255	my ($self, $x, $y, $child) = @_;
953		1256
954	$child->set_parent ($self);	1257	$child->set_parent ($self);
955	$self->{children}[$y][$x] = $child;	1258	$self->{children}[$y][$x] = $child;
956		1259
957	$child->check_size;	1260	$self->realloc;
958	}	1261	}
959		1262
960	sub children {
961	grep $_, map @$_, grep $_, @{ $_[0]{children} }
962	}
963
964	# 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?
965	sub clear {	1264	sub clear {
966	my ($self) = @_;	1265	my ($self) = @_;
967		1266
968	my @children = $self->children;	1267	my @children = $self->children;
969	delete $self->{children};	1268	delete $self->{children};
…		…
971	for (@children) {	1270	for (@children) {
972	delete $_->{parent};	1271	delete $_->{parent};
973	$_->hide;	1272	$_->hide;
974	}	1273	}
975		1274
976	$self->update;	1275	$self->realloc;
977	}	1276	}
978		1277
979	sub get_wh {	1278	sub get_wh {
980	my ($self) = @_;	1279	my ($self) = @_;
981		1280
…		…
1012	sub size_allocate {	1311	sub size_allocate {
1013	my ($self, $w, $h) = @_;	1312	my ($self, $w, $h) = @_;
1014		1313
1015	my ($ws, $hs) = $self->get_wh;	1314	my ($ws, $hs) = $self->get_wh;
1016		1315
1017	my $req_w = sum @$ws;	1316	my $req_w = (sum @$ws) || 1;
1018	my $req_h = sum @$hs;	1317	my $req_h = (sum @$hs) || 1;
1019		1318
1020	# TODO: nicer code && do row_expand	1319	# TODO: nicer code && do row_expand
1021	my @col_expand = @{$self->{col_expand}};	1320	my @col_expand = @{$self->{col_expand}};
1022	@col_expand = (1) x @$ws unless @col_expand;	1321	@col_expand = (1) x @$ws unless @col_expand;
1023	my $col_expand = (sum @col_expand) || 1;	1322	my $col_expand = (sum @col_expand) || 1;
…		…
1077	}	1376	}
1078	}	1377	}
1079		1378
1080	#############################################################################	1379	#############################################################################
1081		1380
1082	package CFClient::UI::HBox;	1381	package CFClient::UI::Box;
1083
1084	# TODO: wrap into common Box base class
1085		1382
1086	our @ISA = CFClient::UI::Container::;	1383	our @ISA = CFClient::UI::Container::;
1087		1384
1088	sub size_request {	1385	sub size_request {
1089	my ($self) = @_;	1386	my ($self) = @_;
1090		1387
1091	my @alloc = map [$_->size_request], @{$self->{children}};	1388	$self->{vertical}
1092		1389	? (
1093	(	1390	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1094	(List::Util::sum map $_->[0], @alloc),	1391	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1095	(List::Util::max map $_->[1], @alloc),	1392	)
1096	)	1393	: (
		1394	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1395	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1396	)
1097	}	1397	}
1098		1398
1099	sub size_allocate {	1399	sub size_allocate {
1100	my ($self, $w, $h) = @_;	1400	my ($self, $w, $h) = @_;
1101		1401
1102	($h, $w) = ($w, $h);	1402	my $space = $self->{vertical} ? $h : $w;
1103
1104	my $children = $self->{children};	1403	my $children = $self->{children};
1105		1404
1106	my @h = map $_->{req_w}, @$children;	1405	my @req;
1107		1406
1108	my $req_h = List::Util::sum @h;	1407	if ($self->{homogeneous}) {
1109		1408	@req = ($space / (@$children || 1)) x @$children;
1110	if ($req_h > $h) {
1111	# ah well, not enough space
1112	$_ *= $h / $req_h for @h;
1113	} 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 {
1114	my $exp = List::Util::sum map $_->{expand}, @$children;	1417	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1115	$exp ||= 1;
1116		1418
		1419	$space = ($space - $req) / $expand; # remaining space to give away
		1420
		1421	$req[$_] += $space * $children->[$_]{expand}
1117	for (0 .. $#$children) {	1422	for 0 .. $#$children;
1118	my $child = $children->[$_];
1119
1120	my $alloc_h = $h[$_];
1121	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1122	$h[$_] = $alloc_h;
1123	}	1423	}
1124	}	1424	}
1125		1425
1126	CFClient::UI::harmonize \@h;	1426	CFClient::UI::harmonize \@req;
1127		1427
1128	my $y = 0;	1428	my $pos = 0;
1129	for (0 .. $#$children) {	1429	for (0 .. $#$children) {
1130	my $child = $children->[$_];
1131	my $h = $h[$_];	1430	my $alloc = $req[$_];
1132	$child->configure ($y, 0, $h, $w);	1431	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1133		1432
1134	$y += $h;	1433	$pos += $alloc;
1135	}	1434	}
1136		1435
1137	1	1436	1
1138	}	1437	}
1139		1438
1140	#############################################################################	1439	#############################################################################
1141		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
1142	package CFClient::UI::VBox;	1456	package CFClient::UI::VBox;
1143		1457
1144	# TODO: wrap into common Box base class
1145
1146	our @ISA = CFClient::UI::Container::;	1458	our @ISA = CFClient::UI::Box::;
1147		1459
1148	sub size_request {	1460	sub new {
1149	my ($self) = @_;	1461	my $class = shift;
1150		1462
1151	my @alloc = map [$_->size_request], @{$self->{children}};	1463	$class->SUPER::new (
1152		1464	vertical => 1,
1153	(	1465	@_,
1154	(List::Util::max map $_->[0], @alloc),
1155	(List::Util::sum map $_->[1], @alloc),
1156	)	1466	)
1157	}	1467	}
1158		1468
1159	sub size_allocate {
1160	my ($self, $w, $h) = @_;
1161
1162	my $children = $self->{children};
1163
1164	my @h = map $_->{req_h}, @$children;
1165
1166	my $req_h = List::Util::sum @h;
1167
1168	if ($req_h > $h) {
1169	# ah well, not enough space
1170	$_ *= $h / $req_h for @h;
1171	} else {
1172	my $exp = List::Util::sum map $_->{expand}, @$children;
1173	$exp ||= 1;
1174
1175	for (0 .. $#$children) {
1176	my $child = $children->[$_];
1177
1178	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1179	}
1180	}
1181
1182	CFClient::UI::harmonize \@h;
1183
1184	my $y = 0;
1185	for (0 .. $#$children) {
1186	my $child = $children->[$_];
1187	my $h = $h[$_];
1188	$child->configure (0, $y, $w, $h);
1189
1190	$y += $h;
1191	}
1192
1193	1
1194	}
1195
1196	#############################################################################	1469	#############################################################################
1197		1470
1198	package CFClient::UI::Label;	1471	package CFClient::UI::Label;
1199		1472
1200	our @ISA = CFClient::UI::Base::;	1473	our @ISA = CFClient::UI::DrawBG::;
1201		1474
1202	use CFClient::OpenGL;	1475	use CFClient::OpenGL;
1203		1476
1204	sub new {	1477	sub new {
1205	my ($class, %arg) = @_;	1478	my ($class, %arg) = @_;
1206		1479
1207	my $self = $class->SUPER::new (	1480	my $self = $class->SUPER::new (
1208	fg => [1, 1, 1],	1481	fg => [1, 1, 1],
		1482	#bg => none
		1483	#active_bg => none
1209	#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),
1210	fontsize => 1,	1490	fontsize => 1,
1211	text => "",
1212	align => -1,	1491	align => -1,
1213	valign => -1,	1492	valign => -1,
1214	padding => 2,	1493	padding_x => 2,
1215	layout => new CFClient::Layout,	1494	padding_y => 2,
1216	can_events => 0,	1495	can_events => 0,
1217	%arg	1496	%arg
1218	);	1497	);
1219		1498
1220	if (exists $self->{template}) {	1499	if (exists $self->{template}) {
1221	my $layout = new CFClient::Layout;	1500	my $layout = new CFClient::Layout;
1222	$layout->set_text (delete $self->{template});	1501	$layout->set_text (delete $self->{template});
1223	$self->{template} = $layout;	1502	$self->{template} = $layout;
1224	}	1503	}
1225		1504
1226	$self->set_text (delete $self->{text}) if exists $self->{text};	1505	if (exists $self->{markup}) {
1227	$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	}
1228		1510
1229	$self	1511	$self
1230	}	1512	}
1231		1513
1232	sub escape {	1514	sub escape($) {
1233	local $_ = $_[1];	1515	local $_ = $_[0];
1234		1516
1235	s/&/&amp;/g;	1517	s/&/&amp;/g;
1236	s/>/&gt;/g;	1518	s/>/&gt;/g;
1237	s/</&lt;/g;	1519	s/</&lt;/g;
1238		1520
1239	$_[1]	1521	$_
1240	}	1522	}
1241		1523
1242	sub update {	1524	sub update {
1243	my ($self) = @_;	1525	my ($self) = @_;
1244		1526
1245	delete $self->{texture};	1527	delete $self->{texture};
1246	$self->SUPER::update;	1528	$self->SUPER::update;
1247	}	1529	}
1248		1530
1249	sub reconfigure {
1250	my ($self) = @_;
1251
1252	delete $self->{texture};
1253	}
1254
1255	sub set_text {	1531	sub set_text {
1256	my ($self, $text) = @_;	1532	my ($self, $text) = @_;
1257		1533
1258	return if $self->{text} eq "T$text";	1534	return if $self->{text} eq "T$text";
1259	$self->{text} = "T$text";	1535	$self->{text} = "T$text";
1260		1536
		1537	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1261	$self->{layout}->set_text ($text);	1538	$self->{layout}->set_text ($text);
1262		1539
1263	delete $self->{texture};	1540	$self->realloc;
1264	$self->update;	1541	$self->update;
1265	$self->check_size;
1266	}	1542	}
1267		1543
1268	sub set_markup {	1544	sub set_markup {
1269	my ($self, $markup) = @_;	1545	my ($self, $markup) = @_;
1270		1546
1271	return if $self->{text} eq "M$markup";	1547	return if $self->{text} eq "M$markup";
1272	$self->{text} = "M$markup";	1548	$self->{text} = "M$markup";
1273		1549
		1550	my $rgba = $markup =~ /span.*(?:foreground|background)/;
		1551
		1552	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1274	$self->{layout}->set_markup ($markup);	1553	$self->{layout}->set_markup ($markup);
1275		1554
1276	delete $self->{texture};	1555	$self->realloc;
1277	$self->update;	1556	$self->update;
1278	$self->check_size;
1279	}	1557	}
1280		1558
1281	sub size_request {	1559	sub size_request {
1282	my ($self) = @_;	1560	my ($self) = @_;
1283		1561
1284	$self->{layout}->set_font ($self->{font}) if $self->{font};	1562	$self->{layout}->set_font ($self->{font}) if $self->{font};
1285	$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});
1286	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1566	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1287		1567
1288	my ($w, $h) = $self->{layout}->size;	1568	my ($w, $h) = $self->{layout}->size;
1289		1569
1290	if (exists $self->{template}) {	1570	if (exists $self->{template}) {
…		…
1295		1575
1296	$w = List::Util::max $w, $w2;	1576	$w = List::Util::max $w, $w2;
1297	$h = List::Util::max $h, $h2;	1577	$h = List::Util::max $h, $h2;
1298	}	1578	}
1299		1579
1300	(	1580	($w, $h)
1301	$w + $self->{padding} * 2,
1302	$h + $self->{padding} * 2,
1303	)
1304	}	1581	}
1305		1582
1306	sub size_allocate {	1583	sub size_allocate {
1307	my ($self, $w, $h) = @_;	1584	my ($self, $w, $h) = @_;
1308		1585
		1586	delete $self->{ox};
		1587
1309	delete $self->{texture};	1588	delete $self->{texture}
		1589	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1310	}	1590	}
1311		1591
1312	sub set_fontsize {	1592	sub set_fontsize {
1313	my ($self, $fontsize) = @_;	1593	my ($self, $fontsize) = @_;
1314		1594
1315	$self->{fontsize} = $fontsize;	1595	$self->{fontsize} = $fontsize;
1316	delete $self->{texture};	1596	delete $self->{texture};
1317	$self->check_size;	1597
1318	$self->update;	1598	$self->realloc;
1319	}	1599	}
1320		1600
1321	sub _draw {	1601	sub _draw {
1322	my ($self) = @_;	1602	my ($self) = @_;
1323		1603
		1604	$self->SUPER::_draw; # draw background, if applicable
		1605
1324	my $tex = $self->{texture} ||= do {	1606	my $tex = $self->{texture} ||= do {
		1607	$self->{layout}->set_foreground (@{$self->{fg}});
1325	$self->{layout}->set_font ($self->{font}) if $self->{font};	1608	$self->{layout}->set_font ($self->{font}) if $self->{font};
1326	$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});
1327	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);	1612	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
		1613
1328	new_from_layout CFClient::Texture $self->{layout}	1614	new_from_layout CFClient::Texture $self->{layout}
1329	};	1615	};
1330		1616
1331	glEnable GL_BLEND;	1617	unless (exists $self->{ox}) {
1332	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
1333	glEnable GL_TEXTURE_2D;	1627	glEnable GL_TEXTURE_2D;
1334	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1628	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1335		1629
		1630	if ($tex->{format} == GL_ALPHA) {
1336	glColor @{$self->{fg}};	1631	glColor @{$self->{fg}};
1337
1338	$self->{ox} = int (
1339	$self->{align} < 0 ? $self->{padding}
1340	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1341	: ($self->{w} - $tex->{w}) * 0.5
1342	);
1343
1344	$self->{oy} = int (
1345	$self->{valign} < 0 ? $self->{padding}
1346	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1347	: ($self->{h} - $tex->{h}) * 0.5
1348	);
1349
1350	$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	}
1351		1636
1352	glDisable GL_TEXTURE_2D;	1637	glDisable GL_TEXTURE_2D;
1353	glDisable GL_BLEND;
1354	}	1638	}
1355		1639
1356	#############################################################################	1640	#############################################################################
1357		1641
1358	package CFClient::UI::EntryBase;	1642	package CFClient::UI::EntryBase;
…		…
1371	active_fg => [0, 0, 0],	1655	active_fg => [0, 0, 0],
1372	can_hover => 1,	1656	can_hover => 1,
1373	can_focus => 1,	1657	can_focus => 1,
1374	valign => 0,	1658	valign => 0,
1375	can_events => 1,	1659	can_events => 1,
		1660	#text => ...
1376	@_	1661	@_
1377	)	1662	)
1378	}	1663	}
1379		1664
1380	sub _set_text {	1665	sub _set_text {
…		…
1390	$self->{text} = $text;	1675	$self->{text} = $text;
1391		1676
1392	$text =~ s/./*/g if $self->{hidden};	1677	$text =~ s/./*/g if $self->{hidden};
1393	$self->{layout}->set_text ("$text ");	1678	$self->{layout}->set_text ("$text ");
1394		1679
1395	$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;
1396	}	1690	}
1397		1691
1398	sub get_text {	1692	sub get_text {
1399	$_[0]{text}	1693	$_[0]{text}
1400	}	1694	}
…		…
1403	my ($self) = @_;	1697	my ($self) = @_;
1404		1698
1405	my ($w, $h) = $self->SUPER::size_request;	1699	my ($w, $h) = $self->SUPER::size_request;
1406		1700
1407	($w + 1, $h) # add 1 for cursor	1701	($w + 1, $h) # add 1 for cursor
1408	}
1409
1410	sub size_allocate {
1411	my ($self, $w, $h) = @_;
1412
1413	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1414	}
1415
1416	sub set_text {
1417	my ($self, $text) = @_;
1418
1419	$self->{cursor} = length $text;
1420	$self->_set_text ($text);
1421	$self->update;
1422	}	1702	}
1423		1703
1424	sub key_down {	1704	sub key_down {
1425	my ($self, $ev) = @_;	1705	my ($self, $ev) = @_;
1426		1706
…		…
1428	my $sym = $ev->{sym};	1708	my $sym = $ev->{sym};
1429	my $uni = $ev->{unicode};	1709	my $uni = $ev->{unicode};
1430		1710
1431	my $text = $self->get_text;	1711	my $text = $self->get_text;
1432		1712
1433	if ($sym == 8) {	1713	if ($uni == 8) {
1434	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1714	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1435	} elsif ($sym == 127) {	1715	} elsif ($uni == 127) {
1436	substr $text, $self->{cursor}, 1, "";	1716	substr $text, $self->{cursor}, 1, "";
1437	} elsif ($sym == CFClient::SDLK_LEFT) {	1717	} elsif ($sym == CFClient::SDLK_LEFT) {
1438	--$self->{cursor} if $self->{cursor};	1718	--$self->{cursor} if $self->{cursor};
1439	} elsif ($sym == CFClient::SDLK_RIGHT) {	1719	} elsif ($sym == CFClient::SDLK_RIGHT) {
1440	++$self->{cursor} if $self->{cursor} < length $self->{text};	1720	++$self->{cursor} if $self->{cursor} < length $self->{text};
1441	} elsif ($sym == CFClient::SDLK_HOME) {	1721	} elsif ($sym == CFClient::SDLK_HOME) {
1442	$self->{cursor} = 0;	1722	$self->{cursor} = 0;
1443	} elsif ($sym == CFClient::SDLK_END) {	1723	} elsif ($sym == CFClient::SDLK_END) {
1444	$self->{cursor} = length $text;	1724	$self->{cursor} = length $text;
1445	} elsif ($sym == 27) {	1725	} elsif ($uni == 27) {
1446	$self->emit ('escape');	1726	$self->_emit ('escape');
1447	} elsif ($uni) {	1727	} elsif ($uni) {
1448	substr $text, $self->{cursor}++, 0, chr $uni;	1728	substr $text, $self->{cursor}++, 0, chr $uni;
		1729	} else {
		1730	return 0;
1449	}	1731	}
1450		1732
1451	$self->_set_text ($text);	1733	$self->_set_text ($text);
1452	$self->update;	1734
		1735	$self->realloc;
		1736
		1737	1
1453	}	1738	}
1454		1739
1455	sub focus_in {	1740	sub focus_in {
1456	my ($self) = @_;	1741	my ($self) = @_;
1457		1742
…		…
1472	utf8::encode $text;	1757	utf8::encode $text;
1473	$self->{cursor} = length substr $text, 0, $idx;	1758	$self->{cursor} = length substr $text, 0, $idx;
1474		1759
1475	$self->_set_text ($self->{text});	1760	$self->_set_text ($self->{text});
1476	$self->update;	1761	$self->update;
		1762
		1763	1
1477	}	1764	}
1478		1765
1479	sub mouse_motion {	1766	sub mouse_motion {
1480	my ($self, $ev, $x, $y) = @_;	1767	my ($self, $ev, $x, $y) = @_;
1481	# 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
1482	}	1771	}
1483		1772
1484	sub _draw {	1773	sub _draw {
1485	my ($self) = @_;	1774	my ($self) = @_;
1486		1775
…		…
1537	if ($sym == 13) {	1826	if ($sym == 13) {
1538	unshift @{$self->{history}},	1827	unshift @{$self->{history}},
1539	my $txt = $self->get_text;	1828	my $txt = $self->get_text;
1540	$self->{history_pointer} = -1;	1829	$self->{history_pointer} = -1;
1541	$self->{history_saveback} = '';	1830	$self->{history_saveback} = '';
1542	$self->emit (activate => $txt);	1831	$self->_emit (activate => $txt);
1543	$self->update;	1832	$self->update;
1544		1833
1545	} elsif ($sym == CFClient::SDLK_UP) {	1834	} elsif ($sym == CFClient::SDLK_UP) {
1546	if ($self->{history_pointer} < 0) {	1835	if ($self->{history_pointer} < 0) {
1547	$self->{history_saveback} = $self->get_text;	1836	$self->{history_saveback} = $self->get_text;
…		…
1563	} else {	1852	} else {
1564	$self->set_text ($self->{history_saveback});	1853	$self->set_text ($self->{history_saveback});
1565	}	1854	}
1566		1855
1567	} else {	1856	} else {
1568	$self->SUPER::key_down ($ev);	1857	return $self->SUPER::key_down ($ev)
		1858	}
		1859
1569	}	1860	1
1570
1571	}	1861	}
1572		1862
1573	#############################################################################	1863	#############################################################################
1574		1864
1575	package CFClient::UI::Button;	1865	package CFClient::UI::Button;
…		…
1584		1874
1585	sub new {	1875	sub new {
1586	my $class = shift;	1876	my $class = shift;
1587		1877
1588	$class->SUPER::new (	1878	$class->SUPER::new (
1589	padding => 4,	1879	padding_x => 4,
		1880	padding_y => 4,
1590	fg => [1, 1, 1],	1881	fg => [1, 1, 1],
1591	bg => [1, 1, 1, 0.2],
1592	active_fg => [0, 0, 1],	1882	active_fg => [0, 0, 1],
1593	can_hover => 1,	1883	can_hover => 1,
1594	align => 0,	1884	align => 0,
1595	valign => 0,	1885	valign => 0,
1596	can_events => 1,	1886	can_events => 1,
1597	@_	1887	@_
1598	)	1888	)
1599	}	1889	}
1600		1890
		1891	sub activate { }
		1892
1601	sub button_up {	1893	sub button_up {
1602	my ($self, $ev, $x, $y) = @_;	1894	my ($self, $ev, $x, $y) = @_;
1603		1895
		1896	$self->emit ("activate")
1604	if ($x >= 0 && $x < $self->{w}	1897	if $x >= 0 && $x < $self->{w}
1605	&& $y >= 0 && $y < $self->{h}) {	1898	&& $y >= 0 && $y < $self->{h};
1606	$self->emit ("activate");	1899
1607	}	1900	1
1608	}	1901	}
1609		1902
1610	sub _draw {	1903	sub _draw {
1611	my ($self) = @_;	1904	my ($self) = @_;
1612		1905
…		…
1614		1907
1615	if ($GRAB == $self) {	1908	if ($GRAB == $self) {
1616	$self->{fg} = $self->{active_fg};	1909	$self->{fg} = $self->{active_fg};
1617	}	1910	}
1618		1911
1619	glEnable GL_BLEND;
1620	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1621	glEnable GL_TEXTURE_2D;	1912	glEnable GL_TEXTURE_2D;
1622	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1913	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1623	glColor 0, 0, 0, 1;	1914	glColor 0, 0, 0, 1;
1624		1915
1625	$tex[0]->draw_quad (0, 0, $self->{w}, $self->{h});	1916	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1626		1917
1627	glDisable GL_TEXTURE_2D;	1918	glDisable GL_TEXTURE_2D;
1628	glDisable GL_BLEND;
1629		1919
1630	$self->SUPER::_draw;	1920	$self->SUPER::_draw;
1631	}	1921	}
1632		1922
1633	#############################################################################	1923	#############################################################################
…		…
1644		1934
1645	sub new {	1935	sub new {
1646	my $class = shift;	1936	my $class = shift;
1647		1937
1648	$class->SUPER::new (	1938	$class->SUPER::new (
1649	padding => 2,	1939	padding_x => 2,
		1940	padding_y => 2,
1650	fg => [1, 1, 1],	1941	fg => [1, 1, 1],
1651	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],
1652	state => 0,	1945	state => 0,
1653	can_hover => 1,	1946	can_hover => 1,
1654	@_	1947	@_
1655	)	1948	)
1656	}	1949	}
1657		1950
1658	sub size_request {	1951	sub size_request {
1659	my ($self) = @_;	1952	my ($self) = @_;
1660		1953
1661	($self->{padding} * 2 + 6) x 2	1954	(6) x 2
1662	}	1955	}
1663		1956
1664	sub button_down {	1957	sub button_down {
1665	my ($self, $ev, $x, $y) = @_;	1958	my ($self, $ev, $x, $y) = @_;
1666		1959
1667	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1960	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1668	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1961	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1669	$self->{state} = !$self->{state};	1962	$self->{state} = !$self->{state};
1670	$self->emit (changed => $self->{state});	1963	$self->_emit (changed => $self->{state});
		1964	} else {
		1965	return 0
		1966	}
		1967
1671	}	1968	1
1672	}	1969	}
1673		1970
1674	sub _draw {	1971	sub _draw {
1675	my ($self) = @_;	1972	my ($self) = @_;
1676		1973
1677	$self->SUPER::_draw;	1974	$self->SUPER::_draw;
1678		1975
1679	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1976	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1680		1977
1681	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;
1682		1981
1683	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1982	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1684		1983
1685	glEnable GL_BLEND;	1984	my $tex = $self->{state} ? $tex[1] : $tex[0];
		1985
1686	glEnable GL_TEXTURE_2D;	1986	glEnable GL_TEXTURE_2D;
1687	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1688
1689	my $tex = $self->{state} ? $tex[1] : $tex[0];
1690
1691	$tex->draw_quad (0, 0, $s, $s);	1987	$tex->draw_quad_alpha (0, 0, $s, $s);
1692
1693	glDisable GL_TEXTURE_2D;	1988	glDisable GL_TEXTURE_2D;
1694	glDisable GL_BLEND;
1695	}	1989	}
1696		1990
1697	#############################################################################	1991	#############################################################################
1698		1992
1699	package CFClient::UI::Image;	1993	package CFClient::UI::Image;
…		…
1742	glTranslate 0, -$self->{w}, 0;	2036	glTranslate 0, -$self->{w}, 0;
1743		2037
1744	($w, $h) = ($h, $w);	2038	($w, $h) = ($h, $w);
1745	}	2039	}
1746		2040
1747	glEnable GL_BLEND;
1748	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1749	glEnable GL_TEXTURE_2D;	2041	glEnable GL_TEXTURE_2D;
1750	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2042	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1751		2043
1752	$tex->draw_quad (0, 0, $w, $h);	2044	$tex->draw_quad_alpha (0, 0, $w, $h);
1753		2045
1754	glDisable GL_BLEND;
1755	glDisable GL_TEXTURE_2D;	2046	glDisable GL_TEXTURE_2D;
1756	}	2047	}
1757		2048
1758	#############################################################################	2049	#############################################################################
1759		2050
…		…
1948	qw(s1_slider.png s1_slider_bg.png);	2239	qw(s1_slider.png s1_slider_bg.png);
1949		2240
1950	sub new {	2241	sub new {
1951	my $class = shift;	2242	my $class = shift;
1952		2243
1953	# range [value, low, high, page]	2244	# range [value, low, high, page, unit]
1954		2245
1955	# TODO: 0-width page	2246	# TODO: 0-width page
1956	# TODO: req_w/h are wrong with vertical	2247	# TODO: req_w/h are wrong with vertical
1957	# TODO: calculations are off	2248	# TODO: calculations are off
1958	my $self = $class->SUPER::new (	2249	my $self = $class->SUPER::new (
1959	fg => [1, 1, 1],	2250	fg => [1, 1, 1],
1960	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],
1961	range => [0, 0, 100, 10],	2254	range => [0, 0, 100, 10, 0],
1962	req_w => 20,	2255	min_w => $::WIDTH / 80,
1963	req_h => 20,	2256	min_h => $::WIDTH / 80,
1964	vertical => 0,	2257	vertical => 0,
1965	can_hover => 1,	2258	can_hover => 1,
1966	inner_pad => 5,	2259	inner_pad => 0.02,
1967	@_	2260	@_
1968	);	2261	);
1969		2262
		2263	$self->set_value ($self->{range}[0]);
		2264	$self->update;
		2265
1970	$self	2266	$self
1971	}	2267	}
1972		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
1973	sub size_request {	2303	sub size_request {
1974	my ($self) = @_;	2304	my ($self) = @_;
1975		2305
1976	my $w = $self->{req_w};	2306	($self->{req_w}, $self->{req_h})
1977	my $h = $self->{req_h};
1978
1979	$self->{vertical} ? ($h, $w) : ($w, $h)
1980	}	2307	}
1981		2308
1982	sub button_down {	2309	sub button_down {
1983	my ($self, $ev, $x, $y) = @_;	2310	my ($self, $ev, $x, $y) = @_;
1984		2311
1985	$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
1986	$self->mouse_motion ($ev, $x, $y);	2316	$self->mouse_motion ($ev, $x, $y)
1987	}	2317	}
1988		2318
1989	sub mouse_motion {	2319	sub mouse_motion {
1990	my ($self, $ev, $x, $y) = @_;	2320	my ($self, $ev, $x, $y) = @_;
1991		2321
1992	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
1993	my ($value, $lo, $hi, $page) = @{$self->{range}};	2343	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2344	my $range = ($hi - $page - $lo) || 1e-100;
1994		2345
1995	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2346	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
1996		2347
1997	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2348	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
1998	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right	2349	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
1999		2350
2000	$x -= $inner_pad_px; # substract the padding	2351	$value = ($value - $lo) / $range;
2001	$x = $x * ($hi - $lo) / $inner_w + $lo;	2352	$value = $value * $self->{scale} + $self->{offset};
2002	$x = $lo if $x < $lo;
2003	$x = $hi - $page if $x > $hi - $page;
2004	$self->{range}[0] = $x;
2005		2353
2006	$self->emit (changed => $x);	2354	$self->{knob_x} = $value - $knob_w * 0.5;
2007	$self->update;	2355	$self->{knob_w} = $knob_w;
2008	}	2356	});
2009	}
2010		2357
2011	# the inner_* stuff is for generating a padding for the slider handle,	2358	$self->SUPER::update;
2012	# so that the handle doesn't leave the texture. This calculation isn't 100%
2013	# correct propably, but it does the job for now
2014	sub _calc_inner_pad_px {
2015	my ($self, $w) = @_;
2016	($w / 100) * $self->{inner_pad} # % to pixels
2017	}	2359	}
2018		2360
2019	sub _draw {	2361	sub _draw {
2020	my ($self) = @_;	2362	my ($self) = @_;
2021		2363
2022	$self->SUPER::_draw ();	2364	$self->SUPER::_draw ();
2023		2365
2024	my ($w, $h) = @$self{qw(w h)};	2366	glScale $self->{w}, $self->{h};
2025		2367
2026	if ($self->{vertical}) {	2368	if ($self->{vertical}) {
2027	# draw a vertical slider like a rotated horizontal slider	2369	# draw a vertical slider like a rotated horizontal slider
2028		2370
		2371	glTranslate 1, 0, 0;
2029	glRotate 90, 0, 0, 1;	2372	glRotate 90, 0, 0, 1;
2030	glTranslate 0, -$self->{w}, 0;
2031
2032	($w, $h) = ($h, $w);
2033	}	2373	}
2034		2374
2035	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2375	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2036	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2376	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2037		2377
2038	my ($value, $lo, $hi, $page) = @{$self->{range}};
2039
2040	$hi = $value + 1 if $lo == $hi;
2041
2042	my $inner_pad_px = $self->_calc_inner_pad_px ($w);
2043	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
2044
2045	$page = int $page * $inner_w / ($hi - $lo);
2046	$value = int +($value - $lo) * $inner_w / ($hi - $lo);
2047
2048	$w -= $page;
2049	$page &= ~1;
2050	glTranslate $page * 0.5, 0, 0;
2051	$page ||= 2;
2052
2053	my $knob_a = $inner_pad_px + ($value - $page * 0.5);
2054	my $knob_b = $inner_pad_px + ($value + $page * 0.5);
2055
2056	glEnable GL_BLEND;
2057	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2058	glEnable GL_TEXTURE_2D;	2378	glEnable GL_TEXTURE_2D;
2059	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2379	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2060		2380
2061	# draw background	2381	# draw background
2062	$tex[1]->draw_quad (0, 0, $w, $h);	2382	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
2063		2383
2064	# draw handle	2384	# draw handle
2065	$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);
2066		2386
2067	glDisable GL_BLEND;
2068	glDisable GL_TEXTURE_2D;	2387	glDisable GL_TEXTURE_2D;
2069	}	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 (@_) }
2070		2430
2071	#############################################################################	2431	#############################################################################
2072		2432
2073	package CFClient::UI::TextView;	2433	package CFClient::UI::TextView;
2074		2434
…		…
2083	fontsize => 1,	2443	fontsize => 1,
2084	can_events => 0,	2444	can_events => 0,
2085	#font => default_font	2445	#font => default_font
2086	@_,	2446	@_,
2087		2447
2088	layout => (new CFClient::Layout),	2448	layout => (new CFClient::Layout 1),
2089	par => [],	2449	par => [],
2090	height => 0,	2450	height => 0,
2091	children => [	2451	children => [
2092	(new CFClient::UI::Empty expand => 1),	2452	(new CFClient::UI::Empty expand => 1),
2093	(new CFClient::UI::Slider vertical => 1),	2453	(new CFClient::UI::Slider vertical => 1),
…		…
2104		2464
2105	$self->{fontsize} = $fontsize;	2465	$self->{fontsize} = $fontsize;
2106	$self->reflow;	2466	$self->reflow;
2107	}	2467	}
2108		2468
2109	sub text_height {
2110	my ($self, $text) = @_;
2111
2112	my $layout = $self->{layout};
2113
2114	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2115	$layout->set_width ($self->{children}[0]{w});
2116	$layout->set_text ($text);
2117
2118	($layout->size)[1]
2119	}
2120
2121	sub reflow {
2122	my ($self) = @_;
2123
2124	$self->{need_reflow}++;
2125	$self->update;
2126	}
2127
2128	sub size_allocate {	2469	sub size_allocate {
2129	my ($self, $w, $h) = @_;	2470	my ($self, $w, $h) = @_;
2130		2471
2131	$self->SUPER::size_allocate ($w, $h);	2472	$self->SUPER::size_allocate ($w, $h);
2132		2473
…		…
2135	$self->{layout}->set_width ($self->{children}[0]{w});	2476	$self->{layout}->set_width ($self->{children}[0]{w});
2136		2477
2137	$self->reflow;	2478	$self->reflow;
2138	}	2479	}
2139		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
2140	sub add_paragraph {	2515	sub add_paragraph {
2141	my ($self, $color, $text) = @_;	2516	my ($self, $color, $text, $indent) = @_;
2142		2517
2143	#TODO: intelligently "reformat" paragraph	2518	for my $line (split /\n/, $text) {
2144		2519	my ($w, $h) = $self->text_size ($line);
2145	my $height = $self->text_height ($text);
2146
2147	$self->{height} += $height;	2520	$self->{height} += $h;
		2521	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
		2522	}
2148		2523
2149	push @{$self->{par}}, [$height, $color, $text];
2150
2151	$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]);
2152	$self->{children}[1]->update;
2153	}	2525	}
2154		2526
2155	sub update {	2527	sub update {
2156	my ($self) = @_;	2528	my ($self) = @_;
2157		2529
…		…
2159		2531
2160	return unless $self->{h} > 0;	2532	return unless $self->{h} > 0;
2161		2533
2162	delete $self->{texture};	2534	delete $self->{texture};
2163		2535
2164	$ROOT->on_refresh ($self, sub {	2536	$ROOT->on_post_alloc ($self, sub {
		2537	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2538
2165	if (delete $self->{need_reflow}) {	2539	if (delete $self->{need_reflow}) {
2166	my $height = 0;	2540	my $height = 0;
2167		2541
2168	$height += $_->[0] = $self->text_height ($_->[2])	2542	my $layout = $self->{layout};
		2543
		2544	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2545
2169	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	}
2170		2557
2171	$self->{height} = $height;	2558	$self->{height} = $height;
2172		2559
2173	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2560	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2174		2561
2175	delete $self->{texture};	2562	delete $self->{texture};
2176	}	2563	}
2177		2564
2178	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {	2565	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2179	glClearColor 0, 0, 0, 0;	2566	glClearColor 0.5, 0.5, 0.5, 0;
2180	glClear GL_COLOR_BUFFER_BIT;	2567	glClear GL_COLOR_BUFFER_BIT;
2181		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
2182	glEnable GL_BLEND;	2580	glEnable GL_BLEND;
		2581	#TODO# not correct in windows where rgba is forced off
2183	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2582	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2184	glEnable GL_TEXTURE_2D;
2185	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2186
2187	my $top = int $self->{children}[1]{range}[0];
2188
2189	my $y0 = $top;
2190	my $y1 = $top + $self->{h};
2191
2192	my $y = 0;
2193
2194	my $layout = $self->{layout};
2195
2196	$layout->set_font ($self->{font}) if $self->{font};
2197		2583
2198	for my $par (@{$self->{par}}) {	2584	for my $par (@{$self->{par}}) {
2199	my $h = $par->[0];	2585	my $h = $par->[1];
2200		2586
2201	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]);
2202	$layout->set_text ($par->[2]);	2590	$layout->set_markup ($par->[4]);
2203		2591
2204	glColor @{ $par->[1] };	2592	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2205	my ($W, $H) = $layout->size;	2593
2206	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;
2207	}	2596	}
2208		2597
2209	$y += $h;	2598	$y += $h;
2210	}	2599	}
2211		2600
2212	glDisable GL_TEXTURE_2D;
2213	glDisable GL_BLEND;	2601	glDisable GL_BLEND;
2214	};	2602	};
2215	});	2603	});
2216	}	2604	}
2217		2605
2218	sub _draw {	2606	sub _draw {
2219	my ($self) = @_;	2607	my ($self) = @_;
2220		2608
2221	glEnable GL_BLEND;
2222	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2223	glEnable GL_TEXTURE_2D;	2609	glEnable GL_TEXTURE_2D;
2224	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2610	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2225	glColor 1, 1, 1, 1;	2611	glColor 1, 1, 1, 1;
2226	$self->{texture}->draw_quad (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2612	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2227	glDisable GL_TEXTURE_2D;	2613	glDisable GL_TEXTURE_2D;
2228	glDisable GL_BLEND;
2229		2614
2230	$self->{children}[1]->draw;	2615	$self->{children}[1]->draw;
2231		2616
2232	}	2617	}
2233		2618
…		…
2281		2666
2282	sub new {	2667	sub new {
2283	my $class = shift;	2668	my $class = shift;
2284		2669
2285	my $self = $class->SUPER::new (	2670	my $self = $class->SUPER::new (
2286	state => 0,	2671	state => 0,
2287	connect_activate => \&toggle_flopper,	2672	on_activate => \&toggle_flopper,
2288	@_	2673	@_
2289	);	2674	);
2290		2675
2291	if ($self->{state}) {
2292	$self->{state} = 0;
2293	$self->toggle_flopper;
2294	}
2295
2296	$self	2676	$self
2297	}	2677	}
2298		2678
2299	sub toggle_flopper {	2679	sub toggle_flopper {
2300	my ($self) = @_;	2680	my ($self) = @_;
2301		2681
2302	# TODO: use animation	2682	$self->{other}->toggle_visibility;
2303	if ($self->{state} = !$self->{state}) {
2304	$CFClient::UI::ROOT->add ($self->{other});
2305	$self->{other}->move ($self->coord2global (0, $self->{h}));
2306	$self->emit ("open");
2307	} else {
2308	$CFClient::UI::ROOT->remove ($self->{other});
2309	$self->emit ("close");
2310	}
2311
2312	$self->emit (changed => $self->{state});
2313	}	2683	}
2314		2684
2315	#############################################################################	2685	#############################################################################
2316		2686
2317	package CFClient::UI::Tooltip;	2687	package CFClient::UI::Tooltip;
…		…
2327	@_,	2697	@_,
2328	can_events => 0,	2698	can_events => 0,
2329	)	2699	)
2330	}	2700	}
2331		2701
2332	sub set_markup {	2702	sub set_tooltip_from {
2333	my ($self, $text) = @_;	2703	my ($self, $widget) = @_;
2334		2704
2335	$self->{label} ||= new CFClient::UI::Label fontsize => 0.8, fg => [0, 0, 0];	2705	my $tooltip = $widget->{tooltip};
2336	$self->{label}->set_markup ($text);	2706
2337	$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	);
2338	}	2722	}
2339		2723
2340	sub size_request {	2724	sub size_request {
2341	my ($self) = @_;	2725	my ($self) = @_;
2342
2343	$self->child->set_max_size ($::WIDTH * 0.3);
2344		2726
2345	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2727	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2346		2728
2347	($w + 4, $h + 4)	2729	($w + 4, $h + 4)
2348	}	2730	}
…		…
2351	my ($self, $w, $h) = @_;	2733	my ($self, $w, $h) = @_;
2352		2734
2353	$self->SUPER::size_allocate ($w - 4, $h - 4);	2735	$self->SUPER::size_allocate ($w - 4, $h - 4);
2354	}	2736	}
2355		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
2356	sub _draw {	2756	sub _draw {
2357	my ($self) = @_;	2757	my ($self) = @_;
2358		2758
2359	glPushMatrix;
2360	glTranslate 0.375, 0.375;	2759	glTranslate 0.375, 0.375;
2361		2760
2362	my ($w, $h) = @$self{qw(w h)};	2761	my ($w, $h) = @$self{qw(w h)};
2363		2762
2364	glColor 1, 0.8, 0.4;	2763	glColor 1, 0.8, 0.4;
…		…
2375	glVertex 0 , $h;	2774	glVertex 0 , $h;
2376	glVertex $w, $h;	2775	glVertex $w, $h;
2377	glVertex $w, 0;	2776	glVertex $w, 0;
2378	glEnd;	2777	glEnd;
2379		2778
2380	glPopMatrix;	2779	glTranslate 2 - 0.375, 2 - 0.375;
2381		2780
2382	glTranslate 2, 2;
2383	$self->SUPER::_draw;	2781	$self->SUPER::_draw;
2384	}	2782	}
2385		2783
2386	#############################################################################	2784	#############################################################################
2387		2785
…		…
2392	use CFClient::OpenGL;	2790	use CFClient::OpenGL;
2393		2791
2394	sub new {	2792	sub new {
2395	my $class = shift;	2793	my $class = shift;
2396		2794
2397	$class->SUPER::new (	2795	my $self = $class->SUPER::new (
2398	aspect => 1,	2796	aspect => 1,
		2797	can_events => 0,
2399	@_,	2798	@_,
2400	)	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
2401	}	2816	}
2402		2817
2403	sub size_request {	2818	sub size_request {
2404	(32, 8)	2819	(32, 8)
2405	}	2820	}
2406		2821
		2822	sub update {
		2823	my ($self) = @_;
		2824
		2825	return unless $self->{visible};
		2826
		2827	$self->SUPER::update;
		2828	}
		2829
2407	sub _draw {	2830	sub _draw {
2408	my ($self) = @_;	2831	my ($self) = @_;
2409		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
2410	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	2844	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2411		2845
2412	# TODO animation
2413	if ($tex) {	2846	if ($tex) {
2414	glEnable GL_BLEND;
2415	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2416	glEnable GL_TEXTURE_2D;	2847	glEnable GL_TEXTURE_2D;
2417	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2848	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2418	glColor 1, 1, 1, 1;	2849	glColor 1, 1, 1, 1;
2419	$tex->draw_quad (0, 0, $self->{w}, $self->{h});	2850	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2420	glDisable GL_TEXTURE_2D;	2851	glDisable GL_TEXTURE_2D;
2421	glDisable GL_BLEND;
2422	}	2852	}
2423	}	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.
2424		2871
2425	#############################################################################	2872	#############################################################################
2426		2873
2427	package CFClient::UI::Menu;	2874	package CFClient::UI::Menu;
2428		2875
…		…
2462		2909
2463	# popup given the event (must be a mouse button down event currently)	2910	# popup given the event (must be a mouse button down event currently)
2464	sub popup {	2911	sub popup {
2465	my ($self, $ev) = @_;	2912	my ($self, $ev) = @_;
2466		2913
2467	$self->emit ("popdown");	2914	$self->_emit ("popdown");
2468		2915
2469	# maybe save $GRAB? must be careful about events...	2916	# maybe save $GRAB? must be careful about events...
2470	$GRAB = $self;	2917	$GRAB = $self;
2471	$self->{button} = $ev->{button};	2918	$self->{button} = $ev->{button};
2472		2919
2473	$self->show;	2920	$self->show;
2474	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2921	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2475	}	2922	}
2476		2923
2477	sub mouse_motion {	2924	sub mouse_motion {
2478	my ($self, $ev, $x, $y) = @_;	2925	my ($self, $ev, $x, $y) = @_;
2479		2926
2480	# TODO: should use vbox->fdind_widget or so	2927	# TODO: should use vbox->find_widget or so
2481	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2928	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2482	$self->{hover} = $self->{item}{$HOVER};	2929	$self->{hover} = $self->{item}{$HOVER};
		2930
		2931	0
2483	}	2932	}
2484		2933
2485	sub button_up {	2934	sub button_up {
2486	my ($self, $ev, $x, $y) = @_;	2935	my ($self, $ev, $x, $y) = @_;
2487		2936
2488	if ($ev->{button} == $self->{button}) {	2937	if ($ev->{button} == $self->{button}) {
2489	undef $GRAB;	2938	undef $GRAB;
2490	$self->hide;	2939	$self->hide;
2491		2940
2492	$self->emit ("popdown");	2941	$self->_emit ("popdown");
2493	$self->{hover}[1]->() if $self->{hover};	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;
2494	}	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;
2495	}	3460	}
2496		3461
2497	#############################################################################	3462	#############################################################################
2498		3463
2499	package CFClient::UI::Root;	3464	package CFClient::UI::Root;
2500		3465
2501	our @ISA = CFClient::UI::Container::;	3466	our @ISA = CFClient::UI::Container::;
2502		3467
2503	use CFClient::OpenGL;	3468	use CFClient::OpenGL;
2504		3469
2505	sub check_size {	3470	sub new {
2506	my ($self) = @_;	3471	my $class = shift;
2507		3472
2508	$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
2509	}	3481	}
2510		3482
2511	sub size_request {	3483	sub size_request {
2512	($::WIDTH, $::HEIGHT)	3484	my ($self) = @_;
2513	}
2514		3485
2515	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 {
2516	my ($self, $x, $y, $w, $h) = @_;	3504	my ($self, $w, $h) = @_;
2517		3505
2518	$self->SUPER::configure ($x, $y, $w, $h);
2519
2520	for my $child (@{$self->{children}}) {	3506	for my $child ($self->children) {
2521	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)};
2522		3508
2523	$X = List::Util::max 0, List::Util::min $w - $W, $X;	3509	$X = $child->{force_x} if exists $child->{force_x};
2524	$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
2525	$child->configure ($X, $Y, $W,$H);	3515	$child->configure ($X, $Y, $W, $H);
2526	}	3516	}
2527	}	3517	}
2528		3518
2529	sub _topleft {	3519	sub coord2local {
2530	my ($self, $x, $y) = @_;	3520	my ($self, $x, $y) = @_;
2531		3521
2532	($x, $y)	3522	($x, $y)
2533	}	3523	}
2534		3524
		3525	sub coord2global {
		3526	my ($self, $x, $y) = @_;
		3527
		3528	($x, $y)
		3529	}
		3530
2535	sub update {	3531	sub update {
2536	my ($self) = @_;	3532	my ($self) = @_;
2537		3533
2538	$self->check_size;	3534	$::WANT_REFRESH++;
2539	::refresh ();
2540	}	3535	}
2541		3536
2542	sub add {	3537	sub add {
2543	my ($self, $child) = @_;	3538	my ($self, @children) = @_;
2544		3539
2545	# integerize window positions	3540	$_->{is_toplevel} = 1
2546	$child->{x} = int $child->{x};	3541	for @children;
2547	$child->{y} = int $child->{y};
2548		3542
2549	$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	}
2550	}	3559	}
2551		3560
2552	sub on_refresh {	3561	sub on_refresh {
2553	my ($self, $id, $cb) = @_;	3562	my ($self, $id, $cb) = @_;
2554		3563
2555	$self->{refresh_hook}{$id} = $cb;	3564	$self->{refresh_hook}{$id} = $cb;
2556	}	3565	}
2557		3566
		3567	sub on_post_alloc {
		3568	my ($self, $id, $cb) = @_;
		3569
		3570	$self->{post_alloc_hook}{$id} = $cb;
		3571	}
		3572
2558	sub draw {	3573	sub draw {
2559	my ($self) = @_;	3574	my ($self) = @_;
2560		3575
2561	while (my $rcb = delete $self->{refresh_hook}) {	3576	while ($self->{refresh_hook}) {
2562	$_->() for values %$rcb;	3577	$_->()
		3578	for values %{delete $self->{refresh_hook}};
2563	}	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
2564		3669
2565	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3670	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2566	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3671	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2567	glClear GL_COLOR_BUFFER_BIT;	3672	glClear GL_COLOR_BUFFER_BIT;
2568		3673
2569	glMatrixMode GL_PROJECTION;	3674	glMatrixMode GL_PROJECTION;
2570	glLoadIdentity;	3675	glLoadIdentity;
2571	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;	3676	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2572	glMatrixMode GL_MODELVIEW;	3677	glMatrixMode GL_MODELVIEW;
2573	glLoadIdentity;	3678	glLoadIdentity;
2574		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
2575	$self->_draw;	3687	$self->_draw;
2576	}	3688	}
2577		3689
2578	#############################################################################	3690	#############################################################################
2579		3691
2580	package CFClient::UI::Inventory;
2581
2582	our @ISA = CFClient::UI::Container::;
2583
2584	use CFClient::OpenGL;
2585
2586	sub new {
2587	my $class = shift;
2588
2589	my $self = $class->SUPER::new (@_);
2590
2591	$self
2592	}
2593
2594	sub size_allocate {
2595	my ($self, $w, $h) = @_;
2596
2597	$self->{w} = $w;
2598	$self->{h} = $h;
2599
2600	$self->check_size;
2601	}
2602
2603	sub set_items {
2604	my ($self, $items) = @_;
2605	my @items = values %{$items};
2606	@items = sort { $a->{type} <=> $b->{type} } @items;
2607
2608	$self->{real_items} = \@items;
2609
2610	for my $item (@items) {
2611	my $desc = $item->{nrof} < 2
2612	? $item->{name}
2613	: "$item->{nrof} $item->{name_pl}";
2614
2615	$self->add (my $hb = new CFClient::UI::HBox);
2616
2617	$hb->add (my $f = new CFClient::UI::Face
2618	can_events => 0,
2619	face => $item->{face},
2620	anim => $item->{anim},
2621	animspeed => $item->{animspeed},
2622	expand => 1
2623	);
2624	$hb->add (new CFClient::UI::Label text => $desc, expand => 1);
2625	}
2626
2627	$self->{max_pos} = (scalar @items) - 1;
2628
2629	my $range = $self->{range};
2630	my $page = $self->{h} / 32; # waht information souce to use for face size?
2631	# it should be configurable i guess...
2632	$range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2633	$range->update;
2634	}
2635
2636	sub size_request {
2637	my ($self) = @_;
2638	(100, 200)
2639	}
2640
2641	sub set_range {
2642	my ($self, $range) = @_;
2643
2644	$self->{range} = $range;
2645	$range->connect (changed => sub { $self->update });
2646
2647	my $page = $self->{h} / 32; # waht information souce to use for face size?
2648	# it should be configurable i guess...
2649
2650	$range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2651	$range->update;
2652
2653	$self->update;
2654	}
2655
2656	sub _draw {
2657	my ($self) = @_;
2658
2659	my ($w, $h) = ($self->{w}, $self->{h});
2660
2661	$self->{pos} = int $self->{range}{range}[0];
2662
2663	my $y = 0;
2664	my $cnt = 0;
2665	my $hrem = $self->{h}; # horiz. remaining space
2666
2667	for (my $i = $self->{pos}; $i < @{$self->{children} || []}; $i++) {
2668	my $chld = $self->{children}->[$i];
2669
2670	if ($hrem >= $chld->{h}) {
2671	$chld->configure (0, $y, $chld->{w}, $chld->{h});
2672
2673	$chld->show;
2674	$chld->draw;
2675
2676	$hrem -= $chld->{h};
2677	$y += $chld->{h};
2678	} else {
2679	last
2680	}
2681	}
2682	}
2683
2684
2685	#############################################################################
2686
2687	package CFClient::UI;	3692	package CFClient::UI;
2688		3693
2689	$ROOT = new CFClient::UI::Root;	3694	$ROOT = new CFClient::UI::Root;
2690	$TOOLTIP = new CFClient::UI::Tooltip;	3695	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2691		3696
2692	1	3697	1
2693		3698

Diff Legend

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