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.175 by root, Tue Apr 25 11:48:31 2006 UTC vs.
Revision 1.299 by root, Wed Jun 7 07:17:37 2006 UTC

1	package CFClient::UI;	1	package CFClient::UI;
2		2
		3	use utf8;
3	use strict;	4	use strict;
4		5
5	use Scalar::Util ();	6	use Scalar::Util ();
6	use List::Util ();	7	use List::Util ();
		8	use Event;
7		9
8	use CFClient;	10	use CFClient;
		11	use CFClient::Texture;
9		12
10	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
11		14
		15	our $LAYOUT;
12	our $ROOT;	16	our $ROOT;
13	our $TOOLTIP;	17	our $TOOLTIP;
14	our $BUTTON_STATE;	18	our $BUTTON_STATE;
15		19
16	sub check_tooltip {	20	our %WIDGET; # all widgets, weak-referenced
		21
		22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
17	if (!$GRAB) {	23	if (!$GRAB) {
18	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
19	if (length $widget->{tooltip}) {	25	if (length $widget->{tooltip}) {
20
21	if ($TOOLTIP->{owner} != $widget) {	26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->hide;
		28
22	$TOOLTIP->{owner} = $widget;	29	$TOOLTIP->{owner} = $widget;
		30
		31	return if $ENV{CFPLUS_DEBUG} & 8;
23		32
24	my $tip = $widget->{tooltip};	33	my $tip = $widget->{tooltip};
25		34
26	$tip = $tip->($widget) if CODE:: eq ref $tip;	35	$tip = $tip->($widget) if CODE:: eq ref $tip;
27		36
28	$TOOLTIP->set_markup ($widget->{tooltip});	37	$TOOLTIP->set_tooltip_from ($widget);
29
30	$TOOLTIP->show;	38	$TOOLTIP->show;
31
32	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
33
34	if ($x + $TOOLTIP->{w} > $::WIDTH) {
35	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0);
36	}
37
38	$TOOLTIP->move ($x, $y);
39	}	39	}
40		40
41	return;	41	return;
42	}	42	}
43	}	43	}
44	}	44	}
45		45
46	$TOOLTIP->hide;	46	$TOOLTIP->hide;
47	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;
48	}	71	}
49		72
50	# class methods for events	73	# class methods for events
51	sub feed_sdl_key_down_event {	74	sub feed_sdl_key_down_event {
52	$FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0])	75	$FOCUS->emit (key_down => $_[0])
53	if $FOCUS;	76	if $FOCUS;
54	}	77	}
55		78
56	sub feed_sdl_key_up_event {	79	sub feed_sdl_key_up_event {
57	$FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0])	80	$FOCUS->emit (key_up => $_[0])
58	if $FOCUS;	81	if $FOCUS;
59	}	82	}
60		83
61	sub feed_sdl_button_down_event {	84	sub feed_sdl_button_down_event {
62	my ($ev) = @_;	85	my ($ev) = @_;
…		…
66	my $widget = $ROOT->find_widget ($x, $y);	89	my $widget = $ROOT->find_widget ($x, $y);
67		90
68	$GRAB = $widget;	91	$GRAB = $widget;
69	$GRAB->update if $GRAB;	92	$GRAB->update if $GRAB;
70		93
71	check_tooltip;	94	$TOOLTIP_WATCHER->cb->();
72	}	95	}
73		96
74	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
75		98
76	if ($GRAB) {	99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
77	($x, $y) = $GRAB->coord2local ($x, $y);	100	if $GRAB;
78	$GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
79	}
80	}	101	}
81		102
82	sub feed_sdl_button_up_event {	103	sub feed_sdl_button_up_event {
83	my ($ev) = @_;	104	my ($ev) = @_;
84	my ($x, $y) = ($ev->{x}, $ev->{y});	105	my ($x, $y) = ($ev->{x}, $ev->{y});
85		106
86	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
87		108
88	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
89		110
90	if ($GRAB) {	111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
91	($x, $y) = $GRAB->coord2local ($x, $y);	112	if $GRAB;
92	$GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
93	}
94		113
95	if (!$BUTTON_STATE) {	114	if (!$BUTTON_STATE) {
96	my $grab = $GRAB; undef $GRAB;	115	my $grab = $GRAB; undef $GRAB;
97	$grab->update if $grab;	116	$grab->update if $grab;
98	$GRAB->update if $GRAB;	117	$GRAB->update if $GRAB;
99		118
100	check_tooltip;	119	$TOOLTIP_WATCHER->cb->();
101	}	120	}
102	}	121	}
103		122
104	sub feed_sdl_motion_event {	123	sub feed_sdl_motion_event {
105	my ($ev) = @_;	124	my ($ev) = @_;
…		…
111	my $hover = $HOVER; $HOVER = $widget;	130	my $hover = $HOVER; $HOVER = $widget;
112		131
113	$hover->update if $hover && $hover->{can_hover};	132	$hover->update if $hover && $hover->{can_hover};
114	$HOVER->update if $HOVER && $HOVER->{can_hover};	133	$HOVER->update if $HOVER && $HOVER->{can_hover};
115		134
116	check_tooltip;	135	$TOOLTIP_WATCHER->start;
117	}	136	}
118		137
119	if ($HOVER) {
120	($x, $y) = $HOVER->coord2local ($x, $y);
121	$HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y);	138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
122	}	139	if $HOVER;
123	}	140	}
124		141
125	# convert position array to integers	142	# convert position array to integers
126	sub harmonize {	143	sub harmonize {
127	my ($vals) = @_;	144	my ($vals) = @_;
…		…
133	$rem += $_ - $i;	150	$rem += $_ - $i;
134	$_ = $i;	151	$_ = $i;
135	}	152	}
136	}	153	}
137		154
		155	sub full_refresh {
		156	# make a copy, otherwise for complains about freed values.
		157	my @widgets = values %WIDGET;
		158
		159	$_->update
		160	for @widgets;
		161	}
		162
		163	sub reconfigure_widgets {
		164	# make a copy, otherwise C<for> complains about freed values.
		165	my @widgets = values %WIDGET;
		166
		167	$_->reconfigure
		168	for @widgets;
		169	}
		170
		171	# call when resolution changes etc.
		172	sub rescale_widgets {
		173	my ($sx, $sy) = @_;
		174
		175	for my $widget (values %WIDGET) {
		176	if ($widget->{is_toplevel}) {
		177	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		178	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		179
		180	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
		181	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
		182	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
		183	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
		184	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
		185	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
		186
		187	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		188	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		189
		190	}
		191	}
		192
		193	reconfigure_widgets;
		194	}
		195
138	#############################################################################	196	#############################################################################
139		197
140	package CFClient::UI::Base;	198	package CFClient::UI::Base;
141		199
142	use strict;	200	use strict;
…		…
145		203
146	sub new {	204	sub new {
147	my $class = shift;	205	my $class = shift;
148		206
149	my $self = bless {	207	my $self = bless {
150	x => 0,	208	x => "center",
151	y => 0,	209	y => "center",
152	z => 0,	210	z => 0,
		211	w => undef,
		212	h => undef,
153	can_events => 1,	213	can_events => 1,
154	@_	214	@_
155	}, $class;	215	}, $class;
156		216
		217	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		218
157	for (keys %$self) {	219	for (keys %$self) {
158	if (/^connect_(.*)$/) {	220	if (/^on_(.*)$/) {
159	$self->connect ($1 => delete $self->{$_});	221	$self->connect ($1 => delete $self->{$_});
160	}	222	}
161	}	223	}
162		224
		225	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		226	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		227	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		228	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		229	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		230
		231	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		232	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		233
		234	$self->show if $layout->{show};
		235	}
		236
163	$self	237	$self
164	}	238	}
165		239
166	sub destroy {	240	sub destroy {
167	my ($self) = @_;	241	my ($self) = @_;
…		…
176	return if $self->{parent};	250	return if $self->{parent};
177		251
178	$CFClient::UI::ROOT->add ($self);	252	$CFClient::UI::ROOT->add ($self);
179	}	253	}
180		254
181	sub hide {	255	sub set_visible {
182	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};
183		279
184	undef $GRAB if $GRAB == $self;	280	undef $GRAB if $GRAB == $self;
185	undef $HOVER if $HOVER == $self;	281	undef $HOVER if $HOVER == $self;
186		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
187	$self->{parent}->remove ($self)	313	$self->{parent}->remove ($self)
188	if $self->{parent};	314	if $self->{parent};
189	}	315	}
190		316
191	sub move {	317	sub move_abs {
192	my ($self, $x, $y, $z) = @_;	318	my ($self, $x, $y, $z) = @_;
193		319
194	$self->{x} = int $x;	320	$self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
195	$self->{y} = int $y;	321	$self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
196	$self->{z} = $z if defined $z;	322	$self->{z} = $z if defined $z;
197		323
198	$self->update;	324	$self->update;
199	}	325	}
200		326
201	sub set_size {	327	sub set_size {
202	my ($self, $w, $h) = @_;	328	my ($self, $w, $h) = @_;
203		329
204	$self->{user_w} = $w;	330	$self->{force_w} = $w;
205	$self->{user_h} = $h;	331	$self->{force_h} = $h;
206		332
207	$self->check_size;	333	$self->realloc;
208	}	334	}
209		335
210	sub size_request {	336	sub size_request {
211	require Carp;	337	require Carp;
212	Carp::confess "size_request is abstract";	338	Carp::confess "size_request is abstract";
…		…
214		340
215	sub configure {	341	sub configure {
216	my ($self, $x, $y, $w, $h) = @_;	342	my ($self, $x, $y, $w, $h) = @_;
217		343
218	if ($self->{aspect}) {	344	if ($self->{aspect}) {
		345	my ($ow, $oh) = ($w, $h);
		346
219	my $w2 = List::Util::min $w, int $h * $self->{aspect};	347	$w = List::Util::min $w, int $h * $self->{aspect};
220	my $h2 = List::Util::min $h, int $w / $self->{aspect};	348	$h = List::Util::min $h, int $w / $self->{aspect};
221		349
222	# use alignment to adjust x, y	350	# use alignment to adjust x, y
223		351
224	$x += int +($w - $w2) * 0.5;	352	$x += int 0.5 * ($ow - $w);
225	$y += int +($h - $h2) * 0.5;	353	$y += int 0.5 * ($oh - $h);
226
227	($w, $h) = ($w2, $h2);
228	}	354	}
229		355
230	if ($self->{x} != $x || $self->{y} != $y) {	356	if ($self->{x} ne $x || $self->{y} ne $y) {
231	$self->{x} = $x;	357	$self->{x} = $x;
232	$self->{y} = $y;	358	$self->{y} = $y;
233	$self->update;	359	$self->update;
234	}	360	}
235		361
236	if ($self->{w} != $w || $self->{h} != $h) {	362	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
		363	return unless $self->{visible};
		364
237	$self->{w} = $w;	365	$self->{alloc_w} = $w;
238	$self->{h} = $h;	366	$self->{alloc_h} = $h;
239		367
240	$self->size_allocate ($w, $h);	368	$self->{root}{size_alloc}{$self+0} = $self;
241	$self->update;
242	}	369	}
243	}	370	}
244		371
245	sub size_allocate {	372	sub size_allocate {
246	# nothing to be done	373	# nothing to be done
247	}	374	}
248		375
249	sub children {	376	sub children {
		377	# nop
250	}	378	}
251		379
252	# call when resoltuion changes etc.	380	sub visible_children {
253	sub reconfigure {	381	$_[0]->children
254	my ($self) = @_;
255
256	$_->reconfigure
257	for $self->children;
258
259	$_->check_size;
260	}	382	}
261		383
262	sub set_max_size {	384	sub set_max_size {
263	my ($self, $w, $h) = @_;	385	my ($self, $w, $h) = @_;
264		386
265	delete $self->{max_w}; $self->{max_w} = $w if $w;	387	$self->{max_w} = int $w if defined $w;
266	delete $self->{max_h}; $self->{max_h} = $h if $h;	388	$self->{max_h} = int $h if defined $h;
267	}
268		389
269	# return top left coordinates	390	$self->realloc;
270	sub _topleft {	391	}
		392
		393	sub set_tooltip {
271	my ($self, $x, $y) = @_;	394	my ($self, $tooltip) = @_;
272		395
273	$self->{parent}	396	$tooltip =~ s/^\s+//;
274	or Carp::confess "no parent widget in _topleft\n";#d#	397	$tooltip =~ s/\s+$//;
275		398
276	$self->{parent}->_topleft ($x + $self->{x}, $y + $self->{y});	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	}
277	}	407	}
278		408
279	# translate global coordinates to local coordinate system	409	# translate global coordinates to local coordinate system
280	sub coord2local {	410	sub coord2local {
281	my ($self, $x, $y) = @_;	411	my ($self, $x, $y) = @_;
282		412
283	my ($X, $Y) = $self->_topleft;	413	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
284	($x - $X, $y - $Y)
285	}	414	}
286		415
287	# translate local coordinates to global coordinate system	416	# translate local coordinates to global coordinate system
288	sub coord2global {	417	sub coord2global {
289	my ($self, $x, $y) = @_;	418	my ($self, $x, $y) = @_;
290		419
291	my ($X, $Y) = $self->_topleft;	420	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
292	($x + $X, $y + $Y)
293	}	421	}
294		422
295	sub focus_in {	423	sub focus_in {
296	my ($self) = @_;	424	my ($self) = @_;
297		425
298	return if $FOCUS == $self;	426	return if $FOCUS == $self;
299	return unless $self->{can_focus};	427	return unless $self->{can_focus};
300		428
301	my $focus = $FOCUS; $FOCUS = $self;	429	my $focus = $FOCUS; $FOCUS = $self;
302		430
303	$self->emit (focus_in => $focus);	431	$self->_emit (focus_in => $focus);
304		432
305	$focus->update if $focus;	433	$focus->update if $focus;
306	$FOCUS->update;	434	$FOCUS->update;
307	}	435	}
308		436
…		…
311		439
312	return unless $FOCUS == $self;	440	return unless $FOCUS == $self;
313		441
314	my $focus = $FOCUS; undef $FOCUS;	442	my $focus = $FOCUS; undef $FOCUS;
315		443
316	$self->emit (focus_out => $focus);	444	$self->_emit (focus_out => $focus);
317		445
318	$focus->update if $focus; #?	446	$focus->update if $focus; #?
319	}
320		447
		448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		449	unless $FOCUS;
		450	}
		451
