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.229 by root, Wed May 24 21:49:58 2006 UTC vs.
Revision 1.290 by root, Mon Jun 5 22:30:35 2006 UTC

…		…
3	use utf8;	3	use utf8;
4	use strict;	4	use strict;
5		5
6	use Scalar::Util ();	6	use Scalar::Util ();
7	use List::Util ();	7	use List::Util ();
		8	use Event;
8		9
9	use CFClient;	10	use CFClient;
		11	use CFClient::Texture;
10		12
11	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
12		14
		15	our $LAYOUT;
13	our $ROOT;	16	our $ROOT;
14	our $TOOLTIP;	17	our $TOOLTIP;
15	our $BUTTON_STATE;	18	our $BUTTON_STATE;
16		19
17	our %WIDGET; # all widgets, weak-referenced	20	our %WIDGET; # all widgets, weak-referenced
18		21
19	sub check_tooltip {	22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
20	if (!$GRAB) {	23	if (!$GRAB) {
21	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {	24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
22	if (length $widget->{tooltip}) {	25	if (length $widget->{tooltip}) {
23
24	if ($TOOLTIP->{owner} != $widget) {	26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->hide;
		28
25	$TOOLTIP->{owner} = $widget;	29	$TOOLTIP->{owner} = $widget;
		30
		31	return if $ENV{CFPLUS_DEBUG} & 8;
26		32
27	my $tip = $widget->{tooltip};	33	my $tip = $widget->{tooltip};
28		34
29	$tip = $tip->($widget) if CODE:: eq ref $tip;	35	$tip = $tip->($widget) if CODE:: eq ref $tip;
30		36
31	$TOOLTIP->set_tooltip_from ($widget);	37	$TOOLTIP->set_tooltip_from ($widget);
32	$TOOLTIP->show;	38	$TOOLTIP->show;
33
34	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
35
36	($x, $y) = $widget->coord2global (-$TOOLTIP->{w}, 0)
37	if $x + $TOOLTIP->{w} > $::WIDTH;
38
39	$TOOLTIP->move ($x, $y);
40	$TOOLTIP->check_size;
41	$TOOLTIP->update;
42	}	39	}
43		40
44	return;	41	return;
45	}	42	}
46	}	43	}
47	}	44	}
48		45
49	$TOOLTIP->hide;	46	$TOOLTIP->hide;
50	delete $TOOLTIP->{owner};	47	delete $TOOLTIP->{owner};
		48	});
		49
		50	sub get_layout {
		51	my $layout;
		52
		53	for (grep { $_->{name} } values %WIDGET) {
		54	my $win = $layout->{$_->{name}} = { };
		55
		56	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
		57	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
		58	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
		59	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
		60
		61	$win->{show} = $_->{visible} && $_->{is_toplevel};
		62	}
		63
		64	$layout
		65	}
		66
		67	sub set_layout {
		68	my ($layout) = @_;
		69
		70	$LAYOUT = $layout;
51	}	71	}
52		72
53	# class methods for events	73	# class methods for events
54	sub feed_sdl_key_down_event {	74	sub feed_sdl_key_down_event {
55	$FOCUS->emit (key_down => $_[0]) || $FOCUS->key_down ($_[0])	75	$FOCUS->emit (key_down => $_[0])
56	if $FOCUS;	76	if $FOCUS;
57	}	77	}
58		78
59	sub feed_sdl_key_up_event {	79	sub feed_sdl_key_up_event {
60	$FOCUS->emit (key_up => $_[0]) || $FOCUS->key_up ($_[0])	80	$FOCUS->emit (key_up => $_[0])
61	if $FOCUS;	81	if $FOCUS;
62	}	82	}
63		83
64	sub feed_sdl_button_down_event {	84	sub feed_sdl_button_down_event {
65	my ($ev) = @_;	85	my ($ev) = @_;
…		…
69	my $widget = $ROOT->find_widget ($x, $y);	89	my $widget = $ROOT->find_widget ($x, $y);
70		90
71	$GRAB = $widget;	91	$GRAB = $widget;
72	$GRAB->update if $GRAB;	92	$GRAB->update if $GRAB;
73		93
74	check_tooltip;	94	$TOOLTIP_WATCHER->cb->();
75	}	95	}
76		96
77	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
78		98
79	if ($GRAB) {	99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
80	($x, $y) = $GRAB->coord2local ($x, $y);	100	if $GRAB;
81	$GRAB->emit (button_down => $ev, $x, $y) || $GRAB->button_down ($ev, $x, $y);
82	}
83	}	101	}
84		102
85	sub feed_sdl_button_up_event {	103	sub feed_sdl_button_up_event {
86	my ($ev) = @_;	104	my ($ev) = @_;
87	my ($x, $y) = ($ev->{x}, $ev->{y});	105	my ($x, $y) = ($ev->{x}, $ev->{y});
88		106
89	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
90		108
91	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
92		110
93	if ($GRAB) {	111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))
94	($x, $y) = $GRAB->coord2local ($x, $y);	112	if $GRAB;
95	$GRAB->emit (button_up => $ev, $x, $y) || $GRAB->button_up ($ev, $x, $y);
96	}
97		113
98	if (!$BUTTON_STATE) {	114	if (!$BUTTON_STATE) {
99	my $grab = $GRAB; undef $GRAB;	115	my $grab = $GRAB; undef $GRAB;
100	$grab->update if $grab;	116	$grab->update if $grab;
101	$GRAB->update if $GRAB;	117	$GRAB->update if $GRAB;
102		118
103	check_tooltip;	119	$TOOLTIP_WATCHER->cb->();
104	}	120	}
105	}	121	}
106		122
107	sub feed_sdl_motion_event {	123	sub feed_sdl_motion_event {
108	my ($ev) = @_;	124	my ($ev) = @_;
…		…
114	my $hover = $HOVER; $HOVER = $widget;	130	my $hover = $HOVER; $HOVER = $widget;
115		131
116	$hover->update if $hover && $hover->{can_hover};	132	$hover->update if $hover && $hover->{can_hover};
117	$HOVER->update if $HOVER && $HOVER->{can_hover};	133	$HOVER->update if $HOVER && $HOVER->{can_hover};
118		134
119	check_tooltip;	135	$TOOLTIP_WATCHER->start;
120	}	136	}
121		137
122	if ($HOVER) {
123	($x, $y) = $HOVER->coord2local ($x, $y);
124	$HOVER->emit (mouse_motion => $ev, $x, $y) || $HOVER->mouse_motion ($ev, $x, $y);	138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
125	}	139	if $HOVER;
126	}	140	}
127		141
128	# convert position array to integers	142	# convert position array to integers
129	sub harmonize {	143	sub harmonize {
130	my ($vals) = @_;	144	my ($vals) = @_;
…		…
144		158
145	$_->update	159	$_->update
146	for @widgets;	160	for @widgets;
147	}	161	}
148		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
149	# call when resolution changes etc.	171	# call when resolution changes etc.
150	sub rescale_widgets {	172	sub rescale_widgets {
151	my ($sx, $sy) = @_;	173	my ($sx, $sy) = @_;
152		174
153	# make a copy, otherwise for complains about freed values.
154	my @widgets = values %WIDGET;	175	for my $widget (values %WIDGET) {
155
156	for my $widget (@widgets) {
157	if ($widget->{toplevel}) {	176	if ($widget->{is_toplevel}) {
		177	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		178	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		179
158	$widget->{x} = int 0.5 + $widget->{x} * $sx if exists $widget->{x};	180	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
159	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};	181	$widget->{w} = int 0.5 + $widget->{w} * $sx if exists $widget->{w};
160	$widget->{req_w} = int 0.5 + $widget->{req_w} * $sx if exists $widget->{req_w};	182	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
161	$widget->{user_w} = int 0.5 + $widget->{user_w} * $sx if exists $widget->{user_w};
162	$widget->{y} = int 0.5 + $widget->{y} * $sy if exists $widget->{y};	183	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
163	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};	184	$widget->{h} = int 0.5 + $widget->{h} * $sy if exists $widget->{h};
164	$widget->{req_h} = int 0.5 + $widget->{req_h} * $sy if exists $widget->{req_h};	185	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
165	$widget->{user_h} = int 0.5 + $widget->{user_h} * $sy if exists $widget->{user_h};	186
		187	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
		188	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
		189
166	}	190	}
167
168	$widget->reconfigure;
169	}	191	}
		192
		193	reconfigure_widgets;
170	}	194	}
171		195
172	#############################################################################	196	#############################################################################
173		197
174	package CFClient::UI::Base;	198	package CFClient::UI::Base;
…		…
179		203
180	sub new {	204	sub new {
181	my $class = shift;	205	my $class = shift;
182		206
183	my $self = bless {	207	my $self = bless {
184	x => 0,	208	x => "center",
185	y => 0,	209	y => "center",
186	z => 0,	210	z => 0,
		211	w => undef,
		212	h => undef,
187	can_events => 1,	213	can_events => 1,
188	@_	214	@_
189	}, $class;	215	}, $class;
190		216
		217	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
		218
191	for (keys %$self) {	219	for (keys %$self) {
192	if (/^connect_(.*)$/) {	220	if (/^on_(.*)$/) {
193	$self->connect ($1 => delete $self->{$_});	221	$self->connect ($1 => delete $self->{$_});
194	}	222	}
195	}	223	}
196		224
197	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	225	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		226	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		227	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		228	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		229	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		230
		231	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		232	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		233
		234	$self->show if $layout->{show};
		235	}
198		236
199	$self	237	$self
200	}	238	}
201		239
202	sub destroy {	240	sub destroy {
…		…
206	%$self = ();	244	%$self = ();
207	}	245	}
208		246
209	sub show {	247	sub show {
210	my ($self) = @_;	248	my ($self) = @_;
		249
211	return if $self->{parent};	250	return if $self->{parent};
212		251
213	$CFClient::UI::ROOT->add ($self);	252	$CFClient::UI::ROOT->add ($self);
214	}	253	}
215		254
216	sub show_centered {	255	sub set_visible {
217	my ($self) = @_;	256	my ($self) = @_;
		257
218	return if $self->{parent};	258	return if $self->{visible};
219		259
220	$self->show;	260	$self->{root} = $self->{parent}{root};
		261	$self->{visible} = $self->{parent}{visible} + 1;
221		262
222	$CFClient::UI::ROOT->on_post_alloc (	263	$self->emit (visibility_change => 1);
223	"centered $self" => sub {
224	$self->move (($::WIDTH - $self->{w}) * 0.5, ($::HEIGHT - $self->{h}) * 0.5);
225	},
226	);
227	}
228		264
229	sub hide {	265	$self->realloc if !exists $self->{req_w};
		266
		267	$_->set_visible for $self->children;
		268	}
		269
		270	sub set_invisible {
230	my ($self) = @_;	271	my ($self) = @_;
		272
		273	return unless $self->{visible};
		274
		275	$_->set_invisible for $self->children;
		276
		277	delete $self->{root};
		278	delete $self->{visible};
231		279
232	undef $GRAB if $GRAB == $self;	280	undef $GRAB if $GRAB == $self;
233	undef $HOVER if $HOVER == $self;	281	undef $HOVER if $HOVER == $self;
234		282
		283	$CFClient::UI::TOOLTIP_WATCHER->cb->()
		284	if $TOOLTIP->{owner} == $self;
		285
		286	$self->focus_out;
		287
		288	$self->emit (visibility_change => 0);
		289	}
		290
		291	sub set_visibility {
		292	my ($self, $visible) = @_;
		293
		294	return if $self->{visible} == $visible;
		295
		296	$visible ? $self->hide
		297	: $self->show;
		298	}
		299
		300	sub toggle_visibility {
		301	my ($self) = @_;
		302
		303	$self->{visible}
		304	? $self->hide
		305	: $self->show;
		306	}
		307
		308	sub hide {
		309	my ($self) = @_;
		310
		311	$self->set_invisible;
		312
235	$self->{parent}->remove ($self)	313	$self->{parent}->remove ($self)
236	if $self->{parent};	314	if $self->{parent};
237	}	315	}
238		316
239	sub move {	317	sub move_abs {
240	my ($self, $x, $y, $z) = @_;	318	my ($self, $x, $y, $z) = @_;
241		319
242	$self->{x} = int $x;	320	$self->{x} = List::Util::max 0, int $x;
243	$self->{y} = int $y;	321	$self->{y} = List::Util::max 0, int $y;
244	$self->{z} = $z if defined $z;	322	$self->{z} = $z if defined $z;
245		323
246	$self->update;	324	$self->update;
247	}	325	}
248		326
249	sub set_size {	327	sub set_size {
250	my ($self, $w, $h) = @_;	328	my ($self, $w, $h) = @_;
251		329
252	$self->{user_w} = $w;	330	$self->{force_w} = $w;
253	$self->{user_h} = $h;	331	$self->{force_h} = $h;
254		332
255	$self->check_size;	333	$self->realloc;
256	}	334	}
257		335
258	sub size_request {	336	sub size_request {
259	require Carp;	337	require Carp;
260	Carp::confess "size_request is abstract";	338	Carp::confess "size_request is abstract";
…		…
262		340
263	sub configure {	341	sub configure {
264	my ($self, $x, $y, $w, $h) = @_;	342	my ($self, $x, $y, $w, $h) = @_;
265		343
266	if ($self->{aspect}) {	344	if ($self->{aspect}) {
		345	my ($ow, $oh) = ($w, $h);
		346
267	my $w2 = List::Util::min $w, int $h * $self->{aspect};	347	$w = List::Util::min $w, int $h * $self->{aspect};
268	my $h2 = List::Util::min $h, int $w / $self->{aspect};	348	$h = List::Util::min $h, int $w / $self->{aspect};
269		349
270	# use alignment to adjust x, y	350	# use alignment to adjust x, y
271		351
272	$x += int +($w - $w2) * 0.5;	352	$x += int 0.5 * ($ow - $w);
273	$y += int +($h - $h2) * 0.5;	353	$y += int 0.5 * ($oh - $h);
274
275	($w, $h) = ($w2, $h2);
276	}	354	}
277		355
278	if ($self->{x} != $x || $self->{y} != $y) {	356	if ($self->{x} ne $x || $self->{y} ne $y) {
279	$self->{x} = $x;	357	$self->{x} = $x;
280	$self->{y} = $y;	358	$self->{y} = $y;
281	$self->update;	359	$self->update;
282	}	360	}
283		361
284	if ($self->{w} != $w || $self->{h} != $h) {	362	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
285	$CFClient::UI::ROOT->{size_alloc}{$self} = [$self, $w, $h];	363	return unless $self->{visible};
		364
		365	$self->{alloc_w} = $w;
		366	$self->{alloc_h} = $h;
		367
		368	$self->{root}{size_alloc}{$self+0} = $self;
286	}	369	}
287	}	370	}
288		371
289	sub size_allocate {	372	sub size_allocate {
290	# nothing to be done	373	# nothing to be done
291	}	374	}
292		375
293	sub reconfigure {
294	my ($self) = @_;
295
296	$self->check_size (1);
297	$self->update;
298	}
299
300	sub children {	376	sub children {
		377	# nop
		378	}
		379
		380	sub visible_children {
		381	$_[0]->children
301	}	382	}
302		383
303	sub set_max_size {	384	sub set_max_size {
304	my ($self, $w, $h) = @_;	385	my ($self, $w, $h) = @_;
305		386
306	delete $self->{max_w}; $self->{max_w} = $w if $w;	387	$self->{max_w} = int $w if defined $w;
307	delete $self->{max_h}; $self->{max_h} = $h if $h;	388	$self->{max_h} = int $h if defined $h;
		389
		390	$self->realloc;
308	}	391	}
309		392
310	sub set_tooltip {	393	sub set_tooltip {
311	my ($self, $tooltip) = @_;	394	my ($self, $tooltip) = @_;
312		395
		396	$tooltip =~ s/^\s+//;
		397	$tooltip =~ s/\s+$//;
		398
		399	return if $self->{tooltip} eq $tooltip;
		400
313	$self->{tooltip} = $tooltip;	401	$self->{tooltip} = $tooltip;
314		402
315	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	403	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
316	delete $CFClient::UI::TOOLTIP->{owner};	404	delete $CFClient::UI::TOOLTIP->{owner};
317	CFClient::UI::check_tooltip;	405	$CFClient::UI::TOOLTIP_WATCHER->cb->();
318	}	406	}
319	}	407	}
320		408
321	# translate global coordinates to local coordinate system	409	# translate global coordinates to local coordinate system
322	sub coord2local {	410	sub coord2local {
…		…
338	return if $FOCUS == $self;	426	return if $FOCUS == $self;
339	return unless $self->{can_focus};	427	return unless $self->{can_focus};
340		428
341	my $focus = $FOCUS; $FOCUS = $self;	429	my $focus = $FOCUS; $FOCUS = $self;
342		430
343	$self->emit (focus_in => $focus);	431	$self->_emit (focus_in => $focus);
344		432
345	$focus->update if $focus;	433	$focus->update if $focus;
346	$FOCUS->update;	434	$FOCUS->update;
347	}	435	}
348		436
…		…
351		439
352	return unless $FOCUS == $self;	440	return unless $FOCUS == $self;
353		441
354	my $focus = $FOCUS; undef $FOCUS;	442	my $focus = $FOCUS; undef $FOCUS;
355		443
356	$self->emit (focus_out => $focus);	444	$self->_emit (focus_out => $focus);
357		445
358	$focus->update if $focus; #?	446	$focus->update if $focus; #?
359	}
360		447
		448	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus
		449	unless $FOCUS;
		450	}
		451
