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.270 by elmex, Fri Jun 2 09:02:49 2006 UTC vs.
Revision 1.394 by root, Sat Jul 21 13:54:03 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	#TODO# update range on size_allocate depending on child?
		1108
		1109	sub add {
		1110	my ($self, $widget) = @_;
		1111
		1112	$self->{vp}->add ($self->{child} = $widget);
		1113	}
		1114
		1115	sub update_slider {
		1116	my ($self) = @_;
		1117
		1118	my $child = ($self->{vp} or return)->child;
		1119
		1120	my ($w1, $w2) = ($child->{w}, $self->{vp}{w});
		1121	$self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);
		1122
		1123	my $visible = $w1 > $w2;
		1124	if ($visible != $self->{hslider_visible}) {
		1125	$self->{hslider_visible} = $visible;
		1126	$visible ? $self->SUPER::add ($self->{hslider})
		1127	: $self->SUPER::remove ($self->{hslider});
		1128	}
		1129
		1130	my ($h1, $h2) = ($child->{h}, $self->{vp}{h});
		1131	$self->{vslider}->set_range ([$self->{vslider}{range}[0], 0, $h1, $h2, 1]);
		1132
		1133	my $visible = $h1 > $h2;
		1134	if ($visible != $self->{vslider_visible}) {
		1135	$self->{vslider_visible} = $visible;
		1136	$visible ? $self->SUPER::add ($self->{vslider})
		1137	: $self->SUPER::remove ($self->{vslider});
		1138	}
		1139	}
		1140
976	sub update {	1141	sub update {
977	my ($self) = @_;	1142	my ($self) = @_;
978		1143
		1144	$self->update_slider;
979	$self->SUPER::update;	1145	$self->SUPER::update;
980
981	# todo: overwrite size_allocate of child
982	my $child = $self->{vp}->child;
983	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
984	}	1146	}
985		1147
		1148	sub invoke_mouse_wheel {
		1149	my ($self, $ev) = @_;
		1150
		1151	$self->{vslider}->emit (mouse_wheel => $ev)
		1152	if $ev->{dy};
		1153
		1154	$self->{hslider}->emit (mouse_wheel => $ev)
		1155	if $ev->{dx};
		1156
		1157	1
		1158	}
		1159
		1160	sub invoke_button_down {
		1161	my ($self, $ev, $x, $y) = @_;
		1162
		1163	if ($ev->{button} == 2) {
		1164	$self->grab_focus;
		1165
		1166	my $ox = $self->{vp}{view_x} + $ev->{x};
		1167	my $oy = $self->{vp}{view_y} + $ev->{y};
		1168
		1169	$self->{motion} = sub {
		1170	my ($ev, $x, $y) = @_;
		1171
		1172	$self->{vp}->set_offset ($ox - $ev->{x}, $oy - $ev->{y});
		1173	$self->update;
		1174	};
		1175
		1176	return 1;
		1177	}
		1178
		1179	0
		1180	}
		1181
		1182	sub invoke_button_up {
		1183	my ($self, $ev, $x, $y) = @_;
		1184
		1185	if (delete $self->{motion}) {
		1186	return 1;
		1187	}
		1188
		1189	0
		1190	}
		1191
		1192	sub invoke_mouse_motion {
		1193	my ($self, $ev, $x, $y) = @_;
		1194
		1195	if ($self->{motion}) {
		1196	$self->{motion}->($ev, $x, $y);
		1197	return 1;
		1198	}
		1199
		1200	0
		1201	}
		1202
986	sub size_allocate {	1203	sub invoke_size_allocate {
987	my ($self, $w, $h) = @_;	1204	my ($self, $w, $h) = @_;
988		1205
		1206	$self->update_slider;
989	$self->SUPER::size_allocate ($w, $h);	1207	$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	}	1208	}
994
995	#TODO# update range on size_allocate depending on child
996	# update viewport offset on scroll
997		1209
998	#############################################################################	1210	#############################################################################
999		1211
1000	package CFClient::UI::Frame;	1212	package CFPlus::UI::Frame;
1001		1213
1002	our @ISA = CFClient::UI::Bin::;	1214	our @ISA = CFPlus::UI::Bin::;
1003		1215
1004	use CFClient::OpenGL;	1216	use CFPlus::OpenGL;
1005		1217
1006	sub new {	1218	sub new {
1007	my $class = shift;	1219	my $class = shift;
1008		1220
1009	$class->SUPER::new (	1221	$class->SUPER::new (
…		…
1017		1229
1018	if ($self->{bg}) {	1230	if ($self->{bg}) {
1019	my ($w, $h) = @$self{qw(w h)};	1231	my ($w, $h) = @$self{qw(w h)};
1020		1232
1021	glEnable GL_BLEND;	1233	glEnable GL_BLEND;
1022	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	1234	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1023	glColor @{ $self->{bg} };	1235	glColor_premultiply @{ $self->{bg} };
1024		1236
1025	glBegin GL_QUADS;	1237	glBegin GL_QUADS;
1026	glVertex 0 , 0;	1238	glVertex 0 , 0;
1027	glVertex 0 , $h;	1239	glVertex 0 , $h;
1028	glVertex $w, $h;	1240	glVertex $w, $h;
…		…
1035	$self->SUPER::_draw;	1247	$self->SUPER::_draw;
1036	}	1248	}
1037		1249
1038	#############################################################################	1250	#############################################################################
1039		1251
1040	package CFClient::UI::FancyFrame;	1252	package CFPlus::UI::FancyFrame;
1041		1253
1042	our @ISA = CFClient::UI::Bin::;	1254	our @ISA = CFPlus::UI::Bin::;
1043		1255
1044	use CFClient::OpenGL;	1256	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		1257
1054	sub new {	1258	sub new {
1055	my ($class, %arg) = @_;	1259	my ($class, %arg) = @_;
1056		1260
1057	my $title = delete $arg{title};	1261	if ((exists $arg{label}) && !ref $arg{label}) {
		1262	$arg{label} = new CFPlus::UI::Label
		1263	align => 1,
		1264	valign => 0,
		1265	text => $arg{label},
		1266	fontsize => ($arg{border} || 0.8) * 0.75;
		1267	}
		1268
		1269	my $self = $class->SUPER::new (
		1270	# label => "",
		1271	fg => [0.6, 0.3, 0.1],
		1272	border => 0.8,
		1273	style => 'single',
		1274	%arg,
		1275	);
		1276
		1277	$self
		1278	}
		1279
		1280	sub add {
		1281	my ($self, @widgets) = @_;
		1282
		1283	$self->SUPER::add (@widgets);
		1284	$self->CFPlus::UI::Container::add ($self->{label}) if $self->{label};
		1285	}
		1286
		1287	sub border {
		1288	int $_[0]{border} * $::FONTSIZE
		1289	}
		1290
		1291	sub size_request {
		1292	my ($self) = @_;
		1293
		1294	($self->{label_w}, undef) = $self->{label}->size_request
		1295	if $self->{label};
		1296
		1297	my ($w, $h) = $self->SUPER::size_request;
		1298
		1299	(
		1300	$w + $self->border * 2,
		1301	$h + $self->border * 2,
		1302	)
		1303	}
		1304
		1305	sub invoke_size_allocate {
		1306	my ($self, $w, $h) = @_;
		1307
		1308	my $border = $self->border;
		1309
		1310	$w -= List::Util::max 0, $border * 2;
		1311	$h -= List::Util::max 0, $border * 2;
		1312
		1313	if (my $label = $self->{label}) {
		1314	$label->{w} = List::Util::max 0, List::Util::min $self->{label_w}, $w - $border * 2;
		1315	$label->{h} = List::Util::min $h, $border;
		1316	$label->invoke_size_allocate ($label->{w}, $label->{h});
		1317	}
		1318
		1319	$self->child->configure ($border, $border, $w, $h);
		1320
		1321	1
		1322	}
		1323
		1324	sub _draw {
		1325	my ($self) = @_;
		1326
		1327	my $child = $self->{children}[0];
		1328
		1329	my $border = $self->border;
		1330	my ($w, $h) = ($self->{w}, $self->{h});
		1331
		1332	$child->draw;
		1333
		1334	glColor @{$self->{fg}};
		1335	glBegin GL_LINE_STRIP;
		1336	glVertex $border * 1.5 , $border * 0.5 + 0.5;
		1337	glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5;
		1338	glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
		1339	glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
		1340	glVertex $w - $border * 0.5 + 0.5, $border * 0.5 + 0.5;
		1341	glVertex $self->{label} ? $border * 2 + $self->{label}{w} : $border * 1.5, $border * 0.5 + 0.5;
		1342	glEnd;
		1343
		1344	if ($self->{label}) {
		1345	glTranslate $border * 2, 0;
		1346	$self->{label}->_draw;
		1347	}
		1348	}
		1349
		1350	#############################################################################
		1351
		1352	package CFPlus::UI::Toplevel;
		1353
		1354	our @ISA = CFPlus::UI::Bin::;
		1355
		1356	use CFPlus::OpenGL;
		1357
		1358	my $bg =
		1359	new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png",
		1360	mipmap => 1, wrap => 1;
		1361
		1362	my @border =
		1363	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
		1364	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
		1365
		1366	my @icon =
		1367	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
		1368	qw(x1_move.png x1_resize.png);
		1369
		1370	sub new {
		1371	my ($class, %arg) = @_;
1058		1372
1059	my $self = $class->SUPER::new (	1373	my $self = $class->SUPER::new (
1060	bg => [1, 1, 1, 1],	1374	bg => [1, 1, 1, 1],
1061	border_bg => [1, 1, 1, 1],	1375	border_bg => [1, 1, 1, 1],
1062	border => 0.6,	1376	border => 0.6,
1063	can_events => 1,	1377	can_events => 1,
1064	min_w => 16,	1378	min_w => 64,
1065	min_h => 16,	1379	min_h => 32,
1066	%arg,	1380	%arg,
1067	);	1381	);
1068		1382
1069	$self->{title} = new CFClient::UI::Label	1383	$self->{title_widget} = new CFPlus::UI::Label
1070	align => 0,	1384	align => 0,
1071	valign => 1,	1385	valign => 1,
1072	text => $title,	1386	text => $self->{title},
1073	fontsize => $self->{border}	1387	fontsize => $self->{border},
1074	if defined $title;	1388	if exists $self->{title};
		1389
		1390	if ($self->{has_close_button}) {
		1391	$self->{close_button} =
		1392	new CFPlus::UI::ImageButton
		1393	path => 'x1_close.png',
		1394	on_activate => sub { $self->emit ("delete") };
		1395
		1396	$self->CFPlus::UI::Container::add ($self->{close_button});
		1397	}
1075		1398
1076	$self	1399	$self
1077	}	1400	}
1078		1401
1079	sub add {	1402	sub add {
1080	my ($self, @widgets) = @_;	1403	my ($self, @widgets) = @_;
1081		1404
1082	$self->SUPER::add (@widgets);	1405	$self->SUPER::add (@widgets);
		1406	$self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button};
1083	$self->CFClient::UI::Container::add ($self->{title}) if $self->{title};	1407	$self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1084	}	1408	}
1085		1409
1086	sub border {	1410	sub border {
1087	int $_[0]{border} * $::FONTSIZE	1411	int $_[0]{border} * $::FONTSIZE
1088	}	1412	}
1089		1413
1090	sub size_request {	1414	sub size_request {
1091	my ($self) = @_;	1415	my ($self) = @_;
1092		1416
1093	$self->{title}->size_request	1417	$self->{title_widget}->size_request
1094	if $self->{title};	1418	if $self->{title_widget};
		1419
		1420	$self->{close_button}->size_request
		1421	if $self->{close_button};
1095		1422
1096	my ($w, $h) = $self->SUPER::size_request;	1423	my ($w, $h) = $self->SUPER::size_request;
1097		1424
1098	(	1425	(
1099	$w + $self->border * 2,	1426	$w + $self->border * 2,
1100	$h + $self->border * 2,	1427	$h + $self->border * 2,
1101	)	1428	)
1102	}	1429	}
1103		1430
1104	sub size_allocate {	1431	sub invoke_size_allocate {
1105	my ($self, $w, $h) = @_;	1432	my ($self, $w, $h) = @_;
1106		1433
1107	if ($self->{title}) {	1434	if ($self->{title_widget}) {
1108	$self->{title}{w} = $w;	1435	$self->{title_widget}{w} = $w;
1109	$self->{title}{h} = $h;	1436	$self->{title_widget}{h} = $h;
1110	$self->{title}->size_allocate ($w, $h);	1437	$self->{title_widget}->invoke_size_allocate ($w, $h);
1111	}	1438	}
1112		1439
1113	my $border = $self->border;	1440	my $border = $self->border;
1114		1441
1115	$h -= List::Util::max 0, $border * 2;	1442	$h -= List::Util::max 0, $border * 2;
1116	$w -= List::Util::max 0, $border * 2;	1443	$w -= List::Util::max 0, $border * 2;
		1444
		1445	$self->child->configure ($border, $border, $w, $h);
		1446
		1447	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
		1448	if $self->{close_button};
		1449
		1450	1
		1451	}
		1452
		1453	sub invoke_delete {
		1454	my ($self) = @_;
		1455
		1456	$self->hide;
1117		1457
1118	$self->child->configure ($border, $border, $w, $h);	1458	1
1119	}	1459	}
1120		1460
1121	sub button_down {	1461	sub invoke_button_down {
1122	my ($self, $ev, $x, $y) = @_;	1462	my ($self, $ev, $x, $y) = @_;
1123		1463
1124	my ($w, $h) = @$self{qw(w h)};	1464	my ($w, $h) = @$self{qw(w h)};
1125	my $border = $self->border;	1465	my $border = $self->border;
1126		1466
…		…
1142	my $dy = $ev->{y} - $oy;	1482	my $dy = $ev->{y} - $oy;
1143		1483
1144	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);	1484	$self->{force_w} = $bw + $dx * ($mx ? -1 : 1);
1145	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);	1485	$self->{force_h} = $bh + $dy * ($my ? -1 : 1);
1146		1486
		1487	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1147	$self->realloc;	1488	$self->realloc;
1148	$self->move_abs ($wx + $dx * $mx, $wy + $dy * $my);
1149	};	1489	};
1150		1490
1151	} elsif ($lr ^ $td) {	1491	} elsif ($lr ^ $td) {
1152	my ($ox, $oy) = ($ev->{x}, $ev->{y});	1492	my ($ox, $oy) = ($ev->{x}, $ev->{y});
1153	my ($bx, $by) = ($self->{x}, $self->{y});	1493	my ($bx, $by) = ($self->{x}, $self->{y});
…		…
1156	my ($ev, $x, $y) = @_;	1496	my ($ev, $x, $y) = @_;
1157		1497
1158	($x, $y) = ($ev->{x}, $ev->{y});	1498	($x, $y) = ($ev->{x}, $ev->{y});
1159		1499
1160	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);	1500	$self->move_abs ($bx + $x - $ox, $by + $y - $oy);
		1501	# HACK: the next line is required to enforce placement
		1502	$self->{parent}->invoke_size_allocate ($self->{parent}{w}, $self->{parent}{h});
