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

Diff Legend

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