361	sub mouse_motion { }	452	sub mouse_motion { 0 }
362	sub button_up { }	453	sub button_up { 0 }
363	sub key_down { }	454	sub key_down { 0 }
364	sub key_up { }	455	sub key_up { 0 }
365		456
366	sub button_down {	457	sub button_down {
367	my ($self, $ev, $x, $y) = @_;	458	my ($self, $ev, $x, $y) = @_;
368		459
369	$self->focus_in;	460	$self->focus_in;
370	}
371		461
372	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	462	0
373	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	463	}
374	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	464
375	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	465	sub find_widget {
376	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	466	my ($self, $x, $y) = @_;
		467
		468	return () unless $self->{can_events};
		469
		470	return $self
		471	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
		472	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
		473
		474	()
		475	}
		476
		477	sub set_parent {
		478	my ($self, $parent) = @_;
		479
		480	Scalar::Util::weaken ($self->{parent} = $parent);
		481	$self->set_visible if $parent->{visible};
		482	}
		483
		484	sub connect {
		485	my ($self, $signal, $cb) = @_;
		486
		487	push @{ $self->{signal_cb}{$signal} }, $cb;
		488	}
		489
		490	sub _emit {
		491	my ($self, $signal, @args) = @_;
		492
		493	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
		494	}
		495
		496	sub emit {
		497	my ($self, $signal, @args) = @_;
		498
		499	$self->_emit ($signal, @args)
		500	|| $self->$signal (@args);
		501	}
		502
		503	sub visibility_change {
		504	#my ($self, $visible) = @_;
		505	}
		506
		507	sub realloc {
		508	my ($self) = @_;
		509
		510	if ($self->{visible}) {
		511	return if $self->{root}{realloc}{$self+0};
		512
		513	$self->{root}{realloc}{$self+0} = $self;
		514	$self->{root}->update;
		515	} else {
		516	delete $self->{req_w};
		517	delete $self->{req_h};
		518	}
		519	}
		520
		521	sub update {
		522	my ($self) = @_;
		523
		524	$self->{parent}->update
		525	if $self->{parent};
		526	}
		527
		528	sub reconfigure {
		529	my ($self) = @_;
		530
		531	$self->realloc;
		532	$self->update;
		533	}
		534
		535	# using global variables seems a bit hacky, but passing through all drawing
		536	# functions seems pointless.
		537	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
377		538
378	sub draw {	539	sub draw {
379	my ($self) = @_;	540	my ($self) = @_;
380		541
381	return unless $self->{h} && $self->{w};	542	return unless $self->{h} && $self->{w};
		543
		544	# update screen rectangle
		545	local $draw_x = $draw_x + $self->{x};
		546	local $draw_y = $draw_y + $self->{y};
		547	local $draw_w = $draw_x + $self->{w};
		548	local $draw_h = $draw_y + $self->{h};
		549
		550	# skip widgets that are entirely outside the drawing area
		551	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		552	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
382		553
383	glPushMatrix;	554	glPushMatrix;
384	glTranslate $self->{x}, $self->{y}, 0;	555	glTranslate $self->{x}, $self->{y}, 0;
385	$self->_draw;
386	glPopMatrix;
387		556
388	if ($self == $HOVER && $self->{can_hover}) {	557	if ($self == $HOVER && $self->{can_hover}) {
389	my ($x, $y) = @$self{qw(x y)};
390
391	glColor 1, 0.8, 0.5, 0.2;	558	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
392	glEnable GL_BLEND;	559	glEnable GL_BLEND;
393	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	560	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
394	glBegin GL_QUADS;	561	glBegin GL_QUADS;
395	glVertex $x , $y;
396	glVertex $x + $self->{w}, $y;
397	glVertex $x + $self->{w}, $y + $self->{h};
398	glVertex $x , $y + $self->{h};
399	glEnd;
400	glDisable GL_BLEND;
401	}
402
403	if ($ENV{PCLIENT_DEBUG}) {
404	glPushMatrix;
405	glColor 1, 1, 0, 1;
406	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;
407	glBegin GL_LINE_LOOP;
408	glVertex 0 , 0;	562	glVertex 0 , 0;
409	glVertex $self->{w}, 0;	563	glVertex $self->{w}, 0;
410	glVertex $self->{w}, $self->{h};	564	glVertex $self->{w}, $self->{h};
411	glVertex 0 , $self->{h};	565	glVertex 0 , $self->{h};
412	glEnd;	566	glEnd;
		567	glDisable GL_BLEND;
		568	}
		569
		570	if ($ENV{CFPLUS_DEBUG} & 1) {
		571	glPushMatrix;
		572	glColor 1, 1, 0, 1;
		573	glTranslate 0.375, 0.375;
		574	glBegin GL_LINE_LOOP;
		575	glVertex 0 , 0;
		576	glVertex $self->{w} - 1, 0;
		577	glVertex $self->{w} - 1, $self->{h} - 1;
		578	glVertex 0 , $self->{h} - 1;
		579	glEnd;
413	glPopMatrix;	580	glPopMatrix;
414	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	581	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
415	}	582	}
		583
		584	$self->_draw;
		585	glPopMatrix;
416	}	586	}
417		587
418	sub _draw {	588	sub _draw {
419	my ($self) = @_;	589	my ($self) = @_;
420		590
421	warn "no draw defined for $self\n";	591	warn "no draw defined for $self\n";
422	}
423
424	sub find_widget {
425	my ($self, $x, $y) = @_;
426
427	return () unless $self->{can_events};
428
429	return $self
430	if $x >= $self->{x} && $x < $self->{x} + $self->{w}
431	&& $y >= $self->{y} && $y < $self->{y} + $self->{h};
432
433	()
434	}
435
436	sub set_parent {
437	my ($self, $parent) = @_;
438
439	Scalar::Util::weaken ($self->{parent} = $parent);
440
441	# TODO: req_w _does_change after ->reconfigure
442	$self->check_size
443	unless exists $self->{req_w};
444
445	$self->show;
446	}
447
448	sub check_size {
449	my ($self, $forced) = @_;
450
451	$self->{force_alloc} = 1 if $forced;
452	$CFClient::UI::ROOT->{check_size}{$self} = $self;
453	}
454
455	sub update {
456	my ($self) = @_;
457
458	$self->{parent}->update
459	if $self->{parent};
460	}
461
462	sub connect {
463	my ($self, $signal, $cb) = @_;
464
465	push @{ $self->{signal_cb}{$signal} }, $cb;
466	}
467
468	sub emit {
469	my ($self, $signal, @args) = @_;
470
471	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
472	}	592	}
473		593
474	sub DESTROY {	594	sub DESTROY {
475	my ($self) = @_;	595	my ($self) = @_;
476		596
…		…
508		628
509	if ($color && (@$color < 4 || $color->[3])) {	629	if ($color && (@$color < 4 || $color->[3])) {
510	my ($w, $h) = @$self{qw(w h)};	630	my ($w, $h) = @$self{qw(w h)};
511		631
512	glEnable GL_BLEND;	632	glEnable GL_BLEND;
513	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	633	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
514	glColor @$color;	634	glColor_premultiply @$color;
515		635
516	glBegin GL_QUADS;	636	glBegin GL_QUADS;
517	glVertex 0 , 0;	637	glVertex 0 , 0;
518	glVertex 0 , $h;	638	glVertex 0 , $h;
519	glVertex $w, $h;	639	glVertex $w, $h;
…		…
534	my ($class, %arg) = @_;	654	my ($class, %arg) = @_;
535	$class->SUPER::new (can_events => 0, %arg);	655	$class->SUPER::new (can_events => 0, %arg);
536	}	656	}
537		657
538	sub size_request {	658	sub size_request {
539	(0, 0)	659	my ($self) = @_;
		660
		661	($self->{w} + 0, $self->{h} + 0)
540	}	662	}
541		663
542	sub draw { }	664	sub draw { }
543		665
544	#############################################################################	666	#############################################################################
…		…
548	our @ISA = CFClient::UI::Base::;	670	our @ISA = CFClient::UI::Base::;
549		671
550	sub new {	672	sub new {
551	my ($class, %arg) = @_;	673	my ($class, %arg) = @_;
552		674
553	my $children = delete $arg{children} || [];	675	my $children = delete $arg{children};
554		676
555	my $self = $class->SUPER::new (	677	my $self = $class->SUPER::new (
556	children => [],	678	children => [],
557	can_events => 0,	679	can_events => 0,
558	%arg,	680	%arg,
559	);	681	);
		682
560	$self->add ($_) for @$children;	683	$self->add (@$children)
		684	if $children;
561		685
562	$self	686	$self
563	}	687	}
564		688
565	sub add {	689	sub add {
…		…
573	$self->{children} = [	697	$self->{children} = [
574	sort { $a->{z} <=> $b->{z} }	698	sort { $a->{z} <=> $b->{z} }
575	@{$self->{children}}, @widgets	699	@{$self->{children}}, @widgets
576	];	700	];
577		701
578	$self->check_size (1);	702	$self->realloc;
579	$self->update;
580	}	703	}
581		704
582	sub children {	705	sub children {
583	@{ $_[0]{children} }	706	@{ $_[0]{children} }
584	}	707	}
…		…
589	delete $child->{parent};	712	delete $child->{parent};
590	$child->hide;	713	$child->hide;
591		714
592	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];	715	$self->{children} = [ grep $_ != $child, @{ $self->{children} } ];
593		716
594	$self->check_size;	717	$self->realloc;
595	$self->update;
596	}	718	}
597		719
598	sub clear {	720	sub clear {
599	my ($self) = @_;	721	my ($self) = @_;
600		722
…		…
604	for (@$children) {	726	for (@$children) {
605	delete $_->{parent};	727	delete $_->{parent};
606	$_->hide;	728	$_->hide;
607	}	729	}
608		730
609	$self->check_size;	731	$self->realloc;
610	$self->update;
611	}	732	}
612		733
613	sub find_widget {	734	sub find_widget {
614	my ($self, $x, $y) = @_;	735	my ($self, $x, $y) = @_;
615		736
616	$x -= $self->{x};	737	$x -= $self->{x};
617	$y -= $self->{y};	738	$y -= $self->{y};
618		739
619	my $res;	740	my $res;
620		741
621	for (reverse @{ $self->{children} }) {	742	for (reverse $self->visible_children) {
622	$res = $_->find_widget ($x, $y)	743	$res = $_->find_widget ($x, $y)
623	and return $res;	744	and return $res;
624	}	745	}
625		746
626	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	747	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
675	$self->{children}[0]->configure (0, 0, $w, $h);	796	$self->{children}[0]->configure (0, 0, $w, $h);
676	}	797	}
677		798
678	#############################################################################	799	#############################################################################
679		800
		801	# back-buffered drawing area
		802
