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.190 by root, Mon May 8 22:17:38 2006 UTC vs.
Revision 1.268 by root, Thu Jun 1 05:04:41 2006 UTC

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

Diff Legend

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