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.257 by root, Tue May 30 02:22:02 2006 UTC vs.
Revision 1.308 by root, Mon Jun 19 05:18:14 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;
10	use CFClient::Texture;	11	use CFClient::Texture;
11		12
12	our ($FOCUS, $HOVER, $GRAB); # various widgets	13	our ($FOCUS, $HOVER, $GRAB); # various widgets
…		…
15	our $ROOT;	16	our $ROOT;
16	our $TOOLTIP;	17	our $TOOLTIP;
17	our $BUTTON_STATE;	18	our $BUTTON_STATE;
18		19
19	our %WIDGET; # all widgets, weak-referenced	20	our %WIDGET; # all widgets, weak-referenced
		21
		22	our $TOOLTIP_WATCHER = Event->idle (min => 1/60, cb => sub {
		23	if (!$GRAB) {
		24	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
		25	if (length $widget->{tooltip}) {
		26	if ($TOOLTIP->{owner} != $widget) {
		27	$TOOLTIP->hide;
		28
		29	$TOOLTIP->{owner} = $widget;
		30
		31	return if $ENV{CFPLUS_DEBUG} & 8;
		32
		33	my $tip = $widget->{tooltip};
		34
		35	$tip = $tip->($widget) if CODE:: eq ref $tip;
		36
		37	$TOOLTIP->set_tooltip_from ($widget);
		38	$TOOLTIP->show;
		39	}
		40
		41	return;
		42	}
		43	}
		44	}
		45
		46	$TOOLTIP->hide;
		47	delete $TOOLTIP->{owner};
		48	});
20		49
21	sub get_layout {	50	sub get_layout {
22	my $layout;	51	my $layout;
23		52
24	for (grep { $_->{name} } values %WIDGET) {	53	for (grep { $_->{name} } values %WIDGET) {
…		…
26		55
27	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;	56	$win->{x} = ($_->{x} + $_->{w} * 0.5) / $::WIDTH if $_->{x} =~ /^[0-9.]+$/;
28	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;	57	$win->{y} = ($_->{y} + $_->{h} * 0.5) / $::HEIGHT if $_->{y} =~ /^[0-9.]+$/;
29	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};	58	$win->{w} = $_->{w} / $::WIDTH if defined $_->{w};
30	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};	59	$win->{h} = $_->{h} / $::HEIGHT if defined $_->{h};
		60
		61	$win->{show} = $_->{visible} && $_->{is_toplevel};
31	}	62	}
32		63
33	$layout	64	$layout
34	}	65	}
35		66
36	sub set_layout {	67	sub set_layout {
37	my ($layout) = @_;	68	my ($layout) = @_;
		69
38	$LAYOUT = $layout;	70	$LAYOUT = $layout;
39	}
40
41	sub check_tooltip {
42	if (!$GRAB) {
43	for (my $widget = $HOVER; $widget; $widget = $widget->{parent}) {
44	if (length $widget->{tooltip}) {
45
46	if ($TOOLTIP->{owner} != $widget) {
47	$TOOLTIP->hide;
48
49	$TOOLTIP->{owner} = $widget;
50
51	my $tip = $widget->{tooltip};
52
53	$tip = $tip->($widget) if CODE:: eq ref $tip;
54
55	$TOOLTIP->set_tooltip_from ($widget);
56	$TOOLTIP->show;
57	}
58
59	return;
60	}
61	}
62	}
63
64	$TOOLTIP->hide;
65	delete $TOOLTIP->{owner};
66	}	71	}
67		72
68	# class methods for events	73	# class methods for events
69	sub feed_sdl_key_down_event {	74	sub feed_sdl_key_down_event {
70	$FOCUS->emit (key_down => $_[0])	75	$FOCUS->emit (key_down => $_[0])
…		…
84	my $widget = $ROOT->find_widget ($x, $y);	89	my $widget = $ROOT->find_widget ($x, $y);
85		90
86	$GRAB = $widget;	91	$GRAB = $widget;
87	$GRAB->update if $GRAB;	92	$GRAB->update if $GRAB;
88		93
89	check_tooltip;	94	$TOOLTIP_WATCHER->cb->();
90	}	95	}
91		96
92	$BUTTON_STATE |= 1 << ($ev->{button} - 1);	97	$BUTTON_STATE |= 1 << ($ev->{button} - 1);
93		98
94	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))
…		…
109	if (!$BUTTON_STATE) {	114	if (!$BUTTON_STATE) {
110	my $grab = $GRAB; undef $GRAB;	115	my $grab = $GRAB; undef $GRAB;
111	$grab->update if $grab;	116	$grab->update if $grab;
112	$GRAB->update if $GRAB;	117	$GRAB->update if $GRAB;
113		118
114	check_tooltip;	119	$TOOLTIP_WATCHER->cb->();
115	}	120	}
116	}	121	}
117		122
118	sub feed_sdl_motion_event {	123	sub feed_sdl_motion_event {
119	my ($ev) = @_;	124	my ($ev) = @_;
…		…
125	my $hover = $HOVER; $HOVER = $widget;	130	my $hover = $HOVER; $HOVER = $widget;
126		131
127	$hover->update if $hover && $hover->{can_hover};	132	$hover->update if $hover && $hover->{can_hover};
128	$HOVER->update if $HOVER && $HOVER->{can_hover};	133	$HOVER->update if $HOVER && $HOVER->{can_hover};
129		134
130	check_tooltip;	135	$TOOLTIP_WATCHER->start;
131	}	136	}
132		137
133	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))	138	$HOVER->emit (mouse_motion => $ev, $HOVER->coord2local ($x, $y))
134	if $HOVER;	139	if $HOVER;
135	}	140	}
…		…
167	sub rescale_widgets {	172	sub rescale_widgets {
168	my ($sx, $sy) = @_;	173	my ($sx, $sy) = @_;
169		174
170	for my $widget (values %WIDGET) {	175	for my $widget (values %WIDGET) {
171	if ($widget->{is_toplevel}) {	176	if ($widget->{is_toplevel}) {
172	$widget->{x} += $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;	177	$widget->{x} += int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
173	$widget->{y} += $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;	178	$widget->{y} += int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
174		179
175	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;	180	$widget->{x} = int 0.5 + $widget->{x} * $sx if $widget->{x} =~ /^[0-9.]+$/;
176	$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};
177	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};	182	$widget->{force_w} = int 0.5 + $widget->{force_w} * $sx if exists $widget->{force_w};
178	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;	183	$widget->{y} = int 0.5 + $widget->{y} * $sy if $widget->{y} =~ /^[0-9.]+$/;
179	$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};
180	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};	185	$widget->{force_h} = int 0.5 + $widget->{force_h} * $sy if exists $widget->{force_h};
181		186
182	$widget->{x} -= $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;	187	$widget->{x} -= int $widget->{w} * 0.5 if $widget->{x} =~ /^[0-9.]+$/;
183	$widget->{y} -= $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;	188	$widget->{y} -= int $widget->{h} * 0.5 if $widget->{y} =~ /^[0-9.]+$/;
184		189
185	}	190	}
186	}	191	}
187		192
188	reconfigure_widgets;	193	reconfigure_widgets;
…		…
207	h => undef,	212	h => undef,
208	can_events => 1,	213	can_events => 1,
209	@_	214	@_
210	}, $class;	215	}, $class;
211		216
212	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
213	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{w} if exists $layout->{x};
214	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{h} if exists $layout->{y};
215	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{w} if exists $layout->{w};
216	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{h} if exists $layout->{h};
217
218	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
219	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
220	}
221
222	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	217	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);
223		218
224	for (keys %$self) {	219	for (keys %$self) {
225	if (/^on_(.*)$/) {	220	if (/^on_(.*)$/) {
226	$self->connect ($1 => delete $self->{$_});	221	$self->connect ($1 => delete $self->{$_});
227	}	222	}
228	}	223	}
229		224
		225	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {
		226	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};
		227	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};
		228	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};
		229	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};
		230
		231	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
		232	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
		233
		234	$self->show if $layout->{show};
		235	}
		236
230	$self	237	$self
231	}	238	}
232		239
233	sub destroy {	240	sub destroy {
234	my ($self) = @_;	241	my ($self) = @_;
…		…
265		272
266	return unless $self->{visible};	273	return unless $self->{visible};
267		274
268	$_->set_invisible for $self->children;	275	$_->set_invisible for $self->children;
269		276
		277	delete $self->{visible};
270	delete $self->{root};	278	delete $self->{root};
271	delete $self->{visible};
272		279
273	undef $GRAB if $GRAB == $self;	280	undef $GRAB if $GRAB == $self;
274	undef $HOVER if $HOVER == $self;	281	undef $HOVER if $HOVER == $self;
275		282
276	CFClient::UI::check_tooltip	283	$CFClient::UI::TOOLTIP_WATCHER->cb->()
277	if $TOOLTIP->{owner} == $self;	284	if $TOOLTIP->{owner} == $self;
278		285
279	$self->focus_out;	286	$self->emit ("focus_out");
280
281	$self->emit (visibility_change => 0);	287	$self->emit (visibility_change => 0);
282	}	288	}
283		289
284	sub set_visibility {	290	sub set_visibility {
285	my ($self, $visible) = @_;	291	my ($self, $visible) = @_;
…		…
308	}	314	}
309		315
310	sub move_abs {	316	sub move_abs {
311	my ($self, $x, $y, $z) = @_;	317	my ($self, $x, $y, $z) = @_;
312		318
313	$self->{x} = List::Util::max 0, int $x;	319	$self->{x} = List::Util::max 0, List::Util::min $self->{root}{w} - $self->{w}, int $x;
314	$self->{y} = List::Util::max 0, int $y;	320	$self->{y} = List::Util::max 0, List::Util::min $self->{root}{h} - $self->{h}, int $y;
315	$self->{z} = $z if defined $z;	321	$self->{z} = $z if defined $z;
316		322
317	$self->update;	323	$self->update;
318	}	324	}
319		325
…		…
350	$self->{x} = $x;	356	$self->{x} = $x;
351	$self->{y} = $y;	357	$self->{y} = $y;
352	$self->update;	358	$self->update;
353	}	359	}
354		360
355	if ($self->{w} != $w || $self->{h} != $h) {	361	if ($self->{alloc_w} != $w || $self->{alloc_h} != $h) {
356	return unless $self->{visible};	362	return unless $self->{visible};
357		363
		364	$self->{alloc_w} = $w;
		365	$self->{alloc_h} = $h;
		366
358	$self->{root}->{size_alloc}{$self+0} = [$self, $w, $h];	367	$self->{root}{size_alloc}{$self+0} = $self;
359	}	368	}
360	}
361
362	sub size_allocate {
363	# nothing to be done
364	}	369	}
365		370
366	sub children {	371	sub children {
		372	# nop
		373	}
		374
		375	sub visible_children {
		376	$_[0]->children
367	}	377	}
368		378
369	sub set_max_size {	379	sub set_max_size {
370	my ($self, $w, $h) = @_;	380	my ($self, $w, $h) = @_;
371		381
372	delete $self->{max_w}; $self->{max_w} = $w if $w;	382	$self->{max_w} = int $w if defined $w;
373	delete $self->{max_h}; $self->{max_h} = $h if $h;	383	$self->{max_h} = int $h if defined $h;
		384
		385	$self->realloc;
374	}	386	}
375		387
376	sub set_tooltip {	388	sub set_tooltip {
377	my ($self, $tooltip) = @_;	389	my ($self, $tooltip) = @_;
378		390
…		…
383		395
384	$self->{tooltip} = $tooltip;	396	$self->{tooltip} = $tooltip;
385		397
386	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	398	if ($CFClient::UI::TOOLTIP->{owner} == $self) {
387	delete $CFClient::UI::TOOLTIP->{owner};	399	delete $CFClient::UI::TOOLTIP->{owner};
388	CFClient::UI::check_tooltip;	400	$CFClient::UI::TOOLTIP_WATCHER->cb->();
389	}	401	}
390	}	402	}
391		403
392	# translate global coordinates to local coordinate system	404	# translate global coordinates to local coordinate system
393	sub coord2local {	405	sub coord2local {
…		…
401	my ($self, $x, $y) = @_;	413	my ($self, $x, $y) = @_;
402		414
403	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	415	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
404	}	416	}
405		417
406	sub focus_in {	418	sub invoke_focus_in {
407	my ($self) = @_;	419	my ($self) = @_;
408		420
409	return if $FOCUS == $self;	421	return if $FOCUS == $self;
410	return unless $self->{can_focus};	422	return unless $self->{can_focus};
411		423
412	my $focus = $FOCUS; $FOCUS = $self;	424	my $focus = $FOCUS; $FOCUS = $self;
413		425
414	$self->_emit (focus_in => $focus);
415
416	$focus->update if $focus;	426	$focus->update if $focus;
417	$FOCUS->update;	427	$FOCUS->update;
418	}
419		428
		429	0
		430	}
		431
420	sub focus_out {	432	sub invoke_focus_out {
421	my ($self) = @_;	433	my ($self) = @_;
422		434
423	return unless $FOCUS == $self;	435	return unless $FOCUS == $self;
424		436
425	my $focus = $FOCUS; undef $FOCUS;	437	my $focus = $FOCUS; undef $FOCUS;
426		438
427	$self->_emit (focus_out => $focus);
428
429	$focus->update if $focus; #?	439	$focus->update if $focus; #?
430		440
431	$::MAPWIDGET->focus_in #d# focus mapwidget if no other widget has focus	441	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
432	unless $FOCUS;	442	unless $FOCUS;
433	}
434		443
		444	0
		445	}
		446
		447	sub grab_focus {
		448	my ($self) = @_;
		449
		450	$self->emit ("focus_in");
		451	}
		452
