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

Diff Legend

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