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.287 by root, Mon Jun 5 05:31:13 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}
1350
1351	$self->{ox} = int $self->{align} < 0 ? $self->{padding}
1352	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1353	: ($self->{w} - $tex->{w}) * 0.5;
1354
1355	$self->{oy} = int $self->{valign} < 0 ? $self->{padding}
1356	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1357	: ($self->{h} - $tex->{h}) * 0.5;
1358
1359	$tex
1360	};	1641	};
1361		1642
		1643	unless (exists $self->{ox}) {
		1644	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
		1645	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
		1646	: ($self->{w} - $tex->{w}) * 0.5);
		1647
		1648	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
		1649	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
		1650	: ($self->{h} - $tex->{h}) * 0.5);
		1651	};
		1652
1362	glEnable GL_TEXTURE_2D;	1653	glEnable GL_TEXTURE_2D;
1363	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1364		1654
1365	if ($tex->{format} == GL_ALPHA) {	1655	if ($tex->{format} == GL_ALPHA) {
		1656	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1366	glColor @{$self->{fg}};	1657	glColor @{$self->{fg}};
1367	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1658	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1368	} else {	1659	} else {
		1660	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1369	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1661	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1370	}	1662	}
1371		1663
1372	glDisable GL_TEXTURE_2D;	1664	glDisable GL_TEXTURE_2D;
1373	}	1665	}
…		…
1390	active_fg => [0, 0, 0],	1682	active_fg => [0, 0, 0],
1391	can_hover => 1,	1683	can_hover => 1,
1392	can_focus => 1,	1684	can_focus => 1,
1393	valign => 0,	1685	valign => 0,
1394	can_events => 1,	1686	can_events => 1,
		1687	#text => ...
1395	@_	1688	@_
1396	)	1689	)
1397	}	1690	}
1398		1691
1399	sub _set_text {	1692	sub _set_text {
…		…
1401		1694
1402	delete $self->{cur_h};	1695	delete $self->{cur_h};
1403		1696
1404	return if $self->{text} eq $text;	1697	return if $self->{text} eq $text;
1405		1698
1406	delete $self->{texture};
1407
1408	$self->{last_activity} = $::NOW;	1699	$self->{last_activity} = $::NOW;
1409	$self->{text} = $text;	1700	$self->{text} = $text;
1410		1701
1411	$text =~ s/./*/g if $self->{hidden};	1702	$text =~ s/./*/g if $self->{hidden};
1412	$self->{layout}->set_text ("$text ");	1703	$self->{layout}->set_text ("$text ");
		1704	delete $self->{req_h};
1413		1705
1414	$self->emit (changed => $self->{text});	1706	$self->_emit (changed => $self->{text});
		1707
		1708	$self->realloc;
		1709	$self->update;
1415	}	1710	}
1416		1711
1417	sub set_text {	1712	sub set_text {
1418	my ($self, $text) = @_;	1713	my ($self, $text) = @_;
1419		1714
1420	$self->{cursor} = length $text;	1715	$self->{cursor} = length $text;
1421	$self->_set_text ($text);	1716	$self->_set_text ($text);
1422	$self->check_size;
1423	$self->update;
1424	}	1717	}
1425		1718
1426	sub get_text {	1719	sub get_text {
1427	$_[0]{text}	1720	$_[0]{text}
1428	}	1721	}
…		…
1431	my ($self) = @_;	1724	my ($self) = @_;
1432		1725
1433	my ($w, $h) = $self->SUPER::size_request;	1726	my ($w, $h) = $self->SUPER::size_request;
1434		1727
1435	($w + 1, $h) # add 1 for cursor	1728	($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	}	1729	}
1443		1730
1444	sub key_down {	1731	sub key_down {
1445	my ($self, $ev) = @_;	1732	my ($self, $ev) = @_;
1446		1733
…		…
1448	my $sym = $ev->{sym};	1735	my $sym = $ev->{sym};
1449	my $uni = $ev->{unicode};	1736	my $uni = $ev->{unicode};
1450		1737
1451	my $text = $self->get_text;	1738	my $text = $self->get_text;
1452		1739
1453	if ($sym == 8) {	1740	if ($uni == 8) {
1454	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1741	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1455	} elsif ($sym == 127) {	1742	} elsif ($uni == 127) {
1456	substr $text, $self->{cursor}, 1, "";	1743	substr $text, $self->{cursor}, 1, "";
1457	} elsif ($sym == CFClient::SDLK_LEFT) {	1744	} elsif ($sym == CFClient::SDLK_LEFT) {
1458	--$self->{cursor} if $self->{cursor};	1745	--$self->{cursor} if $self->{cursor};
1459	} elsif ($sym == CFClient::SDLK_RIGHT) {	1746	} elsif ($sym == CFClient::SDLK_RIGHT) {
1460	++$self->{cursor} if $self->{cursor} < length $self->{text};	1747	++$self->{cursor} if $self->{cursor} < length $self->{text};
1461	} elsif ($sym == CFClient::SDLK_HOME) {	1748	} elsif ($sym == CFClient::SDLK_HOME) {
1462	$self->{cursor} = 0;	1749	$self->{cursor} = 0;
1463	} elsif ($sym == CFClient::SDLK_END) {	1750	} elsif ($sym == CFClient::SDLK_END) {
1464	$self->{cursor} = length $text;	1751	$self->{cursor} = length $text;
1465	} elsif ($sym == 27) {	1752	} elsif ($uni == 27) {
1466	$self->emit ('escape');	1753	$self->_emit ('escape');
1467	} elsif ($uni) {	1754	} elsif ($uni) {
1468	substr $text, $self->{cursor}++, 0, chr $uni;	1755	substr $text, $self->{cursor}++, 0, chr $uni;
		1756	} else {
		1757	return 0;
1469	}	1758	}
1470		1759
1471	$self->_set_text ($text);	1760	$self->_set_text ($text);
1472	$self->update;	1761
		1762	$self->realloc;
		1763
		1764	1
1473	}	1765	}
1474		1766
1475	sub focus_in {	1767	sub focus_in {
1476	my ($self) = @_;	1768	my ($self) = @_;
1477		1769
…		…
1492	utf8::encode $text;	1784	utf8::encode $text;
1493	$self->{cursor} = length substr $text, 0, $idx;	1785	$self->{cursor} = length substr $text, 0, $idx;
1494		1786
1495	$self->_set_text ($self->{text});	1787	$self->_set_text ($self->{text});
1496	$self->update;	1788	$self->update;
		1789
		1790	1
1497	}	1791	}
1498		1792
1499	sub mouse_motion {	1793	sub mouse_motion {
1500	my ($self, $ev, $x, $y) = @_;	1794	my ($self, $ev, $x, $y) = @_;
1501	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1795	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1796
		1797	0
1502	}	1798	}
1503		1799
1504	sub _draw {	1800	sub _draw {
1505	my ($self) = @_;	1801	my ($self) = @_;
1506		1802
1507	local $self->{fg} = $self->{fg};	1803	local $self->{fg} = $self->{fg};
1508		1804
1509	if ($FOCUS == $self) {	1805	if ($FOCUS == $self) {
1510	glColor @{$self->{active_bg}};	1806	glColor_premultiply @{$self->{active_bg}};
1511	$self->{fg} = $self->{active_fg};	1807	$self->{fg} = $self->{active_fg};
1512	} else {	1808	} else {
1513	glColor @{$self->{bg}};	1809	glColor_premultiply @{$self->{bg}};
1514	}	1810	}
1515		1811
1516	glEnable GL_BLEND;	1812	glEnable GL_BLEND;
1517	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1813	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1518	glBegin GL_QUADS;	1814	glBegin GL_QUADS;
1519	glVertex 0 , 0;	1815	glVertex 0 , 0;
1520	glVertex 0 , $self->{h};	1816	glVertex 0 , $self->{h};
1521	glVertex $self->{w}, $self->{h};	1817	glVertex $self->{w}, $self->{h};
1522	glVertex $self->{w}, 0;	1818	glVertex $self->{w}, 0;
…		…
1557	if ($sym == 13) {	1853	if ($sym == 13) {
1558	unshift @{$self->{history}},	1854	unshift @{$self->{history}},
1559	my $txt = $self->get_text;	1855	my $txt = $self->get_text;
1560	$self->{history_pointer} = -1;	1856	$self->{history_pointer} = -1;
1561	$self->{history_saveback} = '';	1857	$self->{history_saveback} = '';
1562	$self->emit (activate => $txt);	1858	$self->_emit (activate => $txt);
1563	$self->update;	1859	$self->update;
1564		1860
1565	} elsif ($sym == CFClient::SDLK_UP) {	1861	} elsif ($sym == CFClient::SDLK_UP) {
1566	if ($self->{history_pointer} < 0) {	1862	if ($self->{history_pointer} < 0) {
1567	$self->{history_saveback} = $self->get_text;	1863	$self->{history_saveback} = $self->get_text;
…		…
1583	} else {	1879	} else {
1584	$self->set_text ($self->{history_saveback});	1880	$self->set_text ($self->{history_saveback});
1585	}	1881	}
1586		1882
1587	} else {	1883	} else {
1588	$self->SUPER::key_down ($ev);	1884	return $self->SUPER::key_down ($ev)
		1885	}
		1886
1589	}	1887	1
1590
1591	}	1888	}
1592		1889
1593	#############################################################################	1890	#############################################################################
1594		1891
1595	package CFClient::UI::Button;	1892	package CFClient::UI::Button;
…		…
1604		1901
1605	sub new {	1902	sub new {
1606	my $class = shift;	1903	my $class = shift;
1607		1904
1608	$class->SUPER::new (	1905	$class->SUPER::new (
1609	padding => 4,	1906	padding_x => 4,
		1907	padding_y => 4,
1610	fg => [1, 1, 1],	1908	fg => [1, 1, 1],
1611	bg => [1, 1, 1, 0.2],
1612	active_fg => [0, 0, 1],	1909	active_fg => [0, 0, 1],
1613	can_hover => 1,	1910	can_hover => 1,
1614	align => 0,	1911	align => 0,
1615	valign => 0,	1912	valign => 0,
1616	can_events => 1,	1913	can_events => 1,
1617	@_	1914	@_
1618	)	1915	)
1619	}	1916	}
1620		1917
		1918	sub activate { }
		1919