680	package CFClient::UI::Window;	803	package CFClient::UI::Window;
681		804
682	our @ISA = CFClient::UI::Bin::;	805	our @ISA = CFClient::UI::Bin::;
683		806
684	use CFClient::OpenGL;	807	use CFClient::OpenGL;
…		…
702	$self->SUPER::size_allocate ($w, $h);	825	$self->SUPER::size_allocate ($w, $h);
703	$self->update;	826	$self->update;
704	}	827	}
705		828
706	sub _render {	829	sub _render {
		830	my ($self) = @_;
		831
707	$_[0]{children}[0]->draw;	832	$self->{children}[0]->draw;
708	}	833	}
709		834
710	sub render_child {	835	sub render_child {
711	my ($self) = @_;	836	my ($self) = @_;
712		837
713	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	838	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
714	glClearColor 0, 0, 0, 0;	839	glClearColor 0, 0, 0, 0;
715	glClear GL_COLOR_BUFFER_BIT;	840	glClear GL_COLOR_BUFFER_BIT;
716		841
		842	{
		843	package CFClient::UI::Base;
		844
		845	($draw_x, $draw_y, $draw_w, $draw_h) =
		846	(0, 0, $self->{w}, $self->{h});
		847	}
		848
717	$self->_render;	849	$self->_render;
718	};	850	};
719	}	851	}
720		852
721	sub _draw {	853	sub _draw {
722	my ($self) = @_;	854	my ($self) = @_;
723		855
724	my ($w, $h) = ($self->w, $self->h);	856	my ($w, $h) = @$self{qw(w h)};
725		857
726	my $tex = $self->{texture}	858	my $tex = $self->{texture}
727	or return;	859	or return;
728		860
729	glEnable GL_TEXTURE_2D;	861	glEnable GL_TEXTURE_2D;
730	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	862	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
731	glColor 1, 1, 1, 1;	863	glColor 0, 0, 0, 1;
732		864
733	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	865	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
734		866
735	glDisable GL_TEXTURE_2D;	867	glDisable GL_TEXTURE_2D;
736	}	868	}
…		…
739		871
740	package CFClient::UI::ViewPort;	872	package CFClient::UI::ViewPort;
741		873
742	our @ISA = CFClient::UI::Window::;	874	our @ISA = CFClient::UI::Window::;
743		875
		876	sub new {
		877	my $class = shift;
		878
		879	$class->SUPER::new (
		880	scroll_x => 0,
		881	scroll_y => 1,
		882	@_,
		883	)
		884	}
		885
744	sub size_request {	886	sub size_request {
745	my ($self) = @_;	887	my ($self) = @_;
746		888
747	@$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	889	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
748		890
749	@$self{qw(child_w child_h)}	891	$w = 10 if $self->{scroll_x};
		892	$h = 10 if $self->{scroll_y};
		893
		894	($w, $h)
750	}	895	}
751		896
752	sub size_allocate {	897	sub size_allocate {
753	my ($self, $w, $h) = @_;	898	my ($self, $w, $h) = @_;
754		899
755	my ($cw, $ch) = @$self{qw(child_w child_h)};	900	my $child = $self->child;
756	# $w = $self->{w};	901
		902	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
		903	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
		904
757	$self->child->configure (0, 0, $cw, $ch);	905	$self->child->configure (0, 0, $w, $h);
758	$self->update;	906	$self->update;
759	}	907	}
760		908
761	sub set_offset {	909	sub set_offset {
762	my ($self, $x, $y) = @_;	910	my ($self, $x, $y) = @_;
…		…
796	}	944	}
797		945
798	sub _render {	946	sub _render {
799	my ($self) = @_;	947	my ($self) = @_;
800		948
		949	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		950	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		951
801	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	952	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
802		953
803	$self->SUPER::_render;	954	$self->SUPER::_render;
804	}	955	}
805		956
…		…
808	package CFClient::UI::ScrolledWindow;	959	package CFClient::UI::ScrolledWindow;
809		960
810	our @ISA = CFClient::UI::HBox::;	961	our @ISA = CFClient::UI::HBox::;
811		962
812	sub new {	963	sub new {
813	my $class = shift;	964	my ($class, %arg) = @_;
		965
		966	my $child = delete $arg{child};
814		967
815	my $self;	968	my $self;
816		969
817	my $slider = new CFClient::UI::Slider	970	my $slider = new CFClient::UI::Slider
818	vertical => 1,	971	vertical => 1,
819	range => [0, 0, 1, 0.01], # HACK fix	972	range => [0, 0, 1, 0.01], # HACK fix
820	connect_changed => sub {	973	on_changed => sub {
821	$self->{vp}->set_offset (0, $_[1]);	974	$self->{vp}->set_offset (0, $_[1]);
822	},	975	},
823	;	976	;
824		977
825	$self = $class->SUPER::new (	978	$self = $class->SUPER::new (
826	vp => (new CFClient::UI::ViewPort expand => 1),	979	vp => (new CFClient::UI::ViewPort expand => 1),
827	slider => $slider,	980	slider => $slider,
828	@_,	981	%arg,
829	);	982	);
830		983
831	$self->{vp}->add ($self->{scrolled});
832	$self->add ($self->{vp});
833	$self->add ($self->{slider});	984	$self->SUPER::add ($self->{vp}, $self->{slider});
		985	$self->add ($child) if $child;
834		986
835	$self	987	$self
		988	}
		989
		990	sub add {
		991	my ($self, $widget) = @_;
		992
		993	$self->{vp}->add ($self->{child} = $widget);
		994	}
		995
		996	sub update {
		997	my ($self) = @_;
		998
		999	$self->SUPER::update;
		1000
		1001	# todo: overwrite size_allocate of child
		1002	my $child = $self->{vp}->child;
		1003	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
836	}	1004	}
837		1005
838	sub size_allocate {	1006	sub size_allocate {
839	my ($self, $w, $h) = @_;	1007	my ($self, $w, $h) = @_;
840		1008
…		…
869		1037
870	if ($self->{bg}) {	1038	if ($self->{bg}) {
871	my ($w, $h) = @$self{qw(w h)};	1039	my ($w, $h) = @$self{qw(w h)};
872		1040
873	glEnable GL_BLEND;	1041	glEnable GL_BLEND;
874	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1042	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
875	glColor @{ $self->{bg} };	1043	glColor_premultiply @{ $self->{bg} };
876		1044
877	glBegin GL_QUADS;	1045	glBegin GL_QUADS;
878	glVertex 0 , 0;	1046	glVertex 0 , 0;
879	glVertex 0 , $h;	1047	glVertex 0 , $h;
880	glVertex $w, $h;	1048	glVertex $w, $h;
…		…
893		1061
894	our @ISA = CFClient::UI::Bin::;	1062	our @ISA = CFClient::UI::Bin::;
895		1063
896	use CFClient::OpenGL;	1064	use CFClient::OpenGL;
897		1065
898	my @tex =	1066	my $bg =
		1067	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",
		1068	mipmap => 1, wrap => 1;
		1069
		1070	my @border =
899	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1071	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
900	qw(d1_bg.png d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1072	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
901		1073
902	sub new {	1074	sub new {
903	my $class = shift;	1075	my ($class, %arg) = @_;
904		1076
905	# TODO: user_x, user_y, overwrite moveto?	1077	my $title = delete $arg{title};
906		1078
907	my $self = $class->SUPER::new (	1079	my $self = $class->SUPER::new (
908	bg => [1, 1, 1, 1],	1080	bg => [1, 1, 1, 1],
909	border_bg => [1, 1, 1, 1],	1081	border_bg => [1, 1, 1, 1],
910	border => 0.6,	1082	border => 0.6,
911	toplevel => 1,
912	can_events => 1,	1083	can_events => 1,
913	@_	1084	min_w => 16,
		1085	min_h => 16,
		1086	%arg,
914	);	1087	);
915		1088
916	$self->{title} &&= new CFClient::UI::Label	1089	$self->{title} = new CFClient::UI::Label
917	align => 0,	1090	align => 0,
918	valign => 1,	1091	valign => 1,
919	text => $self->{title},	1092	text => $title,
920	fontsize => $self->{border};	1093	fontsize => $self->{border}
		1094	if defined $title;
921		1095
922	$self	1096	$self
		1097	}
		1098
		1099	sub add {
		1100	my ($self, @widgets) = @_;
		1101
		1102	$self->SUPER::add (@widgets);
		1103	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};
923	}	1104	}
924		1105
925	sub border {	1106	sub border {
926	int $_[0]{border} * $::FONTSIZE	1107	int $_[0]{border} * $::FONTSIZE
927	}	1108	}
928		1109
929	sub size_request {	1110	sub size_request {
930	my ($self) = @_;	1111	my ($self) = @_;
		1112
		1113	$self->{title}->size_request
		1114	if $self->{title};
931		1115
932	my ($w, $h) = $self->SUPER::size_request;	1116	my ($w, $h) = $self->SUPER::size_request;
933		1117
934	(	1118	(
935	$w + $self->border * 2,	1119	$w + $self->border * 2,
…		…
938	}	1122	}
939		1123
940	sub size_allocate {	1124	sub size_allocate {
941	my ($self, $w, $h) = @_;	1125	my ($self, $w, $h) = @_;
942		1126
		1127	if ($self->{title}) {
		1128	$self->{title}{w} = $w;
		1129	$self->{title}{h} = $h;
		1130	$self->{title}->size_allocate ($w, $h);
		1131	}
		1132
		1133	my $border = $self->border;
		1134
943	$h -= List::Util::max 0, $self->border * 2;	1135	$h -= List::Util::max 0, $border * 2;
944	$w -= List::Util::max 0, $self->border * 2;	1136	$w -= List::Util::max 0, $border * 2;
945		1137
946	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
947	if $self->{title};
948
949	$self->child->configure ($self->border, $self->border, $w, $h);	1138	$self->child->configure ($border, $border, $w, $h);
950	}	1139	}
951		1140
952	sub button_down {	1141	sub button_down {
953	my ($self, $ev, $x, $y) = @_;	1142	my ($self, $ev, $x, $y) = @_;
954		1143
…		…
970	my ($ev, $x, $y) = @_;	1159	my ($ev, $x, $y) = @_;
971		1160
972	my $dx = $ev->{x} - $ox;	1161	my $dx = $ev->{x} - $ox;
973	my $dy = $ev->{y} - $oy;	1162	my $dy = $ev->{y} - $oy;
974		1163
975	$self->{user_w} = $bw + $dx * ($mx ? -1 : 1);	1164	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
976	$self->{user_h} = $bh + $dy * ($my ? -1 : 1);	1165	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
		1166
977	$self->move ($wx + $dx * $mx, $wy + $dy * $my);	1167	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
978	$self->check_size;	1168	$self->realloc;
979	};	1169	};
980		1170
981	} elsif ($lr ^ $td) {	1171	} elsif ($lr ^ $td) {
982	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1172	my ($ox, $oy) = ($ev->{x}, $ev->{y});
983	my ($bx, $by) = ($self->{x}, $self->{y});	1173	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
985	$self->{motion} = sub {	1175	$self->{motion} = sub {
986	my ($ev, $x, $y) = @_;	1176	my ($ev, $x, $y) = @_;
987		1177
988	($x, $y) = ($ev->{x}, $ev->{y});	1178	($x, $y) = ($ev->{x}, $ev->{y});
989		1179
990	$self->move ($bx + $x - $ox, $by + $y - $oy);	1180	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
991	$self->update;	1181	# HACK: the next line is required to enforce placement
		1182	$self->{parent}->size_allocate ($self->{parent}{w}, $self->{parent}{h});
992	};	1183	};
		1184	} else {
		1185	return 0;
		1186	}
		1187
993	}	1188	1
994	}	1189	}
995		1190
996	sub button_up {	1191	sub button_up {
997	my ($self, $ev, $x, $y) = @_;	1192	my ($self, $ev, $x, $y) = @_;
998		1193
999	delete $self->{motion};	1194	!!delete $self->{motion}
1000	}	1195	}
1001		1196
1002	sub mouse_motion {	1197	sub mouse_motion {
1003	my ($self, $ev, $x, $y) = @_;	1198	my ($self, $ev, $x, $y) = @_;
1004		1199
1005	$self->{motion}->($ev, $x, $y) if $self->{motion};	1200	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1201
		1202	!!$self->{motion}
1006	}	1203	}
1007		1204
1008	sub _draw {	1205	sub _draw {
1009	my ($self) = @_;	1206	my ($self) = @_;
1010		1207
		1208	my $child = $self->{children}[0];
		1209
1011	my ($w, $h ) = ($self->{w}, $self->{h});	1210	my ($w, $h ) = ($self->{w}, $self->{h});
1012	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1211	my ($cw, $ch) = ($child->{w}, $child->{h});
1013		1212
1014	glEnable GL_TEXTURE_2D;	1213	glEnable GL_TEXTURE_2D;
1015	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1214	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1016		1215
1017	my $border = $self->border;	1216	my $border = $self->border;
1018		1217
1019	glColor @{ $self->{border_bg} };	1218	glColor @{ $self->{border_bg} };
1020	$tex[1]->draw_quad_alpha (0, 0, $w, $border);	1219	$border[0]->draw_quad_alpha (0, 0, $w, $border);
1021	$tex[3]->draw_quad_alpha (0, $border, $border, $ch);	1220	$border[1]->draw_quad_alpha (0, $border, $border, $ch);
1022	$tex[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1221	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1023	$tex[4]->draw_quad_alpha (0, $h - $border, $w, $border);	1222	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);
1024		1223
1025	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1224	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1026	my $bg = $tex[0];	1225	glColor @{ $self->{bg} };
1027		1226
1028	# TODO: repeat texture not scale	1227	# TODO: repeat texture not scale
		1228	# solve this better(?)
1029	my $rep_x = $cw / $bg->{w};	1229	$bg->{s} = $cw / $bg->{w};
1030	my $rep_y = $ch / $bg->{h};	1230	$bg->{t} = $ch / $bg->{h};
1031
1032	glColor @{ $self->{bg} };
1033
1034	$bg->{s} = $rep_x;
1035	$bg->{t} = $rep_y;
1036	$bg->{wrap_mode} = 1;
1037	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1231	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1038	}	1232	}
1039		1233
1040	glDisable GL_TEXTURE_2D;	1234	glDisable GL_TEXTURE_2D;
1041		1235
1042	$self->{title}->draw if $self->{title};
1043
1044	$self->child->draw;	1236	$child->draw;
		1237
		1238	if ($self->{title}) {
		1239	glTranslate 0, $border - $self->{h};
		1240	$self->{title}->_draw;
		1241	}
1045	}	1242	}
1046		1243
1047	#############################################################################	1244	#############################################################################
1048		1245
1049	package CFClient::UI::Table;	1246	package CFClient::UI::Table;
…		…
1057	sub new {	1254	sub new {
1058	my $class = shift;	1255	my $class = shift;
1059		1256
1060	$class->SUPER::new (	1257	$class->SUPER::new (
1061	col_expand => [],	1258	col_expand => [],
1062	@_	1259	@_,
1063	)	1260	)
		1261	}
		1262
		1263	sub children {
		1264	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1064	}	1265	}
