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.202 by root, Sun May 14 20:51:19 2006 UTC vs.
Revision 1.298 by root, Wed Jun 7 07:00:30 2006 UTC

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

Diff Legend

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