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

Diff Legend

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