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.278 by root, Sun Jun 4 23:05:06 2006 UTC vs.
Revision 1.362 by root, Sat Dec 9 21:26:46 2006 UTC

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

Diff Legend

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