321	sub mouse_motion { }	452	sub mouse_motion { 0 }
322	sub button_up { }	453	sub button_up { 0 }
323	sub key_down { }	454	sub key_down { 0 }
324	sub key_up { }	455	sub key_up { 0 }
325		456
326	sub button_down {	457	sub button_down {
327	my ($self, $ev, $x, $y) = @_;	458	my ($self, $ev, $x, $y) = @_;
328		459
329	$self->focus_in;	460	$self->focus_in;
330	}
331		461
332	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	462	0
333	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	463	}
334	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	464
335	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	465	sub find_widget {
336	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
337		538
338	sub draw {	539	sub draw {
339	my ($self) = @_;	540	my ($self) = @_;
340		541
341	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);
342		553
343	glPushMatrix;	554	glPushMatrix;
344	glTranslate $self->{x}, $self->{y}, 0;	555	glTranslate $self->{x}, $self->{y}, 0;
345	$self->_draw;
346	glPopMatrix;
347		556
348	if ($self == $HOVER && $self->{can_hover}) {	557	if ($self == $HOVER && $self->{can_hover}) {
349	my ($x, $y) = @$self{qw(x y)};
350
351	glColor 1, 0.8, 0.5, 0.2;	558	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
352	glEnable GL_BLEND;	559	glEnable GL_BLEND;
353	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	560	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
354	glBegin GL_QUADS;	561	glBegin GL_QUADS;
355	glVertex $x , $y;
356	glVertex $x + $self->{w}, $y;
357	glVertex $x + $self->{w}, $y + $self->{h};
358	glVertex $x , $y + $self->{h};
359	glEnd;
360	glDisable GL_BLEND;
361	}
362
363	if ($ENV{PCLIENT_DEBUG}) {
364	glPushMatrix;
365	glColor 1, 1, 0, 1;
366	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
367	glBegin GL_LINE_LOOP;
368	glVertex 0 , 0;	562	glVertex 0 , 0;
369	glVertex $self->{w}, 0;	563	glVertex $self->{w}, 0;
370	glVertex $self->{w}, $self->{h};	564	glVertex $self->{w}, $self->{h};
371	glVertex 0 , $self->{h};	565	glVertex 0 , $self->{h};
372	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;
373	glPopMatrix;	580	glPopMatrix;
374	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;
375	}	582	}
		583
		584	$self->_draw;
		585	glPopMatrix;
376	}	586	}
377		587
378	sub _draw {	588	sub _draw {
379	my ($self) = @_;	589	my ($self) = @_;
380		590
381	warn "no draw defined for $self\n";	591	warn "no draw defined for $self\n";
382	}	592	}
383		593
384	sub find_widget {
385	my ($self, $x, $y) = @_;
386
387	return () unless $self->{can_events};
388
389	return $self
390	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
391	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
392
393	()
394	}
395
396	sub set_parent {
397	my ($self, $parent) = @_;
398
399	Scalar::Util::weaken ($self->{parent} = $parent);
400	}
401
402	sub check_size {
403	my ($self) = @_;
404
405	$self->{parent}
406	or return 1;
407
408	my ($w, $h) = $self->{user_w} && $self->{user_h}
409	? @$self{qw(user_w user_h)}
410	: $self->size_request;
411
412	if ($w != $self->{req_w} || $h != $self->{req_h}) {
413	$self->{req_w} = $w;
414	$self->{req_h} = $h;
415
416	$self->{parent}->check_size
417	or $self->size_allocate (
418	(List::Util::max $self->{w}, $w),
419	(List::Util::max $self->{h}, $h),
420	);
421
422	1
423	} else {
424	0
425	}
426	}
427
428	sub update {
429	my ($self) = @_;
430
431	$self->{parent}->update
432	if $self->{parent};
433	}
434
435	sub connect {
436	my ($self, $signal, $cb) = @_;
437
438	push @{ $self->{signal_cb}{$signal} }, $cb;
439	}
440
441	sub emit {
442	my ($self, $signal, @args) = @_;
443
444	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
445	}
446
447	sub DESTROY {	594	sub DESTROY {
448	my ($self) = @_;	595	my ($self) = @_;
449		596
		597	delete $WIDGET{$self+0};
450	#$self->deactivate;	598	#$self->deactivate;
451	}	599	}
452		600
453	#############################################################################	601	#############################################################################
454		602
…		…
463	my $class = shift;	611	my $class = shift;
464		612
465	# range [value, low, high, page]	613	# range [value, low, high, page]
466		614
467	$class->SUPER::new (	615	$class->SUPER::new (
468	bg => [0, 0, 0, 0.2],	616	#bg => [0, 0, 0, 0.2],
469	active_bg => [1, 1, 1, 0.5],	617	#active_bg => [1, 1, 1, 0.5],
470	@_	618	@_
471	)	619	)
472	}	620	}
473		621
474	sub _draw {	622	sub _draw {
475	my ($self) = @_;	623	my ($self) = @_;
476		624
		625	my $color = $FOCUS == $self && $self->{active_bg}
		626	? $self->{active_bg}
		627	: $self->{bg};
		628
		629	if ($color && (@$color < 4 || $color->[3])) {
477	my ($w, $h) = @$self{qw(w h)};	630	my ($w, $h) = @$self{qw(w h)};
478		631
479	glEnable GL_BLEND;	632	glEnable GL_BLEND;
480	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	633	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
481	glColor @{ $FOCUS == $self ? $self->{active_bg} : $self->{bg} };	634	glColor_premultiply @$color;
482		635
483	glBegin GL_QUADS;	636	glBegin GL_QUADS;
484	glVertex 0 , 0;	637	glVertex 0 , 0;
485	glVertex 0 , $h;	638	glVertex 0 , $h;
486	glVertex $w, $h;	639	glVertex $w, $h;
487	glVertex $w, 0;	640	glVertex $w, 0;
488	glEnd;	641	glEnd;
489		642
490	glDisable GL_BLEND;	643	glDisable GL_BLEND;
		644	}
491	}	645	}
492		646
493	#############################################################################	647	#############################################################################
494		648
495	package CFClient::UI::Empty;	649	package CFClient::UI::Empty;
…		…
500	my ($class, %arg) = @_;	654	my ($class, %arg) = @_;
501	$class->SUPER::new (can_events => 0, %arg);	655	$class->SUPER::new (can_events => 0, %arg);
502	}	656	}
503		657
504	sub size_request {	658	sub size_request {
505	(0, 0)	659	my ($self) = @_;
		660
		661	($self->{w} + 0, $self->{h} + 0)
506	}	662	}
507		663
508	sub draw { }	664	sub draw { }
509		665
510	#############################################################################	666	#############################################################################
…		…
514	our @ISA = CFClient::UI::Base::;	670	our @ISA = CFClient::UI::Base::;
515		671
516	sub new {	672	sub new {
517	my ($class, %arg) = @_;	673	my ($class, %arg) = @_;
518		674
519	my $children = delete $arg{children} || [];	675	my $children = delete $arg{children};
520		676
521	my $self = $class->SUPER::new (	677	my $self = $class->SUPER::new (
522	children => [],	678	children => [],
523	can_events => 0,	679	can_events => 0,
524	%arg,	680	%arg,
525	);	681	);
		682
526	$self->add ($_) for @$children;	683	$self->add (@$children)
		684	if $children;
527		685
528	$self	686	$self
529	}	687	}
530		688
531	sub add {	689	sub add {
532	my ($self, $child) = @_;	690	my ($self, @widgets) = @_;
533		691
534	$child->set_parent ($self);	692	$_->set_parent ($self)
		693	for @widgets;
535		694
536	use sort 'stable';	695	use sort 'stable';
537		696
538	$self->{children} = [	697	$self->{children} = [
539	sort { $a->{z} <=> $b->{z} }	698	sort { $a->{z} <=> $b->{z} }
540	@{$self->{children}}, $child	699	@{$self->{children}}, @widgets
541	];	700	];
542		701
543	$child->check_size;	702	$self->realloc;
544	}	703	}
545		704
546	sub children {	705	sub children {
547	@{ $_[0]{children} }	706	@{ $_[0]{children} }
548	}	707	}
…		…
553	delete $child->{parent};	712	delete $child->{parent};
554	$child->hide;	713	$child->hide;
555		714
556	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	715	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
557		716
558	$self->check_size;	717	$self->realloc;
559	$self->update;
560	}	718	}
561		719
562	sub clear {	720	sub clear {
563	my ($self) = @_;	721	my ($self) = @_;
564		722
…		…
567		725
568	for (@$children) {	726	for (@$children) {
569	delete $_->{parent};	727	delete $_->{parent};
570	$_->hide;	728	$_->hide;
571	}	729	}
		730
		731	$self->realloc;
572	}	732	}
573		733
574	sub find_widget {	734	sub find_widget {
575	my ($self, $x, $y) = @_;	735	my ($self, $x, $y) = @_;
576		736
577	$x -= $self->{x};	737	$x -= $self->{x};
578	$y -= $self->{y};	738	$y -= $self->{y};
579		739
580	my $res;	740	my $res;
581		741
582	for (reverse @{ $self->{children} }) {	742	for (reverse $self->visible_children) {
583	$res = $_->find_widget ($x, $y)	743	$res = $_->find_widget ($x, $y)
584	and return $res;	744	and return $res;
585	}	745	}
586		746
587	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	747	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
636	$self->{children}[0]->configure (0, 0, $w, $h);	796	$self->{children}[0]->configure (0, 0, $w, $h);
637	}	797	}
638		798
639	#############################################################################	799	#############################################################################
640		800
		801	# back-buffered drawing area
		802
