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.366 by root, Mon Apr 23 19:17:41 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};
…		…
1650		1974
1651	if ($uni == 8) {	1975	if ($uni == 8) {
1652	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1976	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1653	} elsif ($uni == 127) {	1977	} elsif ($uni == 127) {
1654	substr $text, $self->{cursor}, 1, "";	1978	substr $text, $self->{cursor}, 1, "";
1655	} elsif ($sym == CFClient::SDLK_LEFT) {	1979	} elsif ($sym == CFPlus::SDLK_LEFT) {
1656	--$self->{cursor} if $self->{cursor};	1980	--$self->{cursor} if $self->{cursor};
1657	} elsif ($sym == CFClient::SDLK_RIGHT) {	1981	} elsif ($sym == CFPlus::SDLK_RIGHT) {
1658	++$self->{cursor} if $self->{cursor} < length $self->{text};	1982	++$self->{cursor} if $self->{cursor} < length $self->{text};
1659	} elsif ($sym == CFClient::SDLK_HOME) {	1983	} elsif ($sym == CFPlus::SDLK_HOME) {
		1984	# what a hack
		1985	$self->{cursor} =
		1986	(substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
		1987	? length $1
		1988	: 0;
		1989	} elsif ($sym == CFPlus::SDLK_END) {
		1990	# uh, again
		1991	$self->{cursor} =
		1992	(substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
		1993	? $self->{cursor} + length $1
		1994	: length $self->{text};
		1995	} elsif ($uni == 21) { # ctrl-u
		1996	$text = "";
1660	$self->{cursor} = 0;	1997	$self->{cursor} = 0;
1661	} elsif ($sym == CFClient::SDLK_END) {
1662	$self->{cursor} = length $text;
1663	} elsif ($uni == 27) {	1998	} elsif ($uni == 27) {
1664	$self->_emit ('escape');	1999	$self->emit ('escape');
1665	} elsif ($uni) {	2000	} elsif ($uni == 0x0d) {
		2001	substr $text, $self->{cursor}++, 0, "\012";
		2002	} elsif ($uni >= 0x20) {
1666	substr $text, $self->{cursor}++, 0, chr $uni;	2003	substr $text, $self->{cursor}++, 0, chr $uni;
		2004	} else {
		2005	return 0;
1667	}	2006	}
1668		2007
1669	$self->_set_text ($text);	2008	$self->_set_text ($text);
1670		2009
1671	$self->realloc;	2010	$self->realloc;
1672	}	2011	$self->update;
1673		2012
		2013	1
		2014	}
		2015
1674	sub focus_in {	2016	sub invoke_focus_in {
1675	my ($self) = @_;	2017	my ($self) = @_;
1676		2018
1677	$self->{last_activity} = $::NOW;	2019	$self->{last_activity} = $::NOW;
1678		2020
1679	$self->SUPER::focus_in;	2021	$self->SUPER::invoke_focus_in
1680	}	2022	}
1681		2023
1682	sub button_down {	2024	sub invoke_button_down {
1683	my ($self, $ev, $x, $y) = @_;	2025	my ($self, $ev, $x, $y) = @_;
1684		2026
1685	$self->SUPER::button_down ($ev, $x, $y);	2027	$self->SUPER::invoke_button_down ($ev, $x, $y);
1686		2028
1687	my $idx = $self->{layout}->xy_to_index ($x, $y);	2029	my $idx = $self->{layout}->xy_to_index ($x, $y);
1688		2030
1689	# byte-index to char-index	2031	# byte-index to char-index
1690	my $text = $self->{text};	2032	my $text = $self->{text};
1691	utf8::encode $text;	2033	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1692	$self->{cursor} = length substr $text, 0, $idx;	2034	$self->{cursor} = length $text;
1693		2035
1694	$self->_set_text ($self->{text});	2036	$self->_set_text ($self->{text});
1695	$self->update;	2037	$self->update;
		2038
		2039	1
1696	}	2040	}
1697		2041
1698	sub mouse_motion {	2042	sub invoke_mouse_motion {
1699	my ($self, $ev, $x, $y) = @_;	2043	my ($self, $ev, $x, $y) = @_;
1700	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#	2044	# printf "M %d,%d %d,%d\n", $ev->motion_x, $ev->motion_y, $x, $y;#d#
		2045
		2046	1
1701	}	2047	}
1702		2048
1703	sub _draw {	2049	sub _draw {
1704	my ($self) = @_;	2050	my ($self) = @_;
1705		2051
1706	local $self->{fg} = $self->{fg};	2052	local $self->{fg} = $self->{fg};
1707		2053
1708	if ($FOCUS == $self) {	2054	if ($FOCUS == $self) {
1709	glColor @{$self->{active_bg}};	2055	glColor_premultiply @{$self->{active_bg}};
1710	$self->{fg} = $self->{active_fg};	2056	$self->{fg} = $self->{active_fg};
1711	} else {	2057	} else {
1712	glColor @{$self->{bg}};	2058	glColor_premultiply @{$self->{bg}};
1713	}	2059	}
1714		2060
1715	glEnable GL_BLEND;	2061	glEnable GL_BLEND;
1716	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2062	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1717	glBegin GL_QUADS;	2063	glBegin GL_QUADS;
1718	glVertex 0 , 0;	2064	glVertex 0 , 0;
1719	glVertex 0 , $self->{h};	2065	glVertex 0 , $self->{h};
1720	glVertex $self->{w}, $self->{h};	2066	glVertex $self->{w}, $self->{h};
1721	glVertex $self->{w}, 0;	2067	glVertex $self->{w}, 0;
…		…
1732	utf8::encode $text;	2078	utf8::encode $text;
1733		2079
1734	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)	2080	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1735	}	2081	}
1736		2082
1737	glColor @{$self->{fg}};
1738	glBegin GL_LINES;	2083	glBegin GL_LINES;
1739	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};	2084	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};	2085	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1741	glEnd;	2086	glEnd;
1742	}	2087	}
1743	}	2088	}
1744		2089
		2090	#############################################################################
		2091
1745	package CFClient::UI::Entry;	2092	package CFPlus::UI::Entry;
1746		2093
1747	our @ISA = CFClient::UI::EntryBase::;	2094	our @ISA = CFPlus::UI::EntryBase::;
1748		2095
1749	use CFClient::OpenGL;	2096	use CFPlus::OpenGL;
1750		2097
1751	sub key_down {	2098	sub invoke_key_down {
1752	my ($self, $ev) = @_;	2099	my ($self, $ev) = @_;
1753		2100
1754	my $sym = $ev->{sym};	2101	my $sym = $ev->{sym};
1755		2102
1756	if ($sym == 13) {	2103	if ($ev->{uni} == 0x0d || $sym == 13) {
1757	unshift @{$self->{history}},	2104	unshift @{$self->{history}},
1758	my $txt = $self->get_text;	2105	my $txt = $self->get_text;
		2106
1759	$self->{history_pointer} = -1;	2107	$self->{history_pointer} = -1;
1760	$self->{history_saveback} = '';	2108	$self->{history_saveback} = '';
1761	$self->_emit (activate => $txt);	2109	$self->emit (activate => $txt);
1762	$self->update;	2110	$self->update;
1763		2111
1764	} elsif ($sym == CFClient::SDLK_UP) {	2112	} elsif ($sym == CFPlus::SDLK_UP) {
1765	if ($self->{history_pointer} < 0) {	2113	if ($self->{history_pointer} < 0) {
1766	$self->{history_saveback} = $self->get_text;	2114	$self->{history_saveback} = $self->get_text;
1767	}	2115	}
1768	if (@{$self->{history} || []} > 0) {	2116	if (@{$self->{history} || []} > 0) {
1769	$self->{history_pointer}++;	2117	$self->{history_pointer}++;
…		…
1771	$self->{history_pointer} = @{$self->{history} || []} - 1;	2119	$self->{history_pointer} = @{$self->{history} || []} - 1;
1772	}	2120	}
1773	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2121	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1774	}	2122	}
1775		2123
1776	} elsif ($sym == CFClient::SDLK_DOWN) {	2124	} elsif ($sym == CFPlus::SDLK_DOWN) {
1777	$self->{history_pointer}--;	2125	$self->{history_pointer}--;
1778	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2126	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1779		2127
1780	if ($self->{history_pointer} >= 0) {	2128	if ($self->{history_pointer} >= 0) {
1781	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2129	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1782	} else {	2130	} else {
1783	$self->set_text ($self->{history_saveback});	2131	$self->set_text ($self->{history_saveback});
1784	}	2132	}
1785		2133
1786	} else {	2134	} else {
1787	$self->SUPER::key_down ($ev);	2135	return $self->SUPER::invoke_key_down ($ev)
		2136	}
		2137
1788	}	2138	1
1789
1790	}	2139	}
1791		2140
1792	#############################################################################	2141	#############################################################################
1793		2142
		2143	package CFPlus::UI::TextEdit;
		2144
		2145	our @ISA = CFPlus::UI::EntryBase::;
		2146
		2147	use CFPlus::OpenGL;
		2148
		2149	sub move_cursor_ver {
		2150	my ($self, $dy) = @_;
		2151
		2152	my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
		2153
		2154	$y += $dy;
		2155
		2156	if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
		2157	$self->{cursor} = $index;
		2158	delete $self->{cur_h};
		2159	$self->update;
		2160	return;
		2161	}
		2162	}
		2163
		2164	sub invoke_key_down {
		2165	my ($self, $ev) = @_;
		2166
		2167	my $sym = $ev->{sym};
		2168
		2169	if ($sym == CFPlus::SDLK_UP) {
		2170	$self->move_cursor_ver (-1);
		2171	} elsif ($sym == CFPlus::SDLK_DOWN) {
		2172	$self->move_cursor_ver (+1);
		2173	} else {
		2174	return $self->SUPER::invoke_key_down ($ev)
		2175	}
		2176
		2177	1
		2178	}
		2179
		2180	#############################################################################
		2181