1621	sub button_up {	1920	sub button_up {
1622	my ($self, $ev, $x, $y) = @_;	1921	my ($self, $ev, $x, $y) = @_;
1623		1922
		1923	$self->emit ("activate")
1624	if ($x >= 0 && $x < $self->{w}	1924	if $x >= 0 && $x < $self->{w}
1625	&& $y >= 0 && $y < $self->{h}) {	1925	&& $y >= 0 && $y < $self->{h};
1626	$self->emit ("activate");	1926
1627	}	1927	1
1628	}	1928	}
1629		1929
1630	sub _draw {	1930	sub _draw {
1631	my ($self) = @_;	1931	my ($self) = @_;
1632		1932
1633	local $self->{fg} = $self->{fg};	1933	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1634
1635	if ($GRAB == $self) {
1636	$self->{fg} = $self->{active_fg};
1637	}
1638		1934
1639	glEnable GL_TEXTURE_2D;	1935	glEnable GL_TEXTURE_2D;
1640	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1936	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1641	glColor 0, 0, 0, 1;	1937	glColor 0, 0, 0, 1;
1642		1938
…		…
1661		1957
1662	sub new {	1958	sub new {
1663	my $class = shift;	1959	my $class = shift;
1664		1960
1665	$class->SUPER::new (	1961	$class->SUPER::new (
1666	padding => 2,	1962	padding_x => 2,
		1963	padding_y => 2,
1667	fg => [1, 1, 1],	1964	fg => [1, 1, 1],
1668	active_fg => [1, 1, 0],	1965	active_fg => [1, 1, 0],
		1966	bg => [0, 0, 0, 0.2],
		1967	active_bg => [1, 1, 1, 0.5],
1669	state => 0,	1968	state => 0,
1670	can_hover => 1,	1969	can_hover => 1,
1671	@_	1970	@_
1672	)	1971	)
1673	}	1972	}
1674		1973
1675	sub size_request {	1974	sub size_request {
1676	my ($self) = @_;	1975	my ($self) = @_;
1677		1976
1678	($self->{padding} * 2 + 6) x 2	1977	(6) x 2
1679	}	1978	}
1680		1979
1681	sub button_down {	1980	sub button_down {
1682	my ($self, $ev, $x, $y) = @_;	1981	my ($self, $ev, $x, $y) = @_;
1683		1982
1684	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1983	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1685	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1984	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1686	$self->{state} = !$self->{state};	1985	$self->{state} = !$self->{state};
1687	$self->emit (changed => $self->{state});	1986	$self->_emit (changed => $self->{state});
		1987	} else {
		1988	return 0
		1989	}
		1990
1688	}	1991	1
1689	}	1992	}
1690		1993
1691	sub _draw {	1994	sub _draw {
1692	my ($self) = @_;	1995	my ($self) = @_;
1693		1996
1694	$self->SUPER::_draw;	1997	$self->SUPER::_draw;
1695		1998
1696	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	1999	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1697		2000
1698	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	2001	my ($w, $h) = @$self{qw(w h)};
		2002
		2003	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1699		2004
1700	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2005	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1701		2006
1702	my $tex = $self->{state} ? $tex[1] : $tex[0];	2007	my $tex = $self->{state} ? $tex[1] : $tex[0];
1703		2008
…		…
1858		2163
1859	my $h1 = $self->{h} * (1 - $ycut1);	2164	my $h1 = $self->{h} * (1 - $ycut1);
1860	my $h2 = $self->{h} * (1 - $ycut2);	2165	my $h2 = $self->{h} * (1 - $ycut2);
1861		2166
1862	glEnable GL_BLEND;	2167	glEnable GL_BLEND;
1863	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2168	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2169	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1864	glEnable GL_TEXTURE_2D;	2170	glEnable GL_TEXTURE_2D;
1865	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2171	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1866		2172
1867	glBindTexture GL_TEXTURE_2D, $t1->{name};	2173	glBindTexture GL_TEXTURE_2D, $t1->{name};
1868	glBegin GL_QUADS;	2174	glBegin GL_QUADS;
…		…
1957	qw(s1_slider.png s1_slider_bg.png);	2263	qw(s1_slider.png s1_slider_bg.png);
1958		2264
1959	sub new {	2265	sub new {
1960	my $class = shift;	2266	my $class = shift;
1961		2267
1962	# range [value, low, high, page]	2268	# range [value, low, high, page, unit]
1963		2269
1964	# TODO: 0-width page	2270	# TODO: 0-width page
1965	# TODO: req_w/h are wrong with vertical	2271	# TODO: req_w/h are wrong with vertical
1966	# TODO: calculations are off	2272	# TODO: calculations are off
1967	my $self = $class->SUPER::new (	2273	my $self = $class->SUPER::new (
1968	fg => [1, 1, 1],	2274	fg => [1, 1, 1],
1969	active_fg => [0, 0, 0],	2275	active_fg => [0, 0, 0],
		2276	bg => [0, 0, 0, 0.2],
		2277	active_bg => [1, 1, 1, 0.5],
1970	range => [0, 0, 100, 10],	2278	range => [0, 0, 100, 10, 0],
1971	req_w => $::WIDTH / 80,	2279	min_w => $::WIDTH / 80,
1972	req_h => $::WIDTH / 80,	2280	min_h => $::WIDTH / 80,
1973	vertical => 0,	2281	vertical => 0,
1974	can_hover => 1,	2282	can_hover => 1,
1975	inner_pad => 5,	2283	inner_pad => 0.02,
1976	@_	2284	@_
1977	);	2285	);
1978		2286
		2287	$self->set_value ($self->{range}[0]);
		2288	$self->update;
		2289
1979	$self	2290	$self
1980	}	2291	}
1981		2292
		2293	sub changed { }
		2294
		2295	sub set_range {
		2296	my ($self, $range) = @_;
		2297
		2298	($range, $self->{range}) = ($self->{range}, $range);
		2299
		2300	$self->update
		2301	if "@$range" ne "@{$self->{range}}";
		2302	}
		2303
		2304	sub set_value {
		2305	my ($self, $value) = @_;
		2306
		2307	my ($old_value, $lo, $hi, $page, $unit) = @{$self->{range}};
		2308
		2309	$hi = $lo + 1 if $hi <= $lo;
		2310
		2311	$page = $hi - $lo if $page > $hi - $lo;
		2312
		2313	$value = $lo if $value < $lo;
		2314	$value = $hi - $page if $value > $hi - $page;
		2315
		2316	$value = $lo + $unit * int +($value - $lo + $unit * 0.5) / $unit
		2317	if $unit;
		2318
		2319	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
		2320
		2321	if ($value != $old_value) {
		2322	$self->_emit (changed => $value);
		2323	$self->update;
		2324	}
		2325	}
		2326
1982	sub size_request {	2327	sub size_request {
1983	my ($self) = @_;	2328	my ($self) = @_;
1984		2329
1985	my $w = $self->{req_w};	2330	($self->{req_w}, $self->{req_h})
1986	my $h = $self->{req_h};
1987
1988	$self->{vertical} ? ($h, $w) : ($w, $h)
1989	}	2331	}
1990		2332
1991	sub button_down {	2333	sub button_down {
1992	my ($self, $ev, $x, $y) = @_;	2334	my ($self, $ev, $x, $y) = @_;
1993		2335
1994	$self->SUPER::button_down ($ev, $x, $y);	2336	$self->SUPER::button_down ($ev, $x, $y);
		2337
		2338	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
		2339
1995	$self->mouse_motion ($ev, $x, $y);	2340	$self->mouse_motion ($ev, $x, $y)
1996	}	2341	}
1997		2342
1998	sub mouse_motion {	2343	sub mouse_motion {
1999	my ($self, $ev, $x, $y) = @_;	2344	my ($self, $ev, $x, $y) = @_;
2000		2345
2001	if ($GRAB == $self) {	2346	if ($GRAB == $self) {
		2347	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
		2348
		2349	my (undef, $lo, $hi, $page) = @{$self->{range}};
		2350
		2351	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
		2352
		2353	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2354	} else {
		2355	return 0;
		2356	}
		2357
		2358	1
		2359	}
		2360
		2361	sub update {
		2362	my ($self) = @_;
		2363
		2364	delete $self->{knob_w};
		2365	$self->SUPER::update;
		2366	}
		2367
		2368	sub _draw {
		2369	my ($self) = @_;
		2370
		2371	unless ($self->{knob_w}) {
		2372	$self->set_value ($self->{range}[0]);
		2373
2002	my ($value, $lo, $hi, $page) = @{$self->{range}};	2374	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2375	my $range = ($hi - $page - $lo) || 1e-100;
2003		2376
2004	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2377	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
2005		2378
2006	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2379	$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	2380	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
2008		2381
2009	$x -= $inner_pad_px; # substract the padding	2382	$value = ($value - $lo) / $range;
2010	$x = $x * ($hi - $lo) / $inner_w + $lo;	2383	$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		2384
2015	$self->emit (changed => $x);	2385	$self->{knob_x} = $value - $knob_w * 0.5;
2016	$self->update;	2386	$self->{knob_w} = $knob_w;
2017	}	2387	}
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		2388
2031	$self->SUPER::_draw ();	2389	$self->SUPER::_draw ();
2032		2390
2033	my ($w, $h) = @$self{qw(w h)};	2391	glScale $self->{w}, $self->{h};
2034		2392
2035	if ($self->{vertical}) {	2393	if ($self->{vertical}) {
2036	# draw a vertical slider like a rotated horizontal slider	2394	# draw a vertical slider like a rotated horizontal slider
2037		2395
		2396	glTranslate 1, 0, 0;
2038	glRotate 90, 0, 0, 1;	2397	glRotate 90, 0, 0, 1;
2039	glTranslate 0, -$self->{w}, 0;
2040
2041	($w, $h) = ($h, $w);
2042	}	2398	}
2043		2399
2044	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2400	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2045	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2401	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2046		2402
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;	2403	glEnable GL_TEXTURE_2D;
2066	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2404	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2067		2405
2068	# draw background	2406	# draw background
2069	$tex[1]->draw_quad_alpha (0, 0, $w, $h);	2407	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
2070		2408
2071	# draw handle	2409	# draw handle
2072	$tex[0]->draw_quad_alpha ($knob_a, 0, $knob_b - $knob_a, $h);	2410	$tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2073		2411
2074	glDisable GL_TEXTURE_2D;	2412	glDisable GL_TEXTURE_2D;
2075	}	2413	}
		2414
		2415	#############################################################################
		2416
		2417	package CFClient::UI::ValSlider;
		2418
		2419	our @ISA = CFClient::UI::HBox::;
		2420
		2421	sub new {
		2422	my ($class, %arg) = @_;
		2423
		2424	my $range = delete $arg{range};
		2425
		2426	my $self = $class->SUPER::new (
		2427	slider => (new CFClient::UI::Slider expand => 1, range => $range),
		2428	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),
		2429	to_value => sub { shift },
		2430	from_value => sub { shift },
		2431	%arg,
		2432	);
		2433
		2434	$self->{slider}->connect (changed => sub {
		2435	my ($self, $value) = @_;
		2436	$self->{parent}{entry}->set_text ($self->{parent}{to_value}->($value));
		2437	$self->{parent}->emit (changed => $value);
		2438	});
		2439
		2440	# $self->{entry}->connect (changed => sub {
		2441	# my ($self, $value) = @_;
		2442	# $self->{parent}{slider}->set_value ($self->{parent}{from_value}->($value));
		2443	# $self->{parent}->emit (changed => $value);
		2444	# });
		2445
		2446	$self->add ($self->{slider}, $self->{entry});
		2447
		2448	$self->{slider}->emit (changed => $self->{slider}{range}[0]);
		2449
		2450	$self
		2451	}
		2452
		2453	sub set_range { shift->{slider}->set_range (@_) }
		2454	sub set_value { shift->{slider}->set_value (@_) }
2076		2455
2077	#############################################################################	2456	#############################################################################
2078		2457
2079	package CFClient::UI::TextView;	2458	package CFClient::UI::TextView;
2080		2459
…		…
2110		2489
2111	$self->{fontsize} = $fontsize;	2490	$self->{fontsize} = $fontsize;
2112	$self->reflow;	2491	$self->reflow;
2113	}	2492	}
2114		2493
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 {	2494	sub size_allocate {
2135	my ($self, $w, $h) = @_;	2495	my ($self, $w, $h) = @_;
2136		2496
2137	$self->SUPER::size_allocate ($w, $h);	2497	$self->SUPER::size_allocate ($w, $h);
2138		2498
…		…
2141	$self->{layout}->set_width ($self->{children}[0]{w});	2501	$self->{layout}->set_width ($self->{children}[0]{w});
2142		2502
2143	$self->reflow;	2503	$self->reflow;
2144	}	2504	}
2145		2505
		2506	sub text_size {
		2507	my ($self, $text, $indent) = @_;
		2508
		2509	my $layout = $self->{layout};
		2510
		2511	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2512	$layout->set_width ($self->{children}[0]{w} - $indent);
		2513	$layout->set_markup ($text);
		2514
		2515	$layout->size
		2516	}
		2517
		2518	sub reflow {
		2519	my ($self) = @_;
		2520
		2521	$self->{need_reflow}++;
		2522	$self->update;
		2523	}
		2524
		2525	sub set_offset {
		2526	my ($self, $offset) = @_;
		2527
		2528	# todo: base offset on lines or so, not on pixels
		2529	$self->{children}[1]->set_value ($offset);
		2530	}
		2531
		2532	sub clear {
		2533	my ($self) = @_;
		2534
		2535	$self->{par} = [];
		2536	$self->{height} = 0;
		2537	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
		2538	}
		2539