641	package CFClient::UI::Window;	803	package CFClient::UI::Window;
642		804
643	our @ISA = CFClient::UI::Bin::;	805	our @ISA = CFClient::UI::Bin::;
644		806
645	use CFClient::OpenGL;	807	use CFClient::OpenGL;
…		…
651	}	813	}
652		814
653	sub update {	815	sub update {
654	my ($self) = @_;	816	my ($self) = @_;
655		817
656	$ROOT->on_refresh ($self => sub { $self->render_child });	818	$ROOT->on_post_alloc ($self => sub { $self->render_child });
657	$self->SUPER::update;	819	$self->SUPER::update;
658	}	820	}
659		821
660	sub size_allocate {	822	sub size_allocate {
661	my ($self, $w, $h) = @_;	823	my ($self, $w, $h) = @_;
662		824
663	$self->SUPER::size_allocate ($w, $h);	825	$self->SUPER::size_allocate ($w, $h);
664	$self->update;	826	$self->update;
		827	}
		828
		829	sub _render {
		830	my ($self) = @_;
		831
		832	$self->{children}[0]->draw;
665	}	833	}
666		834
667	sub render_child {	835	sub render_child {
668	my ($self) = @_;	836	my ($self) = @_;
669		837
670	$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 {
671	glClearColor 0, 0, 0, 0;	839	glClearColor 0, 0, 0, 0;
672	glClear GL_COLOR_BUFFER_BIT;	840	glClear GL_COLOR_BUFFER_BIT;
673	$self->child->draw;	841
674	# glColorMask 1, 1, 1, 0;	842	{
675	# glEnable GL_BLEND;	843	package CFClient::UI::Base;
676	# glBlendFunc GL_SRC_ALPHA, GL_ZERO;	844
677	# glRasterPos 0, 0;	845	($draw_x, $draw_y, $draw_w, $draw_h) =
678	# glCopyPixels 0, 0, $self->{w}, $self->{h};	846	(0, 0, $self->{w}, $self->{h});
679	# glDisable GL_BLEND;	847	}
680	# glColorMask 1, 1, 1, 1;	848
		849	$self->_render;
681	};	850	};
682	}	851	}
683		852
684	sub _draw {	853	sub _draw {
685	my ($self) = @_;	854	my ($self) = @_;
686		855
687	my ($w, $h) = ($self->w, $self->h);	856	my ($w, $h) = @$self{qw(w h)};
688		857
689	my $tex = $self->{texture}	858	my $tex = $self->{texture}
690	or return;	859	or return;
691		860
692	glEnable GL_BLEND;
693	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
694	glEnable GL_TEXTURE_2D;	861	glEnable GL_TEXTURE_2D;
695	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	862	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
696	glColor 0, 0, 0, 1;	863	glColor 0, 0, 0, 1;
697		864
698	$tex->draw_quad (0, 0, $w, $h);	865	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
699		866
700	glDisable GL_BLEND;
701	glDisable GL_TEXTURE_2D;	867	glDisable GL_TEXTURE_2D;
702	}	868	}
703		869
704	#############################################################################	870	#############################################################################
705		871
706	package CFClient::UI::ViewPort;	872	package CFClient::UI::ViewPort;
707		873
708	our @ISA = CFClient::UI::Window::;	874	our @ISA = CFClient::UI::Window::;
709
710	sub new { die }
711
712	sub size_request {
713	my ($self) = @_;
714
715	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};
716	$self->child->size_allocate (0, 0, @$self{qw(child_w child_h)});
717
718	@$self{qw(child_w child_h)}
719	}
720
721	sub _draw {
722	my ($self) = @_;
723
724	$self->{children}[1]->draw;
725	}
726
727
728	#############################################################################
729
730	package CFClient::UI::Frame;
731
732	our @ISA = CFClient::UI::Bin::;
733
734	use CFClient::OpenGL;
735		875
736	sub new {	876	sub new {
737	my $class = shift;	877	my $class = shift;
738		878
		879	$class->SUPER::new (
		880	scroll_x => 0,
		881	scroll_y => 1,
		882	@_,
		883	)
		884	}
		885
		886	sub size_request {
		887	my ($self) = @_;
		888
		889	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
		890
		891	$w = 10 if $self->{scroll_x};
		892	$h = 10 if $self->{scroll_y};
		893
		894	($w, $h)
		895	}
		896
		897	sub size_allocate {
		898	my ($self, $w, $h) = @_;
		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);
		906	$self->update;
		907	}
		908
		909	sub set_offset {
		910	my ($self, $x, $y) = @_;
		911
		912	$self->{view_x} = int $x;
		913	$self->{view_y} = int $y;
		914
		915	$self->update;
		916	}
		917
		918	# hmm, this does not work for topleft of $self... but we should not ask for that
		919	sub coord2local {
		920	my ($self, $x, $y) = @_;
		921
		922	$self->SUPER::coord2local ($x + $self->{view_x}, $y + $self->{view_y})
		923	}
		924
		925	sub coord2global {
		926	my ($self, $x, $y) = @_;
		927
		928	$x = List::Util::min $self->{w}, $x - $self->{view_x};
		929	$y = List::Util::min $self->{h}, $y - $self->{view_y};
		930
		931	$self->SUPER::coord2global ($x, $y)
		932	}
		933
		934	sub find_widget {
		935	my ($self, $x, $y) = @_;
		936
		937	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
		938	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
		939	) {
		940	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
		941	} else {
		942	$self->CFClient::UI::Base::find_widget ($x, $y)
		943	}
		944	}
		945
		946	sub _render {
		947	my ($self) = @_;
		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
		952	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
		953
		954	$self->SUPER::_render;
		955	}
		956
		957	#############################################################################
		958
		959	package CFClient::UI::ScrolledWindow;
		960
		961	our @ISA = CFClient::UI::HBox::;
		962
		963	sub new {
		964	my ($class, %arg) = @_;
		965
		966	my $child = delete $arg{child};
		967
		968	my $self;
		969
		970	my $slider = new CFClient::UI::Slider
		971	vertical => 1,
		972	range => [0, 0, 1, 0.01], # HACK fix
		973	on_changed => sub {
		974	$self->{vp}->set_offset (0, $_[1]);
		975	},
		976	;
		977
739	my $self = $class->SUPER::new (	978	$self = $class->SUPER::new (
740	bg => [1, 1, 1, 1],	979	vp => (new CFClient::UI::ViewPort expand => 1),
741	border_bg => [1, 1, 1, 1],	980	slider => $slider,
742	border => 0.8,	981	%arg,
743	@_
744	);	982	);
745		983
		984	$self->SUPER::add ($self->{vp}, $self->{slider});
		985	$self->add ($child) if $child;
		986
746	$self	987	$self
747	}	988	}
748		989
749	sub _draw {	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 {
750	my ($self) = @_;	1007	my ($self, $w, $h) = @_;
751		1008
752	my ($w, $h) = ($self->{w}, $self->{h});	1009	$self->SUPER::size_allocate ($w, $h);
753		1010
754	glEnable GL_BLEND;	1011	my $child = $self->{vp}->child;
755	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1012	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
756	glEnable GL_TEXTURE_2D;
757	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
758
759	# glBegin GL_QUADS;
760	# glColor 0, 0, 0, 0;
761	# glVertex 0 , 0;
762	# glVertex 0 , $h;
763	# glVertex $w, $h;
764	# glVertex $w, 0;
765	# glEnd;
766
767
768	$self->child->draw;
769	glDisable GL_BLEND;
770	glDisable GL_TEXTURE_2D;
771	}	1013	}
		1014
		1015	#TODO# update range on size_allocate depending on child
		1016	# update viewport offset on scroll
