ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/DC/UI.pm

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

Diff Legend

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