1794	package CFClient::UI::Button;	2182	package CFPlus::UI::Button;
1795		2183
1796	our @ISA = CFClient::UI::Label::;	2184	our @ISA = CFPlus::UI::Label::;
1797		2185
1798	use CFClient::OpenGL;	2186	use CFPlus::OpenGL;
1799		2187
1800	my @tex =	2188	my @tex =
1801	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2189	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1802	qw(b1_button_active.png);	2190	qw(b1_button_active.png);
1803		2191
1804	sub new {	2192	sub new {
1805	my $class = shift;	2193	my $class = shift;
1806		2194
…		…
1815	can_events => 1,	2203	can_events => 1,
1816	@_	2204	@_
1817	)	2205	)
1818	}	2206	}
1819		2207
1820	sub activate { }
1821
1822	sub button_up {	2208	sub invoke_button_up {
1823	my ($self, $ev, $x, $y) = @_;	2209	my ($self, $ev, $x, $y) = @_;
1824		2210
1825	$self->emit ("activate")	2211	$self->emit ("activate")
1826	if $x >= 0 && $x < $self->{w}	2212	if $x >= 0 && $x < $self->{w}
1827	&& $y >= 0 && $y < $self->{h};	2213	&& $y >= 0 && $y < $self->{h};
		2214
		2215	1
1828	}	2216	}
1829		2217
1830	sub _draw {	2218	sub _draw {
1831	my ($self) = @_;	2219	my ($self) = @_;
1832		2220
1833	local $self->{fg} = $self->{fg};	2221	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1834
1835	if ($GRAB == $self) {
1836	$self->{fg} = $self->{active_fg};
1837	}
1838		2222
1839	glEnable GL_TEXTURE_2D;	2223	glEnable GL_TEXTURE_2D;
1840	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2224	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1841	glColor 0, 0, 0, 1;	2225	glColor 0, 0, 0, 1;
1842		2226
…		…
1847	$self->SUPER::_draw;	2231	$self->SUPER::_draw;
1848	}	2232	}
1849		2233
1850	#############################################################################	2234	#############################################################################
1851		2235
1852	package CFClient::UI::CheckBox;	2236	package CFPlus::UI::CheckBox;
1853		2237
1854	our @ISA = CFClient::UI::DrawBG::;	2238	our @ISA = CFPlus::UI::DrawBG::;
1855		2239
1856	my @tex =	2240	my @tex =
1857	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2241	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1858	qw(c1_checkbox_bg.png c1_checkbox_active.png);	2242	qw(c1_checkbox_bg.png c1_checkbox_active.png);
1859		2243
1860	use CFClient::OpenGL;	2244	use CFPlus::OpenGL;
1861		2245
1862	sub new {	2246	sub new {
1863	my $class = shift;	2247	my $class = shift;
1864		2248
1865	$class->SUPER::new (	2249	$class->SUPER::new (
…		…
1879	my ($self) = @_;	2263	my ($self) = @_;
1880		2264
1881	(6) x 2	2265	(6) x 2
1882	}	2266	}
1883		2267
		2268	sub toggle {
		2269	my ($self) = @_;
		2270
		2271	$self->{state} = !$self->{state};
		2272	$self->emit (changed => $self->{state});
		2273	$self->update;
		2274	}
		2275
1884	sub button_down {	2276	sub invoke_button_down {
1885	my ($self, $ev, $x, $y) = @_;	2277	my ($self, $ev, $x, $y) = @_;
1886		2278
1887	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2279	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1888	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2280	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1889	$self->{state} = !$self->{state};	2281	$self->toggle;
1890	$self->_emit (changed => $self->{state});	2282	} else {
		2283	return 0
		2284	}
		2285
1891	}	2286	1
1892	}	2287	}
1893		2288
1894	sub _draw {	2289	sub _draw {
1895	my ($self) = @_;	2290	my ($self) = @_;
1896		2291
…		…
1911	glDisable GL_TEXTURE_2D;	2306	glDisable GL_TEXTURE_2D;
1912	}	2307	}
1913		2308
1914	#############################################################################	2309	#############################################################################
1915		2310
1916	package CFClient::UI::Image;	2311	package CFPlus::UI::Image;
1917		2312
1918	our @ISA = CFClient::UI::Base::;	2313	our @ISA = CFPlus::UI::Base::;
1919		2314
1920	use CFClient::OpenGL;	2315	use CFPlus::OpenGL;
1921	use Carp qw/confess/;
1922		2316
1923	our %loaded_images;	2317	our %texture_cache;
1924		2318
1925	sub new {	2319	sub new {
1926	my $class = shift;	2320	my $class = shift;
1927		2321
1928	my $self = $class->SUPER::new (can_events => 0, @_);	2322	my $self = $class->SUPER::new (
		2323	can_events => 0,
		2324	@_,
		2325	);
1929		2326
1930	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2327	$self->{path} || $self->{tex}
		2328	or Carp::croak "'path' or 'tex' attributes required";
1931		2329
1932	$loaded_images{$self->{image}} ||=	2330	$self->{tex} ||= $texture_cache{$self->{path}} ||=
1933	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2331	new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
1934		2332
1935	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2333	CFPlus::weaken $texture_cache{$self->{path}};
1936		2334
1937	Scalar::Util::weaken $loaded_images{$self->{image}};	2335	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
1938
1939	$self->{aspect} = $tex->{w} / $tex->{h};
1940		2336
1941	$self	2337	$self
1942	}	2338	}
1943		2339
		2340	sub STORABLE_freeze {
		2341	my ($self, $cloning) = @_;
		2342
		2343	$self->{path}
		2344	or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
		2345
		2346	$self->{path}
		2347	}
		2348
		2349	sub STORABLE_attach {
		2350	my ($self, $cloning, $path) = @_;
		2351
		2352	$self->new (path => $path)
		2353	}
		2354
1944	sub size_request {	2355	sub size_request {
1945	my ($self) = @_;	2356	my ($self) = @_;
1946		2357
1947	($self->{tex}->{w}, $self->{tex}->{h})	2358	($self->{tex}{w}, $self->{tex}{h})
1948	}	2359	}
1949		2360
1950	sub _draw {	2361	sub _draw {
1951	my ($self) = @_;	2362	my ($self) = @_;
1952		2363
…		…
1962	}	2373	}
1963		2374
1964	glEnable GL_TEXTURE_2D;	2375	glEnable GL_TEXTURE_2D;
1965	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2376	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1966		2377
1967	$tex->draw_quad_alpha (0, 0, $w, $h);	2378	$tex->draw_quad (0, 0, $w, $h);
1968		2379
1969	glDisable GL_TEXTURE_2D;	2380	glDisable GL_TEXTURE_2D;
1970	}	2381	}
1971		2382
1972	#############################################################################	2383	#############################################################################
1973		2384
		2385	package CFPlus::UI::ImageButton;
		2386
		2387	our @ISA = CFPlus::UI::Image::;
		2388
		2389	use CFPlus::OpenGL;
		2390
		2391	my %textures;
		2392
		2393	sub new {
		2394	my $class = shift;
		2395
		2396	my $self = $class->SUPER::new (
		2397	padding_x => 4,
		2398	padding_y => 4,
		2399	fg => [1, 1, 1],
		2400	active_fg => [0, 0, 1],
		2401	can_hover => 1,
		2402	align => 0,
		2403	valign => 0,
		2404	can_events => 1,
		2405	@_
		2406	);
		2407	}
		2408
		2409	sub invoke_button_up {
		2410	my ($self, $ev, $x, $y) = @_;
		2411
		2412	$self->emit ("activate")
		2413	if $x >= 0 && $x < $self->{w}
		2414	&& $y >= 0 && $y < $self->{h};
		2415
		2416	1
		2417	}
		2418
		2419	#############################################################################
		2420
