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.187 by root, Mon May 8 20:40:31 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	$self->emit (size_allocate => $w, $h);
243	}	368	}
244	}	369	}
245		370
246	sub size_allocate {	371	sub size_allocate {
247	# nothing to be done	372	# nothing to be done
248	}	373	}
249		374
250	sub children {	375	sub children {
		376	# nop
251	}	377	}
252		378
253	# call when resolution changes etc.	379	sub visible_children {
254	sub reconfigure {	380	$_[0]->children
255	my ($self) = @_;
256
257	$_->reconfigure
258	for $self->children;
259
260	$self->check_size;
261	$self->size_allocate ($self->{w}, $self->{h});
262	$self->update;
263	}	381	}
264		382
265	sub set_max_size {	383	sub set_max_size {
266	my ($self, $w, $h) = @_;	384	my ($self, $w, $h) = @_;
267		385
268	delete $self->{max_w}; $self->{max_w} = $w if $w;	386	delete $self->{max_w}; $self->{max_w} = $w if $w;
269	delete $self->{max_h}; $self->{max_h} = $h if $h;	387	delete $self->{max_h}; $self->{max_h} = $h if $h;
270	}	388	}
271		389
272	# return top left coordinates	390	sub set_tooltip {
273	sub _topleft {
274	my ($self, $x, $y) = @_;	391	my ($self, $tooltip) = @_;
275		392
276	$self->{parent}	393	$tooltip =~ s/^\s+//;
277	or Carp::confess "no parent widget in _topleft\n";#d#	394	$tooltip =~ s/\s+$//;
278		395
279	$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	}
280	}	404	}
281		405
282	# translate global coordinates to local coordinate system	406	# translate global coordinates to local coordinate system
283	sub coord2local {	407	sub coord2local {
284	my ($self, $x, $y) = @_;	408	my ($self, $x, $y) = @_;
285		409
286	my ($X, $Y) = $self->_topleft;	410	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
287	($x - $X, $y - $Y)
288	}	411	}
289		412
290	# translate local coordinates to global coordinate system	413	# translate local coordinates to global coordinate system
291	sub coord2global {	414	sub coord2global {
292	my ($self, $x, $y) = @_;	415	my ($self, $x, $y) = @_;
293		416
294	my ($X, $Y) = $self->_topleft;	417	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
295	($x + $X, $y + $Y)
296	}	418	}
297		419
298	sub focus_in {	420	sub focus_in {
299	my ($self) = @_;	421	my ($self) = @_;
300		422
301	return if $FOCUS == $self;	423	return if $FOCUS == $self;
302	return unless $self->{can_focus};	424	return unless $self->{can_focus};
303		425
304	my $focus = $FOCUS; $FOCUS = $self;	426	my $focus = $FOCUS; $FOCUS = $self;
305		427
306	$self->emit (focus_in => $focus);	428	$self->_emit (focus_in => $focus);
307		429
308	$focus->update if $focus;	430	$focus->update if $focus;
309	$FOCUS->update;	431	$FOCUS->update;
310	}	432	}
311		433
…		…
314		436
315	return unless $FOCUS == $self;	437	return unless $FOCUS == $self;
316		438
317	my $focus = $FOCUS; undef $FOCUS;	439	my $focus = $FOCUS; undef $FOCUS;
318		440
319	$self->emit (focus_out => $focus);	441	$self->_emit (focus_out => $focus);
320		442
321	$focus->update if $focus; #?	443	$focus->update if $focus; #?
322	}
323		444
		445	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		446	unless $FOCUS;
		447	}
		448
324	sub mouse_motion { }	449	sub mouse_motion { 0 }
325	sub button_up { }	450	sub button_up { 0 }
326	sub key_down { }	451	sub key_down { 0 }
327	sub key_up { }	452	sub key_up { 0 }
328		453
329	sub button_down {	454	sub button_down {
330	my ($self, $ev, $x, $y) = @_;	455	my ($self, $ev, $x, $y) = @_;
331		456
332	$self->focus_in;	457	$self->focus_in;
333	}
334		458
335	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	459	0
336	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	460	}
337	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	461
338	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	462	sub find_widget {
339	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
340		535
341	sub draw {	536	sub draw {
342	my ($self) = @_;	537	my ($self) = @_;
343		538
344	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);
345		550
346	glPushMatrix;	551	glPushMatrix;
347	glTranslate $self->{x}, $self->{y}, 0;	552	glTranslate $self->{x}, $self->{y}, 0;
348	$self->_draw;	553	$self->_draw;
349	glPopMatrix;	554	glPopMatrix;
…		…
361	glVertex $x , $y + $self->{h};	566	glVertex $x , $y + $self->{h};
362	glEnd;	567	glEnd;
363	glDisable GL_BLEND;	568	glDisable GL_BLEND;
364	}	569	}
365		570
366	if ($ENV{PCLIENT_DEBUG}) {	571	if ($ENV{CFPLUS_DEBUG} & 1) {
367	glPushMatrix;	572	glPushMatrix;
368	glColor 1, 1, 0, 1;	573	glColor 1, 1, 0, 1;
369	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	574	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
370	glBegin GL_LINE_LOOP;	575	glBegin GL_LINE_LOOP;
371	glVertex 0 , 0;	576	glVertex 0 , 0;
372	glVertex $self->{w}, 0;	577	glVertex $self->{w} - 1, 0;
373	glVertex $self->{w}, $self->{h};	578	glVertex $self->{w} - 1, $self->{h} - 1;
374	glVertex 0 , $self->{h};	579	glVertex 0 , $self->{h} - 1;
375	glEnd;	580	glEnd;
376	glPopMatrix;	581	glPopMatrix;
377	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;
378	}	583	}
379	}	584	}
380		585
381	sub _draw {	586	sub _draw {
382	my ($self) = @_;	587	my ($self) = @_;
383		588
384	warn "no draw defined for $self\n";	589	warn "no draw defined for $self\n";
385	}	590	}
386		591
387	sub find_widget {
388	my ($self, $x, $y) = @_;
389
390	return () unless $self->{can_events};
391
392	return $self
393	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
394	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
395
396	()
397	}
398
399	sub set_parent {
400	my ($self, $parent) = @_;
401
402	Scalar::Util::weaken ($self->{parent} = $parent);
403	}
404
405	sub check_size {
406	my ($self) = @_;
407
408	$self->{parent}
409	or return 1;
410
411	my ($w, $h) = $self->{user_w} && $self->{user_h}
412	? @$self{qw(user_w user_h)}
413	: $self->size_request;
414
415	if ($w != $self->{req_w} || $h != $self->{req_h}) {
416	$self->{req_w} = $w;
417	$self->{req_h} = $h;
418
419	$self->{parent}->check_size
420	or $self->size_allocate (
421	(List::Util::max $self->{w}, $w),
422	(List::Util::max $self->{h}, $h),
423	);
424
425	1
426	} else {
427	0
428	}
429	}
430
431	sub update {
432	my ($self) = @_;
433
434	$self->{parent}->update
435	if $self->{parent};
436	}
437
438	sub connect {
439	my ($self, $signal, $cb) = @_;
440
441	push @{ $self->{signal_cb}{$signal} }, $cb;
442	}
443
444	sub emit {
445	my ($self, $signal, @args) = @_;
446
447	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
448	}
449
450	sub DESTROY {	592	sub DESTROY {
451	my ($self) = @_;	593	my ($self) = @_;
452		594
		595	delete $WIDGET{$self+0};
453	#$self->deactivate;	596	#$self->deactivate;
454	}	597	}
455		598
456	#############################################################################	599	#############################################################################
457		600
…		…
466	my $class = shift;	609	my $class = shift;
467		610
468	# range [value, low, high, page]	611	# range [value, low, high, page]
469		612
470	$class->SUPER::new (	613	$class->SUPER::new (
471	bg => [0, 0, 0, 0.2],	614	#bg => [0, 0, 0, 0.2],
472	active_bg => [1, 1, 1, 0.5],	615	#active_bg => [1, 1, 1, 0.5],
473	@_	616	@_
474	)	617	)
475	}	618	}
476		619
477	sub _draw {	620	sub _draw {
478	my ($self) = @_;	621	my ($self) = @_;
479		622
		623	my $color = $FOCUS == $self && $self->{active_bg}
		624	? $self->{active_bg}
		625	: $self->{bg};
		626
		627	if ($color && (@$color < 4 || $color->[3])) {
480	my ($w, $h) = @$self{qw(w h)};	628	my ($w, $h) = @$self{qw(w h)};
481		629
482	glEnable GL_BLEND;	630	glEnable GL_BLEND;
483	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	631	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
484	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	632	glColor @$color;
485		633
486	glBegin GL_QUADS;	634	glBegin GL_QUADS;
487	glVertex 0 , 0;	635	glVertex 0 , 0;
488	glVertex 0 , $h;	636	glVertex 0 , $h;
489	glVertex $w, $h;	637	glVertex $w, $h;
490	glVertex $w, 0;	638	glVertex $w, 0;
491	glEnd;	639	glEnd;
492		640
493	glDisable GL_BLEND;	641	glDisable GL_BLEND;
		642	}
494	}	643	}
495		644
496	#############################################################################	645	#############################################################################
497		646
498	package CFClient::UI::Empty;	647	package CFClient::UI::Empty;
…		…
503	my ($class, %arg) = @_;	652	my ($class, %arg) = @_;
504	$class->SUPER::new (can_events => 0, %arg);	653	$class->SUPER::new (can_events => 0, %arg);
505	}	654	}
506		655
507	sub size_request {	656	sub size_request {
508	(0, 0)	657	my ($self) = @_;
		658
		659	($self->{w} + 0, $self->{h} + 0)
509	}	660	}
510		661
511	sub draw { }	662	sub draw { }
512		663
513	#############################################################################	664	#############################################################################
…		…
517	our @ISA = CFClient::UI::Base::;	668	our @ISA = CFClient::UI::Base::;
518		669
519	sub new {	670	sub new {
520	my ($class, %arg) = @_;	671	my ($class, %arg) = @_;
521		672
522	my $children = delete $arg{children} || [];	673	my $children = delete $arg{children};
523		674
524	my $self = $class->SUPER::new (	675	my $self = $class->SUPER::new (
525	children => [],	676	children => [],
526	can_events => 0,	677	can_events => 0,
527	%arg,	678	%arg,
528	);	679	);
		680
529	$self->add ($_) for @$children;	681	$self->add (@$children)
		682	if $children;
530		683
531	$self	684	$self
532	}	685	}
533		686
534	sub add {	687	sub add {
535	my ($self, $child) = @_;	688	my ($self, @widgets) = @_;
536		689
537	$child->set_parent ($self);	690	$_->set_parent ($self)
		691	for @widgets;
538		692
539	use sort 'stable';	693	use sort 'stable';
540		694
541	$self->{children} = [	695	$self->{children} = [
542	sort { $a->{z} <=> $b->{z} }	696	sort { $a->{z} <=> $b->{z} }
543	@{$self->{children}}, $child	697	@{$self->{children}}, @widgets
544	];	698	];
545		699
546	$child->check_size;	700	$self->realloc;
547	$self->update;
548	}	701	}
549		702
550	sub children {	703	sub children {
551	@{ $_[0]{children} }	704	@{ $_[0]{children} }
552	}	705	}
…		…
557	delete $child->{parent};	710	delete $child->{parent};
558	$child->hide;	711	$child->hide;
559		712
560	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	713	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
561		714
562	$self->check_size;	715	$self->realloc;
563	$self->update;
564	}	716	}
565		717
566	sub clear {	718	sub clear {
567	my ($self) = @_;	719	my ($self) = @_;
568		720
…		…
572	for (@$children) {	724	for (@$children) {
573	delete $_->{parent};	725	delete $_->{parent};
574	$_->hide;	726	$_->hide;
575	}	727	}
576		728
577	$self->check_size;	729	$self->realloc;
578	$self->update;
579	}	730	}
580		731
581	sub find_widget {	732	sub find_widget {
582	my ($self, $x, $y) = @_;	733	my ($self, $x, $y) = @_;
583		734
584	$x -= $self->{x};	735	$x -= $self->{x};
585	$y -= $self->{y};	736	$y -= $self->{y};
586		737
587	my $res;	738	my $res;
588		739
589	for (reverse @{ $self->{children} }) {	740	for (reverse $self->visible_children) {
590	$res = $_->find_widget ($x, $y)	741	$res = $_->find_widget ($x, $y)
591	and return $res;	742	and return $res;
592	}	743	}
593		744
594	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	745	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
658	}	809	}
659		810
660	sub update {	811	sub update {
661	my ($self) = @_;	812	my ($self) = @_;
662		813
663	$ROOT->on_refresh ($self => sub { $self->render_child });	814	$ROOT->on_post_alloc ($self => sub { $self->render_child });
664	$self->SUPER::update;	815	$self->SUPER::update;
665	}	816	}
666		817
667	sub size_allocate {	818	sub size_allocate {
668	my ($self, $w, $h) = @_;	819	my ($self, $w, $h) = @_;
…		…
670	$self->SUPER::size_allocate ($w, $h);	821	$self->SUPER::size_allocate ($w, $h);
671	$self->update;	822	$self->update;
672	}	823	}
673		824
674	sub _render {	825	sub _render {
		826	my ($self) = @_;
		827
675	$_[0]{children}[0]->draw;	828	$self->{children}[0]->draw;
676	}	829	}
677		830
678	sub render_child {	831	sub render_child {
679	my ($self) = @_;	832	my ($self) = @_;
680		833
681	$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 {
682	glClearColor 0, 0, 0, 0;	835	glClearColor 0, 0, 0, 0;
683	glClear GL_COLOR_BUFFER_BIT;	836	glClear GL_COLOR_BUFFER_BIT;
684		837
		838	{
		839	package CFClient::UI::Base;
		840
		841	($draw_x, $draw_y, $draw_w, $draw_h) =
		842	(0, 0, $self->{w}, $self->{h});
		843	}
		844
685	$self->_render;	845	$self->_render;
686	# glColorMask 1, 1, 1, 0;
687	# glEnable GL_BLEND;
688	# glBlendFunc GL_SRC_ALPHA, GL_ZERO;
689	# glRasterPos 0, 0;
690	# glCopyPixels 0, 0, $self->{w}, $self->{h};
691	# glDisable GL_BLEND;
692	# glColorMask 1, 1, 1, 1;
693	};	846	};
694	}	847	}
695		848
696	sub _draw {	849	sub _draw {
697	my ($self) = @_;	850	my ($self) = @_;
698		851
699	my ($w, $h) = ($self->w, $self->h);	852	my ($w, $h) = @$self{qw(w h)};
700		853
701	my $tex = $self->{texture}	854	my $tex = $self->{texture}
702	or return;	855	or return;
703		856
704	glEnable GL_BLEND;
705	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
706	glEnable GL_TEXTURE_2D;	857	glEnable GL_TEXTURE_2D;
707	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	858	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
708	glColor 0, 0, 0, 1;	859	glColor 1, 1, 1, 1;
709		860
710	$tex->draw_quad (0, 0, $w, $h);	861	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
711		862
712	glDisable GL_BLEND;
713	glDisable GL_TEXTURE_2D;	863	glDisable GL_TEXTURE_2D;
714	}	864	}
715		865
716	#############################################################################	866	#############################################################################
717		867
718	package CFClient::UI::ViewPort;	868	package CFClient::UI::ViewPort;
719		869
720	our @ISA = CFClient::UI::Window::;	870	our @ISA = CFClient::UI::Window::;
721		871
		872	sub new {
		873	my $class = shift;
		874
		875	$class->SUPER::new (
		876	scroll_x => 0,
		877	scroll_y => 1,
		878	@_,
		879	)
		880	}
		881