772		1017
773	#############################################################################	1018	#############################################################################
774		1019
775	package CFClient::UI::FancyFrame;	1020	package CFClient::UI::Frame;
776		1021
777	our @ISA = CFClient::UI::Bin::;	1022	our @ISA = CFClient::UI::Bin::;
778		1023
779	use CFClient::OpenGL;	1024	use CFClient::OpenGL;
780
781	my @tex =
782	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
783	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
784		1025
785	sub new {	1026	sub new {
786	my $class = shift;	1027	my $class = shift;
787		1028
788	# TODO: user_x, user_y, overwrite moveto?	1029	$class->SUPER::new (
		1030	bg => undef,
		1031	@_,
		1032	)
		1033	}
		1034
		1035	sub _draw {
		1036	my ($self) = @_;
		1037
		1038	if ($self->{bg}) {
		1039	my ($w, $h) = @$self{qw(w h)};
		1040
		1041	glEnable GL_BLEND;
		1042	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		1043	glColor_premultiply @{ $self->{bg} };
		1044
		1045	glBegin GL_QUADS;
		1046	glVertex 0 , 0;
		1047	glVertex 0 , $h;
		1048	glVertex $w, $h;
		1049	glVertex $w, 0;
		1050	glEnd;
		1051
		1052	glDisable GL_BLEND;
		1053	}
		1054
		1055	$self->SUPER::_draw;
		1056	}
		1057
		1058	#############################################################################
		1059
		1060	package CFClient::UI::FancyFrame;
		1061
		1062	our @ISA = CFClient::UI::Bin::;
		1063
		1064	use CFClient::OpenGL;
		1065
		1066	my $bg =
		1067	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1068	mipmap => 1, wrap => 1;
		1069
		1070	my @border =
		1071	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
		1072	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
		1073
		1074	sub new {
		1075	my ($class, %arg) = @_;
		1076
		1077	my $title = delete $arg{title};
789		1078
790	my $self = $class->SUPER::new (	1079	my $self = $class->SUPER::new (
791	bg => [1, 1, 1, 1],	1080	bg => [1, 1, 1, 1],
792	border_bg => [1, 1, 1, 1],	1081	border_bg => [1, 1, 1, 1],
793	border => 0.8,	1082	border => 0.6,
794	can_events => 1,	1083	can_events => 1,
795	@_	1084	min_w => 16,
		1085	min_h => 16,
		1086	%arg,
796	);	1087	);
797		1088
798	$self->{title} &&= new CFClient::UI::Label	1089	$self->{title} = new CFClient::UI::Label
799	align => 0,	1090	align => 0,
800	valign => 1,	1091	valign => 1,
801	text => $self->{title},	1092	text => $title,
802	fontsize => 1;	1093	fontsize => $self->{border}
		1094	if defined $title;
803		1095
804	$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};
805	}	1104	}
806		1105
807	sub border {	1106	sub border {
808	int $_[0]{border} * $::FONTSIZE	1107	int $_[0]{border} * $::FONTSIZE
809	}	1108	}
810		1109
811	sub size_request {	1110	sub size_request {
812	my ($self) = @_;	1111	my ($self) = @_;
		1112
		1113	$self->{title}->size_request
		1114	if $self->{title};
813		1115
814	my ($w, $h) = $self->SUPER::size_request;	1116	my ($w, $h) = $self->SUPER::size_request;
815		1117
816	(	1118	(
817	$w + $self->border * 2,	1119	$w + $self->border * 2,
…		…
820	}	1122	}
821		1123
822	sub size_allocate {	1124	sub size_allocate {
823	my ($self, $w, $h) = @_;	1125	my ($self, $w, $h) = @_;
824		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
825	$h -= List::Util::max 0, $self->border * 2;	1135	$h -= List::Util::max 0, $border * 2;
826	$w -= List::Util::max 0, $self->border * 2;	1136	$w -= List::Util::max 0, $border * 2;
827		1137
828	$self->{title}->configure ($self->border, $self->border - $::FONTSIZE * 2, $w, $::FONTSIZE * 2)
829	if $self->{title};
830
831	$self->child->configure ($self->border, $self->border, $w, $h);	1138	$self->child->configure ($border, $border, $w, $h);
832	}	1139	}
833		1140
834	sub button_down {	1141	sub button_down {
835	my ($self, $ev, $x, $y) = @_;	1142	my ($self, $ev, $x, $y) = @_;
836		1143
		1144	my ($w, $h) = @$self{qw(w h)};
837	my $border = $self->border;	1145	my $border = $self->border;
838		1146
839	if ($x < $self->{w} && $x >= $self->{w} - $border	1147	my $lr = ($x >= 0 && $x < $border) || ($x > $w - $border && $x < $w);
840	&& $y < $self->{h} && $y >= $self->{h} - $border) {	1148	my $td = ($y >= 0 && $y < $border) || ($y > $h - $border && $y < $h);
841		1149
		1150	if ($lr & $td) {
		1151	my ($wx, $wy) = ($self->{x}, $self->{y});
842	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1152	my ($ox, $oy) = ($ev->{x}, $ev->{y});
843	my ($bw, $bh) = ($self->{w}, $self->{h});	1153	my ($bw, $bh) = ($self->{w}, $self->{h});
844		1154
		1155	my $mx = $x < $border;
		1156	my $my = $y < $border;
		1157
845	$self->{motion} = sub {	1158	$self->{motion} = sub {
846	my ($ev, $x, $y) = @_;	1159	my ($ev, $x, $y) = @_;
847		1160
848	($x, $y) = ($ev->{x}, $ev->{y});	1161	my $dx = $ev->{x} - $ox;
		1162	my $dy = $ev->{y} - $oy;
849		1163
850	$self->{user_w} = $bw + $x - $ox;	1164	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
851	$self->{user_h} = $bh + $y - $oy;	1165	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
852	$self->check_size;	1166
		1167	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
		1168	$self->realloc;
853	};	1169	};
854		1170
855	} elsif ($x >= 0 && $x < $self->{w}	1171	} elsif ($lr ^ $td) {
856	&& $y >= 0 && $y < $border) {
857
858	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1172	my ($ox, $oy) = ($ev->{x}, $ev->{y});
859	my ($bx, $by) = ($self->{x}, $self->{y});	1173	my ($bx, $by) = ($self->{x}, $self->{y});
860		1174
861	$self->{motion} = sub {	1175	$self->{motion} = sub {
862	my ($ev, $x, $y) = @_;	1176	my ($ev, $x, $y) = @_;
863		1177
864	($x, $y) = ($ev->{x}, $ev->{y});	1178	($x, $y) = ($ev->{x}, $ev->{y});
865		1179
866	$self->move ($bx + $x - $ox, $by + $y - $oy);	1180	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
867	$self->update;	1181	# HACK: the next line is required to enforce placement
		1182	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
868	};	1183	};
		1184	} else {
		1185	return 0;
		1186	}
		1187
869	}	1188	1
870	}	1189	}
871		1190
872	sub button_up {	1191	sub button_up {
873	my ($self, $ev, $x, $y) = @_;	1192	my ($self, $ev, $x, $y) = @_;
874		1193
875	delete $self->{motion};	1194	!!delete $self->{motion}
876	}	1195	}
877		1196
878	sub mouse_motion {	1197	sub mouse_motion {
879	my ($self, $ev, $x, $y) = @_;	1198	my ($self, $ev, $x, $y) = @_;
880		1199
881	$self->{motion}->($ev, $x, $y) if $self->{motion};	1200	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1201
		1202	!!$self->{motion}
882	}	1203	}
883		1204
884	sub _draw {	1205	sub _draw {
885	my ($self) = @_;	1206	my ($self) = @_;
886		1207
		1208	my $child = $self->{children}[0];
		1209
887	my ($w, $h ) = ($self->{w}, $self->{h});	1210	my ($w, $h ) = ($self->{w}, $self->{h});
888	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1211	my ($cw, $ch) = ($child->{w}, $child->{h});
889		1212
890	glEnable GL_BLEND;
891	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
892	glEnable GL_TEXTURE_2D;	1213	glEnable GL_TEXTURE_2D;
893	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1214	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
894		1215
895	my $border = $self->border;	1216	my $border = $self->border;
896		1217
897	glColor @{ $self->{border_bg} };	1218	glColor @{ $self->{border_bg} };
898	$tex[1]->draw_quad (0, 0, $w, $border);	1219	$border[0]->draw_quad_alpha (0, 0, $w, $border);
899	$tex[3]->draw_quad (0, $border, $border, $ch);	1220	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
900	$tex[2]->draw_quad ($w - $border, $border, $border, $ch);	1221	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
901	$tex[4]->draw_quad (0, $h - $border, $w, $border);	1222	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
902		1223
903	my $bg = $tex[0];	1224	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
		1225	glColor @{ $self->{bg} };
904		1226
905	# TODO: repeat texture not scale	1227	# TODO: repeat texture not scale
906	my $rep_x = $cw / $bg->{w};	1228	# solve this better(?)
907	my $rep_y = $ch / $bg->{h};	1229	$bg->{s} = $cw / $bg->{w};
908		1230	$bg->{t} = $ch / $bg->{h};
909	glColor @{ $self->{bg} };
910
911	$bg->{s} = $rep_x;
912	$bg->{t} = $rep_y;
913	$bg->{wrap_mode} = 1;
914	$bg->draw_quad ($border, $border, $cw, $ch);	1231	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
		1232	}
915		1233
916	glDisable GL_TEXTURE_2D;	1234	glDisable GL_TEXTURE_2D;
917	glDisable GL_BLEND;
918		1235
919	$self->{title}->draw if $self->{title};
920	$self->child->draw;	1236	$child->draw;
		1237
		1238	if ($self->{title}) {
		1239	glTranslate 0, $border - $self->{h};
		1240	$self->{title}->_draw;
		1241	}
921	}	1242	}
922		1243
923	#############################################################################	1244	#############################################################################
924		1245
925	package CFClient::UI::Table;	1246	package CFClient::UI::Table;
…		…
933	sub new {	1254	sub new {
934	my $class = shift;	1255	my $class = shift;
935		1256
936	$class->SUPER::new (	1257	$class->SUPER::new (
937	col_expand => [],	1258	col_expand => [],
938	@_	1259	@_,
939	)	1260	)
		1261	}
		1262
		1263	sub children {
		1264	grep $_, map @$_, grep $_, @{ $_[0]{children} }
940	}	1265	}
941		1266
942	sub add {	1267	sub add {
943	my ($self, $x, $y, $child) = @_;	1268	my ($self, $x, $y, $child) = @_;
944		1269
945	$child->set_parent ($self);	1270	$child->set_parent ($self);
946	$self->{children}[$y][$x] = $child;	1271	$self->{children}[$y][$x] = $child;
947		1272
948	$child->check_size;	1273	$self->realloc;
949	}	1274	}
950		1275
951	sub children {
952	grep $_, map @$_, grep $_, @{ $_[0]{children} }
953	}
954
955	# 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?
956	sub clear {	1277	sub clear {
957	my ($self) = @_;	1278	my ($self) = @_;
958		1279
959	my @children = $self->children;	1280	my @children = $self->children;
960	delete $self->{children};	1281	delete $self->{children};
…		…
962	for (@children) {	1283	for (@children) {
963	delete $_->{parent};	1284	delete $_->{parent};
964	$_->hide;	1285	$_->hide;
965	}	1286	}
966		1287
967	$self->update;	1288	$self->realloc;
968	}	1289	}
969		1290
970	sub get_wh {	1291	sub get_wh {
971	my ($self) = @_;	1292	my ($self) = @_;
972		1293
…		…
1003	sub size_allocate {	1324	sub size_allocate {
1004	my ($self, $w, $h) = @_;	1325	my ($self, $w, $h) = @_;
1005		1326
1006	my ($ws, $hs) = $self->get_wh;	1327	my ($ws, $hs) = $self->get_wh;
1007		1328
1008	my $req_w = sum @$ws;	1329	my $req_w = (sum @$ws) || 1;
1009	my $req_h = sum @$hs;	1330	my $req_h = (sum @$hs) || 1;
1010		1331
1011	# TODO: nicer code && do row_expand	1332	# TODO: nicer code && do row_expand
1012	my @col_expand = @{$self->{col_expand}};	1333	my @col_expand = @{$self->{col_expand}};
1013	@col_expand = (1) x @$ws unless @col_expand;	1334	@col_expand = (1) x @$ws unless @col_expand;
1014	my $col_expand = (sum @col_expand) || 1;	1335	my $col_expand = (sum @col_expand) || 1;
…		…
1068	}	1389	}
1069	}	1390	}
1070		1391
1071	#############################################################################	1392	#############################################################################
1072		1393
1073	package CFClient::UI::HBox;	1394	package CFClient::UI::Box;
1074
1075	# TODO: wrap into common Box base class
1076		1395
1077	our @ISA = CFClient::UI::Container::;	1396	our @ISA = CFClient::UI::Container::;
1078		1397
1079	sub size_request {	1398	sub size_request {
1080	my ($self) = @_;	1399	my ($self) = @_;
1081		1400
1082	my @alloc = map [$_->size_request], @{$self->{children}};	1401	$self->{vertical}
1083		1402	? (
1084	(	1403	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1085	(List::Util::sum map $_->[0], @alloc),	1404	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1086	(List::Util::max map $_->[1], @alloc),	1405	)
1087	)	1406	: (
		1407	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1408	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1409	)
1088	}	1410	}
1089		1411
1090	sub size_allocate {	1412	sub size_allocate {
1091	my ($self, $w, $h) = @_;	1413	my ($self, $w, $h) = @_;
1092		1414
1093	($h, $w) = ($w, $h);	1415	my $space = $self->{vertical} ? $h : $w;
1094
1095	my $children = $self->{children};	1416	my $children = $self->{children};
1096		1417
1097	my @h = map $_->{req_w}, @$children;	1418	my @req;
1098		1419
1099	my $req_h = List::Util::sum @h;	1420	if ($self->{homogeneous}) {
1100		1421	@req = ($space / (@$children || 1)) x @$children;
1101	if ($req_h > $h) {
1102	# ah well, not enough space
1103	$_ *= $h / $req_h for @h;
1104	} 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 {
1105	my $exp = List::Util::sum map $_->{expand}, @$children;	1430	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1106	$exp ||= 1;
1107		1431
		1432	$space = ($space - $req) / $expand; # remaining space to give away
		1433
		1434	$req[$_] += $space * $children->[$_]{expand}
1108	for (0 .. $#$children) {	1435	for 0 .. $#$children;
1109	my $child = $children->[$_];
1110
1111	my $alloc_h = $h[$_];
1112	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1113	$h[$_] = $alloc_h;
1114	}	1436	}
1115	}	1437	}
1116		1438
1117	CFClient::UI::harmonize \@h;	1439	CFClient::UI::harmonize \@req;
1118		1440
1119	my $y = 0;	1441	my $pos = 0;
1120	for (0 .. $#$children) {	1442	for (0 .. $#$children) {
1121	my $child = $children->[$_];
1122	my $h = $h[$_];	1443	my $alloc = $req[$_];
1123	$child->configure ($y, 0, $h, $w);	1444	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1124		1445
1125	$y += $h;	1446	$pos += $alloc;
1126	}	1447	}
1127		1448
1128	1	1449	1
1129	}	1450	}
1130		1451
1131	#############################################################################	1452	#############################################################################
1132		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
1133	package CFClient::UI::VBox;	1469	package CFClient::UI::VBox;
1134		1470
1135	# TODO: wrap into common Box base class
1136
1137	our @ISA = CFClient::UI::Container::;	1471	our @ISA = CFClient::UI::Box::;
1138		1472
1139	sub size_request {	1473	sub new {
1140	my ($self) = @_;	1474	my $class = shift;
1141		1475
1142	my @alloc = map [$_->size_request], @{$self->{children}};	1476	$class->SUPER::new (
1143		1477	vertical => 1,
1144	(	1478	@_,
1145	(List::Util::max map $_->[0], @alloc),
1146	(List::Util::sum map $_->[1], @alloc),
1147	)	1479	)
1148	}	1480	}
1149		1481
1150	sub size_allocate {
1151	my ($self, $w, $h) = @_;
1152
1153	my $children = $self->{children};
1154
1155	my @h = map $_->{req_h}, @$children;
1156
1157	my $req_h = List::Util::sum @h;
1158
1159	if ($req_h > $h) {
1160	# ah well, not enough space
1161	$_ *= $h / $req_h for @h;
1162	} else {
1163	my $exp = List::Util::sum map $_->{expand}, @$children;
1164	$exp ||= 1;
1165
1166	for (0 .. $#$children) {
1167	my $child = $children->[$_];
1168
1169	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1170	}
1171	}
1172
1173	CFClient::UI::harmonize \@h;
1174
1175	my $y = 0;
1176	for (0 .. $#$children) {
1177	my $child = $children->[$_];
1178	my $h = $h[$_];
1179	$child->configure (0, $y, $w, $h);
1180
1181	$y += $h;
1182	}
1183
1184	1
1185	}
1186
1187	#############################################################################	1482	#############################################################################
1188		1483
1189	package CFClient::UI::Label;	1484	package CFClient::UI::Label;
1190		1485
1191	our @ISA = CFClient::UI::Base::;	1486	our @ISA = CFClient::UI::DrawBG::;
1192		1487
1193	use CFClient::OpenGL;	1488	use CFClient::OpenGL;
1194		1489
1195	sub new {	1490	sub new {
1196	my ($class, %arg) = @_;	1491	my ($class, %arg) = @_;
1197		1492
1198	my $self = $class->SUPER::new (	1493	my $self = $class->SUPER::new (
1199	fg => [1, 1, 1],	1494	fg => [1, 1, 1],
		1495	#bg => none
		1496	#active_bg => none
1200	#font => default_font	1497	#font => default_font
		1498	#text => initial text
		1499	#markup => initial narkup
		1500	#max_w => maximum pixel width
		1501	ellipsise => 3, # end
		1502	layout => (new CFClient::Layout),
1201	fontsize => 1,	1503	fontsize => 1,
1202	text => "",
1203	align => -1,	1504	align => -1,
1204	valign => -1,	1505	valign => -1,
1205	padding => 2,	1506	padding_x => 2,
1206	layout => new CFClient::Layout,	1507	padding_y => 2,
1207	can_events => 0,	1508	can_events => 0,
1208	%arg	1509	%arg
1209	);	1510	);
1210		1511
1211	if (exists $self->{template}) {	1512	if (exists $self->{template}) {
1212	my $layout = new CFClient::Layout;	1513	my $layout = new CFClient::Layout;
1213	$layout->set_text (delete $self->{template});	1514	$layout->set_text (delete $self->{template});
1214	$self->{template} = $layout;	1515	$self->{template} = $layout;
1215	}	1516	}
1216		1517
1217	$self->set_text (delete $self->{text}) if exists $self->{text};	1518	if (exists $self->{markup}) {
1218	$self->set_markup (delete $self->{markup}) if exists $self->{markup};	1519	$self->set_markup (delete $self->{markup});
		1520	} else {
		1521	$self->set_text (delete $self->{text});
		1522	}
1219		1523
1220	$self	1524	$self
1221	}	1525	}
1222		1526
1223	sub escape {	1527	sub escape($) {
1224	local $_ = $_[1];	1528	local $_ = $_[0];
1225		1529
1226	s/&/&amp;/g;	1530	s/&/&amp;/g;
1227	s/>/&gt;/g;	1531	s/>/&gt;/g;
1228	s/</&lt;/g;	1532	s/</&lt;/g;
1229		1533
1230	$_[1]	1534	$_
1231	}	1535	}
1232		1536
1233	sub update {	1537	sub update {
1234	my ($self) = @_;	1538	my ($self) = @_;
1235		1539
1236	delete $self->{texture};	1540	delete $self->{texture};
1237	$self->SUPER::update;	1541	$self->SUPER::update;
1238	}	1542	}
1239		1543
1240	sub reconfigure {	1544	sub realloc {
1241	my ($self) = @_;	1545	my ($self) = @_;
1242		1546
1243	delete $self->{texture};	1547	delete $self->{ox};
		1548	$self->SUPER::realloc;
1244	}	1549	}
1245		1550
1246	sub set_text {	1551	sub set_text {
1247	my ($self, $text) = @_;	1552	my ($self, $text) = @_;
1248		1553
1249	return if $self->{text} eq "T$text";	1554	return if $self->{text} eq "T$text";
1250	$self->{text} = "T$text";	1555	$self->{text} = "T$text";
1251		1556
		1557	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1252	$self->{layout}->set_text ($text);	1558	$self->{layout}->set_text ($text);
1253		1559
1254	delete $self->{texture};	1560	delete $self->{size_req};
		1561	$self->realloc;
1255	$self->update;	1562	$self->update;
1256	$self->check_size;
1257	}	1563	}
1258		1564
1259	sub set_markup {	1565	sub set_markup {
1260	my ($self, $markup) = @_;	1566	my ($self, $markup) = @_;
1261		1567
1262	return if $self->{text} eq "M$markup";	1568	return if $self->{text} eq "M$markup";
1263	$self->{text} = "M$markup";	1569	$self->{text} = "M$markup";
1264		1570
		1571	my $rgba = $markup =~ /span.*(?:foreground|background)/;
		1572
		1573	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1265	$self->{layout}->set_markup ($markup);	1574	$self->{layout}->set_markup ($markup);
1266		1575
1267	delete $self->{texture};	1576	delete $self->{size_req};
		1577	$self->realloc;
1268	$self->update;	1578	$self->update;
1269	$self->check_size;
1270	}	1579	}
1271		1580
1272	sub size_request {	1581	sub size_request {
1273	my ($self) = @_;	1582	my ($self) = @_;
1274		1583
		1584	$self->{size_req} ||= do {
1275	$self->{layout}->set_font ($self->{font}) if $self->{font};	1585	$self->{layout}->set_font ($self->{font}) if $self->{font};
1276	$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});
1277	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1589	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1278		1590
1279	my ($w, $h) = $self->{layout}->size;	1591	my ($w, $h) = $self->{layout}->size;
1280		1592
1281	if (exists $self->{template}) {	1593	if (exists $self->{template}) {
1282	$self->{template}->set_font ($self->{font}) if $self->{font};	1594	$self->{template}->set_font ($self->{font}) if $self->{font};
1283	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1595	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1284		1596
1285	my ($w2, $h2) = $self->{template}->size;	1597	my ($w2, $h2) = $self->{template}->size;
1286		1598
1287	$w = List::Util::max $w, $w2;	1599	$w = List::Util::max $w, $w2;
1288	$h = List::Util::max $h, $h2;	1600	$h = List::Util::max $h, $h2;
		1601	}
		1602
		1603	[$w, $h]
1289	}	1604	};
1290		1605
1291	(	1606	@{ $self->{size_req} }
1292	$w + $self->{padding} * 2,
1293	$h + $self->{padding} * 2,
1294	)
1295	}	1607	}
1296		1608
1297	sub size_allocate {	1609	sub size_allocate {
1298	my ($self, $w, $h) = @_;	1610	my ($self, $w, $h) = @_;
1299		1611
		1612	delete $self->{ox};
		1613
1300	delete $self->{texture};	1614	delete $self->{texture}
		1615	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1301	}	1616	}
