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.184 by root, Wed May 3 19:56:05 2006 UTC vs.
Revision 1.279 by root, Mon Jun 5 00:17:47 2006 UTC

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

Diff Legend

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