1974	package CFClient::UI::VGauge;	2421	package CFPlus::UI::VGauge;
1975		2422
1976	our @ISA = CFClient::UI::Base::;	2423	our @ISA = CFPlus::UI::Base::;
1977		2424
1978	use List::Util qw(min max);	2425	use List::Util qw(min max);
1979		2426
1980	use CFClient::OpenGL;	2427	use CFPlus::OpenGL;
1981		2428
1982	my %tex = (	2429	my %tex = (
1983	food => [	2430	food => [
1984	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2431	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1985	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2432	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
1986	],	2433	],
1987	grace => [	2434	grace => [
1988	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2435	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/	2436	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
1990	],	2437	],
1991	hp => [	2438	hp => [
1992	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2439	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1993	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2440	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
1994	],	2441	],
1995	mana => [	2442	mana => [
1996	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2443	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/	2444	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
1998	],	2445	],
1999	);	2446	);
2000		2447
2001	# eg. VGauge->new (gauge => 'food'), default gauge: food	2448	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2061	my $ycut1 = max 0, min 1, $ycut;	2508	my $ycut1 = max 0, min 1, $ycut;
2062	my $ycut2 = max 0, min 1, $ycut - 1;	2509	my $ycut2 = max 0, min 1, $ycut - 1;
2063		2510
2064	my $h1 = $self->{h} * (1 - $ycut1);	2511	my $h1 = $self->{h} * (1 - $ycut1);
2065	my $h2 = $self->{h} * (1 - $ycut2);	2512	my $h2 = $self->{h} * (1 - $ycut2);
		2513	my $h3 = $self->{h};
		2514
		2515	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2066		2516