1065		1266
1066	sub add {	1267	sub add {
1067	my ($self, $x, $y, $child) = @_;	1268	my ($self, $x, $y, $child) = @_;
1068		1269
1069	$child->set_parent ($self);	1270	$child->set_parent ($self);
1070	$self->{children}[$y][$x] = $child;	1271	$self->{children}[$y][$x] = $child;
1071		1272
1072	$child->check_size;	1273	$self->realloc;
1073	}	1274	}
1074		1275
1075	sub children {
1076	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1077	}
1078
1079	# TODO: move to container class maybe? send childs a signal on removal?	1276	# TODO: move to container class maybe? send children a signal on removal?
1080	sub clear {	1277	sub clear {
1081	my ($self) = @_;	1278	my ($self) = @_;
1082		1279
1083	my @children = $self->children;	1280	my @children = $self->children;
1084	delete $self->{children};	1281	delete $self->{children};
…		…
1086	for (@children) {	1283	for (@children) {
1087	delete $_->{parent};	1284	delete $_->{parent};
1088	$_->hide;	1285	$_->hide;
1089	}	1286	}
1090		1287
1091	$self->update;	1288	$self->realloc;
1092	}	1289	}
1093		1290
1094	sub get_wh {	1291	sub get_wh {
1095	my ($self) = @_;	1292	my ($self) = @_;
1096		1293
…		…
1127	sub size_allocate {	1324	sub size_allocate {
1128	my ($self, $w, $h) = @_;	1325	my ($self, $w, $h) = @_;
1129		1326
1130	my ($ws, $hs) = $self->get_wh;	1327	my ($ws, $hs) = $self->get_wh;
1131		1328
1132	my $req_w = sum @$ws;	1329	my $req_w = (sum @$ws) || 1;
1133	my $req_h = sum @$hs;	1330	my $req_h = (sum @$hs) || 1;
1134		1331
1135	# TODO: nicer code && do row_expand	1332	# TODO: nicer code && do row_expand
1136	my @col_expand = @{$self->{col_expand}};	1333	my @col_expand = @{$self->{col_expand}};
1137	@col_expand = (1) x @$ws unless @col_expand;	1334	@col_expand = (1) x @$ws unless @col_expand;
1138	my $col_expand = (sum @col_expand) || 1;	1335	my $col_expand = (sum @col_expand) || 1;
…		…
1192	}	1389	}
1193	}	1390	}
1194		1391
1195	#############################################################################	1392	#############################################################################
1196		1393
1197	package CFClient::UI::HBox;	1394	package CFClient::UI::Box;
1198
1199	# TODO: wrap into common Box base class
1200		1395
1201	our @ISA = CFClient::UI::Container::;	1396	our @ISA = CFClient::UI::Container::;
1202		1397
1203	sub size_request {	1398	sub size_request {
1204	my ($self) = @_;	1399	my ($self) = @_;
1205		1400
1206	my @alloc = map [$_->size_request], @{$self->{children}};	1401	$self->{vertical}
1207		1402	? (
1208	(	1403	(List::Util::max map $_->{req_w}, @{$self->{children}}),
1209	(List::Util::sum map $_->[0], @alloc),	1404	(List::Util::sum map $_->{req_h}, @{$self->{children}}),
1210	(List::Util::max map $_->[1], @alloc),	1405	)
1211	)	1406	: (
		1407	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
		1408	(List::Util::max map $_->{req_h}, @{$self->{children}}),
		1409	)
1212	}	1410	}
1213		1411
1214	sub size_allocate {	1412	sub size_allocate {
1215	my ($self, $w, $h) = @_;	1413	my ($self, $w, $h) = @_;
1216		1414
1217	($h, $w) = ($w, $h);	1415	my $space = $self->{vertical} ? $h : $w;
1218
1219	my $children = $self->{children};	1416	my $children = $self->{children};
1220		1417
1221	my @h = map $_->{req_w}, @$children;	1418	my @req;
1222		1419
1223	my $req_h = List::Util::sum @h;	1420	if ($self->{homogeneous}) {
1224		1421	@req = ($space / (@$children || 1)) x @$children;
1225	if ($req_h > $h) {
1226	# ah well, not enough space
1227	$_ *= $h / $req_h for @h;
1228	} else {	1422	} else {
		1423	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;
		1424	my $req = List::Util::sum @req;
		1425
		1426	if ($req > $space) {
		1427	# ah well, not enough space
		1428	$_ *= $space / $req for @req;
		1429	} else {
1229	my $exp = List::Util::sum map $_->{expand}, @$children;	1430	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;
1230	$exp ||= 1;
1231		1431
		1432	$space = ($space - $req) / $expand; # remaining space to give away
		1433
		1434	$req[$_] += $space * $children->[$_]{expand}
1232	for (0 .. $#$children) {	1435	for 0 .. $#$children;
1233	my $child = $children->[$_];
1234
1235	my $alloc_h = $h[$_];
1236	$alloc_h += ($h - $req_h) * $child->{expand} / $exp;
1237	$h[$_] = $alloc_h;
1238	}	1436	}
1239	}	1437	}
1240		1438
1241	CFClient::UI::harmonize \@h;	1439	CFClient::UI::harmonize \@req;
1242		1440
1243	my $y = 0;	1441	my $pos = 0;
1244	for (0 .. $#$children) {	1442	for (0 .. $#$children) {
1245	my $child = $children->[$_];
1246	my $h = $h[$_];	1443	my $alloc = $req[$_];
1247	$child->configure ($y, 0, $h, $w);	1444	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1248		1445
1249	$y += $h;	1446	$pos += $alloc;
1250	}	1447	}
1251		1448
1252	1	1449	1
1253	}	1450	}
1254		1451
1255	#############################################################################	1452	#############################################################################
1256		1453
		1454	package CFClient::UI::HBox;
		1455
		1456	our @ISA = CFClient::UI::Box::;
		1457
		1458	sub new {
		1459	my $class = shift;
		1460
		1461	$class->SUPER::new (
		1462	vertical => 0,
		1463	@_,
		1464	)
		1465	}
		1466
		1467	#############################################################################
		1468
1257	package CFClient::UI::VBox;	1469	package CFClient::UI::VBox;
1258		1470
1259	# TODO: wrap into common Box base class
1260
1261	our @ISA = CFClient::UI::Container::;	1471	our @ISA = CFClient::UI::Box::;
1262		1472
1263	sub size_request {	1473	sub new {
1264	my ($self) = @_;	1474	my $class = shift;
1265		1475
1266	my @alloc = map [$_->size_request], @{$self->{children}};	1476	$class->SUPER::new (
1267		1477	vertical => 1,
1268	(	1478	@_,
1269	(List::Util::max map $_->[0], @alloc),
1270	(List::Util::sum map $_->[1], @alloc),
1271	)	1479	)
1272	}
1273
1274	sub size_allocate {
1275	my ($self, $w, $h) = @_;
1276
1277	Carp::confess "negative size" if $w < 0 || $h < 0;#d#
1278
1279	my $children = $self->{children};
1280
1281	my @h = map $_->{req_h}, @$children;
1282
1283	my $req_h = List::Util::sum @h;
1284
1285	if ($req_h > $h) {
1286	# ah well, not enough space
1287	$_ *= $h / $req_h for @h;
1288	} else {
1289	my $exp = List::Util::sum map $_->{expand}, @$children;
1290	$exp ||= 1;
1291
1292	for (0 .. $#$children) {
1293	my $child = $children->[$_];
1294
1295	$h[$_] += ($h - $req_h) * $child->{expand} / $exp;
1296	}
1297	}
1298
1299	CFClient::UI::harmonize \@h;
1300
1301	my $y = 0;
1302	for (0 .. $#$children) {
1303	my $child = $children->[$_];
1304	my $h = $h[$_];
1305	$child->configure (0, $y, $w, $h);
1306
1307	$y += $h;
1308	}
1309
1310	1
1311	}	1480	}
1312		1481
1313	#############################################################################	1482	#############################################################################
1314		1483
1315	package CFClient::UI::Label;	1484	package CFClient::UI::Label;
…		…
1332	ellipsise => 3, # end	1501	ellipsise => 3, # end
1333	layout => (new CFClient::Layout),	1502	layout => (new CFClient::Layout),
1334	fontsize => 1,	1503	fontsize => 1,
1335	align => -1,	1504	align => -1,
1336	valign => -1,	1505	valign => -1,
1337	padding => 2,	1506	padding_x => 2,
		1507	padding_y => 2,
1338	can_events => 0,	1508	can_events => 0,
1339	%arg	1509	%arg
1340	);	1510	);
1341		1511
1342	if (exists $self->{template}) {	1512	if (exists $self->{template}) {
…		…
1369		1539
1370	delete $self->{texture};	1540	delete $self->{texture};
1371	$self->SUPER::update;	1541	$self->SUPER::update;
1372	}	1542	}
1373		1543
		1544	sub realloc {
		1545	my ($self) = @_;
		1546
		1547	delete $self->{ox};
		1548	$self->SUPER::realloc;
		1549	}
		1550
1374	sub set_text {	1551	sub set_text {
1375	my ($self, $text) = @_;	1552	my ($self, $text) = @_;
1376		1553
1377	return if $self->{text} eq "T$text";	1554	return if $self->{text} eq "T$text";
1378	$self->{text} = "T$text";	1555	$self->{text} = "T$text";
1379		1556
1380	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1557	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1381	$self->{layout}->set_text ($text);	1558	$self->{layout}->set_text ($text);
1382		1559
		1560	delete $self->{size_req};
		1561	$self->realloc;
1383	$self->update;	1562	$self->update;
1384	$self->check_size;
1385	}	1563	}
1386		1564
1387	sub set_markup {	1565	sub set_markup {
1388	my ($self, $markup) = @_;	1566	my ($self, $markup) = @_;
1389		1567
…		…
1393	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1571	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1394		1572
1395	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1573	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1396	$self->{layout}->set_markup ($markup);	1574	$self->{layout}->set_markup ($markup);
1397		1575
		1576	delete $self->{size_req};
		1577	$self->realloc;
1398	$self->update;	1578	$self->update;
1399	$self->check_size;
1400	}	1579	}
1401		1580
1402	sub size_request {	1581	sub size_request {
1403	my ($self) = @_;	1582	my ($self) = @_;
1404		1583
		1584	$self->{size_req} ||= do {
1405	$self->{layout}->set_font ($self->{font}) if $self->{font};	1585	$self->{layout}->set_font ($self->{font}) if $self->{font};
1406	$self->{layout}->set_width ($self->{max_w} || -1);	1586	$self->{layout}->set_width ($self->{max_w} || -1);
1407	$self->{layout}->set_ellipsise ($self->{ellipsise});	1587	$self->{layout}->set_ellipsise ($self->{ellipsise});
1408	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1588	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1409	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1589	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1410		1590
1411	my ($w, $h) = $self->{layout}->size;	1591	my ($w, $h) = $self->{layout}->size;
1412		1592
1413	if (exists $self->{template}) {	1593	if (exists $self->{template}) {
1414	$self->{template}->set_font ($self->{font}) if $self->{font};	1594	$self->{template}->set_font ($self->{font}) if $self->{font};
1415	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1595	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1416		1596
1417	my ($w2, $h2) = $self->{template}->size;	1597	my ($w2, $h2) = $self->{template}->size;
1418		1598
1419	$w = List::Util::max $w, $w2;	1599	$w = List::Util::max $w, $w2;
1420	$h = List::Util::max $h, $h2;	1600	$h = List::Util::max $h, $h2;
		1601	}
		1602
		1603	[$w, $h]
1421	}	1604	};
1422		1605
1423	(	1606	@{ $self->{size_req} }
1424	$w + $self->{padding} * 2,
1425	$h + $self->{padding} * 2,
1426	)
1427	}	1607	}
1428		1608
1429	sub size_allocate {	1609	sub size_allocate {
1430	my ($self, $w, $h) = @_;	1610	my ($self, $w, $h) = @_;
1431		1611
		1612	delete $self->{ox};
		1613
1432	delete $self->{texture};	1614	delete $self->{texture}
		1615	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
1433	}	1616	}
1434		1617
1435	sub set_fontsize {	1618	sub set_fontsize {
1436	my ($self, $fontsize) = @_;	1619	my ($self, $fontsize) = @_;
1437		1620
1438	$self->{fontsize} = $fontsize;	1621	$self->{fontsize} = $fontsize;
1439	delete $self->{texture};	1622	delete $self->{texture};
1440		1623
1441	$self->update;	1624	$self->realloc;
1442	$self->check_size;	1625	}
		1626
		1627	sub reconfigure {
		1628	my ($self) = @_;
		1629
		1630	delete $self->{size_req};
		1631
		1632	$self->SUPER::reconfigure;
1443	}	1633	}
1444		1634
1445	sub _draw {	1635	sub _draw {
1446	my ($self) = @_;	1636	my ($self) = @_;
1447		1637
…		…
1453	$self->{layout}->set_width ($self->{w});	1643	$self->{layout}->set_width ($self->{w});
1454	$self->{layout}->set_ellipsise ($self->{ellipsise});	1644	$self->{layout}->set_ellipsise ($self->{ellipsise});
1455	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1645	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1456	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1646	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1457		1647
1458	my $tex = new_from_layout CFClient::Texture $self->{layout};	1648	new_from_layout CFClient::Texture $self->{layout}
		1649	};
1459		1650
		1651	unless (exists $self->{ox}) {
1460	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1652	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1461	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1653	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1462	: ($self->{w} - $tex->{w}) * 0.5);	1654	: ($self->{w} - $tex->{w}) * 0.5);
1463		1655
1464	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1656	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1465	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1657	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1466	: ($self->{h} - $tex->{h}) * 0.5);	1658	: ($self->{h} - $tex->{h}) * 0.5);
1467
1468	$tex
1469	};	1659	};
1470		1660
1471	glEnable GL_TEXTURE_2D;	1661	glEnable GL_TEXTURE_2D;
1472	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1473		1662
1474	if ($tex->{format} == GL_ALPHA) {	1663	if ($tex->{format} == GL_ALPHA) {
		1664	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1475	glColor @{$self->{fg}};	1665	glColor @{$self->{fg}};
1476	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1666	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1477	} else {	1667	} else {
		1668	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1478	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1669	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1479	}	1670	}
1480		1671
1481	glDisable GL_TEXTURE_2D;	1672	glDisable GL_TEXTURE_2D;
1482	}	1673	}
…		…
1511		1702
1512	delete $self->{cur_h};	1703	delete $self->{cur_h};
1513		1704
1514	return if $self->{text} eq $text;	1705	return if $self->{text} eq $text;
1515		1706
1516	delete $self->{texture};
1517
1518	$self->{last_activity} = $::NOW;	1707	$self->{last_activity} = $::NOW;
1519	$self->{text} = $text;	1708	$self->{text} = $text;
1520		1709
1521	$text =~ s/./*/g if $self->{hidden};	1710	$text =~ s/./*/g if $self->{hidden};
1522	$self->{layout}->set_text ("$text ");	1711	$self->{layout}->set_text ("$text ");
		1712	delete $self->{size_req};