722	sub size_request {	882	sub size_request {
723	my ($self) = @_;	883	my ($self) = @_;
724		884
725	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	885	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
726	$self->child->configure (0, 0, @$self{qw(child_w child_h)});
727		886
728	@$self{qw(child_w child_h)}	887	$w = 10 if $self->{scroll_x};
		888	$h = 10 if $self->{scroll_y};
		889
		890	($w, $h)
729	}	891	}
730		892
731	sub size_allocate {	893	sub size_allocate {
732	my ($self, $w, $h) = @_;	894	my ($self, $w, $h) = @_;
733		895
		896	my $child = $self->child;
		897
		898	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
		899	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
		900
		901	$self->child->configure (0, 0, $w, $h);
734	$self->update;	902	$self->update;
735	}	903	}
736		904
737	sub set_offset {	905	sub set_offset {
738	my ($self, $x, $y) = @_;	906	my ($self, $x, $y) = @_;
…		…
741	$self->{view_y} = int $y;	909	$self->{view_y} = int $y;
742		910
743	$self->update;	911	$self->update;
744	}	912	}
745		913
746	# hmm, this does not work for topleft of $self... but we should not aks for that	914	# hmm, this does not work for topleft of $self... but we should not ask for that
747	sub _topleft {	915	sub coord2local {
748	my ($self, $x, $y) = @_;	916	my ($self, $x, $y) = @_;
749		917
750	$self->SUPER::_topleft ($x - $self->{view_x}, $y - $self->{view_y})	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)
751	}	928	}
752		929
753	sub find_widget {	930	sub find_widget {
754	my ($self, $x, $y) = @_;	931	my ($self, $x, $y) = @_;
755		932
…		…
763	}	940	}
764		941
765	sub _render {	942	sub _render {
766	my ($self) = @_;	943	my ($self) = @_;
767		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
768	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	948	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
769		949
770	$self->SUPER::_render;	950	$self->SUPER::_render;
771	}	951	}
772		952
…		…
780	my $class = shift;	960	my $class = shift;
781		961
782	my $self;	962	my $self;
783		963
784	my $slider = new CFClient::UI::Slider	964	my $slider = new CFClient::UI::Slider
785	vertical => 1,	965	vertical => 1,
786	range => [0, 0, 1, 0.01], # HACK fix	966	range => [0, 0, 1, 0.01], # HACK fix
787	connect_changed => sub {	967	on_changed => sub {
788	$self->{vp}->set_offset (0, $_[1] * ($self->{vp}{child_h} - $self->{vp}{h}));	968	$self->{vp}->set_offset (0, $_[1]);
789	},	969	},
790	;	970	;
791		971
792	$self = $class->SUPER::new (	972	$self = $class->SUPER::new (
793	vp => (new CFClient::UI::ViewPort),	973	vp => (new CFClient::UI::ViewPort expand => 1),
794	slider => $slider,	974	slider => $slider,
795	@_,	975	@_,
796	);	976	);
797		977
798	$self->{vp}->add ($self->{scrolled});	978	$self->{vp}->add ($self->{scrolled});
…		…
800	$self->add ($self->{slider});	980	$self->add ($self->{slider});
801		981
802	$self	982	$self
803	}	983	}
804		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
805	#TODO# update range on size_allocate depeneing on child	1004	#TODO# update range on size_allocate depending on child
806	# update viewport offset on scroll	1005	# update viewport offset on scroll
807		1006
808	#############################################################################	1007	#############################################################################
809		1008
810	package CFClient::UI::Frame;	1009	package CFClient::UI::Frame;
…		…
814	use CFClient::OpenGL;	1013	use CFClient::OpenGL;
815		1014
816	sub new {	1015	sub new {
817	my $class = shift;	1016	my $class = shift;
818		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};
		1067
819	my $self = $class->SUPER::new (	1068	my $self = $class->SUPER::new (
820	bg => [1, 1, 1, 1],	1069	bg => [1, 1, 1, 1],
821	border_bg => [1, 1, 1, 1],	1070	border_bg => [1, 1, 1, 1],
822	border => 0.8,	1071	border => 0.6,
823	@_	1072	can_events => 1,
		1073	min_w => 16,
		1074	min_h => 16,
		1075	%arg,
824	);	1076	);
825		1077
826	$self
827	}
828
829	sub _draw {
830	my ($self) = @_;
831
832	my ($w, $h) = ($self->{w}, $self->{h});
833
834	glEnable GL_BLEND;
835	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
836	glEnable GL_TEXTURE_2D;
837	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
838
839	# glBegin GL_QUADS;
840	# glColor 0, 0, 0, 0;
841	# glVertex 0 , 0;
842	# glVertex 0 , $h;
843	# glVertex $w, $h;
844	# glVertex $w, 0;
845	# glEnd;
846
847
848	$self->child->draw;
849	glDisable GL_BLEND;
850	glDisable GL_TEXTURE_2D;
851	}
852
853	#############################################################################
854
855	package CFClient::UI::FancyFrame;
856
857	our @ISA = CFClient::UI::Bin::;
858
859	use CFClient::OpenGL;
860
861	my @tex =
862	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
863	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
864
865	sub new {
866	my $class = shift;
867
868	# TODO: user_x, user_y, overwrite moveto?
869
870	my $self = $class->SUPER::new (
871	bg => [1, 1, 1, 1],
872	border_bg => [1, 1, 1, 1],
873	border => 0.6,
874	can_events => 1,
875	@_
876	);
877
878	$self->{title} &&= new CFClient::UI::Label	1078	$self->{title} = new CFClient::UI::Label
879	align => 0,	1079	align => 0,
880	valign => 1,	1080	valign => 1,
881	text => $self->{title},	1081	text => $title,
882	fontsize => $self->{border};	1082	fontsize => $self->{border}
		1083	if defined $title;
883		1084
884	$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};
885	}	1093	}
886		1094
887	sub border {	1095	sub border {
888	int $_[0]{border} * $::FONTSIZE	1096	int $_[0]{border} * $::FONTSIZE
889	}	1097	}
890		1098
891	sub size_request {	1099	sub size_request {
892	my ($self) = @_;	1100	my ($self) = @_;
		1101
		1102	$self->{title}->size_request
		1103	if $self->{title};
893		1104
894	my ($w, $h) = $self->SUPER::size_request;	1105	my ($w, $h) = $self->SUPER::size_request;
895		1106
896	(	1107	(
897	$w + $self->border * 2,	1108	$w + $self->border * 2,
…		…
900	}	1111	}
901		1112
902	sub size_allocate {	1113	sub size_allocate {
903	my ($self, $w, $h) = @_;	1114	my ($self, $w, $h) = @_;
904		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
905	$h -= List::Util::max 0, $self->border * 2;	1124	$h -= List::Util::max 0, $border * 2;
906	$w -= List::Util::max 0, $self->border * 2;	1125	$w -= List::Util::max 0, $border * 2;
907		1126
908	$self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)
909	if $self->{title};
910
911	$self->child->configure ($self->border, $self->border, $w, $h);	1127	$self->child->configure ($border, $border, $w, $h);
912	}	1128	}
913		1129
914	sub button_down {	1130	sub button_down {
915	my ($self, $ev, $x, $y) = @_;	1131	my ($self, $ev, $x, $y) = @_;
916		1132
…		…
932	my ($ev, $x, $y) = @_;	1148	my ($ev, $x, $y) = @_;
933		1149
934	my $dx = $ev->{x} - $ox;	1150	my $dx = $ev->{x} - $ox;
935	my $dy = $ev->{y} - $oy;	1151	my $dy = $ev->{y} - $oy;
936		1152
937	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1153	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
938	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1154	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1155
		1156	$self->realloc;
939	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1157	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
940	$self->check_size;
941	};	1158	};
942		1159
943	} elsif ($lr ^ $td) {	1160	} elsif ($lr ^ $td) {
944	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1161	my ($ox, $oy) = ($ev->{x}, $ev->{y});
945	my ($bx, $by) = ($self->{x}, $self->{y});	1162	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
947	$self->{motion} = sub {	1164	$self->{motion} = sub {
948	my ($ev, $x, $y) = @_;	1165	my ($ev, $x, $y) = @_;
949		1166
950	($x, $y) = ($ev->{x}, $ev->{y});	1167	($x, $y) = ($ev->{x}, $ev->{y});
951		1168
952	$self->move ($bx + $x - $ox, $by + $y - $oy);	1169	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
953	$self->update;
954	};	1170	};
		1171	} else {
		1172	return 0;
		1173	}
		1174