1161	};	1503	};
		1504	} else {
		1505	return 0;
		1506	}
		1507
1162	}	1508	1
1163	}	1509	}
1164		1510
1165	sub button_up {	1511	sub invoke_button_up {
1166	my ($self, $ev, $x, $y) = @_;	1512	my ($self, $ev, $x, $y) = @_;
1167		1513
1168	delete $self->{motion};	1514	! ! delete $self->{motion}
1169	}	1515	}
1170		1516
1171	sub mouse_motion {	1517	sub invoke_mouse_motion {
1172	my ($self, $ev, $x, $y) = @_;	1518	my ($self, $ev, $x, $y) = @_;
1173		1519
1174	$self->{motion}->($ev, $x, $y) if $self->{motion};	1520	$self->{motion}->($ev, $x, $y) if $self->{motion};
		1521
		1522	! ! $self->{motion}
		1523	}
		1524
		1525	sub invoke_visibility_change {
		1526	my ($self, $visible) = @_;
		1527
		1528	delete $self->{motion} unless $visible;
		1529
		1530	0
1175	}	1531	}
1176		1532
1177	sub _draw {	1533	sub _draw {
1178	my ($self) = @_;	1534	my ($self) = @_;
1179		1535
…		…
1186	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;	1542	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1187		1543
1188	my $border = $self->border;	1544	my $border = $self->border;
1189		1545
1190	glColor @{ $self->{border_bg} };	1546	glColor @{ $self->{border_bg} };
1191	$border[0]->draw_quad_alpha (0, 0, $w, $border);	1547	$border[0]->draw_quad_alpha ( 0, 0, $w, $border);
1192	$border[1]->draw_quad_alpha (0, $border, $border, $ch);	1548	$border[1]->draw_quad_alpha ( 0, $border, $border, $ch);
1193	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);	1549	$border[2]->draw_quad_alpha ($w - $border, $border, $border, $ch);
1194	$border[3]->draw_quad_alpha (0, $h - $border, $w, $border);	1550	$border[3]->draw_quad_alpha ( 0, $h - $border, $w, $border);
		1551
		1552	# move
		1553	my $w2 = ($w - $border) * .5;
		1554	my $h2 = ($h - $border) * .5;
		1555	$icon[0]->draw_quad_alpha ( 0, $h2, $border, $border);
		1556	$icon[0]->draw_quad_alpha ($w - $border, $h2, $border, $border);
		1557	$icon[0]->draw_quad_alpha ($w2 , $h - $border, $border, $border);
		1558
		1559	# resize
		1560	$icon[1]->draw_quad_alpha ( 0, 0, $border, $border);
		1561	$icon[1]->draw_quad_alpha ($w - $border, 0, $border, $border)
		1562	unless $self->{has_close_button};
		1563	$icon[1]->draw_quad_alpha ( 0, $h - $border, $border, $border);
		1564	$icon[1]->draw_quad_alpha ($w - $border, $h - $border, $border, $border);
1195		1565
1196	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {	1566	if (@{$self->{bg}} < 4 || $self->{bg}[3]) {
1197	glColor @{ $self->{bg} };	1567	glColor @{ $self->{bg} };
1198		1568
1199	# TODO: repeat texture not scale	1569	# TODO: repeat texture not scale
…		…
1205		1575
1206	glDisable GL_TEXTURE_2D;	1576	glDisable GL_TEXTURE_2D;
1207		1577
1208	$child->draw;	1578	$child->draw;
1209		1579
1210	if ($self->{title}) {	1580	if ($self->{title_widget}) {
1211	glTranslate 0, $border - $self->{h};	1581	glTranslate 0, $border - $self->{h};
1212	$self->{title}->_draw;	1582	$self->{title_widget}->_draw;
		1583
		1584	glTranslate 0, - ($border - $self->{h});
1213	}	1585	}
		1586
		1587	$self->{close_button}->draw
		1588	if $self->{close_button};
1214	}	1589	}
1215		1590
1216	#############################################################################	1591	#############################################################################
1217		1592
1218	package CFClient::UI::Table;	1593	package CFPlus::UI::Table;
1219		1594
1220	our @ISA = CFClient::UI::Base::;	1595	our @ISA = CFPlus::UI::Container::;
1221		1596
1222	use List::Util qw(max sum);	1597	use List::Util qw(max sum);
1223		1598
1224	use CFClient::OpenGL;	1599	use CFPlus::OpenGL;
1225		1600
1226	sub new {	1601	sub new {
1227	my $class = shift;	1602	my $class = shift;
1228		1603
1229	$class->SUPER::new (	1604	$class->SUPER::new (
1230	col_expand => [],	1605	col_expand => [],
		1606	row_expand => [],
1231	@_,	1607	@_,
1232	)	1608	)
1233	}	1609	}
1234		1610
1235	sub children {
1236	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1237	}
1238
1239	sub add {	1611	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) = @_;	1612	my ($self, @widgets) = @_;
		1613
		1614	for my $child (@widgets) {
		1615	$child->{rowspan} ||= 1;
		1616	$child->{colspan} ||= 1;
		1617	}
		1618
		1619	$self->SUPER::add (@widgets);
		1620	}
		1621
		1622	sub add_at {
		1623	my $self = shift;
		1624
		1625	my @widgets;
		1626
		1627	while (@_) {
		1628	my ($col, $row, $child) = splice @_, 0, 3, ();
		1629
		1630	$child->{row} = $row;
		1631	$child->{col} = $col;
		1632
		1633	push @widgets, $child;
		1634	}
		1635
		1636	$self->add (@widgets);
		1637	}
		1638
		1639	sub get_wh {
		1640	my ($self) = @_;
		1641
		1642	my (@w, @h);
1251		1643
1252	my @children = $self->children;	1644	my @children = $self->children;
1253	delete $self->{children};	1645
		1646	# first pass, columns
		1647	for my $widget (sort { $a->{colspan} <=> $b->{colspan} } @children) {
		1648	my ($c, $w, $cs) = @$widget{qw(col req_w colspan)};
		1649
		1650	my $sw = sum @w[$c .. $c + $cs - 1];
		1651
		1652	if ($w > $sw) {
		1653	$_ += ($w - $sw) / ($sw ? $sw / $_ : $cs) for @w[$c .. $c + $cs - 1];
		1654	}
1254		1655	}
1255	for (@children) {
1256	delete $_->{parent};
1257	$_->hide;
1258	}
1259		1656
1260	$self->realloc;	1657	# second pass, rows
1261	}	1658	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)};	1659	my ($r, $h, $rs) = @$widget{qw(row req_h rowspan)};
1276		1660
1277	$w[$x] = max $w[$x], $w;	1661	my $sh = sum @h[$r .. $r + $rs - 1];
1278	$h[$y] = max $h[$y], $h;	1662
		1663	if ($h > $sh) {
		1664	$_ += ($h - $sh) / ($sh ? $sh / $_ : $rs) for @h[$r .. $r + $rs - 1];
1279	}	1665	}
1280	}	1666	}
1281		1667
1282	(\@w, \@h)	1668	(\@w, \@h)
1283	}	1669	}
…		…
1291	(sum @$ws),	1677	(sum @$ws),
1292	(sum @$hs),	1678	(sum @$hs),
1293	)	1679	)
1294	}	1680	}
1295		1681
1296	sub size_allocate {	1682	sub invoke_size_allocate {
1297	my ($self, $w, $h) = @_;	1683	my ($self, $w, $h) = @_;
1298		1684
1299	my ($ws, $hs) = $self->get_wh;	1685	my ($ws, $hs) = $self->get_wh;
1300		1686
1301	my $req_w = (sum @$ws) || 1;	1687	my $req_w = (sum @$ws) || 1;
1302	my $req_h = (sum @$hs) || 1;	1688	my $req_h = (sum @$hs) || 1;
1303		1689
1304	# TODO: nicer code && do row_expand	1690	# now linearly scale the rows/columns to the allocated size
1305	my @col_expand = @{$self->{col_expand}};	1691	my @col_expand = @{$self->{col_expand}};
1306	@col_expand = (1) x @$ws unless @col_expand;	1692	@col_expand = (1) x @$ws unless @col_expand;
1307	my $col_expand = (sum @col_expand) || 1;	1693	my $col_expand = (sum @col_expand) || 1;
1308		1694
1309	# linearly scale sizes
1310	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;	1695	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1311	$hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1312		1696
1313	CFClient::UI::harmonize $ws;	1697	CFPlus::UI::harmonize $ws;
		1698
		1699	my @row_expand = @{$self->{row_expand}};
		1700	@row_expand = (1) x @$ws unless @row_expand;
		1701	my $row_expand = (sum @row_expand) || 1;
		1702
		1703	$hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs;
		1704
1314	CFClient::UI::harmonize $hs;	1705	CFPlus::UI::harmonize $hs;
1315		1706
1316	my $y;	1707	my @x; for (0 .. $#$ws) { $x[$_ + 1] = $x[$_] + $ws->[$_] }
		1708	my @y; for (0 .. $#$hs) { $y[$_ + 1] = $y[$_] + $hs->[$_] }
1317		1709
1318	for my $r (0 .. $#{$self->{children}}) {	1710	for my $widget ($self->children) {
1319	my $row = $self->{children}[$r]	1711	my ($r, $c, $w, $h, $rs, $cs) = @$widget{qw(row col req_w req_h rowspan colspan)};
1320	or next;
1321		1712
1322	my $x = 0;	1713	$widget->configure (
1323	my $row_h = $hs->[$r];	1714	$x[$c], $y[$r],
		1715	$x[$c + $cs] - $x[$c], $y[$r + $rs] - $y[$r],
1324		1716	);
1325	for my $c (0 .. $#$row) {	1717	}
1326	my $col_w = $ws->[$c];
1327		1718
1328	if (my $widget = $row->[$c]) {	1719	1
1329	$widget->configure ($x, $y, $col_w, $row_h);	1720	}
1330	}
1331		1721
1332	$x += $col_w;	1722	#############################################################################
		1723
		1724	package CFPlus::UI::Fixed;
		1725
		1726	use List::Util qw(min max);
		1727
		1728	our @ISA = CFPlus::UI::Container::;
		1729
		1730	sub add {
		1731	my ($self, $child, $posmode, $x, $y, $sizemode, $w, $h) = @_;
		1732
		1733	$child->{_fixed} = [$posmode, $x, $y, $sizemode, $w, $h];
		1734	$self->SUPER::add ($child);
		1735	}
		1736
		1737	sub _scale($$$) {
		1738	my ($mode, $val, $max) = @_;
		1739
		1740	$mode eq "abs" ? $val
		1741	: $mode eq "rel" ? $val * $max
		1742	: 0
		1743	}
		1744
		1745	sub size_request {
		1746	my ($self) = @_;
		1747
		1748	my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0);
		1749
		1750	# determine overall size by querying abs widgets
		1751	for my $child ($self->visible_children) {
		1752	my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };
		1753
		1754	if ($pos eq "abs") {
		1755	$w = _scale $size, $w, $child->{req_w};
		1756	$h = _scale $size, $h, $child->{req_h};
		1757
		1758	$x1 = min $x1, $x; $x2 = max $x2, $x + $w;
		1759	$y1 = min $y1, $y; $y2 = max $y2, $y + $h;
1333	}	1760	}
1334
1335	$y += $row_h;
1336	}	1761	}
1337		1762
1338	}	1763	my $W = $x2 - $x1;
		1764	my $H = $y2 - $y1;
1339		1765
1340	sub find_widget {	1766	# now layout remaining widgets
		1767	for my $child ($self->visible_children) {
		1768	my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };
		1769
		1770	if ($pos ne "abs") {
		1771	$x = _scale $pos, $x, $W;
		1772	$y = _scale $pos, $x, $H;
		1773	$w = _scale $size, $w, $child->{req_w};
		1774	$h = _scale $size, $h, $child->{req_h};
		1775
		1776	$x1 = min $x1, $x; $x2 = max $x2, $x + $w;
		1777	$y1 = min $y1, $y; $y2 = max $y2, $y + $h;
		1778	}
		1779	}
		1780
		1781	my $W = $x2 - $x1;
		1782	my $H = $y2 - $y1;
		1783
		1784	($W, $H)
		1785	}
		1786
		1787	sub invoke_size_allocate {
1341	my ($self, $x, $y) = @_;	1788	my ($self, $W, $H) = @_;
1342		1789
1343	$x -= $self->{x};	1790	for my $child ($self->visible_children) {
1344	$y -= $self->{y};	1791	my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };
1345		1792
1346	my $res;	1793	$x = _scale $pos, $x, $W;
		1794	$y = _scale $pos, $x, $H;
		1795	$w = _scale $size, $w, $child->{req_w};
		1796	$h = _scale $size, $h, $child->{req_h};
1347		1797
1348	for (grep $_, map @$_, grep $_, @{ $self->{children} }) {	1798	$child->configure ($x, $y, $w, $h);
1349	$res = $_->find_widget ($x, $y)	1799	}
1350	and return $res;	1800
1351	}	1801	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	}	1802	}
1363		1803
1364	#############################################################################	1804	#############################################################################
1365		1805
1366	package CFClient::UI::Box;	1806	package CFPlus::UI::Box;
1367		1807
1368	our @ISA = CFClient::UI::Container::;	1808	our @ISA = CFPlus::UI::Container::;
1369		1809
1370	sub size_request {	1810	sub size_request {
1371	my ($self) = @_;	1811	my ($self) = @_;
1372		1812
1373	$self->{vertical}	1813	$self->{vertical}
…		…
1379	(List::Util::sum map $_->{req_w}, @{$self->{children}}),	1819	(List::Util::sum map $_->{req_w}, @{$self->{children}}),
1380	(List::Util::max map $_->{req_h}, @{$self->{children}}),	1820	(List::Util::max map $_->{req_h}, @{$self->{children}}),
1381	)	1821	)
1382	}	1822	}
1383		1823
1384	sub size_allocate {	1824	sub invoke_size_allocate {
1385	my ($self, $w, $h) = @_;	1825	my ($self, $w, $h) = @_;
1386		1826
1387	my $space = $self->{vertical} ? $h : $w;	1827	my $space = $self->{vertical} ? $h : $w;
1388	my $children = $self->{children};	1828	my @children = $self->visible_children;
1389		1829
1390	my @req;	1830	my @req;
1391		1831
1392	if ($self->{homogeneous}) {	1832	if ($self->{homogeneous}) {
1393	@req = ($space / (@$children || 1)) x @$children;	1833	@req = ($space / (@children || 1)) x @children;
1394	} else {	1834	} else {
1395	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1835	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1396	my $req = List::Util::sum @req;	1836	my $req = List::Util::sum @req;
1397		1837
1398	if ($req > $space) {	1838	if ($req > $space) {
1399	# ah well, not enough space	1839	# ah well, not enough space
1400	$_ *= $space / $req for @req;	1840	$_ *= $space / $req for @req;
1401	} else {	1841	} else {
1402	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1842	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1403		1843
1404	$space = ($space - $req) / $expand; # remaining space to give away	1844	$space = ($space - $req) / $expand; # remaining space to give away
1405		1845
1406	$req[$_] += $space * $children->[$_]{expand}	1846	$req[$_] += $space * $children[$_]{expand}
1407	for 0 .. $#$children;	1847	for 0 .. $#children;
1408	}	1848	}
1409	}	1849	}
1410		1850
1411	CFClient::UI::harmonize \@req;	1851	CFPlus::UI::harmonize \@req;
1412		1852
1413	my $pos = 0;	1853	my $pos = 0;
1414	for (0 .. $#$children) {	1854	for (0 .. $#children) {
1415	my $alloc = $req[$_];	1855	my $alloc = $req[$_];
1416	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1856	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1417		1857
1418	$pos += $alloc;	1858	$pos += $alloc;
1419	}	1859	}
1420		1860
1421	1	1861	1
1422	}	1862	}
1423		1863
1424	#############################################################################	1864	#############################################################################
1425		1865
1426	package CFClient::UI::HBox;	1866	package CFPlus::UI::HBox;
1427		1867
1428	our @ISA = CFClient::UI::Box::;	1868	our @ISA = CFPlus::UI::Box::;
1429		1869
1430	sub new {	1870	sub new {
1431	my $class = shift;	1871	my $class = shift;
1432		1872
1433	$class->SUPER::new (	1873	$class->SUPER::new (
…		…
1436	)	1876	)
1437	}	1877	}
1438		1878
1439	#############################################################################	1879	#############################################################################
1440		1880
1441	package CFClient::UI::VBox;	1881	package CFPlus::UI::VBox;
1442		1882
1443	our @ISA = CFClient::UI::Box::;	1883	our @ISA = CFPlus::UI::Box::;
1444		1884
1445	sub new {	1885	sub new {
1446	my $class = shift;	1886	my $class = shift;
1447		1887
1448	$class->SUPER::new (	1888	$class->SUPER::new (
…		…
1451	)	1891	)
1452	}	1892	}
1453		1893
1454	#############################################################################	1894	#############################################################################
1455		1895
1456	package CFClient::UI::Label;	1896	package CFPlus::UI::Label;
1457		1897
1458	our @ISA = CFClient::UI::DrawBG::;	1898	our @ISA = CFPlus::UI::DrawBG::;
1459		1899
1460	use CFClient::OpenGL;	1900	use CFPlus::OpenGL;
1461		1901
1462	sub new {	1902	sub new {
1463	my ($class, %arg) = @_;	1903	my ($class, %arg) = @_;
1464		1904
1465	my $self = $class->SUPER::new (	1905	my $self = $class->SUPER::new (
…		…
1468	#active_bg => none	1908	#active_bg => none
1469	#font => default_font	1909	#font => default_font
1470	#text => initial text	1910	#text => initial text
1471	#markup => initial narkup	1911	#markup => initial narkup
1472	#max_w => maximum pixel width	1912	#max_w => maximum pixel width
		1913	#style => 0, # render flags
1473	ellipsise => 3, # end	1914	ellipsise => 3, # end
1474	layout => (new CFClient::Layout),	1915	layout => (new CFPlus::Layout),
1475	fontsize => 1,	1916	fontsize => 1,
1476	align => -1,	1917	align => -1,
1477	valign => -1,	1918	valign => -1,
1478	padding_x => 2,	1919	padding_x => 2,
1479	padding_y => 2,	1920	padding_y => 2,
1480	can_events => 0,	1921	can_events => 0,
1481	%arg	1922	%arg
1482	);	1923	);
1483		1924
1484	if (exists $self->{template}) {	1925	if (exists $self->{template}) {
1485	my $layout = new CFClient::Layout;	1926	my $layout = new CFPlus::Layout;
1486	$layout->set_text (delete $self->{template});	1927	$layout->set_text (delete $self->{template});
1487	$self->{template} = $layout;	1928	$self->{template} = $layout;
1488	}	1929	}
1489		1930
1490	if (exists $self->{markup}) {	1931	if (exists $self->{markup}) {
…		…
1494	}	1935	}
1495		1936
1496	$self	1937	$self
1497	}	1938	}
1498		1939
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 {	1940	sub update {
1510	my ($self) = @_;	1941	my ($self) = @_;
1511		1942
1512	delete $self->{texture};	1943	delete $self->{texture};
1513	$self->SUPER::update;	1944	$self->SUPER::update;
1514	}	1945	}
1515		1946
		1947	sub realloc {
		1948	my ($self) = @_;
		1949
		1950	delete $self->{ox};
		1951	$self->SUPER::realloc;
		1952	}
		1953
