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

Diff Legend

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