955	}	1175	1
956	}	1176	}
957		1177
958	sub button_up {	1178	sub button_up {
959	my ($self, $ev, $x, $y) = @_;	1179	my ($self, $ev, $x, $y) = @_;
960		1180
961	delete $self->{motion};	1181	!!delete $self->{motion}
962	}	1182	}
963		1183
964	sub mouse_motion {	1184	sub mouse_motion {
965	my ($self, $ev, $x, $y) = @_;	1185	my ($self, $ev, $x, $y) = @_;
966		1186
967	$self->{motion}->($ev, $x, $y) if $self->{motion};	1187	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1188
		1189	!!$self->{motion}
968	}	1190	}
969		1191
970	sub _draw {	1192	sub _draw {
971	my ($self) = @_;	1193	my ($self) = @_;
972		1194
		1195	my $child = $self->{children}[0];
		1196
973	my ($w, $h ) = ($self->{w}, $self->{h});	1197	my ($w, $h ) = ($self->{w}, $self->{h});
974	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1198	my ($cw, $ch) = ($child->{w}, $child->{h});
975		1199
976	glEnable GL_BLEND;
977	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
978	glEnable GL_TEXTURE_2D;	1200	glEnable GL_TEXTURE_2D;
979	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1201	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
980		1202
981	my $border = $self->border;	1203	my $border = $self->border;
982		1204
983	glColor @{ $self->{border_bg} };	1205	glColor @{ $self->{border_bg} };
984	$tex[1]->draw_quad (0, 0, $w, $border);	1206	$border[0]->draw_quad_alpha (0, 0, $w, $border);
985	$tex[3]->draw_quad (0, $border, $border, $ch);	1207	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
986	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	1208	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
987	$tex[4]->draw_quad (0, $h - $border, $w, $border);	1209	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
988		1210
989	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1211	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
990	my $bg = $tex[0];	1212	glColor @{ $self->{bg} };
991		1213
992	# TODO: repeat texture not scale	1214	# TODO: repeat texture not scale
		1215	# solve this better(?)
993	my $rep_x = $cw / $bg->{w};	1216	$bg->{s} = $cw / $bg->{w};
994	my $rep_y = $ch / $bg->{h};	1217	$bg->{t} = $ch / $bg->{h};
995
996	glColor @{ $self->{bg} };
997
998	$bg->{s} = $rep_x;
999	$bg->{t} = $rep_y;
1000	$bg->{wrap_mode} = 1;
1001	$bg->draw_quad ($border, $border, $cw, $ch);	1218	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
		1219	}
1002		1220
1003	glDisable GL_TEXTURE_2D;	1221	glDisable GL_TEXTURE_2D;
1004	glDisable GL_BLEND;
1005	}
1006		1222
1007	$self->{title}->draw if $self->{title};
1008
1009	$self->child->draw;	1223	$child->draw;
		1224
		1225	if ($self->{title}) {
		1226	glTranslate 0, $border - $self->{h};
		1227	$self->{title}->_draw;
		1228	}
1010	}	1229	}
1011		1230
1012	#############################################################################	1231	#############################################################################
1013		1232
1014	package CFClient::UI::Table;	1233	package CFClient::UI::Table;
…		…
1022	sub new {	1241	sub new {
1023	my $class = shift;	1242	my $class = shift;
1024		1243
1025	$class->SUPER::new (	1244	$class->SUPER::new (
1026	col_expand => [],	1245	col_expand => [],
1027	@_	1246	@_,
1028	)	1247	)
		1248	}
		1249
		1250	sub children {
		1251	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1029	}	1252	}