1516	sub set_text {	1954	sub set_text {
1517	my ($self, $text) = @_;	1955	my ($self, $text) = @_;
1518		1956
1519	return if $self->{text} eq "T$text";	1957	return if $self->{text} eq "T$text";
1520	$self->{text} = "T$text";	1958	$self->{text} = "T$text";
1521		1959
1522	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1523	$self->{layout}->set_text ($text);	1960	$self->{layout}->set_text ($text);
1524		1961
		1962	delete $self->{size_req};
1525	$self->realloc;	1963	$self->realloc;
1526	$self->update;	1964	$self->update;
1527	}	1965	}
1528		1966
1529	sub set_markup {	1967	sub set_markup {
…		…
1532	return if $self->{text} eq "M$markup";	1970	return if $self->{text} eq "M$markup";
1533	$self->{text} = "M$markup";	1971	$self->{text} = "M$markup";
1534		1972
1535	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1973	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1536		1974
1537	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1538	$self->{layout}->set_markup ($markup);	1975	$self->{layout}->set_markup ($markup);
1539		1976
		1977	delete $self->{size_req};
1540	$self->realloc;	1978	$self->realloc;
1541	$self->update;	1979	$self->update;
1542	}	1980	}
1543		1981
1544	sub size_request {	1982	sub size_request {
1545	my ($self) = @_;	1983	my ($self) = @_;
1546		1984
		1985	$self->{size_req} ||= do {
1547	$self->{layout}->set_font ($self->{font}) if $self->{font};	1986	$self->{layout}->set_font ($self->{font}) if $self->{font};
1548	$self->{layout}->set_width ($self->{max_w} || -1);	1987	$self->{layout}->set_width ($self->{max_w} || -1);
1549	$self->{layout}->set_ellipsise ($self->{ellipsise});	1988	$self->{layout}->set_ellipsise ($self->{ellipsise});
1550	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1989	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1551	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1990	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1552		1991
1553	my ($w, $h) = $self->{layout}->size;	1992	my ($w, $h) = $self->{layout}->size;
1554		1993
1555	if (exists $self->{template}) {	1994	if (exists $self->{template}) {
1556	$self->{template}->set_font ($self->{font}) if $self->{font};	1995	$self->{template}->set_font ($self->{font}) if $self->{font};
		1996	$self->{template}->set_width ($self->{max_w} || -1);
1557	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1997	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1558		1998
1559	my ($w2, $h2) = $self->{template}->size;	1999	my ($w2, $h2) = $self->{template}->size;
1560		2000
1561	$w = List::Util::max $w, $w2;	2001	$w = List::Util::max $w, $w2;
1562	$h = List::Util::max $h, $h2;	2002	$h = List::Util::max $h, $h2;
		2003	}
		2004
		2005	[$w, $h]
1563	}	2006	};
1564		2007
1565	($w, $h)	2008	@{ $self->{size_req} }
1566	}	2009	}
1567		2010
		2011	sub baseline_shift {
		2012	$_[0]{layout}->descent
		2013	}
		2014
1568	sub size_allocate {	2015	sub invoke_size_allocate {
1569	my ($self, $w, $h) = @_;	2016	my ($self, $w, $h) = @_;
1570		2017
1571	delete $self->{ox};	2018	delete $self->{ox};
1572		2019
1573	delete $self->{texture}	2020	delete $self->{texture}
1574	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};	2021	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		2022
		2023	1
1575	}	2024	}
1576		2025
1577	sub set_fontsize {	2026	sub set_fontsize {
1578	my ($self, $fontsize) = @_;	2027	my ($self, $fontsize) = @_;
1579		2028
1580	$self->{fontsize} = $fontsize;	2029	$self->{fontsize} = $fontsize;
		2030	delete $self->{size_req};
1581	delete $self->{texture};	2031	delete $self->{texture};
1582		2032
1583	$self->realloc;	2033	$self->realloc;
1584	}	2034	}
1585		2035
		2036	sub reconfigure {
		2037	my ($self) = @_;
		2038
		2039	delete $self->{size_req};
		2040	delete $self->{texture};
		2041
		2042	$self->SUPER::reconfigure;
		2043	}
		2044
1586	sub _draw {	2045	sub _draw {
1587	my ($self) = @_;	2046	my ($self) = @_;
1588		2047
1589	$self->SUPER::_draw; # draw background, if applicable	2048	$self->SUPER::_draw; # draw background, if applicable
1590		2049
1591	my $tex = $self->{texture} ||= do {	2050	my $size = $self->{texture} ||= do {
1592	$self->{layout}->set_foreground (@{$self->{fg}});	2051	$self->{layout}->set_foreground (@{$self->{fg}});
1593	$self->{layout}->set_font ($self->{font}) if $self->{font};	2052	$self->{layout}->set_font ($self->{font}) if $self->{font};
1594	$self->{layout}->set_width ($self->{w});	2053	$self->{layout}->set_width ($self->{w});
1595	$self->{layout}->set_ellipsise ($self->{ellipsise});	2054	$self->{layout}->set_ellipsise ($self->{ellipsise});
1596	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	2055	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1597	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2056	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1598		2057
1599	new_from_layout CFClient::Texture $self->{layout}	2058	[$self->{layout}->size]
1600	};	2059	};
1601		2060
1602	unless (exists $self->{ox}) {	2061	unless (exists $self->{ox}) {
1603	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	2062	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1604	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	2063	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1605	: ($self->{w} - $tex->{w}) * 0.5);	2064	: ($self->{w} - $size->[0]) * 0.5);
1606		2065
1607	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	2066	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1608	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	2067	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1609	: ($self->{h} - $tex->{h}) * 0.5);	2068	: ($self->{h} - $size->[1]) * 0.5);
1610	};	2069	};
1611		2070
1612	glEnable GL_TEXTURE_2D;	2071	my $w = List::Util::min $self->{w} + 4, $size->[0];
1613	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2072	my $h = List::Util::min $self->{h} + 2, $size->[1];
1614		2073
1615	if ($tex->{format} == GL_ALPHA) {	2074	$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	}	2075	}
1624		2076
1625	#############################################################################	2077	#############################################################################
1626		2078
1627	package CFClient::UI::EntryBase;	2079	package CFPlus::UI::EntryBase;
1628		2080
1629	our @ISA = CFClient::UI::Label::;	2081	our @ISA = CFPlus::UI::Label::;
1630		2082
1631	use CFClient::OpenGL;	2083	use CFPlus::OpenGL;
1632		2084
1633	sub new {	2085	sub new {
1634	my $class = shift;	2086	my $class = shift;
1635		2087
1636	$class->SUPER::new (	2088	$class->SUPER::new (
…		…
1640	active_fg => [0, 0, 0],	2092	active_fg => [0, 0, 0],
1641	can_hover => 1,	2093	can_hover => 1,
1642	can_focus => 1,	2094	can_focus => 1,
1643	valign => 0,	2095	valign => 0,
1644	can_events => 1,	2096	can_events => 1,
		2097	ellipsise => 0,
1645	#text => ...	2098	#text => ...
		2099	#hidden => "*",
1646	@_	2100	@_
1647	)	2101	)
1648	}	2102	}
1649		2103
1650	sub _set_text {	2104	sub _set_text {
…		…
1652		2106
1653	delete $self->{cur_h};	2107	delete $self->{cur_h};
1654		2108
1655	return if $self->{text} eq $text;	2109	return if $self->{text} eq $text;
1656		2110
1657	delete $self->{texture};
1658
1659	$self->{last_activity} = $::NOW;	2111	$self->{last_activity} = $::NOW;
1660	$self->{text} = $text;	2112	$self->{text} = $text;
1661		2113
1662	$text =~ s/./*/g if $self->{hidden};	2114	$text =~ s/./*/g if $self->{hidden};
1663	$self->{layout}->set_text ("$text ");	2115	$self->{layout}->set_text ("$text ");
		2116	delete $self->{size_req};
1664		2117
1665	$self->_emit (changed => $self->{text});	2118	$self->emit (changed => $self->{text});
		2119
		2120	$self->realloc;
		2121	$self->update;
1666	}	2122	}
1667		2123
1668	sub set_text {	2124	sub set_text {
1669	my ($self, $text) = @_;	2125	my ($self, $text) = @_;
1670		2126
1671	$self->{cursor} = length $text;	2127	$self->{cursor} = length $text;
1672	$self->_set_text ($text);	2128	$self->_set_text ($text);
1673
1674	$self->realloc;
1675	}	2129	}
1676		2130
1677	sub get_text {	2131	sub get_text {
1678	$_[0]{text}	2132	$_[0]{text}
1679	}	2133	}
…		…
1684	my ($w, $h) = $self->SUPER::size_request;	2138	my ($w, $h) = $self->SUPER::size_request;
1685		2139
1686	($w + 1, $h) # add 1 for cursor	2140	($w + 1, $h) # add 1 for cursor
1687	}	2141	}
1688		2142
1689	sub key_down {	2143	sub invoke_key_down {
1690	my ($self, $ev) = @_;	2144	my ($self, $ev) = @_;
1691		2145
1692	my $mod = $ev->{mod};	2146	my $mod = $ev->{mod};
1693	my $sym = $ev->{sym};	2147	my $sym = $ev->{sym};
1694	my $uni = $ev->{unicode};	2148	my $uni = $ev->{unicode};
1695		2149
1696	my $text = $self->get_text;	2150	my $text = $self->get_text;
		2151
		2152	$self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;
1697		2153
1698	if ($uni == 8) {	2154	if ($uni == 8) {
1699	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	2155	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1700	} elsif ($uni == 127) {	2156	} elsif ($uni == 127) {
1701	substr $text, $self->{cursor}, 1, "";	2157	substr $text, $self->{cursor}, 1, "";
1702	} elsif ($sym == CFClient::SDLK_LEFT) {	2158	} elsif ($sym == CFPlus::SDLK_LEFT) {
1703	--$self->{cursor} if $self->{cursor};	2159	--$self->{cursor} if $self->{cursor};
1704	} elsif ($sym == CFClient::SDLK_RIGHT) {	2160	} elsif ($sym == CFPlus::SDLK_RIGHT) {
1705	++$self->{cursor} if $self->{cursor} < length $self->{text};	2161	++$self->{cursor} if $self->{cursor} < length $self->{text};
1706	} elsif ($sym == CFClient::SDLK_HOME) {	2162	} elsif ($sym == CFPlus::SDLK_HOME) {
		2163	# what a hack
		2164	$self->{cursor} =
		2165	(substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
		2166	? length $1
		2167	: 0;
		2168	} elsif ($sym == CFPlus::SDLK_END) {
		2169	# uh, again
		2170	$self->{cursor} =
		2171	(substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
		2172	? $self->{cursor} + length $1
		2173	: length $self->{text};
		2174	} elsif ($uni == 21) { # ctrl-u
		2175	$text = "";
1707	$self->{cursor} = 0;	2176	$self->{cursor} = 0;
1708	} elsif ($sym == CFClient::SDLK_END) {
1709	$self->{cursor} = length $text;
1710	} elsif ($uni == 27) {	2177	} elsif ($uni == 27) {
1711	$self->_emit ('escape');	2178	$self->emit ('escape');
1712	} elsif ($uni) {	2179	} elsif ($uni == 0x0d) {
		2180	substr $text, $self->{cursor}++, 0, "\012";
		2181	} elsif ($uni >= 0x20) {
1713	substr $text, $self->{cursor}++, 0, chr $uni;	2182	substr $text, $self->{cursor}++, 0, chr $uni;
		2183	} else {
		2184	return 0;
1714	}	2185	}
1715		2186
1716	$self->_set_text ($text);	2187	$self->_set_text ($text);
1717		2188
1718	$self->realloc;	2189	$self->realloc;
1719	}	2190	$self->update;
1720		2191
		2192	1
		2193	}
		2194
1721	sub focus_in {	2195	sub invoke_focus_in {
1722	my ($self) = @_;	2196	my ($self) = @_;
1723		2197
1724	$self->{last_activity} = $::NOW;	2198	$self->{last_activity} = $::NOW;
1725		2199
1726	$self->SUPER::focus_in;	2200	$self->SUPER::invoke_focus_in
1727	}	2201	}
1728		2202
1729	sub button_down {	2203	sub invoke_button_down {
1730	my ($self, $ev, $x, $y) = @_;	2204	my ($self, $ev, $x, $y) = @_;
1731		2205
1732	$self->SUPER::button_down ($ev, $x, $y);	2206	$self->SUPER::invoke_button_down ($ev, $x, $y);
1733		2207
1734	my $idx = $self->{layout}->xy_to_index ($x, $y);	2208	my $idx = $self->{layout}->xy_to_index ($x, $y);
1735		2209
1736	# byte-index to char-index	2210	# byte-index to char-index
1737	my $text = $self->{text};	2211	my $text = $self->{text};
1738	utf8::encode $text;	2212	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1739	$self->{cursor} = length substr $text, 0, $idx;	2213	$self->{cursor} = length $text;
1740		2214
1741	$self->_set_text ($self->{text});	2215	$self->_set_text ($self->{text});
1742	$self->update;	2216	$self->update;
		2217
		2218	1
1743	}	2219	}
1744		2220
1745	sub mouse_motion {	2221	sub invoke_mouse_motion {
1746	my ($self, $ev, $x, $y) = @_;	2222	my ($self, $ev, $x, $y) = @_;
1747	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	2223	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		2224
		2225	1
1748	}	2226	}
1749		2227
1750	sub _draw {	2228	sub _draw {
1751	my ($self) = @_;	2229	my ($self) = @_;
1752		2230
1753	local $self->{fg} = $self->{fg};	2231	local $self->{fg} = $self->{fg};
1754		2232
1755	if ($FOCUS == $self) {	2233	if ($FOCUS == $self) {
1756	glColor @{$self->{active_bg}};	2234	glColor_premultiply @{$self->{active_bg}};
1757	$self->{fg} = $self->{active_fg};	2235	$self->{fg} = $self->{active_fg};
1758	} else {	2236	} else {
1759	glColor @{$self->{bg}};	2237	glColor_premultiply @{$self->{bg}};
1760	}	2238	}
1761		2239
1762	glEnable GL_BLEND;	2240	glEnable GL_BLEND;
1763	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2241	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1764	glBegin GL_QUADS;	2242	glBegin GL_QUADS;
1765	glVertex 0 , 0;	2243	glVertex 0 , 0;
1766	glVertex 0 , $self->{h};	2244	glVertex 0 , $self->{h};
1767	glVertex $self->{w}, $self->{h};	2245	glVertex $self->{w}, $self->{h};
1768	glVertex $self->{w}, 0;	2246	glVertex $self->{w}, 0;
…		…
1779	utf8::encode $text;	2257	utf8::encode $text;
1780		2258
1781	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)	2259	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1782	}	2260	}
1783		2261
1784	glColor @{$self->{fg}};
1785	glBegin GL_LINES;	2262	glBegin GL_LINES;
1786	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};	2263	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};	2264	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1788	glEnd;	2265	glEnd;
1789	}	2266	}
1790	}	2267	}
1791		2268
		2269	#############################################################################
		2270