435	sub mouse_motion { }	453	sub invoke_mouse_motion { 1 }
436	sub button_up { }	454	sub invoke_button_up { 1 }
437	sub key_down { }	455	sub invoke_key_down { 1 }
438	sub key_up { }	456	sub invoke_key_up { 1 }
439		457
440	sub button_down {	458	sub invoke_button_down {
441	my ($self, $ev, $x, $y) = @_;	459	my ($self, $ev, $x, $y) = @_;
442		460
443	$self->focus_in;	461	$self->grab_focus;
444	}
445		462
446	sub w { $_[0]{w} = $_[1] if @_ > 1; $_[0]{w} }	463	1
447	sub h { $_[0]{h} = $_[1] if @_ > 1; $_[0]{h} }	464	}
448	sub x { $_[0]{x} = $_[1] if @_ > 1; $_[0]{x} }	465
449	sub y { $_[0]{y} = $_[1] if @_ > 1; $_[0]{y} }	466	sub connect {
450	sub z { $_[0]{z} = $_[1] if @_ > 1; $_[0]{z} }	467	my ($self, $signal, $cb) = @_;
		468
		469	push @{ $self->{signal_cb}{$signal} }, $cb;
		470	}
		471
		472	sub emit {
		473	my ($self, $signal, @args) = @_;
		474
		475	#d##TODO# stop propagating at first true, do not use sum
		476	(List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before
		477	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure
		478	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent
		479	}
451		480
452	sub find_widget {	481	sub find_widget {
453	my ($self, $x, $y) = @_;	482	my ($self, $x, $y) = @_;
454		483
455	return () unless $self->{can_events};	484	return () unless $self->{can_events};
…		…
463		492
464	sub set_parent {	493	sub set_parent {
465	my ($self, $parent) = @_;	494	my ($self, $parent) = @_;
466		495
467	Scalar::Util::weaken ($self->{parent} = $parent);	496	Scalar::Util::weaken ($self->{parent} = $parent);
468
469	$self->set_visible if $parent->{visible};	497	$self->set_visible if $parent->{visible};
470	}	498	}
471		499
472	sub connect {
473	my ($self, $signal, $cb) = @_;
474
475	push @{ $self->{signal_cb}{$signal} }, $cb;
476	}
477
478	sub _emit {
479	my ($self, $signal, @args) = @_;
480
481	List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}
482	}
483
484	sub emit {
485	my ($self, $signal, @args) = @_;
486
487	$self->_emit ($signal, @args)
488	|| $self->$signal (@args);
489	}
490
491	sub visibility_change {
492	#my ($self, $visible) = @_;
493	}
494
495	sub realloc {	500	sub realloc {
496	my ($self) = @_;	501	my ($self) = @_;
497		502
498	if ($self->{visible}) {	503	if ($self->{visible}) {
499	return if $self->{root}{realloc}{$self};	504	return if $self->{root}{realloc}{$self+0};
500		505
501	$self->{root}{realloc}{$self} = $self;	506	$self->{root}{realloc}{$self+0} = $self;
502	$self->{root}->update;	507	$self->{root}->update;
503	} else {	508	} else {
504	delete $self->{req_w};	509	delete $self->{req_w};
		510	delete $self->{req_h};
505	}	511	}
506	}	512	}
507		513
508	sub update {	514	sub update {
509	my ($self) = @_;	515	my ($self) = @_;
…		…
517		523
518	$self->realloc;	524	$self->realloc;
519	$self->update;	525	$self->update;
520	}	526	}
521		527
		528	# using global variables seems a bit hacky, but passing through all drawing
		529	# functions seems pointless.
		530	our ($draw_x, $draw_y, $draw_w, $draw_h); # screen rectangle being drawn
		531
522	sub draw {	532	sub draw {
523	my ($self) = @_;	533	my ($self) = @_;
524		534
525	return unless $self->{h} && $self->{w};	535	return unless $self->{h} && $self->{w};
		536
		537	# update screen rectangle
		538	local $draw_x = $draw_x + $self->{x};
		539	local $draw_y = $draw_y + $self->{y};
		540	local $draw_w = $draw_x + $self->{w};
		541	local $draw_h = $draw_y + $self->{h};
		542
		543	# skip widgets that are entirely outside the drawing area
		544	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
		545	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
526		546
527	glPushMatrix;	547	glPushMatrix;
528	glTranslate $self->{x}, $self->{y}, 0;	548	glTranslate $self->{x}, $self->{y}, 0;
529	$self->_draw;
530	glPopMatrix;
531		549
532	if ($self == $HOVER && $self->{can_hover}) {	550	if ($self == $HOVER && $self->{can_hover}) {
533	my ($x, $y) = @$self{qw(x y)};
534
535	glColor 1, 0.8, 0.5, 0.2;	551	glColor 1*0.2, 0.8*0.2, 0.5*0.2, 0.2;
536	glEnable GL_BLEND;	552	glEnable GL_BLEND;
537	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	553	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
538	glBegin GL_QUADS;	554	glBegin GL_QUADS;
539	glVertex $x , $y;	555	glVertex 0 , 0;
540	glVertex $x + $self->{w}, $y;	556	glVertex $self->{w}, 0;
541	glVertex $x + $self->{w}, $y + $self->{h};	557	glVertex $self->{w}, $self->{h};
542	glVertex $x , $y + $self->{h};	558	glVertex 0 , $self->{h};
543	glEnd;	559	glEnd;
544	glDisable GL_BLEND;	560	glDisable GL_BLEND;
545	}	561	}
546		562
547	if ($ENV{CFPLUS_DEBUG}) {	563	if ($ENV{CFPLUS_DEBUG} & 1) {
548	glPushMatrix;	564	glPushMatrix;
549	glColor 1, 1, 0, 1;	565	glColor 1, 1, 0, 1;
550	glTranslate $self->{x} + 0.375, $self->{y} + 0.375;	566	glTranslate 0.375, 0.375;
551	glBegin GL_LINE_LOOP;	567	glBegin GL_LINE_LOOP;
552	glVertex 0 , 0;	568	glVertex 0 , 0;
553	glVertex $self->{w} - 1, 0;	569	glVertex $self->{w} - 1, 0;
554	glVertex $self->{w} - 1, $self->{h} - 1;	570	glVertex $self->{w} - 1, $self->{h} - 1;
555	glVertex 0 , $self->{h} - 1;	571	glVertex 0 , $self->{h} - 1;
556	glEnd;	572	glEnd;
557	glPopMatrix;	573	glPopMatrix;
558	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	574	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
559	}	575	}
		576
		577	$self->_draw;
		578	glPopMatrix;
560	}	579	}
561		580
562	sub _draw {	581	sub _draw {
563	my ($self) = @_;	582	my ($self) = @_;
564		583
…		…
567		586
568	sub DESTROY {	587	sub DESTROY {
569	my ($self) = @_;	588	my ($self) = @_;
570		589
571	delete $WIDGET{$self+0};	590	delete $WIDGET{$self+0};
572	#$self->deactivate;	591
		592	eval { $self->destroy };
		593	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
573	}	594	}
574		595
575	#############################################################################	596	#############################################################################
576		597
577	package CFClient::UI::DrawBG;	598	package CFClient::UI::DrawBG;
…		…
602		623
603	if ($color && (@$color < 4 || $color->[3])) {	624	if ($color && (@$color < 4 || $color->[3])) {
604	my ($w, $h) = @$self{qw(w h)};	625	my ($w, $h) = @$self{qw(w h)};
605		626
606	glEnable GL_BLEND;	627	glEnable GL_BLEND;
607	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	628	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
608	glColor @$color;	629	glColor_premultiply @$color;
609		630
610	glBegin GL_QUADS;	631	glBegin GL_QUADS;
611	glVertex 0 , 0;	632	glVertex 0 , 0;
612	glVertex 0 , $h;	633	glVertex 0 , $h;
613	glVertex $w, $h;	634	glVertex $w, $h;
…		…
644	our @ISA = CFClient::UI::Base::;	665	our @ISA = CFClient::UI::Base::;
645		666
646	sub new {	667	sub new {
647	my ($class, %arg) = @_;	668	my ($class, %arg) = @_;
648		669
649	my $children = delete $arg{children} || [];	670	my $children = delete $arg{children};
650		671
651	my $self = $class->SUPER::new (	672	my $self = $class->SUPER::new (
652	children => [],	673	children => [],
653	can_events => 0,	674	can_events => 0,
654	%arg,	675	%arg,
655	);	676	);
		677
656	$self->add ($_) for @$children;	678	$self->add (@$children)
		679	if $children;
657		680
658	$self	681	$self
659	}	682	}
660		683
661	sub add {	684	sub add {
…		…
709	$x -= $self->{x};	732	$x -= $self->{x};
710	$y -= $self->{y};	733	$y -= $self->{y};
711		734
712	my $res;	735	my $res;
713		736
714	for (reverse @{ $self->{children} }) {	737	for (reverse $self->visible_children) {
715	$res = $_->find_widget ($x, $y)	738	$res = $_->find_widget ($x, $y)
716	and return $res;	739	and return $res;
717	}	740	}
718		741
719	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})	742	$self->SUPER::find_widget ($x + $self->{x}, $y + $self->{y})
…		…
740	}	763	}
741		764
742	sub add {	765	sub add {
743	my ($self, $child) = @_;	766	my ($self, $child) = @_;
744		767
745	$self->{children} = [];	768	$self->SUPER::remove ($_) for @{ $self->{children} };
746
747	$self->SUPER::add ($child);	769	$self->SUPER::add ($child);
748	}	770	}
749		771
750	sub remove {	772	sub remove {
751	my ($self, $widget) = @_;	773	my ($self, $widget) = @_;
…		…
760		782
761	sub size_request {	783	sub size_request {
762	$_[0]{children}[0]->size_request	784	$_[0]{children}[0]->size_request
763	}	785	}
764		786
765	sub size_allocate {	787	sub invoke_size_allocate {
766	my ($self, $w, $h, $changed) = @_;	788	my ($self, $w, $h) = @_;
767		789
768	$self->{children}[0]->configure (0, 0, $w, $h);	790	$self->{children}[0]->configure (0, 0, $w, $h);
		791
		792	1
769	}	793	}
770		794
771	#############################################################################	795	#############################################################################
		796
		797	# back-buffered drawing area
772		798
773	package CFClient::UI::Window;	799	package CFClient::UI::Window;
774		800
775	our @ISA = CFClient::UI::Bin::;	801	our @ISA = CFClient::UI::Bin::;
776		802
…		…
787		813
788	$ROOT->on_post_alloc ($self => sub { $self->render_child });	814	$ROOT->on_post_alloc ($self => sub { $self->render_child });
789	$self->SUPER::update;	815	$self->SUPER::update;
790	}	816	}
791		817
792	sub size_allocate {	818	sub invoke_size_allocate {
793	my ($self, $w, $h, $changed) = @_;	819	my ($self, $w, $h) = @_;
794		820
795	$self->SUPER::size_allocate ($w, $h, $changed);
796	$self->update	821	$self->update;
797	if $changed;	822
		823	$self->SUPER::invoke_size_allocate ($w, $h)
798	}	824	}
799		825
800	sub _render {	826	sub _render {
		827	my ($self) = @_;
		828
801	$_[0]{children}[0]->draw;	829	$self->{children}[0]->draw;
802	}	830	}
803		831
804	sub render_child {	832	sub render_child {
805	my ($self) = @_;	833	my ($self) = @_;
806		834
807	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	835	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {
808	glClearColor 0, 0, 0, 0;	836	glClearColor 0, 0, 0, 0;
809	glClear GL_COLOR_BUFFER_BIT;	837	glClear GL_COLOR_BUFFER_BIT;
810		838
		839	{
		840	package CFClient::UI::Base;
		841
		842	($draw_x, $draw_y, $draw_w, $draw_h) =
		843	(0, 0, $self->{w}, $self->{h});
		844	}
		845
811	$self->_render;	846	$self->_render;
812	};	847	};
813	}	848	}
814		849
815	sub _draw {	850	sub _draw {
816	my ($self) = @_;	851	my ($self) = @_;
817		852
818	my ($w, $h) = ($self->w, $self->h);	853	my ($w, $h) = @$self{qw(w h)};
819		854
820	my $tex = $self->{texture}	855	my $tex = $self->{texture}
821	or return;	856	or return;
822		857
823	glEnable GL_TEXTURE_2D;	858	glEnable GL_TEXTURE_2D;
824	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	859	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
825	glColor 1, 1, 1, 1;	860	glColor 0, 0, 0, 1;
826		861
827	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	862	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);
828		863
829	glDisable GL_TEXTURE_2D;	864	glDisable GL_TEXTURE_2D;
830	}	865	}
…		…
846	}	881	}
847		882
848	sub size_request {	883	sub size_request {
849	my ($self) = @_;	884	my ($self) = @_;
850		885
851	my ($w, $h) = @$self{qw(child_w child_h)} = @{$self->child}{qw(req_w req_h)};	886	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
852		887
853	$w = 10 if $self->{scroll_x};	888	$w = 10 if $self->{scroll_x};
854	$h = 10 if $self->{scroll_y};	889	$h = 10 if $self->{scroll_y};
855		890
856	($w, $h)	891	($w, $h)
857	}	892	}
858		893
859	sub size_allocate {	894	sub invoke_size_allocate {
860	my ($self, $w, $h, $changed) = @_;	895	my ($self, $w, $h) = @_;
861		896
		897	my $child = $self->child;
		898
862	$w = $self->{child_w} if $self->{scroll_x} && $self->{child_w};	899	$w = $child->{req_w} if $self->{scroll_x} && $child->{req_w};
863	$h = $self->{child_h} if $self->{scroll_y} && $self->{child_h};	900	$h = $child->{req_h} if $self->{scroll_y} && $child->{req_h};
864		901
865	$self->child->configure (0, 0, $w, $h);	902	$self->child->configure (0, 0, $w, $h);
866	$self->update;	903	$self->update;
		904
		905	1
867	}	906	}
868		907
869	sub set_offset {	908	sub set_offset {
870	my ($self, $x, $y) = @_;	909	my ($self, $x, $y) = @_;
871		910
…		…
904	}	943	}
905		944
906	sub _render {	945	sub _render {
907	my ($self) = @_;	946	my ($self) = @_;
908		947
		948	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};
		949	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};
		950