1030		1253
1031	sub add {	1254	sub add {
1032	my ($self, $x, $y, $child) = @_;	1255	my ($self, $x, $y, $child) = @_;
1033		1256
1034	$child->set_parent ($self);	1257	$child->set_parent ($self);
1035	$self->{children}[$y][$x] = $child;	1258	$self->{children}[$y][$x] = $child;
1036		1259
1037	$child->check_size;	1260	$self->realloc;
1038	}	1261	}
1039		1262
1040	sub children {
1041	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1042	}
1043
1044	# 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?
1045	sub clear {	1264	sub clear {
1046	my ($self) = @_;	1265	my ($self) = @_;
1047		1266
1048	my @children = $self->children;	1267	my @children = $self->children;
1049	delete $self->{children};	1268	delete $self->{children};
…		…
1051	for (@children) {	1270	for (@children) {
1052	delete $_->{parent};	1271	delete $_->{parent};
1053	$_->hide;	1272	$_->hide;
1054	}	1273	}
1055		1274
1056	$self->update;	1275	$self->realloc;
1057	}	1276	}
1058		1277
1059	sub get_wh {	1278	sub get_wh {
1060	my ($self) = @_;	1279	my ($self) = @_;
1061		1280
…		…
1092	sub size_allocate {	1311	sub size_allocate {
1093	my ($self, $w, $h) = @_;	1312	my ($self, $w, $h) = @_;
1094		1313
1095	my ($ws, $hs) = $self->get_wh;	1314	my ($ws, $hs) = $self->get_wh;
1096		1315
1097	my $req_w = sum @$ws;	1316	my $req_w = (sum @$ws) || 1;
1098	my $req_h = sum @$hs;	1317	my $req_h = (sum @$hs) || 1;
1099		1318
1100	# TODO: nicer code && do row_expand	1319	# TODO: nicer code && do row_expand
1101	my @col_expand = @{$self->{col_expand}};	1320	my @col_expand = @{$self->{col_expand}};
1102	@col_expand = (1) x @$ws unless @col_expand;	1321	@col_expand = (1) x @$ws unless @col_expand;
1103	my $col_expand = (sum @col_expand) || 1;	1322	my $col_expand = (sum @col_expand) || 1;
…		…
1157	}	1376	}
1158	}	1377	}
1159		1378
1160	#############################################################################	1379	#############################################################################
1161		1380
1162	package CFClient::UI::HBox;	1381	package CFClient::UI::Box;
1163
1164	# TODO: wrap into common Box base class
1165		1382
1166	our @ISA = CFClient::UI::Container::;	1383	our @ISA = CFClient::UI::Container::;
1167		1384
1168	sub size_request {	1385	sub size_request {
1169	my ($self) = @_;	1386	my ($self) = @_;
1170		1387
1171	my @alloc = map [$_->size_request], @{$self->{children}};	1388	$self->{vertical}
1172		1389	? (
1173	(	1390	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1174	(List::Util::sum map $_->[0], @alloc),	1391	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1175	(List::Util::max map $_->[1], @alloc),	1392	)
1176	)	1393	: (
		1394	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1395	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1396	)
1177	}	1397	}
1178		1398
1179	sub size_allocate {	1399	sub size_allocate {
1180	my ($self, $w, $h) = @_;	1400	my ($self, $w, $h) = @_;
1181		1401
1182	($h, $w) = ($w, $h);	1402	my $space = $self->{vertical} ? $h : $w;
1183
1184	my $children = $self->{children};	1403	my $children = $self->{children};
1185		1404
1186	my @h = map $_->{req_w}, @$children;	1405	my @req;
1187		1406
1188	my $req_h = List::Util::sum @h;	1407	if ($self->{homogeneous}) {
1189		1408	@req = ($space / (@$children || 1)) x @$children;
1190	if ($req_h > $h) {
1191	# ah well, not enough space
1192	$_ *= $h / $req_h for @h;
1193	} 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 {
1194	my $exp = List::Util::sum map $_->{expand}, @$children;	1417	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1195	$exp ||= 1;
1196		1418
		1419	$space = ($space - $req) / $expand; # remaining space to give away
		1420
		1421	$req[$_] += $space * $children->[$_]{expand}
1197	for (0 .. $#$children) {	1422	for 0 .. $#$children;
1198	my $child = $children->[$_];
1199
1200	my $alloc_h = $h[$_];
1201	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1202	$h[$_] = $alloc_h;
1203	}	1423	}
1204	}	1424	}
1205		1425
1206	CFClient::UI::harmonize \@h;	1426	CFClient::UI::harmonize \@req;
1207		1427
1208	my $y = 0;	1428	my $pos = 0;
1209	for (0 .. $#$children) {	1429	for (0 .. $#$children) {
1210	my $child = $children->[$_];
1211	my $h = $h[$_];	1430	my $alloc = $req[$_];
1212	$child->configure ($y, 0, $h, $w);	1431	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1213		1432
1214	$y += $h;	1433	$pos += $alloc;
1215	}	1434	}
1216		1435
1217	1	1436	1
1218	}	1437	}
1219		1438
1220	#############################################################################	1439	#############################################################################
1221		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
1222	package CFClient::UI::VBox;	1456	package CFClient::UI::VBox;
1223		1457
1224	# TODO: wrap into common Box base class
1225
1226	our @ISA = CFClient::UI::Container::;	1458	our @ISA = CFClient::UI::Box::;
1227		1459
1228	sub size_request {	1460	sub new {
1229	my ($self) = @_;	1461	my $class = shift;
1230		1462
1231	my @alloc = map [$_->size_request], @{$self->{children}};	1463	$class->SUPER::new (
1232		1464	vertical => 1,
1233	(	1465	@_,
1234	(List::Util::max map $_->[0], @alloc),
1235	(List::Util::sum map $_->[1], @alloc),
1236	)	1466	)
1237	}	1467	}
1238		1468
1239	sub size_allocate {
1240	my ($self, $w, $h) = @_;
1241
1242	my $children = $self->{children};
1243
1244	my @h = map $_->{req_h}, @$children;
1245
1246	my $req_h = List::Util::sum @h;
1247
1248	if ($req_h > $h) {
1249	# ah well, not enough space
1250	$_ *= $h / $req_h for @h;
1251	} else {
1252	my $exp = List::Util::sum map $_->{expand}, @$children;
1253	$exp ||= 1;
1254
1255	for (0 .. $#$children) {
1256	my $child = $children->[$_];
1257
1258	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1259	}
1260	}
1261
1262	CFClient::UI::harmonize \@h;
1263
1264	my $y = 0;
1265	for (0 .. $#$children) {
1266	my $child = $children->[$_];
1267	my $h = $h[$_];
1268	$child->configure (0, $y, $w, $h);
1269
1270	$y += $h;
1271	}
1272
1273	1
1274	}
1275
1276	#############################################################################	1469	#############################################################################
1277		1470
1278	package CFClient::UI::Label;	1471	package CFClient::UI::Label;
1279		1472
1280	our @ISA = CFClient::UI::Base::;	1473	our @ISA = CFClient::UI::DrawBG::;
1281		1474
1282	use CFClient::OpenGL;	1475	use CFClient::OpenGL;
1283		1476
1284	sub new {	1477	sub new {
1285	my ($class, %arg) = @_;	1478	my ($class, %arg) = @_;
1286		1479
1287	my $self = $class->SUPER::new (	1480	my $self = $class->SUPER::new (
1288	fg => [1, 1, 1],	1481	fg => [1, 1, 1],
		1482	#bg => none
		1483	#active_bg => none
1289	#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),
1290	fontsize => 1,	1490	fontsize => 1,
1291	text => "",
1292	align => -1,	1491	align => -1,
1293	valign => -1,	1492	valign => -1,
1294	padding => 2,	1493	padding_x => 2,
1295	layout => new CFClient::Layout,	1494	padding_y => 2,
1296	can_events => 0,	1495	can_events => 0,
1297	%arg	1496	%arg
1298	);	1497	);
1299		1498
1300	if (exists $self->{template}) {	1499	if (exists $self->{template}) {
1301	my $layout = new CFClient::Layout;	1500	my $layout = new CFClient::Layout;
1302	$layout->set_text (delete $self->{template});	1501	$layout->set_text (delete $self->{template});
1303	$self->{template} = $layout;	1502	$self->{template} = $layout;
1304	}	1503	}
1305		1504
1306	$self->set_text (delete $self->{text}) if exists $self->{text};	1505	if (exists $self->{markup}) {
1307	$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	}
1308		1510
1309	$self	1511	$self
1310	}	1512	}
1311		1513
1312	sub escape {	1514	sub escape($) {
1313	local $_ = $_[1];	1515	local $_ = $_[0];
1314		1516
1315	s/&/&amp;/g;	1517	s/&/&amp;/g;
1316	s/>/&gt;/g;	1518	s/>/&gt;/g;
1317	s/</&lt;/g;	1519	s/</&lt;/g;
1318		1520
1319	$_[1]	1521	$_
1320	}	1522	}
1321		1523
1322	sub update {	1524	sub update {
1323	my ($self) = @_;	1525	my ($self) = @_;
1324		1526
…		…
1330	my ($self, $text) = @_;	1532	my ($self, $text) = @_;
1331		1533
1332	return if $self->{text} eq "T$text";	1534	return if $self->{text} eq "T$text";
1333	$self->{text} = "T$text";	1535	$self->{text} = "T$text";
1334		1536
		1537	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1335	$self->{layout}->set_text ($text);	1538	$self->{layout}->set_text ($text);
1336		1539
1337	delete $self->{texture};	1540	$self->realloc;
1338	$self->update;	1541	$self->update;
1339	$self->check_size;
1340	}	1542	}
1341		1543
1342	sub set_markup {	1544	sub set_markup {
1343	my ($self, $markup) = @_;	1545	my ($self, $markup) = @_;
1344		1546
1345	return if $self->{text} eq "M$markup";	1547	return if $self->{text} eq "M$markup";
1346	$self->{text} = "M$markup";	1548	$self->{text} = "M$markup";
1347		1549
		1550	my $rgba = $markup =~ /span.*(?:foreground|background)/;
		1551
		1552	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1348	$self->{layout}->set_markup ($markup);	1553	$self->{layout}->set_markup ($markup);
1349		1554
1350	delete $self->{texture};	1555	$self->realloc;
1351	$self->update;	1556	$self->update;
1352	$self->check_size;
1353	}	1557	}
1354		1558
1355	sub size_request {	1559	sub size_request {
1356	my ($self) = @_;	1560	my ($self) = @_;
1357		1561
1358	$self->{layout}->set_font ($self->{font}) if $self->{font};	1562	$self->{layout}->set_font ($self->{font}) if $self->{font};
1359	$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});
1360	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1566	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1361		1567
1362	my ($w, $h) = $self->{layout}->size;	1568	my ($w, $h) = $self->{layout}->size;
1363		1569
1364	if (exists $self->{template}) {	1570	if (exists $self->{template}) {
…		…
1369		1575
1370	$w = List::Util::max $w, $w2;	1576	$w = List::Util::max $w, $w2;
1371	$h = List::Util::max $h, $h2;	1577	$h = List::Util::max $h, $h2;
1372	}	1578	}
1373		1579
1374	(	1580	($w, $h)
1375	$w + $self->{padding} * 2,
1376	$h + $self->{padding} * 2,
1377	)
1378	}	1581	}
1379		1582
1380	sub size_allocate {	1583	sub size_allocate {
1381	my ($self, $w, $h) = @_;	1584	my ($self, $w, $h) = @_;
1382		1585
		1586	delete $self->{ox};
		1587
1383	delete $self->{texture};	1588	delete $self->{texture}
		1589	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1384	}	1590	}
1385		1591
1386	sub set_fontsize {	1592	sub set_fontsize {
1387	my ($self, $fontsize) = @_;	1593	my ($self, $fontsize) = @_;
1388		1594
1389	$self->{fontsize} = $fontsize;	1595	$self->{fontsize} = $fontsize;
1390	delete $self->{texture};	1596	delete $self->{texture};
1391		1597
1392	$self->update;	1598	$self->realloc;
1393	$self->check_size;
1394	}	1599	}
1395		1600
1396	sub _draw {	1601	sub _draw {
1397	my ($self) = @_;	1602	my ($self) = @_;
1398		1603
		1604	$self->SUPER::_draw; # draw background, if applicable
		1605
1399	my $tex = $self->{texture} ||= do {	1606	my $tex = $self->{texture} ||= do {
		1607	$self->{layout}->set_foreground (@{$self->{fg}});
1400	$self->{layout}->set_font ($self->{font}) if $self->{font};	1608	$self->{layout}->set_font ($self->{font}) if $self->{font};
1401	$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});
1402	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);	1612	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
		1613
1403	new_from_layout CFClient::Texture $self->{layout}	1614	new_from_layout CFClient::Texture $self->{layout}
1404	};	1615	};
1405		1616
1406	glEnable GL_BLEND;	1617	unless (exists $self->{ox}) {
1407	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
1408	glEnable GL_TEXTURE_2D;	1627	glEnable GL_TEXTURE_2D;
1409	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1628	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1410		1629
		1630	if ($tex->{format} == GL_ALPHA) {
1411	glColor @{$self->{fg}};	1631	glColor @{$self->{fg}};
1412
1413	$self->{ox} = int (
1414	$self->{align} < 0 ? $self->{padding}
1415	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1416	: ($self->{w} - $tex->{w}) * 0.5
1417	);
1418
1419	$self->{oy} = int (
1420	$self->{valign} < 0 ? $self->{padding}
1421	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1422	: ($self->{h} - $tex->{h}) * 0.5
1423	);
1424
1425	$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	}
1426		1636
1427	glDisable GL_TEXTURE_2D;	1637	glDisable GL_TEXTURE_2D;
1428	glDisable GL_BLEND;
1429	}	1638	}
1430		1639
1431	#############################################################################	1640	#############################################################################
1432		1641
1433	package CFClient::UI::EntryBase;	1642	package CFClient::UI::EntryBase;
…		…
1446	active_fg => [0, 0, 0],	1655	active_fg => [0, 0, 0],
1447	can_hover => 1,	1656	can_hover => 1,
1448	can_focus => 1,	1657	can_focus => 1,
1449	valign => 0,	1658	valign => 0,
1450	can_events => 1,	1659	can_events => 1,
		1660	#text => ...