1792	package CFClient::UI::Entry;	2271	package CFPlus::UI::Entry;
1793		2272
1794	our @ISA = CFClient::UI::EntryBase::;	2273	our @ISA = CFPlus::UI::EntryBase::;
1795		2274
1796	use CFClient::OpenGL;	2275	use CFPlus::OpenGL;
1797		2276
1798	sub key_down {	2277	sub invoke_key_down {
1799	my ($self, $ev) = @_;	2278	my ($self, $ev) = @_;
1800		2279
1801	my $sym = $ev->{sym};	2280	my $sym = $ev->{sym};
1802		2281
1803	if ($sym == 13) {	2282	if ($ev->{uni} == 0x0d || $sym == 13) {
1804	unshift @{$self->{history}},	2283	unshift @{$self->{history}},
1805	my $txt = $self->get_text;	2284	my $txt = $self->get_text;
		2285
1806	$self->{history_pointer} = -1;	2286	$self->{history_pointer} = -1;
1807	$self->{history_saveback} = '';	2287	$self->{history_saveback} = '';
1808	$self->_emit (activate => $txt);	2288	$self->emit (activate => $txt);
1809	$self->update;	2289	$self->update;
1810		2290
1811	} elsif ($sym == CFClient::SDLK_UP) {	2291	} elsif ($sym == CFPlus::SDLK_UP) {
1812	if ($self->{history_pointer} < 0) {	2292	if ($self->{history_pointer} < 0) {
1813	$self->{history_saveback} = $self->get_text;	2293	$self->{history_saveback} = $self->get_text;
1814	}	2294	}
1815	if (@{$self->{history} || []} > 0) {	2295	if (@{$self->{history} || []} > 0) {
1816	$self->{history_pointer}++;	2296	$self->{history_pointer}++;
…		…
1818	$self->{history_pointer} = @{$self->{history} || []} - 1;	2298	$self->{history_pointer} = @{$self->{history} || []} - 1;
1819	}	2299	}
1820	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2300	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1821	}	2301	}
1822		2302
1823	} elsif ($sym == CFClient::SDLK_DOWN) {	2303	} elsif ($sym == CFPlus::SDLK_DOWN) {
1824	$self->{history_pointer}--;	2304	$self->{history_pointer}--;
1825	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2305	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1826		2306
1827	if ($self->{history_pointer} >= 0) {	2307	if ($self->{history_pointer} >= 0) {
1828	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2308	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1829	} else {	2309	} else {
1830	$self->set_text ($self->{history_saveback});	2310	$self->set_text ($self->{history_saveback});
1831	}	2311	}
1832		2312
1833	} else {	2313	} else {
1834	$self->SUPER::key_down ($ev);	2314	return $self->SUPER::invoke_key_down ($ev)
		2315	}
		2316
1835	}	2317	1
1836
1837	}	2318	}
1838		2319
1839	#############################################################################	2320	#############################################################################
1840		2321
		2322	package CFPlus::UI::TextEdit;
		2323
		2324	our @ISA = CFPlus::UI::EntryBase::;
		2325
		2326	use CFPlus::OpenGL;
		2327
		2328	sub move_cursor_ver {
		2329	my ($self, $dy) = @_;
		2330
		2331	my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
		2332
		2333	$y += $dy;
		2334
		2335	if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
		2336	$self->{cursor} = $index;
		2337	delete $self->{cur_h};
		2338	$self->update;
		2339	return;
		2340	}
		2341	}
		2342
		2343	sub invoke_key_down {
		2344	my ($self, $ev) = @_;
		2345
		2346	my $sym = $ev->{sym};
		2347
		2348	if ($sym == CFPlus::SDLK_UP) {
		2349	$self->move_cursor_ver (-1);
		2350	} elsif ($sym == CFPlus::SDLK_DOWN) {
		2351	$self->move_cursor_ver (+1);
		2352	} else {
		2353	return $self->SUPER::invoke_key_down ($ev)
		2354	}
		2355
		2356	1
		2357	}
		2358
		2359	#############################################################################
		2360
1841	package CFClient::UI::Button;	2361	package CFPlus::UI::Button;
1842		2362
1843	our @ISA = CFClient::UI::Label::;	2363	our @ISA = CFPlus::UI::Label::;
1844		2364
1845	use CFClient::OpenGL;	2365	use CFPlus::OpenGL;
1846		2366
1847	my @tex =	2367	my @tex =
1848	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2368	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1849	qw(b1_button_active.png);	2369	qw(b1_button_inactive.png b1_button_active.png);
1850		2370
1851	sub new {	2371	sub new {
1852	my $class = shift;	2372	my $class = shift;
1853		2373
1854	$class->SUPER::new (	2374	$class->SUPER::new (
1855	padding_x => 4,	2375	padding_x => 4,
1856	padding_y => 4,	2376	padding_y => 4,
1857	fg => [1, 1, 1],	2377	fg => [1.0, 1.0, 1.0],
1858	active_fg => [0, 0, 1],	2378	active_fg => [0.8, 0.8, 0.8],
1859	can_hover => 1,	2379	can_hover => 1,
1860	align => 0,	2380	align => 0,
1861	valign => 0,	2381	valign => 0,
1862	can_events => 1,	2382	can_events => 1,
1863	@_	2383	@_
1864	)	2384	)
1865	}	2385	}
1866		2386
1867	sub activate { }
1868
1869	sub button_up {	2387	sub invoke_button_up {
1870	my ($self, $ev, $x, $y) = @_;	2388	my ($self, $ev, $x, $y) = @_;
1871		2389
1872	$self->emit ("activate")	2390	$self->emit ("activate")
1873	if $x >= 0 && $x < $self->{w}	2391	if $x >= 0 && $x < $self->{w}
1874	&& $y >= 0 && $y < $self->{h};	2392	&& $y >= 0 && $y < $self->{h};
		2393
		2394	1
1875	}	2395	}
1876		2396
1877	sub _draw {	2397	sub _draw {
1878	my ($self) = @_;	2398	my ($self) = @_;
1879		2399
1880	local $self->{fg} = $self->{fg};	2400	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1881
1882	if ($GRAB == $self) {
1883	$self->{fg} = $self->{active_fg};
1884	}
1885		2401
1886	glEnable GL_TEXTURE_2D;	2402	glEnable GL_TEXTURE_2D;
1887	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2403	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1888	glColor 0, 0, 0, 1;	2404	glColor 0, 0, 0, 1;
1889		2405
		2406	my $tex = $tex[$GRAB == $self];
1890	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2407	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1891		2408
1892	glDisable GL_TEXTURE_2D;	2409	glDisable GL_TEXTURE_2D;
1893		2410
1894	$self->SUPER::_draw;	2411	$self->SUPER::_draw;
1895	}	2412	}
1896		2413
1897	#############################################################################	2414	#############################################################################
1898		2415
1899	package CFClient::UI::CheckBox;	2416	package CFPlus::UI::CheckBox;
1900		2417
1901	our @ISA = CFClient::UI::DrawBG::;	2418	our @ISA = CFPlus::UI::DrawBG::;
1902		2419
1903	my @tex =	2420	my @tex =
1904	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2421	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1905	qw(c1_checkbox_bg.png c1_checkbox_active.png);	2422	qw(c1_checkbox_bg.png c1_checkbox_active.png);
1906		2423
1907	use CFClient::OpenGL;	2424	use CFPlus::OpenGL;
1908		2425
1909	sub new {	2426	sub new {
1910	my $class = shift;	2427	my $class = shift;
1911		2428
1912	$class->SUPER::new (	2429	$class->SUPER::new (
…		…
1926	my ($self) = @_;	2443	my ($self) = @_;
1927		2444
1928	(6) x 2	2445	(6) x 2
1929	}	2446	}
1930		2447
		2448	sub toggle {
		2449	my ($self) = @_;
		2450
		2451	$self->{state} = !$self->{state};
		2452	$self->emit (changed => $self->{state});
		2453	$self->update;
		2454	}
		2455
1931	sub button_down {	2456	sub invoke_button_down {
1932	my ($self, $ev, $x, $y) = @_;	2457	my ($self, $ev, $x, $y) = @_;
1933		2458
1934	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2459	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1935	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2460	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1936	$self->{state} = !$self->{state};	2461	$self->toggle;
1937	$self->_emit (changed => $self->{state});	2462	} else {
		2463	return 0
		2464	}
		2465
1938	}	2466	1
1939	}	2467	}
1940		2468
1941	sub _draw {	2469	sub _draw {
1942	my ($self) = @_;	2470	my ($self) = @_;
1943		2471
…		…
1958	glDisable GL_TEXTURE_2D;	2486	glDisable GL_TEXTURE_2D;
1959	}	2487	}
1960		2488
1961	#############################################################################	2489	#############################################################################
1962		2490
1963	package CFClient::UI::Image;	2491	package CFPlus::UI::Image;
1964		2492
1965	our @ISA = CFClient::UI::Base::;	2493	our @ISA = CFPlus::UI::Base::;
1966		2494
1967	use CFClient::OpenGL;	2495	use CFPlus::OpenGL;
1968	use Carp qw/confess/;
1969		2496
1970	our %loaded_images;	2497	our %texture_cache;
1971		2498
1972	sub new {	2499	sub new {
1973	my $class = shift;	2500	my $class = shift;
1974		2501
1975	my $self = $class->SUPER::new (can_events => 0, @_);	2502	my $self = $class->SUPER::new (
		2503	can_events => 0,
		2504	@_,
		2505	);
1976		2506
1977	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2507	$self->{path} || $self->{tex}
		2508	or Carp::croak "'path' or 'tex' attributes required";
1978		2509
1979	$loaded_images{$self->{image}} ||=	2510	$self->{tex} ||= $texture_cache{$self->{path}} ||=
1980	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2511	new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
1981		2512
1982	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2513	CFPlus::weaken $texture_cache{$self->{path}};
1983		2514
1984	Scalar::Util::weaken $loaded_images{$self->{image}};	2515	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
1985
1986	$self->{aspect} = $tex->{w} / $tex->{h};
1987		2516
1988	$self	2517	$self
1989	}	2518	}
1990		2519
		2520	sub STORABLE_freeze {
		2521	my ($self, $cloning) = @_;
		2522
		2523	$self->{path}
		2524	or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
		2525
		2526	$self->{path}
		2527	}
		2528
		2529	sub STORABLE_attach {
		2530	my ($self, $cloning, $path) = @_;
		2531
		2532	$self->new (path => $path)
		2533	}
		2534