1523		1713
1524	$self->emit (changed => $self->{text});	1714	$self->_emit (changed => $self->{text});
		1715
		1716	$self->realloc;
		1717	$self->update;
1525	}	1718	}
1526		1719
1527	sub set_text {	1720	sub set_text {
1528	my ($self, $text) = @_;	1721	my ($self, $text) = @_;
1529		1722
1530	$self->{cursor} = length $text;	1723	$self->{cursor} = length $text;
1531	$self->_set_text ($text);	1724	$self->_set_text ($text);
1532	$self->update;
1533	$self->check_size;
1534	}	1725	}
1535		1726
1536	sub get_text {	1727	sub get_text {
1537	$_[0]{text}	1728	$_[0]{text}
1538	}	1729	}
…		…
1541	my ($self) = @_;	1732	my ($self) = @_;
1542		1733
1543	my ($w, $h) = $self->SUPER::size_request;	1734	my ($w, $h) = $self->SUPER::size_request;
1544		1735
1545	($w + 1, $h) # add 1 for cursor	1736	($w + 1, $h) # add 1 for cursor
1546	}
1547
1548	sub size_allocate {
1549	my ($self, $w, $h) = @_;
1550
1551	$self->_set_text (delete $self->{text});#d# don't check for == inside _set_text
1552	}	1737	}
1553		1738
1554	sub key_down {	1739	sub key_down {
1555	my ($self, $ev) = @_;	1740	my ($self, $ev) = @_;
1556		1741
…		…
1571	} elsif ($sym == CFClient::SDLK_HOME) {	1756	} elsif ($sym == CFClient::SDLK_HOME) {
1572	$self->{cursor} = 0;	1757	$self->{cursor} = 0;
1573	} elsif ($sym == CFClient::SDLK_END) {	1758	} elsif ($sym == CFClient::SDLK_END) {
1574	$self->{cursor} = length $text;	1759	$self->{cursor} = length $text;
1575	} elsif ($uni == 27) {	1760	} elsif ($uni == 27) {
1576	$self->emit ('escape');	1761	$self->_emit ('escape');
1577	} elsif ($uni) {	1762	} elsif ($uni) {
1578	substr $text, $self->{cursor}++, 0, chr $uni;	1763	substr $text, $self->{cursor}++, 0, chr $uni;
		1764	} else {
		1765	return 0;
1579	}	1766	}
1580		1767
1581	$self->_set_text ($text);	1768	$self->_set_text ($text);
1582	$self->update;	1769
1583	$self->check_size;	1770	$self->realloc;
		1771
		1772	1
1584	}	1773	}
1585		1774
1586	sub focus_in {	1775	sub focus_in {
1587	my ($self) = @_;	1776	my ($self) = @_;
1588		1777
…		…
1603	utf8::encode $text;	1792	utf8::encode $text;
1604	$self->{cursor} = length substr $text, 0, $idx;	1793	$self->{cursor} = length substr $text, 0, $idx;
1605		1794
1606	$self->_set_text ($self->{text});	1795	$self->_set_text ($self->{text});
1607	$self->update;	1796	$self->update;
		1797
		1798	1
1608	}	1799	}
1609		1800
1610	sub mouse_motion {	1801	sub mouse_motion {
1611	my ($self, $ev, $x, $y) = @_;	1802	my ($self, $ev, $x, $y) = @_;
1612	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1803	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1804
		1805	0
1613	}	1806	}
1614		1807
1615	sub _draw {	1808	sub _draw {
1616	my ($self) = @_;	1809	my ($self) = @_;
1617		1810
1618	local $self->{fg} = $self->{fg};	1811	local $self->{fg} = $self->{fg};
1619		1812
1620	if ($FOCUS == $self) {	1813	if ($FOCUS == $self) {
1621	glColor @{$self->{active_bg}};	1814	glColor_premultiply @{$self->{active_bg}};
1622	$self->{fg} = $self->{active_fg};	1815	$self->{fg} = $self->{active_fg};
1623	} else {	1816	} else {
1624	glColor @{$self->{bg}};	1817	glColor_premultiply @{$self->{bg}};
1625	}	1818	}
1626		1819
1627	glEnable GL_BLEND;	1820	glEnable GL_BLEND;
1628	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1821	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1629	glBegin GL_QUADS;	1822	glBegin GL_QUADS;
1630	glVertex 0 , 0;	1823	glVertex 0 , 0;
1631	glVertex 0 , $self->{h};	1824	glVertex 0 , $self->{h};
1632	glVertex $self->{w}, $self->{h};	1825	glVertex $self->{w}, $self->{h};
1633	glVertex $self->{w}, 0;	1826	glVertex $self->{w}, 0;
…		…
1668	if ($sym == 13) {	1861	if ($sym == 13) {
1669	unshift @{$self->{history}},	1862	unshift @{$self->{history}},
1670	my $txt = $self->get_text;	1863	my $txt = $self->get_text;
1671	$self->{history_pointer} = -1;	1864	$self->{history_pointer} = -1;
1672	$self->{history_saveback} = '';	1865	$self->{history_saveback} = '';
1673	$self->emit (activate => $txt);	1866	$self->_emit (activate => $txt);
1674	$self->update;	1867	$self->update;
1675		1868
1676	} elsif ($sym == CFClient::SDLK_UP) {	1869	} elsif ($sym == CFClient::SDLK_UP) {
1677	if ($self->{history_pointer} < 0) {	1870	if ($self->{history_pointer} < 0) {
1678	$self->{history_saveback} = $self->get_text;	1871	$self->{history_saveback} = $self->get_text;
…		…
1694	} else {	1887	} else {
1695	$self->set_text ($self->{history_saveback});	1888	$self->set_text ($self->{history_saveback});
1696	}	1889	}
1697		1890
1698	} else {	1891	} else {
1699	$self->SUPER::key_down ($ev);	1892	return $self->SUPER::key_down ($ev)
		1893	}
		1894
1700	}	1895	1
1701
1702	}	1896	}
1703		1897
1704	#############################################################################	1898	#############################################################################
1705		1899
1706	package CFClient::UI::Button;	1900	package CFClient::UI::Button;
…		…
1715		1909
1716	sub new {	1910	sub new {
1717	my $class = shift;	1911	my $class = shift;
1718		1912
1719	$class->SUPER::new (	1913	$class->SUPER::new (
1720	padding => 4,	1914	padding_x => 4,
		1915	padding_y => 4,
1721	fg => [1, 1, 1],	1916	fg => [1, 1, 1],
1722	active_fg => [0, 0, 1],	1917	active_fg => [0, 0, 1],
1723	can_hover => 1,	1918	can_hover => 1,
1724	align => 0,	1919	align => 0,
1725	valign => 0,	1920	valign => 0,
1726	can_events => 1,	1921	can_events => 1,
1727	@_	1922	@_
1728	)	1923	)
1729	}	1924	}
1730		1925
		1926	sub activate { }
		1927
1731	sub button_up {	1928	sub button_up {
1732	my ($self, $ev, $x, $y) = @_;	1929	my ($self, $ev, $x, $y) = @_;
1733		1930
		1931	$self->emit ("activate")
1734	if ($x >= 0 && $x < $self->{w}	1932	if $x >= 0 && $x < $self->{w}
1735	&& $y >= 0 && $y < $self->{h}) {	1933	&& $y >= 0 && $y < $self->{h};
1736	$self->emit ("activate");	1934
1737	}	1935	1
1738	}	1936	}
1739		1937
1740	sub _draw {	1938	sub _draw {
1741	my ($self) = @_;	1939	my ($self) = @_;
1742		1940
1743	local $self->{fg} = $self->{fg};	1941	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1744
1745	if ($GRAB == $self) {
1746	$self->{fg} = $self->{active_fg};
1747	}
1748		1942
1749	glEnable GL_TEXTURE_2D;	1943	glEnable GL_TEXTURE_2D;
1750	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1944	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1751	glColor 0, 0, 0, 1;	1945	glColor 0, 0, 0, 1;
1752		1946
…		…
1771		1965
1772	sub new {	1966	sub new {
1773	my $class = shift;	1967	my $class = shift;
1774		1968
1775	$class->SUPER::new (	1969	$class->SUPER::new (
1776	padding => 2,	1970	padding_x => 2,
		1971	padding_y => 2,
1777	fg => [1, 1, 1],	1972	fg => [1, 1, 1],
1778	active_fg => [1, 1, 0],	1973	active_fg => [1, 1, 0],
1779	bg => [0, 0, 0, 0.2],	1974	bg => [0, 0, 0, 0.2],
1780	active_bg => [1, 1, 1, 0.5],	1975	active_bg => [1, 1, 1, 0.5],
1781	state => 0,	1976	state => 0,
…		…
1785	}	1980	}
1786		1981
1787	sub size_request {	1982	sub size_request {
1788	my ($self) = @_;	1983	my ($self) = @_;
1789		1984
1790	($self->{padding} * 2 + 6) x 2	1985	(6) x 2
1791	}	1986	}
1792		1987
1793	sub button_down {	1988	sub button_down {
1794	my ($self, $ev, $x, $y) = @_;	1989	my ($self, $ev, $x, $y) = @_;
1795		1990
1796	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	1991	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1797	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	1992	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1798	$self->{state} = !$self->{state};	1993	$self->{state} = !$self->{state};
1799	$self->emit (changed => $self->{state});	1994	$self->_emit (changed => $self->{state});
		1995	} else {
		1996	return 0
		1997	}
		1998
1800	}	1999	1
1801	}	2000	}
1802		2001
1803	sub _draw {	2002	sub _draw {
1804	my ($self) = @_;	2003	my ($self) = @_;
1805		2004
1806	$self->SUPER::_draw;	2005	$self->SUPER::_draw;
1807		2006
1808	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2007	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1809		2008
1810	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	2009	my ($w, $h) = @$self{qw(w h)};
		2010
		2011	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1811		2012
1812	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2013	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1813		2014
1814	my $tex = $self->{state} ? $tex[1] : $tex[0];	2015	my $tex = $self->{state} ? $tex[1] : $tex[0];
1815		2016
…		…
1970		2171
1971	my $h1 = $self->{h} * (1 - $ycut1);	2172	my $h1 = $self->{h} * (1 - $ycut1);
1972	my $h2 = $self->{h} * (1 - $ycut2);	2173	my $h2 = $self->{h} * (1 - $ycut2);
1973		2174
1974	glEnable GL_BLEND;	2175	glEnable GL_BLEND;
1975	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2176	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2177	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1976	glEnable GL_TEXTURE_2D;	2178	glEnable GL_TEXTURE_2D;
1977	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2179	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1978		2180
1979	glBindTexture GL_TEXTURE_2D, $t1->{name};	2181	glBindTexture GL_TEXTURE_2D, $t1->{name};
1980	glBegin GL_QUADS;	2182	glBegin GL_QUADS;
…		…
2080	fg => [1, 1, 1],	2282	fg => [1, 1, 1],
2081	active_fg => [0, 0, 0],	2283	active_fg => [0, 0, 0],
2082	bg => [0, 0, 0, 0.2],	2284	bg => [0, 0, 0, 0.2],
2083	active_bg => [1, 1, 1, 0.5],	2285	active_bg => [1, 1, 1, 0.5],
2084	range => [0, 0, 100, 10, 0],	2286	range => [0, 0, 100, 10, 0],
2085	req_w => $::WIDTH / 80,	2287	min_w => $::WIDTH / 80,
2086	req_h => $::WIDTH / 80,	2288	min_h => $::WIDTH / 80,
2087	vertical => 0,	2289	vertical => 0,
2088	can_hover => 1,	2290	can_hover => 1,
2089	inner_pad => 0.02,	2291	inner_pad => 0.02,
2090	@_	2292	@_
2091	);	2293	);
…		…
2094	$self->update;	2296	$self->update;
2095		2297
2096	$self	2298	$self
2097	}	2299	}
2098		2300
		2301	sub changed { }
		2302
