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

Diff Legend

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