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.179 by elmex, Fri Apr 28 05:17:21 2006 UTC vs.
Revision 1.271 by root, Fri Jun 2 22:13:47 2006 UTC

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

Diff Legend

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