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

Diff Legend

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