1451	@_	1661	@_
1452	)	1662	)
1453	}	1663	}
1454		1664
1455	sub _set_text {	1665	sub _set_text {
…		…
1465	$self->{text} = $text;	1675	$self->{text} = $text;
1466		1676
1467	$text =~ s/./*/g if $self->{hidden};	1677	$text =~ s/./*/g if $self->{hidden};
1468	$self->{layout}->set_text ("$text ");	1678	$self->{layout}->set_text ("$text ");
1469		1679
1470	$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;
1471	}	1690	}
1472		1691
1473	sub get_text {	1692	sub get_text {
1474	$_[0]{text}	1693	$_[0]{text}
1475	}	1694	}
…		…
1478	my ($self) = @_;	1697	my ($self) = @_;
1479		1698
1480	my ($w, $h) = $self->SUPER::size_request;	1699	my ($w, $h) = $self->SUPER::size_request;
1481		1700
1482	($w + 1, $h) # add 1 for cursor	1701	($w + 1, $h) # add 1 for cursor
1483	}
1484
1485	sub size_allocate {
1486	my ($self, $w, $h) = @_;
1487
1488	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1489	}
1490
1491	sub set_text {
1492	my ($self, $text) = @_;
1493
1494	$self->{cursor} = length $text;
1495	$self->_set_text ($text);
1496	$self->update;
1497	}	1702	}
1498		1703
1499	sub key_down {	1704	sub key_down {
1500	my ($self, $ev) = @_;	1705	my ($self, $ev) = @_;
1501		1706
…		…
1503	my $sym = $ev->{sym};	1708	my $sym = $ev->{sym};
1504	my $uni = $ev->{unicode};	1709	my $uni = $ev->{unicode};
1505		1710
1506	my $text = $self->get_text;	1711	my $text = $self->get_text;
1507		1712
1508	if ($sym == 8) {	1713	if ($uni == 8) {
1509	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1714	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1510	} elsif ($sym == 127) {	1715	} elsif ($uni == 127) {
1511	substr $text, $self->{cursor}, 1, "";	1716	substr $text, $self->{cursor}, 1, "";
1512	} elsif ($sym == CFClient::SDLK_LEFT) {	1717	} elsif ($sym == CFClient::SDLK_LEFT) {
1513	--$self->{cursor} if $self->{cursor};	1718	--$self->{cursor} if $self->{cursor};
1514	} elsif ($sym == CFClient::SDLK_RIGHT) {	1719	} elsif ($sym == CFClient::SDLK_RIGHT) {
1515	++$self->{cursor} if $self->{cursor} < length $self->{text};	1720	++$self->{cursor} if $self->{cursor} < length $self->{text};
1516	} elsif ($sym == CFClient::SDLK_HOME) {	1721	} elsif ($sym == CFClient::SDLK_HOME) {
1517	$self->{cursor} = 0;	1722	$self->{cursor} = 0;
1518	} elsif ($sym == CFClient::SDLK_END) {	1723	} elsif ($sym == CFClient::SDLK_END) {
1519	$self->{cursor} = length $text;	1724	$self->{cursor} = length $text;
1520	} elsif ($sym == 27) {	1725	} elsif ($uni == 27) {
1521	$self->emit ('escape');	1726	$self->_emit ('escape');
1522	} elsif ($uni) {	1727	} elsif ($uni) {
1523	substr $text, $self->{cursor}++, 0, chr $uni;	1728	substr $text, $self->{cursor}++, 0, chr $uni;
		1729	} else {
		1730	return 0;
1524	}	1731	}
1525		1732
1526	$self->_set_text ($text);	1733	$self->_set_text ($text);
1527	$self->update;	1734
		1735	$self->realloc;
		1736
		1737	1
1528	}	1738	}
1529		1739
1530	sub focus_in {	1740	sub focus_in {
1531	my ($self) = @_;	1741	my ($self) = @_;
1532		1742
…		…
1547	utf8::encode $text;	1757	utf8::encode $text;
1548	$self->{cursor} = length substr $text, 0, $idx;	1758	$self->{cursor} = length substr $text, 0, $idx;
1549		1759
1550	$self->_set_text ($self->{text});	1760	$self->_set_text ($self->{text});
1551	$self->update;	1761	$self->update;
		1762
		1763	1
1552	}	1764	}
1553		1765
1554	sub mouse_motion {	1766	sub mouse_motion {
1555	my ($self, $ev, $x, $y) = @_;	1767	my ($self, $ev, $x, $y) = @_;
1556	# 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
1557	}	1771	}
1558		1772
1559	sub _draw {	1773	sub _draw {
1560	my ($self) = @_;	1774	my ($self) = @_;
1561		1775
…		…
1612	if ($sym == 13) {	1826	if ($sym == 13) {
1613	unshift @{$self->{history}},	1827	unshift @{$self->{history}},
1614	my $txt = $self->get_text;	1828	my $txt = $self->get_text;
1615	$self->{history_pointer} = -1;	1829	$self->{history_pointer} = -1;
1616	$self->{history_saveback} = '';	1830	$self->{history_saveback} = '';
1617	$self->emit (activate => $txt);	1831	$self->_emit (activate => $txt);
1618	$self->update;	1832	$self->update;
1619		1833
1620	} elsif ($sym == CFClient::SDLK_UP) {	1834	} elsif ($sym == CFClient::SDLK_UP) {
1621	if ($self->{history_pointer} < 0) {	1835	if ($self->{history_pointer} < 0) {
1622	$self->{history_saveback} = $self->get_text;	1836	$self->{history_saveback} = $self->get_text;
…		…
1638	} else {	1852	} else {
1639	$self->set_text ($self->{history_saveback});	1853	$self->set_text ($self->{history_saveback});
1640	}	1854	}
1641		1855
1642	} else {	1856	} else {
1643	$self->SUPER::key_down ($ev);	1857	return $self->SUPER::key_down ($ev)
		1858	}
		1859
1644	}	1860	1
1645
1646	}	1861	}
1647		1862
1648	#############################################################################	1863	#############################################################################
1649		1864
1650	package CFClient::UI::Button;	1865	package CFClient::UI::Button;
…		…
1659		1874
1660	sub new {	1875	sub new {
1661	my $class = shift;	1876	my $class = shift;
1662		1877
1663	$class->SUPER::new (	1878	$class->SUPER::new (
1664	padding => 4,	1879	padding_x => 4,
		1880	padding_y => 4,
1665	fg => [1, 1, 1],	1881	fg => [1, 1, 1],
1666	bg => [1, 1, 1, 0.2],
1667	active_fg => [0, 0, 1],	1882	active_fg => [0, 0, 1],
1668	can_hover => 1,	1883	can_hover => 1,
1669	align => 0,	1884	align => 0,
1670	valign => 0,	1885	valign => 0,
1671	can_events => 1,	1886	can_events => 1,
1672	@_	1887	@_
1673	)	1888	)
1674	}	1889	}
1675		1890
		1891	sub activate { }
		1892
