ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/DC/UI.pm

Comparing deliantra/Deliantra-Client/DC/UI.pm (file contents):
Revision 1.174 by root, Tue Apr 25 11:18:49 2006 UTC vs.
Revision 1.278 by root, Sun Jun 4 23:05:06 2006 UTC

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

Diff Legend

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