1991	sub size_request {	2535	sub size_request {
1992	my ($self) = @_;	2536	my ($self) = @_;
1993		2537
1994	($self->{tex}->{w}, $self->{tex}->{h})	2538	($self->{tex}{w}, $self->{tex}{h})
1995	}	2539	}
1996		2540
1997	sub _draw {	2541	sub _draw {
1998	my ($self) = @_;	2542	my ($self) = @_;
1999		2543
…		…
2009	}	2553	}
2010		2554
2011	glEnable GL_TEXTURE_2D;	2555	glEnable GL_TEXTURE_2D;
2012	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2556	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2013		2557
2014	$tex->draw_quad_alpha (0, 0, $w, $h);	2558	$tex->draw_quad (0, 0, $w, $h);
2015		2559
2016	glDisable GL_TEXTURE_2D;	2560	glDisable GL_TEXTURE_2D;
2017	}	2561	}
2018		2562
2019	#############################################################################	2563	#############################################################################
2020		2564
		2565	package CFPlus::UI::ImageButton;
		2566
		2567	our @ISA = CFPlus::UI::Image::;
		2568
		2569	use CFPlus::OpenGL;
		2570
		2571	my %textures;
		2572
		2573	sub new {
		2574	my $class = shift;
		2575
		2576	my $self = $class->SUPER::new (
		2577	padding_x => 4,
		2578	padding_y => 4,
		2579	fg => [1, 1, 1],
		2580	active_fg => [0, 0, 1],
		2581	can_hover => 1,
		2582	align => 0,
		2583	valign => 0,
		2584	can_events => 1,
		2585	@_
		2586	);
		2587	}
		2588
		2589	sub invoke_button_up {
		2590	my ($self, $ev, $x, $y) = @_;
		2591
		2592	$self->emit ("activate")
		2593	if $x >= 0 && $x < $self->{w}
		2594	&& $y >= 0 && $y < $self->{h};
		2595
		2596	1
		2597	}
		2598
		2599	#############################################################################
		2600
2021	package CFClient::UI::VGauge;	2601	package CFPlus::UI::VGauge;
2022		2602
2023	our @ISA = CFClient::UI::Base::;	2603	our @ISA = CFPlus::UI::Base::;
2024		2604
2025	use List::Util qw(min max);	2605	use List::Util qw(min max);
2026		2606
2027	use CFClient::OpenGL;	2607	use CFPlus::OpenGL;
2028		2608
2029	my %tex = (	2609	my %tex = (
2030	food => [	2610	food => [
2031	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2611	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2032	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2612	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2033	],	2613	],
2034	grace => [	2614	grace => [
2035	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2615	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/	2616	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2037	],	2617	],
2038	hp => [	2618	hp => [
2039	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2619	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2040	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2620	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2041	],	2621	],
2042	mana => [	2622	mana => [
2043	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2623	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/	2624	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2045	],	2625	],
2046	);	2626	);
2047		2627
2048	# eg. VGauge->new (gauge => 'food'), default gauge: food	2628	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2108	my $ycut1 = max 0, min 1, $ycut;	2688	my $ycut1 = max 0, min 1, $ycut;
2109	my $ycut2 = max 0, min 1, $ycut - 1;	2689	my $ycut2 = max 0, min 1, $ycut - 1;
2110		2690
2111	my $h1 = $self->{h} * (1 - $ycut1);	2691	my $h1 = $self->{h} * (1 - $ycut1);
2112	my $h2 = $self->{h} * (1 - $ycut2);	2692	my $h2 = $self->{h} * (1 - $ycut2);
		2693	my $h3 = $self->{h};
		2694
		2695	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2113		2696
2114	glEnable GL_BLEND;	2697	glEnable GL_BLEND;
2115	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2698	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2699	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2116	glEnable GL_TEXTURE_2D;	2700	glEnable GL_TEXTURE_2D;
2117	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2701	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2118		2702
2119	glBindTexture GL_TEXTURE_2D, $t1->{name};	2703	glBindTexture GL_TEXTURE_2D, $t1->{name};
2120	glBegin GL_QUADS;	2704	glBegin GL_QUADS;
…		…
2135		2719
2136	if ($t3) {	2720	if ($t3) {
2137	glBindTexture GL_TEXTURE_2D, $t3->{name};	2721	glBindTexture GL_TEXTURE_2D, $t3->{name};
2138	glBegin GL_QUADS;	2722	glBegin GL_QUADS;
2139	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2723	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2140	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2724	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2141	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2725	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2142	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2726	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2143	glEnd;	2727	glEnd;
2144	}	2728	}
2145		2729
2146	glDisable GL_BLEND;	2730	glDisable GL_BLEND;
2147	glDisable GL_TEXTURE_2D;	2731	glDisable GL_TEXTURE_2D;
2148	}	2732	}
2149		2733
2150	#############################################################################	2734	#############################################################################
2151		2735
2152	package CFClient::UI::Gauge;	2736	package CFPlus::UI::Gauge;
2153		2737
2154	our @ISA = CFClient::UI::VBox::;	2738	our @ISA = CFPlus::UI::VBox::;
2155		2739
2156	sub new {	2740	sub new {
2157	my ($class, %arg) = @_;	2741	my ($class, %arg) = @_;
2158		2742
2159	my $self = $class->SUPER::new (	2743	my $self = $class->SUPER::new (
…		…
2161	can_hover => 1,	2745	can_hover => 1,
2162	can_events => 1,	2746	can_events => 1,
2163	%arg,	2747	%arg,
2164	);	2748	);
2165		2749
2166	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2750	$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);	2751	$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");	2752	$self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2169		2753
2170	$self	2754	$self
2171	}	2755	}
2172		2756
2173	sub set_fontsize {	2757	sub set_fontsize {
…		…
2194	$self->{value}->set_text ($val);	2778	$self->{value}->set_text ($val);
2195	}	2779	}
2196		2780
2197	#############################################################################	2781	#############################################################################
2198		2782
2199	package CFClient::UI::Slider;	2783	package CFPlus::UI::Slider;
2200		2784
2201	use strict;	2785	use strict;
2202		2786
2203	use CFClient::OpenGL;	2787	use CFPlus::OpenGL;
2204		2788
2205	our @ISA = CFClient::UI::DrawBG::;	2789	our @ISA = CFPlus::UI::DrawBG::;
2206		2790
2207	my @tex =	2791	my @tex =
2208	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2792	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2209	qw(s1_slider.png s1_slider_bg.png);	2793	qw(s1_slider.png s1_slider_bg.png);
2210		2794
2211	sub new {	2795	sub new {
2212	my $class = shift;	2796	my $class = shift;
2213		2797
…		…
2234	$self->update;	2818	$self->update;
2235		2819
2236	$self	2820	$self
2237	}	2821	}
2238		2822
2239	sub changed { }
2240
2241	sub set_range {	2823	sub set_range {
2242	my ($self, $range) = @_;	2824	my ($self, $range) = @_;
2243		2825
2244	($range, $self->{range}) = ($self->{range}, $range);	2826	($range, $self->{range}) = ($self->{range}, $range);
2245		2827
2246	$self->update
2247	if "@$range" ne "@{$self->{range}}";	2828	if ("@$range" ne "@{$self->{range}}") {
		2829	$self->update;
		2830	$self->set_value ($self->{range}[0]);
		2831	}
2248	}	2832	}
2249		2833
2250	sub set_value {	2834	sub set_value {
2251	my ($self, $value) = @_;	2835	my ($self, $value) = @_;
2252		2836
…		…
2263	if $unit;	2847	if $unit;
2264		2848
2265	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2849	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2266		2850
2267	if ($value != $old_value) {	2851	if ($value != $old_value) {
2268	$self->_emit (changed => $value);	2852	$self->emit (changed => $value);
2269	$self->update;	2853	$self->update;
2270	}	2854	}
2271	}	2855	}
2272		2856
2273	sub size_request {	2857	sub size_request {
2274	my ($self) = @_;	2858	my ($self) = @_;
2275		2859
2276	($self->{req_w}, $self->{req_h})	2860	($self->{req_w}, $self->{req_h})
2277	}	2861	}
2278		2862
2279	sub button_down {	2863	sub invoke_button_down {
2280	my ($self, $ev, $x, $y) = @_;	2864	my ($self, $ev, $x, $y) = @_;
2281		2865
2282	$self->SUPER::button_down ($ev, $x, $y);	2866	$self->SUPER::invoke_button_down ($ev, $x, $y);
2283		2867
2284	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2868	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2285		2869
2286	$self->mouse_motion ($ev, $x, $y);	2870	$self->invoke_mouse_motion ($ev, $x, $y)
2287	}	2871	}
2288		2872
2289	sub mouse_motion {	2873	sub invoke_mouse_motion {
2290	my ($self, $ev, $x, $y) = @_;	2874	my ($self, $ev, $x, $y) = @_;
2291		2875
2292	if ($GRAB == $self) {	2876	if ($GRAB == $self) {
2293	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2877	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2294		2878
2295	my (undef, $lo, $hi, $page) = @{$self->{range}};	2879	my (undef, $lo, $hi, $page) = @{$self->{range}};
2296		2880
2297	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2881	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2298		2882
2299	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2883	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2884	} else {
		2885	return 0;
		2886	}
		2887
2300	}	2888	1
		2889	}
		2890
		2891	sub invoke_mouse_wheel {
		2892	my ($self, $ev) = @_;
		2893
		2894	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2895
		2896	my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;
		2897
		2898	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
		2899
		2900	! ! $delta
2301	}	2901	}
2302		2902
2303	sub update {	2903	sub update {
2304	my ($self) = @_;	2904	my ($self) = @_;
2305		2905
2306	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2906	delete $self->{knob_w};
		2907	$self->SUPER::update;
		2908	}
		2909
		2910	sub _draw {
		2911	my ($self) = @_;
		2912
		2913	unless ($self->{knob_w}) {
2307	$self->set_value ($self->{range}[0]);	2914	$self->set_value ($self->{range}[0]);
2308		2915
2309	my ($value, $lo, $hi, $page) = @{$self->{range}};	2916	my ($value, $lo, $hi, $page) = @{$self->{range}};
2310	my $range = ($hi - $page - $lo) || 1e-100;	2917	my $range = ($hi - $page - $lo) || 1e-100;
2311		2918
…		…
2317	$value = ($value - $lo) / $range;	2924	$value = ($value - $lo) / $range;
2318	$value = $value * $self->{scale} + $self->{offset};	2925	$value = $value * $self->{scale} + $self->{offset};
2319		2926
2320	$self->{knob_x} = $value - $knob_w * 0.5;	2927	$self->{knob_x} = $value - $knob_w * 0.5;
2321	$self->{knob_w} = $knob_w;	2928	$self->{knob_w} = $knob_w;
2322	});	2929	}
2323
2324	$self->SUPER::update;
2325	}
2326
2327	sub _draw {
2328	my ($self) = @_;
2329		2930
2330	$self->SUPER::_draw ();	2931	$self->SUPER::_draw ();
2331		2932
2332	glScale $self->{w}, $self->{h};	2933	glScale $self->{w}, $self->{h};
2333		2934
…		…
2353	glDisable GL_TEXTURE_2D;	2954	glDisable GL_TEXTURE_2D;
2354	}	2955	}
2355		2956
2356	#############################################################################	2957	#############################################################################
2357		2958
2358	package CFClient::UI::ValSlider;	2959	package CFPlus::UI::ValSlider;
2359		2960
2360	our @ISA = CFClient::UI::HBox::;	2961	our @ISA = CFPlus::UI::HBox::;
2361		2962
2362	sub new {	2963	sub new {
2363	my ($class, %arg) = @_;	2964	my ($class, %arg) = @_;
2364		2965
2365	my $range = delete $arg{range};	2966	my $range = delete $arg{range};
2366		2967
2367	my $self = $class->SUPER::new (	2968	my $self = $class->SUPER::new (
2368	slider => (new CFClient::UI::Slider expand => 1, range => $range),	2969	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2369	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	2970	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2370	to_value => sub { shift },	2971	to_value => sub { shift },
2371	from_value => sub { shift },	2972	from_value => sub { shift },
2372	%arg,	2973	%arg,
2373	);	2974	);
2374		2975
…		…
2394	sub set_range { shift->{slider}->set_range (@_) }	2995	sub set_range { shift->{slider}->set_range (@_) }
2395	sub set_value { shift->{slider}->set_value (@_) }	2996	sub set_value { shift->{slider}->set_value (@_) }
2396		2997
2397	#############################################################################	2998	#############################################################################
2398		2999
2399	package CFClient::UI::TextView;	3000	package CFPlus::UI::TextScroller;
2400		3001
2401	our @ISA = CFClient::UI::HBox::;	3002	our @ISA = CFPlus::UI::HBox::;
2402		3003
2403	use CFClient::OpenGL;	3004	use CFPlus::OpenGL;
2404		3005
2405	sub new {	3006	sub new {
2406	my $class = shift;	3007	my $class = shift;
2407		3008
2408	my $self = $class->SUPER::new (	3009	my $self = $class->SUPER::new (
2409	fontsize => 1,	3010	fontsize => 1,
2410	can_events => 0,	3011	can_events => 1,
		3012	indent => 0,
2411	#font => default_font	3013	#font => default_font
2412	@_,	3014	@_,
2413		3015
2414	layout => (new CFClient::Layout 1),	3016	layout => (new CFPlus::Layout),
2415	par => [],	3017	par => [],
		3018	max_par => 0,
2416	height => 0,	3019	height => 0,
2417	children => [	3020	children => [
2418	(new CFClient::UI::Empty expand => 1),	3021	(new CFPlus::UI::Empty expand => 1),
2419	(new CFClient::UI::Slider vertical => 1),	3022	(new CFPlus::UI::Slider vertical => 1),
2420	],	3023	],
2421	);	3024	);
2422		3025
2423	$self->{children}[1]->connect (changed => sub { $self->update });	3026	$self->{children}[1]->connect (changed => sub { $self->update });
2424		3027
…		…
2430		3033
2431	$self->{fontsize} = $fontsize;	3034	$self->{fontsize} = $fontsize;
2432	$self->reflow;	3035	$self->reflow;
2433	}	3036	}
2434		3037
		3038	sub size_request {
		3039	my ($self) = @_;
		3040
		3041	my ($empty, $slider) = @{ $self->{children} };
		3042
		3043	local $self->{children} = [$empty, $slider];
		3044	$self->SUPER::size_request
		3045	}
		3046
2435	sub size_allocate {	3047	sub invoke_size_allocate {
2436	my ($self, $w, $h) = @_;	3048	my ($self, $w, $h) = @_;
2437		3049
2438	$self->SUPER::size_allocate ($w, $h);	3050	my ($empty, $slider, @other) = @{ $self->{children} };
		3051	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2439		3052
2440	$self->{layout}->set_font ($self->{font}) if $self->{font};	3053	$self->{layout}->set_font ($self->{font}) if $self->{font};
2441	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	3054	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2442	$self->{layout}->set_width ($self->{children}[0]{w});	3055	$self->{layout}->set_width ($empty->{w});
		3056	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2443		3057
2444	$self->reflow;	3058	$self->reflow;
2445	}
2446		3059
2447	sub text_size {	3060	local $self->{children} = [$empty, $slider];
		3061	$self->SUPER::invoke_size_allocate ($w, $h)
		3062	}
		3063
		3064	sub invoke_mouse_wheel {
2448	my ($self, $text, $indent) = @_;	3065	my ($self, $ev) = @_;
		3066
		3067	return 0 unless $ev->{dy}; # only vertical movements
		3068
		3069	$self->{children}[1]->emit (mouse_wheel => $ev);
		3070
		3071	1
		3072	}
		3073
		3074	sub get_layout {
		3075	my ($self, $para) = @_;
2449		3076
2450	my $layout = $self->{layout};	3077	my $layout = $self->{layout};
2451		3078
		3079	$layout->set_font ($self->{font}) if $self->{font};
		3080	$layout->set_foreground (@{$para->{fg}});
2452	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	3081	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2453	$layout->set_width ($self->{children}[0]{w} - $indent);	3082	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
		3083	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2454	$layout->set_markup ($text);	3084	$layout->set_markup ($para->{markup});
		3085
		3086	$layout->set_shapes (
		3087	map
		3088	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		3089	@{$para->{widget}}
2455		3090	);
		3091
2456	$layout->size	3092	$layout
2457	}	3093	}
2458		3094
2459	sub reflow {	3095	sub reflow {
2460	my ($self) = @_;	3096	my ($self) = @_;
2461		3097
…		…
2468		3104
2469	# todo: base offset on lines or so, not on pixels	3105	# todo: base offset on lines or so, not on pixels
2470	$self->{children}[1]->set_value ($offset);	3106	$self->{children}[1]->set_value ($offset);
2471	}	3107	}
2472		3108
		3109	sub current_paragraph {
		3110	my ($self) = @_;
		3111
		3112	$self->{top_paragraph} - 1
		3113	}
		3114
		3115	sub scroll_to {
		3116	my ($self, $para) = @_;
		3117
		3118	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		3119
		3120	$self->{scroll_to} = $para;
		3121	$self->update;
		3122	}
		3123
2473	sub clear {	3124	sub clear {
2474	my ($self) = @_;	3125	my ($self) = @_;
		3126
		3127	my (undef, undef, @other) = @{ $self->{children} };
		3128	$self->remove ($_) for @other;
2475		3129
2476	$self->{par} = [];	3130	$self->{par} = [];
2477	$self->{height} = 0;	3131	$self->{height} = 0;
2478	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	3132	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2479	}	3133	}
2480		3134
2481	sub add_paragraph {	3135	sub add_paragraph {
2482	my ($self, $color, $text, $indent) = @_;	3136	my $self = shift;
2483		3137
2484	for my $line (split /\n/, $text) {	3138	for my $para (@_) {
2485	my ($w, $h) = $self->text_size ($line);	3139	$para = {
		3140	fg => [1, 1, 1, 1],
		3141	indent => 0,
		3142	markup => "",
		3143	widget => [],
		3144	ref $para ? %$para : (markup => $para),
		3145	w => 1e10,
		3146	wrapped => 1,
		3147	};
		3148
		3149	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		3150	push @{$self->{par}}, $para;
		3151	}
		3152
		3153	if (my $max = $self->{max_par}) {
		3154	shift @{$self->{par}} while @{$self->{par}} > $max;
		3155	}
		3156
		3157	$self->{need_reflow}++;
		3158	$self->update;
		3159	}
		3160
		3161	sub scroll_to_bottom {
		3162	my ($self) = @_;
		3163
		3164	$self->{scroll_to} = $#{$self->{par}};
		3165	$self->update;
		3166	}
		3167
		3168	sub force_uptodate {
		3169	my ($self) = @_;
		3170
		3171	if (delete $self->{need_reflow}) {
		3172	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		3173
		3174	my $height = 0;
		3175
		3176	for my $para (@{$self->{par}}) {
		3177	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		3178	my $layout = $self->get_layout ($para);
		3179	my ($w, $h) = $layout->size;
		3180
		3181	$para->{w} = $w + $para->{indent};
		3182	$para->{h} = $h;
		3183	$para->{wrapped} = $layout->has_wrapped;
		3184	}
		3185
		3186	$para->{y} = $height;
		3187	$height += $para->{h};
		3188	}
		3189
2486	$self->{height} += $h;	3190	$self->{height} = $height;
2487	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3191	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2488	}
2489		3192
2490	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	3193	delete $self->{texture};
		3194	}
		3195
		3196	if (my $paridx = delete $self->{scroll_to}) {
		3197	$self->{children}[1]->set_value ($self->{par}[$paridx]{y});
		3198	}
2491	}	3199	}
2492		3200
2493	sub update {	3201	sub update {
2494	my ($self) = @_;	3202	my ($self) = @_;
2495		3203
…		…
2497		3205
2498	return unless $self->{h} > 0;	3206	return unless $self->{h} > 0;
2499		3207
2500	delete $self->{texture};	3208	delete $self->{texture};
2501		3209
2502	$ROOT->on_post_alloc ($self, sub {	3210	$ROOT->on_post_alloc ($self => sub {
		3211	$self->force_uptodate;
		3212
2503	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3213	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2504		3214
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 {	3215	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2532	glClearColor 0.5, 0.5, 0.5, 0;	3216	glClearColor 0, 0, 0, 0;
2533	glClear GL_COLOR_BUFFER_BIT;	3217	glClear GL_COLOR_BUFFER_BIT;
2534		3218
		3219	package CFPlus::UI::Base;
		3220	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		3221	(0, 0, $self->{w}, $self->{h});
		3222
		3223	my $top = int $self->{children}[1]{range}[0];
		3224
		3225	my $paridx = 0;
		3226	my $top_paragraph;
2535	my $top = int $self->{children}[1]{range}[0];	3227	my $top = int $self->{children}[1]{range}[0];
2536		3228
2537	my $y0 = $top;	3229	my $y0 = $top;
2538	my $y1 = $top + $H;	3230	my $y1 = $top + $H;
2539		3231
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}}) {	3232	for my $para (@{$self->{par}}) {
2551	my $h = $par->[1];	3233	my $h = $para->{h};
		3234	my $y = $para->{y};
2552		3235
2553	if ($y0 < $y + $h && $y < $y1) {	3236	if ($y0 < $y + $h && $y < $y1) {
2554	$layout->set_foreground (@{ $par->[2] });	3237	my $layout = $self->get_layout ($para);
2555	$layout->set_width ($W - $par->[3]);
2556	$layout->set_markup ($par->[4]);
2557		3238
2558	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3239	$layout->render ($para->{indent}, $y - $y0);
2559		3240
2560	glRasterPos $par->[3], $y - $y0;	3241	if (my @w = @{ $para->{widget} }) {
2561	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3242	my @s = $layout->get_shapes;
		3243
		3244	for (@w) {
		3245	my ($dx, $dy) = splice @s, 0, 2, ();
		3246
		3247	$_->{x} = $dx + $para->{indent};
		3248	$_->{y} = $dy + $y - $y0;
		3249
		3250	$_->draw;
		3251	}
		3252	}
2562	}	3253	}
2563		3254
2564	$y += $h;	3255	$paridx++;
		3256	$top_paragraph ||= $paridx if $y >= $top;
2565	}	3257	}
2566		3258
2567	glDisable GL_BLEND;	3259	$self->{top_paragraph} = $top_paragraph;
2568	};	3260	};
2569	});	3261	});
2570	}	3262	}
2571		3263
		3264	sub reconfigure {
		3265	my ($self) = @_;
		3266
		3267	$self->SUPER::reconfigure;
		3268
		3269	$_->{w} = 1e10 for @{ $self->{par} };
		3270	$self->reflow;
		3271	}
		3272