909	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	951	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
910		952
911	$self->SUPER::_render;	953	$self->SUPER::_render;
912	}	954	}
913		955
…		…
916	package CFClient::UI::ScrolledWindow;	958	package CFClient::UI::ScrolledWindow;
917		959
918	our @ISA = CFClient::UI::HBox::;	960	our @ISA = CFClient::UI::HBox::;
919		961
920	sub new {	962	sub new {
921	my $class = shift;	963	my ($class, %arg) = @_;
		964
		965	my $child = delete $arg{child};
922		966
923	my $self;	967	my $self;
924		968
925	my $slider = new CFClient::UI::Slider	969	my $slider = new CFClient::UI::Slider
926	vertical => 1,	970	vertical => 1,
…		…
931	;	975	;
932		976
933	$self = $class->SUPER::new (	977	$self = $class->SUPER::new (
934	vp => (new CFClient::UI::ViewPort expand => 1),	978	vp => (new CFClient::UI::ViewPort expand => 1),
935	slider => $slider,	979	slider => $slider,
936	@_,	980	%arg,
937	);	981	);
938		982
939	$self->{vp}->add ($self->{scrolled});
940	$self->add ($self->{vp});
941	$self->add ($self->{slider});	983	$self->SUPER::add ($self->{vp}, $self->{slider});
		984	$self->add ($child) if $child;
942		985
943	$self	986	$self
		987	}
		988
		989	sub add {
		990	my ($self, $widget) = @_;
		991
		992	$self->{vp}->add ($self->{child} = $widget);
944	}	993	}
945		994
946	sub update {	995	sub update {
947	my ($self) = @_;	996	my ($self) = @_;
948		997
…		…
951	# todo: overwrite size_allocate of child	1000	# todo: overwrite size_allocate of child
952	my $child = $self->{vp}->child;	1001	my $child = $self->{vp}->child;
953	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1002	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
954	}	1003	}
955		1004
956	sub size_allocate {	1005	sub invoke_size_allocate {
957	my ($self, $w, $h, $changed) = @_;	1006	my ($self, $w, $h) = @_;
958
959	$self->SUPER::size_allocate ($w, $h, $changed);
960		1007
961	my $child = $self->{vp}->child;	1008	my $child = $self->{vp}->child;
962	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1009	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
		1010
		1011	$self->SUPER::invoke_size_allocate ($w, $h)
963	}	1012	}
964		1013
965	#TODO# update range on size_allocate depending on child	1014	#TODO# update range on size_allocate depending on child
966	# update viewport offset on scroll	1015	# update viewport offset on scroll
967		1016
…		…
987		1036
988	if ($self->{bg}) {	1037	if ($self->{bg}) {
989	my ($w, $h) = @$self{qw(w h)};	1038	my ($w, $h) = @$self{qw(w h)};
990		1039
991	glEnable GL_BLEND;	1040	glEnable GL_BLEND;
992	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1041	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
993	glColor @{ $self->{bg} };	1042	glColor_premultiply @{ $self->{bg} };
994		1043
995	glBegin GL_QUADS;	1044	glBegin GL_QUADS;
996	glVertex 0 , 0;	1045	glVertex 0 , 0;
997	glVertex 0 , $h;	1046	glVertex 0 , $h;
998	glVertex $w, $h;	1047	glVertex $w, $h;
…		…
1020	my @border =	1069	my @border =
1021	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1070	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
1022	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1071	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1023		1072
1024	sub new {	1073	sub new {
1025	my $class = shift;	1074	my ($class, %arg) = @_;
1026		1075
1027	my $self = $class->SUPER::new (	1076	my $self = $class->SUPER::new (
1028	bg => [1, 1, 1, 1],	1077	bg => [1, 1, 1, 1],
1029	border_bg => [1, 1, 1, 1],	1078	border_bg => [1, 1, 1, 1],
1030	border => 0.6,	1079	border => 0.6,
1031	can_events => 1,	1080	can_events => 1,
1032	@_	1081	min_w => 16,
		1082	min_h => 16,
		1083	%arg,
1033	);	1084	);
1034		1085
1035	$self->{title} &&= new CFClient::UI::Label	1086	$self->{title_widget} = new CFClient::UI::Label
1036	align => 0,	1087	align => 0,
1037	valign => 1,	1088	valign => 1,
1038	text => $self->{title},	1089	text => $self->{title},
1039	fontsize => $self->{border};	1090	fontsize => $self->{border},
		1091	if exists $self->{title};
		1092
		1093	if ($self->{has_close_button}) {
		1094	$self->{close_button} =
		1095	new CFClient::UI::ImageButton
		1096	image => 'x1_close.png',
		1097	on_activate => sub { $self->hide };
		1098
		1099	$self->CFClient::UI::Container::add ($self->{close_button});
		1100	}
1040		1101
1041	$self	1102	$self
		1103	}
		1104
		1105	sub add {
		1106	my ($self, @widgets) = @_;
		1107
		1108	$self->SUPER::add (@widgets);
		1109	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};
		1110	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1042	}	1111	}
1043		1112
1044	sub border {	1113	sub border {
1045	int $_[0]{border} * $::FONTSIZE	1114	int $_[0]{border} * $::FONTSIZE
1046	}	1115	}
1047		1116
1048	sub size_request {	1117	sub size_request {
1049	my ($self) = @_;	1118	my ($self) = @_;
		1119
		1120	$self->{title_widget}->size_request
		1121	if $self->{title_widget};
		1122
		1123	$self->{close_button}->size_request
		1124	if $self->{close_button};
1050		1125
1051	my ($w, $h) = $self->SUPER::size_request;	1126	my ($w, $h) = $self->SUPER::size_request;
1052		1127
1053	(	1128	(
1054	$w + $self->border * 2,	1129	$w + $self->border * 2,
1055	$h + $self->border * 2,	1130	$h + $self->border * 2,
1056	)	1131	)
1057	}	1132	}
1058		1133
1059	sub size_allocate {	1134	sub invoke_size_allocate {
1060	my ($self, $w, $h, $changed) = @_;	1135	my ($self, $w, $h) = @_;
1061		1136
1062	return unless $changed;	1137	if ($self->{title_widget}) {
		1138	$self->{title_widget}{w} = $w;
		1139	$self->{title_widget}{h} = $h;
		1140	$self->{title_widget}->invoke_size_allocate ($w, $h);
		1141	}
1063		1142
		1143	my $border = $self->border;
		1144
1064	$h -= List::Util::max 0, $self->border * 2;	1145	$h -= List::Util::max 0, $border * 2;
1065	$w -= List::Util::max 0, $self->border * 2;	1146	$w -= List::Util::max 0, $border * 2;
1066		1147
1067	$self->{title}->configure ($self->border, int $self->border - $::FONTSIZE * 2, $w, int $::FONTSIZE * 2)
1068	if $self->{title};
1069
1070	$self->child->configure ($self->border, $self->border, $w, $h);	1148	$self->child->configure ($border, $border, $w, $h);
1071	}
1072		1149
		1150	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1151	if $self->{close_button};
		1152
		1153	1
		1154	}
		1155
1073	sub button_down {	1156	sub invoke_button_down {
1074	my ($self, $ev, $x, $y) = @_;	1157	my ($self, $ev, $x, $y) = @_;
1075		1158
1076	my ($w, $h) = @$self{qw(w h)};	1159	my ($w, $h) = @$self{qw(w h)};
1077	my $border = $self->border;	1160	my $border = $self->border;
1078		1161
…		…
1094	my $dy = $ev->{y} - $oy;	1177	my $dy = $ev->{y} - $oy;
1095		1178
1096	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1179	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1097	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1180	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1098		1181
		1182	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1099	$self->realloc;	1183	$self->realloc;
1100	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1101	};	1184	};
1102		1185
1103	} elsif ($lr ^ $td) {	1186	} elsif ($lr ^ $td) {
1104	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1187	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1105	my ($bx, $by) = ($self->{x}, $self->{y});	1188	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1108	my ($ev, $x, $y) = @_;	1191	my ($ev, $x, $y) = @_;
1109		1192
1110	($x, $y) = ($ev->{x}, $ev->{y});	1193	($x, $y) = ($ev->{x}, $ev->{y});
1111		1194
1112	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1195	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
		1196	# HACK: the next line is required to enforce placement
		1197	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1113	};	1198	};
		1199	} else {
		1200	return 0;
		1201	}
		1202
1114	}	1203	1
1115	}	1204	}
1116		1205
1117	sub button_up {	1206	sub invoke_button_up {
1118	my ($self, $ev, $x, $y) = @_;	1207	my ($self, $ev, $x, $y) = @_;
1119		1208
1120	delete $self->{motion};	1209	! ! delete $self->{motion}
1121	}	1210	}
1122		1211
1123	sub mouse_motion {	1212	sub invoke_mouse_motion {
1124	my ($self, $ev, $x, $y) = @_;	1213	my ($self, $ev, $x, $y) = @_;
1125		1214
1126	$self->{motion}->($ev, $x, $y) if $self->{motion};	1215	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1216
		1217	! ! $self->{motion}
1127	}	1218	}
1128		1219
1129	sub _draw {	1220	sub _draw {
1130	my ($self) = @_;	1221	my ($self) = @_;
1131		1222
		1223	my $child = $self->{children}[0];
		1224
1132	my ($w, $h ) = ($self->{w}, $self->{h});	1225	my ($w, $h ) = ($self->{w}, $self->{h});
1133	my ($cw, $ch) = ($self->child->{w}, $self->child->{h});	1226	my ($cw, $ch) = ($child->{w}, $child->{h});
1134		1227
1135	glEnable GL_TEXTURE_2D;	1228	glEnable GL_TEXTURE_2D;
1136	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1229	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1137		1230
1138	my $border = $self->border;	1231	my $border = $self->border;
…		…
1153	$bg->draw_quad_alpha ($border, $border, $cw, $ch);	1246	$bg->draw_quad_alpha ($border, $border, $cw, $ch);
1154	}	1247	}
1155		1248
1156	glDisable GL_TEXTURE_2D;	1249	glDisable GL_TEXTURE_2D;
1157		1250
1158	$self->{title}->draw if $self->{title};
1159
1160	$self->child->draw;	1251	$child->draw;
		1252
		1253	if ($self->{title_widget}) {
		1254	glTranslate 0, $border - $self->{h};
		1255	$self->{title_widget}->_draw;
		1256
		1257	glTranslate 0, - ($border - $self->{h});
		1258	}
		1259
		1260	$self->{close_button}->draw
		1261	if $self->{close_button};
1161	}	1262	}
1162		1263
1163	#############################################################################	1264	#############################################################################
1164		1265
1165	package CFClient::UI::Table;	1266	package CFClient::UI::Table;
…		…
1188		1289
1189	$child->set_parent ($self);	1290	$child->set_parent ($self);
1190	$self->{children}[$y][$x] = $child;	1291	$self->{children}[$y][$x] = $child;
1191		1292
1192	$self->realloc;	1293	$self->realloc;
		1294	}
		1295
		1296	sub remove {
		1297	my ($self, $child) = @_;
		1298
		1299	# TODO: not yet implemented
1193	}	1300	}
1194		1301
1195	# TODO: move to container class maybe? send children a signal on removal?	1302	# TODO: move to container class maybe? send children a signal on removal?
1196	sub clear {	1303	sub clear {
1197	my ($self) = @_;	1304	my ($self) = @_;
…		…
1238	(sum @$ws),	1345	(sum @$ws),
1239	(sum @$hs),	1346	(sum @$hs),
1240	)	1347	)
1241	}	1348	}
1242		1349
1243	sub size_allocate {	1350	sub invoke_size_allocate {
1244	my ($self, $w, $h, $changed) = @_;	1351	my ($self, $w, $h) = @_;
1245		1352
1246	my ($ws, $hs) = $self->get_wh;	1353	my ($ws, $hs) = $self->get_wh;
1247		1354
1248	my $req_w = (sum @$ws) || 1;	1355	my $req_w = (sum @$ws) || 1;
1249	my $req_h = (sum @$hs) || 1;	1356	my $req_h = (sum @$hs) || 1;
…		…
1280	}	1387	}
1281		1388
1282	$y += $row_h;	1389	$y += $row_h;
1283	}	1390	}
1284		1391
		1392	1
1285	}	1393	}
1286		1394
1287	sub find_widget {	1395	sub find_widget {
1288	my ($self, $x, $y) = @_;	1396	my ($self, $x, $y) = @_;
1289		1397
…		…
1326	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1434	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1327	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1435	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1328	)	1436	)
1329	}	1437	}
1330		1438
1331	sub size_allocate {	1439	sub invoke_size_allocate {
1332	my ($self, $w, $h, $changed) = @_;	1440	my ($self, $w, $h) = @_;
1333		1441
1334	my $space = $self->{vertical} ? $h : $w;	1442	my $space = $self->{vertical} ? $h : $w;
1335	my $children = $self->{children};	1443	my $children = $self->{children};
1336		1444
1337	my @req;	1445	my @req;
…		…
1420	ellipsise => 3, # end	1528	ellipsise => 3, # end
1421	layout => (new CFClient::Layout),	1529	layout => (new CFClient::Layout),
1422	fontsize => 1,	1530	fontsize => 1,
1423	align => -1,	1531	align => -1,
1424	valign => -1,	1532	valign => -1,
1425	padding => 2,	1533	padding_x => 2,
		1534	padding_y => 2,
1426	can_events => 0,	1535	can_events => 0,
1427	%arg	1536	%arg
1428	);	1537	);
1429		1538
1430	if (exists $self->{template}) {	1539	if (exists $self->{template}) {
…		…
1457		1566
1458	delete $self->{texture};	1567	delete $self->{texture};
1459	$self->SUPER::update;	1568	$self->SUPER::update;
1460	}	1569	}
1461		1570
		1571	sub realloc {
		1572	my ($self) = @_;
		1573
		1574	delete $self->{ox};
		1575	$self->SUPER::realloc;
		1576	}
		1577