1302		1617
1303	sub set_fontsize {	1618	sub set_fontsize {
1304	my ($self, $fontsize) = @_;	1619	my ($self, $fontsize) = @_;
1305		1620
1306	$self->{fontsize} = $fontsize;	1621	$self->{fontsize} = $fontsize;
1307	delete $self->{texture};	1622	delete $self->{texture};
1308	$self->check_size;	1623
1309	$self->update;	1624	$self->realloc;
		1625	}
		1626
		1627	sub reconfigure {
		1628	my ($self) = @_;
		1629
		1630	delete $self->{size_req};
		1631
		1632	$self->SUPER::reconfigure;
1310	}	1633	}
1311		1634
1312	sub _draw {	1635	sub _draw {
1313	my ($self) = @_;	1636	my ($self) = @_;
1314		1637
		1638	$self->SUPER::_draw; # draw background, if applicable
		1639
1315	my $tex = $self->{texture} ||= do {	1640	my $tex = $self->{texture} ||= do {
		1641	$self->{layout}->set_foreground (@{$self->{fg}});
1316	$self->{layout}->set_font ($self->{font}) if $self->{font};	1642	$self->{layout}->set_font ($self->{font}) if $self->{font};
1317	$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});
1318	$self->{layout}->set_height (List::Util::min $self->{h}, $self->{fontsize} * $::FONTSIZE);	1646	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
		1647
1319	new_from_layout CFClient::Texture $self->{layout}	1648	new_from_layout CFClient::Texture $self->{layout}
1320	};	1649	};
1321		1650
1322	glEnable GL_BLEND;	1651	unless (exists $self->{ox}) {
1323	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	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
1324	glEnable GL_TEXTURE_2D;	1661	glEnable GL_TEXTURE_2D;
		1662
		1663	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1664	my $h = List::Util::min $self->{h} + 2, $tex->{h};
		1665
		1666	if ($tex->{format} == GL_ALPHA) {
		1667	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
		1668	glColor @{$self->{fg}};
		1669	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
		1670	} else {
1325	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1671	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1326		1672	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1327	glColor @{$self->{fg}};	1673	}
1328
1329	$self->{ox} = int (
1330	$self->{align} < 0 ? $self->{padding}
1331	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}
1332	: ($self->{w} - $tex->{w}) * 0.5
1333	);
1334
1335	$self->{oy} = int (
1336	$self->{valign} < 0 ? $self->{padding}
1337	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}
1338	: ($self->{h} - $tex->{h}) * 0.5
1339	);
1340
1341	$tex->draw_quad ($self->{ox}, $self->{oy});
1342		1674
1343	glDisable GL_TEXTURE_2D;	1675	glDisable GL_TEXTURE_2D;
1344	glDisable GL_BLEND;
1345	}	1676	}
1346		1677
1347	#############################################################################	1678	#############################################################################
1348		1679
1349	package CFClient::UI::EntryBase;	1680	package CFClient::UI::EntryBase;
…		…
1362	active_fg => [0, 0, 0],	1693	active_fg => [0, 0, 0],
1363	can_hover => 1,	1694	can_hover => 1,
1364	can_focus => 1,	1695	can_focus => 1,
1365	valign => 0,	1696	valign => 0,
1366	can_events => 1,	1697	can_events => 1,
		1698	#text => ...
		1699	#hidden => "*",
1367	@_	1700	@_
1368	)	1701	)
1369	}	1702	}
1370		1703
1371	sub _set_text {	1704	sub _set_text {
…		…
1373		1706
1374	delete $self->{cur_h};	1707	delete $self->{cur_h};
1375		1708
1376	return if $self->{text} eq $text;	1709	return if $self->{text} eq $text;
1377		1710
1378	delete $self->{texture};
1379
1380	$self->{last_activity} = $::NOW;	1711	$self->{last_activity} = $::NOW;
1381	$self->{text} = $text;	1712	$self->{text} = $text;
1382		1713
1383	$text =~ s/./*/g if $self->{hidden};	1714	$text =~ s/./*/g if $self->{hidden};
1384	$self->{layout}->set_text ("$text ");	1715	$self->{layout}->set_text ("$text ");
		1716	delete $self->{size_req};
1385		1717
1386	$self->emit (changed => $self->{text});	1718	$self->_emit (changed => $self->{text});
		1719
		1720	$self->realloc;
		1721	$self->update;
		1722	}
		1723
		1724	sub set_text {
		1725	my ($self, $text) = @_;
		1726
		1727	$self->{cursor} = length $text;
		1728	$self->_set_text ($text);
1387	}	1729	}
1388		1730
1389	sub get_text {	1731	sub get_text {
1390	$_[0]{text}	1732	$_[0]{text}
1391	}	1733	}
…		…
1394	my ($self) = @_;	1736	my ($self) = @_;
1395		1737
1396	my ($w, $h) = $self->SUPER::size_request;	1738	my ($w, $h) = $self->SUPER::size_request;
1397		1739
1398	($w + 1, $h) # add 1 for cursor	1740	($w + 1, $h) # add 1 for cursor
1399	}
1400
1401	sub size_allocate {
1402	my ($self, $w, $h) = @_;
1403
1404	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1405	}
1406
1407	sub set_text {
1408	my ($self, $text) = @_;
1409
1410	$self->{cursor} = length $text;
1411	$self->_set_text ($text);
1412	$self->update;
1413	}	1741	}
1414		1742
1415	sub key_down {	1743	sub key_down {
1416	my ($self, $ev) = @_;	1744	my ($self, $ev) = @_;
1417		1745
…		…
1419	my $sym = $ev->{sym};	1747	my $sym = $ev->{sym};
1420	my $uni = $ev->{unicode};	1748	my $uni = $ev->{unicode};
1421		1749
1422	my $text = $self->get_text;	1750	my $text = $self->get_text;
1423		1751
1424	if ($sym == 8) {	1752	if ($uni == 8) {
1425	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1753	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1426	} elsif ($sym == 127) {	1754	} elsif ($uni == 127) {
1427	substr $text, $self->{cursor}, 1, "";	1755	substr $text, $self->{cursor}, 1, "";
1428	} elsif ($sym == CFClient::SDLK_LEFT) {	1756	} elsif ($sym == CFClient::SDLK_LEFT) {
1429	--$self->{cursor} if $self->{cursor};	1757	--$self->{cursor} if $self->{cursor};
1430	} elsif ($sym == CFClient::SDLK_RIGHT) {	1758	} elsif ($sym == CFClient::SDLK_RIGHT) {
1431	++$self->{cursor} if $self->{cursor} < length $self->{text};	1759	++$self->{cursor} if $self->{cursor} < length $self->{text};
1432	} elsif ($sym == CFClient::SDLK_HOME) {	1760	} elsif ($sym == CFClient::SDLK_HOME) {
1433	$self->{cursor} = 0;	1761	$self->{cursor} = 0;
1434	} elsif ($sym == CFClient::SDLK_END) {	1762	} elsif ($sym == CFClient::SDLK_END) {
1435	$self->{cursor} = length $text;	1763	$self->{cursor} = length $text;
1436	} elsif ($sym == 27) {	1764	} elsif ($uni == 27) {
1437	$self->emit ('escape');	1765	$self->_emit ('escape');
1438	} elsif ($uni) {	1766	} elsif ($uni) {
1439	substr $text, $self->{cursor}++, 0, chr $uni;	1767	substr $text, $self->{cursor}++, 0, chr $uni;
		1768	} else {
		1769	return 0;
1440	}	1770	}
1441		1771
1442	$self->_set_text ($text);	1772	$self->_set_text ($text);
1443	$self->update;	1773
		1774	$self->realloc;
		1775
		1776	1
1444	}	1777	}
1445		1778
1446	sub focus_in {	1779	sub focus_in {
1447	my ($self) = @_;	1780	my ($self) = @_;
1448		1781
…		…
1463	utf8::encode $text;	1796	utf8::encode $text;
1464	$self->{cursor} = length substr $text, 0, $idx;	1797	$self->{cursor} = length substr $text, 0, $idx;
1465		1798
1466	$self->_set_text ($self->{text});	1799	$self->_set_text ($self->{text});
1467	$self->update;	1800	$self->update;
		1801
		1802	1
1468	}	1803	}
1469		1804
1470	sub mouse_motion {	1805	sub mouse_motion {
1471	my ($self, $ev, $x, $y) = @_;	1806	my ($self, $ev, $x, $y) = @_;
1472	# 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
1473	}	1810	}
1474		1811
1475	sub _draw {	1812	sub _draw {
1476	my ($self) = @_;	1813	my ($self) = @_;
1477		1814
1478	local $self->{fg} = $self->{fg};	1815	local $self->{fg} = $self->{fg};
1479		1816
1480	if ($FOCUS == $self) {	1817	if ($FOCUS == $self) {
1481	glColor @{$self->{active_bg}};	1818	glColor_premultiply @{$self->{active_bg}};
1482	$self->{fg} = $self->{active_fg};	1819	$self->{fg} = $self->{active_fg};
1483	} else {	1820	} else {
1484	glColor @{$self->{bg}};	1821	glColor_premultiply @{$self->{bg}};
1485	}	1822	}
1486		1823
1487	glEnable GL_BLEND;	1824	glEnable GL_BLEND;
1488	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1825	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1489	glBegin GL_QUADS;	1826	glBegin GL_QUADS;
1490	glVertex 0 , 0;	1827	glVertex 0 , 0;
1491	glVertex 0 , $self->{h};	1828	glVertex 0 , $self->{h};
1492	glVertex $self->{w}, $self->{h};	1829	glVertex $self->{w}, $self->{h};
1493	glVertex $self->{w}, 0;	1830	glVertex $self->{w}, 0;
…		…
1528	if ($sym == 13) {	1865	if ($sym == 13) {
1529	unshift @{$self->{history}},	1866	unshift @{$self->{history}},
1530	my $txt = $self->get_text;	1867	my $txt = $self->get_text;
1531	$self->{history_pointer} = -1;	1868	$self->{history_pointer} = -1;
1532	$self->{history_saveback} = '';	1869	$self->{history_saveback} = '';
1533	$self->emit (activate => $txt);	1870	$self->_emit (activate => $txt);
1534	$self->update;	1871	$self->update;
1535		1872
1536	} elsif ($sym == CFClient::SDLK_UP) {	1873	} elsif ($sym == CFClient::SDLK_UP) {
1537	if ($self->{history_pointer} < 0) {	1874	if ($self->{history_pointer} < 0) {
1538	$self->{history_saveback} = $self->get_text;	1875	$self->{history_saveback} = $self->get_text;
…		…
1554	} else {	1891	} else {
1555	$self->set_text ($self->{history_saveback});	1892	$self->set_text ($self->{history_saveback});
1556	}	1893	}
1557		1894
1558	} else {	1895	} else {
1559	$self->SUPER::key_down ($ev);	1896	return $self->SUPER::key_down ($ev)
		1897	}
		1898
1560	}	1899	1
1561
1562	}	1900	}
1563		1901
1564	#############################################################################	1902	#############################################################################
1565		1903
1566	package CFClient::UI::Button;	1904	package CFClient::UI::Button;
…		…
1575		1913
1576	sub new {	1914	sub new {
1577	my $class = shift;	1915	my $class = shift;
1578		1916
1579	$class->SUPER::new (	1917	$class->SUPER::new (
1580	padding => 4,	1918	padding_x => 4,
		1919	padding_y => 4,
1581	fg => [1, 1, 1],	1920	fg => [1, 1, 1],
1582	bg => [1, 1, 1, 0.2],
1583	active_fg => [0, 0, 1],	1921	active_fg => [0, 0, 1],
1584	can_hover => 1,	1922	can_hover => 1,
1585	align => 0,	1923	align => 0,
1586	valign => 0,	1924	valign => 0,
1587	can_events => 1,	1925	can_events => 1,
1588	@_	1926	@_
1589	)	1927	)
1590	}	1928	}
1591		1929
		1930	sub activate { }
		1931