2572	sub _draw {	3273	sub _draw {
2573	my ($self) = @_;	3274	my ($self) = @_;
2574		3275
2575	glEnable GL_TEXTURE_2D;	3276	glEnable GL_TEXTURE_2D;
2576	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3277	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2577	glColor 1, 1, 1, 1;	3278	glColor 0, 0, 0, 1;
2578	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	3279	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2579	glDisable GL_TEXTURE_2D;	3280	glDisable GL_TEXTURE_2D;
2580		3281
2581	$self->{children}[1]->draw;	3282	$self->{children}[1]->draw;
2582
2583	}	3283	}
2584		3284
2585	#############################################################################	3285	#############################################################################
2586		3286
2587	package CFClient::UI::Animator;	3287	package CFPlus::UI::Animator;
2588		3288
2589	use CFClient::OpenGL;	3289	use CFPlus::OpenGL;
2590		3290
2591	our @ISA = CFClient::UI::Bin::;	3291	our @ISA = CFPlus::UI::Bin::;
2592		3292
2593	sub moveto {	3293	sub moveto {
2594	my ($self, $x, $y) = @_;	3294	my ($self, $x, $y) = @_;
2595		3295
2596	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3296	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2624	glPopMatrix;	3324	glPopMatrix;
2625	}	3325	}
2626		3326
2627	#############################################################################	3327	#############################################################################
2628		3328
2629	package CFClient::UI::Flopper;	3329	package CFPlus::UI::Flopper;
2630		3330
2631	our @ISA = CFClient::UI::Button::;	3331	our @ISA = CFPlus::UI::Button::;
2632		3332
2633	sub new {	3333	sub new {
2634	my $class = shift;	3334	my $class = shift;
2635		3335
2636	my $self = $class->SUPER::new (	3336	my $self = $class->SUPER::new (
…		…
2648	$self->{other}->toggle_visibility;	3348	$self->{other}->toggle_visibility;
2649	}	3349	}
2650		3350
2651	#############################################################################	3351	#############################################################################
2652		3352
2653	package CFClient::UI::Tooltip;	3353	package CFPlus::UI::Tooltip;
2654		3354
2655	our @ISA = CFClient::UI::Bin::;	3355	our @ISA = CFPlus::UI::Bin::;
2656		3356
2657	use CFClient::OpenGL;	3357	use CFPlus::OpenGL;
2658		3358
2659	sub new {	3359	sub new {
2660	my $class = shift;	3360	my $class = shift;
2661		3361
2662	$class->SUPER::new (	3362	$class->SUPER::new (
…		…
2665	)	3365	)
2666	}	3366	}
2667		3367
2668	sub set_tooltip_from {	3368	sub set_tooltip_from {
2669	my ($self, $widget) = @_;	3369	my ($self, $widget) = @_;
		3370
		3371	$widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
		3372	if $widget->{tooltip} =~ /^#(.*)$/;
2670		3373
2671	my $tooltip = $widget->{tooltip};	3374	my $tooltip = $widget->{tooltip};
2672		3375
2673	if ($ENV{CFPLUS_DEBUG} & 2) {	3376	if ($ENV{CFPLUS_DEBUG} & 2) {
2674	$tooltip .= "\n\n" . (ref $widget) . "\n"	3377	$tooltip .= "\n\n" . (ref $widget) . "\n"
2675	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3378	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2676	. "req $widget->{req_w} $widget->{req_h}\n"	3379	. "req $widget->{req_w} $widget->{req_h}\n"
2677	. "visible $widget->{visible}";	3380	. "visible $widget->{visible}";
2678	}	3381	}
2679		3382
		3383	$tooltip =~ s/^\n+//;
		3384	$tooltip =~ s/\n+$//;
		3385
2680	$self->add (new CFClient::UI::Label	3386	$self->add (new CFPlus::UI::Label
2681	markup => $tooltip,	3387	markup => $tooltip,
2682	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3388	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2683	fontsize => 0.8,	3389	fontsize => 0.8,
2684	fg => [0, 0, 0, 1],	3390	style => 1, # FLAG_INVERSE
2685	ellipsise => 0,	3391	ellipsise => 0,
2686	font => ($widget->{tooltip_font} || $::FONT_PROP),	3392	font => ($widget->{tooltip_font} || $::FONT_PROP),
2687	);	3393	);
2688	}	3394	}
2689		3395
…		…
2693	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3399	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2694		3400
2695	($w + 4, $h + 4)	3401	($w + 4, $h + 4)
2696	}	3402	}
2697		3403
2698	sub size_allocate {	3404	sub invoke_size_allocate {
2699	my ($self, $w, $h) = @_;	3405	my ($self, $w, $h) = @_;
2700		3406
2701	$self->SUPER::size_allocate ($w - 4, $h - 4);	3407	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2702	}	3408	}
2703		3409
2704	sub visibility_change {	3410	sub invoke_visibility_change {
2705	my ($self, $visible) = @_;	3411	my ($self, $visible) = @_;
2706		3412
2707	return unless $visible;	3413	return unless $visible;
2708		3414
2709	$self->{root}->on_post_alloc ("move_$self" => sub {	3415	$self->{root}->on_post_alloc ("move_$self" => sub {
2710	my $widget = $self->{owner}	3416	my $widget = $self->{owner}
2711	or return;	3417	or return;
2712		3418
		3419	if ($widget->{visible}) {
2713	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3420	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2714		3421
2715	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3422	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2716	if $x + $self->{w} > $::WIDTH;	3423	if $x + $self->{w} > $self->{root}{w};
2717		3424
2718	$self->move_abs ($x, $y);	3425	$self->move_abs ($x, $y);
		3426	} else {
		3427	$self->hide;
		3428	}
2719	});	3429	});
2720	}	3430	}
2721		3431
2722	sub _draw {	3432	sub _draw {
2723	my ($self) = @_;	3433	my ($self) = @_;
…		…
2747	$self->SUPER::_draw;	3457	$self->SUPER::_draw;
2748	}	3458	}
2749		3459
2750	#############################################################################	3460	#############################################################################
2751		3461
2752	package CFClient::UI::Face;	3462	package CFPlus::UI::Face;
2753		3463
2754	our @ISA = CFClient::UI::Base::;	3464	our @ISA = CFPlus::UI::DrawBG::;
2755		3465
2756	use CFClient::OpenGL;	3466	use CFPlus::OpenGL;
2757		3467
2758	sub new {	3468	sub new {
2759	my $class = shift;	3469	my $class = shift;
2760		3470
2761	my $self = $class->SUPER::new (	3471	my $self = $class->SUPER::new (
		3472	size_w => 32,
		3473	size_h => 8,
2762	aspect => 1,	3474	aspect => 1,
2763	can_events => 0,	3475	can_events => 0,
2764	@_,	3476	@_,
2765	);	3477	);
2766		3478
2767	if ($self->{anim} && $self->{animspeed}) {	3479	if ($self->{anim} && $self->{animspeed}) {
2768	Scalar::Util::weaken (my $widget = $self);	3480	CFPlus::weaken (my $widget = $self);
2769		3481
		3482	$widget->{animspeed} = List::Util::max 0.05, $widget->{animspeed};
		3483	$widget->{anim_start} = $self->{animspeed} * Event::time / $self->{animspeed};
2770	$self->{timer} = Event->timer (	3484	$self->{timer} = Event->timer (
2771	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2772	hard => 1,	3485	parked => 1,
2773	interval => $self->{animspeed},
2774	cb => sub {	3486	cb => sub {
		3487	return unless $::CONN && $widget;
		3488
2775	++$widget->{frame};	3489	++$widget->{frame};
		3490	$widget->update_face;
2776	$widget->update;	3491	$widget->update;
		3492
		3493	$widget->update_timer;
2777	},	3494	},
2778	);	3495	);
		3496
		3497	$self->update_face;
		3498	$self->update_timer;
2779	}	3499	}
2780		3500
2781	$self	3501	$self
2782	}	3502	}
2783		3503
		3504	sub update_timer {
		3505	my ($self) = @_;
		3506
		3507	return unless $self->{timer};
		3508
		3509	if ($self->{visible}) {
		3510	$self->{timer}->at (
		3511	$self->{anim_start}
		3512	+ $self->{animspeed}
		3513	* int 1.5 + (Event::time - $self->{anim_start}) / $self->{animspeed}
		3514	);
		3515	$self->{timer}->start;
		3516	} else {
		3517	$self->{timer}->stop;
		3518	}
		3519	}
		3520
		3521	sub update_face {
		3522	my ($self) = @_;
		3523
		3524	return unless $::CONN;
		3525
		3526	if (my $anim = $::CONN->{anim}[$self->{anim}]) {
		3527	if ($anim && @$anim) {
		3528	delete $self->{wait_face};
		3529	$self->{face} = $anim->[ $self->{frame} % @$anim ];
		3530	}
		3531	}
		3532	}
		3533
