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

Diff Legend

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