1592	sub button_up {	1932	sub button_up {
1593	my ($self, $ev, $x, $y) = @_;	1933	my ($self, $ev, $x, $y) = @_;
1594		1934
		1935	$self->emit ("activate")
1595	if ($x >= 0 && $x < $self->{w}	1936	if $x >= 0 && $x < $self->{w}
1596	&& $y >= 0 && $y < $self->{h}) {	1937	&& $y >= 0 && $y < $self->{h};
1597	$self->emit ("activate");	1938
1598	}	1939	1
1599	}	1940	}
1600		1941
1601	sub _draw {	1942	sub _draw {
1602	my ($self) = @_;	1943	my ($self) = @_;
1603		1944
1604	local $self->{fg} = $self->{fg};	1945	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1605		1946
1606	if ($GRAB == $self) {
1607	$self->{fg} = $self->{active_fg};
1608	}
1609
1610	glEnable GL_BLEND;
1611	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1612	glEnable GL_TEXTURE_2D;	1947	glEnable GL_TEXTURE_2D;
1613	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1948	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1614	glColor 0, 0, 0, 1;	1949	glColor 0, 0, 0, 1;
1615		1950
1616	$tex[0]->draw_quad (0, 0, $self->{w}, $self->{h});	1951	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1617		1952
1618	glDisable GL_TEXTURE_2D;	1953	glDisable GL_TEXTURE_2D;
1619	glDisable GL_BLEND;
1620		1954
1621	$self->SUPER::_draw;	1955	$self->SUPER::_draw;
1622	}	1956	}
1623		1957
1624	#############################################################################	1958	#############################################################################
…		…
1635		1969
1636	sub new {	1970	sub new {
1637	my $class = shift;	1971	my $class = shift;
1638		1972
1639	$class->SUPER::new (	1973	$class->SUPER::new (
1640	padding => 2,	1974	padding_x => 2,
		1975	padding_y => 2,
1641	fg => [1, 1, 1],	1976	fg => [1, 1, 1],
1642	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],
1643	state => 0,	1980	state => 0,
1644	can_hover => 1,	1981	can_hover => 1,
1645	@_	1982	@_
1646	)	1983	)
1647	}	1984	}
1648		1985
1649	sub size_request {	1986	sub size_request {
1650	my ($self) = @_;	1987	my ($self) = @_;
1651		1988
1652	($self->{padding} * 2 + 6) x 2	1989	(6) x 2
1653	}	1990	}
1654		1991
1655	sub button_down {	1992	sub button_down {
1656	my ($self, $ev, $x, $y) = @_;	1993	my ($self, $ev, $x, $y) = @_;
1657		1994
1658	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1995	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1659	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1996	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1660	$self->{state} = !$self->{state};	1997	$self->{state} = !$self->{state};
1661	$self->emit (changed => $self->{state});	1998	$self->_emit (changed => $self->{state});
		1999	} else {
		2000	return 0
		2001	}
		2002
1662	}	2003	1
1663	}	2004	}
1664		2005
1665	sub _draw {	2006	sub _draw {
1666	my ($self) = @_;	2007	my ($self) = @_;
1667		2008
1668	$self->SUPER::_draw;	2009	$self->SUPER::_draw;
1669		2010
1670	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2011	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1671		2012
1672	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;
1673		2016
1674	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2017	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1675		2018
1676	glEnable GL_BLEND;	2019	my $tex = $self->{state} ? $tex[1] : $tex[0];
		2020
1677	glEnable GL_TEXTURE_2D;	2021	glEnable GL_TEXTURE_2D;
1678	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1679
1680	my $tex = $self->{state} ? $tex[1] : $tex[0];
1681
1682	$tex->draw_quad (0, 0, $s, $s);	2022	$tex->draw_quad_alpha (0, 0, $s, $s);
1683
1684	glDisable GL_TEXTURE_2D;	2023	glDisable GL_TEXTURE_2D;
1685	glDisable GL_BLEND;
1686	}	2024	}
1687		2025
1688	#############################################################################	2026	#############################################################################
1689		2027
1690	package CFClient::UI::Image;	2028	package CFClient::UI::Image;
…		…
1733	glTranslate 0, -$self->{w}, 0;	2071	glTranslate 0, -$self->{w}, 0;
1734		2072
1735	($w, $h) = ($h, $w);	2073	($w, $h) = ($h, $w);
1736	}	2074	}
1737		2075
1738	glEnable GL_BLEND;
1739	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
1740	glEnable GL_TEXTURE_2D;	2076	glEnable GL_TEXTURE_2D;
1741	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2077	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1742		2078
1743	$tex->draw_quad (0, 0, $w, $h);	2079	$tex->draw_quad_alpha (0, 0, $w, $h);
1744		2080
1745	glDisable GL_BLEND;
1746	glDisable GL_TEXTURE_2D;	2081	glDisable GL_TEXTURE_2D;
1747	}	2082	}
1748		2083
1749	#############################################################################	2084	#############################################################################
1750		2085
…		…
1840		2175
1841	my $h1 = $self->{h} * (1 - $ycut1);	2176	my $h1 = $self->{h} * (1 - $ycut1);
1842	my $h2 = $self->{h} * (1 - $ycut2);	2177	my $h2 = $self->{h} * (1 - $ycut2);
1843		2178
1844	glEnable GL_BLEND;	2179	glEnable GL_BLEND;
1845	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;
1846	glEnable GL_TEXTURE_2D;	2182	glEnable GL_TEXTURE_2D;
1847	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2183	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1848		2184
1849	glBindTexture GL_TEXTURE_2D, $t1->{name};	2185	glBindTexture GL_TEXTURE_2D, $t1->{name};
1850	glBegin GL_QUADS;	2186	glBegin GL_QUADS;
…		…
1939	qw(s1_slider.png s1_slider_bg.png);	2275	qw(s1_slider.png s1_slider_bg.png);
1940		2276
1941	sub new {	2277	sub new {
1942	my $class = shift;	2278	my $class = shift;
1943		2279
1944	# range [value, low, high, page]	2280	# range [value, low, high, page, unit]
1945		2281
1946	# TODO: 0-width page	2282	# TODO: 0-width page
1947	# TODO: req_w/h are wrong with vertical	2283	# TODO: req_w/h are wrong with vertical
1948	# TODO: calculations are off	2284	# TODO: calculations are off
1949	my $self = $class->SUPER::new (	2285	my $self = $class->SUPER::new (
1950	fg => [1, 1, 1],	2286	fg => [1, 1, 1],
1951	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],
1952	range => [0, 0, 100, 10],	2290	range => [0, 0, 100, 10, 0],
1953	req_w => 20,	2291	min_w => $::WIDTH / 80,
1954	req_h => 20,	2292	min_h => $::WIDTH / 80,
1955	vertical => 0,	2293	vertical => 0,
1956	can_hover => 1,	2294	can_hover => 1,
1957	inner_pad => 5,	2295	inner_pad => 0.02,
1958	@_	2296	@_
1959	);	2297	);
1960		2298
		2299	$self->set_value ($self->{range}[0]);
		2300	$self->update;
		2301
1961	$self	2302	$self
1962	}	2303	}
1963		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
1964	sub size_request {	2341	sub size_request {
1965	my ($self) = @_;	2342	my ($self) = @_;
1966		2343
1967	my $w = $self->{req_w};	2344	($self->{req_w}, $self->{req_h})
1968	my $h = $self->{req_h};
1969
1970	$self->{vertical} ? ($h, $w) : ($w, $h)
1971	}	2345	}
1972		2346
1973	sub button_down {	2347	sub button_down {
1974	my ($self, $ev, $x, $y) = @_;	2348	my ($self, $ev, $x, $y) = @_;
1975		2349
1976	$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
1977	$self->mouse_motion ($ev, $x, $y);	2354	$self->mouse_motion ($ev, $x, $y)
1978	}	2355	}
1979		2356
1980	sub mouse_motion {	2357	sub mouse_motion {
1981	my ($self, $ev, $x, $y) = @_;	2358	my ($self, $ev, $x, $y) = @_;
1982		2359
1983	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
1984	my ($value, $lo, $hi, $page) = @{$self->{range}};	2388	my ($value, $lo, $hi, $page) = @{$self->{range}};
		2389	my $range = ($hi - $page - $lo) || 1e-100;
1985		2390
1986	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2391	my $knob_w = List::Util::min 1, $page / ($hi - $lo) || 0.1;
1987		2392
1988	my $inner_pad_px = $self->_calc_inner_pad_px ($w);	2393	$self->{offset} = List::Util::max $self->{inner_pad}, $knob_w * 0.5;
1989	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right	2394	$self->{scale} = 1 - 2 * $self->{offset} || 1e-100;
1990		2395
1991	$x -= $inner_pad_px; # substract the padding	2396	$value = ($value - $lo) / $range;
1992	$x = $x * ($hi - $lo) / $inner_w + $lo;	2397	$value = $value * $self->{scale} + $self->{offset};
1993	$x = $lo if $x < $lo;
1994	$x = $hi - $page if $x > $hi - $page;
1995	$self->{range}[0] = $x;
1996		2398
1997	$self->emit (changed => $x);	2399	$self->{knob_x} = $value - $knob_w * 0.5;
1998	$self->update;	2400	$self->{knob_w} = $knob_w;
1999	}	2401	}
2000	}
2001
2002	# the inner_* stuff is for generating a padding for the slider handle,
2003	# so that the handle doesn't leave the texture. This calculation isn't 100%
2004	# correct propably, but it does the job for now
2005	sub _calc_inner_pad_px {
2006	my ($self, $w) = @_;
2007	($w / 100) * $self->{inner_pad} # % to pixels
2008	}
2009
2010	sub _draw {
2011	my ($self) = @_;
2012		2402
2013	$self->SUPER::_draw ();	2403	$self->SUPER::_draw ();
2014		2404
2015	my ($w, $h) = @$self{qw(w h)};	2405	glScale $self->{w}, $self->{h};
2016		2406
2017	if ($self->{vertical}) {	2407	if ($self->{vertical}) {
2018	# draw a vertical slider like a rotated horizontal slider	2408	# draw a vertical slider like a rotated horizontal slider
2019		2409
		2410	glTranslate 1, 0, 0;
2020	glRotate 90, 0, 0, 1;	2411	glRotate 90, 0, 0, 1;
2021	glTranslate 0, -$self->{w}, 0;
2022
2023	($w, $h) = ($h, $w);
2024	}	2412	}
2025		2413
2026	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};	2414	my $fg = $FOCUS == $self ? $self->{active_fg} : $self->{fg};
2027	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};	2415	my $bg = $FOCUS == $self ? $self->{active_bg} : $self->{bg};
2028		2416
2029	my ($value, $lo, $hi, $page) = @{$self->{range}};
2030
2031	$hi = $value + 1 if $lo == $hi;
2032
2033	my $inner_pad_px = $self->_calc_inner_pad_px ($w);
2034	my $inner_w = $w - $inner_pad_px * 2; # * 2 for left & right
2035
2036	$page = int $page * $inner_w / ($hi - $lo);
2037	$value = int +($value - $lo) * $inner_w / ($hi - $lo);
2038
2039	$w -= $page;
2040	$page &= ~1;
2041	glTranslate $page * 0.5, 0, 0;
2042	$page ||= 2;
2043
2044	my $knob_a = $inner_pad_px + ($value - $page * 0.5);
2045	my $knob_b = $inner_pad_px + ($value + $page * 0.5);
2046
2047	glEnable GL_BLEND;
2048	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2049	glEnable GL_TEXTURE_2D;	2417	glEnable GL_TEXTURE_2D;
2050	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2418	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2051		2419
2052	# draw background	2420	# draw background
2053	$tex[1]->draw_quad (0, 0, $w, $h);	2421	$tex[1]->draw_quad_alpha (0, 0, 1, 1);
2054		2422
2055	# draw handle	2423	# draw handle
2056	$tex[0]->draw_quad ($knob_a, 0, $knob_b - $knob_a, $h);	2424	$tex[0]->draw_quad_alpha ($self->{knob_x}, 0, $self->{knob_w}, 1);
2057		2425
2058	glDisable GL_BLEND;
2059	glDisable GL_TEXTURE_2D;	2426	glDisable GL_TEXTURE_2D;
2060	}	2427	}
2061		2428
2062	#############################################################################	2429	#############################################################################
2063		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
2064	package CFClient::UI::TextView;	2472	package CFClient::UI::TextScroller;
2065		2473
2066	our @ISA = CFClient::UI::HBox::;	2474	our @ISA = CFClient::UI::HBox::;
2067		2475
2068	use CFClient::OpenGL;	2476	use CFClient::OpenGL;
2069		2477
…		…
2071	my $class = shift;	2479	my $class = shift;
2072		2480
2073	my $self = $class->SUPER::new (	2481	my $self = $class->SUPER::new (
2074	fontsize => 1,	2482	fontsize => 1,
2075	can_events => 0,	2483	can_events => 0,
		2484	indent => 0,
2076	#font => default_font	2485	#font => default_font
2077	@_,	2486	@_,
2078		2487
2079	layout => (new CFClient::Layout),	2488	layout => (new CFClient::Layout 1),
2080	par => [],	2489	par => [],
2081	height => 0,	2490	height => 0,
2082	children => [	2491	children => [
2083	(new CFClient::UI::Empty expand => 1),	2492	(new CFClient::UI::Empty expand => 1),
2084	(new CFClient::UI::Slider vertical => 1),	2493	(new CFClient::UI::Slider vertical => 1),
2085	],	2494	],
2086	);	2495	);
2087		2496
2088	$self->{children}[1]->connect (changed => sub {	2497	$self->{children}[1]->connect (changed => sub { $self->update });
2089	$self->update;
2090	});
2091		2498
2092	$self	2499	$self
2093	}	2500	}
2094		2501
2095	sub set_fontsize {	2502	sub set_fontsize {
2096	my ($self, $fontsize) = @_;	2503	my ($self, $fontsize) = @_;
2097		2504
2098	$self->{fontsize} = $fontsize;	2505	$self->{fontsize} = $fontsize;
2099	$self->reflow;	2506	$self->reflow;
2100	}
2101
2102	sub text_height {
2103	my ($self, $text) = @_;
2104
2105	my $layout = $self->{layout};
2106
2107	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2108	$layout->set_width ($self->{w});
2109	$layout->set_text ($text);
2110
2111	($layout->size)[1]
2112	}
2113
2114	sub reflow {
2115	my ($self) = @_;
2116
2117	$self->{need_reflow}++;
2118	$self->update;
2119	}	2507	}
2120		2508
2121	sub size_allocate {	2509	sub size_allocate {
2122	my ($self, $w, $h) = @_;	2510	my ($self, $w, $h) = @_;
2123		2511
2124	$self->SUPER::size_allocate ($w, $h);	2512	$self->SUPER::size_allocate ($w, $h);
2125		2513
2126	$self->{layout}->set_font ($self->{font}) if $self->{font};	2514	$self->{layout}->set_font ($self->{font}) if $self->{font};
2127	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2515	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2128	$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});
2129		2518
2130	$self->reflow;	2519	$self->reflow;
2131	}	2520	}
2132		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
2133	sub add_paragraph {	2557	sub add_paragraph {
2134	my ($self, $color, $text) = @_;	2558	my ($self, $color, $text, $indent) = @_;
2135		2559
2136	#TODO: intelligently "reformat" paragraph	2560	for my $line (split /\n/, $text) {
2137		2561	my ($w, $h) = $self->text_size ($line);
2138	my $height = $self->text_height ($text);
2139
2140	$self->{height} += $height;	2562	$self->{height} += $h;
		2563	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];
		2564	}