1676	sub button_up {	1893	sub button_up {
1677	my ($self, $ev, $x, $y) = @_;	1894	my ($self, $ev, $x, $y) = @_;
1678		1895
		1896	$self->emit ("activate")
1679	if ($x >= 0 && $x < $self->{w}	1897	if $x >= 0 && $x < $self->{w}
1680	&& $y >= 0 && $y < $self->{h}) {	1898	&& $y >= 0 && $y < $self->{h};
1681	$self->emit ("activate");	1899
1682	}	1900	1
1683	}	1901	}
1684		1902
1685	sub _draw {	1903	sub _draw {
1686	my ($self) = @_;	1904	my ($self) = @_;
1687		1905
…		…
1689		1907
1690	if ($GRAB == $self) {	1908	if ($GRAB == $self) {
1691	$self->{fg} = $self->{active_fg};	1909	$self->{fg} = $self->{active_fg};
1692	}	1910	}
1693		1911
1694	glEnable GL_BLEND;
1695	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1696	glEnable GL_TEXTURE_2D;	1912	glEnable GL_TEXTURE_2D;
1697	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1913	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1698	glColor 0, 0, 0, 1;	1914	glColor 0, 0, 0, 1;
1699		1915
1700	$tex[0]->draw_quad (0, 0, $self->{w}, $self->{h});	1916	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1701		1917
1702	glDisable GL_TEXTURE_2D;	1918	glDisable GL_TEXTURE_2D;
1703	glDisable GL_BLEND;
1704		1919
1705	$self->SUPER::_draw;	1920	$self->SUPER::_draw;
1706	}	1921	}
1707		1922
1708	#############################################################################	1923	#############################################################################
…		…
1719		1934
1720	sub new {	1935	sub new {
1721	my $class = shift;	1936	my $class = shift;
1722		1937
1723	$class->SUPER::new (	1938	$class->SUPER::new (
1724	padding => 2,	1939	padding_x => 2,
		1940	padding_y => 2,
1725	fg => [1, 1, 1],	1941	fg => [1, 1, 1],
1726	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],
1727	state => 0,	1945	state => 0,
1728	can_hover => 1,	1946	can_hover => 1,
1729	@_	1947	@_
1730	)	1948	)
1731	}	1949	}
1732		1950
1733	sub size_request {	1951	sub size_request {
1734	my ($self) = @_;	1952	my ($self) = @_;
1735		1953
1736	($self->{padding} * 2 + 6) x 2	1954	(6) x 2
1737	}	1955	}
1738		1956
1739	sub button_down {	1957	sub button_down {
1740	my ($self, $ev, $x, $y) = @_;	1958	my ($self, $ev, $x, $y) = @_;
1741		1959
1742	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1960	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1743	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1961	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1744	$self->{state} = !$self->{state};	1962	$self->{state} = !$self->{state};
1745	$self->emit (changed => $self->{state});	1963	$self->_emit (changed => $self->{state});
		1964	} else {
		1965	return 0
		1966	}
		1967
1746	}	1968	1
1747	}	1969	}
1748		1970
1749	sub _draw {	1971	sub _draw {
1750	my ($self) = @_;	1972	my ($self) = @_;
1751		1973
1752	$self->SUPER::_draw;	1974	$self->SUPER::_draw;
1753		1975
1754	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1976	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1755		1977
1756	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;
1757		1981
1758	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	1982	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1759		1983
1760	glEnable GL_BLEND;	1984	my $tex = $self->{state} ? $tex[1] : $tex[0];
		1985
1761	glEnable GL_TEXTURE_2D;	1986	glEnable GL_TEXTURE_2D;
1762	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1763
1764	my $tex = $self->{state} ? $tex[1] : $tex[0];
1765
1766	$tex->draw_quad (0, 0, $s, $s);	1987	$tex->draw_quad_alpha (0, 0, $s, $s);
1767
1768	glDisable GL_TEXTURE_2D;	1988	glDisable GL_TEXTURE_2D;
1769	glDisable GL_BLEND;
1770	}	1989	}
1771		1990
1772	#############################################################################	1991	#############################################################################
1773		1992
1774	package CFClient::UI::Image;	1993	package CFClient::UI::Image;
…		…
1817	glTranslate 0, -$self->{w}, 0;	2036	glTranslate 0, -$self->{w}, 0;
1818		2037
1819	($w, $h) = ($h, $w);	2038	($w, $h) = ($h, $w);
1820	}	2039	}
1821		2040
1822	glEnable GL_BLEND;
1823	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1824	glEnable GL_TEXTURE_2D;	2041	glEnable GL_TEXTURE_2D;
1825	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2042	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1826		2043
1827	$tex->draw_quad (0, 0, $w, $h);	2044	$tex->draw_quad_alpha (0, 0, $w, $h);
1828		2045
1829	glDisable GL_BLEND;
1830	glDisable GL_TEXTURE_2D;	2046	glDisable GL_TEXTURE_2D;
1831	}	2047	}
1832		2048
1833	#############################################################################	2049	#############################################################################
1834		2050
…		…
2023	qw(s1_slider.png s1_slider_bg.png);	2239	qw(s1_slider.png s1_slider_bg.png);
2024		2240
2025	sub new {	2241	sub new {
2026	my $class = shift;	2242	my $class = shift;
2027		2243
2028	# range [value, low, high, page]	2244	# range [value, low, high, page, unit]
2029		2245
2030	# TODO: 0-width page	2246	# TODO: 0-width page
2031	# TODO: req_w/h are wrong with vertical	2247	# TODO: req_w/h are wrong with vertical
2032	# TODO: calculations are off	2248	# TODO: calculations are off
2033	my $self = $class->SUPER::new (	2249	my $self = $class->SUPER::new (
2034	fg => [1, 1, 1],	2250	fg => [1, 1, 1],
2035	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],
2036	range => [0, 0, 100, 10],	2254	range => [0, 0, 100, 10, 0],
2037	req_w => $::WIDTH / 80,	2255	min_w => $::WIDTH / 80,
2038	req_h => $::WIDTH / 80,	2256	min_h => $::WIDTH / 80,
2039	vertical => 0,	2257	vertical => 0,
2040	can_hover => 1,	2258	can_hover => 1,
2041	inner_pad => 5,	2259	inner_pad => 0.02,
2042	@_	2260	@_
2043	);	2261	);
2044		2262
		2263	$self->set_value ($self->{range}[0]);
		2264	$self->update;
		2265
2045	$self	2266	$self
2046	}	2267	}
2047		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
2048	sub size_request {	2303	sub size_request {
2049	my ($self) = @_;	2304	my ($self) = @_;
2050		2305
2051	my $w = $self->{req_w};	2306	($self->{req_w}, $self->{req_h})
2052	my $h = $self->{req_h};
2053
2054	$self->{vertical} ? ($h, $w) : ($w, $h)
2055	}	2307	}
2056		2308
2057	sub button_down {	2309	sub button_down {
2058	my ($self, $ev, $x, $y) = @_;	2310	my ($self, $ev, $x, $y) = @_;
2059		2311
2060	$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
2061	$self->mouse_motion ($ev, $x, $y);	2316	$self->mouse_motion ($ev, $x, $y)
2062	}	2317	}
2063		2318
2064	sub mouse_motion {	2319	sub mouse_motion {
2065	my ($self, $ev, $x, $y) = @_;	2320	my ($self, $ev, $x, $y) = @_;
2066		2321
2067	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
2068	my ($value, $lo, $hi, $page) = @{$self->{range}};	2343	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2344	my $range = ($hi - $page - $lo) || 1e-100;
2069		2345
2070	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2346	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2071		2347
2072	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2348	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
2073	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right	2349	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2074		2350
2075	$x -= $inner_pad_px; # substract the padding	2351	$value = ($value - $lo) / $range;
2076	$x = $x * ($hi - $lo) / $inner_w + $lo;	2352	$value = $value * $self->{scale} + $self->{offset};
2077	$x = $lo if $x < $lo;
2078	$x = $hi - $page if $x > $hi - $page;
2079	$self->{range}[0] = $x;
2080		2353
2081	$self->emit (changed => $x);	2354	$self->{knob_x} = $value - $knob_w * 0.5;
2082	$self->update;	2355	$self->{knob_w} = $knob_w;
2083	}	2356	});
2084	}
2085		2357
2086	# the inner_* stuff is for generating a padding for the slider handle,	2358	$self->SUPER::update;
2087	# so that the handle doesn't leave the texture. This calculation isn't 100%
2088	# correct propably, but it does the job for now
2089	sub _calc_inner_pad_px {
2090	my ($self, $w) = @_;
2091	($w / 100) * $self->{inner_pad} # % to pixels
2092	}	2359	}
2093		2360
2094	sub _draw {	2361	sub _draw {
2095	my ($self) = @_;	2362	my ($self) = @_;
2096		2363
2097	$self->SUPER::_draw ();	2364	$self->SUPER::_draw ();
2098		2365
2099	my ($w, $h) = @$self{qw(w h)};	2366	glScale $self->{w}, $self->{h};
2100		2367
2101	if ($self->{vertical}) {	2368	if ($self->{vertical}) {
2102	# draw a vertical slider like a rotated horizontal slider	2369	# draw a vertical slider like a rotated horizontal slider
2103		2370
		2371	glTranslate 1, 0, 0;
2104	glRotate 90, 0, 0, 1;	2372	glRotate 90, 0, 0, 1;
2105	glTranslate 0, -$self->{w}, 0;
2106
2107	($w, $h) = ($h, $w);
2108	}	2373	}
2109		2374
2110	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2375	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2111	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2376	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2112		2377
2113	my ($value, $lo, $hi, $page) = @{$self->{range}};
2114
2115	$hi = $value + 1 if $lo == $hi;
2116
2117	my $inner_pad_px = $self->_calc_inner_pad_px ($w);
2118	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
2119
2120	$page = int $page * $inner_w / ($hi - $lo);
2121	$value = int +($value - $lo) * $inner_w / ($hi - $lo);
2122
2123	$w -= $page;
2124	$page &= ~1;
2125	glTranslate $page * 0.5, 0, 0;
2126	$page ||= 2;
2127
2128	my $knob_a = $inner_pad_px + ($value - $page * 0.5);
2129	my $knob_b = $inner_pad_px + ($value + $page * 0.5);
2130
2131	glEnable GL_BLEND;
2132	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2133	glEnable GL_TEXTURE_2D;	2378	glEnable GL_TEXTURE_2D;
2134	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2379	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2135		2380
2136	# draw background	2381	# draw background
2137	$tex[1]->draw_quad (0, 0, $w, $h);	2382	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
2138		2383
2139	# draw handle	2384	# draw handle
2140	$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);
2141		2386
2142	glDisable GL_BLEND;
2143	glDisable GL_TEXTURE_2D;	2387	glDisable GL_TEXTURE_2D;
2144	}	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 (@_) }
2145		2430
2146	#############################################################################	2431	#############################################################################
2147		2432
2148	package CFClient::UI::TextView;	2433	package CFClient::UI::TextView;
2149		2434
…		…
2158	fontsize => 1,	2443	fontsize => 1,
2159	can_events => 0,	2444	can_events => 0,
2160	#font => default_font	2445	#font => default_font
2161	@_,	2446	@_,
2162		2447
2163	layout => (new CFClient::Layout),	2448	layout => (new CFClient::Layout 1),
2164	par => [],	2449	par => [],
2165	height => 0,	2450	height => 0,
2166	children => [	2451	children => [
2167	(new CFClient::UI::Empty expand => 1),	2452	(new CFClient::UI::Empty expand => 1),
2168	(new CFClient::UI::Slider vertical => 1),	2453	(new CFClient::UI::Slider vertical => 1),
…		…
2179		2464
2180	$self->{fontsize} = $fontsize;	2465	$self->{fontsize} = $fontsize;
2181	$self->reflow;	2466	$self->reflow;
2182	}	2467	}
2183		2468
2184	sub text_height {
2185	my ($self, $text) = @_;
2186
2187	my $layout = $self->{layout};
2188
2189	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2190	$layout->set_width ($self->{children}[0]{w});
2191	$layout->set_text ($text);
2192
2193	($layout->size)[1]
2194	}
2195
2196	sub reflow {
2197	my ($self) = @_;
2198
2199	$self->{need_reflow}++;
2200	$self->update;
2201	}
2202
2203	sub size_allocate {	2469	sub size_allocate {
2204	my ($self, $w, $h) = @_;	2470	my ($self, $w, $h) = @_;
2205		2471
2206	$self->SUPER::size_allocate ($w, $h);	2472	$self->SUPER::size_allocate ($w, $h);
2207		2473
…		…
2210	$self->{layout}->set_width ($self->{children}[0]{w});	2476	$self->{layout}->set_width ($self->{children}[0]{w});
2211		2477
2212	$self->reflow;	2478	$self->reflow;
2213	}	2479	}
2214		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
2215	sub add_paragraph {	2515	sub add_paragraph {
2216	my ($self, $color, $text) = @_;	2516	my ($self, $color, $text, $indent) = @_;
2217		2517
2218	#TODO: intelligently "reformat" paragraph	2518	for my $line (split /\n/, $text) {
2219		2519	my ($w, $h) = $self->text_size ($line);
2220	my $height = $self->text_height ($text);
2221
2222	$self->{height} += $height;	2520	$self->{height} += $h;
		2521	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
		2522	}
2223		2523
2224	push @{$self->{par}}, [$height, $color, $text];
2225
2226	$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]);
2227	$self->{children}[1]->update;
2228	}	2525	}
2229		2526
2230	sub update {	2527	sub update {
2231	my ($self) = @_;	2528	my ($self) = @_;
2232		2529
…		…
2234		2531
2235	return unless $self->{h} > 0;	2532	return unless $self->{h} > 0;
2236		2533
2237	delete $self->{texture};	2534	delete $self->{texture};
2238		2535
2239	$ROOT->on_refresh ($self, sub {	2536	$ROOT->on_post_alloc ($self, sub {
		2537	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2538
2240	if (delete $self->{need_reflow}) {	2539	if (delete $self->{need_reflow}) {
2241	my $height = 0;	2540	my $height = 0;
2242		2541
2243	$height += $_->[0] = $self->text_height ($_->[2])	2542	my $layout = $self->{layout};
		2543
		2544	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2545
2244	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	}
2245		2557
2246	$self->{height} = $height;	2558	$self->{height} = $height;
2247		2559
2248	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2560	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2249		2561
2250	delete $self->{texture};	2562	delete $self->{texture};
2251	}	2563	}
2252		2564
2253	$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 {
2254	glClearColor 0, 0, 0, 0;	2566	glClearColor 0.5, 0.5, 0.5, 0;
2255	glClear GL_COLOR_BUFFER_BIT;	2567	glClear GL_COLOR_BUFFER_BIT;
2256		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
2257	glEnable GL_BLEND;	2580	glEnable GL_BLEND;
		2581	#TODO# not correct in windows where rgba is forced off
2258	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2582	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2259	glEnable GL_TEXTURE_2D;
2260	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2261
2262	my $top = int $self->{children}[1]{range}[0];
2263
2264	my $y0 = $top;
2265	my $y1 = $top + $self->{h};
2266
2267	my $y = 0;
2268
2269	my $layout = $self->{layout};
2270
2271	$layout->set_font ($self->{font}) if $self->{font};
2272		2583
2273	for my $par (@{$self->{par}}) {	2584	for my $par (@{$self->{par}}) {
2274	my $h = $par->[0];	2585	my $h = $par->[1];
2275		2586
2276	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]);
2277	$layout->set_text ($par->[2]);	2590	$layout->set_markup ($par->[4]);
2278		2591
2279	glColor @{ $par->[1] };	2592	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2280	my ($W, $H) = $layout->size;	2593
2281	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;
2282	}	2596	}
2283		2597
2284	$y += $h;	2598	$y += $h;
2285	}	2599	}
2286		2600
2287	glDisable GL_TEXTURE_2D;
2288	glDisable GL_BLEND;	2601	glDisable GL_BLEND;
2289	};	2602	};
2290	});	2603	});
2291	}	2604	}
2292		2605
2293	sub _draw {	2606	sub _draw {
2294	my ($self) = @_;	2607	my ($self) = @_;
2295		2608
2296	glEnable GL_BLEND;
2297	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2298	glEnable GL_TEXTURE_2D;	2609	glEnable GL_TEXTURE_2D;
2299	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2610	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2300	glColor 1, 1, 1, 1;	2611	glColor 1, 1, 1, 1;
2301	$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});
2302	glDisable GL_TEXTURE_2D;	2613	glDisable GL_TEXTURE_2D;
2303	glDisable GL_BLEND;
2304		2614
2305	$self->{children}[1]->draw;	2615	$self->{children}[1]->draw;
2306		2616
2307	}	2617	}
2308		2618
…		…
2356		2666
2357	sub new {	2667	sub new {
2358	my $class = shift;	2668	my $class = shift;
2359		2669
2360	my $self = $class->SUPER::new (	2670	my $self = $class->SUPER::new (
2361	state => 0,	2671	state => 0,
2362	connect_activate => \&toggle_flopper,	2672	on_activate => \&toggle_flopper,
2363	@_	2673	@_
2364	);	2674	);
2365		2675
2366	if ($self->{state}) {
2367	$self->{state} = 0;
2368	$self->toggle_flopper;
2369	}
2370
2371	$self	2676	$self
2372	}	2677	}
2373		2678
2374	sub toggle_flopper {	2679	sub toggle_flopper {
2375	my ($self) = @_;	2680	my ($self) = @_;
2376		2681
2377	# TODO: use animation	2682	$self->{other}->toggle_visibility;
2378	if ($self->{state} = !$self->{state}) {
2379	$CFClient::UI::ROOT->add ($self->{other});
2380	$self->{other}->move ($self->coord2global (0, $self->{h}));
2381	$self->emit ("open");
2382	} else {
2383	$CFClient::UI::ROOT->remove ($self->{other});
2384	$self->emit ("close");
2385	}
2386
2387	$self->emit (changed => $self->{state});
2388	}	2683	}
2389		2684
2390	#############################################################################	2685	#############################################################################
2391		2686
2392	package CFClient::UI::Tooltip;	2687	package CFClient::UI::Tooltip;
…		…
2402	@_,	2697	@_,
2403	can_events => 0,	2698	can_events => 0,
2404	)	2699	)
2405	}	2700	}
2406		2701
2407	sub set_markup {	2702	sub set_tooltip_from {
2408	my ($self, $text) = @_;	2703	my ($self, $widget) = @_;
2409		2704
2410	$self->{label} ||= new CFClient::UI::Label fontsize => 0.8, fg => [0, 0, 0];	2705	my $tooltip = $widget->{tooltip};
2411	$self->{label}->set_markup ($text);	2706
2412	$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	);
2413	}	2722	}
2414		2723
2415	sub size_request {	2724	sub size_request {
2416	my ($self) = @_;	2725	my ($self) = @_;
2417
2418	$self->child->set_max_size ($::WIDTH * 0.3);
2419		2726
2420	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2727	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2421		2728
2422	($w + 4, $h + 4)	2729	($w + 4, $h + 4)
2423	}	2730	}
…		…
2426	my ($self, $w, $h) = @_;	2733	my ($self, $w, $h) = @_;
2427		2734
2428	$self->SUPER::size_allocate ($w - 4, $h - 4);	2735	$self->SUPER::size_allocate ($w - 4, $h - 4);
2429	}	2736	}
2430		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
2431	sub _draw {	2756	sub _draw {
2432	my ($self) = @_;	2757	my ($self) = @_;
2433		2758
2434	glPushMatrix;
2435	glTranslate 0.375, 0.375;	2759	glTranslate 0.375, 0.375;
2436		2760
2437	my ($w, $h) = @$self{qw(w h)};	2761	my ($w, $h) = @$self{qw(w h)};
2438		2762
2439	glColor 1, 0.8, 0.4;	2763	glColor 1, 0.8, 0.4;
…		…
2450	glVertex 0 , $h;	2774	glVertex 0 , $h;
2451	glVertex $w, $h;	2775	glVertex $w, $h;
2452	glVertex $w, 0;	2776	glVertex $w, 0;
2453	glEnd;	2777	glEnd;
2454		2778
2455	glPopMatrix;	2779	glTranslate 2 - 0.375, 2 - 0.375;
2456		2780
2457	glTranslate 2, 2;
2458	$self->SUPER::_draw;	2781	$self->SUPER::_draw;
2459	}	2782	}
2460		2783
2461	#############################################################################	2784	#############################################################################
2462		2785
…		…
2467	use CFClient::OpenGL;	2790	use CFClient::OpenGL;
2468		2791
2469	sub new {	2792	sub new {
2470	my $class = shift;	2793	my $class = shift;
2471		2794
2472	$class->SUPER::new (	2795	my $self = $class->SUPER::new (
2473	aspect => 1,	2796	aspect => 1,
		2797	can_events => 0,
2474	@_,	2798	@_,
2475	)	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
2476	}	2816	}
2477		2817
2478	sub size_request {	2818	sub size_request {
2479	(32, 8)	2819	(32, 8)
2480	}	2820	}
2481		2821
		2822	sub update {
		2823	my ($self) = @_;
		2824
		2825	return unless $self->{visible};
		2826
		2827	$self->SUPER::update;
		2828	}
		2829
2482	sub _draw {	2830	sub _draw {
2483	my ($self) = @_;	2831	my ($self) = @_;
2484		2832
2485	return unless $::CONN;#d# manage and cache textures differently	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
2486	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	2844	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2487		2845
2488	# TODO animation
2489	if ($tex) {	2846	if ($tex) {
2490	glEnable GL_BLEND;
2491	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2492	glEnable GL_TEXTURE_2D;	2847	glEnable GL_TEXTURE_2D;
2493	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2848	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2494	glColor 1, 1, 1, 1;	2849	glColor 1, 1, 1, 1;
2495	$tex->draw_quad (0, 0, $self->{w}, $self->{h});	2850	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2496	glDisable GL_TEXTURE_2D;	2851	glDisable GL_TEXTURE_2D;
2497	glDisable GL_BLEND;
2498	}	2852	}
2499	}	2853	}
2500		2854
2501	#############################################################################	2855	sub DESTROY {
		2856	my ($self) = @_;
2502		2857
		2858	$self->{timer}->cancel
		2859	if $self->{timer};
		2860
		2861	$self->SUPER::DESTROY;
		2862	}
		2863
		2864	#############################################################################
		2865
