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.197 by root, Fri May 12 01:47:04 2006 UTC vs.
Revision 1.286 by root, Mon Jun 5 03:48:49 2006 UTC

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

Diff Legend

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