2141		2565
2142	push @{$self->{par}}, [$height, $color, $text];
2143
2144	$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]);
2145	$self->{children}[1]->update;
2146	}	2567	}
2147		2568
2148	sub update {	2569	sub update {
2149	my ($self) = @_;	2570	my ($self) = @_;
2150		2571
…		…
2152		2573
2153	return unless $self->{h} > 0;	2574	return unless $self->{h} > 0;
2154		2575
2155	delete $self->{texture};	2576	delete $self->{texture};
2156		2577
2157	$ROOT->on_refresh ($self, sub {	2578	$ROOT->on_post_alloc ($self => sub {
		2579	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2580
2158	if (delete $self->{need_reflow}) {	2581	if (delete $self->{need_reflow}) {
2159	my $height = 0;	2582	my $height = 0;
2160		2583
2161	$height += $_->[0] = $self->text_height ($_->[2])	2584	my $layout = $self->{layout};
		2585
		2586	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
		2587
2162	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	}
2163		2600
2164	$self->{height} = $height;	2601	$self->{height} = $height;
2165		2602
2166	$self->{children}[1]{range} = [$height - $self->{h}, 0, $height, $self->{h}];	2603	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2167		2604
2168	delete $self->{texture};	2605	delete $self->{texture};
2169	}	2606	}
2170		2607
2171	$self->{texture} ||= new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	2608	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2172	glClearColor 0, 0, 0, 0;	2609	glClearColor 0, 0, 0, 0;
2173	glClear GL_COLOR_BUFFER_BIT;	2610	glClear GL_COLOR_BUFFER_BIT;
2174		2611
		2612	my $top = int $self->{children}[1]{range}[0];
		2613
		2614	my $y0 = $top;
		2615	my $y1 = $top + $H;
		2616
		2617	my $y = 0;
		2618
		2619	my $layout = $self->{layout};
		2620
		2621	$layout->set_font ($self->{font}) if $self->{font};
		2622
2175	glEnable GL_BLEND;	2623	glEnable GL_BLEND;
		2624	#TODO# not correct in windows where rgba is forced off
2176	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2625	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2177	glEnable GL_TEXTURE_2D;
2178	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2179
2180	my $top = int $self->{children}[1]{range}[0];
2181
2182	my $y0 = $top;
2183	my $y1 = $top + $self->{h};
2184
2185	my $y = 0;
2186
2187	my $layout = $self->{layout};
2188
2189	$layout->set_font ($self->{font}) if $self->{font};
2190		2626
2191	for my $par (@{$self->{par}}) {	2627	for my $par (@{$self->{par}}) {
2192	my $h = $par->[0];	2628	my $h = $par->[1];
2193		2629
2194	if ($y0 < $y + $h && $y < $y1) {	2630	if ($y0 < $y + $h && $y < $y1) {
		2631	$layout->set_foreground (@{ $par->[2] });
		2632	$layout->set_width ($W - $par->[3]);
		2633	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2195	$layout->set_text ($par->[2]);	2634	$layout->set_markup ($par->[4]);
2196		2635
2197	glColor @{ $par->[1] };	2636	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2198	my ($W, $H) = $layout->size;	2637
2199	CFClient::Texture->new_from_layout ($layout)->draw_quad (0, $y - $y0);	2638	glRasterPos $par->[3], $y - $y0;
		2639	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;
2200	}	2640	}
2201		2641
2202	$y += $h;	2642	$y += $h;
2203	}	2643	}
2204		2644
2205	glDisable GL_TEXTURE_2D;
2206	glDisable GL_BLEND;	2645	glDisable GL_BLEND;
2207	};	2646	};
2208	});	2647	});
2209	}	2648	}
2210		2649
2211	sub _draw {	2650	sub _draw {
2212	my ($self) = @_;	2651	my ($self) = @_;
2213		2652
2214	if ($self->{texture}) {
2215	glEnable GL_BLEND;
2216	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2217	glEnable GL_TEXTURE_2D;	2653	glEnable GL_TEXTURE_2D;
2218	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2654	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2219	glColor 1, 1, 1, 1;	2655	glColor 0, 0, 0, 1;
2220	$self->{texture}->draw_quad (0, 0, $self->{w}, $self->{h});	2656	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2221	glDisable GL_TEXTURE_2D;	2657	glDisable GL_TEXTURE_2D;
2222	glDisable GL_BLEND;
2223	}
2224		2658
2225	$self->{children}[1]->draw;	2659	$self->{children}[1]->draw;
2226		2660
2227	}	2661	}
2228		2662
…		…
2276		2710
2277	sub new {	2711	sub new {
2278	my $class = shift;	2712	my $class = shift;
2279		2713
2280	my $self = $class->SUPER::new (	2714	my $self = $class->SUPER::new (
2281	state => 0,	2715	state => 0,
2282	connect_activate => \&toggle_flopper,	2716	on_activate => \&toggle_flopper,
2283	@_	2717	@_
2284	);	2718	);
2285		2719
2286	if ($self->{state}) {
2287	$self->{state} = 0;
2288	$self->toggle_flopper;
2289	}
2290
2291	$self	2720	$self
2292	}	2721	}
2293		2722
2294	sub toggle_flopper {	2723	sub toggle_flopper {
2295	my ($self) = @_;	2724	my ($self) = @_;
2296		2725
2297	# TODO: use animation	2726	$self->{other}->toggle_visibility;
2298	if ($self->{state} = !$self->{state}) {
2299	$CFClient::UI::ROOT->add ($self->{other});
2300	$self->{other}->move ($self->coord2global (0, $self->{h}));
2301	$self->emit ("open");
2302	} else {
2303	$CFClient::UI::ROOT->remove ($self->{other});
2304	$self->emit ("close");
2305	}
2306
2307	$self->emit (changed => $self->{state});
2308	}	2727	}
2309		2728
2310	#############################################################################	2729	#############################################################################
2311		2730
2312	package CFClient::UI::Tooltip;	2731	package CFClient::UI::Tooltip;
…		…
2322	@_,	2741	@_,
2323	can_events => 0,	2742	can_events => 0,
2324	)	2743	)
2325	}	2744	}
2326		2745
2327	sub set_markup {	2746	sub set_tooltip_from {
2328	my ($self, $text) = @_;	2747	my ($self, $widget) = @_;
2329		2748
2330	$self->{label} ||= new CFClient::UI::Label fontsize => 0.8, fg => [0, 0, 0];	2749	my $tooltip = $widget->{tooltip};
2331	$self->{label}->set_markup ($text);	2750
2332	$self->add ($self->{label});	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
		2761	$self->add (new CFClient::UI::Label
		2762	markup => $tooltip,
		2763	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
		2764	fontsize => 0.8,
		2765	fg => [0, 0, 0, 1],
		2766	ellipsise => 0,
		2767	font => ($widget->{tooltip_font} || $::FONT_PROP),
		2768	);
2333	}	2769	}
2334		2770
2335	sub size_request {	2771	sub size_request {
2336	my ($self) = @_;	2772	my ($self) = @_;
2337
2338	$self->child->set_max_size ($::WIDTH * 0.3);
2339		2773
2340	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2774	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2341		2775
2342	($w + 4, $h + 4)	2776	($w + 4, $h + 4)
2343	}	2777	}
…		…
2346	my ($self, $w, $h) = @_;	2780	my ($self, $w, $h) = @_;
2347		2781
2348	$self->SUPER::size_allocate ($w - 4, $h - 4);	2782	$self->SUPER::size_allocate ($w - 4, $h - 4);
2349	}	2783	}
2350		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	});
		2801	}
		2802
2351	sub _draw {	2803	sub _draw {
2352	my ($self) = @_;	2804	my ($self) = @_;
2353		2805
2354	glPushMatrix;
2355	glTranslate 0.375, 0.375;	2806	glTranslate 0.375, 0.375;
2356		2807
2357	my ($w, $h) = @$self{qw(w h)};	2808	my ($w, $h) = @$self{qw(w h)};
2358		2809
2359	glColor 1, 0.8, 0.4;	2810	glColor 1, 0.8, 0.4;
…		…
2370	glVertex 0 , $h;	2821	glVertex 0 , $h;
2371	glVertex $w, $h;	2822	glVertex $w, $h;
2372	glVertex $w, 0;	2823	glVertex $w, 0;
2373	glEnd;	2824	glEnd;
2374		2825
2375	glPopMatrix;	2826	glTranslate 2 - 0.375, 2 - 0.375;
2376		2827
2377	glTranslate 2, 2;
2378	$self->SUPER::_draw;	2828	$self->SUPER::_draw;
2379	}	2829	}
2380		2830
2381	#############################################################################	2831	#############################################################################
2382		2832
…		…
2387	use CFClient::OpenGL;	2837	use CFClient::OpenGL;
2388		2838
2389	sub new {	2839	sub new {
2390	my $class = shift;	2840	my $class = shift;
2391		2841
2392	$class->SUPER::new (	2842	my $self = $class->SUPER::new (
2393	aspect => 1,	2843	aspect => 1,
		2844	can_events => 0,
		2845	@_,
		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
		2863	}
		2864
		2865	sub size_request {
		2866	(32, 8)
		2867	}
		2868
		2869	sub update {
		2870	my ($self) = @_;
		2871
		2872	return unless $self->{visible};
		2873
		2874	$self->SUPER::update;
		2875	}
		2876
		2877	sub _draw {
		2878	my ($self) = @_;
		2879
		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
		2891	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
		2892
		2893	if ($tex) {
		2894	glEnable GL_TEXTURE_2D;
		2895	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2896	glColor 0, 0, 0, 1;
		2897	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
		2898	glDisable GL_TEXTURE_2D;
		2899	}
		2900	}
		2901
		2902	sub DESTROY {
		2903	my ($self) = @_;
		2904
		2905	$self->{timer}->cancel
		2906	if $self->{timer};
		2907
		2908	$self->SUPER::DESTROY;
		2909	}
		2910
		2911	#############################################################################
		2912
		2913	package CFClient::UI::Buttonbar;
		2914
		2915	our @ISA = CFClient::UI::HBox::;
		2916
		2917	# TODO: should actualyl wrap buttons and other goodies.
		2918
		2919	#############################################################################
		2920
		2921	package CFClient::UI::Menu;
		2922
		2923	our @ISA = CFClient::UI::FancyFrame::;
		2924
		2925	use CFClient::OpenGL;
		2926
		2927	sub new {
		2928	my $class = shift;
		2929
		2930	my $self = $class->SUPER::new (
		2931	items => [],
		2932	z => 100,
		2933	@_,
		2934	);
		2935
		2936	$self->add ($self->{vbox} = new CFClient::UI::VBox);
		2937
		2938	for my $item (@{ $self->{items} }) {
		2939	my ($widget, $cb, $tooltip) = @$item;
		2940
		2941	# handle various types of items, only text for now
		2942	if (!ref $widget) {
		2943	$widget = new CFClient::UI::Label
		2944	can_hover => 1,
		2945	can_events => 1,
		2946	markup => $widget,
		2947	tooltip => $tooltip
		2948	}
		2949
		2950	$self->{item}{$widget} = $item;
		2951
		2952	$self->{vbox}->add ($widget);
		2953	}
		2954
		2955	$self
		2956	}
		2957
		2958	# popup given the event (must be a mouse button down event currently)
		2959	sub popup {
		2960	my ($self, $ev) = @_;
		2961
		2962	$self->_emit ("popdown");
		2963
		2964	# maybe save $GRAB? must be careful about events...
		2965	$GRAB = $self;
		2966	$self->{button} = $ev->{button};
		2967
		2968	$self->show;
		2969	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
		2970	}
		2971
		2972	sub mouse_motion {
		2973	my ($self, $ev, $x, $y) = @_;
		2974
		2975	# TODO: should use vbox->find_widget or so
		2976	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
		2977	$self->{hover} = $self->{item}{$HOVER};
		2978
		2979	0
		2980	}
		2981
		2982	sub button_up {
		2983	my ($self, $ev, $x, $y) = @_;
		2984
		2985	if ($ev->{button} == $self->{button}) {
		2986	undef $GRAB;
		2987	$self->hide;
		2988
		2989	$self->_emit ("popdown");
		2990	$self->{hover}[1]->() if $self->{hover};
		2991	} else {
		2992	return 0
		2993	}
		2994
		2995	1
		2996	}
		2997
		2998	#############################################################################
		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
		3164	package CFClient::UI::Statusbox;
		3165
		3166	our @ISA = CFClient::UI::VBox::;
		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
		3183	sub reorder {
		3184	my ($self) = @_;
		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} };
		3191
		3192	while (my ($k, $v) = each %{ $self->{item} }) {
		3193	delete $self->{item}{$k} if $v->{timeout} < $NOW;
		3194	}
		3195
		3196	my @widgets;
		3197
		3198	my @items = sort {
		3199	$a->{pri} <=> $b->{pri}
		3200	or $b->{id} <=> $a->{id}
		3201	} values %{ $self->{item} };
		3202
		3203	$self->{timer}->interval (1);
		3204
		3205	my $count = 10 + 1;
		3206	for my $item (@items) {
		3207	last unless --$count;
		3208
		3209	my $label = $item->{label} ||= do {
		3210	# TODO: doesn't handle markup well (read as: at all)
		3211	my $short = $item->{count} > 1
		3212	? "<b>$item->{count} ×</b> $item->{text}"
		3213	: $item->{text};
		3214
		3215	for ($short) {
		3216	s/^\s+//;
		3217	s/\s+/ /g;
		3218	}
		3219
		3220	new CFClient::UI::Label
		3221	markup => $short,
		3222	tooltip => $item->{tooltip},
		3223	tooltip_font => $::FONT_PROP,
		3224	tooltip_width => 0.67,
		3225	fontsize => $item->{fontsize} || $self->{fontsize},
		3226	max_w => $::WIDTH * 0.44,
		3227	fg => [@{ $item->{fg} }],
		3228	can_events => 1,
		3229	can_hover => 1
		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;
		3243	}
		3244
		3245	$self->clear;
		3246	$self->SUPER::add (reverse @widgets);
		3247	}
		3248
		3249	sub add {
		3250	my ($self, $text, %arg) = @_;
		3251
		3252	$text =~ s/^\s+//;
		3253	$text =~ s/\s+$//;
		3254
		3255	return unless $text;
		3256
		3257	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
		3258
		3259	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
		3260
		3261	if (my $item = $self->{item}{$group}) {
		3262	if ($item->{text} eq $text) {
		3263	$item->{count}++;
		3264	} else {
		3265	$item->{count} = 1;
		3266	$item->{text} = $item->{tooltip} = $text;
		3267	}
		3268	$item->{id} = ++$self->{id};
		3269	$item->{timeout} = $timeout;
		3270	delete $item->{label};
		3271	} else {
		3272	$self->{item}{$group} = {
		3273	id => ++$self->{id},
		3274	text => $text,
		3275	timeout => $timeout,
		3276	tooltip => $text,
		3277	fg => [0.8, 0.8, 0.8, 0.8],
		3278	pri => 0,
		3279	count => 1,
		3280	%arg,
		3281	};
		3282	}
		3283
		3284	$self->reorder;
		3285	}
		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
		3305	#############################################################################
		3306
		3307	package CFClient::UI::Inventory;
		3308
		3309	our @ISA = CFClient::UI::ScrolledWindow::;
		3310
		3311	sub new {
		3312	my $class = shift;
		3313
		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 => [],
2394	@_,	3556	@_,
2395	)	3557	)
2396	}	3558	}
2397		3559
		3560	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3561
		3562	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3563	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3564	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3565	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3566	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3567	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3568	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3569	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3570	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3571	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3572
		3573	sub rebuild_spell_list {
		3574	my ($self) = @_;
		3575
		3576	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3577	$self->clear;
		3578
		3579	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3580	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3581	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3582	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3583	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3584
		3585	my $row = 0;
		3586
		3587	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3588	my $spell = $self->{spell}{$_};
		3589
		3590	$row++;
		3591
		3592	my $spell_cb = sub {
		3593	my ($widget, $ev) = @_;
		3594
		3595	if ($ev->{button} == 1) {
		3596	$::CONN->user_send ("cast $spell->{name}");
		3597	} elsif ($ev->{button} == 2) {
		3598	$::CONN->user_send ("invoke $spell->{name}");
		3599	} elsif ($ev->{button} == 3) {
		3600	(new CFClient::UI::Menu
		3601	items => [
		3602	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3603	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3604	],
		3605	)->popup ($ev);
		3606	} else {
		3607	return 0;
		3608	}
		3609
		3610	1
		3611	};
		3612
		3613	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3614
		3615	#TODO: add path info to tooltip
		3616	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3617
		3618	$self->add (0, $row, new CFClient::UI::Face
		3619	face => $spell->{face},
		3620	can_hover => 1,
		3621	can_events => 1,
		3622	tooltip => $tooltip,
		3623	on_button_down => $spell_cb,
		3624	);
		3625
		3626	$self->add (1, $row, new CFClient::UI::Label
		3627	expand => 1,
		3628	text => $spell->{name},
		3629	can_hover => 1,
		3630	can_events => 1,
		3631	tooltip => $tooltip,
		3632	on_button_down => $spell_cb,
		3633	);
		3634
		3635	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3636	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3637	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3638	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3639	}
		3640	});
		3641	}
		3642
		3643	sub add_spell {
		3644	my ($self, $spell) = @_;
		3645
		3646	$self->{spell}->{$spell->{name}} = $spell;
		3647	$self->rebuild_spell_list;
		3648	}
		3649
		3650	sub remove_spell {
		3651	my ($self, $spell) = @_;
		3652
		3653	delete $self->{spell}->{$spell->{name}};
		3654	$self->rebuild_spell_list;
		3655	}
		3656
		3657	#############################################################################
		3658
		3659	package CFClient::UI::Root;
		3660
		3661	our @ISA = CFClient::UI::Container::;
		3662
		3663	use List::Util qw(min max);
		3664
		3665	use CFClient::OpenGL;
		3666
		3667	sub new {
		3668	my $class = shift;
		3669
		3670	my $self = $class->SUPER::new (
		3671	visible => 1,
		3672	@_,
		3673	);
		3674
		3675	Scalar::Util::weaken ($self->{root} = $self);
		3676
		3677	$self
		3678	}
		3679