2784	sub size_request {	3534	sub size_request {
2785	(32, 8)	3535	my ($self) = @_;
		3536
		3537	if ($::CONN) {
		3538	if (my $faceid = $::CONN->{faceid}[$self->{face}]) {
		3539	if (my $tex = $::CONN->{texture}[$faceid]) {
		3540	return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
		3541	} else {
		3542	$self->{wait_face} ||= $::CONN->connect_face_update ($faceid, sub {
		3543	$self->realloc;
		3544	});
		3545	}
		3546	}
		3547	}
		3548
		3549	($self->{size_w} || 8, $self->{size_h} || 8)
2786	}	3550	}
2787		3551
2788	sub update {	3552	sub update {
2789	my ($self) = @_;	3553	my ($self) = @_;
2790		3554
2791	return unless $self->{visible};	3555	return unless $self->{visible};
2792		3556
2793	$self->SUPER::update;	3557	$self->SUPER::update;
2794	}	3558	}
2795		3559
		3560	sub invoke_visibility_change {
		3561	my ($self) = @_;
		3562
		3563	$self->update_timer;
		3564
		3565	0
		3566	}
		3567
2796	sub _draw {	3568	sub _draw {
2797	my ($self) = @_;	3569	my ($self) = @_;
2798		3570
2799	return unless $::CONN;	3571	return unless $::CONN;
2800		3572
2801	my $face;	3573	$self->SUPER::_draw;
2802		3574
2803	if ($self->{frame}) {
2804	my $anim = $::CONN->{anim}[$self->{anim}];	3575	my $faceid = $::CONN->{faceid}[$self->{face}]
2805		3576	or return;
2806	$face = $anim->[ $self->{frame} % @$anim ]
2807	if $anim && @$anim;
2808	}
2809		3577
2810	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	3578	my $tex = $::CONN->{texture}[$faceid];
2811		3579
2812	if ($tex) {	3580	if ($tex) {
2813	glEnable GL_TEXTURE_2D;	3581	glEnable GL_TEXTURE_2D;
2814	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3582	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2815	glColor 1, 1, 1, 1;	3583	glColor 0, 0, 0, 1;
2816	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3584	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2817	glDisable GL_TEXTURE_2D;	3585	glDisable GL_TEXTURE_2D;
2818	}	3586	}
2819	}	3587	}
2820		3588
2821	sub DESTROY {	3589	sub destroy {
2822	my ($self) = @_;	3590	my ($self) = @_;
2823		3591
2824	$self->{timer}->cancel	3592	(delete $self->{timer})->cancel
2825	if $self->{timer};	3593	if $self->{timer};
2826		3594
2827	$self->SUPER::DESTROY;	3595	$self->SUPER::destroy;
2828	}	3596	}
2829		3597
2830	#############################################################################	3598	#############################################################################
2831		3599
		3600	package CFPlus::UI::Buttonbar;
		3601
		3602	our @ISA = CFPlus::UI::HBox::;
		3603
		3604	# TODO: should actually wrap buttons and other goodies.
		3605
		3606	#############################################################################
		3607