2067	glEnable GL_BLEND;	2517	glEnable GL_BLEND;
2068	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2518	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2519	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2069	glEnable GL_TEXTURE_2D;	2520	glEnable GL_TEXTURE_2D;
2070	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2521	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2071		2522
2072	glBindTexture GL_TEXTURE_2D, $t1->{name};	2523	glBindTexture GL_TEXTURE_2D, $t1->{name};
2073	glBegin GL_QUADS;	2524	glBegin GL_QUADS;
…		…
2088		2539
2089	if ($t3) {	2540	if ($t3) {
2090	glBindTexture GL_TEXTURE_2D, $t3->{name};	2541	glBindTexture GL_TEXTURE_2D, $t3->{name};
2091	glBegin GL_QUADS;	2542	glBegin GL_QUADS;
2092	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2543	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2093	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2544	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2094	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2545	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2095	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2546	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2096	glEnd;	2547	glEnd;
2097	}	2548	}
2098		2549
2099	glDisable GL_BLEND;	2550	glDisable GL_BLEND;
2100	glDisable GL_TEXTURE_2D;	2551	glDisable GL_TEXTURE_2D;
2101	}	2552	}
2102		2553
2103	#############################################################################	2554	#############################################################################
2104		2555
2105	package CFClient::UI::Gauge;	2556	package CFPlus::UI::Gauge;
2106		2557
2107	our @ISA = CFClient::UI::VBox::;	2558	our @ISA = CFPlus::UI::VBox::;
2108		2559
2109	sub new {	2560	sub new {
2110	my ($class, %arg) = @_;	2561	my ($class, %arg) = @_;
2111		2562
2112	my $self = $class->SUPER::new (	2563	my $self = $class->SUPER::new (
…		…
2114	can_hover => 1,	2565	can_hover => 1,
2115	can_events => 1,	2566	can_events => 1,
2116	%arg,	2567	%arg,
2117	);	2568	);
2118		2569
2119	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2570	$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);	2571	$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");	2572	$self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2122		2573
2123	$self	2574	$self
2124	}	2575	}
2125		2576
2126	sub set_fontsize {	2577	sub set_fontsize {
…		…
2147	$self->{value}->set_text ($val);	2598	$self->{value}->set_text ($val);
2148	}	2599	}
2149		2600
2150	#############################################################################	2601	#############################################################################
2151		2602
2152	package CFClient::UI::Slider;	2603	package CFPlus::UI::Slider;
2153		2604
2154	use strict;	2605	use strict;
2155		2606
2156	use CFClient::OpenGL;	2607	use CFPlus::OpenGL;
2157		2608
2158	our @ISA = CFClient::UI::DrawBG::;	2609	our @ISA = CFPlus::UI::DrawBG::;
2159		2610
2160	my @tex =	2611	my @tex =
2161	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2612	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2162	qw(s1_slider.png s1_slider_bg.png);	2613	qw(s1_slider.png s1_slider_bg.png);
2163		2614
2164	sub new {	2615	sub new {
2165	my $class = shift;	2616	my $class = shift;
2166		2617
…		…
2187	$self->update;	2638	$self->update;
2188		2639
2189	$self	2640	$self
2190	}	2641	}
2191		2642
2192	sub changed { }
2193
2194	sub set_range {	2643	sub set_range {
2195	my ($self, $range) = @_;	2644	my ($self, $range) = @_;
2196		2645
2197	($range, $self->{range}) = ($self->{range}, $range);	2646	($range, $self->{range}) = ($self->{range}, $range);
2198		2647
2199	$self->update
2200	if "@$range" ne "@{$self->{range}}";	2648	if ("@$range" ne "@{$self->{range}}") {
		2649	$self->update;
		2650	$self->set_value ($self->{range}[0]);
		2651	}
2201	}	2652	}
2202		2653
2203	sub set_value {	2654	sub set_value {
2204	my ($self, $value) = @_;	2655	my ($self, $value) = @_;
2205		2656
…		…
2216	if $unit;	2667	if $unit;
2217		2668
2218	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2669	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2219		2670
2220	if ($value != $old_value) {	2671	if ($value != $old_value) {
2221	$self->_emit (changed => $value);	2672	$self->emit (changed => $value);
2222	$self->update;	2673	$self->update;
2223	}	2674	}
2224	}	2675	}
2225		2676
2226	sub size_request {	2677	sub size_request {
2227	my ($self) = @_;	2678	my ($self) = @_;
2228		2679
2229	($self->{req_w}, $self->{req_h})	2680	($self->{req_w}, $self->{req_h})
2230	}	2681	}
2231		2682
2232	sub button_down {	2683	sub invoke_button_down {
2233	my ($self, $ev, $x, $y) = @_;	2684	my ($self, $ev, $x, $y) = @_;
2234		2685
2235	$self->SUPER::button_down ($ev, $x, $y);	2686	$self->SUPER::invoke_button_down ($ev, $x, $y);
2236		2687
2237	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2688	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2238		2689
2239	$self->mouse_motion ($ev, $x, $y);	2690	$self->invoke_mouse_motion ($ev, $x, $y)
2240	}	2691	}
2241		2692
2242	sub mouse_motion {	2693	sub invoke_mouse_motion {
2243	my ($self, $ev, $x, $y) = @_;	2694	my ($self, $ev, $x, $y) = @_;
2244		2695
2245	if ($GRAB == $self) {	2696	if ($GRAB == $self) {
2246	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2697	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2247		2698
2248	my (undef, $lo, $hi, $page) = @{$self->{range}};	2699	my (undef, $lo, $hi, $page) = @{$self->{range}};
2249		2700
2250	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2701	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2251		2702
2252	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	2703	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		2704	} else {
		2705	return 0;
		2706	}
		2707
2253	}	2708	1
		2709	}
		2710
		2711	sub invoke_mouse_wheel {
		2712	my ($self, $ev) = @_;
		2713
		2714	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2715
		2716	my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;
		2717
		2718	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
		2719
		2720	! ! $delta
2254	}	2721	}
2255		2722
2256	sub update {	2723	sub update {
2257	my ($self) = @_;	2724	my ($self) = @_;
2258		2725
2259	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	2726	delete $self->{knob_w};
		2727	$self->SUPER::update;
		2728	}
		2729
		2730	sub _draw {
		2731	my ($self) = @_;
		2732
		2733	unless ($self->{knob_w}) {
2260	$self->set_value ($self->{range}[0]);	2734	$self->set_value ($self->{range}[0]);
2261		2735
2262	my ($value, $lo, $hi, $page) = @{$self->{range}};	2736	my ($value, $lo, $hi, $page) = @{$self->{range}};
2263	my $range = ($hi - $page - $lo) || 1e-100;	2737	my $range = ($hi - $page - $lo) || 1e-100;
2264		2738
…		…
2270	$value = ($value - $lo) / $range;	2744	$value = ($value - $lo) / $range;
2271	$value = $value * $self->{scale} + $self->{offset};	2745	$value = $value * $self->{scale} + $self->{offset};
2272		2746
2273	$self->{knob_x} = $value - $knob_w * 0.5;	2747	$self->{knob_x} = $value - $knob_w * 0.5;
2274	$self->{knob_w} = $knob_w;	2748	$self->{knob_w} = $knob_w;
2275	});	2749	}
2276
2277	$self->SUPER::update;
2278	}
2279
2280	sub _draw {
2281	my ($self) = @_;
2282		2750
2283	$self->SUPER::_draw ();	2751	$self->SUPER::_draw ();
2284		2752
2285	glScale $self->{w}, $self->{h};	2753	glScale $self->{w}, $self->{h};
2286		2754
…		…
2306	glDisable GL_TEXTURE_2D;	2774	glDisable GL_TEXTURE_2D;
2307	}	2775	}
2308		2776
2309	#############################################################################	2777	#############################################################################
2310		2778
2311	package CFClient::UI::ValSlider;	2779	package CFPlus::UI::ValSlider;
2312		2780
2313	our @ISA = CFClient::UI::HBox::;	2781	our @ISA = CFPlus::UI::HBox::;
2314		2782
2315	sub new {	2783	sub new {
2316	my ($class, %arg) = @_;	2784	my ($class, %arg) = @_;
2317		2785
2318	my $range = delete $arg{range};	2786	my $range = delete $arg{range};
2319		2787
2320	my $self = $class->SUPER::new (	2788	my $self = $class->SUPER::new (
2321	slider => (new CFClient::UI::Slider expand => 1, range => $range),	2789	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2322	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	2790	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2323	to_value => sub { shift },	2791	to_value => sub { shift },
2324	from_value => sub { shift },	2792	from_value => sub { shift },
2325	%arg,	2793	%arg,
2326	);	2794	);
2327		2795
…		…
2347	sub set_range { shift->{slider}->set_range (@_) }	2815	sub set_range { shift->{slider}->set_range (@_) }
2348	sub set_value { shift->{slider}->set_value (@_) }	2816	sub set_value { shift->{slider}->set_value (@_) }
2349		2817
2350	#############################################################################	2818	#############################################################################
2351		2819
2352	package CFClient::UI::TextView;	2820	package CFPlus::UI::TextScroller;
2353		2821
2354	our @ISA = CFClient::UI::HBox::;	2822	our @ISA = CFPlus::UI::HBox::;
2355		2823
2356	use CFClient::OpenGL;	2824	use CFPlus::OpenGL;
2357		2825
2358	sub new {	2826	sub new {
2359	my $class = shift;	2827	my $class = shift;
2360		2828
2361	my $self = $class->SUPER::new (	2829	my $self = $class->SUPER::new (
2362	fontsize => 1,	2830	fontsize => 1,
2363	can_events => 0,	2831	can_events => 1,
		2832	indent => 0,
2364	#font => default_font	2833	#font => default_font
2365	@_,	2834	@_,
2366		2835
2367	layout => (new CFClient::Layout 1),	2836	layout => (new CFPlus::Layout),
2368	par => [],	2837	par => [],
		2838	max_par => 0,
2369	height => 0,	2839	height => 0,
2370	children => [	2840	children => [
2371	(new CFClient::UI::Empty expand => 1),	2841	(new CFPlus::UI::Empty expand => 1),
2372	(new CFClient::UI::Slider vertical => 1),	2842	(new CFPlus::UI::Slider vertical => 1),
2373	],	2843	],
2374	);	2844	);
2375		2845
2376	$self->{children}[1]->connect (changed => sub { $self->update });	2846	$self->{children}[1]->connect (changed => sub { $self->update });
2377		2847
…		…
2383		2853
2384	$self->{fontsize} = $fontsize;	2854	$self->{fontsize} = $fontsize;
2385	$self->reflow;	2855	$self->reflow;
2386	}	2856	}
2387		2857
		2858	sub size_request {
		2859	my ($self) = @_;
		2860
		2861	my ($empty, $slider) = @{ $self->{children} };
		2862
		2863	local $self->{children} = [$empty, $slider];
		2864	$self->SUPER::size_request
		2865	}
		2866
2388	sub size_allocate {	2867	sub invoke_size_allocate {
2389	my ($self, $w, $h) = @_;	2868	my ($self, $w, $h) = @_;
2390		2869
2391	$self->SUPER::size_allocate ($w, $h);	2870	my ($empty, $slider, @other) = @{ $self->{children} };
		2871	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2392		2872
2393	$self->{layout}->set_font ($self->{font}) if $self->{font};	2873	$self->{layout}->set_font ($self->{font}) if $self->{font};
2394	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2874	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2395	$self->{layout}->set_width ($self->{children}[0]{w});	2875	$self->{layout}->set_width ($empty->{w});
		2876	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2396		2877
2397	$self->reflow;	2878	$self->reflow;
2398	}
2399		2879
2400	sub text_size {	2880	local $self->{children} = [$empty, $slider];
		2881	$self->SUPER::invoke_size_allocate ($w, $h)
		2882	}
		2883
		2884	sub invoke_mouse_wheel {
2401	my ($self, $text, $indent) = @_;	2885	my ($self, $ev) = @_;
		2886
		2887	return 0 unless $ev->{dy}; # only vertical movements
		2888
		2889	$self->{children}[1]->emit (mouse_wheel => $ev);
		2890
		2891	1
		2892	}
		2893
		2894	sub get_layout {
		2895	my ($self, $para) = @_;
2402		2896
2403	my $layout = $self->{layout};	2897	my $layout = $self->{layout};
2404		2898
		2899	$layout->set_font ($self->{font}) if $self->{font};
		2900	$layout->set_foreground (@{$para->{fg}});
2405	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2901	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2406	$layout->set_width ($self->{children}[0]{w} - $indent);	2902	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
		2903	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2407	$layout->set_markup ($text);	2904	$layout->set_markup ($para->{markup});
		2905
		2906	$layout->set_shapes (
		2907	map
		2908	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2909	@{$para->{widget}}
2408		2910	);
		2911
2409	$layout->size	2912	$layout
2410	}	2913	}
2411		2914
2412	sub reflow {	2915	sub reflow {
2413	my ($self) = @_;	2916	my ($self) = @_;
2414		2917
…		…
2421		2924
2422	# todo: base offset on lines or so, not on pixels	2925	# todo: base offset on lines or so, not on pixels
2423	$self->{children}[1]->set_value ($offset);	2926	$self->{children}[1]->set_value ($offset);
2424	}	2927	}
2425		2928
		2929	sub current_paragraph {
		2930	my ($self) = @_;
		2931
		2932	$self->{top_paragraph} - 1
		2933	}
		2934
		2935	sub scroll_to {
		2936	my ($self, $para) = @_;
		2937
		2938	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		2939
		2940	$self->{scroll_to} = $para;
		2941	$self->update;
		2942	}
		2943
2426	sub clear {	2944	sub clear {
2427	my ($self) = @_;	2945	my ($self) = @_;
		2946
		2947	my (undef, undef, @other) = @{ $self->{children} };
		2948	$self->remove ($_) for @other;
2428		2949
2429	$self->{par} = [];	2950	$self->{par} = [];
2430	$self->{height} = 0;	2951	$self->{height} = 0;
2431	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2952	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2432	}	2953	}
2433		2954
2434	sub add_paragraph {	2955	sub add_paragraph {
2435	my ($self, $color, $text, $indent) = @_;	2956	my $self = shift;
2436		2957
2437	for my $line (split /\n/, $text) {	2958	for my $para (@_) {
2438	my ($w, $h) = $self->text_size ($line);	2959	$para = {
		2960	fg => [1, 1, 1, 1],
		2961	indent => 0,
		2962	markup => "",
		2963	widget => [],
		2964	ref $para ? %$para : (markup => $para),
		2965	w => 1e10,
		2966	wrapped => 1,
		2967	};
		2968
		2969	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		2970	push @{$self->{par}}, $para;
		2971	}
		2972
		2973	if (my $max = $self->{max_par}) {
		2974	shift @{$self->{par}} while @{$self->{par}} > $max;
		2975	}
		2976
		2977	$self->{need_reflow}++;
		2978	$self->update;
		2979	}
		2980
		2981	sub scroll_to_bottom {
		2982	my ($self) = @_;
		2983
		2984	$self->{scroll_to} = $#{$self->{par}};
		2985	$self->update;
		2986	}
		2987
		2988	sub force_uptodate {
		2989	my ($self) = @_;
		2990
		2991	if (delete $self->{need_reflow}) {
		2992	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2993
		2994	my $height = 0;
		2995
		2996	for my $para (@{$self->{par}}) {
		2997	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		2998	my $layout = $self->get_layout ($para);
		2999	my ($w, $h) = $layout->size;
		3000
		3001	$para->{w} = $w + $para->{indent};
		3002	$para->{h} = $h;
		3003	$para->{wrapped} = $layout->has_wrapped;
		3004	}
		3005
		3006	$para->{y} = $height;
		3007	$height += $para->{h};
		3008	}
		3009
2439	$self->{height} += $h;	3010	$self->{height} = $height;
2440	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3011	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2441	}
2442		3012
2443	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	3013	delete $self->{texture};
		3014	}
		3015
		3016	if (my $paridx = delete $self->{scroll_to}) {
		3017	$self->{children}[1]->set_value ($self->{par}[$paridx]{y});
		3018	}
2444	}	3019	}
2445		3020
2446	sub update {	3021	sub update {
2447	my ($self) = @_;	3022	my ($self) = @_;
2448		3023
…		…
2450		3025
2451	return unless $self->{h} > 0;	3026	return unless $self->{h} > 0;
2452		3027
2453	delete $self->{texture};	3028	delete $self->{texture};
2454		3029
2455	$ROOT->on_post_alloc ($self, sub {	3030	$ROOT->on_post_alloc ($self => sub {
		3031	$self->force_uptodate;
		3032
2456	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3033	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2457		3034
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 {	3035	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2485	glClearColor 0.5, 0.5, 0.5, 0;	3036	glClearColor 0, 0, 0, 0;
2486	glClear GL_COLOR_BUFFER_BIT;	3037	glClear GL_COLOR_BUFFER_BIT;
2487		3038
		3039	package CFPlus::UI::Base;
		3040	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		3041	(0, 0, $self->{w}, $self->{h});
		3042
		3043	my $top = int $self->{children}[1]{range}[0];
		3044
		3045	my $paridx = 0;
		3046	my $top_paragraph;
2488	my $top = int $self->{children}[1]{range}[0];	3047	my $top = int $self->{children}[1]{range}[0];
2489		3048
2490	my $y0 = $top;	3049	my $y0 = $top;
2491	my $y1 = $top + $H;	3050	my $y1 = $top + $H;
2492		3051
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}}) {	3052	for my $para (@{$self->{par}}) {
2504	my $h = $par->[1];	3053	my $h = $para->{h};
		3054	my $y = $para->{y};
2505		3055
2506	if ($y0 < $y + $h && $y < $y1) {	3056	if ($y0 < $y + $h && $y < $y1) {
2507	$layout->set_foreground (@{ $par->[2] });	3057	my $layout = $self->get_layout ($para);
2508	$layout->set_width ($W - $par->[3]);
2509	$layout->set_markup ($par->[4]);
2510		3058
2511	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3059	$layout->render ($para->{indent}, $y - $y0);
2512		3060
2513	glRasterPos $par->[3], $y - $y0;	3061	if (my @w = @{ $para->{widget} }) {
2514	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3062	my @s = $layout->get_shapes;
		3063
		3064	for (@w) {
		3065	my ($dx, $dy) = splice @s, 0, 2, ();
		3066
		3067	$_->{x} = $dx + $para->{indent};
		3068	$_->{y} = $dy + $y - $y0;
		3069
		3070	$_->draw;
		3071	}
		3072	}
2515	}	3073	}
2516		3074
2517	$y += $h;	3075	$paridx++;
		3076	$top_paragraph ||= $paridx if $y >= $top;
2518	}	3077	}
2519		3078
2520	glDisable GL_BLEND;	3079	$self->{top_paragraph} = $top_paragraph;
2521	};	3080	};
2522	});	3081	});
2523	}	3082	}
2524		3083
		3084	sub reconfigure {
		3085	my ($self) = @_;
		3086
		3087	$self->SUPER::reconfigure;
		3088
		3089	$_->{w} = 1e10 for @{ $self->{par} };
		3090	$self->reflow;
		3091	}
		3092