1462	sub set_text {	1578	sub set_text {
1463	my ($self, $text) = @_;	1579	my ($self, $text) = @_;
1464		1580
1465	return if $self->{text} eq "T$text";	1581	return if $self->{text} eq "T$text";
1466	$self->{text} = "T$text";	1582	$self->{text} = "T$text";
1467		1583
1468	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;	1584	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1469	$self->{layout}->set_text ($text);	1585	$self->{layout}->set_text ($text);
1470		1586
		1587	delete $self->{size_req};
1471	$self->realloc;	1588	$self->realloc;
1472	$self->update;	1589	$self->update;
1473	}	1590	}
1474		1591
1475	sub set_markup {	1592	sub set_markup {
…		…
1481	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1598	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1482		1599
1483	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;	1600	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1484	$self->{layout}->set_markup ($markup);	1601	$self->{layout}->set_markup ($markup);
1485		1602
		1603	delete $self->{size_req};
1486	$self->realloc;	1604	$self->realloc;
1487	$self->update;	1605	$self->update;
1488	}	1606	}
1489		1607
1490	sub size_request {	1608	sub size_request {
1491	my ($self) = @_;	1609	my ($self) = @_;
1492		1610
		1611	$self->{size_req} ||= do {
1493	$self->{layout}->set_font ($self->{font}) if $self->{font};	1612	$self->{layout}->set_font ($self->{font}) if $self->{font};
1494	$self->{layout}->set_width ($self->{max_w} || -1);	1613	$self->{layout}->set_width ($self->{max_w} || -1);
1495	$self->{layout}->set_ellipsise ($self->{ellipsise});	1614	$self->{layout}->set_ellipsise ($self->{ellipsise});
1496	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1615	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1497	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1616	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1498		1617
1499	my ($w, $h) = $self->{layout}->size;	1618	my ($w, $h) = $self->{layout}->size;
1500		1619
1501	if (exists $self->{template}) {	1620	if (exists $self->{template}) {
1502	$self->{template}->set_font ($self->{font}) if $self->{font};	1621	$self->{template}->set_font ($self->{font}) if $self->{font};
1503	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1622	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1504		1623
1505	my ($w2, $h2) = $self->{template}->size;	1624	my ($w2, $h2) = $self->{template}->size;
1506		1625
1507	$w = List::Util::max $w, $w2;	1626	$w = List::Util::max $w, $w2;
1508	$h = List::Util::max $h, $h2;	1627	$h = List::Util::max $h, $h2;
		1628	}
		1629
		1630	[$w, $h]
1509	}	1631	};
1510		1632
1511	(	1633	@{ $self->{size_req} }
1512	$w + $self->{padding} * 2,
1513	$h + $self->{padding} * 2,
1514	)
1515	}	1634	}
1516		1635
1517	sub size_allocate {	1636	sub invoke_size_allocate {
1518	my ($self, $w, $h, $changed) = @_;	1637	my ($self, $w, $h) = @_;
		1638
		1639	delete $self->{ox};
1519		1640
1520	delete $self->{texture}	1641	delete $self->{texture}
1521	if $changed;	1642	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1643
		1644	1
1522	}	1645	}
1523		1646
1524	sub set_fontsize {	1647	sub set_fontsize {
1525	my ($self, $fontsize) = @_;	1648	my ($self, $fontsize) = @_;
1526		1649
1527	$self->{fontsize} = $fontsize;	1650	$self->{fontsize} = $fontsize;
1528	delete $self->{texture};	1651	delete $self->{texture};
1529		1652
1530	$self->realloc;	1653	$self->realloc;
		1654	}
		1655
		1656	sub reconfigure {
		1657	my ($self) = @_;
		1658
		1659	delete $self->{size_req};
		1660
		1661	$self->SUPER::reconfigure;
1531	}	1662	}
1532		1663
1533	sub _draw {	1664	sub _draw {
1534	my ($self) = @_;	1665	my ($self) = @_;
1535		1666
…		…
1541	$self->{layout}->set_width ($self->{w});	1672	$self->{layout}->set_width ($self->{w});
1542	$self->{layout}->set_ellipsise ($self->{ellipsise});	1673	$self->{layout}->set_ellipsise ($self->{ellipsise});
1543	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1544	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1545		1676
1546	my $tex = new_from_layout CFClient::Texture $self->{layout};	1677	new_from_layout CFClient::Texture $self->{layout}
		1678	};
1547		1679
		1680	unless (exists $self->{ox}) {
1548	$self->{ox} = int ($self->{align} < 0 ? $self->{padding}	1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1549	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding}	1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}
1550	: ($self->{w} - $tex->{w}) * 0.5);	1683	: ($self->{w} - $tex->{w}) * 0.5);
1551		1684
1552	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding}	1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1553	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding}	1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}
1554	: ($self->{h} - $tex->{h}) * 0.5);	1687	: ($self->{h} - $tex->{h}) * 0.5);
1555
1556	$tex
1557	};	1688	};
1558		1689
1559	glEnable GL_TEXTURE_2D;	1690	glEnable GL_TEXTURE_2D;
1560	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1691
		1692	my $w = List::Util::min $self->{w} + 4, $tex->{w};
		1693	my $h = List::Util::min $self->{h} + 2, $tex->{h};
1561		1694
1562	if ($tex->{format} == GL_ALPHA) {	1695	if ($tex->{format} == GL_ALPHA) {
		1696	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1563	glColor @{$self->{fg}};	1697	glColor @{$self->{fg}};
1564	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});	1698	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1565	} else {	1699	} else {
		1700	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1566	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});	1701	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1567	}	1702	}
1568		1703
1569	glDisable GL_TEXTURE_2D;	1704	glDisable GL_TEXTURE_2D;
1570	}	1705	}
1571		1706
…		…
1588	can_hover => 1,	1723	can_hover => 1,
1589	can_focus => 1,	1724	can_focus => 1,
1590	valign => 0,	1725	valign => 0,
1591	can_events => 1,	1726	can_events => 1,
1592	#text => ...	1727	#text => ...
		1728	#hidden => "*",
1593	@_	1729	@_
1594	)	1730	)
1595	}	1731	}
1596		1732
1597	sub _set_text {	1733	sub _set_text {
…		…
1599		1735
1600	delete $self->{cur_h};	1736	delete $self->{cur_h};
1601		1737
1602	return if $self->{text} eq $text;	1738	return if $self->{text} eq $text;
1603		1739
1604	delete $self->{texture};
1605
1606	$self->{last_activity} = $::NOW;	1740	$self->{last_activity} = $::NOW;
1607	$self->{text} = $text;	1741	$self->{text} = $text;
1608		1742
1609	$text =~ s/./*/g if $self->{hidden};	1743	$text =~ s/./*/g if $self->{hidden};
1610	$self->{layout}->set_text ("$text ");	1744	$self->{layout}->set_text ("$text ");
		1745	delete $self->{size_req};
1611		1746
1612	$self->_emit (changed => $self->{text});	1747	$self->emit (changed => $self->{text});
		1748
		1749	$self->realloc;
		1750	$self->update;
1613	}	1751	}
1614		1752
1615	sub set_text {	1753	sub set_text {
1616	my ($self, $text) = @_;	1754	my ($self, $text) = @_;
1617		1755
1618	$self->{cursor} = length $text;	1756	$self->{cursor} = length $text;
1619	$self->_set_text ($text);	1757	$self->_set_text ($text);
1620
1621	$self->realloc;
1622	}	1758	}
1623		1759
1624	sub get_text {	1760	sub get_text {
1625	$_[0]{text}	1761	$_[0]{text}
1626	}	1762	}
…		…
1631	my ($w, $h) = $self->SUPER::size_request;	1767	my ($w, $h) = $self->SUPER::size_request;
1632		1768
1633	($w + 1, $h) # add 1 for cursor	1769	($w + 1, $h) # add 1 for cursor
1634	}	1770	}
1635		1771
1636	sub key_down {	1772	sub invoke_key_down {
1637	my ($self, $ev) = @_;	1773	my ($self, $ev) = @_;
1638		1774
1639	my $mod = $ev->{mod};	1775	my $mod = $ev->{mod};
1640	my $sym = $ev->{sym};	1776	my $sym = $ev->{sym};
1641	my $uni = $ev->{unicode};	1777	my $uni = $ev->{unicode};
…		…
1653	} elsif ($sym == CFClient::SDLK_HOME) {	1789	} elsif ($sym == CFClient::SDLK_HOME) {
1654	$self->{cursor} = 0;	1790	$self->{cursor} = 0;
1655	} elsif ($sym == CFClient::SDLK_END) {	1791	} elsif ($sym == CFClient::SDLK_END) {
1656	$self->{cursor} = length $text;	1792	$self->{cursor} = length $text;
1657	} elsif ($uni == 27) {	1793	} elsif ($uni == 27) {
1658	$self->_emit ('escape');	1794	$self->emit ('escape');
1659	} elsif ($uni) {	1795	} elsif ($uni) {
1660	substr $text, $self->{cursor}++, 0, chr $uni;	1796	substr $text, $self->{cursor}++, 0, chr $uni;
		1797	} else {
		1798	return 0;
1661	}	1799	}
1662		1800
1663	$self->_set_text ($text);	1801	$self->_set_text ($text);
1664		1802
1665	$self->realloc;	1803	$self->realloc;
1666	}
1667		1804
		1805	1
		1806	}
		1807
