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.120 by elmex, Sun Apr 16 17:43:17 2006 UTC vs.
Revision 1.307 by root, Sun Jun 18 19:13:20 2006 UTC

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

Diff Legend

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