2099	sub set_range {	2303	sub set_range {
2100	my ($self, $range) = @_;	2304	my ($self, $range) = @_;
2101		2305
2102	$self->{range} = $range;	2306	($range, $self->{range}) = ($self->{range}, $range);
2103		2307
2104	$self->update;	2308	$self->update
		2309	if "@$range" ne "@{$self->{range}}";
2105	}	2310	}
2106		2311
2107	sub set_value {	2312	sub set_value {
2108	my ($self, $value) = @_;	2313	my ($self, $value) = @_;
2109		2314
…		…
2120	if $unit;	2325	if $unit;
2121		2326
2122	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2327	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2123		2328
2124	if ($value != $old_value) {	2329	if ($value != $old_value) {
2125	$self->emit (changed => $value);	2330	$self->_emit (changed => $value);
2126	$self->update;	2331	$self->update;
2127	}	2332	}
2128	}	2333	}
2129		2334
2130	sub size_request {	2335	sub size_request {
2131	my ($self) = @_;	2336	my ($self) = @_;
2132		2337
2133	my $w = $self->{req_w};	2338	($self->{req_w}, $self->{req_h})
2134	my $h = $self->{req_h};
2135
2136	$self->{vertical} ? ($h, $w) : ($w, $h)
2137	}	2339	}
2138		2340
2139	sub button_down {	2341	sub button_down {
2140	my ($self, $ev, $x, $y) = @_;	2342	my ($self, $ev, $x, $y) = @_;
2141		2343
2142	$self->SUPER::button_down ($ev, $x, $y);	2344	$self->SUPER::button_down ($ev, $x, $y);
2143		2345
2144	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2346	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2145		2347
2146	$self->mouse_motion ($ev, $x, $y);	2348	$self->mouse_motion ($ev, $x, $y)
2147	}	2349	}
2148		2350
2149	sub mouse_motion {	2351	sub mouse_motion {
2150	my ($self, $ev, $x, $y) = @_;	2352	my ($self, $ev, $x, $y) = @_;
2151		2353
…		…
2155	my (undef, $lo, $hi, $page) = @{$self->{range}};	2357	my (undef, $lo, $hi, $page) = @{$self->{range}};
2156		2358
2157	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2359	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2158		2360
2159	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2361	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2362	} else {
		2363	return 0;
		2364	}
		2365
2160	}	2366	1
2161	}	2367	}
2162		2368
2163	sub update {	2369	sub update {
2164	my ($self) = @_;	2370	my ($self) = @_;
2165		2371
2166	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2372	delete $self->{knob_w};
		2373	$self->SUPER::update;
		2374	}
		2375
		2376	sub _draw {
		2377	my ($self) = @_;
		2378
		2379	unless ($self->{knob_w}) {
2167	$self->set_value ($self->{range}[0]);	2380	$self->set_value ($self->{range}[0]);
2168		2381
2169	my ($value, $lo, $hi, $page) = @{$self->{range}};	2382	my ($value, $lo, $hi, $page) = @{$self->{range}};
2170	my $range = ($hi - $page - $lo) || 1e-100;	2383	my $range = ($hi - $page - $lo) || 1e-100;
2171		2384
…		…
2177	$value = ($value - $lo) / $range;	2390	$value = ($value - $lo) / $range;
2178	$value = $value * $self->{scale} + $self->{offset};	2391	$value = $value * $self->{scale} + $self->{offset};
2179		2392
2180	$self->{knob_x} = $value - $knob_w * 0.5;	2393	$self->{knob_x} = $value - $knob_w * 0.5;
2181	$self->{knob_w} = $knob_w;	2394	$self->{knob_w} = $knob_w;
2182	});	2395	}
2183
2184	$self->SUPER::update;
2185	}
2186
2187	sub _draw {
2188	my ($self) = @_;
2189		2396
2190	$self->SUPER::_draw ();	2397	$self->SUPER::_draw ();
2191		2398
2192	glScale $self->{w}, $self->{h};	2399	glScale $self->{w}, $self->{h};
2193		2400
…		…
2387		2594
2388	delete $self->{texture};	2595	delete $self->{texture};
2389	}	2596	}
2390		2597
2391	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2598	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2392	glClearColor 0.5, 0.5, 0.5, 0;	2599	glClearColor 0, 0, 0, 0;
2393	glClear GL_COLOR_BUFFER_BIT;	2600	glClear GL_COLOR_BUFFER_BIT;
2394		2601
2395	my $top = int $self->{children}[1]{range}[0];	2602	my $top = int $self->{children}[1]{range}[0];
2396		2603
2397	my $y0 = $top;	2604	my $y0 = $top;
…		…
2432	sub _draw {	2639	sub _draw {
2433	my ($self) = @_;	2640	my ($self) = @_;
2434		2641
2435	glEnable GL_TEXTURE_2D;	2642	glEnable GL_TEXTURE_2D;
2436	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2643	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2437	glColor 1, 1, 1, 1;	2644	glColor 0, 0, 0, 1;
2438	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2645	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2439	glDisable GL_TEXTURE_2D;	2646	glDisable GL_TEXTURE_2D;
2440		2647
2441	$self->{children}[1]->draw;	2648	$self->{children}[1]->draw;
2442		2649
2443	}	2650	}
…		…
2492		2699
2493	sub new {	2700	sub new {
2494	my $class = shift;	2701	my $class = shift;
2495		2702
2496	my $self = $class->SUPER::new (	2703	my $self = $class->SUPER::new (
2497	state => 0,	2704	state => 0,
2498	connect_activate => \&toggle_flopper,	2705	on_activate => \&toggle_flopper,
2499	@_	2706	@_
2500	);	2707	);
2501		2708
2502	if ($self->{state}) {
2503	$self->{state} = 0;
2504	$self->toggle_flopper;
2505	}
2506
2507	$self	2709	$self
2508	}	2710	}
2509		2711
2510	sub toggle_flopper {	2712	sub toggle_flopper {
2511	my ($self) = @_;	2713	my ($self) = @_;
2512		2714
2513	# TODO: use animation	2715	$self->{other}->toggle_visibility;
2514	if ($self->{state} = !$self->{state}) {
2515	$CFClient::UI::ROOT->add ($self->{other});
2516	$self->{other}->move ($self->coord2global (0, $self->{h}));
2517	$self->emit ("open");
2518	} else {
2519	$CFClient::UI::ROOT->remove ($self->{other});
2520	$self->emit ("close");
2521	}
2522
2523	$self->emit (changed => $self->{state});
2524	}	2716	}
2525		2717
2526	#############################################################################	2718	#############################################################################
2527		2719
2528	package CFClient::UI::Tooltip;	2720	package CFClient::UI::Tooltip;
…		…
2541	}	2733	}
2542		2734
2543	sub set_tooltip_from {	2735	sub set_tooltip_from {
2544	my ($self, $widget) = @_;	2736	my ($self, $widget) = @_;
2545		2737
		2738	my $tooltip = $widget->{tooltip};
		2739
		2740	if ($ENV{CFPLUS_DEBUG} & 2) {
		2741	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2742	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2743	. "req $widget->{req_w} $widget->{req_h}\n"
		2744	. "visible $widget->{visible}";
		2745	}
		2746
2546	$self->add (new CFClient::UI::Label	2747	$self->add (new CFClient::UI::Label
2547	markup => $widget->{tooltip},	2748	markup => $tooltip,
2548	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2749	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2549	fontsize => 0.8,	2750	fontsize => 0.8,
2550	fg => [0, 0, 0, 1],	2751	fg => [0, 0, 0, 1],
2551	ellipsise => 0,	2752	ellipsise => 0,
2552	font => ($widget->{tooltip_font} || $::FONT_PROP),	2753	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2563		2764
2564	sub size_allocate {	2765	sub size_allocate {
2565	my ($self, $w, $h) = @_;	2766	my ($self, $w, $h) = @_;
2566		2767
2567	$self->SUPER::size_allocate ($w - 4, $h - 4);	2768	$self->SUPER::size_allocate ($w - 4, $h - 4);
		2769	}
		2770
		2771	sub visibility_change {
		2772	my ($self, $visible) = @_;
		2773
		2774	return unless $visible;
		2775
		2776	$self->{root}->on_post_alloc ("move_$self" => sub {
		2777	my $widget = $self->{owner}
		2778	or return;
		2779
		2780	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
		2781
		2782	($x, $y) = $widget->coord2global (-$self->{w}, 0)
		2783	if $x + $self->{w} > $::WIDTH;
		2784
		2785	$self->move_abs ($x, $y);
		2786	});
2568	}	2787	}
2569		2788
2570	sub _draw {	2789	sub _draw {
2571	my ($self) = @_;	2790	my ($self) = @_;
2572		2791
…		…
2589	glVertex $w, $h;	2808	glVertex $w, $h;
2590	glVertex $w, 0;	2809	glVertex $w, 0;
2591	glEnd;	2810	glEnd;
2592		2811
2593	glTranslate 2 - 0.375, 2 - 0.375;	2812	glTranslate 2 - 0.375, 2 - 0.375;
		2813
2594	$self->SUPER::_draw;	2814	$self->SUPER::_draw;
2595	}	2815	}
2596		2816
2597	#############################################################################	2817	#############################################################################
2598		2818
…		…
2604		2824
2605	sub new {	2825	sub new {
2606	my $class = shift;	2826	my $class = shift;
2607		2827
2608	my $self = $class->SUPER::new (	2828	my $self = $class->SUPER::new (
2609	aspect => 1,	2829	aspect => 1,
		2830	can_events => 0,
2610	@_,	2831	@_,
2611	);	2832	);
2612		2833
2613	if ($self->{anim} && $self->{animspeed}) {	2834	if ($self->{anim} && $self->{animspeed}) {
2614	Scalar::Util::weaken (my $widget = $self);	2835	Scalar::Util::weaken (my $widget = $self);
…		…
2656	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2877	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2657		2878
2658	if ($tex) {	2879	if ($tex) {
2659	glEnable GL_TEXTURE_2D;	2880	glEnable GL_TEXTURE_2D;
2660	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2881	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2661	glColor 1, 1, 1, 1;	2882	glColor 0, 0, 0, 1;
2662	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2883	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2663	glDisable GL_TEXTURE_2D;	2884	glDisable GL_TEXTURE_2D;
2664	}	2885	}
2665	}	2886	}
2666		2887
…		…
2673	$self->SUPER::DESTROY;	2894	$self->SUPER::DESTROY;
2674	}	2895	}
2675		2896
2676	#############################################################################	2897	#############################################################################
2677		2898
2678	package CFClient::UI::InventoryItem;	2899	package CFClient::UI::Buttonbar;
2679		2900
2680	our @ISA = CFClient::UI::HBox::;	2901	our @ISA = CFClient::UI::HBox::;
2681		2902
2682	sub _item_to_desc {	2903	# TODO: should actualyl wrap buttons and other goodies.
2683	my ($item) = @_;
2684
2685	my $desc =
2686	$item->{nrof} < 2
2687	? $item->{name}
2688	: "$item->{nrof} × $item->{name_pl}";
2689
2690	$item->{flags} & Crossfire::Protocol::F_OPEN
2691	and $desc .= " (open)";
2692	$item->{flags} & Crossfire::Protocol::F_APPLIED
2693	and $desc .= " (applied)";
2694	$item->{flags} & Crossfire::Protocol::F_UNPAID
2695	and $desc .= " (unpaid)";
2696	$item->{flags} & Crossfire::Protocol::F_MAGIC
2697	and $desc .= " (magic)";
2698	$item->{flags} & Crossfire::Protocol::F_CURSED
2699	and $desc .= " (cursed)";
2700	$item->{flags} & Crossfire::Protocol::F_DAMNED
2701	and $desc .= " (damned)";
2702	$item->{flags} & Crossfire::Protocol::F_LOCKED
2703	and $desc .= " *";
2704
2705	$desc
2706	}
2707
2708	sub new {
2709	my $class = shift;
2710
2711	my %args = @_;
2712
2713	my $item = delete $args{item};
2714
2715	my $desc = _item_to_desc ($item);
2716
2717	my $self = $class->SUPER::new (
2718	can_hover => 1,
2719	can_events => 1,
2720	tooltip => ((CFClient::UI::Label::escape $desc)
2721	. "\n<small>leftclick - examine\nshift+leftclick - move/pickup/drop\nmiddle click - apply\nrightclick - menu</small>"),
2722	connect_button_down => sub {
2723	my ($self, $ev, $x, $y) = @_;
2724
2725	# todo: maybe put examine on 1? but should just be a tooltip :(
2726	if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) {
2727	my $targ = $::CONN->{player}{tag};
2728
2729	if ($item->{container} == $::CONN->{player}{tag}) {
2730	$targ = $main::OPENCONT;
2731	}
2732
2733	$::CONN->send ("move $targ $item->{tag} 0");
2734	} elsif ($ev->{button} == 1) {
2735	$::CONN->send ("examine $item->{tag}");
2736	} elsif ($ev->{button} == 2) {
2737	$::CONN->send ("apply $item->{tag}");
2738	} elsif ($ev->{button} == 3) {
2739	my @menu_items = (
2740	["examine", sub { $::CONN->send ("examine $item->{tag}") }],
2741	["mark", sub { $::CONN->send ("mark ". pack "N", $item->{tag}) }],
2742	["apply", sub { $::CONN->send ("apply $item->{tag}") }],
2743	(
2744	$item->{flags} & Crossfire::Protocol::F_LOCKED
2745	? (
2746	["unlock", sub { $::CONN->send ("lock " . pack "CN", 0, $item->{tag}) }],
2747	)
2748	: (
2749	["lock", sub { $::CONN->send ("lock " . pack "CN", 1, $item->{tag}) }],
2750	["drop", sub { $::CONN->send ("move $main::OPENCONT $item->{tag} 0") }],
2751	)
2752	),
2753	);
2754
2755	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
2756	}
2757
2758	1
2759	},
2760	%args
2761	);
2762
2763
2764	$self->add (new CFClient::UI::Face
2765	can_events => 0,
2766	face => $item->{face},
2767	anim => $item->{anim},
2768	animspeed => $item->{animspeed},
2769	);
2770
2771	$self->add ($self->{name_lbl} = new CFClient::UI::Label can_events => 0);
2772
2773	$self->{item} = $item;
2774
2775	$self->update_item;
2776
2777	$self
2778	}
2779
2780	sub update_item {
2781	my ($self) = @_;
2782
2783	my $desc = _item_to_desc ($self->{item});
2784
2785	$self->{name_lbl}->set_text ($desc);
2786	}
2787
2788	#############################################################################
2789
2790	package CFClient::UI::Inventory;
2791
2792	our @ISA = CFClient::UI::ScrolledWindow::;
2793
2794	sub new {
2795	my $class = shift;
2796
2797	my $self = $class->SUPER::new (
2798	scrolled => (new CFClient::UI::Table),
2799	@_,
2800	);
2801
2802	$self
2803	}
2804
2805	sub set_items {
2806	my ($self, $items) = @_;
2807
2808	$self->{scrolled}->clear;
2809	return unless $items;
2810
2811	my @items = sort {
2812	($a->{type} <=> $b->{type})
2813	or ($a->{name} cmp $b->{name})
2814	} @$items;
2815
2816	$self->{real_items} = \@items;
2817
2818	for my $item (@items) {
2819	$item->{item} = $item;
2820	$item = $item->{widget} ||= new CFClient::UI::InventoryItem item => $item;
2821	$item->update_item ();
2822	}
2823
2824	my $i = 0;
2825	for (@items) {
2826	$self->{scrolled}->add (0, $i, $_);
2827	my $nrof = $_->{item}->{nrof} || 1;
2828	$self->{scrolled}->add (1, $i++, new CFClient::UI::Label text => ($_->{item}->{weight} * $nrof) / 1000);
2829	}
2830
2831	# $range->{range} = [$self->{pos}, 0, $self->{max_pos}, $page];
2832	}
2833
2834	sub size_request {
2835	my ($self) = @_;
2836	($self->{req_w}, $self->{req_h});
2837	}
2838		2904
2839	#############################################################################	2905	#############################################################################
2840		2906
2841	package CFClient::UI::Menu;	2907	package CFClient::UI::Menu;
2842		2908
…		…
2876		2942
2877	# popup given the event (must be a mouse button down event currently)	2943	# popup given the event (must be a mouse button down event currently)
2878	sub popup {	2944	sub popup {
2879	my ($self, $ev) = @_;	2945	my ($self, $ev) = @_;
2880		2946
2881	$self->emit ("popdown");	2947	$self->_emit ("popdown");
2882		2948
2883	# maybe save $GRAB? must be careful about events...	2949	# maybe save $GRAB? must be careful about events...
2884	$GRAB = $self;	2950	$GRAB = $self;
2885	$self->{button} = $ev->{button};	2951	$self->{button} = $ev->{button};
2886		2952
2887	$self->show;	2953	$self->show;
2888	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	2954	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2889	}	2955	}
2890		2956
2891	sub mouse_motion {	2957	sub mouse_motion {
2892	my ($self, $ev, $x, $y) = @_;	2958	my ($self, $ev, $x, $y) = @_;
2893		2959
2894	# TODO: should use vbox->find_widget or so	2960	# TODO: should use vbox->find_widget or so
2895	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	2961	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2896	$self->{hover} = $self->{item}{$HOVER};	2962	$self->{hover} = $self->{item}{$HOVER};
		2963
		2964	0
2897	}	2965	}
2898		2966
2899	sub button_up {	2967	sub button_up {
2900	my ($self, $ev, $x, $y) = @_;	2968	my ($self, $ev, $x, $y) = @_;
2901		2969
2902	if ($ev->{button} == $self->{button}) {	2970	if ($ev->{button} == $self->{button}) {
2903	undef $GRAB;	2971	undef $GRAB;
2904	$self->hide;	2972	$self->hide;
2905		2973
2906	$self->emit ("popdown");	2974	$self->_emit ("popdown");
2907	$self->{hover}[1]->() if $self->{hover};	2975	$self->{hover}[1]->() if $self->{hover};
		2976	} else {
		2977	return 0
		2978	}
		2979
2908	}	2980	1
2909	}	2981	}
2910		2982
2911	#############################################################################	2983	#############################################################################
2912		2984
2913	package CFClient::UI::Statusbox;	2985	package CFClient::UI::Multiplexer;
2914		2986
2915	our @ISA = CFClient::UI::VBox::;	2987	our @ISA = CFClient::UI::Container::;
2916		2988
2917	sub new {	2989	sub new {
2918	my $class = shift;	2990	my $class = shift;
2919		2991
2920	$class->SUPER::new (	2992	my $self = $class->SUPER::new (
		2993	@_,
		2994	);
		2995
		2996	$self->{current} = $self->{children}[0]
		2997	if @{ $self->{children} };
		2998
		2999	$self
		3000	}
		3001
		3002	sub add {
		3003	my ($self, @widgets) = @_;
		3004
		3005	$self->SUPER::add (@widgets);
		3006
		3007	$self->{current} = $self->{children}[0]
		3008	if @{ $self->{children} };
		3009	}
		3010
		3011	sub set_current_page {
		3012	my ($self, $page_or_widget) = @_;
		3013
		3014	my $widget = ref $page_or_widget
		3015	? $page_or_widget
		3016	: $self->{children}[$page_or_widget];
		3017
		3018	$self->{current} = $widget;
		3019	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3020
		3021	$self->_emit (page_changed => $self->{current});
		3022
		3023	$self->realloc;
		3024	}
		3025
		3026	sub visible_children {
		3027	$_[0]{current}
		3028	}
		3029
		3030	sub size_request {
		3031	my ($self) = @_;
		3032
		3033	$self->{current}->size_request
		3034	}
		3035
		3036	sub size_allocate {
		3037	my ($self, $w, $h) = @_;
		3038
		3039	$self->{current}->configure (0, 0, $w, $h);
		3040	}
		3041
		3042	sub _draw {
		3043	my ($self) = @_;
		3044
		3045	$self->{current}->draw;
		3046	}
		3047
		3048	#############################################################################
		3049
		3050	package CFClient::UI::Notebook;
		3051
		3052	our @ISA = CFClient::UI::VBox::;
		3053
		3054	sub new {
		3055	my $class = shift;
		3056
		3057	my $self = $class->SUPER::new (
		3058	buttonbar => (new CFClient::UI::Buttonbar),
		3059	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3060	# filter => # will be put between multiplexer and $self
		3061	@_,
		3062	);
		3063
		3064	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3065	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3066
		3067	$self
		3068	}
		3069
		3070	sub add {
		3071	my ($self, $title, $widget, $tooltip) = @_;
		3072
		3073	Scalar::Util::weaken $self;
		3074
		3075	$self->{buttonbar}->add (new CFClient::UI::Button
		3076	markup => $title,
		3077	tooltip => $tooltip,
		3078	on_activate => sub { $self->set_current_page ($widget) },
		3079	);
		3080
		3081	$self->{multiplexer}->add ($widget);
		3082	}
		3083
		3084	sub set_current_page {
		3085	my ($self, $page) = @_;
		3086
		3087	$self->{multiplexer}->set_current_page ($page);
		3088	$self->_emit (page_changed => $self->{multiplexer}{current});
		3089	}
		3090
		3091	#############################################################################
		3092
		3093	package CFClient::UI::Statusbox;
		3094
		3095	our @ISA = CFClient::UI::VBox::;
		3096
		3097	sub new {
		3098	my $class = shift;
		3099
		3100	my $self = $class->SUPER::new (
2921	fontsize => 0.8,	3101	fontsize => 0.8,
2922	@_,	3102	@_,
2923	)	3103	);
		3104
		3105	Scalar::Util::weaken (my $this = $self);
		3106
		3107	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3108
		3109	$self
2924	}	3110	}
2925		3111
2926	sub reorder {	3112	sub reorder {
2927	my ($self) = @_;	3113	my ($self) = @_;
2928	my $NOW = time;	3114	my $NOW = Time::HiRes::time;
		3115
		3116	# freeze display when hovering over any label
		3117	return if $CFClient::UI::TOOLTIP->{owner}
		3118	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3119	values %{ $self->{item} };
2929		3120
2930	while (my ($k, $v) = each %{ $self->{item} }) {	3121	while (my ($k, $v) = each %{ $self->{item} }) {
2931	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3122	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2932	}	3123	}
2933		3124
…		…
2936	my @items = sort {	3127	my @items = sort {
2937	$a->{pri} <=> $b->{pri}	3128	$a->{pri} <=> $b->{pri}
2938	or $b->{id} <=> $a->{id}	3129	or $b->{id} <=> $a->{id}
2939	} values %{ $self->{item} };	3130	} values %{ $self->{item} };
2940		3131
		3132	$self->{timer}->interval (1);
		3133
2941	my $count = 10 + 1;	3134	my $count = 10 + 1;
2942	for my $item (@items) {	3135	for my $item (@items) {
2943	last unless --$count;	3136	last unless --$count;
2944		3137
2945	push @widgets, $item->{label} ||= do {	3138	my $label = $item->{label} ||= do {
2946	# TODO: doesn't handle markup well (read as: at all)	3139	# TODO: doesn't handle markup well (read as: at all)
2947	my $short = $item->{count} > 1	3140	my $short = $item->{count} > 1
2948	? "<b>$item->{count} ×</b> $item->{text}"	3141	? "<b>$item->{count} ×</b> $item->{text}"
2949	: $item->{text};	3142	: $item->{text};
2950		3143
…		…
2958	tooltip => $item->{tooltip},	3151	tooltip => $item->{tooltip},
2959	tooltip_font => $::FONT_PROP,	3152	tooltip_font => $::FONT_PROP,
2960	tooltip_width => 0.67,	3153	tooltip_width => 0.67,
2961	fontsize => $item->{fontsize} || $self->{fontsize},	3154	fontsize => $item->{fontsize} || $self->{fontsize},
2962	max_w => $::WIDTH * 0.44,	3155	max_w => $::WIDTH * 0.44,
2963	fg => $item->{fg},	3156	fg => [@{ $item->{fg} }],
2964	can_events => 1,	3157	can_events => 1,
2965	can_hover => 1	3158	can_hover => 1
2966	};	3159	};
		3160
		3161	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3162	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3163	$label->update;
		3164	$label->set_max_size (undef, $label->{req_h} * $diff)
		3165	if $diff < 1;
		3166	$self->{timer}->interval (1/30);
		3167	} else {
		3168	$label->{fg}[3] = $item->{fg}[3] || 1;
		3169	}
		3170
		3171	push @widgets, $label;
2967	}	3172	}
2968		3173
2969	$self->clear;	3174	$self->clear;
2970	$self->SUPER::add (reverse @widgets);	3175	$self->SUPER::add (reverse @widgets);
2971	}	3176	}
…		…
2974	my ($self, $text, %arg) = @_;	3179	my ($self, $text, %arg) = @_;
2975		3180
2976	$text =~ s/^\s+//;	3181	$text =~ s/^\s+//;
2977	$text =~ s/\s+$//;	3182	$text =~ s/\s+$//;
2978		3183
		3184	return unless $text;
		3185
2979	my $timeout = time + ((delete $arg{timeout}) || 60);	3186	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2980		3187
2981	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3188	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2982		3189
2983	if (my $item = $self->{item}{$group}) {	3190	if (my $item = $self->{item}{$group}) {
2984	if ($item->{text} eq $text) {	3191	if ($item->{text} eq $text) {
…		…
3014		3221
3015	$self->reorder;	3222	$self->reorder;
3016	$self->SUPER::reconfigure;	3223	$self->SUPER::reconfigure;
3017	}	3224	}
3018		3225
		3226	sub DESTROY {
		3227	my ($self) = @_;
		3228
		3229	$self->{timer}->cancel;
		3230
		3231	$self->SUPER::DESTROY;
		3232	}
		3233
3019	#############################################################################	3234	#############################################################################
3020		3235
3021	package CFClient::UI::Root;	3236	package CFClient::UI::Inventory;
3022		3237
3023	our @ISA = CFClient::UI::Container::;	3238	our @ISA = CFClient::UI::ScrolledWindow::;
3024
3025	use CFClient::OpenGL;
3026		3239
3027	sub new {	3240	sub new {
3028	my $class = shift;	3241	my $class = shift;
3029		3242
3030	$class->SUPER::new (	3243	my $self = $class->SUPER::new (
		3244	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3245	@_,
		3246	);
		3247
		3248	$self
		3249	}
		3250
		3251	sub set_items {
		3252	my ($self, $items) = @_;
		3253
		3254	$self->{child}->clear;
		3255	return unless $items;
		3256
		3257	my @items = sort {
		3258	($a->{type} <=> $b->{type})
		3259	or ($a->{name} cmp $b->{name})
		3260	} @$items;
		3261
		3262	$self->{real_items} = \@items;
		3263
		3264	my $row = 0;
		3265	for my $item (@items) {
		3266	CFClient::Item::update_widgets $item;
		3267
		3268	$self->{child}->add (0, $row, $item->{face_widget});
		3269	$self->{child}->add (1, $row, $item->{desc_widget});
		3270	$self->{child}->add (2, $row, $item->{weight_widget});
		3271
		3272	$row++;
		3273	}
		3274	}
		3275
		3276	#############################################################################
		3277
		3278	package CFClient::UI::BindEditor;
		3279
		3280	our @ISA = CFClient::UI::FancyFrame::;
		3281
		3282	sub new {
		3283	my $class = shift;
		3284
		3285	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3286
		3287	$self->add (my $vb = new CFClient::UI::VBox);
		3288
		3289
		3290	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3291	text => "start recording",
		3292	tooltip => "Start/Stops recording of actions."
		3293	."All subsequent actions after the recording started will be captured."
		3294	."The actions are displayed after the record was stopped."
		3295	."To bind the action you have to click on the 'Bind' button",
		3296	on_activate => sub {
		3297	unless ($self->{recording}) {
		3298	$self->start;
		3299	} else {
		3300	$self->stop;
		3301	}
		3302	});
		3303
		3304	$vb->add (new CFClient::UI::Label text => "Actions:");
		3305	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3306
		3307	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3308	$vb->add (my $hb = new CFClient::UI::HBox);
		3309	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3310	$hb->add (new CFClient::UI::Button
		3311	text => "bind",
		3312	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3313	on_activate => sub {
		3314	$self->ask_for_bind;
		3315	});
		3316
		3317	$vb->add (my $hb = new CFClient::UI::HBox);
		3318	$hb->add (new CFClient::UI::Button
		3319	text => "ok",
		3320	expand => 1,
		3321	tooltip => "This closes the binding editor and saves the binding",
		3322	on_activate => sub {
		3323	$self->hide;
		3324	$self->commit;
		3325	});
		3326
		3327	$hb->add (new CFClient::UI::Button
		3328	text => "cancel",
		3329	expand => 1,
		3330	tooltip => "This closes the binding editor without saving",
		3331	on_activate => sub {
		3332	$self->hide;
		3333	$self->{binding_cancel}->()
		3334	if $self->{binding_cancel};
		3335	});
		3336
		3337	$self->update_binding_widgets;
		3338
		3339	$self
		3340	}
		3341
		3342	sub commit {
		3343	my ($self) = @_;
		3344	my ($mod, $sym, $cmds) = $self->get_binding;
		3345	if ($sym != 0 && @$cmds > 0) {
		3346	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3347	."'. Don't forget 'Save Config'!");
		3348	$self->{binding_change}->($mod, $sym, $cmds)
		3349	if $self->{binding_change};
		3350	} else {
		3351	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3352	$self->{binding_cancel}->()
		3353	if $self->{binding_cancel};
		3354	}
		3355	}
		3356
		3357	sub start {
		3358	my ($self) = @_;
		3359
		3360	$self->{rec_btn}->set_text ("stop recording");
		3361	$self->{recording} = 1;
		3362	$self->clear_command_list;
		3363	$::CONN->start_record if $::CONN;
		3364	}
		3365
		3366	sub stop {
		3367	my ($self) = @_;
		3368
		3369	$self->{rec_btn}->set_text ("start recording");
		3370	$self->{recording} = 0;
		3371
		3372	my $rec;
		3373	$rec = $::CONN->stop_record if $::CONN;
		3374	return unless ref $rec eq 'ARRAY';
		3375	$self->set_command_list ($rec);
		3376	}
		3377
		3378
		3379	sub ask_for_bind_and_commit {
		3380	my ($self) = @_;
		3381	$self->ask_for_bind (1);
		3382	}
		3383
		3384	sub ask_for_bind {
		3385	my ($self, $commit) = @_;
		3386
		3387	CFClient::Binder::open_binding_dialog (sub {
		3388	my ($mod, $sym) = @_;
		3389	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3390	$self->update_binding_widgets;
		3391	$self->commit if $commit;
		3392	});
		3393	}
		3394
		3395	# $mod and $sym are the modifiers and key symbol
		3396	# $cmds is a array ref of strings (the commands)
		3397	# $cb is the callback that is executed on OK
		3398	# $ccb is the callback that is executed on CANCEL and
		3399	# when the binding was unsuccessful on OK
		3400	sub set_binding {
		3401	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3402
		3403	$self->clear_command_list;
		3404	$self->{recording} = 0;
		3405	$self->{rec_btn}->set_text ("start recording");
		3406
		3407	$self->{binding} = [$mod, $sym];
		3408	$self->{commands} = $cmds;
		3409
		3410	$self->{binding_change} = $cb;
		3411	$self->{binding_cancel} = $ccb;
		3412
		3413	$self->update_binding_widgets;
		3414	}
		3415
		3416	# this is a shortcut method that asks for a binding
		3417	# and then just binds it.
		3418	sub do_quick_binding {
		3419	my ($self, $cmds) = @_;
		3420	$self->set_binding (undef, undef, $cmds, sub {
		3421	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3422	});
		3423	$self->ask_for_bind (1);
		3424	}
		3425
		3426	sub update_binding_widgets {
		3427	my ($self) = @_;
		3428	my ($mod, $sym, $cmds) = $self->get_binding;
		3429	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3430	$self->set_command_list ($cmds);
		3431	}
		3432
		3433	sub get_binding {
		3434	my ($self) = @_;
		3435	return (
		3436	$self->{binding}->[0],
		3437	$self->{binding}->[1],
		3438	[ grep { defined $_ } @{$self->{commands}} ]
		3439	);
		3440	}
		3441
		3442	sub clear_command_list {
		3443	my ($self) = @_;
		3444	$self->{cmdbox}->clear ();
		3445	}
		3446
		3447	sub set_command_list {
		3448	my ($self, $cmds) = @_;
		3449
		3450	$self->{cmdbox}->clear ();
		3451	$self->{commands} = $cmds;
		3452
		3453	my $idx = 0;
		3454
		3455	for (@$cmds) {
		3456	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3457
		3458	my $i = $idx;
		3459	$hb->add (new CFClient::UI::Label text => $_);
		3460	$hb->add (new CFClient::UI::Button
		3461	text => "delete",
		3462	tooltip => "Deletes the action from the record",
		3463	on_activate => sub {
		3464	$self->{cmdbox}->remove ($hb);
		3465	$cmds->[$i] = undef;
		3466	});
		3467
		3468
		3469	$idx++
		3470	}
		3471	}
		3472
		3473	#############################################################################
		3474
		3475	package CFClient::UI::SpellList;
		3476
		3477	our @ISA = CFClient::UI::Table::;
		3478
		3479	sub new {
		3480	my $class = shift;
		3481
		3482	my $self = $class->SUPER::new (
		3483	binding => [],
		3484	commands => [],
3031	@_,	3485	@_,
3032	)	3486	)
3033	}	3487	}
3034		3488
3035	sub configure {	3489	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3036	my ($self, $x, $y, $w, $h) = @_;	3490	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.");
		3491	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3492	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.");
		3493	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3494	"<b>Damage</b>. The amount of damage the spell deals when it hits.");
3037		3495
3038	$self->{w} = $w;	3496	sub rebuild_spell_list {
3039	$self->{h} = $h;	3497	my ($self) = @_;
3040	}
3041		3498
3042	sub check_size {	3499	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3500	$self->clear;
		3501
		3502	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name");
		3503	$self->add (2, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3504	$self->add (3, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3505	$self->add (4, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3506
		3507	my $row = 0;
		3508
		3509	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3510	my $spell = $self->{spell}{$_};
		3511
		3512	$row++;
		3513
		3514	$self->add (0, $row, new CFClient::UI::Face
		3515	face => $spell->{face},
		3516	can_hover => 1,
		3517	can_events => 1,
		3518	tooltip => $spell->{message},
		3519	);
		3520
		3521	$self->add (1, $row, new CFClient::UI::Label
		3522	expand => 1,
		3523	text => $spell->{name},
		3524	can_hover => 1,
		3525	can_events => 1,
		3526	tooltip => $spell->{message},
		3527	);
		3528
		3529	$self->add (2, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3530	$self->add (3, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3531	$self->add (4, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3532
		3533	# TODO: should be done via popup
		3534	$self->add (5, $row, new CFClient::UI::Button
		3535	text => "bind",
		3536	tooltip => "bind spell readying (cast command) to key",
		3537	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) },
		3538	);
		3539	}
		3540	});
		3541	}
		3542
		3543	sub add_spell {
3043	my ($self) = @_;	3544	my ($self, $spell) = @_;
3044		3545
3045	$self->size_allocate ($self->{w}, $self->{h})	3546	$self->{spell}->{$spell->{name}} = $spell;
3046	if $self->{w};	3547	$self->rebuild_spell_list;
		3548	}
		3549
		3550	sub remove_spell {
		3551	my ($self, $spell) = @_;
		3552
		3553	delete $self->{spell}->{$spell->{name}};
		3554	$self->rebuild_spell_list;
		3555	}
		3556
		3557	#############################################################################
		3558
		3559	package CFClient::UI::Root;
		3560
		3561	our @ISA = CFClient::UI::Container::;
		3562
		3563	use List::Util qw(min max);
		3564
		3565	use CFClient::OpenGL;
		3566
		3567	sub new {
		3568	my $class = shift;
		3569
		3570	my $self = $class->SUPER::new (
		3571	visible => 1,
		3572	@_,
		3573	);
		3574
		3575	Scalar::Util::weaken ($self->{root} = $self);
		3576
		3577	$self
3047	}	3578	}
3048		3579
3049	sub size_request {	3580	sub size_request {
3050	my ($self) = @_;	3581	my ($self) = @_;
3051		3582
3052	($self->{w}, $self->{h})	3583	($self->{w}, $self->{h})
		3584	}
		3585
		3586	sub _to_pixel {
		3587	my ($coord, $size, $max) = @_;
		3588
		3589	$coord =
		3590	$coord eq "center" ? ($max - $size) * 0.5
		3591	: $coord eq "max" ? $max
		3592	: $coord;
		3593
		3594	$coord = 0 if $coord < 0;
		3595	$coord = $max - $size if $coord > $max - $size;
		3596
		3597	int $coord + 0.5
3053	}	3598	}
3054		3599
3055	sub size_allocate {	3600	sub size_allocate {
3056	my ($self, $w, $h) = @_;	3601	my ($self, $w, $h) = @_;
3057		3602
3058	my $old_w = $self->{old_w}; $self->{old_w} = $w;
3059	my $old_h = $self->{old_h}; $self->{old_h} = $h;
3060
3061	CFClient::UI::rescale_widgets $w / $old_w, $h / $old_h
3062	if $old_w && $old_h && ($old_w != $w || $old_h != $h);
3063
3064	for my $child ($self->children) {	3603	for my $child ($self->children) {
3065	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3604	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3066		3605
3067	$X = $child->{req_x} > 0 ? $child->{req_x} : $w - $W - $child->{req_x} + 1	3606	$X = $child->{force_x} if exists $child->{force_x};
3068	if exists $child->{req_x};	3607	$Y = $child->{force_y} if exists $child->{force_y};
3069		3608
3070	$Y = $child->{req_y} > 0 ? $child->{req_y} : $h - $H - $child->{req_y} + 1	3609	$X = _to_pixel $X, $W, $self->{w};
3071	if exists $child->{req_y};	3610	$Y = _to_pixel $Y, $H, $self->{h};
3072
3073	$X = List::Util::max 0, List::Util::min $w - $W, int $X + 0.5;
3074	$Y = List::Util::max 0, List::Util::min $h - $H, int $Y + 0.5;
3075		3611
3076	$child->configure ($X, $Y, $W, $H);	3612	$child->configure ($X, $Y, $W, $H);
3077	}	3613	}
3078	}	3614	}
3079		3615
…		…
3090	}	3626	}
3091		3627
3092	sub update {	3628	sub update {
3093	my ($self) = @_;	3629	my ($self) = @_;
3094		3630
3095	$self->check_size;
3096	$::WANT_REFRESH++;	3631	$::WANT_REFRESH++;
3097	}	3632	}
3098		3633
3099	sub add {	3634	sub add {
3100	my ($self, @children) = @_;	3635	my ($self, @children) = @_;
3101		3636
3102	for (my @widgets = @children; my $w = pop @widgets; ) {
3103	push @widgets, $w->children;
3104	$w->{root} = $self;
3105	$w->{visible} = 1;
3106	}
3107
3108	for my $child (@children) {
3109	$child->{toplevel} = 1;	3637	$_->{is_toplevel} = 1
3110		3638	for @children;
3111	# integerise window positions
3112	$child->{x} = int $child->{x};
3113	$child->{y} = int $child->{y};
3114	}
3115		3639
3116	$self->SUPER::add (@children);	3640	$self->SUPER::add (@children);
3117	}	3641	}
3118		3642
3119	sub remove {	3643	sub remove {
3120	my ($self, @children) = @_;	3644	my ($self, @children) = @_;
3121		3645
3122	$self->SUPER::remove (@children);	3646	$self->SUPER::remove (@children);
		3647
		3648	delete $self->{is_toplevel}
		3649	for @children;
3123		3650
3124	while (@children) {	3651	while (@children) {
3125	my $w = pop @children;	3652	my $w = pop @children;
3126	push @children, $w->children;	3653	push @children, $w->children;
3127	delete $w->{visible};	3654	$w->set_invisible;
3128	}	3655	}
3129	}	3656	}
3130		3657
3131	sub on_refresh {	3658	sub on_refresh {
3132	my ($self, $id, $cb) = @_;	3659	my ($self, $id, $cb) = @_;
…		…
3146	while ($self->{refresh_hook}) {	3673	while ($self->{refresh_hook}) {
3147	$_->()	3674	$_->()
3148	for values %{delete $self->{refresh_hook}};	3675	for values %{delete $self->{refresh_hook}};
3149	}	3676	}
3150		3677
3151	if ($self->{check_size}) {	3678	if ($self->{realloc}) {
3152	my @queue = ([], []);	3679	my %queue;
		3680	my @queue;
		3681	my $widget;
3153		3682
3154	for (;;) {	3683	outer:
3155	if ($self->{check_size}) {	3684	while () {
3156	# heuristic: check containers last	3685	if (my $realloc = delete $self->{realloc}) {
3157	push @{ $queue[ ! ! $_->isa ("CFClient::UI::Container") ] }, $_	3686	for $widget (values %$realloc) {
3158	for values %{delete $self->{check_size}}	3687	$widget->{visible} or next; # do not resize invisible widgets
		3688
		3689	$queue{$widget+0}++ and next; # duplicates are common
		3690
		3691	push @{ $queue[$widget->{visible}] }, $widget;
		3692	}
3159	}	3693	}
3160		3694
3161	my $widget = (pop @{ $queue[0] }) || (pop @{ $queue[1] }) || last;	3695	while () {
		3696	@queue or last outer;
3162		3697
3163	my ($w, $h) = $widget->{user_w} && $widget->{user_h}	3698	$widget = pop @{ $queue[-1] || [] }
3164	? @$widget{qw(user_w user_h)}	3699	and last;
3165	: $widget->size_request;
3166
3167	if (delete $widget->{force_alloc}
3168	or $w != $widget->{req_w} or $h != $widget->{req_h}) {
3169	Carp::confess "$widget: size_request is negative" if $w < 0 || $h < 0;#d#
3170		3700
		3701	pop @queue;
		3702	}
		3703
		3704	delete $queue{$widget+0};
		3705
		3706	my ($w, $h) = $widget->size_request;
		3707
		3708	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3709	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3710
		3711	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3712	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3713
		3714	$w = $widget->{force_w} if exists $widget->{force_w};
		3715	$h = $widget->{force_h} if exists $widget->{force_h};
		3716
		3717	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3718	|| delete $widget->{force_realloc}) {
3171	$widget->{req_w} = $w;	3719	$widget->{req_w} = $w;
3172	$widget->{req_h} = $h;	3720	$widget->{req_h} = $h;
3173		3721
3174	$self->{size_alloc}{$widget} = [$widget, $widget->{w} || $w, $widget->{h} || $h];	3722	$self->{size_alloc}{$widget+0} = $widget;
3175		3723
3176	$widget->{parent}->check_size
3177	if $widget->{parent};	3724	if (my $parent = $widget->{parent}) {
		3725	$self->{realloc}{$parent+0} = $parent
		3726	unless $queue{$parent+0};
		3727
		3728	$parent->{force_size_alloc} = 1;
		3729	$self->{size_alloc}{$parent+0} = $parent;
		3730	}
3178	}	3731	}
		3732
		3733	delete $self->{realloc}{$widget+0};
3179	}	3734	}
3180	}	3735	}
3181		3736
3182	while ($self->{size_alloc}) {	3737	while (my $size_alloc = delete $self->{size_alloc}) {
3183	for (values %{delete $self->{size_alloc}}) {	3738	my @queue = sort { $b->{visible} <=> $a->{visible} }
3184	my ($widget, $w, $h) = @$_;	3739	values %$size_alloc;
		3740
		3741	while () {
		3742	my $widget = pop @queue || last;
		3743
		3744	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3185		3745
3186	$w = 0 if $w < 0;	3746	$w = 0 if $w < 0;
3187	$h = 0 if $h < 0;	3747	$h = 0 if $h < 0;
3188		3748
		3749	$w = int $w + 0.5;
		3750	$h = int $h + 0.5;
		3751
		3752	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3753	$widget->{old_w} = $widget->{w};
		3754	$widget->{old_h} = $widget->{h};
		3755
3189	$widget->{w} = $w;	3756	$widget->{w} = $w;
3190	$widget->{h} = $h;	3757	$widget->{h} = $h;
3191	$widget->size_allocate ($w, $h);	3758
3192	$widget->emit (size_allocate => $w, $h);	3759	$widget->emit (size_allocate => $w, $h);
		3760	}
3193	}	3761	}
3194	}	3762	}
3195		3763
3196	while ($self->{post_alloc_hook}) {	3764	while ($self->{post_alloc_hook}) {
3197	$_->()	3765	$_->()
3198	for values %{delete $self->{post_alloc_hook}};	3766	for values %{delete $self->{post_alloc_hook}};
3199	}	3767	}
		3768
3200		3769
3201	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3770	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3202	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3771	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3203	glClear GL_COLOR_BUFFER_BIT;	3772	glClear GL_COLOR_BUFFER_BIT;
3204		3773
…		…
3206	glLoadIdentity;	3775	glLoadIdentity;
3207	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3776	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3208	glMatrixMode GL_MODELVIEW;	3777	glMatrixMode GL_MODELVIEW;
3209	glLoadIdentity;	3778	glLoadIdentity;
3210		3779
		3780	{
		3781	package CFClient::UI::Base;
		3782
		3783	($draw_x, $draw_y, $draw_w, $draw_h) =
		3784	(0, 0, $self->{w}, $self->{h});
		3785	}
		3786
3211	$self->_draw;	3787	$self->_draw;
3212	}	3788	}
3213		3789
3214	#############################################################################	3790	#############################################################################
3215		3791

Diff Legend

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