1668	sub focus_in {	1808	sub invoke_focus_in {
1669	my ($self) = @_;	1809	my ($self) = @_;
1670		1810
1671	$self->{last_activity} = $::NOW;	1811	$self->{last_activity} = $::NOW;
1672		1812
1673	$self->SUPER::focus_in;	1813	$self->SUPER::invoke_focus_in
1674	}	1814	}
1675		1815
1676	sub button_down {	1816	sub invoke_button_down {
1677	my ($self, $ev, $x, $y) = @_;	1817	my ($self, $ev, $x, $y) = @_;
1678		1818
1679	$self->SUPER::button_down ($ev, $x, $y);	1819	$self->SUPER::invoke_button_down ($ev, $x, $y);
1680		1820
1681	my $idx = $self->{layout}->xy_to_index ($x, $y);	1821	my $idx = $self->{layout}->xy_to_index ($x, $y);
1682		1822
1683	# byte-index to char-index	1823	# byte-index to char-index
1684	my $text = $self->{text};	1824	my $text = $self->{text};
1685	utf8::encode $text;	1825	utf8::encode $text;
1686	$self->{cursor} = length substr $text, 0, $idx;	1826	$self->{cursor} = length substr $text, 0, $idx;
1687		1827
1688	$self->_set_text ($self->{text});	1828	$self->_set_text ($self->{text});
1689	$self->update;	1829	$self->update;
		1830
		1831	1
1690	}	1832	}
1691		1833
1692	sub mouse_motion {	1834	sub invoke_mouse_motion {
1693	my ($self, $ev, $x, $y) = @_;	1835	my ($self, $ev, $x, $y) = @_;
1694	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	1836	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		1837
		1838	1
1695	}	1839	}
1696		1840
1697	sub _draw {	1841	sub _draw {
1698	my ($self) = @_;	1842	my ($self) = @_;
1699		1843
1700	local $self->{fg} = $self->{fg};	1844	local $self->{fg} = $self->{fg};
1701		1845
1702	if ($FOCUS == $self) {	1846	if ($FOCUS == $self) {
1703	glColor @{$self->{active_bg}};	1847	glColor_premultiply @{$self->{active_bg}};
1704	$self->{fg} = $self->{active_fg};	1848	$self->{fg} = $self->{active_fg};
1705	} else {	1849	} else {
1706	glColor @{$self->{bg}};	1850	glColor_premultiply @{$self->{bg}};
1707	}	1851	}
1708		1852
1709	glEnable GL_BLEND;	1853	glEnable GL_BLEND;
1710	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1854	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1711	glBegin GL_QUADS;	1855	glBegin GL_QUADS;
1712	glVertex 0 , 0;	1856	glVertex 0 , 0;
1713	glVertex 0 , $self->{h};	1857	glVertex 0 , $self->{h};
1714	glVertex $self->{w}, $self->{h};	1858	glVertex $self->{w}, $self->{h};
1715	glVertex $self->{w}, 0;	1859	glVertex $self->{w}, 0;
…		…
1740		1884
1741	our @ISA = CFClient::UI::EntryBase::;	1885	our @ISA = CFClient::UI::EntryBase::;
1742		1886
1743	use CFClient::OpenGL;	1887	use CFClient::OpenGL;
1744		1888
1745	sub key_down {	1889	sub invoke_key_down {
1746	my ($self, $ev) = @_;	1890	my ($self, $ev) = @_;
1747		1891
1748	my $sym = $ev->{sym};	1892	my $sym = $ev->{sym};
1749		1893
1750	if ($sym == 13) {	1894	if ($sym == 13) {
1751	unshift @{$self->{history}},	1895	unshift @{$self->{history}},
1752	my $txt = $self->get_text;	1896	my $txt = $self->get_text;
		1897
1753	$self->{history_pointer} = -1;	1898	$self->{history_pointer} = -1;
1754	$self->{history_saveback} = '';	1899	$self->{history_saveback} = '';
1755	$self->_emit (activate => $txt);	1900	$self->emit (activate => $txt);
1756	$self->update;	1901	$self->update;
1757		1902
1758	} elsif ($sym == CFClient::SDLK_UP) {	1903	} elsif ($sym == CFClient::SDLK_UP) {
1759	if ($self->{history_pointer} < 0) {	1904	if ($self->{history_pointer} < 0) {
1760	$self->{history_saveback} = $self->get_text;	1905	$self->{history_saveback} = $self->get_text;
…		…
1776	} else {	1921	} else {
1777	$self->set_text ($self->{history_saveback});	1922	$self->set_text ($self->{history_saveback});
1778	}	1923	}
1779		1924
1780	} else {	1925	} else {
1781	$self->SUPER::key_down ($ev);	1926	return $self->SUPER::invoke_key_down ($ev)
		1927	}
		1928
1782	}	1929	1
1783
1784	}	1930	}
1785		1931
1786	#############################################################################	1932	#############################################################################
1787		1933
1788	package CFClient::UI::Button;	1934	package CFClient::UI::Button;
…		…
1797		1943
1798	sub new {	1944	sub new {
1799	my $class = shift;	1945	my $class = shift;
1800		1946
1801	$class->SUPER::new (	1947	$class->SUPER::new (
1802	padding => 4,	1948	padding_x => 4,
		1949	padding_y => 4,
1803	fg => [1, 1, 1],	1950	fg => [1, 1, 1],
1804	active_fg => [0, 0, 1],	1951	active_fg => [0, 0, 1],
1805	can_hover => 1,	1952	can_hover => 1,
1806	align => 0,	1953	align => 0,
1807	valign => 0,	1954	valign => 0,
1808	can_events => 1,	1955	can_events => 1,
1809	@_	1956	@_
1810	)	1957	)
1811	}	1958	}
1812		1959
1813	sub activate { }
1814
1815	sub button_up {	1960	sub invoke_button_up {
1816	my ($self, $ev, $x, $y) = @_;	1961	my ($self, $ev, $x, $y) = @_;
1817		1962
1818	$self->emit ("activate")	1963	$self->emit ("activate")
1819	if $x >= 0 && $x < $self->{w}	1964	if $x >= 0 && $x < $self->{w}
1820	&& $y >= 0 && $y < $self->{h};	1965	&& $y >= 0 && $y < $self->{h};
		1966
		1967	1
1821	}	1968	}
1822		1969
1823	sub _draw {	1970	sub _draw {
1824	my ($self) = @_;	1971	my ($self) = @_;
1825		1972
1826	local $self->{fg} = $self->{fg};	1973	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1827
1828	if ($GRAB == $self) {
1829	$self->{fg} = $self->{active_fg};
1830	}
1831		1974
1832	glEnable GL_TEXTURE_2D;	1975	glEnable GL_TEXTURE_2D;
1833	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1976	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1834	glColor 0, 0, 0, 1;	1977	glColor 0, 0, 0, 1;
1835		1978
…		…
1840	$self->SUPER::_draw;	1983	$self->SUPER::_draw;
1841	}	1984	}
1842		1985
1843	#############################################################################	1986	#############################################################################
1844		1987
		1988	package CFClient::UI::ImageButton;
		1989
		1990	our @ISA = CFClient::UI::Image::;
		1991
		1992	use CFClient::OpenGL;
		1993
		1994	my %textures;
		1995
		1996	sub new {
		1997	my $class = shift;
		1998
		1999	my $self = $class->SUPER::new (
		2000	padding_x => 4,
		2001	padding_y => 4,
		2002	fg => [1, 1, 1],
		2003	active_fg => [0, 0, 1],
		2004	can_hover => 1,
		2005	align => 0,
		2006	valign => 0,
		2007	can_events => 1,
		2008	@_
		2009	);
		2010	}
		2011
		2012	sub invoke_button_up {
		2013	my ($self, $ev, $x, $y) = @_;
		2014
		2015	$self->emit ("activate")
		2016	if $x >= 0 && $x < $self->{w}
		2017	&& $y >= 0 && $y < $self->{h};
		2018
		2019	1
		2020	}
		2021
		2022	#############################################################################
		2023
1845	package CFClient::UI::CheckBox;	2024	package CFClient::UI::CheckBox;
1846		2025
1847	our @ISA = CFClient::UI::DrawBG::;	2026	our @ISA = CFClient::UI::DrawBG::;
1848		2027
1849	my @tex =	2028	my @tex =
…		…
1854		2033
1855	sub new {	2034	sub new {
1856	my $class = shift;	2035	my $class = shift;
1857		2036
1858	$class->SUPER::new (	2037	$class->SUPER::new (
1859	padding => 2,	2038	padding_x => 2,
		2039	padding_y => 2,
1860	fg => [1, 1, 1],	2040	fg => [1, 1, 1],
1861	active_fg => [1, 1, 0],	2041	active_fg => [1, 1, 0],
1862	bg => [0, 0, 0, 0.2],	2042	bg => [0, 0, 0, 0.2],
1863	active_bg => [1, 1, 1, 0.5],	2043	active_bg => [1, 1, 1, 0.5],
1864	state => 0,	2044	state => 0,
…		…
1868	}	2048	}
1869		2049
1870	sub size_request {	2050	sub size_request {
1871	my ($self) = @_;	2051	my ($self) = @_;
1872		2052
1873	($self->{padding} * 2 + 6) x 2	2053	(6) x 2
1874	}	2054	}
1875		2055
1876	sub button_down {	2056	sub invoke_button_down {
1877	my ($self, $ev, $x, $y) = @_;	2057	my ($self, $ev, $x, $y) = @_;
1878		2058
1879	if ($x >= $self->{padding} && $x < $self->{w} - $self->{padding}	2059	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1880	&& $y >= $self->{padding} && $y < $self->{h} - $self->{padding}) {	2060	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1881	$self->{state} = !$self->{state};	2061	$self->{state} = !$self->{state};
1882	$self->_emit (changed => $self->{state});	2062	$self->emit (changed => $self->{state});
		2063	} else {
		2064	return 0
		2065	}
		2066
1883	}	2067	1
1884	}	2068	}
1885		2069
1886	sub _draw {	2070	sub _draw {
1887	my ($self) = @_;	2071	my ($self) = @_;
1888		2072
1889	$self->SUPER::_draw;	2073	$self->SUPER::_draw;
1890		2074
1891	glTranslate $self->{padding} + 0.375, $self->{padding} + 0.375, 0;	2075	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
1892		2076
1893	my $s = (List::Util::min @$self{qw(w h)}) - $self->{padding} * 2;	2077	my ($w, $h) = @$self{qw(w h)};
		2078
		2079	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1894		2080
1895	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };	2081	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
1896		2082
1897	my $tex = $self->{state} ? $tex[1] : $tex[0];	2083	my $tex = $self->{state} ? $tex[1] : $tex[0];
1898		2084
…		…
2053		2239
2054	my $h1 = $self->{h} * (1 - $ycut1);	2240	my $h1 = $self->{h} * (1 - $ycut1);
2055	my $h2 = $self->{h} * (1 - $ycut2);	2241	my $h2 = $self->{h} * (1 - $ycut2);
2056		2242
2057	glEnable GL_BLEND;	2243	glEnable GL_BLEND;
2058	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2244	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2245	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2059	glEnable GL_TEXTURE_2D;	2246	glEnable GL_TEXTURE_2D;
2060	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2247	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2061		2248
2062	glBindTexture GL_TEXTURE_2D, $t1->{name};	2249	glBindTexture GL_TEXTURE_2D, $t1->{name};
2063	glBegin GL_QUADS;	2250	glBegin GL_QUADS;
…		…
2177	$self->update;	2364	$self->update;
2178		2365
2179	$self	2366	$self
2180	}	2367	}
2181		2368
2182	sub changed { }
2183
2184	sub set_range {	2369	sub set_range {
2185	my ($self, $range) = @_;	2370	my ($self, $range) = @_;
2186		2371
2187	($range, $self->{range}) = ($self->{range}, $range);	2372	($range, $self->{range}) = ($self->{range}, $range);
2188		2373
2189	$self->update
2190	if "@$range" ne "@{$self->{range}}";	2374	if ("@$range" ne "@{$self->{range}}") {
		2375	$self->update;
		2376	$self->set_value ($self->{range}[0]);
		2377	}
2191	}	2378	}
2192		2379
2193	sub set_value {	2380	sub set_value {
2194	my ($self, $value) = @_;	2381	my ($self, $value) = @_;
2195		2382
…		…
2206	if $unit;	2393	if $unit;
2207		2394
2208	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2395	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2209		2396
2210	if ($value != $old_value) {	2397	if ($value != $old_value) {
2211	$self->_emit (changed => $value);	2398	$self->emit (changed => $value);
2212	$self->update;	2399	$self->update;
2213	}	2400	}
2214	}	2401	}
2215		2402
2216	sub size_request {	2403	sub size_request {
2217	my ($self) = @_;	2404	my ($self) = @_;
2218		2405
2219	($self->{req_w}, $self->{req_h})	2406	($self->{req_w}, $self->{req_h})
2220	}	2407	}
2221		2408
2222	sub button_down {	2409	sub invoke_button_down {
2223	my ($self, $ev, $x, $y) = @_;	2410	my ($self, $ev, $x, $y) = @_;
2224		2411
2225	$self->SUPER::button_down ($ev, $x, $y);	2412	$self->SUPER::invoke_button_down ($ev, $x, $y);
2226		2413
2227	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2414	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2228		2415
2229	$self->mouse_motion ($ev, $x, $y);	2416	$self->invoke_mouse_motion ($ev, $x, $y)
2230	}	2417	}
2231		2418
2232	sub mouse_motion {	2419	sub invoke_mouse_motion {
2233	my ($self, $ev, $x, $y) = @_;	2420	my ($self, $ev, $x, $y) = @_;
2234		2421
2235	if ($GRAB == $self) {	2422	if ($GRAB == $self) {
2236	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2423	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2237		2424
2238	my (undef, $lo, $hi, $page) = @{$self->{range}};	2425	my (undef, $lo, $hi, $page) = @{$self->{range}};
2239		2426
2240	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2427	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2241		2428
2242	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2429	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2430	} else {
		2431	return 0;
		2432	}
		2433
2243	}	2434	1
2244	}	2435	}
2245		2436
2246	sub update {	2437	sub update {
2247	my ($self) = @_;	2438	my ($self) = @_;
2248		2439
2249	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2440	delete $self->{knob_w};
		2441	$self->SUPER::update;
		2442	}
		2443
		2444	sub _draw {
		2445	my ($self) = @_;
		2446
		2447	unless ($self->{knob_w}) {
2250	$self->set_value ($self->{range}[0]);	2448	$self->set_value ($self->{range}[0]);
2251		2449
2252	my ($value, $lo, $hi, $page) = @{$self->{range}};	2450	my ($value, $lo, $hi, $page) = @{$self->{range}};
2253	my $range = ($hi - $page - $lo) || 1e-100;	2451	my $range = ($hi - $page - $lo) || 1e-100;
2254		2452
…		…
2260	$value = ($value - $lo) / $range;	2458	$value = ($value - $lo) / $range;
2261	$value = $value * $self->{scale} + $self->{offset};	2459	$value = $value * $self->{scale} + $self->{offset};
2262		2460
2263	$self->{knob_x} = $value - $knob_w * 0.5;	2461	$self->{knob_x} = $value - $knob_w * 0.5;
2264	$self->{knob_w} = $knob_w;	2462	$self->{knob_w} = $knob_w;
2265	});	2463	}
2266
2267	$self->SUPER::update;
2268	}
2269
2270	sub _draw {
2271	my ($self) = @_;
2272		2464
2273	$self->SUPER::_draw ();	2465	$self->SUPER::_draw ();
2274		2466
2275	glScale $self->{w}, $self->{h};	2467	glScale $self->{w}, $self->{h};
2276		2468
…		…
2337	sub set_range { shift->{slider}->set_range (@_) }	2529	sub set_range { shift->{slider}->set_range (@_) }
2338	sub set_value { shift->{slider}->set_value (@_) }	2530	sub set_value { shift->{slider}->set_value (@_) }
2339		2531
2340	#############################################################################	2532	#############################################################################
2341		2533
2342	package CFClient::UI::TextView;	2534	package CFClient::UI::TextScroller;
2343		2535
2344	our @ISA = CFClient::UI::HBox::;	2536	our @ISA = CFClient::UI::HBox::;
2345		2537
2346	use CFClient::OpenGL;	2538	use CFClient::OpenGL;
2347		2539
…		…
2349	my $class = shift;	2541	my $class = shift;
2350		2542
2351	my $self = $class->SUPER::new (	2543	my $self = $class->SUPER::new (
2352	fontsize => 1,	2544	fontsize => 1,
2353	can_events => 0,	2545	can_events => 0,
		2546	indent => 0,
2354	#font => default_font	2547	#font => default_font
2355	@_,	2548	@_,
2356		2549
2357	layout => (new CFClient::Layout 1),	2550	layout => (new CFClient::Layout 1),
2358	par => [],	2551	par => [],
…		…
2373		2566
2374	$self->{fontsize} = $fontsize;	2567	$self->{fontsize} = $fontsize;
2375	$self->reflow;	2568	$self->reflow;
2376	}	2569	}
2377		2570
2378	sub size_allocate {	2571	sub invoke_size_allocate {
2379	my ($self, $w, $h, $changed) = @_;	2572	my ($self, $w, $h) = @_;
2380
2381	$self->SUPER::size_allocate ($w, $h, $changed);
2382
2383	return unless $changed;
2384		2573
2385	$self->{layout}->set_font ($self->{font}) if $self->{font};	2574	$self->{layout}->set_font ($self->{font}) if $self->{font};
2386	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2575	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2387	$self->{layout}->set_width ($self->{children}[0]{w});	2576	$self->{layout}->set_width ($self->{children}[0]{w});
		2577	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2388		2578
2389	$self->reflow;	2579	$self->reflow;
		2580
		2581	$self->SUPER::invoke_size_allocate ($w, $h)
2390	}	2582	}
2391		2583
2392	sub text_size {	2584	sub text_size {
2393	my ($self, $text, $indent) = @_;	2585	my ($self, $text, $indent) = @_;
2394		2586
2395	my $layout = $self->{layout};	2587	my $layout = $self->{layout};
2396		2588
2397	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2589	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2398	$layout->set_width ($self->{children}[0]{w} - $indent);	2590	$layout->set_width ($self->{children}[0]{w} - $indent);
		2591	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2399	$layout->set_markup ($text);	2592	$layout->set_markup ($text);
2400		2593
2401	$layout->size	2594	$layout->size
2402	}	2595	}
2403		2596
…		…
2442		2635
2443	return unless $self->{h} > 0;	2636	return unless $self->{h} > 0;
2444		2637
2445	delete $self->{texture};	2638	delete $self->{texture};
2446		2639
2447	$ROOT->on_post_alloc ($self, sub {	2640	$ROOT->on_post_alloc ($self => sub {
2448	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	2641	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2449		2642
2450	if (delete $self->{need_reflow}) {	2643	if (delete $self->{need_reflow}) {
2451	my $height = 0;	2644	my $height = 0;
2452		2645
…		…
2455	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2648	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2456		2649
2457	for (@{$self->{par}}) {	2650	for (@{$self->{par}}) {
2458	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support	2651	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2459	$layout->set_width ($W - $_->[3]);	2652	$layout->set_width ($W - $_->[3]);
		2653	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2460	$layout->set_markup ($_->[4]);	2654	$layout->set_markup ($_->[4]);
2461	my ($w, $h) = $layout->size;	2655	my ($w, $h) = $layout->size;
2462	$_->[0] = $w + $_->[3];	2656	$_->[0] = $w + $_->[3];
2463	$_->[1] = $h;	2657	$_->[1] = $h;
2464	}	2658	}
…		…
2467	}	2661	}
2468		2662
2469	$self->{height} = $height;	2663	$self->{height} = $height;
2470		2664
2471	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);	2665	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2472		2666
2473	delete $self->{texture};	2667	delete $self->{texture};
2474	}	2668	}
2475		2669
2476	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	2670	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {
2477	glClearColor 0.5, 0.5, 0.5, 0;	2671	glClearColor 0, 0, 0, 0;
2478	glClear GL_COLOR_BUFFER_BIT;	2672	glClear GL_COLOR_BUFFER_BIT;
2479		2673
2480	my $top = int $self->{children}[1]{range}[0];	2674	my $top = int $self->{children}[1]{range}[0];
2481		2675
2482	my $y0 = $top;	2676	my $y0 = $top;
…		…
2496	my $h = $par->[1];	2690	my $h = $par->[1];
2497		2691
2498	if ($y0 < $y + $h && $y < $y1) {	2692	if ($y0 < $y + $h && $y < $y1) {
2499	$layout->set_foreground (@{ $par->[2] });	2693	$layout->set_foreground (@{ $par->[2] });
2500	$layout->set_width ($W - $par->[3]);	2694	$layout->set_width ($W - $par->[3]);
		2695	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2501	$layout->set_markup ($par->[4]);	2696	$layout->set_markup ($par->[4]);
2502		2697
2503	my ($w, $h, $data, $format, $internalformat) = $layout->render;	2698	my ($w, $h, $data, $format, $internalformat) = $layout->render;
2504		2699
2505	glRasterPos $par->[3], $y - $y0;	2700	glRasterPos $par->[3], $y - $y0;
…		…
2517	sub _draw {	2712	sub _draw {
2518	my ($self) = @_;	2713	my ($self) = @_;
2519		2714
2520	glEnable GL_TEXTURE_2D;	2715	glEnable GL_TEXTURE_2D;
2521	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2716	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2522	glColor 1, 1, 1, 1;	2717	glColor 0, 0, 0, 1;
2523	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	2718	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2524	glDisable GL_TEXTURE_2D;	2719	glDisable GL_TEXTURE_2D;
2525		2720
2526	$self->{children}[1]->draw;	2721	$self->{children}[1]->draw;
2527		2722
2528	}	2723	}
…		…
2611	}	2806	}
2612		2807
2613	sub set_tooltip_from {	2808	sub set_tooltip_from {
2614	my ($self, $widget) = @_;	2809	my ($self, $widget) = @_;
2615		2810
		2811	my $tooltip = $widget->{tooltip};
		2812
		2813	if ($ENV{CFPLUS_DEBUG} & 2) {
		2814	$tooltip .= "\n\n" . (ref $widget) . "\n"
		2815	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
		2816	. "req $widget->{req_w} $widget->{req_h}\n"
		2817	. "visible $widget->{visible}";
		2818	}
		2819
		2820	$tooltip =~ s/^\n+//;
		2821	$tooltip =~ s/\n+$//;
		2822
2616	$self->add (new CFClient::UI::Label	2823	$self->add (new CFClient::UI::Label
2617	markup => $widget->{tooltip},	2824	markup => $tooltip,
2618	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	2825	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2619	fontsize => 0.8,	2826	fontsize => 0.8,
2620	fg => [0, 0, 0, 1],	2827	fg => [0, 0, 0, 1],
2621	ellipsise => 0,	2828	ellipsise => 0,
2622	font => ($widget->{tooltip_font} || $::FONT_PROP),	2829	font => ($widget->{tooltip_font} || $::FONT_PROP),
…		…
2629	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	2836	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2630		2837
2631	($w + 4, $h + 4)	2838	($w + 4, $h + 4)
2632	}	2839	}
2633		2840
2634	sub size_allocate {	2841	sub invoke_size_allocate {
2635	my ($self, $w, $h, $changed) = @_;	2842	my ($self, $w, $h) = @_;
2636		2843
2637	return unless $changed;
2638
2639	$self->SUPER::size_allocate ($w - 4, $h - 4, $changed);	2844	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2640	}	2845	}
2641		2846
2642	sub visibility_change {	2847	sub invoke_visibility_change {
2643	my ($self, $visible) = @_;	2848	my ($self, $visible) = @_;
2644		2849
2645	return unless $visible;	2850	return unless $visible;
2646		2851
2647	$self->{root}->on_post_alloc ("move_$self" => sub {	2852	$self->{root}->on_post_alloc ("move_$self" => sub {
…		…
2649	or return;	2854	or return;
2650		2855
2651	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	2856	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2652		2857
2653	($x, $y) = $widget->coord2global (-$self->{w}, 0)	2858	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2654	if $x + $self->{w} > $::WIDTH;	2859	if $x + $self->{w} > $self->{root}{w};
2655		2860
2656	$self->move_abs ($x, $y);	2861	$self->move_abs ($x, $y);
2657	});	2862	});
2658	}	2863	}
2659		2864
…		…
2748	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	2953	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2749		2954
2750	if ($tex) {	2955	if ($tex) {
2751	glEnable GL_TEXTURE_2D;	2956	glEnable GL_TEXTURE_2D;
2752	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2957	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2753	glColor 1, 1, 1, 1;	2958	glColor 0, 0, 0, 1;
2754	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2959	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2755	glDisable GL_TEXTURE_2D;	2960	glDisable GL_TEXTURE_2D;
2756	}	2961	}
2757	}	2962	}
2758		2963
2759	sub DESTROY {	2964	sub destroy {
2760	my ($self) = @_;	2965	my ($self) = @_;
2761		2966
2762	$self->{timer}->cancel	2967	$self->{timer}->cancel
2763	if $self->{timer};	2968	if $self->{timer};
2764		2969
2765	$self->SUPER::DESTROY;	2970	$self->SUPER::destroy;
2766	}	2971	}
2767		2972
2768	#############################################################################	2973	#############################################################################
2769		2974
2770	package CFClient::UI::Inventory;	2975	package CFClient::UI::Buttonbar;
2771		2976
2772	our @ISA = CFClient::UI::ScrolledWindow::;	2977	our @ISA = CFClient::UI::HBox::;
2773		2978
2774	sub new {	2979	# TODO: should actualyl wrap buttons and other goodies.
2775	my $class = shift;
2776
2777	my $self = $class->SUPER::new (
2778	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2779	@_,
2780	);
2781
2782	$self
2783	}
2784
2785	sub set_items {
2786	my ($self, $items) = @_;
2787
2788	$self->{scrolled}->clear;
2789	return unless $items;
2790
2791	my @items = sort {
2792	($a->{type} <=> $b->{type})
2793	or ($a->{name} cmp $b->{name})
2794	} @$items;
2795
2796	$self->{real_items} = \@items;
2797
2798	my $row = 0;
2799	for my $item (@items) {
2800	CFClient::Item::update_widgets $item;
2801
2802	$self->{scrolled}->add (0, $row, $item->{face_widget});
2803	$self->{scrolled}->add (1, $row, $item->{desc_widget});
2804	$self->{scrolled}->add (2, $row, $item->{weight_widget});
2805
2806	$row++;
2807	}
2808	}
2809		2980
2810	#############################################################################	2981	#############################################################################
2811		2982
2812	package CFClient::UI::Menu;	2983	package CFClient::UI::Menu;
2813		2984
…		…
2825	);	2996	);
2826		2997
2827	$self->add ($self->{vbox} = new CFClient::UI::VBox);	2998	$self->add ($self->{vbox} = new CFClient::UI::VBox);
2828		2999
2829	for my $item (@{ $self->{items} }) {	3000	for my $item (@{ $self->{items} }) {
2830	my ($widget, $cb) = @$item;	3001	my ($widget, $cb, $tooltip) = @$item;
2831		3002
2832	# handle various types of items, only text for now	3003	# handle various types of items, only text for now
2833	if (!ref $widget) {	3004	if (!ref $widget) {
2834	$widget = new CFClient::UI::Label	3005	$widget = new CFClient::UI::Label
2835	can_hover => 1,	3006	can_hover => 1,
2836	can_events => 1,	3007	can_events => 1,
2837	text => $widget;	3008	markup => $widget,
		3009	tooltip => $tooltip
2838	}	3010	}
2839		3011
2840	$self->{item}{$widget} = $item;	3012	$self->{item}{$widget} = $item;
2841		3013
2842	$self->{vbox}->add ($widget);	3014	$self->{vbox}->add ($widget);
…		…
2847		3019
2848	# popup given the event (must be a mouse button down event currently)	3020	# popup given the event (must be a mouse button down event currently)
2849	sub popup {	3021	sub popup {
2850	my ($self, $ev) = @_;	3022	my ($self, $ev) = @_;
2851		3023
2852	$self->_emit ("popdown");	3024	$self->emit ("popdown");
2853		3025
2854	# maybe save $GRAB? must be careful about events...	3026	# maybe save $GRAB? must be careful about events...
2855	$GRAB = $self;	3027	$GRAB = $self;
2856	$self->{button} = $ev->{button};	3028	$self->{button} = $ev->{button};
2857		3029
2858	$self->show;	3030	$self->show;
2859	$self->move ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3031	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2860	}	3032	}
2861		3033
2862	sub mouse_motion {	3034	sub invoke_mouse_motion {
2863	my ($self, $ev, $x, $y) = @_;	3035	my ($self, $ev, $x, $y) = @_;
2864		3036
2865	# TODO: should use vbox->find_widget or so	3037	# TODO: should use vbox->find_widget or so
2866	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3038	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2867	$self->{hover} = $self->{item}{$HOVER};	3039	$self->{hover} = $self->{item}{$HOVER};
2868	}
2869		3040
		3041	0
		3042	}
		3043
2870	sub button_up {	3044	sub invoke_button_up {
2871	my ($self, $ev, $x, $y) = @_;	3045	my ($self, $ev, $x, $y) = @_;
2872		3046
2873	if ($ev->{button} == $self->{button}) {	3047	if ($ev->{button} == $self->{button}) {
2874	undef $GRAB;	3048	undef $GRAB;
2875	$self->hide;	3049	$self->hide;
2876		3050
2877	$self->_emit ("popdown");	3051	$self->emit ("popdown");
2878	$self->{hover}[1]->() if $self->{hover};	3052	$self->{hover}[1]->() if $self->{hover};
		3053	} else {
		3054	return 0
		3055	}
		3056
2879	}	3057	1
2880	}	3058	}
2881		3059
2882	#############################################################################	3060	#############################################################################
2883		3061
2884	package CFClient::UI::Statusbox;	3062	package CFClient::UI::Multiplexer;
2885		3063
2886	our @ISA = CFClient::UI::VBox::;	3064	our @ISA = CFClient::UI::Container::;
2887		3065
2888	sub new {	3066	sub new {
2889	my $class = shift;	3067	my $class = shift;
2890		3068
2891	$class->SUPER::new (	3069	my $self = $class->SUPER::new (
		3070	@_,
		3071	);
		3072
		3073	$self->{current} = $self->{children}[0]
		3074	if @{ $self->{children} };
		3075
		3076	$self
		3077	}
		3078
		3079	sub add {
		3080	my ($self, @widgets) = @_;
		3081
		3082	$self->SUPER::add (@widgets);
		3083
		3084	$self->{current} = $self->{children}[0]
		3085	if @{ $self->{children} };
		3086	}
		3087
		3088	sub set_current_page {
		3089	my ($self, $page_or_widget) = @_;
		3090
		3091	my $widget = ref $page_or_widget
		3092	? $page_or_widget
		3093	: $self->{children}[$page_or_widget];
		3094
		3095	$self->{current} = $widget;
		3096	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3097
		3098	$self->emit (page_changed => $self->{current});
		3099
		3100	$self->realloc;
		3101	}
		3102
		3103	sub visible_children {
		3104	$_[0]{current}
		3105	}
		3106
		3107	sub size_request {
		3108	my ($self) = @_;
		3109
		3110	$self->{current}->size_request
		3111	}
		3112
		3113	sub invoke_size_allocate {
		3114	my ($self, $w, $h) = @_;
		3115
		3116	$self->{current}->configure (0, 0, $w, $h);
		3117
		3118	1
		3119	}
		3120
		3121	sub _draw {
		3122	my ($self) = @_;
		3123
		3124	$self->{current}->draw;
		3125	}
		3126
		3127	#############################################################################
		3128
		3129	package CFClient::UI::Notebook;
		3130
		3131	our @ISA = CFClient::UI::VBox::;
		3132
		3133	sub new {
		3134	my $class = shift;
		3135
		3136	my $self = $class->SUPER::new (
		3137	buttonbar => (new CFClient::UI::Buttonbar),
		3138	multiplexer => (new CFClient::UI::Multiplexer expand => 1),
		3139	# filter => # will be put between multiplexer and $self
		3140	@_,
		3141	);
		3142
		3143	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3144	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3145
		3146	$self
		3147	}
		3148
		3149	sub add {
		3150	my ($self, $title, $widget, $tooltip) = @_;
		3151
		3152	Scalar::Util::weaken $self;
		3153
		3154	$self->{buttonbar}->add (new CFClient::UI::Button
		3155	markup => $title,
		3156	tooltip => $tooltip,
		3157	on_activate => sub { $self->set_current_page ($widget) },
		3158	);
		3159
		3160	$self->{multiplexer}->add ($widget);
		3161	}
		3162
		3163	sub set_current_page {
		3164	my ($self, $page) = @_;
		3165
		3166	$self->{multiplexer}->set_current_page ($page);
		3167	$self->emit (page_changed => $self->{multiplexer}{current});
		3168	}
		3169
		3170	#############################################################################
		3171
		3172	package CFClient::UI::Combobox;
		3173
		3174	use utf8;
		3175
		3176	our @ISA = CFClient::UI::Button::;
		3177
		3178	sub new {
		3179	my $class = shift;
		3180
		3181	my $self = $class->SUPER::new (
		3182	options => [], # [value, title, longdesc], ...
		3183	value => undef,
		3184	@_,
		3185	);
		3186
		3187	$self->_set_value ($self->{value});
		3188
		3189	$self
		3190	}
		3191
		3192	sub invoke_button_down {
		3193	my ($self, $ev) = @_;
		3194
		3195	my @menu_items;
		3196
		3197	for (@{ $self->{options} }) {
		3198	my ($value, $title, $tooltip) = @$_;
		3199
		3200	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3201	}
		3202
		3203	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3204	}
		3205
		3206	sub _set_value {
		3207	my ($self, $value) = @_;
		3208
		3209	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3210	or return;
		3211
		3212	$self->{value} = $item->[0];
		3213	$self->set_markup ("$item->[1] ⇓");
		3214	$self->set_tooltip ($item->[2]);
		3215	}
		3216
		3217	sub set_value {
		3218	my ($self, $value) = @_;
		3219
		3220	return unless $self->{value} ne $value;
		3221
		3222	$self->_set_value ($value);
		3223	$self->emit (changed => $value);
		3224	}
		3225
		3226	#############################################################################
		3227
		3228	package CFClient::UI::Statusbox;
		3229
		3230	our @ISA = CFClient::UI::VBox::;
		3231
		3232	sub new {
		3233	my $class = shift;
		3234
		3235	my $self = $class->SUPER::new (
2892	fontsize => 0.8,	3236	fontsize => 0.8,
2893	@_,	3237	@_,
2894	)	3238	);
		3239
		3240	Scalar::Util::weaken (my $this = $self);
		3241
		3242	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3243
		3244	$self
2895	}	3245	}
2896		3246
2897	sub reorder {	3247	sub reorder {
2898	my ($self) = @_;	3248	my ($self) = @_;
2899	my $NOW = time;	3249	my $NOW = Time::HiRes::time;
		3250
		3251	# freeze display when hovering over any label
		3252	return if $CFClient::UI::TOOLTIP->{owner}
		3253	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},
		3254	values %{ $self->{item} };
2900		3255
2901	while (my ($k, $v) = each %{ $self->{item} }) {	3256	while (my ($k, $v) = each %{ $self->{item} }) {
2902	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3257	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2903	}	3258	}
2904		3259
…		…
2907	my @items = sort {	3262	my @items = sort {
2908	$a->{pri} <=> $b->{pri}	3263	$a->{pri} <=> $b->{pri}
2909	or $b->{id} <=> $a->{id}	3264	or $b->{id} <=> $a->{id}
2910	} values %{ $self->{item} };	3265	} values %{ $self->{item} };
2911		3266
		3267	$self->{timer}->interval (1);
		3268
2912	my $count = 10 + 1;	3269	my $count = 10 + 1;
2913	for my $item (@items) {	3270	for my $item (@items) {
2914	last unless --$count;	3271	last unless --$count;
2915		3272
2916	push @widgets, $item->{label} ||= do {	3273	my $label = $item->{label} ||= do {
2917	# TODO: doesn't handle markup well (read as: at all)	3274	# TODO: doesn't handle markup well (read as: at all)
2918	my $short = $item->{count} > 1	3275	my $short = $item->{count} > 1
2919	? "<b>$item->{count} ×</b> $item->{text}"	3276	? "<b>$item->{count} ×</b> $item->{text}"
2920	: $item->{text};	3277	: $item->{text};
2921		3278
…		…
2929	tooltip => $item->{tooltip},	3286	tooltip => $item->{tooltip},
2930	tooltip_font => $::FONT_PROP,	3287	tooltip_font => $::FONT_PROP,
2931	tooltip_width => 0.67,	3288	tooltip_width => 0.67,
2932	fontsize => $item->{fontsize} || $self->{fontsize},	3289	fontsize => $item->{fontsize} || $self->{fontsize},
2933	max_w => $::WIDTH * 0.44,	3290	max_w => $::WIDTH * 0.44,
2934	fg => $item->{fg},	3291	fg => [@{ $item->{fg} }],
2935	can_events => 1,	3292	can_events => 1,
2936	can_hover => 1	3293	can_hover => 1
2937	};	3294	};
		3295
		3296	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3297	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3298	$label->update;
		3299	$label->set_max_size (undef, $label->{req_h} * $diff)
		3300	if $diff < 1;
		3301	$self->{timer}->interval (1/30);
		3302	} else {
		3303	$label->{fg}[3] = $item->{fg}[3] || 1;
		3304	}
		3305
		3306	push @widgets, $label;
2938	}	3307	}
2939		3308
2940	$self->clear;	3309	$self->clear;
2941	$self->SUPER::add (reverse @widgets);	3310	$self->SUPER::add (reverse @widgets);
2942	}	3311	}
…		…
2947	$text =~ s/^\s+//;	3316	$text =~ s/^\s+//;
2948	$text =~ s/\s+$//;	3317	$text =~ s/\s+$//;
2949		3318
2950	return unless $text;	3319	return unless $text;
2951		3320
2952	my $timeout = time + ((delete $arg{timeout}) || 60);	3321	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2953		3322
2954	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3323	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2955		3324
2956	if (my $item = $self->{item}{$group}) {	3325	if (my $item = $self->{item}{$group}) {
2957	if ($item->{text} eq $text) {	3326	if ($item->{text} eq $text) {
2958	$item->{count}++;	3327	$item->{count}++;
2959	} else {	3328	} else {
2960	$item->{count} = 1;	3329	$item->{count} = 1;
2961	$item->{text} = $item->{tooltip} = $text;	3330	$item->{text} = $item->{tooltip} = $text;
2962	}	3331	}
2963	$item->{id} = ++$self->{id};	3332	$item->{id} += 0.2;#d#
2964	$item->{timeout} = $timeout;	3333	$item->{timeout} = $timeout;
2965	delete $item->{label};	3334	delete $item->{label};
2966	} else {	3335	} else {
2967	$self->{item}{$group} = {	3336	$self->{item}{$group} = {
2968	id => ++$self->{id},	3337	id => ++$self->{id},
…		…
2987		3356
2988	$self->reorder;	3357	$self->reorder;
2989	$self->SUPER::reconfigure;	3358	$self->SUPER::reconfigure;
2990	}	3359	}
2991		3360
		3361	sub destroy {
		3362	my ($self) = @_;
		3363
		3364	$self->{timer}->cancel;
		3365
		3366	$self->SUPER::destroy;
		3367	}
		3368
2992	#############################################################################	3369	#############################################################################
2993		3370
		3371	package CFClient::UI::Inventory;
		3372
		3373	our @ISA = CFClient::UI::ScrolledWindow::;
		3374
		3375	sub new {
		3376	my $class = shift;
		3377
		3378	my $self = $class->SUPER::new (
		3379	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
		3380	@_,
		3381	);
		3382
		3383	$self
		3384	}
		3385
		3386	sub set_items {
		3387	my ($self, $items) = @_;
		3388
		3389	$self->{child}->clear;
		3390	return unless $items;
		3391
		3392	my @items = sort {
		3393	($a->{type} <=> $b->{type})
		3394	or ($a->{name} cmp $b->{name})
		3395	} @$items;
		3396
		3397	$self->{real_items} = \@items;
		3398
		3399	my $row = 0;
		3400	for my $item (@items) {
		3401	CFClient::Item::update_widgets $item;
		3402
		3403	$self->{child}->add (0, $row, $item->{face_widget});
		3404	$self->{child}->add (1, $row, $item->{desc_widget});
		3405	$self->{child}->add (2, $row, $item->{weight_widget});
		3406
		3407	$row++;
		3408	}
		3409	}
		3410
		3411	#############################################################################
		3412
		3413	package CFClient::UI::BindEditor;
		3414
		3415	our @ISA = CFClient::UI::FancyFrame::;
		3416
		3417	sub new {
		3418	my $class = shift;
		3419
		3420	my $self = $class->SUPER::new (binding => [], commands => [], @_);
		3421
		3422	$self->add (my $vb = new CFClient::UI::VBox);
		3423
		3424
		3425	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
		3426	text => "start recording",
		3427	tooltip => "Start/Stops recording of actions."
		3428	."All subsequent actions after the recording started will be captured."
		3429	."The actions are displayed after the record was stopped."
		3430	."To bind the action you have to click on the 'Bind' button",
		3431	on_activate => sub {
		3432	unless ($self->{recording}) {
		3433	$self->start;
		3434	} else {
		3435	$self->stop;
		3436	}
		3437	});
		3438
		3439	$vb->add (new CFClient::UI::Label text => "Actions:");
		3440	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
		3441
		3442	$vb->add (new CFClient::UI::Label text => "Bound to: ");
		3443	$vb->add (my $hb = new CFClient::UI::HBox);
		3444	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
		3445	$hb->add (new CFClient::UI::Button
		3446	text => "bind",
		3447	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
		3448	on_activate => sub {
		3449	$self->ask_for_bind;
		3450	});
		3451
		3452	$vb->add (my $hb = new CFClient::UI::HBox);
		3453	$hb->add (new CFClient::UI::Button
		3454	text => "ok",
		3455	expand => 1,
		3456	tooltip => "This closes the binding editor and saves the binding",
		3457	on_activate => sub {
		3458	$self->hide;
		3459	$self->commit;
		3460	});
		3461
		3462	$hb->add (new CFClient::UI::Button
		3463	text => "cancel",
		3464	expand => 1,
		3465	tooltip => "This closes the binding editor without saving",
		3466	on_activate => sub {
		3467	$self->hide;
		3468	$self->{binding_cancel}->()
		3469	if $self->{binding_cancel};
		3470	});
		3471
		3472	$self->update_binding_widgets;
		3473
		3474	$self
		3475	}
		3476
		3477	sub commit {
		3478	my ($self) = @_;
		3479	my ($mod, $sym, $cmds) = $self->get_binding;
		3480	if ($sym != 0 && @$cmds > 0) {
		3481	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
		3482	."'. Don't forget 'Save Config'!");
		3483	$self->{binding_change}->($mod, $sym, $cmds)
		3484	if $self->{binding_change};
		3485	} else {
		3486	$::STATUSBOX->add ("No action bound, no key or action specified!");
		3487	$self->{binding_cancel}->()
		3488	if $self->{binding_cancel};
		3489	}
		3490	}
		3491
		3492	sub start {
		3493	my ($self) = @_;
		3494
		3495	$self->{rec_btn}->set_text ("stop recording");
		3496	$self->{recording} = 1;
		3497	$self->clear_command_list;
		3498	$::CONN->start_record if $::CONN;
		3499	}
		3500
		3501	sub stop {
		3502	my ($self) = @_;
		3503
		3504	$self->{rec_btn}->set_text ("start recording");
		3505	$self->{recording} = 0;
		3506
		3507	my $rec;
		3508	$rec = $::CONN->stop_record if $::CONN;
		3509	return unless ref $rec eq 'ARRAY';
		3510	$self->set_command_list ($rec);
		3511	}
		3512
		3513
		3514	sub ask_for_bind_and_commit {
		3515	my ($self) = @_;
		3516	$self->ask_for_bind (1);
		3517	}
		3518
		3519	sub ask_for_bind {
		3520	my ($self, $commit, $end_cb) = @_;
		3521
		3522	CFClient::Binder::open_binding_dialog (sub {
		3523	my ($mod, $sym) = @_;
		3524	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
		3525	$self->update_binding_widgets;
		3526	$self->commit if $commit;
		3527	$end_cb->() if $end_cb;
		3528	});
		3529	}
		3530
		3531	# $mod and $sym are the modifiers and key symbol
		3532	# $cmds is a array ref of strings (the commands)
		3533	# $cb is the callback that is executed on OK
		3534	# $ccb is the callback that is executed on CANCEL and
		3535	# when the binding was unsuccessful on OK
		3536	sub set_binding {
		3537	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
		3538
		3539	$self->clear_command_list;
		3540	$self->{recording} = 0;
		3541	$self->{rec_btn}->set_text ("start recording");
		3542
		3543	$self->{binding} = [$mod, $sym];
		3544	$self->{commands} = $cmds;
		3545
		3546	$self->{binding_change} = $cb;
		3547	$self->{binding_cancel} = $ccb;
		3548
		3549	$self->update_binding_widgets;
		3550	}
		3551
		3552	# this is a shortcut method that asks for a binding
		3553	# and then just binds it.
		3554	sub do_quick_binding {
		3555	my ($self, $cmds, $end_cb) = @_;
		3556	$self->set_binding (undef, undef, $cmds, sub {
		3557	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
		3558	});
		3559	$self->ask_for_bind (1, $end_cb);
		3560	}
		3561
		3562	sub update_binding_widgets {
		3563	my ($self) = @_;
		3564	my ($mod, $sym, $cmds) = $self->get_binding;
		3565	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
		3566	$self->set_command_list ($cmds);
		3567	}
		3568
		3569	sub get_binding {
		3570	my ($self) = @_;
		3571	return (
		3572	$self->{binding}->[0],
		3573	$self->{binding}->[1],
		3574	[ grep { defined $_ } @{$self->{commands}} ]
		3575	);
		3576	}
		3577
		3578	sub clear_command_list {
		3579	my ($self) = @_;
		3580	$self->{cmdbox}->clear ();
		3581	}
		3582
		3583	sub set_command_list {
		3584	my ($self, $cmds) = @_;
		3585
		3586	$self->{cmdbox}->clear ();
		3587	$self->{commands} = $cmds;
		3588
		3589	my $idx = 0;
		3590
		3591	for (@$cmds) {
		3592	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
		3593
		3594	my $i = $idx;
		3595	$hb->add (new CFClient::UI::Label text => $_);
		3596	$hb->add (new CFClient::UI::Button
		3597	text => "delete",
		3598	tooltip => "Deletes the action from the record",
		3599	on_activate => sub {
		3600	$self->{cmdbox}->remove ($hb);
		3601	$cmds->[$i] = undef;
		3602	});
		3603
		3604
		3605	$idx++
		3606	}
		3607	}
		3608
		3609	#############################################################################
		3610
		3611	package CFClient::UI::SpellList;
		3612
		3613	our @ISA = CFClient::UI::Table::;
		3614
		3615	sub new {
		3616	my $class = shift;
		3617
		3618	my $self = $class->SUPER::new (
		3619	binding => [],
		3620	commands => [],
		3621	@_,
		3622	)
		3623	}
		3624
		3625	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
		3626
		3627	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3628	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
		3629	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
		3630	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
		3631	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3632	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
		3633	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3634	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
		3635	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
		3636	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
		3637
		3638	sub rebuild_spell_list {
		3639	my ($self) = @_;
		3640
		3641	$CFClient::UI::ROOT->on_refresh ($self => sub {
		3642	$self->clear;
		3643
		3644	return unless $::CONN;
		3645
		3646	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
		3647	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
		3648	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
		3649	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
		3650	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
		3651
		3652	my $row = 0;
		3653
		3654	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
		3655	my $spell = $self->{spell}{$_};
		3656
		3657	$row++;
		3658
		3659	my $spell_cb = sub {
		3660	my ($widget, $ev) = @_;
		3661
		3662	if ($ev->{button} == 1) {
		3663	$::CONN->user_send ("cast $spell->{name}");
		3664	} elsif ($ev->{button} == 2) {
		3665	$::CONN->user_send ("invoke $spell->{name}");
		3666	} elsif ($ev->{button} == 3) {
		3667	(new CFClient::UI::Menu
		3668	items => [
		3669	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
		3670	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
		3671	],
		3672	)->popup ($ev);
		3673	} else {
		3674	return 0;
		3675	}
		3676
		3677	1
		3678	};
		3679
		3680	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
		3681
		3682	#TODO: add path info to tooltip
		3683	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
		3684
		3685	$self->add (0, $row, new CFClient::UI::Face
		3686	face => $spell->{face},
		3687	can_hover => 1,
		3688	can_events => 1,
		3689	tooltip => $tooltip,
		3690	on_button_down => $spell_cb,
		3691	);
		3692
		3693	$self->add (1, $row, new CFClient::UI::Label
		3694	expand => 1,
		3695	text => $spell->{name},
		3696	can_hover => 1,
		3697	can_events => 1,
		3698	tooltip => $tooltip,
		3699	on_button_down => $spell_cb,
		3700	);
		3701
		3702	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
		3703	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
		3704	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
		3705	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
		3706	}
		3707	});
		3708	}
		3709
		3710	sub add_spell {
		3711	my ($self, $spell) = @_;
		3712
		3713	$self->{spell}->{$spell->{name}} = $spell;
		3714	$self->rebuild_spell_list;
		3715	}
		3716
		3717	sub remove_spell {
		3718	my ($self, $spell) = @_;
		3719
		3720	delete $self->{spell}->{$spell->{name}};
		3721	$self->rebuild_spell_list;
		3722	}
		3723
		3724	sub clear_spells {
		3725	my ($self) = @_;
		3726
		3727	$self->{spell} = {};
		3728	$self->rebuild_spell_list;
		3729	}
		3730
		3731	#############################################################################
		3732
2994	package CFClient::UI::Root;	3733	package CFClient::UI::Root;
2995		3734
2996	our @ISA = CFClient::UI::Container::;	3735	our @ISA = CFClient::UI::Container::;
		3736
		3737	use List::Util qw(min max);
2997		3738
2998	use CFClient::OpenGL;	3739	use CFClient::OpenGL;
2999		3740
3000	sub new {	3741	sub new {
3001	my $class = shift;	3742	my $class = shift;
…		…
3008	Scalar::Util::weaken ($self->{root} = $self);	3749	Scalar::Util::weaken ($self->{root} = $self);
3009		3750
3010	$self	3751	$self
3011	}	3752	}
3012		3753
3013	sub configure {
3014	my ($self, $x, $y, $w, $h) = @_;
3015
3016	$self->{w} = $w;
3017	$self->{h} = $h;
3018	}
3019
3020	sub reconfigure {
3021	my ($self) = @_;
3022
3023	$self->SUPER::reconfigure;
3024
3025	$self->size_allocate ($self->{w}, $self->{h}, 1)
3026	if $self->{w};
3027	}
3028
3029	sub size_request {	3754	sub size_request {
3030	my ($self) = @_;	3755	my ($self) = @_;
3031		3756
3032	($self->{w}, $self->{h})	3757	($self->{w}, $self->{h})
3033	}	3758	}
…		…
3044	$coord = $max - $size if $coord > $max - $size;	3769	$coord = $max - $size if $coord > $max - $size;
3045		3770
3046	int $coord + 0.5	3771	int $coord + 0.5
3047	}	3772	}
3048		3773
3049	sub size_allocate {	3774	sub invoke_size_allocate {
3050	my ($self, $w, $h, $changed) = @_;	3775	my ($self, $w, $h) = @_;
3051		3776
3052	for my $child ($self->children) {	3777	for my $child ($self->children) {
3053	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3778	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3054		3779
3055	$X = $child->{force_x} if exists $child->{force_x};	3780	$X = $child->{force_x} if exists $child->{force_x};
…		…
3058	$X = _to_pixel $X, $W, $self->{w};	3783	$X = _to_pixel $X, $W, $self->{w};
3059	$Y = _to_pixel $Y, $H, $self->{h};	3784	$Y = _to_pixel $Y, $H, $self->{h};
3060		3785
3061	$child->configure ($X, $Y, $W, $H);	3786	$child->configure ($X, $Y, $W, $H);
3062	}	3787	}
		3788
		3789	1
3063	}	3790	}
3064		3791
3065	sub coord2local {	3792	sub coord2local {
3066	my ($self, $x, $y) = @_;	3793	my ($self, $x, $y) = @_;
3067		3794
…		…
3123	$_->()	3850	$_->()
3124	for values %{delete $self->{refresh_hook}};	3851	for values %{delete $self->{refresh_hook}};
3125	}	3852	}
3126		3853
3127	if ($self->{realloc}) {	3854	if ($self->{realloc}) {
		3855	my %queue;
3128	my @queue;	3856	my @queue;
		3857	my $widget;
3129		3858
		3859	outer:
3130	while () {	3860	while () {
3131	if ($self->{realloc}) {	3861	if (my $realloc = delete $self->{realloc}) {
3132	#TODO use array-of-depth approach	3862	for $widget (values %$realloc) {
		3863	$widget->{visible} or next; # do not resize invisible widgets
3133		3864
3134	@queue = sort { $a->{visible} <=> $b->{visible} }	3865	$queue{$widget+0}++ and next; # duplicates are common
3135	@queue, values %{delete $self->{realloc}};	3866
		3867	push @{ $queue[$widget->{visible}] }, $widget;
		3868	}
3136	}	3869	}
3137		3870
		3871	while () {
		3872	@queue or last outer;
		3873
3138	my $widget = pop @queue || last;	3874	$widget = pop @{ $queue[-1] || [] }
		3875	and last;
		3876
		3877	pop @queue;
		3878	}
3139		3879
3140	$widget->{visible} or last; # do not resize invisible widgets	3880	delete $queue{$widget+0};
3141		3881
3142	my ($w, $h) = $widget->size_request;	3882	my ($w, $h) = $widget->size_request;
3143		3883
3144	my $min_size = $widget->{is_toplevel} ? 16 : 0;	3884	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
		3885	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
3145		3886
3146	$w = List::Util::max $widget->{min_w} || $widget->{is_toplevel} * 16, $w;	3887	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
3147	$h = List::Util::max $widget->{min_h} || $widget->{is_toplevel} * 16, $h;	3888	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3148		3889
3149	$w = $widget->{force_w} if exists $widget->{force_w};	3890	$w = $widget->{force_w} if exists $widget->{force_w};
3150	$h = $widget->{force_h} if exists $widget->{force_h};	3891	$h = $widget->{force_h} if exists $widget->{force_h};
3151		3892
		3893	if ($widget->{req_w} != $w || $widget->{req_h} != $h
		3894	|| delete $widget->{force_realloc}) {
3152	$widget->{req_w} = $w;	3895	$widget->{req_w} = $w;
3153	$widget->{req_h} = $h;	3896	$widget->{req_h} = $h;
3154		3897
3155	$self->{size_alloc}{$widget} = [$widget, undef, undef];	3898	$self->{size_alloc}{$widget+0} = $widget;
3156		3899
3157	push @queue, $widget->{parent}	3900	if (my $parent = $widget->{parent}) {
3158	if ($self->{w} != $w || $self->{h} != $h) && $widget->{parent};	3901	$self->{realloc}{$parent+0} = $parent
		3902	unless $queue{$parent+0};
		3903
		3904	$parent->{force_size_alloc} = 1;
		3905	$self->{size_alloc}{$parent+0} = $parent;
		3906	}
		3907	}
		3908
		3909	delete $self->{realloc}{$widget+0};
3159	}	3910	}
3160	}	3911	}
3161		3912
3162	while (my $size_alloc = delete $self->{size_alloc}) {	3913	while (my $size_alloc = delete $self->{size_alloc}) {
3163	my @queue = sort $b->[0]{visible} <=> $a->[0]{visible},	3914	my @queue = sort { $b->{visible} <=> $a->{visible} }
3164	values %$size_alloc;	3915	values %$size_alloc;
3165		3916
3166	while () {	3917	while () {
3167	my ($widget, $w, $h) = @{ pop @queue or last };	3918	my $widget = pop @queue || last;
3168		3919
3169	$w = $widget->{w} || $widget->{req_w} unless defined $w;	3920	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3170	$h = $widget->{h} || $widget->{req_h} unless defined $h;
3171		3921
3172	$w = 0 if $w < 0;	3922	$w = 0 if $w < 0;
3173	$h = 0 if $h < 0;	3923	$h = 0 if $h < 0;
3174		3924
3175	$w = int $w + 0.5;	3925	$w = int $w + 0.5;
3176	$h = int $h + 0.5;	3926	$h = int $h + 0.5;
3177		3927
3178	my $changed = $widget->{w} != $w || $widget->{h} != $h;	3928	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3929	$widget->{old_w} = $widget->{w};
		3930	$widget->{old_h} = $widget->{h};
3179		3931
3180	$widget->{w} = $w;	3932	$widget->{w} = $w;
3181	$widget->{h} = $h;	3933	$widget->{h} = $h;
3182		3934
3183	$widget->emit (size_allocate => $w, $h, $changed);	3935	$widget->emit (size_allocate => $w, $h);
		3936	}
3184	}	3937	}
3185	}	3938	}
3186		3939
3187	while ($self->{post_alloc_hook}) {	3940	while ($self->{post_alloc_hook}) {
3188	$_->()	3941	$_->()
3189	for values %{delete $self->{post_alloc_hook}};	3942	for values %{delete $self->{post_alloc_hook}};
3190	}	3943	}
		3944
3191		3945
3192	glViewport 0, 0, $::WIDTH, $::HEIGHT;	3946	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3193	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	3947	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3194	glClear GL_COLOR_BUFFER_BIT;	3948	glClear GL_COLOR_BUFFER_BIT;
3195		3949
…		…
3197	glLoadIdentity;	3951	glLoadIdentity;
3198	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	3952	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3199	glMatrixMode GL_MODELVIEW;	3953	glMatrixMode GL_MODELVIEW;
3200	glLoadIdentity;	3954	glLoadIdentity;
3201		3955
		3956	{
		3957	package CFClient::UI::Base;
		3958
		3959	($draw_x, $draw_y, $draw_w, $draw_h) =
		3960	(0, 0, $self->{w}, $self->{h});
		3961	}
		3962
3202	$self->_draw;	3963	$self->_draw;
3203	}	3964	}
3204		3965
3205	#############################################################################	3966	#############################################################################
3206		3967

Diff Legend

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