2398	sub size_request {	3680	sub size_request {
2399	(32, 8)
2400	}
2401
2402	sub draw {
2403	my ($self) = @_;	3681	my ($self) = @_;
2404		3682
2405	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$self->{face}]];	3683	($self->{w}, $self->{h})
2406
2407	if ($tex) {
2408	glEnable GL_BLEND;
2409	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
2410	glEnable GL_TEXTURE_2D;
2411	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2412	glColor 1, 1, 1, 1;
2413	$tex->draw_quad (0, 0, $self->{w}, $self->{h});
2414	glDisable GL_TEXTURE_2D;
2415	glDisable GL_BLEND;
2416	}
2417	}	3684	}
2418		3685
2419	#############################################################################	3686	sub _to_pixel {
		3687	my ($coord, $size, $max) = @_;
2420		3688
2421	package CFClient::UI::Root;	3689	$coord =
		3690	$coord eq "center" ? ($max - $size) * 0.5
		3691	: $coord eq "max" ? $max
		3692	: $coord;
2422		3693
2423	our @ISA = CFClient::UI::Container::;	3694	$coord = 0 if $coord < 0;
		3695	$coord = $max - $size if $coord > $max - $size;
2424		3696
2425	use CFClient::OpenGL;	3697	int $coord + 0.5
2426
2427	sub check_size {
2428	my ($self) = @_;
2429
2430	$self->configure (0, 0, $::WIDTH, $::HEIGHT);
2431	}	3698	}
2432		3699
2433	sub size_request {	3700	sub size_allocate {
2434	($::WIDTH, $::HEIGHT)
2435	}
2436
2437	sub configure {
2438	my ($self, $x, $y, $w, $h) = @_;	3701	my ($self, $w, $h) = @_;
2439		3702
2440	$self->SUPER::configure ($x, $y, $w, $h);
2441
2442	for my $child (@{$self->{children}}) {	3703	for my $child ($self->children) {
2443	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3704	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
2444		3705
2445	$X = List::Util::max 0, List::Util::min $w - $W, $X;	3706	$X = $child->{force_x} if exists $child->{force_x};
2446	$Y = List::Util::max 0, List::Util::min $h - $H, $Y;	3707	$Y = $child->{force_y} if exists $child->{force_y};
		3708
		3709	$X = _to_pixel $X, $W, $self->{w};
		3710	$Y = _to_pixel $Y, $H, $self->{h};
		3711
2447	$child->configure ($X, $Y, $W,$H);	3712	$child->configure ($X, $Y, $W, $H);
2448	}	3713	}
2449	}	3714	}
2450		3715
2451	sub _topleft {	3716	sub coord2local {
2452	my ($self, $x, $y) = @_;	3717	my ($self, $x, $y) = @_;
2453		3718
2454	($x, $y)	3719	($x, $y)
2455	}	3720	}
2456		3721
		3722	sub coord2global {
		3723	my ($self, $x, $y) = @_;
		3724
		3725	($x, $y)
		3726	}
		3727
2457	sub update {	3728	sub update {
2458	my ($self) = @_;	3729	my ($self) = @_;
2459		3730
2460	$self->check_size;	3731	$::WANT_REFRESH++;
2461	::refresh ();
2462	}	3732	}
2463		3733
2464	sub add {	3734	sub add {
2465	my ($self, $child) = @_;	3735	my ($self, @children) = @_;
2466		3736
2467	# integerize window positions	3737	$_->{is_toplevel} = 1
2468	$child->{x} = int $child->{x};	3738	for @children;
2469	$child->{y} = int $child->{y};
2470		3739
2471	$self->SUPER::add ($child);	3740	$self->SUPER::add (@children);
		3741	}
		3742
		3743	sub remove {
		3744	my ($self, @children) = @_;
		3745
		3746	$self->SUPER::remove (@children);
		3747
		3748	delete $self->{is_toplevel}
		3749	for @children;
		3750
		3751	while (@children) {
		3752	my $w = pop @children;
		3753	push @children, $w->children;
		3754	$w->set_invisible;
		3755	}
2472	}	3756	}
2473		3757
2474	sub on_refresh {	3758	sub on_refresh {
2475	my ($self, $id, $cb) = @_;	3759	my ($self, $id, $cb) = @_;
2476		3760
2477	$self->{refresh_hook}{$id} = $cb;	3761	$self->{refresh_hook}{$id} = $cb;
2478	}	3762	}
2479		3763
		3764	sub on_post_alloc {
		3765	my ($self, $id, $cb) = @_;
		3766
		3767	$self->{post_alloc_hook}{$id} = $cb;
		3768	}
		3769
2480	sub draw {	3770	sub draw {
2481	my ($self) = @_;	3771	my ($self) = @_;
2482		3772
2483	while (my $rcb = delete $self->{refresh_hook}) {	3773	while ($self->{refresh_hook}) {
2484	$_->() for values %$rcb;	3774	$_->()
		3775	for values %{delete $self->{refresh_hook}};
2485	}	3776	}
		3777
		3778	if ($self->{realloc}) {
		3779	my %queue;
		3780	my @queue;
		3781	my $widget;
		3782
		3783	outer:
		3784	while () {
		3785	if (my $realloc = delete $self->{realloc}) {
		3786	for $widget (values %$realloc) {
		3787	$widget->{visible} or next; # do not resize invisible widgets
		3788
		3789	$queue{$widget+0}++ and next; # duplicates are common
		3790
		3791	push @{ $queue[$widget->{visible}] }, $widget;
		3792	}
		3793	}
		3794
		3795	while () {
		3796	@queue or last outer;
		3797
		3798	$widget = pop @{ $queue[-1] || [] }
		3799	and last;
		3800
		3801	pop @queue;
		3802	}
		3803
		3804	delete $queue{$widget+0};
		3805
		3806	my ($w, $h) = $widget->size_request;
		3807
		3808	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3809	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3810
		3811	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3812	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3813
		3814	$w = $widget->{force_w} if exists $widget->{force_w};
		3815	$h = $widget->{force_h} if exists $widget->{force_h};
		3816
		3817	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3818	|| delete $widget->{force_realloc}) {
		3819	$widget->{req_w} = $w;
		3820	$widget->{req_h} = $h;
		3821
		3822	$self->{size_alloc}{$widget+0} = $widget;
		3823
		3824	if (my $parent = $widget->{parent}) {
		3825	$self->{realloc}{$parent+0} = $parent
		3826	unless $queue{$parent+0};
		3827
		3828	$parent->{force_size_alloc} = 1;
		3829	$self->{size_alloc}{$parent+0} = $parent;
		3830	}
		3831	}
		3832
		3833	delete $self->{realloc}{$widget+0};
		3834	}
		3835	}
		3836
		3837	while (my $size_alloc = delete $self->{size_alloc}) {
		3838	my @queue = sort { $b->{visible} <=> $a->{visible} }
		3839	values %$size_alloc;
		3840
		3841	while () {
		3842	my $widget = pop @queue || last;
		3843
		3844	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
		3845
		3846	$w = 0 if $w < 0;
		3847	$h = 0 if $h < 0;
		3848
		3849	$w = int $w + 0.5;
		3850	$h = int $h + 0.5;
		3851
		3852	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3853	$widget->{old_w} = $widget->{w};
		3854	$widget->{old_h} = $widget->{h};
		3855
		3856	$widget->{w} = $w;
		3857	$widget->{h} = $h;
		3858
		3859	$widget->emit (size_allocate => $w, $h);
		3860	}
		3861	}
		3862	}
		3863
		3864	while ($self->{post_alloc_hook}) {
		3865	$_->()
		3866	for values %{delete $self->{post_alloc_hook}};
		3867	}
		3868
2486		3869
2487	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3870	glViewport 0, 0, $::WIDTH, $::HEIGHT;
2488	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3871	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
2489	glClear GL_COLOR_BUFFER_BIT;	3872	glClear GL_COLOR_BUFFER_BIT;
2490		3873
2491	glMatrixMode GL_PROJECTION;	3874	glMatrixMode GL_PROJECTION;
2492	glLoadIdentity;	3875	glLoadIdentity;
2493	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000 , 10000;	3876	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
2494	glMatrixMode GL_MODELVIEW;	3877	glMatrixMode GL_MODELVIEW;
2495	glLoadIdentity;	3878	glLoadIdentity;
2496		3879
		3880	{
		3881	package CFClient::UI::Base;
		3882
		3883	($draw_x, $draw_y, $draw_w, $draw_h) =
		3884	(0, 0, $self->{w}, $self->{h});
		3885	}
		3886
2497	$self->_draw;	3887	$self->_draw;
2498	}	3888	}
2499		3889
2500	#############################################################################	3890	#############################################################################
2501		3891
2502	package CFClient::UI;	3892	package CFClient::UI;
2503		3893
2504	$ROOT = new CFClient::UI::Root;	3894	$ROOT = new CFClient::UI::Root;
2505	$TOOLTIP = new CFClient::UI::Tooltip;	3895	$TOOLTIP = new CFClient::UI::Tooltip z => 900;
2506		3896
2507	1	3897	1
2508		3898

Diff Legend

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