2525	sub _draw {	3093	sub _draw {
2526	my ($self) = @_;	3094	my ($self) = @_;
2527		3095
2528	glEnable GL_TEXTURE_2D;	3096	glEnable GL_TEXTURE_2D;
2529	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3097	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2530	glColor 1, 1, 1, 1;	3098	glColor 0, 0, 0, 1;
2531	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	3099	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2532	glDisable GL_TEXTURE_2D;	3100	glDisable GL_TEXTURE_2D;
2533		3101
2534	$self->{children}[1]->draw;	3102	$self->{children}[1]->draw;
2535
2536	}	3103	}
2537		3104
2538	#############################################################################	3105	#############################################################################
2539		3106
2540	package CFClient::UI::Animator;	3107	package CFPlus::UI::Animator;
2541		3108
2542	use CFClient::OpenGL;	3109	use CFPlus::OpenGL;
2543		3110
2544	our @ISA = CFClient::UI::Bin::;	3111	our @ISA = CFPlus::UI::Bin::;
2545		3112
2546	sub moveto {	3113	sub moveto {
2547	my ($self, $x, $y) = @_;	3114	my ($self, $x, $y) = @_;
2548		3115
2549	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3116	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2577	glPopMatrix;	3144	glPopMatrix;
2578	}	3145	}
2579		3146
2580	#############################################################################	3147	#############################################################################
2581		3148
2582	package CFClient::UI::Flopper;	3149	package CFPlus::UI::Flopper;
2583		3150
2584	our @ISA = CFClient::UI::Button::;	3151	our @ISA = CFPlus::UI::Button::;
2585		3152
2586	sub new {	3153	sub new {
2587	my $class = shift;	3154	my $class = shift;
2588		3155
2589	my $self = $class->SUPER::new (	3156	my $self = $class->SUPER::new (
…		…
2601	$self->{other}->toggle_visibility;	3168	$self->{other}->toggle_visibility;
2602	}	3169	}
2603		3170
2604	#############################################################################	3171	#############################################################################
2605		3172
2606	package CFClient::UI::Tooltip;	3173	package CFPlus::UI::Tooltip;
2607		3174
2608	our @ISA = CFClient::UI::Bin::;	3175	our @ISA = CFPlus::UI::Bin::;
2609		3176
2610	use CFClient::OpenGL;	3177	use CFPlus::OpenGL;
2611		3178
2612	sub new {	3179	sub new {
2613	my $class = shift;	3180	my $class = shift;
2614		3181
2615	$class->SUPER::new (	3182	$class->SUPER::new (
…		…
2618	)	3185	)
2619	}	3186	}
2620		3187
2621	sub set_tooltip_from {	3188	sub set_tooltip_from {
2622	my ($self, $widget) = @_;	3189	my ($self, $widget) = @_;
		3190
		3191	$widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
		3192	if $widget->{tooltip} =~ /^#(.*)$/;
2623		3193
2624	my $tooltip = $widget->{tooltip};	3194	my $tooltip = $widget->{tooltip};
2625		3195
2626	if ($ENV{CFPLUS_DEBUG} & 2) {	3196	if ($ENV{CFPLUS_DEBUG} & 2) {
2627	$tooltip .= "\n\n" . (ref $widget) . "\n"	3197	$tooltip .= "\n\n" . (ref $widget) . "\n"
2628	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3198	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2629	. "req $widget->{req_w} $widget->{req_h}\n"	3199	. "req $widget->{req_w} $widget->{req_h}\n"
2630	. "visible $widget->{visible}";	3200	. "visible $widget->{visible}";
2631	}	3201	}
2632		3202
		3203	$tooltip =~ s/^\n+//;
		3204	$tooltip =~ s/\n+$//;
		3205
2633	$self->add (new CFClient::UI::Label	3206	$self->add (new CFPlus::UI::Label
2634	markup => $tooltip,	3207	markup => $tooltip,
2635	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3208	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2636	fontsize => 0.8,	3209	fontsize => 0.8,
2637	fg => [0, 0, 0, 1],	3210	style => 1, # FLAG_INVERSE
2638	ellipsise => 0,	3211	ellipsise => 0,
2639	font => ($widget->{tooltip_font} || $::FONT_PROP),	3212	font => ($widget->{tooltip_font} || $::FONT_PROP),
2640	);	3213	);
2641	}	3214	}
2642		3215
…		…
2646	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3219	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2647		3220
2648	($w + 4, $h + 4)	3221	($w + 4, $h + 4)
2649	}	3222	}
2650		3223
2651	sub size_allocate {	3224	sub invoke_size_allocate {
2652	my ($self, $w, $h) = @_;	3225	my ($self, $w, $h) = @_;
2653		3226
2654	$self->SUPER::size_allocate ($w - 4, $h - 4);	3227	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2655	}	3228	}
2656		3229
2657	sub visibility_change {	3230	sub invoke_visibility_change {
2658	my ($self, $visible) = @_;	3231	my ($self, $visible) = @_;
2659		3232
2660	return unless $visible;	3233	return unless $visible;
2661		3234
2662	$self->{root}->on_post_alloc ("move_$self" => sub {	3235	$self->{root}->on_post_alloc ("move_$self" => sub {
2663	my $widget = $self->{owner}	3236	my $widget = $self->{owner}
2664	or return;	3237	or return;
2665		3238
		3239	if ($widget->{visible}) {
2666	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3240	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2667		3241
2668	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3242	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2669	if $x + $self->{w} > $::WIDTH;	3243	if $x + $self->{w} > $self->{root}{w};
2670		3244
2671	$self->move_abs ($x, $y);	3245	$self->move_abs ($x, $y);
		3246	} else {
		3247	$self->hide;
		3248	}
2672	});	3249	});
2673	}	3250	}
2674		3251
2675	sub _draw {	3252	sub _draw {
2676	my ($self) = @_;	3253	my ($self) = @_;
…		…
2700	$self->SUPER::_draw;	3277	$self->SUPER::_draw;
2701	}	3278	}
2702		3279
2703	#############################################################################	3280	#############################################################################
2704		3281
2705	package CFClient::UI::Face;	3282	package CFPlus::UI::Face;
2706		3283
2707	our @ISA = CFClient::UI::Base::;	3284	our @ISA = CFPlus::UI::DrawBG::;
2708		3285
2709	use CFClient::OpenGL;	3286	use CFPlus::OpenGL;
2710		3287
2711	sub new {	3288	sub new {
2712	my $class = shift;	3289	my $class = shift;
2713		3290
2714	my $self = $class->SUPER::new (	3291	my $self = $class->SUPER::new (
…		…
2716	can_events => 0,	3293	can_events => 0,
2717	@_,	3294	@_,
2718	);	3295	);
2719		3296
2720	if ($self->{anim} && $self->{animspeed}) {	3297	if ($self->{anim} && $self->{animspeed}) {
2721	Scalar::Util::weaken (my $widget = $self);	3298	CFPlus::weaken (my $widget = $self);
2722		3299
2723	$self->{timer} = Event->timer (	3300	$self->{timer} = Event->timer (
2724	at => $self->{animspeed} * int $::NOW / $self->{animspeed},	3301	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2725	hard => 1,	3302	hard => 1,
2726	interval => $self->{animspeed},	3303	interval => $self->{animspeed},
…		…
2749	sub _draw {	3326	sub _draw {
2750	my ($self) = @_;	3327	my ($self) = @_;
2751		3328
2752	return unless $::CONN;	3329	return unless $::CONN;
2753		3330
		3331	$self->SUPER::_draw;
		3332
2754	my $face;	3333	my $face;
2755		3334
2756	if ($self->{frame}) {	3335	if ($self->{frame}) {
2757	my $anim = $::CONN->{anim}[$self->{anim}];	3336	my $anim = $::CONN->{anim}[$self->{anim}];
2758		3337
…		…
2763	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	3342	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2764		3343
2765	if ($tex) {	3344	if ($tex) {
2766	glEnable GL_TEXTURE_2D;	3345	glEnable GL_TEXTURE_2D;
2767	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3346	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2768	glColor 1, 1, 1, 1;	3347	glColor 0, 0, 0, 1;
2769	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3348	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2770	glDisable GL_TEXTURE_2D;	3349	glDisable GL_TEXTURE_2D;
2771	}	3350	}
2772	}	3351	}
2773		3352
2774	sub DESTROY {	3353	sub destroy {
2775	my ($self) = @_;	3354	my ($self) = @_;
2776		3355
2777	$self->{timer}->cancel	3356	$self->{timer}->cancel
2778	if $self->{timer};	3357	if $self->{timer};
2779		3358
2780	$self->SUPER::DESTROY;	3359	$self->SUPER::destroy;
2781	}	3360	}
2782		3361
2783	#############################################################################	3362	#############################################################################
2784		3363
2785	package CFClient::UI::Inventory;	3364	package CFPlus::UI::Buttonbar;
2786		3365
2787	our @ISA = CFClient::UI::ScrolledWindow::;	3366	our @ISA = CFPlus::UI::HBox::;
2788		3367
2789	sub new {	3368	# 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		3369
2825	#############################################################################	3370	#############################################################################
2826		3371
2827	package CFClient::UI::Menu;	3372	package CFPlus::UI::Menu;
2828		3373
2829	our @ISA = CFClient::UI::FancyFrame::;	3374	our @ISA = CFPlus::UI::Toplevel::;
2830		3375
2831	use CFClient::OpenGL;	3376	use CFPlus::OpenGL;
2832		3377
2833	sub new {	3378	sub new {
2834	my $class = shift;	3379	my $class = shift;
2835		3380
2836	my $self = $class->SUPER::new (	3381	my $self = $class->SUPER::new (
2837	items => [],	3382	items => [],
2838	z => 100,	3383	z => 100,
2839	@_,	3384	@_,
2840	);	3385	);
2841		3386
2842	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3387	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2843		3388
2844	for my $item (@{ $self->{items} }) {	3389	for my $item (@{ $self->{items} }) {
2845	my ($widget, $cb) = @$item;	3390	my ($widget, $cb, $tooltip) = @$item;
2846		3391
2847	# handle various types of items, only text for now	3392	# handle various types of items, only text for now
2848	if (!ref $widget) {	3393	if (!ref $widget) {
		3394	if ($widget =~ /\t/) {
		3395	my ($left, $right) = split /\t/, $widget, 2;
		3396
2849	$widget = new CFClient::UI::Label	3397	$widget = new CFPlus::UI::HBox
2850	can_hover => 1,	3398	can_hover => 1,
2851	can_events => 1,	3399	can_events => 1,
		3400	tooltip => $tooltip,
		3401	children => [
		3402	(new CFPlus::UI::Label markup => $left, expand => 1),
		3403	(new CFPlus::UI::Label markup => $right, align => +1),
		3404	],
		3405	;
		3406
		3407	} else {
		3408	$widget = new CFPlus::UI::Label
		3409	can_hover => 1,
		3410	can_events => 1,
2852	text => $widget;	3411	markup => $widget,
		3412	tooltip => $tooltip;
		3413	}
2853	}	3414	}
2854		3415
2855	$self->{item}{$widget} = $item;	3416	$self->{item}{$widget} = $item;
2856		3417
2857	$self->{vbox}->add ($widget);	3418	$self->{vbox}->add ($widget);
…		…
2862		3423
2863	# popup given the event (must be a mouse button down event currently)	3424	# popup given the event (must be a mouse button down event currently)
2864	sub popup {	3425	sub popup {
2865	my ($self, $ev) = @_;	3426	my ($self, $ev) = @_;
2866		3427
2867	$self->_emit ("popdown");	3428	$self->emit ("popdown");
2868		3429
2869	# maybe save $GRAB? must be careful about events...	3430	# maybe save $GRAB? must be careful about events...
2870	$GRAB = $self;	3431	$GRAB = $self;
2871	$self->{button} = $ev->{button};	3432	$self->{button} = $ev->{button};
2872		3433
2873	$self->show;	3434	$self->show;
2874	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3435	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2875	}	3436	}
2876		3437
2877	sub mouse_motion {	3438	sub invoke_mouse_motion {
2878	my ($self, $ev, $x, $y) = @_;	3439	my ($self, $ev, $x, $y) = @_;
2879		3440
2880	# TODO: should use vbox->find_widget or so	3441	# TODO: should use vbox->find_widget or so
2881	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3442	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2882	$self->{hover} = $self->{item}{$HOVER};	3443	$self->{hover} = $self->{item}{$HOVER};
2883	}
2884		3444
		3445	0
		3446	}
		3447
2885	sub button_up {	3448	sub invoke_button_up {
2886	my ($self, $ev, $x, $y) = @_;	3449	my ($self, $ev, $x, $y) = @_;
2887		3450
2888	if ($ev->{button} == $self->{button}) {	3451	if ($ev->{button} == $self->{button}) {
2889	undef $GRAB;	3452	undef $GRAB;
2890	$self->hide;	3453	$self->hide;
2891		3454
2892	$self->_emit ("popdown");	3455	$self->emit ("popdown");
2893	$self->{hover}[1]->() if $self->{hover};	3456	$self->{hover}[1]->() if $self->{hover};
		3457	} else {
		3458	return 0
		3459	}
		3460
2894	}	3461	1
2895	}	3462	}
2896		3463
2897	#############################################################################	3464	#############################################################################
2898		3465
2899	package CFClient::UI::Statusbox;	3466	package CFPlus::UI::Multiplexer;
2900		3467
2901	our @ISA = CFClient::UI::VBox::;	3468	our @ISA = CFPlus::UI::Container::;
2902		3469
2903	sub new {	3470	sub new {
2904	my $class = shift;	3471	my $class = shift;
2905		3472
2906	$class->SUPER::new (	3473	my $self = $class->SUPER::new (
		3474	@_,
		3475	);
		3476
		3477	$self->{current} = $self->{children}[0]
		3478	if @{ $self->{children} };
		3479
		3480	$self
		3481	}
		3482
		3483	sub add {
		3484	my ($self, @widgets) = @_;
		3485
		3486	$self->SUPER::add (@widgets);
		3487
		3488	$self->{current} = $self->{children}[0]
		3489	if @{ $self->{children} };
		3490	}
		3491
		3492	sub get_current_page {
		3493	my ($self) = @_;
		3494
		3495	$self->{current}
		3496	}
		3497
		3498	sub set_current_page {
		3499	my ($self, $page_or_widget) = @_;
		3500
		3501	my $widget = ref $page_or_widget
		3502	? $page_or_widget
		3503	: $self->{children}[$page_or_widget];
		3504
		3505	$self->{current} = $widget;
		3506	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3507
		3508	$self->emit (page_changed => $self->{current});
		3509
		3510	$self->realloc;
		3511	}
		3512
		3513	sub visible_children {
		3514	$_[0]{current}
		3515	}
		3516
		3517	sub size_request {
		3518	my ($self) = @_;
		3519
		3520	$self->{current}->size_request
		3521	}
		3522
		3523	sub invoke_size_allocate {
		3524	my ($self, $w, $h) = @_;
		3525
		3526	$self->{current}->configure (0, 0, $w, $h);
		3527
		3528	1
		3529	}
		3530
		3531	sub _draw {
		3532	my ($self) = @_;
		3533
		3534	$self->{current}->draw;
		3535	}
		3536
		3537	#############################################################################
		3538
		3539	package CFPlus::UI::Notebook;
		3540
		3541	our @ISA = CFPlus::UI::VBox::;
		3542
		3543	sub new {
		3544	my $class = shift;
		3545
		3546	my $self = $class->SUPER::new (
		3547	buttonbar => (new CFPlus::UI::Buttonbar),
		3548	multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
		3549	# filter => # will be put between multiplexer and $self
		3550	@_,
		3551	);
		3552
		3553	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3554	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3555
		3556	$self
		3557	}
		3558
		3559	sub add {
		3560	my ($self, $title, $widget, $tooltip) = @_;
		3561
		3562	CFPlus::weaken $self;
		3563
		3564	$self->{buttonbar}->add (new CFPlus::UI::Button
		3565	markup => $title,
		3566	tooltip => $tooltip,
		3567	on_activate => sub { $self->set_current_page ($widget) },
		3568	);
		3569
		3570	$self->{multiplexer}->add ($widget);
		3571	}
		3572
		3573	sub get_current_page {
		3574	my ($self) = @_;
		3575
		3576	$self->{multiplexer}->get_current_page
		3577	}
		3578
		3579	sub set_current_page {
		3580	my ($self, $page) = @_;
		3581
		3582	$self->{multiplexer}->set_current_page ($page);
		3583	$self->emit (page_changed => $self->{multiplexer}{current});
		3584	}
		3585
		3586	#############################################################################
		3587
		3588	package CFPlus::UI::Selector;
		3589
		3590	use utf8;
		3591
		3592	our @ISA = CFPlus::UI::Button::;
		3593
		3594	sub new {
		3595	my $class = shift;
		3596
		3597	my $self = $class->SUPER::new (
		3598	options => [], # [value, title, longdesc], ...
		3599	value => undef,
		3600	@_,
		3601	);
		3602
		3603	$self->_set_value ($self->{value});
		3604
		3605	$self
		3606	}
		3607
		3608	sub invoke_button_down {
		3609	my ($self, $ev) = @_;
		3610
		3611	my @menu_items;
		3612
		3613	for (@{ $self->{options} }) {
		3614	my ($value, $title, $tooltip) = @$_;
		3615
		3616	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		3617	}
		3618
		3619	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
		3620	}
		3621
		3622	sub _set_value {
		3623	my ($self, $value) = @_;
		3624
		3625	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		3626	or return;
		3627
		3628	$self->{value} = $item->[0];
		3629	$self->set_markup ("$item->[1] ⇓");
		3630	$self->set_tooltip ($item->[2]);
		3631	}
		3632
		3633	sub set_value {
		3634	my ($self, $value) = @_;
		3635
		3636	return unless $self->{value} ne $value;
		3637
		3638	$self->_set_value ($value);
		3639	$self->emit (changed => $value);
		3640	}
		3641
		3642	#############################################################################
		3643
		3644	package CFPlus::UI::Statusbox;
		3645
		3646	our @ISA = CFPlus::UI::VBox::;
		3647
		3648	sub new {
		3649	my $class = shift;
		3650
		3651	my $self = $class->SUPER::new (
2907	fontsize => 0.8,	3652	fontsize => 0.8,
2908	@_,	3653	@_,
2909	)	3654	);
		3655
		3656	CFPlus::weaken (my $this = $self);
		3657
		3658	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		3659
		3660	$self
2910	}	3661	}
2911		3662
2912	sub reorder {	3663	sub reorder {
2913	my ($self) = @_;	3664	my ($self) = @_;
2914	my $NOW = time;	3665	my $NOW = Time::HiRes::time;
		3666
		3667	# freeze display when hovering over any label
		3668	return if $CFPlus::UI::TOOLTIP->{owner}
		3669	&& grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
		3670	values %{ $self->{item} };
2915		3671
2916	while (my ($k, $v) = each %{ $self->{item} }) {	3672	while (my ($k, $v) = each %{ $self->{item} }) {
2917	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3673	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2918	}	3674	}
2919		3675
…		…
2922	my @items = sort {	3678	my @items = sort {
2923	$a->{pri} <=> $b->{pri}	3679	$a->{pri} <=> $b->{pri}
2924	or $b->{id} <=> $a->{id}	3680	or $b->{id} <=> $a->{id}
2925	} values %{ $self->{item} };	3681	} values %{ $self->{item} };
2926		3682
		3683	$self->{timer}->interval (1);
		3684
2927	my $count = 10 + 1;	3685	my $count = 10 + 1;
2928	for my $item (@items) {	3686	for my $item (@items) {
2929	last unless --$count;	3687	last unless --$count;
2930		3688
2931	push @widgets, $item->{label} ||= do {	3689	my $label = $item->{label} ||= do {
2932	# TODO: doesn't handle markup well (read as: at all)	3690	# TODO: doesn't handle markup well (read as: at all)
2933	my $short = $item->{count} > 1	3691	my $short = $item->{count} > 1
2934	? "<b>$item->{count} ×</b> $item->{text}"	3692	? "<b>$item->{count} ×</b> $item->{text}"
2935	: $item->{text};	3693	: $item->{text};
2936		3694
2937	for ($short) {	3695	for ($short) {
2938	s/^\s+//;	3696	s/^\s+//;
2939	s/\s+/ /g;	3697	s/\s+/ /g;
2940	}	3698	}
2941		3699
2942	new CFClient::UI::Label	3700	new CFPlus::UI::Label
2943	markup => $short,	3701	markup => $short,
2944	tooltip => $item->{tooltip},	3702	tooltip => $item->{tooltip},
2945	tooltip_font => $::FONT_PROP,	3703	tooltip_font => $::FONT_PROP,
2946	tooltip_width => 0.67,	3704	tooltip_width => 0.67,
2947	fontsize => $item->{fontsize} || $self->{fontsize},	3705	fontsize => $item->{fontsize} || $self->{fontsize},
2948	max_w => $::WIDTH * 0.44,	3706	max_w => $::WIDTH * 0.44,
2949	fg => $item->{fg},	3707	fg => [@{ $item->{fg} }],
2950	can_events => 1,	3708	can_events => 1,
2951	can_hover => 1	3709	can_hover => 1
2952	};	3710	};
		3711
		3712	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		3713	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		3714	$label->update;
		3715	$label->set_max_size (undef, $label->{req_h} * $diff)
		3716	if $diff < 1;
		3717	$self->{timer}->interval (1/30);
		3718	} else {
		3719	$label->{fg}[3] = $item->{fg}[3] || 1;
		3720	}
		3721
		3722	push @widgets, $label;
2953	}	3723	}
2954		3724
2955	$self->clear;	3725	$self->clear;
2956	$self->SUPER::add (reverse @widgets);	3726	$self->SUPER::add (reverse @widgets);
2957	}	3727	}
…		…
2962	$text =~ s/^\s+//;	3732	$text =~ s/^\s+//;
2963	$text =~ s/\s+$//;	3733	$text =~ s/\s+$//;
2964		3734
2965	return unless $text;	3735	return unless $text;
2966		3736
2967	my $timeout = time + ((delete $arg{timeout}) || 60);	3737	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2968		3738
2969	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3739	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2970		3740
2971	if (my $item = $self->{item}{$group}) {	3741	if (my $item = $self->{item}{$group}) {
2972	if ($item->{text} eq $text) {	3742	if ($item->{text} eq $text) {
2973	$item->{count}++;	3743	$item->{count}++;
2974	} else {	3744	} else {
2975	$item->{count} = 1;	3745	$item->{count} = 1;
2976	$item->{text} = $item->{tooltip} = $text;	3746	$item->{text} = $item->{tooltip} = $text;
2977	}	3747	}
2978	$item->{id} = ++$self->{id};	3748	$item->{id} += 0.2;#d#
2979	$item->{timeout} = $timeout;	3749	$item->{timeout} = $timeout;
2980	delete $item->{label};	3750	delete $item->{label};
2981	} else {	3751	} else {
2982	$self->{item}{$group} = {	3752	$self->{item}{$group} = {
2983	id => ++$self->{id},	3753	id => ++$self->{id},
…		…
2989	count => 1,	3759	count => 1,
2990	%arg,	3760	%arg,
2991	};	3761	};
2992	}	3762	}
2993		3763
		3764	$ROOT->on_refresh (reorder => sub {
2994	$self->reorder;	3765	$self->reorder;
		3766	});
2995	}	3767	}
2996		3768
2997	sub reconfigure {	3769	sub reconfigure {
2998	my ($self) = @_;	3770	my ($self) = @_;
2999		3771
…		…
3002		3774
3003	$self->reorder;	3775	$self->reorder;
3004	$self->SUPER::reconfigure;	3776	$self->SUPER::reconfigure;
3005	}	3777	}
3006		3778
		3779	sub destroy {
		3780	my ($self) = @_;
		3781
		3782	$self->{timer}->cancel;
		3783
		3784	$self->SUPER::destroy;
		3785	}
		3786
3007	#############################################################################	3787	#############################################################################
3008		3788
3009	package CFClient::UI::Root;	3789	package CFPlus::UI::Root;
3010		3790
3011	our @ISA = CFClient::UI::Container::;	3791	our @ISA = CFPlus::UI::Container::;
3012		3792
		3793	use List::Util qw(min max);
		3794
3013	use CFClient::OpenGL;	3795	use CFPlus::OpenGL;
3014		3796
3015	sub new {	3797	sub new {
3016	my $class = shift;	3798	my $class = shift;
3017		3799
3018	my $self = $class->SUPER::new (	3800	my $self = $class->SUPER::new (
3019	visible => 1,	3801	visible => 1,
3020	@_,	3802	@_,
3021	);	3803	);
3022		3804
3023	Scalar::Util::weaken ($self->{root} = $self);	3805	CFPlus::weaken ($self->{root} = $self);
3024		3806
3025	$self	3807	$self
3026	}	3808	}
3027		3809
3028	sub size_request {	3810	sub size_request {
…		…
3043	$coord = $max - $size if $coord > $max - $size;	3825	$coord = $max - $size if $coord > $max - $size;
3044		3826
3045	int $coord + 0.5	3827	int $coord + 0.5
3046	}	3828	}
3047		3829
3048	sub size_allocate {	3830	sub invoke_size_allocate {
3049	my ($self, $w, $h) = @_;	3831	my ($self, $w, $h) = @_;
3050		3832
3051	for my $child ($self->children) {	3833	for my $child ($self->children) {
3052	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	3834	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3053		3835
…		…
3057	$X = _to_pixel $X, $W, $self->{w};	3839	$X = _to_pixel $X, $W, $self->{w};
3058	$Y = _to_pixel $Y, $H, $self->{h};	3840	$Y = _to_pixel $Y, $H, $self->{h};
3059		3841
3060	$child->configure ($X, $Y, $W, $H);	3842	$child->configure ($X, $Y, $W, $H);
3061	}	3843	}
		3844
		3845	1
3062	}	3846	}
3063		3847
3064	sub coord2local {	3848	sub coord2local {
3065	my ($self, $x, $y) = @_;	3849	my ($self, $x, $y) = @_;
3066		3850
…		…
3122	$_->()	3906	$_->()
3123	for values %{delete $self->{refresh_hook}};	3907	for values %{delete $self->{refresh_hook}};
3124	}	3908	}
3125		3909
3126	if ($self->{realloc}) {	3910	if ($self->{realloc}) {
		3911	my %queue;
3127	my @queue;	3912	my @queue;
		3913	my $widget;
3128		3914
		3915	outer:
3129	while () {	3916	while () {
3130	if ($self->{realloc}) {	3917	if (my $realloc = delete $self->{realloc}) {
3131	#TODO use array-of-depth approach	3918	for $widget (values %$realloc) {
		3919	$widget->{visible} or next; # do not resize invisible widgets
3132		3920
3133	use sort 'stable';	3921	$queue{$widget+0}++ and next; # duplicates are common
3134		3922
3135	@queue = sort { $a->{visible} <=> $b->{visible} }	3923	push @{ $queue[$widget->{visible}] }, $widget;
3136	@queue, values %{delete $self->{realloc}};	3924	}
3137	}	3925	}
3138		3926
		3927	while () {
		3928	@queue or last outer;
		3929
3139	my $widget = pop @queue || last;	3930	$widget = pop @{ $queue[-1] || [] }
		3931	and last;
		3932
		3933	pop @queue;
		3934	}
3140		3935
3141	$widget->{visible} or last; # do not resize invisible widgets	3936	delete $queue{$widget+0};
3142		3937
3143	my ($w, $h) = $widget->size_request;	3938	my ($w, $h) = $widget->size_request;
3144		3939
3145	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;	3940	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3146	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;	3941	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		3942
		3943	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3944	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3147		3945
3148	$w = $widget->{force_w} if exists $widget->{force_w};	3946	$w = $widget->{force_w} if exists $widget->{force_w};
3149	$h = $widget->{force_h} if exists $widget->{force_h};	3947	$h = $widget->{force_h} if exists $widget->{force_h};
3150		3948
3151	if ($widget->{req_w} != $w || $widget->{req_h} != $h	3949	if ($widget->{req_w} != $w || $widget->{req_h} != $h
…		…
3154	$widget->{req_h} = $h;	3952	$widget->{req_h} = $h;
3155		3953
3156	$self->{size_alloc}{$widget+0} = $widget;	3954	$self->{size_alloc}{$widget+0} = $widget;
3157		3955
3158	if (my $parent = $widget->{parent}) {	3956	if (my $parent = $widget->{parent}) {
3159	$self->{realloc}{$parent+0} = $parent;	3957	$self->{realloc}{$parent+0} = $parent
3160	#unshift @queue, $parent;	3958	unless $queue{$parent+0};
		3959
3161	$parent->{force_size_alloc} = 1;	3960	$parent->{force_size_alloc} = 1;
3162	$self->{size_alloc}{$parent+0} = $parent;	3961	$self->{size_alloc}{$parent+0} = $parent;
3163	}	3962	}
3164	}	3963	}
3165		3964
…		…
3177	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3976	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3178		3977
3179	$w = 0 if $w < 0;	3978	$w = 0 if $w < 0;
3180	$h = 0 if $h < 0;	3979	$h = 0 if $h < 0;
3181		3980
		3981	$w = max $widget->{min_w}, $w;
		3982	$h = max $widget->{min_h}, $h;
		3983
		3984	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		3985	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		3986
		3987	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3988	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3989
3182	$w = int $w + 0.5;	3990	$w = int $w + 0.5;
3183	$h = int $h + 0.5;	3991	$h = int $h + 0.5;
3184		3992
3185	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3993	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
		3994	$widget->{old_w} = $widget->{w};
		3995	$widget->{old_h} = $widget->{h};
		3996
3186	$widget->{w} = $w;	3997	$widget->{w} = $w;
3187	$widget->{h} = $h;	3998	$widget->{h} = $h;
3188		3999
3189	$widget->emit (size_allocate => $w, $h);	4000	$widget->emit (size_allocate => $w, $h);
3190	}	4001	}
…		…
3205	glLoadIdentity;	4016	glLoadIdentity;
3206	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4017	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3207	glMatrixMode GL_MODELVIEW;	4018	glMatrixMode GL_MODELVIEW;
3208	glLoadIdentity;	4019	glLoadIdentity;
3209		4020
		4021	{
		4022	package CFPlus::UI::Base;
		4023
		4024	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		4025	(0, 0, $self->{w}, $self->{h});
		4026
3210	$self->_draw;	4027	$self->_draw;
		4028	}
3211	}	4029	}
3212		4030
3213	#############################################################################	4031	#############################################################################
3214		4032
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;	4033	package CFPlus::UI;
3466		4034
3467	$ROOT = new CFClient::UI::Root;	4035	$ROOT = new CFPlus::UI::Root;
3468	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4036	$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
3469		4037
3470	1	4038	1
3471		4039

Diff Legend

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