2503	package CFClient::UI::InventoryItem;	2866	package CFClient::UI::Buttonbar;
2504		2867
2505	our @ISA = CFClient::UI::HBox::;	2868	our @ISA = CFClient::UI::HBox::;
2506		2869
2507	sub new {	2870	# TODO: should actualyl wrap buttons and other goodies.
2508	my $class = shift;
2509
2510	my %args = @_;
2511
2512	my $item = $args{item};
2513
2514	my $desc = $item->{nrof} < 2
2515	? $item->{name}
2516	: "$item->{nrof} $item->{name_pl}";
2517
2518
2519	my $self = $class->SUPER::new (
2520	can_hover => 1,
2521	can_events => 1,
2522	tooltip => (CFClient::UI::Label->escape ($desc)
2523	. "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
2524	connect_button_down => sub {
2525	my ($self, $ev, $x, $y) = @_;
2526
2527	# todo: maybe put examine on 1? but should just be a tooltip :(
2528	if ($ev->{button} == 1) {
2529	$::CONN->send ("move $::CONN->{player}{tag} $item->{tag} 0");
2530	} elsif ($ev->{button} == 2) {
2531	$::CONN->send ("apply $item->{tag}");
2532	} elsif ($ev->{button} == 3) {
2533	CFClient::UI::Menu->new (
2534	items => [
2535	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2536	[
2537	$item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
2538	sub { $::CONN->send ("lock $item->{tag}") },
2539	],
2540	["mark", sub { $::CONN->send ("mark $item->{tag}") }],
2541	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2542	["drop", sub { $::CONN->send ("move 0 $item->{tag} 0") }],
2543	],
2544	)->popup ($ev);
2545	}
2546
2547	1
2548	},
2549	%args
2550	);
2551	$self->add(new CFClient::UI::Face
2552	can_events => 0,
2553	face => $item->{face},
2554	anim => $item->{anim},
2555	animspeed => $item->{animspeed});
2556	$self->add(new CFClient::UI::Label
2557	can_events => 0,
2558	text => $desc);
2559
2560	$self
2561	}
2562
2563	#############################################################################
2564
2565	package CFClient::UI::Inventory;
2566
2567	our @ISA = CFClient::UI::ScrolledWindow::;
2568
2569	sub new {
2570	my $class = shift;
2571
2572	my $self = $class->SUPER::new (
2573	scrolled => (new CFClient::UI::VBox),
2574	@_,
2575	);
2576
2577	$self
2578	}
2579
2580	sub set_items {
2581	my ($self, $items) = @_;
2582
2583	$self->{scrolled}->clear;
2584	return unless $items;
2585
2586	my @items = sort { $a->{type} <=> $b->{type} } @$items;
2587
2588	$self->{real_items} = \@items;
2589
2590	for my $item (@items) {
2591	my $desc = $item->{nrof} < 2
2592	? $item->{name}
2593	: "$item->{nrof} $item->{name_pl}";
2594
2595	$self->{scrolled}->add (new CFClient::UI::InventoryItem item => $item);
2596	}
2597
2598	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2599	}
2600
2601	sub size_request {
2602	my ($self) = @_;
2603	($self->{req_w}, $self->{req_h});
2604	}
2605		2871
2606	#############################################################################	2872	#############################################################################
2607		2873
2608	package CFClient::UI::Menu;	2874	package CFClient::UI::Menu;
2609		2875
…		…
2643		2909
2644	# 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)
2645	sub popup {	2911	sub popup {
2646	my ($self, $ev) = @_;	2912	my ($self, $ev) = @_;
2647		2913
2648	$self->emit ("popdown");	2914	$self->_emit ("popdown");
2649		2915
2650	# maybe save $GRAB? must be careful about events...	2916	# maybe save $GRAB? must be careful about events...
2651	$GRAB = $self;	2917	$GRAB = $self;
2652	$self->{button} = $ev->{button};	2918	$self->{button} = $ev->{button};
2653		2919
2654	$self->show;	2920	$self->show;
2655	$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);
2656	}	2922	}
2657		2923
2658	sub mouse_motion {	2924	sub mouse_motion {
2659	my ($self, $ev, $x, $y) = @_;	2925	my ($self, $ev, $x, $y) = @_;
2660		2926
2661	# TODO: should use vbox->find_widget or so	2927	# TODO: should use vbox->find_widget or so
2662	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2928	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2663	$self->{hover} = $self->{item}{$HOVER};	2929	$self->{hover} = $self->{item}{$HOVER};
		2930
		2931	0
2664	}	2932	}
2665		2933
2666	sub button_up {	2934	sub button_up {
2667	my ($self, $ev, $x, $y) = @_;	2935	my ($self, $ev, $x, $y) = @_;
2668		2936
2669	if ($ev->{button} == $self->{button}) {	2937	if ($ev->{button} == $self->{button}) {
2670	undef $GRAB;	2938	undef $GRAB;
2671	$self->hide;	2939	$self->hide;
2672		2940
2673	$self->emit ("popdown");	2941	$self->_emit ("popdown");
2674	$self->{hover}[1]->() if $self->{hover};	2942	$self->{hover}[1]->() if $self->{hover};
		2943	} else {
		2944	return 0
		2945	}
		2946
2675	}	2947	1
2676	}	2948	}
2677		2949
2678	#############################################################################	2950	#############################################################################
2679		2951
2680	package CFClient::UI::Root;	2952	package CFClient::UI::Multiplexer;
2681		2953
2682	our @ISA = CFClient::UI::Container::;	2954	our @ISA = CFClient::UI::Container::;
2683		2955
2684	use CFClient::OpenGL;	2956	sub new {
		2957	my $class = shift;
2685		2958
2686	sub check_size {	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 {
2687	my ($self) = @_;	2970	my ($self, @widgets) = @_;
2688		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;
2689	$self->configure (0, 0, $self->{w}, $self->{h});	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}
2690	}	2995	}
2691		2996
2692	sub size_request {	2997	sub size_request {
2693	my ($self) = @_;	2998	my ($self) = @_;
2694		2999
2695	($self->{w}, $self->{h})	3000	$self->{current}->size_request
2696	}	3001	}
2697		3002
2698	sub size_allocate {	3003	sub size_allocate {
2699	my ($self, $w, $h) = @_;	3004	my ($self, $w, $h) = @_;
2700		3005
2701	my $old_w = $self->{old_w};	3006	$self->{current}->configure (0, 0, $w, $h);
2702	my $old_h = $self->{old_h};	3007	}
2703		3008
2704	if ($old_w && $old_h) {	3009	sub _draw {
2705	for my $child ($self->children) {	3010	my ($self) = @_;
2706	$child->{x} = int 0.5 + $child->{x} * $w / $old_w;	3011
2707	$child->{w} = int 0.5 + $child->{w} * $w / $old_w;	3012	$self->{current}->draw;
2708	$child->{req_w} = int 0.5 + $child->{req_w} * $w / $old_w if exists $child->{req_w};	3013	}
2709	$child->{user_w} = int 0.5 + $child->{user_w} * $w / $old_w if exists $child->{user_w};	3014
2710	$child->{y} = int 0.5 + $child->{y} * $h / $old_h;	3015	#############################################################################
2711	$child->{h} = int 0.5 + $child->{h} * $h / $old_h;	3016
2712	$child->{req_h} = int 0.5 + $child->{req_h} * $h / $old_h if exists $child->{req_h};	3017	package CFClient::UI::Notebook;
2713	$child->{user_h} = int 0.5 + $child->{user_h} * $h / $old_h if exists $child->{user_h};	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;
2714	}	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	};
2715	}	3151	}
2716		3152
2717	$self->{old_w} = $w;	3153	$self->reorder;
2718	$self->{old_h} = $h;
2719	}	3154	}
2720		3155
2721	sub configure {	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;
		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;
		3460	}
		3461
		3462	#############################################################################
		3463
		3464	package CFClient::UI::Root;
		3465
		3466	our @ISA = CFClient::UI::Container::;
		3467
		3468	use CFClient::OpenGL;
		3469
		3470	sub new {
		3471	my $class = shift;
		3472
		3473	my $self = $class->SUPER::new (
		3474	visible => 1,
		3475	@_,
		3476	);
		3477
		3478	Scalar::Util::weaken ($self->{root} = $self);
		3479
		3480	$self
		3481	}
		3482
		3483	sub size_request {
		3484	my ($self) = @_;
		3485
		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 {
2722	my ($self, $x, $y, $w, $h) = @_;	3504	my ($self, $w, $h) = @_;
2723
2724	$self->SUPER::configure ($x, $y, $w, $h);
2725		3505
2726	for my $child ($self->children) {	3506	for my $child ($self->children) {
2727	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)};
2728		3508
2729	$X = List::Util::max 0, List::Util::min $w - $W, $X;	3509	$X = $child->{force_x} if exists $child->{force_x};
2730	$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
2731	$child->configure ($X, $Y, $W, $H);	3515	$child->configure ($X, $Y, $W, $H);
2732	}	3516	}
2733	}	3517	}
2734		3518
2735	sub _topleft {	3519	sub coord2local {
2736	my ($self, $x, $y) = @_;	3520	my ($self, $x, $y) = @_;
2737		3521
2738	($x, $y)	3522	($x, $y)
2739	}	3523	}
2740		3524
		3525	sub coord2global {
		3526	my ($self, $x, $y) = @_;
		3527
		3528	($x, $y)
		3529	}
		3530