2146	sub add_paragraph {	2540	sub add_paragraph {
2147	my ($self, $color, $text) = @_;	2541	my ($self, $color, $text, $indent) = @_;
2148		2542
2149	#TODO: intelligently "reformat" paragraph	2543	for my $line (split /\n/, $text) {
2150		2544	my ($w, $h) = $self->text_size ($line);
2151	my $height = $self->text_height ($text);
2152
2153	$self->{height} += $height;	2545	$self->{height} += $h;
		2546	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
		2547	}
2154		2548
2155	push @{$self->{par}}, [$height, $color, $text];
2156
2157	$self->{children}[1]{range} = [$self->{height} - $self->{h}, 0, $self->{height}, $self->{h}];	2549	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);
2158	$self->{children}[1]->update;
2159	}	2550	}
2160		2551
2161	sub update {	2552	sub update {
2162	my ($self) = @_;	2553	my ($self) = @_;
2163		2554
…		…
2165		2556
2166	return unless $self->{h} > 0;	2557	return unless $self->{h} > 0;
2167		2558
2168	delete $self->{texture};	2559	delete $self->{texture};
2169		2560
2170	$ROOT->on_refresh ($self, sub {	2561	$ROOT->on_post_alloc ($self, sub {
		2562	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2563
2171	if (delete $self->{need_reflow}) {	2564	if (delete $self->{need_reflow}) {
2172	my $height = 0;	2565	my $height = 0;
2173		2566
2174	$height += $_->[0] = $self->text_height ($_->[2])	2567	my $layout = $self->{layout};
		2568
		2569	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2570
2175	for @{$self->{par}};	2571	for (@{$self->{par}}) {
		2572	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
		2573	$layout->set_width ($W - $_->[3]);
		2574	$layout->set_markup ($_->[4]);
		2575	my ($w, $h) = $layout->size;
		2576	$_->[0] = $w + $_->[3];
		2577	$_->[1] = $h;
		2578	}
		2579
		2580	$height += $_->[1];
		2581	}
2176		2582
2177	$self->{height} = $height;	2583	$self->{height} = $height;
2178		2584
2179	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2585	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2180		2586
2181	delete $self->{texture};	2587	delete $self->{texture};
2182	}	2588	}
2183		2589
2184	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{children}[0]{w}, $self->{children}[0]{h}, sub {	2590	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2185	glClearColor 0, 0, 0, 0;	2591	glClearColor 0, 0, 0, 0;
2186	glClear GL_COLOR_BUFFER_BIT;	2592	glClear GL_COLOR_BUFFER_BIT;
2187		2593
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];	2594	my $top = int $self->{children}[1]{range}[0];
2192		2595
2193	my $y0 = $top;	2596	my $y0 = $top;
2194	my $y1 = $top + $self->{h};	2597	my $y1 = $top + $H;
2195		2598
2196	my $y = 0;	2599	my $y = 0;
2197		2600
2198	my $layout = $self->{layout};	2601	my $layout = $self->{layout};
2199		2602
2200	$layout->set_font ($self->{font}) if $self->{font};	2603	$layout->set_font ($self->{font}) if $self->{font};
2201		2604
		2605	glEnable GL_BLEND;
		2606	#TODO# not correct in windows where rgba is forced off
		2607	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		2608
2202	for my $par (@{$self->{par}}) {	2609	for my $par (@{$self->{par}}) {
2203	my $h = $par->[0];	2610	my $h = $par->[1];
2204		2611
2205	if ($y0 < $y + $h && $y < $y1) {	2612	if ($y0 < $y + $h && $y < $y1) {
2206	$layout->set_foreground (@{ $par->[1] });	2613	$layout->set_foreground (@{ $par->[2] });
		2614	$layout->set_width ($W - $par->[3]);
2207	$layout->set_markup ($par->[2]);	2615	$layout->set_markup ($par->[4]);
2208		2616
2209	my ($W, $H) = $layout->size;	2617	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2210	CFClient::Texture->new_from_layout ($layout)->draw_quad_alpha_premultiplied (0, $y - $y0);	2618
		2619	glRasterPos $par->[3], $y - $y0;
		2620	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2211	}	2621	}
2212		2622
2213	$y += $h;	2623	$y += $h;
2214	}	2624	}
2215		2625
2216	glDisable GL_TEXTURE_2D;	2626	glDisable GL_BLEND;
2217	};	2627	};
2218	});	2628	});
2219	}	2629	}
2220		2630
2221	sub _draw {	2631	sub _draw {
2222	my ($self) = @_;	2632	my ($self) = @_;
2223		2633
2224	glEnable GL_TEXTURE_2D;	2634	glEnable GL_TEXTURE_2D;
2225	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2635	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2226	glColor 1, 1, 1, 1;	2636	glColor 0, 0, 0, 1;
2227	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2637	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2228	glDisable GL_TEXTURE_2D;	2638	glDisable GL_TEXTURE_2D;
2229		2639
2230	$self->{children}[1]->draw;	2640	$self->{children}[1]->draw;
2231		2641
…		…
2281		2691
2282	sub new {	2692	sub new {
2283	my $class = shift;	2693	my $class = shift;
2284		2694
2285	my $self = $class->SUPER::new (	2695	my $self = $class->SUPER::new (
2286	state => 0,	2696	state => 0,
2287	connect_activate => \&toggle_flopper,	2697	on_activate => \&toggle_flopper,
2288	@_	2698	@_
2289	);	2699	);
2290		2700
2291	if ($self->{state}) {
2292	$self->{state} = 0;
2293	$self->toggle_flopper;
2294	}
2295
2296	$self	2701	$self
2297	}	2702	}
2298		2703
2299	sub toggle_flopper {	2704	sub toggle_flopper {
2300	my ($self) = @_;	2705	my ($self) = @_;
2301		2706
2302	# TODO: use animation	2707	$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	}	2708	}
2314		2709
2315	#############################################################################	2710	#############################################################################
2316		2711
2317	package CFClient::UI::Tooltip;	2712	package CFClient::UI::Tooltip;
…		…
2330	}	2725	}
2331		2726
2332	sub set_tooltip_from {	2727	sub set_tooltip_from {
2333	my ($self, $widget) = @_;	2728	my ($self, $widget) = @_;
2334		2729
		2730	my $tooltip = $widget->{tooltip};
		2731
		2732	if ($ENV{CFPLUS_DEBUG} & 2) {
		2733	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2734	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2735	. "req $widget->{req_w} $widget->{req_h}\n"
		2736	. "visible $widget->{visible}";
		2737	}
		2738
2335	$self->add (new CFClient::UI::Label	2739	$self->add (new CFClient::UI::Label
2336	markup => $widget->{tooltip},	2740	markup => $tooltip,
2337	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2741	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2338	fontsize => 0.8,	2742	fontsize => 0.8,
2339	fg => [0, 0, 0, 1],	2743	fg => [0, 0, 0, 1],
		2744	ellipsise => 0,
2340	font => ($widget->{tooltip_font} || $::FONT_PROP),	2745	font => ($widget->{tooltip_font} || $::FONT_PROP),
2341	);	2746	);
2342	}	2747	}
2343		2748
2344	sub size_request {	2749	sub size_request {
2345	my ($self) = @_;	2750	my ($self) = @_;
…		…
2351		2756
2352	sub size_allocate {	2757	sub size_allocate {
2353	my ($self, $w, $h) = @_;	2758	my ($self, $w, $h) = @_;
2354		2759
2355	$self->SUPER::size_allocate ($w - 4, $h - 4);	2760	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2761	}
		2762
		2763	sub visibility_change {
		2764	my ($self, $visible) = @_;
		2765
		2766	return unless $visible;
		2767
		2768	$self->{root}->on_post_alloc ("move_$self" => sub {
		2769	my $widget = $self->{owner}
		2770	or return;
		2771
		2772	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2773
		2774	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2775	if $x + $self->{w} > $::WIDTH;
		2776
		2777	$self->move_abs ($x, $y);
		2778	});
2356	}	2779	}
2357		2780
2358	sub _draw {	2781	sub _draw {
2359	my ($self) = @_;	2782	my ($self) = @_;
2360		2783
…		…
2377	glVertex $w, $h;	2800	glVertex $w, $h;
2378	glVertex $w, 0;	2801	glVertex $w, 0;
2379	glEnd;	2802	glEnd;
2380		2803
2381	glTranslate 2 - 0.375, 2 - 0.375;	2804	glTranslate 2 - 0.375, 2 - 0.375;
		2805
2382	$self->SUPER::_draw;	2806	$self->SUPER::_draw;
2383	}	2807	}
2384		2808
2385	#############################################################################	2809	#############################################################################
2386		2810
…		…
2391	use CFClient::OpenGL;	2815	use CFClient::OpenGL;
2392		2816
2393	sub new {	2817	sub new {
2394	my $class = shift;	2818	my $class = shift;
2395		2819
2396	$class->SUPER::new (	2820	my $self = $class->SUPER::new (
2397	aspect => 1,	2821	aspect => 1,
		2822	can_events => 0,
2398	@_,	2823	@_,
2399	)	2824	);
		2825
		2826	if ($self->{anim} && $self->{animspeed}) {
		2827	Scalar::Util::weaken (my $widget = $self);
		2828
		2829	$self->{timer} = Event->timer (
		2830	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
		2831	hard => 1,
		2832	interval => $self->{animspeed},
		2833	cb => sub {
		2834	++$widget->{frame};
		2835	$widget->update;
		2836	},
		2837	);
		2838	}
		2839
		2840	$self
2400	}	2841	}
2401		2842
2402	sub size_request {	2843	sub size_request {
2403	(32, 8)	2844	(32, 8)
2404	}	2845	}
2405		2846
		2847	sub update {
		2848	my ($self) = @_;
		2849
		2850	return unless $self->{visible};
		2851
		2852	$self->SUPER::update;
		2853	}
		2854
2406	sub _draw {	2855	sub _draw {
2407	my ($self) = @_;	2856	my ($self) = @_;
2408		2857
2409	return unless $::CONN;#d# manage and cache textures differently	2858	return unless $::CONN;
		2859
		2860	my $face;
		2861
		2862	if ($self->{frame}) {
		2863	my $anim = $::CONN->{anim}[$self->{anim}];
		2864
		2865	$face = $anim->[ $self->{frame} % @$anim ]
		2866	if $anim && @$anim;
		2867	}
		2868
2410	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	2869	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2411		2870
2412	# TODO animation
2413	if ($tex) {	2871	if ($tex) {
2414	glEnable GL_TEXTURE_2D;	2872	glEnable GL_TEXTURE_2D;
2415	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2873	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2416	glColor 1, 1, 1, 1;	2874	glColor 0, 0, 0, 1;
2417	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2875	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2418	glDisable GL_TEXTURE_2D;	2876	glDisable GL_TEXTURE_2D;
2419	}	2877	}
2420	}	2878	}
2421		2879
		2880	sub DESTROY {
		2881	my ($self) = @_;
		2882
		2883	$self->{timer}->cancel
		2884	if $self->{timer};
		2885
		2886	$self->SUPER::DESTROY;
		2887	}
		2888
2422	#############################################################################	2889	#############################################################################
2423		2890
2424	package CFClient::UI::InventoryItem;	2891	package CFClient::UI::Buttonbar;
2425		2892
2426	our @ISA = CFClient::UI::HBox::;	2893	our @ISA = CFClient::UI::HBox::;
2427		2894
2428	sub new {	2895	# 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		2896
2531	#############################################################################	2897	#############################################################################
2532		2898
2533	package CFClient::UI::Menu;	2899	package CFClient::UI::Menu;
2534		2900
…		…
2568		2934
2569	# popup given the event (must be a mouse button down event currently)	2935	# popup given the event (must be a mouse button down event currently)
2570	sub popup {	2936	sub popup {
2571	my ($self, $ev) = @_;	2937	my ($self, $ev) = @_;
2572		2938
2573	$self->emit ("popdown");	2939	$self->_emit ("popdown");
2574		2940
2575	# maybe save $GRAB? must be careful about events...	2941	# maybe save $GRAB? must be careful about events...
2576	$GRAB = $self;	2942	$GRAB = $self;
2577	$self->{button} = $ev->{button};	2943	$self->{button} = $ev->{button};
2578		2944
2579	$self->show;	2945	$self->show;
2580	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2946	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2581	}	2947	}
2582		2948
2583	sub mouse_motion {	2949	sub mouse_motion {
2584	my ($self, $ev, $x, $y) = @_;	2950	my ($self, $ev, $x, $y) = @_;
2585		2951
2586	# TODO: should use vbox->find_widget or so	2952	# TODO: should use vbox->find_widget or so
2587	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2953	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2588	$self->{hover} = $self->{item}{$HOVER};	2954	$self->{hover} = $self->{item}{$HOVER};
		2955
		2956	0
2589	}	2957	}
2590		2958
2591	sub button_up {	2959	sub button_up {
2592	my ($self, $ev, $x, $y) = @_;	2960	my ($self, $ev, $x, $y) = @_;
2593		2961
2594	if ($ev->{button} == $self->{button}) {	2962	if ($ev->{button} == $self->{button}) {
2595	undef $GRAB;	2963	undef $GRAB;
2596	$self->hide;	2964	$self->hide;
2597		2965
2598	$self->emit ("popdown");	2966	$self->_emit ("popdown");
2599	$self->{hover}[1]->() if $self->{hover};	2967	$self->{hover}[1]->() if $self->{hover};
		2968	} else {
		2969	return 0
		2970	}
		2971
2600	}	2972	1
2601	}	2973	}
2602		2974
2603	#############################################################################	2975	#############################################################################
2604		2976
		2977	package CFClient::UI::Multiplexer;
		2978
		2979	our @ISA = CFClient::UI::Container::;
		2980
		2981	sub new {
		2982	my $class = shift;
		2983
		2984	my $self = $class->SUPER::new (
		2985	@_,
		2986	);
		2987
		2988	$self->{current} = $self->{children}[0]
		2989	if @{ $self->{children} };
		2990
		2991	$self
		2992	}
		2993
		2994	sub add {
		2995	my ($self, @widgets) = @_;
		2996
		2997	$self->SUPER::add (@widgets);
		2998
		2999	$self->{current} = $self->{children}[0]
		3000	if @{ $self->{children} };
		3001	}
		3002
		3003	sub set_current_page {
		3004	my ($self, $page_or_widget) = @_;
		3005
		3006	my $widget = ref $page_or_widget
		3007	? $page_or_widget
		3008	: $self->{children}[$page_or_widget];
		3009
		3010	$self->{current} = $widget;
		3011	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3012
		3013	$self->_emit (page_changed => $self->{current});
		3014
		3015	$self->realloc;
		3016	}
		3017
		3018	sub visible_children {
		3019	$_[0]{current}
		3020	}
		3021
		3022	sub size_request {
		3023	my ($self) = @_;
		3024
		3025	$self->{current}->size_request
		3026	}
		3027
		3028	sub size_allocate {
		3029	my ($self, $w, $h) = @_;
		3030
		3031	$self->{current}->configure (0, 0, $w, $h);
		3032	}
		3033
		3034	sub _draw {
		3035	my ($self) = @_;
		3036
		3037	$self->{current}->draw;
		3038	}
		3039
		3040	#############################################################################
		3041
		3042	package CFClient::UI::Notebook;
		3043
		3044	our @ISA = CFClient::UI::VBox::;
		3045
		3046	sub new {
		3047	my $class = shift;
		3048
		3049	my $self = $class->SUPER::new (
		3050	buttonbar => (new CFClient::UI::Buttonbar),
		3051	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3052	# filter => # will be put between multiplexer and $self
		3053	@_,
		3054	);
		3055
		3056	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3057	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3058
		3059	$self
		3060	}
		3061
		3062	sub add {
		3063	my ($self, $title, $widget, $tooltip) = @_;
		3064
		3065	Scalar::Util::weaken $self;
		3066
		3067	$self->{buttonbar}->add (new CFClient::UI::Button
		3068	markup => $title,
		3069	tooltip => $tooltip,
		3070	on_activate => sub { $self->set_current_page ($widget) },
		3071	);
		3072
		3073	$self->{multiplexer}->add ($widget);
		3074	}
		3075
		3076	sub set_current_page {
		3077	my ($self, $page) = @_;
		3078
		3079	$self->{multiplexer}->set_current_page ($page);
		3080	$self->_emit (page_changed => $self->{multiplexer}{current});
		3081	}
		3082
		3083	#############################################################################
		3084
2605	package CFClient::UI::Statusbox;	3085	package CFClient::UI::Statusbox;
2606		3086
2607	our @ISA = CFClient::UI::VBox::;	3087	our @ISA = CFClient::UI::VBox::;
2608		3088
		3089	sub new {
		3090	my $class = shift;
		3091
		3092	my $self = $class->SUPER::new (
		3093	fontsize => 0.8,
		3094	@_,
		3095	);
		3096
		3097	Scalar::Util::weaken (my $this = $self);
		3098
		3099	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3100
		3101	$self
		3102	}
		3103
2609	sub reorder {	3104	sub reorder {
2610	my ($self) = @_;	3105	my ($self) = @_;
2611	my $NOW = time;	3106	my $NOW = Time::HiRes::time;
		3107
		3108	# freeze display when hovering over any label
		3109	return if $CFClient::UI::TOOLTIP->{owner}
		3110	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3111	values %{ $self->{item} };
2612		3112
2613	while (my ($k, $v) = each %{ $self->{item} }) {	3113	while (my ($k, $v) = each %{ $self->{item} }) {
2614	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3114	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2615	}	3115	}
2616		3116
…		…
2619	my @items = sort {	3119	my @items = sort {
2620	$a->{pri} <=> $b->{pri}	3120	$a->{pri} <=> $b->{pri}
2621	or $b->{id} <=> $a->{id}	3121	or $b->{id} <=> $a->{id}
2622	} values %{ $self->{item} };	3122	} values %{ $self->{item} };
2623		3123
		3124	$self->{timer}->interval (1);
		3125
2624	my $count = 10 + 1;	3126	my $count = 10 + 1;
2625	for my $item (@items) {	3127	for my $item (@items) {
2626	last unless --$count;	3128	last unless --$count;
2627		3129
2628	push @widgets, $item->{label} ||= do {	3130	my $label = $item->{label} ||= do {
2629	# TODO: doesn't handle markup well (read as: at all)	3131	# TODO: doesn't handle markup well (read as: at all)
2630	my $short = $item->{count} > 1	3132	my $short = $item->{count} > 1
2631	? "<b>$item->{count} ×</b> $item->{text}"	3133	? "<b>$item->{count} ×</b> $item->{text}"
2632	: $item->{text};	3134	: $item->{text};
2633		3135
2634	for ($short) {	3136	for ($short) {
2635	s/^\s+//;	3137	s/^\s+//;
2636	s/\012.*/…/s;	3138	s/\s+/ /g;
2637	my $len = int 30 / $item->{fontsize};
2638	substr $_, $len, length, "…" if $len < length;
2639	}	3139	}
2640		3140
2641	new CFClient::UI::Label	3141	new CFClient::UI::Label
2642	markup => $short,	3142	markup => $short,
2643	tooltip => $item->{tooltip},	3143	tooltip => $item->{tooltip},
2644	tooltip_font => $::FONT_PROP,	3144	tooltip_font => $::FONT_PROP,
2645	tooltip_width => 0.67,	3145	tooltip_width => 0.67,
2646	fontsize => $item->{fontsize},	3146	fontsize => $item->{fontsize} || $self->{fontsize},
2647	color => $item->{color},	3147	max_w => $::WIDTH * 0.44,
		3148	fg => [@{ $item->{fg} }],
2648	can_events => 1,	3149	can_events => 1,
2649	can_hover => 1	3150	can_hover => 1
2650	};	3151	};
		3152
		3153	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3154	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3155	$label->update;
		3156	$label->set_max_size (undef, $label->{req_h} * $diff)
		3157	if $diff < 1;
		3158	$self->{timer}->interval (1/30);
		3159	} else {
		3160	$label->{fg}[3] = $item->{fg}[3] || 1;
		3161	}
		3162
		3163	push @widgets, $label;
2651	}	3164	}
2652		3165
2653	$self->clear;	3166	$self->clear;
2654	$self->SUPER::add (reverse @widgets);	3167	$self->SUPER::add (reverse @widgets);
2655	}	3168	}
2656		3169
2657	sub add {	3170	sub add {
2658	my ($self, $text, %arg) = @_;	3171	my ($self, $text, %arg) = @_;
2659		3172
		3173	$text =~ s/^\s+//;
		3174	$text =~ s/\s+$//;
		3175
		3176	return unless $text;
		3177
2660	my $timeout = time + ((delete $arg{timeout}) || 60);	3178	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2661		3179
2662	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3180	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2663		3181
2664	if (my $item = $self->{item}{$group}) {	3182	if (my $item = $self->{item}{$group}) {
2665	if ($item->{text} eq $text) {	3183	if ($item->{text} eq $text) {
2666	$item->{count}++;	3184	$item->{count}++;
2667	} else {	3185	} else {
2668	$item->{count} = 1;	3186	$item->{count} = 1;
2669	$item->{text} = $item->{tooltip} = $text;	3187	$item->{text} = $item->{tooltip} = $text;
2670	}	3188	}
		3189	$item->{id} = ++$self->{id};
2671	$item->{timeout} = $timeout;	3190	$item->{timeout} = $timeout;
2672	delete $item->{label};	3191	delete $item->{label};
2673	} else {	3192	} else {
2674	$self->{item}{$group} = {	3193	$self->{item}{$group} = {
2675	id => ++$self->{id},	3194	id => ++$self->{id},
2676	text => $text,	3195	text => $text,
2677	timeout => $timeout,	3196	timeout => $timeout,
2678	tooltip => $text,	3197	tooltip => $text,
2679	fontsize => 0.8,
2680	color => [0.8, 0.8, 0.8, 0.8],	3198	fg => [0.8, 0.8, 0.8, 0.8],
2681	pri => 0,	3199	pri => 0,
2682	count => 1,	3200	count => 1,
2683	%arg,	3201	%arg,
2684	};	3202	};
2685	}	3203	}
2686		3204
2687	$self->reorder;	3205	$self->reorder;
2688	}	3206	}
2689		3207
		3208	sub reconfigure {
		3209	my ($self) = @_;
		3210
		3211	delete $_->{label}
		3212	for values %{ $self->{item} || {} };
		3213
		3214	$self->reorder;
		3215	$self->SUPER::reconfigure;
		3216	}
		3217
		3218	sub DESTROY {
		3219	my ($self) = @_;
		3220
		3221	$self->{timer}->cancel;
		3222
		3223	$self->SUPER::DESTROY;
		3224	}
		3225
2690	#############################################################################	3226	#############################################################################
2691		3227
2692	package CFClient::UI::Root;	3228	package CFClient::UI::Inventory;
2693		3229
2694	our @ISA = CFClient::UI::Container::;	3230	our @ISA = CFClient::UI::ScrolledWindow::;
2695
2696	use CFClient::OpenGL;
2697		3231
2698	sub new {	3232	sub new {
2699	my $class = shift;	3233	my $class = shift;
2700		3234
2701	$class->SUPER::new (	3235	my $self = $class->SUPER::new (
		3236	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3237	@_,
		3238	);
		3239
		3240	$self
		3241	}
		3242
		3243	sub set_items {
		3244	my ($self, $items) = @_;
		3245
		3246	$self->{child}->clear;
		3247	return unless $items;
		3248
		3249	my @items = sort {
		3250	($a->{type} <=> $b->{type})
		3251	or ($a->{name} cmp $b->{name})
		3252	} @$items;
		3253
		3254	$self->{real_items} = \@items;
		3255
		3256	my $row = 0;
		3257	for my $item (@items) {
		3258	CFClient::Item::update_widgets $item;
		3259
		3260	$self->{child}->add (0, $row, $item->{face_widget});
		3261	$self->{child}->add (1, $row, $item->{desc_widget});
		3262	$self->{child}->add (2, $row, $item->{weight_widget});
		3263
		3264	$row++;
		3265	}
		3266	}
		3267
		3268	#############################################################################
		3269
		3270	package CFClient::UI::BindEditor;
		3271
		3272	our @ISA = CFClient::UI::FancyFrame::;
		3273
		3274	sub new {
		3275	my $class = shift;
		3276
		3277	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3278
		3279	$self->add (my $vb = new CFClient::UI::VBox);
		3280
		3281
		3282	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3283	text => "start recording",
		3284	tooltip => "Start/Stops recording of actions."
		3285	."All subsequent actions after the recording started will be captured."
		3286	."The actions are displayed after the record was stopped."
		3287	."To bind the action you have to click on the 'Bind' button",
		3288	on_activate => sub {
		3289	unless ($self->{recording}) {
		3290	$self->start;
		3291	} else {
		3292	$self->stop;
		3293	}
		3294	});
		3295
		3296	$vb->add (new CFClient::UI::Label text => "Actions:");
		3297	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3298
		3299	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3300	$vb->add (my $hb = new CFClient::UI::HBox);
		3301	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3302	$hb->add (new CFClient::UI::Button
		3303	text => "bind",
		3304	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3305	on_activate => sub {
		3306	$self->ask_for_bind;
		3307	});
		3308
		3309	$vb->add (my $hb = new CFClient::UI::HBox);
		3310	$hb->add (new CFClient::UI::Button
		3311	text => "ok",
		3312	expand => 1,
		3313	tooltip => "This closes the binding editor and saves the binding",
		3314	on_activate => sub {
		3315	$self->hide;
		3316	$self->commit;
		3317	});
		3318
		3319	$hb->add (new CFClient::UI::Button
		3320	text => "cancel",
		3321	expand => 1,
		3322	tooltip => "This closes the binding editor without saving",
		3323	on_activate => sub {
		3324	$self->hide;
		3325	$self->{binding_cancel}->()
		3326	if $self->{binding_cancel};
		3327	});
		3328
		3329	$self->update_binding_widgets;
		3330
		3331	$self
		3332	}
		3333
		3334	sub commit {
		3335	my ($self) = @_;
		3336	my ($mod, $sym, $cmds) = $self->get_binding;
		3337	if ($sym != 0 && @$cmds > 0) {
		3338	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3339	."'. Don't forget 'Save Config'!");
		3340	$self->{binding_change}->($mod, $sym, $cmds)
		3341	if $self->{binding_change};
		3342	} else {
		3343	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3344	$self->{binding_cancel}->()
		3345	if $self->{binding_cancel};
		3346	}
		3347	}
		3348
		3349	sub start {
		3350	my ($self) = @_;
		3351
		3352	$self->{rec_btn}->set_text ("stop recording");
		3353	$self->{recording} = 1;
		3354	$self->clear_command_list;
		3355	$::CONN->start_record if $::CONN;
		3356	}
		3357
		3358	sub stop {
		3359	my ($self) = @_;
		3360
		3361	$self->{rec_btn}->set_text ("start recording");
		3362	$self->{recording} = 0;
		3363
		3364	my $rec;
		3365	$rec = $::CONN->stop_record if $::CONN;
		3366	return unless ref $rec eq 'ARRAY';
		3367	$self->set_command_list ($rec);
		3368	}
		3369
		3370
		3371	sub ask_for_bind_and_commit {
		3372	my ($self) = @_;
		3373	$self->ask_for_bind (1);
		3374	}
		3375
		3376	sub ask_for_bind {
		3377	my ($self, $commit) = @_;
		3378
		3379	CFClient::Binder::open_binding_dialog (sub {
		3380	my ($mod, $sym) = @_;
		3381	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3382	$self->update_binding_widgets;
		3383	$self->commit if $commit;
		3384	});
		3385	}
		3386
		3387	# $mod and $sym are the modifiers and key symbol
		3388	# $cmds is a array ref of strings (the commands)
		3389	# $cb is the callback that is executed on OK
		3390	# $ccb is the callback that is executed on CANCEL and
		3391	# when the binding was unsuccessful on OK
		3392	sub set_binding {
		3393	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3394
		3395	$self->clear_command_list;
		3396	$self->{recording} = 0;
		3397	$self->{rec_btn}->set_text ("start recording");
		3398
		3399	$self->{binding} = [$mod, $sym];
		3400	$self->{commands} = $cmds;
		3401
		3402	$self->{binding_change} = $cb;
		3403	$self->{binding_cancel} = $ccb;
		3404
		3405	$self->update_binding_widgets;
		3406	}
		3407
		3408	# this is a shortcut method that asks for a binding
		3409	# and then just binds it.
		3410	sub do_quick_binding {
		3411	my ($self, $cmds) = @_;
		3412	$self->set_binding (undef, undef, $cmds, sub {
		3413	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3414	});
		3415	$self->ask_for_bind (1);
		3416	}
		3417
		3418	sub update_binding_widgets {
		3419	my ($self) = @_;
		3420	my ($mod, $sym, $cmds) = $self->get_binding;
		3421	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3422	$self->set_command_list ($cmds);
		3423	}
		3424
		3425	sub get_binding {
		3426	my ($self) = @_;
		3427	return (
		3428	$self->{binding}->[0],
		3429	$self->{binding}->[1],
		3430	[ grep { defined $_ } @{$self->{commands}} ]
		3431	);
		3432	}
		3433
		3434	sub clear_command_list {
		3435	my ($self) = @_;
		3436	$self->{cmdbox}->clear ();
		3437	}
		3438
		3439	sub set_command_list {
		3440	my ($self, $cmds) = @_;
		3441
		3442	$self->{cmdbox}->clear ();
		3443	$self->{commands} = $cmds;
		3444
		3445	my $idx = 0;
		3446
		3447	for (@$cmds) {
		3448	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3449
		3450	my $i = $idx;
		3451	$hb->add (new CFClient::UI::Label text => $_);
		3452	$hb->add (new CFClient::UI::Button
		3453	text => "delete",
		3454	tooltip => "Deletes the action from the record",
		3455	on_activate => sub {
		3456	$self->{cmdbox}->remove ($hb);
		3457	$cmds->[$i] = undef;
		3458	});
		3459
		3460
		3461	$idx++
		3462	}
		3463	}
		3464
		3465	#############################################################################
		3466
		3467	package CFClient::UI::SpellList;
		3468
		3469	our @ISA = CFClient::UI::Table::;
		3470
		3471	sub new {
		3472	my $class = shift;
		3473
		3474	my $self = $class->SUPER::new (
		3475	binding => [],
		3476	commands => [],
2702	@_,	3477	@_,
2703	)	3478	)
2704	}	3479	}
2705		3480
2706	sub configure {	3481	# XXX: Do sorting? Argl...
2707	my ($self, $x, $y, $w, $h) = @_;	3482	sub add_spell {
2708
2709	$self->{w} = $w;
2710	$self->{h} = $h;
2711	}
2712
2713	sub check_size {
2714	my ($self) = @_;	3483	my ($self, $spell) = @_;
		3484	$self->{spells}->{$spell->{name}} = $spell;
2715		3485
2716	$self->size_allocate ($self->{w}, $self->{h})	3486	$self->add (0, $self->{tbl_idx}, new CFClient::UI::Face
2717	if $self->{w};	3487	face => $spell->{face},
		3488	can_hover => 1,
		3489	can_events => 1,
		3490	tooltip => $spell->{message});
		3491
		3492	$self->add (1, $self->{tbl_idx}, new CFClient::UI::Label
		3493	text => $spell->{name},
		3494	can_hover => 1,
		3495	can_events => 1,
		3496	tooltip => $spell->{message},
		3497	expand => 1);
		3498
		3499	$self->add (2, $self->{tbl_idx}, new CFClient::UI::Label
		3500	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
		3501	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
		3502	expand => 1);
		3503
		3504	$self->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
		3505	text => "bind to key",
		3506	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
		3507	}
		3508
		3509	sub rebuild_spell_list {
		3510	my ($self) = @_;
		3511	$self->{tbl_idx} = 0;
		3512	$self->add_spell ($_) for values %{$self->{spells}};
		3513	}
		3514
		3515	sub remove_spell {
		3516	my ($self, $spell) = @_;
		3517	delete $self->{spells}->{$spell->{name}};
		3518	$self->rebuild_spell_list;
		3519	}
		3520
		3521	#############################################################################
		3522
		3523	package CFClient::UI::Root;
		3524
		3525	our @ISA = CFClient::UI::Container::;
		3526
		3527	use List::Util qw(min max);
		3528
		3529	use CFClient::OpenGL;
		3530
		3531	sub new {
		3532	my $class = shift;
		3533
		3534	my $self = $class->SUPER::new (
		3535	visible => 1,
		3536	@_,
		3537	);
		3538
		3539	Scalar::Util::weaken ($self->{root} = $self);
		3540
		3541	$self
2718	}	3542	}
2719		3543
2720	sub size_request {	3544	sub size_request {
2721	my ($self) = @_;	3545	my ($self) = @_;
2722		3546
2723	($self->{w}, $self->{h})	3547	($self->{w}, $self->{h})
		3548	}
		3549
		3550	sub _to_pixel {
		3551	my ($coord, $size, $max) = @_;
		3552
		3553	$coord =
		3554	$coord eq "center" ? ($max - $size) * 0.5
		3555	: $coord eq "max" ? $max
		3556	: $coord;
		3557
		3558	$coord = 0 if $coord < 0;
		3559	$coord = $max - $size if $coord > $max - $size;
		3560
		3561	int $coord + 0.5
2724	}	3562	}
2725		3563
2726	sub size_allocate {	3564	sub size_allocate {
2727	my ($self, $w, $h) = @_;	3565	my ($self, $w, $h) = @_;
2728		3566
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) {	3567	for my $child ($self->children) {
2746	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3568	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2747		3569
2748	$X = List::Util::max 0, List::Util::min $w - $W, $X;	3570	$X = $child->{force_x} if exists $child->{force_x};
2749	$Y = List::Util::max 0, List::Util::min $h - $H, $Y;	3571	$Y = $child->{force_y} if exists $child->{force_y};
		3572
		3573	$X = _to_pixel $X, $W, $self->{w};
		3574	$Y = _to_pixel $Y, $H, $self->{h};
		3575
2750	$child->configure ($X, $Y, $W, $H);	3576	$child->configure ($X, $Y, $W, $H);
2751	}	3577	}
2752
2753	$self->{old_w} = $w;
2754	$self->{old_h} = $h;
2755	}	3578	}
2756		3579
2757	sub coord2local {	3580	sub coord2local {
2758	my ($self, $x, $y) = @_;	3581	my ($self, $x, $y) = @_;
2759		3582
…		…
2767	}	3590	}
2768		3591
2769	sub update {	3592	sub update {
2770	my ($self) = @_;	3593	my ($self) = @_;
2771		3594
2772	$self->check_size;
2773	$::WANT_REFRESH++;	3595	$::WANT_REFRESH++;
2774	}	3596	}
2775		3597
2776	sub add {	3598	sub add {
2777	my ($self, $child) = @_;	3599	my ($self, @children) = @_;
2778		3600
2779	# integerise window positions	3601	$_->{is_toplevel} = 1
2780	$child->{x} = int $child->{x};	3602	for @children;
2781	$child->{y} = int $child->{y};
2782		3603
2783	$self->SUPER::add ($child);	3604	$self->SUPER::add (@children);
		3605	}
		3606
		3607	sub remove {
		3608	my ($self, @children) = @_;
		3609
		3610	$self->SUPER::remove (@children);
		3611
		3612	delete $self->{is_toplevel}
		3613	for @children;
		3614
		3615	while (@children) {
		3616	my $w = pop @children;
		3617	push @children, $w->children;
		3618	$w->set_invisible;
		3619	}
2784	}	3620	}
2785		3621
2786	sub on_refresh {	3622	sub on_refresh {
2787	my ($self, $id, $cb) = @_;	3623	my ($self, $id, $cb) = @_;
2788		3624
2789	$self->{refresh_hook}{$id} = $cb;	3625	$self->{refresh_hook}{$id} = $cb;
2790	}	3626	}
2791		3627
		3628	sub on_post_alloc {
		3629	my ($self, $id, $cb) = @_;
		3630
		3631	$self->{post_alloc_hook}{$id} = $cb;
		3632	}
		3633
2792	sub draw {	3634	sub draw {
2793	my ($self) = @_;	3635	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		3636
2840	while ($self->{refresh_hook}) {	3637	while ($self->{refresh_hook}) {
2841	$_->()	3638	$_->()
2842	for values %{delete $self->{refresh_hook}};	3639	for values %{delete $self->{refresh_hook}};
2843	}	3640	}
2844		3641
		3642	if ($self->{realloc}) {
		3643	my %queue;
		3644	my @queue;
		3645	my $widget;
		3646
		3647	outer:
		3648	while () {
		3649	if (my $realloc = delete $self->{realloc}) {
		3650	for $widget (values %$realloc) {
		3651	$widget->{visible} or next; # do not resize invisible widgets
		3652
		3653	$queue{$widget+0}++ and next; # duplicates are common
		3654
		3655	push @{ $queue[$widget->{visible}] }, $widget;
		3656	}
		3657	}
		3658
		3659	while () {
		3660	@queue or last outer;
		3661
		3662	$widget = pop @{ $queue[-1] || [] }
		3663	and last;
		3664
		3665	pop @queue;
		3666	}
		3667
		3668	delete $queue{$widget+0};
		3669
		3670	my ($w, $h) = $widget->size_request;
		3671
		3672	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3673	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3674
		3675	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3676	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3677
		3678	$w = $widget->{force_w} if exists $widget->{force_w};
		3679	$h = $widget->{force_h} if exists $widget->{force_h};
		3680
		3681	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3682	|| delete $widget->{force_realloc}) {
		3683	$widget->{req_w} = $w;
		3684	$widget->{req_h} = $h;
		3685
		3686	$self->{size_alloc}{$widget+0} = $widget;
		3687
		3688	if (my $parent = $widget->{parent}) {
		3689	$self->{realloc}{$parent+0} = $parent
		3690	unless $queue{$parent+0};
		3691
		3692	$parent->{force_size_alloc} = 1;
		3693	$self->{size_alloc}{$parent+0} = $parent;
		3694	}
		3695	}
		3696
		3697	delete $self->{realloc}{$widget+0};
		3698	}
		3699	}
		3700
		3701	while (my $size_alloc = delete $self->{size_alloc}) {
		3702	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3703	values %$size_alloc;
		3704
		3705	while () {
		3706	my $widget = pop @queue || last;
		3707
		3708	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
		3709
		3710	$w = 0 if $w < 0;
		3711	$h = 0 if $h < 0;
		3712
		3713	$w = int $w + 0.5;
		3714	$h = int $h + 0.5;
		3715
		3716	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3717	$widget->{old_w} = $widget->{w};
		3718	$widget->{old_h} = $widget->{h};
		3719
		3720	$widget->{w} = $w;
		3721	$widget->{h} = $h;
		3722
		3723	$widget->emit (size_allocate => $w, $h);
		3724	}
		3725	}
		3726	}
		3727
		3728	while ($self->{post_alloc_hook}) {
		3729	$_->()
		3730	for values %{delete $self->{post_alloc_hook}};
		3731	}
		3732
		3733
2845	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3734	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2846	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3735	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2847	glClear GL_COLOR_BUFFER_BIT;	3736	glClear GL_COLOR_BUFFER_BIT;
2848		3737
2849	glMatrixMode GL_PROJECTION;	3738	glMatrixMode GL_PROJECTION;
2850	glLoadIdentity;	3739	glLoadIdentity;
2851	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;	3740	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2852	glMatrixMode GL_MODELVIEW;	3741	glMatrixMode GL_MODELVIEW;
2853	glLoadIdentity;	3742	glLoadIdentity;
2854		3743
		3744	{
		3745	package CFClient::UI::Base;
		3746
		3747	($draw_x, $draw_y, $draw_w, $draw_h) =
		3748	(0, 0, $self->{w}, $self->{h});
		3749	}
		3750
2855	$self->_draw;	3751	$self->_draw;
2856	}	3752	}
2857		3753
2858	#############################################################################	3754	#############################################################################
2859		3755
2860	package CFClient::UI;	3756	package CFClient::UI;
2861		3757
2862	$ROOT = new CFClient::UI::Root;	3758	$ROOT = new CFClient::UI::Root;
2863	$TOOLTIP = new CFClient::UI::Tooltip;	3759	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2864		3760
2865	1	3761	1
2866		3762

Diff Legend

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