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.269 by root, Fri Jun 2 06:22:55 2006 UTC vs.
Revision 1.397 by root, Sat Jul 21 14:01:35 2007 UTC

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

Diff Legend

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