2741	sub update {	3531	sub update {
2742	my ($self) = @_;	3532	my ($self) = @_;
2743		3533
2744	$self->check_size;	3534	$::WANT_REFRESH++;
2745	::refresh ();
2746	}	3535	}
2747		3536
2748	sub add {	3537	sub add {
2749	my ($self, $child) = @_;	3538	my ($self, @children) = @_;
2750		3539
2751	# integerize window positions	3540	$_->{is_toplevel} = 1
2752	$child->{x} = int $child->{x};	3541	for @children;
2753	$child->{y} = int $child->{y};
2754		3542
2755	$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	}
2756	}	3559	}
2757		3560
2758	sub on_refresh {	3561	sub on_refresh {
2759	my ($self, $id, $cb) = @_;	3562	my ($self, $id, $cb) = @_;
2760		3563
2761	$self->{refresh_hook}{$id} = $cb;	3564	$self->{refresh_hook}{$id} = $cb;
2762	}	3565	}
2763		3566
		3567	sub on_post_alloc {
		3568	my ($self, $id, $cb) = @_;
		3569
		3570	$self->{post_alloc_hook}{$id} = $cb;
		3571	}
		3572
2764	sub draw {	3573	sub draw {
2765	my ($self) = @_;	3574	my ($self) = @_;
2766		3575
2767	while (my $rcb = delete $self->{refresh_hook}) {	3576	while ($self->{refresh_hook}) {
2768	$_->() for values %$rcb;	3577	$_->()
		3578	for values %{delete $self->{refresh_hook}};
2769	}	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
2770		3669
2771	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3670	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2772	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3671	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2773	glClear GL_COLOR_BUFFER_BIT;	3672	glClear GL_COLOR_BUFFER_BIT;
2774		3673
2775	glMatrixMode GL_PROJECTION;	3674	glMatrixMode GL_PROJECTION;
2776	glLoadIdentity;	3675	glLoadIdentity;
2777	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;	3676	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2778	glMatrixMode GL_MODELVIEW;	3677	glMatrixMode GL_MODELVIEW;
2779	glLoadIdentity;	3678	glLoadIdentity;
2780		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
2781	$self->_draw;	3687	$self->_draw;
2782	}	3688	}
2783		3689
2784	#############################################################################	3690	#############################################################################
2785		3691
2786	package CFClient::UI;	3692	package CFClient::UI;
2787		3693
2788	$ROOT = new CFClient::UI::Root;	3694	$ROOT = new CFClient::UI::Root;
2789	$TOOLTIP = new CFClient::UI::Tooltip;	3695	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2790		3696
2791	1	3697	1
2792		3698

Diff Legend

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