2832	package CFClient::UI::Menu;	3608	package CFPlus::UI::Menu;
2833		3609
2834	our @ISA = CFClient::UI::FancyFrame::;	3610	our @ISA = CFPlus::UI::Toplevel::;
2835		3611
2836	use CFClient::OpenGL;	3612	use CFPlus::OpenGL;
2837		3613
2838	sub new {	3614	sub new {
2839	my $class = shift;	3615	my $class = shift;
2840		3616
2841	my $self = $class->SUPER::new (	3617	my $self = $class->SUPER::new (
2842	items => [],	3618	items => [],
2843	z => 100,	3619	z => 100,
2844	@_,	3620	@_,
2845	);	3621	);
2846		3622
2847	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3623	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2848		3624
2849	for my $item (@{ $self->{items} }) {	3625	for my $item (@{ $self->{items} }) {
2850	my ($widget, $cb) = @$item;	3626	my ($widget, $cb, $tooltip) = @$item;
2851		3627
2852	# handle various types of items, only text for now	3628	# handle various types of items, only text for now
2853	if (!ref $widget) {	3629	if (!ref $widget) {
		3630	if ($widget =~ /\t/) {
		3631	my ($left, $right) = split /\t/, $widget, 2;
		3632
2854	$widget = new CFClient::UI::Label	3633	$widget = new CFPlus::UI::HBox
2855	can_hover => 1,	3634	can_hover => 1,
2856	can_events => 1,	3635	can_events => 1,
		3636	tooltip => $tooltip,
		3637	children => [
		3638	(new CFPlus::UI::Label markup => $left, expand => 1),
		3639	(new CFPlus::UI::Label markup => $right, align => +1),
		3640	],
		3641	;
		3642
		3643	} else {
		3644	$widget = new CFPlus::UI::Label
		3645	can_hover => 1,
		3646	can_events => 1,
2857	text => $widget;	3647	markup => $widget,
		3648	tooltip => $tooltip;
		3649	}
2858	}	3650	}
2859		3651
2860	$self->{item}{$widget} = $item;	3652	$self->{item}{$widget} = $item;
2861		3653
2862	$self->{vbox}->add ($widget);	3654	$self->{vbox}->add ($widget);
…		…
2867		3659
2868	# popup given the event (must be a mouse button down event currently)	3660	# popup given the event (must be a mouse button down event currently)
2869	sub popup {	3661	sub popup {
2870	my ($self, $ev) = @_;	3662	my ($self, $ev) = @_;
2871		3663
2872	$self->_emit ("popdown");	3664	$self->emit ("popdown");
2873		3665
2874	# maybe save $GRAB? must be careful about events...	3666	# maybe save $GRAB? must be careful about events...
2875	$GRAB = $self;	3667	$GRAB = $self;
2876	$self->{button} = $ev->{button};	3668	$self->{button} = $ev->{button};
2877		3669
2878	$self->show;	3670	$self->show;
2879	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3671	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2880	}	3672	}
2881		3673
2882	sub mouse_motion {	3674	sub invoke_mouse_motion {
2883	my ($self, $ev, $x, $y) = @_;	3675	my ($self, $ev, $x, $y) = @_;
2884		3676
2885	# TODO: should use vbox->find_widget or so	3677	# TODO: should use vbox->find_widget or so
2886	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3678	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2887	$self->{hover} = $self->{item}{$HOVER};	3679	$self->{hover} = $self->{item}{$HOVER};
2888	}
2889		3680
		3681	0
		3682	}
		3683
2890	sub button_up {	3684	sub invoke_button_up {
2891	my ($self, $ev, $x, $y) = @_;	3685	my ($self, $ev, $x, $y) = @_;
2892		3686
2893	if ($ev->{button} == $self->{button}) {	3687	if ($ev->{button} == $self->{button}) {
2894	undef $GRAB;	3688	undef $GRAB;
2895	$self->hide;	3689	$self->hide;
2896		3690
2897	$self->_emit ("popdown");	3691	$self->emit ("popdown");
2898	$self->{hover}[1]->() if $self->{hover};	3692	$self->{hover}[1]->() if $self->{hover};
		3693	} else {
		3694	return 0
		3695	}
		3696
2899	}	3697	1
2900	}	3698	}
2901		3699
2902	#############################################################################	3700	#############################################################################
2903		3701
2904	package CFClient::UI::Statusbox;	3702	package CFPlus::UI::Multiplexer;
2905		3703
2906	our @ISA = CFClient::UI::VBox::;	3704	our @ISA = CFPlus::UI::Container::;
2907		3705
2908	sub new {	3706	sub new {
2909	my $class = shift;	3707	my $class = shift;
2910		3708
2911	$class->SUPER::new (	3709	my $self = $class->SUPER::new (
		3710	@_,
		3711	);
		3712
		3713	$self->{current} = $self->{children}[0]
		3714	if @{ $self->{children} };
		3715
		3716	$self
		3717	}
		3718
		3719	sub add {
		3720	my ($self, @widgets) = @_;
		3721
		3722	$self->SUPER::add (@widgets);
		3723
		3724	$self->{current} = $self->{children}[0]
		3725	if @{ $self->{children} };
		3726	}
		3727
		3728	sub get_current_page {
		3729	my ($self) = @_;
		3730
		3731	$self->{current}
		3732	}
		3733
		3734	sub set_current_page {
		3735	my ($self, $page_or_widget) = @_;
		3736
		3737	my $widget = ref $page_or_widget
		3738	? $page_or_widget
		3739	: $self->{children}[$page_or_widget];
		3740
		3741	$self->{current} = $widget;
		3742	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3743
		3744	$self->emit (page_changed => $self->{current});
		3745
		3746	$self->realloc;
		3747	}
		3748
		3749	sub visible_children {
		3750	$_[0]{current}
		3751	}
		3752
		3753	sub size_request {
		3754	my ($self) = @_;
		3755
		3756	$self->{current}->size_request
		3757	}
		3758
		3759	sub invoke_size_allocate {
		3760	my ($self, $w, $h) = @_;
		3761
		3762	$self->{current}->configure (0, 0, $w, $h);
		3763
		3764	1
		3765	}
		3766
		3767	sub _draw {
		3768	my ($self) = @_;
		3769
		3770	$self->{current}->draw;
		3771	}
		3772
		3773	#############################################################################
		3774
		3775	package CFPlus::UI::Notebook;
		3776
		3777	our @ISA = CFPlus::UI::VBox::;
		3778
		3779	sub new {
		3780	my $class = shift;
		3781
		3782	my $self = $class->SUPER::new (
		3783	buttonbar => (new CFPlus::UI::Buttonbar),
		3784	multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
		3785	# filter => # will be put between multiplexer and $self
		3786	@_,
		3787	);
		3788
		3789	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3790	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3791
		3792	$self
		3793	}
		3794
		3795	sub add {
		3796	my ($self, $title, $widget, $tooltip) = @_;
		3797
		3798	CFPlus::weaken $self;
		3799
		3800	$self->{buttonbar}->add (new CFPlus::UI::Button
		3801	markup => $title,
		3802	tooltip => $tooltip,
		3803	on_activate => sub { $self->set_current_page ($widget) },
		3804	);
		3805
		3806	$self->{multiplexer}->add ($widget);
		3807	}
		3808
		3809	sub get_current_page {
		3810	my ($self) = @_;
		3811
		3812	$self->{multiplexer}->get_current_page
		3813	}
		3814
		3815	sub set_current_page {
		3816	my ($self, $page) = @_;
		3817
		3818	$self->{multiplexer}->set_current_page ($page);
		3819	$self->emit (page_changed => $self->{multiplexer}{current});
		3820	}
		3821
		3822	#############################################################################
		3823
		3824	package CFPlus::UI::Selector;
		3825
		3826	use utf8;
		3827
		3828	our @ISA = CFPlus::UI::Button::;
		3829
		3830	sub new {
		3831	my $class = shift;
		3832
		3833	my $self = $class->SUPER::new (
		3834	options => [], # [value, title, longdesc], ...
		3835	value => undef,
		3836	@_,
		3837	);
		3838
		3839	$self->_set_value ($self->{value});
		3840
		3841	$self
		3842	}
		3843
		3844	sub invoke_button_down {
		3845	my ($self, $ev) = @_;
		3846
		3847	my @menu_items;
		3848
		3849	for (@{ $self->{options} }) {
		3850	my ($value, $title, $tooltip) = @$_;
		3851
		3852	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3853	}
		3854
		3855	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3856	}
		3857
		3858	sub _set_value {
		3859	my ($self, $value) = @_;
		3860
		3861	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3862	or return;
		3863
		3864	$self->{value} = $item->[0];
		3865	$self->set_markup ("$item->[1] ⇓");
		3866	$self->set_tooltip ($item->[2]);
		3867	}
		3868
		3869	sub set_value {
		3870	my ($self, $value) = @_;
		3871
		3872	return unless $self->{value} ne $value;
		3873
		3874	$self->_set_value ($value);
		3875	$self->emit (changed => $value);
		3876	}
		3877
		3878	#############################################################################
		3879
		3880	package CFPlus::UI::Statusbox;
		3881
		3882	our @ISA = CFPlus::UI::VBox::;
		3883
		3884	sub new {
		3885	my $class = shift;
		3886
		3887	my $self = $class->SUPER::new (
2912	fontsize => 0.8,	3888	fontsize => 0.8,
2913	@_,	3889	@_,
2914	)	3890	);
		3891
		3892	CFPlus::weaken (my $this = $self);
		3893
		3894	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3895
		3896	$self
2915	}	3897	}
2916		3898
2917	sub reorder {	3899	sub reorder {
2918	my ($self) = @_;	3900	my ($self) = @_;
2919	my $NOW = time;	3901	my $NOW = Time::HiRes::time;
		3902
		3903	# freeze display when hovering over any label
		3904	return if $CFPlus::UI::TOOLTIP->{owner}
		3905	&& grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
		3906	values %{ $self->{item} };
2920		3907
2921	while (my ($k, $v) = each %{ $self->{item} }) {	3908	while (my ($k, $v) = each %{ $self->{item} }) {
2922	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3909	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2923	}	3910	}
2924		3911
…		…
2927	my @items = sort {	3914	my @items = sort {
2928	$a->{pri} <=> $b->{pri}	3915	$a->{pri} <=> $b->{pri}
2929	or $b->{id} <=> $a->{id}	3916	or $b->{id} <=> $a->{id}
2930	} values %{ $self->{item} };	3917	} values %{ $self->{item} };
2931		3918
		3919	$self->{timer}->interval (1);
		3920
2932	my $count = 10 + 1;	3921	my $count = 10 + 1;
2933	for my $item (@items) {	3922	for my $item (@items) {
2934	last unless --$count;	3923	last unless --$count;
2935		3924
2936	push @widgets, $item->{label} ||= do {	3925	my $label = $item->{label} ||= do {
2937	# TODO: doesn't handle markup well (read as: at all)	3926	# TODO: doesn't handle markup well (read as: at all)
2938	my $short = $item->{count} > 1	3927	my $short = $item->{count} > 1
2939	? "<b>$item->{count} ×</b> $item->{text}"	3928	? "<b>$item->{count} ×</b> $item->{text}"
2940	: $item->{text};	3929	: $item->{text};
2941		3930
2942	for ($short) {	3931	for ($short) {
2943	s/^\s+//;	3932	s/^\s+//;
2944	s/\s+/ /g;	3933	s/\s+/ /g;
2945	}	3934	}
2946		3935
2947	new CFClient::UI::Label	3936	new CFPlus::UI::Label
2948	markup => $short,	3937	markup => $short,
2949	tooltip => $item->{tooltip},	3938	tooltip => $item->{tooltip},
2950	tooltip_font => $::FONT_PROP,	3939	tooltip_font => $::FONT_PROP,
2951	tooltip_width => 0.67,	3940	tooltip_width => 0.67,
2952	fontsize => $item->{fontsize} || $self->{fontsize},	3941	fontsize => $item->{fontsize} || $self->{fontsize},
2953	max_w => $::WIDTH * 0.44,	3942	max_w => $::WIDTH * 0.44,
2954	fg => $item->{fg},	3943	fg => [@{ $item->{fg} }],
2955	can_events => 1,	3944	can_events => 1,
2956	can_hover => 1	3945	can_hover => 1
2957	};	3946	};
		3947
		3948	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3949	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3950	$label->update;
		3951	$label->set_max_size (undef, $label->{req_h} * $diff)
		3952	if $diff < 1;
		3953	$self->{timer}->interval (1/30);
		3954	} else {
		3955	$label->{fg}[3] = $item->{fg}[3] || 1;
		3956	}
		3957
		3958	push @widgets, $label;
2958	}	3959	}
2959		3960
2960	$self->clear;	3961	$self->clear;
2961	$self->SUPER::add (reverse @widgets);	3962	$self->SUPER::add (reverse @widgets);
2962	}	3963	}
…		…
2967	$text =~ s/^\s+//;	3968	$text =~ s/^\s+//;
2968	$text =~ s/\s+$//;	3969	$text =~ s/\s+$//;
2969		3970
2970	return unless $text;	3971	return unless $text;
2971		3972
2972	my $timeout = time + ((delete $arg{timeout}) || 60);	3973	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2973		3974
2974	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3975	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2975		3976
2976	if (my $item = $self->{item}{$group}) {	3977	if (my $item = $self->{item}{$group}) {
2977	if ($item->{text} eq $text) {	3978	if ($item->{text} eq $text) {
2978	$item->{count}++;	3979	$item->{count}++;
2979	} else {	3980	} else {
2980	$item->{count} = 1;	3981	$item->{count} = 1;
2981	$item->{text} = $item->{tooltip} = $text;	3982	$item->{text} = $item->{tooltip} = $text;
2982	}	3983	}
2983	$item->{id} = ++$self->{id};	3984	$item->{id} += 0.2;#d#
2984	$item->{timeout} = $timeout;	3985	$item->{timeout} = $timeout;
2985	delete $item->{label};	3986	delete $item->{label};
2986	} else {	3987	} else {
2987	$self->{item}{$group} = {	3988	$self->{item}{$group} = {
2988	id => ++$self->{id},	3989	id => ++$self->{id},
…		…
2994	count => 1,	3995	count => 1,
2995	%arg,	3996	%arg,
2996	};	3997	};
2997	}	3998	}
2998		3999
		4000	$ROOT->on_refresh (reorder => sub {
2999	$self->reorder;	4001	$self->reorder;
		4002	});
3000	}	4003	}
3001		4004
3002	sub reconfigure {	4005	sub reconfigure {
3003	my ($self) = @_;	4006	my ($self) = @_;
3004		4007
…		…
3007		4010
3008	$self->reorder;	4011	$self->reorder;
3009	$self->SUPER::reconfigure;	4012	$self->SUPER::reconfigure;
3010	}	4013	}
3011		4014
		4015	sub destroy {
		4016	my ($self) = @_;
		4017
		4018	$self->{timer}->cancel;
		4019
		4020	$self->SUPER::destroy;
		4021	}
		4022
3012	#############################################################################	4023	#############################################################################
3013		4024
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
3157	sub ask_for_bind_and_commit {
3158	my ($self) = @_;
3159	$self->ask_for_bind (1);
3160	}
3161
3162	sub ask_for_bind {
3163	my ($self, $commit) = @_;
3164
3165	CFClient::Binder::open_binding_dialog (sub {
3166	my ($mod, $sym) = @_;
3167	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3168	$self->update_binding_widgets;
3169	$self->commit if $commit;
3170	});
3171	}
3172
3173	# $mod and $sym are the modifiers and key symbol
3174	# $cmds is a array ref of strings (the commands)
3175	# $cb is the callback that is executed on OK
3176	# $ccb is the callback that is executed on CANCEL and
3177	# when the binding was unsuccessful on OK
3178	sub set_binding {
3179	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3180
3181	$self->clear_command_list;
3182	$self->{recording} = 0;
3183	$self->{rec_btn}->set_text ("start recording");
3184
3185	$self->{binding} = [$mod, $sym];
3186	$self->{commands} = $cmds;
3187
3188	$self->{binding_change} = $cb;
3189	$self->{binding_cancel} = $ccb;
3190
3191	$self->update_binding_widgets;
3192	}
3193
3194	# this is a shortcut method that asks for a binding
3195	# and then just binds it.
3196	sub do_quick_binding {
3197	my ($self, $cmds) = @_;
3198	$self->set_binding (undef, undef, $cmds, sub {
3199	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3200	});
3201	$self->ask_for_bind (1);
3202	}
3203
3204	sub update_binding_widgets {
3205	my ($self) = @_;
3206	my ($mod, $sym, $cmds) = $self->get_binding;
3207	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3208	$self->set_command_list ($cmds);
3209	}
3210
3211	sub get_binding {
3212	my ($self) = @_;
3213	return (
3214	$self->{binding}->[0],
3215	$self->{binding}->[1],
3216	[ grep { defined $_ } @{$self->{commands}} ]
3217	);
3218	}
3219
3220	sub clear_command_list {
3221	my ($self) = @_;
3222	$self->{cmdbox}->clear ();
3223	}
3224
3225	sub set_command_list {
3226	my ($self, $cmds) = @_;
3227
3228	$self->{cmdbox}->clear ();
3229	$self->{commands} = $cmds;
3230
3231	my $idx = 0;
3232
3233	for (@$cmds) {
3234	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3235
3236	my $i = $idx;
3237	$hb->add (new CFClient::UI::Label text => $_);
3238	$hb->add (new CFClient::UI::Button
3239	text => "delete",
3240	tooltip => "Deletes the action from the record",
3241	on_activate => sub {
3242	$self->{cmdbox}->remove ($hb);
3243	$cmds->[$i] = undef;
3244	});
3245
3246
3247	$idx++
3248	}
3249	}
3250
3251	#############################################################################
3252
3253	package CFClient::UI::SpellList;
3254
3255	our @ISA = CFClient::UI::FancyFrame::;
3256
3257	sub new {
3258	my $class = shift;
3259
3260	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3261
3262	$self->add (new CFClient::UI::ScrolledWindow
3263	scrolled => $self->{spellbox} = new CFClient::UI::Table);
3264
3265	$self;
3266	}
3267
3268	# XXX: Do sorting? Argl...
3269	sub add_spell {
3270	my ($self, $spell) = @_;
3271	$self->{spells}->{$spell->{name}} = $spell;
3272
3273	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3274	face => $spell->{face},
3275	can_hover => 1,
3276	can_events => 1,
3277	tooltip => $spell->{message});
3278
3279	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3280	text => $spell->{name},
3281	can_hover => 1,
3282	can_events => 1,
3283	tooltip => $spell->{message},
3284	expand => 1);
3285
3286	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3287	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3288	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3289	expand => 1);
3290
3291	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3292	text => "bind to key",
3293	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3294	}
3295
3296	sub rebuild_spell_list {
3297	my ($self) = @_;
3298	$self->{tbl_idx} = 0;
3299	$self->add_spell ($_) for values %{$self->{spells}};
3300	}
3301
3302	sub remove_spell {
3303	my ($self, $spell) = @_;
3304	delete $self->{spells}->{$spell->{name}};
3305	$self->rebuild_spell_list;
3306	}
3307
3308	#############################################################################
3309
3310	package CFClient::UI::Root;	4025	package CFPlus::UI::Root;
3311		4026
3312	our @ISA = CFClient::UI::Container::;	4027	our @ISA = CFPlus::UI::Container::;
3313		4028
		4029	use List::Util qw(min max);
		4030
3314	use CFClient::OpenGL;	4031	use CFPlus::OpenGL;
3315		4032
3316	sub new {	4033	sub new {
3317	my $class = shift;	4034	my $class = shift;
3318		4035
3319	my $self = $class->SUPER::new (	4036	my $self = $class->SUPER::new (
3320	visible => 1,	4037	visible => 1,
3321	@_,	4038	@_,
3322	);	4039	);
3323		4040
3324	Scalar::Util::weaken ($self->{root} = $self);	4041	CFPlus::weaken ($self->{root} = $self);
3325		4042
3326	$self	4043	$self
3327	}	4044	}
3328		4045
3329	sub size_request {	4046	sub size_request {
…		…
3344	$coord = $max - $size if $coord > $max - $size;	4061	$coord = $max - $size if $coord > $max - $size;
3345		4062
3346	int $coord + 0.5	4063	int $coord + 0.5
3347	}	4064	}
3348		4065
3349	sub size_allocate {	4066	sub invoke_size_allocate {
3350	my ($self, $w, $h) = @_;	4067	my ($self, $w, $h) = @_;
3351		4068
3352	for my $child ($self->children) {	4069	for my $child ($self->children) {
3353	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	4070	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3354		4071
…		…
3358	$X = _to_pixel $X, $W, $self->{w};	4075	$X = _to_pixel $X, $W, $self->{w};
3359	$Y = _to_pixel $Y, $H, $self->{h};	4076	$Y = _to_pixel $Y, $H, $self->{h};
3360		4077
3361	$child->configure ($X, $Y, $W, $H);	4078	$child->configure ($X, $Y, $W, $H);
3362	}	4079	}
		4080
		4081	1
3363	}	4082	}
3364		4083
3365	sub coord2local {	4084	sub coord2local {
3366	my ($self, $x, $y) = @_;	4085	my ($self, $x, $y) = @_;
3367		4086
…		…
3452		4171
3453	delete $queue{$widget+0};	4172	delete $queue{$widget+0};
3454		4173
3455	my ($w, $h) = $widget->size_request;	4174	my ($w, $h) = $widget->size_request;
3456		4175
3457	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;	4176	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3458	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;	4177	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		4178
		4179	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		4180	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3459		4181
3460	$w = $widget->{force_w} if exists $widget->{force_w};	4182	$w = $widget->{force_w} if exists $widget->{force_w};
3461	$h = $widget->{force_h} if exists $widget->{force_h};	4183	$h = $widget->{force_h} if exists $widget->{force_h};
3462		4184
3463	if ($widget->{req_w} != $w || $widget->{req_h} != $h	4185	if ($widget->{req_w} != $w || $widget->{req_h} != $h
…		…
3490	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	4212	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3491		4213
3492	$w = 0 if $w < 0;	4214	$w = 0 if $w < 0;
3493	$h = 0 if $h < 0;	4215	$h = 0 if $h < 0;
3494		4216
		4217	$w = max $widget->{min_w}, $w;
		4218	$h = max $widget->{min_h}, $h;
		4219
		4220	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		4221	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		4222
		4223	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		4224	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		4225
3495	$w = int $w + 0.5;	4226	$w = int $w + 0.5;
3496	$h = int $h + 0.5;	4227	$h = int $h + 0.5;
3497		4228
3498	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	4229	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3499	$widget->{old_w} = $widget->{w};	4230	$widget->{old_w} = $widget->{w};
…		…
3509		4240
3510	while ($self->{post_alloc_hook}) {	4241	while ($self->{post_alloc_hook}) {
3511	$_->()	4242	$_->()
3512	for values %{delete $self->{post_alloc_hook}};	4243	for values %{delete $self->{post_alloc_hook}};
3513	}	4244	}
3514
3515		4245
3516	glViewport 0, 0, $::WIDTH, $::HEIGHT;	4246	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3517	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	4247	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3518	glClear GL_COLOR_BUFFER_BIT;	4248	glClear GL_COLOR_BUFFER_BIT;
3519		4249
…		…
3522	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4252	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3523	glMatrixMode GL_MODELVIEW;	4253	glMatrixMode GL_MODELVIEW;
3524	glLoadIdentity;	4254	glLoadIdentity;
3525		4255
3526	{	4256	{
3527	package CFClient::UI::Base;	4257	package CFPlus::UI::Base;
3528		4258
3529	($draw_x, $draw_y, $draw_w, $draw_h) =	4259	local ($draw_x, $draw_y, $draw_w, $draw_h) =
3530	(0, 0, $self->{w}, $self->{h});	4260	(0, 0, $self->{w}, $self->{h});
3531	}
3532		4261
3533	$self->_draw;	4262	$self->_draw;
		4263	}
3534	}	4264	}
3535		4265
3536	#############################################################################	4266	#############################################################################
3537		4267
3538	package CFClient::UI;	4268	package CFPlus::UI;
3539		4269
3540	$ROOT = new CFClient::UI::Root;	4270	$ROOT = new CFPlus::UI::Root;
3541	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4271	$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
3542		4272
3543	1	4273	1
3544		4274

Diff Legend

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