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.265 by root, Thu Jun 1 02:59:46 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}
1528	;#d#	1844	unless $w >= $self->{req_w} && $self->{old_w} >= $self->{req_w};
		1845
		1846	1
1529	}	1847	}
1530		1848
1531	sub set_fontsize {	1849	sub set_fontsize {
1532	my ($self, $fontsize) = @_;	1850	my ($self, $fontsize) = @_;
1533		1851
1534	$self->{fontsize} = $fontsize;	1852	$self->{fontsize} = $fontsize;
		1853	delete $self->{size_req};
1535	delete $self->{texture};	1854	delete $self->{texture};
1536		1855
1537	$self->realloc;	1856	$self->realloc;
1538	}	1857	}
1539		1858
		1859	sub reconfigure {
		1860	my ($self) = @_;
		1861
		1862	delete $self->{size_req};
		1863	delete $self->{texture};
		1864
		1865	$self->SUPER::reconfigure;
		1866	}
		1867
1540	sub _draw {	1868	sub _draw {
1541	my ($self) = @_;	1869	my ($self) = @_;
1542		1870
1543	$self->SUPER::_draw; # draw background, if applicable	1871	$self->SUPER::_draw; # draw background, if applicable
1544		1872
1545	my $tex = $self->{texture} ||= do {	1873	my $size = $self->{texture} ||= do {
1546	$self->{layout}->set_foreground (@{$self->{fg}});	1874	$self->{layout}->set_foreground (@{$self->{fg}});
1547	$self->{layout}->set_font ($self->{font}) if $self->{font};	1875	$self->{layout}->set_font ($self->{font}) if $self->{font};
1548	$self->{layout}->set_width ($self->{w});	1876	$self->{layout}->set_width ($self->{w});
1549	$self->{layout}->set_ellipsise ($self->{ellipsise});	1877	$self->{layout}->set_ellipsise ($self->{ellipsise});
1550	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1878	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1551	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1879	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1552		1880
1553	my $tex = new_from_layout CFClient::Texture $self->{layout};	1881	[$self->{layout}->size]
		1882	};
1554		1883
		1884	unless (exists $self->{ox}) {
1555	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1885	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1556	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1886	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1557	: ($self->{w} - $tex->{w}) * 0.5);	1887	: ($self->{w} - $size->[0]) * 0.5);
1558		1888
1559	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1889	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1560	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1890	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1561	: ($self->{h} - $tex->{h}) * 0.5);	1891	: ($self->{h} - $size->[1]) * 0.5);
1562
1563	$tex
1564	};	1892	};
1565		1893
1566	glEnable GL_TEXTURE_2D;	1894	my $w = List::Util::min $self->{w} + 4, $size->[0];
1567	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	1895	my $h = List::Util::min $self->{h} + 2, $size->[1];
1568		1896
1569	if ($tex->{format} == GL_ALPHA) {	1897	$self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1570	glColor @{$self->{fg}};
1571	$tex->draw_quad_alpha ($self->{ox}, $self->{oy});
1572	} else {
1573	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy});
1574	}
1575
1576	glDisable GL_TEXTURE_2D;
1577	}	1898	}
1578		1899
1579	#############################################################################	1900	#############################################################################
1580		1901
1581	package CFClient::UI::EntryBase;	1902	package CFPlus::UI::EntryBase;
1582		1903
1583	our @ISA = CFClient::UI::Label::;	1904	our @ISA = CFPlus::UI::Label::;
1584		1905
1585	use CFClient::OpenGL;	1906	use CFPlus::OpenGL;
1586		1907
1587	sub new {	1908	sub new {
1588	my $class = shift;	1909	my $class = shift;
1589		1910
1590	$class->SUPER::new (	1911	$class->SUPER::new (
…		…
1594	active_fg => [0, 0, 0],	1915	active_fg => [0, 0, 0],
1595	can_hover => 1,	1916	can_hover => 1,
1596	can_focus => 1,	1917	can_focus => 1,
1597	valign => 0,	1918	valign => 0,
1598	can_events => 1,	1919	can_events => 1,
		1920	ellipsise => 0,
1599	#text => ...	1921	#text => ...
		1922	#hidden => "*",
1600	@_	1923	@_
1601	)	1924	)
1602	}	1925	}
1603		1926
1604	sub _set_text {	1927	sub _set_text {
…		…
1606		1929
1607	delete $self->{cur_h};	1930	delete $self->{cur_h};
1608		1931
1609	return if $self->{text} eq $text;	1932	return if $self->{text} eq $text;
1610		1933
1611	delete $self->{texture};
1612
1613	$self->{last_activity} = $::NOW;	1934	$self->{last_activity} = $::NOW;
1614	$self->{text} = $text;	1935	$self->{text} = $text;
1615		1936
1616	$text =~ s/./*/g if $self->{hidden};	1937	$text =~ s/./*/g if $self->{hidden};
1617	$self->{layout}->set_text ("$text ");	1938	$self->{layout}->set_text ("$text ");
		1939	delete $self->{size_req};
1618		1940
1619	$self->_emit (changed => $self->{text});	1941	$self->emit (changed => $self->{text});
		1942
		1943	$self->realloc;
		1944	$self->update;
1620	}	1945	}
1621		1946
1622	sub set_text {	1947	sub set_text {
1623	my ($self, $text) = @_;	1948	my ($self, $text) = @_;
1624		1949
1625	$self->{cursor} = length $text;	1950	$self->{cursor} = length $text;
1626	$self->_set_text ($text);	1951	$self->_set_text ($text);
1627
1628	$self->realloc;
1629	}	1952	}
1630		1953
1631	sub get_text {	1954	sub get_text {
1632	$_[0]{text}	1955	$_[0]{text}
1633	}	1956	}
…		…
1638	my ($w, $h) = $self->SUPER::size_request;	1961	my ($w, $h) = $self->SUPER::size_request;
1639		1962
1640	($w + 1, $h) # add 1 for cursor	1963	($w + 1, $h) # add 1 for cursor
1641	}	1964	}
1642		1965
1643	sub key_down {	1966	sub invoke_key_down {
1644	my ($self, $ev) = @_;	1967	my ($self, $ev) = @_;
1645		1968
1646	my $mod = $ev->{mod};	1969	my $mod = $ev->{mod};
1647	my $sym = $ev->{sym};	1970	my $sym = $ev->{sym};
1648	my $uni = $ev->{unicode};	1971	my $uni = $ev->{unicode};
…		…
1651		1974
1652	if ($uni == 8) {	1975	if ($uni == 8) {
1653	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1976	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1654	} elsif ($uni == 127) {	1977	} elsif ($uni == 127) {
1655	substr $text, $self->{cursor}, 1, "";	1978	substr $text, $self->{cursor}, 1, "";
1656	} elsif ($sym == CFClient::SDLK_LEFT) {	1979	} elsif ($sym == CFPlus::SDLK_LEFT) {
1657	--$self->{cursor} if $self->{cursor};	1980	--$self->{cursor} if $self->{cursor};
1658	} elsif ($sym == CFClient::SDLK_RIGHT) {	1981	} elsif ($sym == CFPlus::SDLK_RIGHT) {
1659	++$self->{cursor} if $self->{cursor} < length $self->{text};	1982	++$self->{cursor} if $self->{cursor} < length $self->{text};
1660	} 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 = "";
1661	$self->{cursor} = 0;	1997	$self->{cursor} = 0;
1662	} elsif ($sym == CFClient::SDLK_END) {
1663	$self->{cursor} = length $text;
1664	} elsif ($uni == 27) {	1998	} elsif ($uni == 27) {
1665	$self->_emit ('escape');	1999	$self->emit ('escape');
1666	} elsif ($uni) {	2000	} elsif ($uni == 0x0d) {
		2001	substr $text, $self->{cursor}++, 0, "\012";
		2002	} elsif ($uni >= 0x20) {
1667	substr $text, $self->{cursor}++, 0, chr $uni;	2003	substr $text, $self->{cursor}++, 0, chr $uni;
		2004	} else {
		2005	return 0;
1668	}	2006	}
1669		2007
1670	$self->_set_text ($text);	2008	$self->_set_text ($text);
1671		2009
1672	$self->realloc;	2010	$self->realloc;
1673	}	2011	$self->update;
1674		2012
		2013	1
		2014	}
		2015
1675	sub focus_in {	2016	sub invoke_focus_in {
1676	my ($self) = @_;	2017	my ($self) = @_;
1677		2018
1678	$self->{last_activity} = $::NOW;	2019	$self->{last_activity} = $::NOW;
1679		2020
1680	$self->SUPER::focus_in;	2021	$self->SUPER::invoke_focus_in
1681	}	2022	}
1682		2023
1683	sub button_down {	2024	sub invoke_button_down {
1684	my ($self, $ev, $x, $y) = @_;	2025	my ($self, $ev, $x, $y) = @_;
1685		2026
1686	$self->SUPER::button_down ($ev, $x, $y);	2027	$self->SUPER::invoke_button_down ($ev, $x, $y);
1687		2028
1688	my $idx = $self->{layout}->xy_to_index ($x, $y);	2029	my $idx = $self->{layout}->xy_to_index ($x, $y);
1689		2030
1690	# byte-index to char-index	2031	# byte-index to char-index
1691	my $text = $self->{text};	2032	my $text = $self->{text};
1692	utf8::encode $text;	2033	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1693	$self->{cursor} = length substr $text, 0, $idx;	2034	$self->{cursor} = length $text;
1694		2035
1695	$self->_set_text ($self->{text});	2036	$self->_set_text ($self->{text});
1696	$self->update;	2037	$self->update;
		2038
		2039	1
1697	}	2040	}
1698		2041
1699	sub mouse_motion {	2042	sub invoke_mouse_motion {
1700	my ($self, $ev, $x, $y) = @_;	2043	my ($self, $ev, $x, $y) = @_;
1701	# 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
1702	}	2047	}
1703		2048
1704	sub _draw {	2049	sub _draw {
1705	my ($self) = @_;	2050	my ($self) = @_;
1706		2051
1707	local $self->{fg} = $self->{fg};	2052	local $self->{fg} = $self->{fg};
1708		2053
1709	if ($FOCUS == $self) {	2054	if ($FOCUS == $self) {
1710	glColor @{$self->{active_bg}};	2055	glColor_premultiply @{$self->{active_bg}};
1711	$self->{fg} = $self->{active_fg};	2056	$self->{fg} = $self->{active_fg};
1712	} else {	2057	} else {
1713	glColor @{$self->{bg}};	2058	glColor_premultiply @{$self->{bg}};
1714	}	2059	}
1715		2060
1716	glEnable GL_BLEND;	2061	glEnable GL_BLEND;
1717	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2062	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
1718	glBegin GL_QUADS;	2063	glBegin GL_QUADS;
1719	glVertex 0 , 0;	2064	glVertex 0 , 0;
1720	glVertex 0 , $self->{h};	2065	glVertex 0 , $self->{h};
1721	glVertex $self->{w}, $self->{h};	2066	glVertex $self->{w}, $self->{h};
1722	glVertex $self->{w}, 0;	2067	glVertex $self->{w}, 0;
…		…
1733	utf8::encode $text;	2078	utf8::encode $text;
1734		2079
1735	@$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)
1736	}	2081	}
1737		2082
1738	glColor @{$self->{fg}};
1739	glBegin GL_LINES;	2083	glBegin GL_LINES;
1740	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};
1741	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};
1742	glEnd;	2086	glEnd;
1743	}	2087	}
1744	}	2088	}
1745		2089
		2090	#############################################################################
		2091
1746	package CFClient::UI::Entry;	2092	package CFPlus::UI::Entry;
1747		2093
1748	our @ISA = CFClient::UI::EntryBase::;	2094	our @ISA = CFPlus::UI::EntryBase::;
1749		2095
1750	use CFClient::OpenGL;	2096	use CFPlus::OpenGL;
1751		2097
1752	sub key_down {	2098	sub invoke_key_down {
1753	my ($self, $ev) = @_;	2099	my ($self, $ev) = @_;
1754		2100
1755	my $sym = $ev->{sym};	2101	my $sym = $ev->{sym};
1756		2102
1757	if ($sym == 13) {	2103	if ($ev->{uni} == 0x0d || $sym == 13) {
1758	unshift @{$self->{history}},	2104	unshift @{$self->{history}},
1759	my $txt = $self->get_text;	2105	my $txt = $self->get_text;
		2106
1760	$self->{history_pointer} = -1;	2107	$self->{history_pointer} = -1;
1761	$self->{history_saveback} = '';	2108	$self->{history_saveback} = '';
1762	$self->_emit (activate => $txt);	2109	$self->emit (activate => $txt);
1763	$self->update;	2110	$self->update;
1764		2111
1765	} elsif ($sym == CFClient::SDLK_UP) {	2112	} elsif ($sym == CFPlus::SDLK_UP) {
1766	if ($self->{history_pointer} < 0) {	2113	if ($self->{history_pointer} < 0) {
1767	$self->{history_saveback} = $self->get_text;	2114	$self->{history_saveback} = $self->get_text;
1768	}	2115	}
1769	if (@{$self->{history} || []} > 0) {	2116	if (@{$self->{history} || []} > 0) {
1770	$self->{history_pointer}++;	2117	$self->{history_pointer}++;
…		…
1772	$self->{history_pointer} = @{$self->{history} || []} - 1;	2119	$self->{history_pointer} = @{$self->{history} || []} - 1;
1773	}	2120	}
1774	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2121	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1775	}	2122	}
1776		2123
1777	} elsif ($sym == CFClient::SDLK_DOWN) {	2124	} elsif ($sym == CFPlus::SDLK_DOWN) {
1778	$self->{history_pointer}--;	2125	$self->{history_pointer}--;
1779	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2126	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1780		2127
1781	if ($self->{history_pointer} >= 0) {	2128	if ($self->{history_pointer} >= 0) {
1782	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2129	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1783	} else {	2130	} else {
1784	$self->set_text ($self->{history_saveback});	2131	$self->set_text ($self->{history_saveback});
1785	}	2132	}
1786		2133
1787	} else {	2134	} else {
1788	$self->SUPER::key_down ($ev);	2135	return $self->SUPER::invoke_key_down ($ev)
		2136	}
		2137
1789	}	2138	1
1790
1791	}	2139	}
1792		2140
1793	#############################################################################	2141	#############################################################################
1794		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
1795	package CFClient::UI::Button;	2182	package CFPlus::UI::Button;
1796		2183
1797	our @ISA = CFClient::UI::Label::;	2184	our @ISA = CFPlus::UI::Label::;
1798		2185
1799	use CFClient::OpenGL;	2186	use CFPlus::OpenGL;
1800		2187
1801	my @tex =	2188	my @tex =
1802	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2189	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1803	qw(b1_button_active.png);	2190	qw(b1_button_active.png);
1804		2191
1805	sub new {	2192	sub new {
1806	my $class = shift;	2193	my $class = shift;
1807		2194
…		…
1816	can_events => 1,	2203	can_events => 1,
1817	@_	2204	@_
1818	)	2205	)
1819	}	2206	}
1820		2207
1821	sub activate { }
1822
1823	sub button_up {	2208	sub invoke_button_up {
1824	my ($self, $ev, $x, $y) = @_;	2209	my ($self, $ev, $x, $y) = @_;
1825		2210
1826	$self->emit ("activate")	2211	$self->emit ("activate")
1827	if $x >= 0 && $x < $self->{w}	2212	if $x >= 0 && $x < $self->{w}
1828	&& $y >= 0 && $y < $self->{h};	2213	&& $y >= 0 && $y < $self->{h};
		2214
		2215	1
1829	}	2216	}
1830		2217
1831	sub _draw {	2218	sub _draw {
1832	my ($self) = @_;	2219	my ($self) = @_;
1833		2220
1834	local $self->{fg} = $self->{fg};	2221	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
1835
1836	if ($GRAB == $self) {
1837	$self->{fg} = $self->{active_fg};
1838	}
1839		2222
1840	glEnable GL_TEXTURE_2D;	2223	glEnable GL_TEXTURE_2D;
1841	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2224	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1842	glColor 0, 0, 0, 1;	2225	glColor 0, 0, 0, 1;
1843		2226
…		…
1848	$self->SUPER::_draw;	2231	$self->SUPER::_draw;
1849	}	2232	}
1850		2233
1851	#############################################################################	2234	#############################################################################
1852		2235
1853	package CFClient::UI::CheckBox;	2236	package CFPlus::UI::CheckBox;
1854		2237
1855	our @ISA = CFClient::UI::DrawBG::;	2238	our @ISA = CFPlus::UI::DrawBG::;
1856		2239
1857	my @tex =	2240	my @tex =
1858	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2241	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1859	qw(c1_checkbox_bg.png c1_checkbox_active.png);	2242	qw(c1_checkbox_bg.png c1_checkbox_active.png);
1860		2243
1861	use CFClient::OpenGL;	2244	use CFPlus::OpenGL;
1862		2245
1863	sub new {	2246	sub new {
1864	my $class = shift;	2247	my $class = shift;
1865		2248
1866	$class->SUPER::new (	2249	$class->SUPER::new (
…		…
1880	my ($self) = @_;	2263	my ($self) = @_;
1881		2264
1882	(6) x 2	2265	(6) x 2
1883	}	2266	}
1884		2267
		2268	sub toggle {
		2269	my ($self) = @_;
		2270
		2271	$self->{state} = !$self->{state};
		2272	$self->emit (changed => $self->{state});
		2273	$self->update;
		2274	}
		2275
1885	sub button_down {	2276	sub invoke_button_down {
1886	my ($self, $ev, $x, $y) = @_;	2277	my ($self, $ev, $x, $y) = @_;
1887		2278
1888	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2279	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1889	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2280	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1890	$self->{state} = !$self->{state};	2281	$self->toggle;
1891	$self->_emit (changed => $self->{state});	2282	} else {
		2283	return 0
		2284	}
		2285
1892	}	2286	1
1893	}	2287	}
1894		2288
1895	sub _draw {	2289	sub _draw {
1896	my ($self) = @_;	2290	my ($self) = @_;
1897		2291
…		…
1912	glDisable GL_TEXTURE_2D;	2306	glDisable GL_TEXTURE_2D;
1913	}	2307	}
1914		2308
1915	#############################################################################	2309	#############################################################################
1916		2310
1917	package CFClient::UI::Image;	2311	package CFPlus::UI::Image;
1918		2312
1919	our @ISA = CFClient::UI::Base::;	2313	our @ISA = CFPlus::UI::Base::;
1920		2314
1921	use CFClient::OpenGL;	2315	use CFPlus::OpenGL;
1922	use Carp qw/confess/;
1923		2316
1924	our %loaded_images;	2317	our %texture_cache;
1925		2318
1926	sub new {	2319	sub new {
1927	my $class = shift;	2320	my $class = shift;
1928		2321
1929	my $self = $class->SUPER::new (can_events => 0, @_);	2322	my $self = $class->SUPER::new (
		2323	can_events => 0,
		2324	@_,
		2325	);
1930		2326
1931	$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";
1932		2329
1933	$loaded_images{$self->{image}} ||=	2330	$self->{tex} ||= $texture_cache{$self->{path}} ||=
1934	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;
1935		2332
1936	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2333	CFPlus::weaken $texture_cache{$self->{path}};
1937		2334
1938	Scalar::Util::weaken $loaded_images{$self->{image}};	2335	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
1939
1940	$self->{aspect} = $tex->{w} / $tex->{h};
1941		2336
1942	$self	2337	$self
1943	}	2338	}
1944		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
1945	sub size_request {	2355	sub size_request {
1946	my ($self) = @_;	2356	my ($self) = @_;
1947		2357
1948	($self->{tex}->{w}, $self->{tex}->{h})	2358	($self->{tex}{w}, $self->{tex}{h})
1949	}	2359	}
1950		2360
1951	sub _draw {	2361	sub _draw {
1952	my ($self) = @_;	2362	my ($self) = @_;
1953		2363
…		…
1963	}	2373	}
1964		2374
1965	glEnable GL_TEXTURE_2D;	2375	glEnable GL_TEXTURE_2D;
1966	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2376	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1967		2377
1968	$tex->draw_quad_alpha (0, 0, $w, $h);	2378	$tex->draw_quad (0, 0, $w, $h);
1969		2379
1970	glDisable GL_TEXTURE_2D;	2380	glDisable GL_TEXTURE_2D;
1971	}	2381	}
1972		2382
1973	#############################################################################	2383	#############################################################################
1974		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
1975	package CFClient::UI::VGauge;	2421	package CFPlus::UI::VGauge;
1976		2422
1977	our @ISA = CFClient::UI::Base::;	2423	our @ISA = CFPlus::UI::Base::;
1978		2424
1979	use List::Util qw(min max);	2425	use List::Util qw(min max);
1980		2426
1981	use CFClient::OpenGL;	2427	use CFPlus::OpenGL;
1982		2428
1983	my %tex = (	2429	my %tex = (
1984	food => [	2430	food => [
1985	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2431	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1986	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2432	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
1987	],	2433	],
1988	grace => [	2434	grace => [
1989	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2435	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1990	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/
1991	],	2437	],
1992	hp => [	2438	hp => [
1993	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2439	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1994	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2440	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
1995	],	2441	],
1996	mana => [	2442	mana => [
1997	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2443	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1998	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/
1999	],	2445	],
2000	);	2446	);
2001		2447
2002	# eg. VGauge->new (gauge => 'food'), default gauge: food	2448	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2062	my $ycut1 = max 0, min 1, $ycut;	2508	my $ycut1 = max 0, min 1, $ycut;
2063	my $ycut2 = max 0, min 1, $ycut - 1;	2509	my $ycut2 = max 0, min 1, $ycut - 1;
2064		2510
2065	my $h1 = $self->{h} * (1 - $ycut1);	2511	my $h1 = $self->{h} * (1 - $ycut1);
2066	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);
2067		2516
2068	glEnable GL_BLEND;	2517	glEnable GL_BLEND;
2069	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;
2070	glEnable GL_TEXTURE_2D;	2520	glEnable GL_TEXTURE_2D;
2071	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2521	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2072		2522
2073	glBindTexture GL_TEXTURE_2D, $t1->{name};	2523	glBindTexture GL_TEXTURE_2D, $t1->{name};
2074	glBegin GL_QUADS;	2524	glBegin GL_QUADS;
…		…
2089		2539
2090	if ($t3) {	2540	if ($t3) {
2091	glBindTexture GL_TEXTURE_2D, $t3->{name};	2541	glBindTexture GL_TEXTURE_2D, $t3->{name};
2092	glBegin GL_QUADS;	2542	glBegin GL_QUADS;
2093	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2543	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2094	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2544	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2095	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2545	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2096	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2546	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2097	glEnd;	2547	glEnd;
2098	}	2548	}
2099		2549
2100	glDisable GL_BLEND;	2550	glDisable GL_BLEND;
2101	glDisable GL_TEXTURE_2D;	2551	glDisable GL_TEXTURE_2D;
2102	}	2552	}
2103		2553
2104	#############################################################################	2554	#############################################################################
2105		2555
2106	package CFClient::UI::Gauge;	2556	package CFPlus::UI::Gauge;
2107		2557
2108	our @ISA = CFClient::UI::VBox::;	2558	our @ISA = CFPlus::UI::VBox::;
2109		2559
2110	sub new {	2560	sub new {
2111	my ($class, %arg) = @_;	2561	my ($class, %arg) = @_;
2112		2562
2113	my $self = $class->SUPER::new (	2563	my $self = $class->SUPER::new (
…		…
2115	can_hover => 1,	2565	can_hover => 1,
2116	can_events => 1,	2566	can_events => 1,
2117	%arg,	2567	%arg,
2118	);	2568	);
2119		2569
2120	$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");
2121	$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);
2122	$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");
2123		2573
2124	$self	2574	$self
2125	}	2575	}
2126		2576
2127	sub set_fontsize {	2577	sub set_fontsize {
…		…
2148	$self->{value}->set_text ($val);	2598	$self->{value}->set_text ($val);
2149	}	2599	}
2150		2600
2151	#############################################################################	2601	#############################################################################
2152		2602
2153	package CFClient::UI::Slider;	2603	package CFPlus::UI::Slider;
2154		2604
2155	use strict;	2605	use strict;
2156		2606
2157	use CFClient::OpenGL;	2607	use CFPlus::OpenGL;
2158		2608
2159	our @ISA = CFClient::UI::DrawBG::;	2609	our @ISA = CFPlus::UI::DrawBG::;
2160		2610
2161	my @tex =	2611	my @tex =
2162	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2612	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2163	qw(s1_slider.png s1_slider_bg.png);	2613	qw(s1_slider.png s1_slider_bg.png);
2164		2614
2165	sub new {	2615	sub new {
2166	my $class = shift;	2616	my $class = shift;
2167		2617
…		…
2188	$self->update;	2638	$self->update;
2189		2639
2190	$self	2640	$self
2191	}	2641	}
2192		2642
2193	sub changed { }
2194
2195	sub set_range {	2643	sub set_range {
2196	my ($self, $range) = @_;	2644	my ($self, $range) = @_;
2197		2645
2198	($range, $self->{range}) = ($self->{range}, $range);	2646	($range, $self->{range}) = ($self->{range}, $range);
2199		2647
2200	$self->update
2201	if "@$range" ne "@{$self->{range}}";	2648	if ("@$range" ne "@{$self->{range}}") {
		2649	$self->update;
		2650	$self->set_value ($self->{range}[0]);
		2651	}
2202	}	2652	}
2203		2653
2204	sub set_value {	2654	sub set_value {
2205	my ($self, $value) = @_;	2655	my ($self, $value) = @_;
2206		2656
…		…
2217	if $unit;	2667	if $unit;
2218		2668
2219	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	2669	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2220		2670
2221	if ($value != $old_value) {	2671	if ($value != $old_value) {
2222	$self->_emit (changed => $value);	2672	$self->emit (changed => $value);
2223	$self->update;	2673	$self->update;
2224	}	2674	}
2225	}	2675	}
2226		2676
2227	sub size_request {	2677	sub size_request {
2228	my ($self) = @_;	2678	my ($self) = @_;
2229		2679
2230	($self->{req_w}, $self->{req_h})	2680	($self->{req_w}, $self->{req_h})
2231	}	2681	}
2232		2682
2233	sub button_down {	2683	sub invoke_button_down {
2234	my ($self, $ev, $x, $y) = @_;	2684	my ($self, $ev, $x, $y) = @_;
2235		2685
2236	$self->SUPER::button_down ($ev, $x, $y);	2686	$self->SUPER::invoke_button_down ($ev, $x, $y);
2237		2687
2238	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	2688	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2239		2689
2240	$self->mouse_motion ($ev, $x, $y);	2690	$self->invoke_mouse_motion ($ev, $x, $y)
2241	}	2691	}
2242		2692
2243	sub mouse_motion {	2693	sub invoke_mouse_motion {
2244	my ($self, $ev, $x, $y) = @_;	2694	my ($self, $ev, $x, $y) = @_;
2245		2695
2246	if ($GRAB == $self) {	2696	if ($GRAB == $self) {
2247	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	2697	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2248		2698
2249	my (undef, $lo, $hi, $page) = @{$self->{range}};	2699	my (undef, $lo, $hi, $page) = @{$self->{range}};
2250		2700
2251	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	2701	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2252		2702
2253	$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
2254	}	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
2255	}	2721	}
2256		2722
2257	sub update {	2723	sub update {
2258	my ($self) = @_;	2724	my ($self) = @_;
2259		2725
2260	$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}) {
2261	$self->set_value ($self->{range}[0]);	2734	$self->set_value ($self->{range}[0]);
2262		2735
2263	my ($value, $lo, $hi, $page) = @{$self->{range}};	2736	my ($value, $lo, $hi, $page) = @{$self->{range}};
2264	my $range = ($hi - $page - $lo) || 1e-100;	2737	my $range = ($hi - $page - $lo) || 1e-100;
2265		2738
…		…
2271	$value = ($value - $lo) / $range;	2744	$value = ($value - $lo) / $range;
2272	$value = $value * $self->{scale} + $self->{offset};	2745	$value = $value * $self->{scale} + $self->{offset};
2273		2746
2274	$self->{knob_x} = $value - $knob_w * 0.5;	2747	$self->{knob_x} = $value - $knob_w * 0.5;
2275	$self->{knob_w} = $knob_w;	2748	$self->{knob_w} = $knob_w;
2276	});	2749	}
2277
2278	$self->SUPER::update;
2279	}
2280
2281	sub _draw {
2282	my ($self) = @_;
2283		2750
2284	$self->SUPER::_draw ();	2751	$self->SUPER::_draw ();
2285		2752
2286	glScale $self->{w}, $self->{h};	2753	glScale $self->{w}, $self->{h};
2287		2754
…		…
2307	glDisable GL_TEXTURE_2D;	2774	glDisable GL_TEXTURE_2D;
2308	}	2775	}
2309		2776
2310	#############################################################################	2777	#############################################################################
2311		2778
2312	package CFClient::UI::ValSlider;	2779	package CFPlus::UI::ValSlider;
2313		2780
2314	our @ISA = CFClient::UI::HBox::;	2781	our @ISA = CFPlus::UI::HBox::;
2315		2782
2316	sub new {	2783	sub new {
2317	my ($class, %arg) = @_;	2784	my ($class, %arg) = @_;
2318		2785
2319	my $range = delete $arg{range};	2786	my $range = delete $arg{range};
2320		2787
2321	my $self = $class->SUPER::new (	2788	my $self = $class->SUPER::new (
2322	slider => (new CFClient::UI::Slider expand => 1, range => $range),	2789	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2323	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	2790	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2324	to_value => sub { shift },	2791	to_value => sub { shift },
2325	from_value => sub { shift },	2792	from_value => sub { shift },
2326	%arg,	2793	%arg,
2327	);	2794	);
2328		2795
…		…
2348	sub set_range { shift->{slider}->set_range (@_) }	2815	sub set_range { shift->{slider}->set_range (@_) }
2349	sub set_value { shift->{slider}->set_value (@_) }	2816	sub set_value { shift->{slider}->set_value (@_) }
2350		2817
2351	#############################################################################	2818	#############################################################################
2352		2819
2353	package CFClient::UI::TextView;	2820	package CFPlus::UI::TextScroller;
2354		2821
2355	our @ISA = CFClient::UI::HBox::;	2822	our @ISA = CFPlus::UI::HBox::;
2356		2823
2357	use CFClient::OpenGL;	2824	use CFPlus::OpenGL;
2358		2825
2359	sub new {	2826	sub new {
2360	my $class = shift;	2827	my $class = shift;
2361		2828
2362	my $self = $class->SUPER::new (	2829	my $self = $class->SUPER::new (
2363	fontsize => 1,	2830	fontsize => 1,
2364	can_events => 0,	2831	can_events => 1,
		2832	indent => 0,
2365	#font => default_font	2833	#font => default_font
2366	@_,	2834	@_,
2367		2835
2368	layout => (new CFClient::Layout 1),	2836	layout => (new CFPlus::Layout),
2369	par => [],	2837	par => [],
		2838	max_par => 0,
2370	height => 0,	2839	height => 0,
2371	children => [	2840	children => [
2372	(new CFClient::UI::Empty expand => 1),	2841	(new CFPlus::UI::Empty expand => 1),
2373	(new CFClient::UI::Slider vertical => 1),	2842	(new CFPlus::UI::Slider vertical => 1),
2374	],	2843	],
2375	);	2844	);
2376		2845
2377	$self->{children}[1]->connect (changed => sub { $self->update });	2846	$self->{children}[1]->connect (changed => sub { $self->update });
2378		2847
…		…
2384		2853
2385	$self->{fontsize} = $fontsize;	2854	$self->{fontsize} = $fontsize;
2386	$self->reflow;	2855	$self->reflow;
2387	}	2856	}
2388		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
2389	sub size_allocate {	2867	sub invoke_size_allocate {
2390	my ($self, $w, $h) = @_;	2868	my ($self, $w, $h) = @_;
2391		2869
2392	$self->SUPER::size_allocate ($w, $h);	2870	my ($empty, $slider, @other) = @{ $self->{children} };
		2871	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2393		2872
2394	$self->{layout}->set_font ($self->{font}) if $self->{font};	2873	$self->{layout}->set_font ($self->{font}) if $self->{font};
2395	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2874	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2396	$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});
2397		2877
2398	$self->reflow;	2878	$self->reflow;
2399	}
2400		2879
2401	sub text_size {	2880	local $self->{children} = [$empty, $slider];
		2881	$self->SUPER::invoke_size_allocate ($w, $h)
		2882	}
		2883
		2884	sub invoke_mouse_wheel {
2402	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) = @_;
2403		2896
2404	my $layout = $self->{layout};	2897	my $layout = $self->{layout};
2405		2898
		2899	$layout->set_font ($self->{font}) if $self->{font};
		2900	$layout->set_foreground (@{$para->{fg}});
2406	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2901	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2407	$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});
2408	$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}}
2409		2910	);
		2911
2410	$layout->size	2912	$layout
2411	}	2913	}
2412		2914
2413	sub reflow {	2915	sub reflow {
2414	my ($self) = @_;	2916	my ($self) = @_;
2415		2917
…		…
2422		2924
2423	# todo: base offset on lines or so, not on pixels	2925	# todo: base offset on lines or so, not on pixels
2424	$self->{children}[1]->set_value ($offset);	2926	$self->{children}[1]->set_value ($offset);
2425	}	2927	}
2426		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
2427	sub clear {	2944	sub clear {
2428	my ($self) = @_;	2945	my ($self) = @_;
		2946
		2947	my (undef, undef, @other) = @{ $self->{children} };
		2948	$self->remove ($_) for @other;
2429		2949
2430	$self->{par} = [];	2950	$self->{par} = [];
2431	$self->{height} = 0;	2951	$self->{height} = 0;
2432	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2952	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2433	}	2953	}
2434		2954
2435	sub add_paragraph {	2955	sub add_paragraph {
2436	my ($self, $color, $text, $indent) = @_;	2956	my $self = shift;
2437		2957
2438	for my $line (split /\n/, $text) {	2958	for my $para (@_) {
2439	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
2440	$self->{height} += $h;	3010	$self->{height} = $height;
2441	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3011	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2442	}
2443		3012
2444	$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	}
2445	}	3019	}
2446		3020
2447	sub update {	3021	sub update {
2448	my ($self) = @_;	3022	my ($self) = @_;
2449		3023
…		…
2451		3025
2452	return unless $self->{h} > 0;	3026	return unless $self->{h} > 0;
2453		3027
2454	delete $self->{texture};	3028	delete $self->{texture};
2455		3029
2456	$ROOT->on_post_alloc ($self, sub {	3030	$ROOT->on_post_alloc ($self => sub {
		3031	$self->force_uptodate;
		3032
2457	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3033	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2458		3034
2459	if (delete $self->{need_reflow}) {
2460	my $height = 0;
2461
2462	my $layout = $self->{layout};
2463
2464	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2465
2466	for (@{$self->{par}}) {
2467	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2468	$layout->set_width ($W - $_->[3]);
2469	$layout->set_markup ($_->[4]);
2470	my ($w, $h) = $layout->size;
2471	$_->[0] = $w + $_->[3];
2472	$_->[1] = $h;
2473	}
2474
2475	$height += $_->[1];
2476	}
2477
2478	$self->{height} = $height;
2479
2480	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2481
2482	delete $self->{texture};
2483	}
2484
2485	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	3035	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2486	glClearColor 0.5, 0.5, 0.5, 0;	3036	glClearColor 0, 0, 0, 0;
2487	glClear GL_COLOR_BUFFER_BIT;	3037	glClear GL_COLOR_BUFFER_BIT;
2488		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;
2489	my $top = int $self->{children}[1]{range}[0];	3047	my $top = int $self->{children}[1]{range}[0];
2490		3048
2491	my $y0 = $top;	3049	my $y0 = $top;
2492	my $y1 = $top + $H;	3050	my $y1 = $top + $H;
2493		3051
2494	my $y = 0;
2495
2496	my $layout = $self->{layout};
2497
2498	$layout->set_font ($self->{font}) if $self->{font};
2499
2500	glEnable GL_BLEND;
2501	#TODO# not correct in windows where rgba is forced off
2502	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2503
2504	for my $par (@{$self->{par}}) {	3052	for my $para (@{$self->{par}}) {
2505	my $h = $par->[1];	3053	my $h = $para->{h};
		3054	my $y = $para->{y};
2506		3055
2507	if ($y0 < $y + $h && $y < $y1) {	3056	if ($y0 < $y + $h && $y < $y1) {
2508	$layout->set_foreground (@{ $par->[2] });	3057	my $layout = $self->get_layout ($para);
2509	$layout->set_width ($W - $par->[3]);
2510	$layout->set_markup ($par->[4]);
2511		3058
2512	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3059	$layout->render ($para->{indent}, $y - $y0);
2513		3060
2514	glRasterPos $par->[3], $y - $y0;	3061	if (my @w = @{ $para->{widget} }) {
2515	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	}
2516	}	3073	}
2517		3074
2518	$y += $h;	3075	$paridx++;
		3076	$top_paragraph ||= $paridx if $y >= $top;
2519	}	3077	}
2520		3078
2521	glDisable GL_BLEND;	3079	$self->{top_paragraph} = $top_paragraph;
2522	};	3080	};
2523	});	3081	});
2524	}	3082	}
2525		3083
		3084	sub reconfigure {
		3085	my ($self) = @_;
		3086
		3087	$self->SUPER::reconfigure;
		3088
		3089	$_->{w} = 1e10 for @{ $self->{par} };
		3090	$self->reflow;
		3091	}
		3092
2526	sub _draw {	3093	sub _draw {
2527	my ($self) = @_;	3094	my ($self) = @_;
2528		3095
2529	glEnable GL_TEXTURE_2D;	3096	glEnable GL_TEXTURE_2D;
2530	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3097	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2531	glColor 1, 1, 1, 1;	3098	glColor 0, 0, 0, 1;
2532	$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});
2533	glDisable GL_TEXTURE_2D;	3100	glDisable GL_TEXTURE_2D;
2534		3101
2535	$self->{children}[1]->draw;	3102	$self->{children}[1]->draw;
2536
2537	}	3103	}
2538		3104
2539	#############################################################################	3105	#############################################################################
2540		3106
2541	package CFClient::UI::Animator;	3107	package CFPlus::UI::Animator;
2542		3108
2543	use CFClient::OpenGL;	3109	use CFPlus::OpenGL;
2544		3110
2545	our @ISA = CFClient::UI::Bin::;	3111	our @ISA = CFPlus::UI::Bin::;
2546		3112
2547	sub moveto {	3113	sub moveto {
2548	my ($self, $x, $y) = @_;	3114	my ($self, $x, $y) = @_;
2549		3115
2550	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3116	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2578	glPopMatrix;	3144	glPopMatrix;
2579	}	3145	}
2580		3146
2581	#############################################################################	3147	#############################################################################
2582		3148
2583	package CFClient::UI::Flopper;	3149	package CFPlus::UI::Flopper;
2584		3150
2585	our @ISA = CFClient::UI::Button::;	3151	our @ISA = CFPlus::UI::Button::;
2586		3152
2587	sub new {	3153	sub new {
2588	my $class = shift;	3154	my $class = shift;
2589		3155
2590	my $self = $class->SUPER::new (	3156	my $self = $class->SUPER::new (
…		…
2602	$self->{other}->toggle_visibility;	3168	$self->{other}->toggle_visibility;
2603	}	3169	}
2604		3170
2605	#############################################################################	3171	#############################################################################
2606		3172
2607	package CFClient::UI::Tooltip;	3173	package CFPlus::UI::Tooltip;
2608		3174
2609	our @ISA = CFClient::UI::Bin::;	3175	our @ISA = CFPlus::UI::Bin::;
2610		3176
2611	use CFClient::OpenGL;	3177	use CFPlus::OpenGL;
2612		3178
2613	sub new {	3179	sub new {
2614	my $class = shift;	3180	my $class = shift;
2615		3181
2616	$class->SUPER::new (	3182	$class->SUPER::new (
…		…
2619	)	3185	)
2620	}	3186	}
2621		3187
2622	sub set_tooltip_from {	3188	sub set_tooltip_from {
2623	my ($self, $widget) = @_;	3189	my ($self, $widget) = @_;
		3190
		3191	$widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
		3192	if $widget->{tooltip} =~ /^#(.*)$/;
2624		3193
2625	my $tooltip = $widget->{tooltip};	3194	my $tooltip = $widget->{tooltip};
2626		3195
2627	if ($ENV{CFPLUS_DEBUG} & 2) {	3196	if ($ENV{CFPLUS_DEBUG} & 2) {
2628	$tooltip .= "\n\n" . (ref $widget) . "\n"	3197	$tooltip .= "\n\n" . (ref $widget) . "\n"
2629	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3198	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2630	. "req $widget->{req_w} $widget->{req_h}\n"	3199	. "req $widget->{req_w} $widget->{req_h}\n"
2631	. "visible $widget->{visible}";	3200	. "visible $widget->{visible}";
2632	}	3201	}
2633		3202
		3203	$tooltip =~ s/^\n+//;
		3204	$tooltip =~ s/\n+$//;
		3205
2634	$self->add (new CFClient::UI::Label	3206	$self->add (new CFPlus::UI::Label
2635	markup => $tooltip,	3207	markup => $tooltip,
2636	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3208	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2637	fontsize => 0.8,	3209	fontsize => 0.8,
2638	fg => [0, 0, 0, 1],	3210	style => 1, # FLAG_INVERSE
2639	ellipsise => 0,	3211	ellipsise => 0,
2640	font => ($widget->{tooltip_font} || $::FONT_PROP),	3212	font => ($widget->{tooltip_font} || $::FONT_PROP),
2641	);	3213	);
2642	}	3214	}
2643		3215
…		…
2647	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3219	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2648		3220
2649	($w + 4, $h + 4)	3221	($w + 4, $h + 4)
2650	}	3222	}
2651		3223
2652	sub size_allocate {	3224	sub invoke_size_allocate {
2653	my ($self, $w, $h) = @_;	3225	my ($self, $w, $h) = @_;
2654		3226
2655	$self->SUPER::size_allocate ($w - 4, $h - 4);	3227	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2656	}	3228	}
2657		3229
2658	sub visibility_change {	3230	sub invoke_visibility_change {
2659	my ($self, $visible) = @_;	3231	my ($self, $visible) = @_;
2660		3232
2661	return unless $visible;	3233	return unless $visible;
2662		3234
2663	$self->{root}->on_post_alloc ("move_$self" => sub {	3235	$self->{root}->on_post_alloc ("move_$self" => sub {
2664	my $widget = $self->{owner}	3236	my $widget = $self->{owner}
2665	or return;	3237	or return;
2666		3238
		3239	if ($widget->{visible}) {
2667	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3240	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2668		3241
2669	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3242	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2670	if $x + $self->{w} > $::WIDTH;	3243	if $x + $self->{w} > $self->{root}{w};
2671		3244
2672	$self->move_abs ($x, $y);	3245	$self->move_abs ($x, $y);
		3246	} else {
		3247	$self->hide;
		3248	}
2673	});	3249	});
2674	}	3250	}
2675		3251
2676	sub _draw {	3252	sub _draw {
2677	my ($self) = @_;	3253	my ($self) = @_;
…		…
2701	$self->SUPER::_draw;	3277	$self->SUPER::_draw;
2702	}	3278	}
2703		3279
2704	#############################################################################	3280	#############################################################################
2705		3281
2706	package CFClient::UI::Face;	3282	package CFPlus::UI::Face;
2707		3283
2708	our @ISA = CFClient::UI::Base::;	3284	our @ISA = CFPlus::UI::DrawBG::;
2709		3285
2710	use CFClient::OpenGL;	3286	use CFPlus::OpenGL;
2711		3287
2712	sub new {	3288	sub new {
2713	my $class = shift;	3289	my $class = shift;
2714		3290
2715	my $self = $class->SUPER::new (	3291	my $self = $class->SUPER::new (
…		…
2717	can_events => 0,	3293	can_events => 0,
2718	@_,	3294	@_,
2719	);	3295	);
2720		3296
2721	if ($self->{anim} && $self->{animspeed}) {	3297	if ($self->{anim} && $self->{animspeed}) {
2722	Scalar::Util::weaken (my $widget = $self);	3298	CFPlus::weaken (my $widget = $self);
2723		3299
2724	$self->{timer} = Event->timer (	3300	$self->{timer} = Event->timer (
2725	at => $self->{animspeed} * int $::NOW / $self->{animspeed},	3301	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2726	hard => 1,	3302	hard => 1,
2727	interval => $self->{animspeed},	3303	interval => $self->{animspeed},
…		…
2750	sub _draw {	3326	sub _draw {
2751	my ($self) = @_;	3327	my ($self) = @_;
2752		3328
2753	return unless $::CONN;	3329	return unless $::CONN;
2754		3330
		3331	$self->SUPER::_draw;
		3332
2755	my $face;	3333	my $face;
2756		3334
2757	if ($self->{frame}) {	3335	if ($self->{frame}) {
2758	my $anim = $::CONN->{anim}[$self->{anim}];	3336	my $anim = $::CONN->{anim}[$self->{anim}];
2759		3337
…		…
2764	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	3342	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];
2765		3343
2766	if ($tex) {	3344	if ($tex) {
2767	glEnable GL_TEXTURE_2D;	3345	glEnable GL_TEXTURE_2D;
2768	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3346	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2769	glColor 1, 1, 1, 1;	3347	glColor 0, 0, 0, 1;
2770	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3348	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2771	glDisable GL_TEXTURE_2D;	3349	glDisable GL_TEXTURE_2D;
2772	}	3350	}
2773	}	3351	}
2774		3352
2775	sub DESTROY {	3353	sub destroy {
2776	my ($self) = @_;	3354	my ($self) = @_;
2777		3355
2778	$self->{timer}->cancel	3356	$self->{timer}->cancel
2779	if $self->{timer};	3357	if $self->{timer};
2780		3358
2781	$self->SUPER::DESTROY;	3359	$self->SUPER::destroy;
2782	}	3360	}
2783		3361
2784	#############################################################################	3362	#############################################################################
2785		3363
		3364	package CFPlus::UI::Buttonbar;
		3365
		3366	our @ISA = CFPlus::UI::HBox::;
		3367
		3368	# TODO: should actually wrap buttons and other goodies.
		3369
		3370	#############################################################################
		3371
2786	package CFClient::UI::Menu;	3372	package CFPlus::UI::Menu;
2787		3373
2788	our @ISA = CFClient::UI::FancyFrame::;	3374	our @ISA = CFPlus::UI::Toplevel::;
2789		3375
2790	use CFClient::OpenGL;	3376	use CFPlus::OpenGL;
2791		3377
2792	sub new {	3378	sub new {
2793	my $class = shift;	3379	my $class = shift;
2794		3380
2795	my $self = $class->SUPER::new (	3381	my $self = $class->SUPER::new (
2796	items => [],	3382	items => [],
2797	z => 100,	3383	z => 100,
2798	@_,	3384	@_,
2799	);	3385	);
2800		3386
2801	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3387	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2802		3388
2803	for my $item (@{ $self->{items} }) {	3389	for my $item (@{ $self->{items} }) {
2804	my ($widget, $cb) = @$item;	3390	my ($widget, $cb, $tooltip) = @$item;
2805		3391
2806	# handle various types of items, only text for now	3392	# handle various types of items, only text for now
2807	if (!ref $widget) {	3393	if (!ref $widget) {
		3394	if ($widget =~ /\t/) {
		3395	my ($left, $right) = split /\t/, $widget, 2;
		3396
2808	$widget = new CFClient::UI::Label	3397	$widget = new CFPlus::UI::HBox
2809	can_hover => 1,	3398	can_hover => 1,
2810	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,
2811	text => $widget;	3411	markup => $widget,
		3412	tooltip => $tooltip;
		3413	}
2812	}	3414	}
2813		3415
2814	$self->{item}{$widget} = $item;	3416	$self->{item}{$widget} = $item;
2815		3417
2816	$self->{vbox}->add ($widget);	3418	$self->{vbox}->add ($widget);
…		…
2821		3423
2822	# 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)
2823	sub popup {	3425	sub popup {
2824	my ($self, $ev) = @_;	3426	my ($self, $ev) = @_;
2825		3427
2826	$self->_emit ("popdown");	3428	$self->emit ("popdown");
2827		3429
2828	# maybe save $GRAB? must be careful about events...	3430	# maybe save $GRAB? must be careful about events...
2829	$GRAB = $self;	3431	$GRAB = $self;
2830	$self->{button} = $ev->{button};	3432	$self->{button} = $ev->{button};
2831		3433
2832	$self->show;	3434	$self->show;
2833	$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);
2834	}	3436	}
2835		3437
2836	sub mouse_motion {	3438	sub invoke_mouse_motion {
2837	my ($self, $ev, $x, $y) = @_;	3439	my ($self, $ev, $x, $y) = @_;
2838		3440
2839	# TODO: should use vbox->find_widget or so	3441	# TODO: should use vbox->find_widget or so
2840	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3442	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2841	$self->{hover} = $self->{item}{$HOVER};	3443	$self->{hover} = $self->{item}{$HOVER};
2842	}
2843		3444
		3445	0
		3446	}
		3447
2844	sub button_up {	3448	sub invoke_button_up {
2845	my ($self, $ev, $x, $y) = @_;	3449	my ($self, $ev, $x, $y) = @_;
2846		3450
2847	if ($ev->{button} == $self->{button}) {	3451	if ($ev->{button} == $self->{button}) {
2848	undef $GRAB;	3452	undef $GRAB;
2849	$self->hide;	3453	$self->hide;
2850		3454
2851	$self->_emit ("popdown");	3455	$self->emit ("popdown");
2852	$self->{hover}[1]->() if $self->{hover};	3456	$self->{hover}[1]->() if $self->{hover};
		3457	} else {
		3458	return 0
		3459	}
		3460
2853	}	3461	1
2854	}	3462	}
2855		3463
2856	#############################################################################	3464	#############################################################################
2857		3465
2858	package CFClient::UI::Statusbox;	3466	package CFPlus::UI::Multiplexer;
2859		3467
2860	our @ISA = CFClient::UI::VBox::;	3468	our @ISA = CFPlus::UI::Container::;
2861		3469
2862	sub new {	3470	sub new {
2863	my $class = shift;	3471	my $class = shift;
2864		3472
2865	$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 (
2866	fontsize => 0.8,	3652	fontsize => 0.8,
2867	@_,	3653	@_,
2868	)	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
2869	}	3661	}
2870		3662
2871	sub reorder {	3663	sub reorder {
2872	my ($self) = @_;	3664	my ($self) = @_;
2873	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} };
2874		3671
2875	while (my ($k, $v) = each %{ $self->{item} }) {	3672	while (my ($k, $v) = each %{ $self->{item} }) {
2876	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3673	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2877	}	3674	}
2878		3675
…		…
2881	my @items = sort {	3678	my @items = sort {
2882	$a->{pri} <=> $b->{pri}	3679	$a->{pri} <=> $b->{pri}
2883	or $b->{id} <=> $a->{id}	3680	or $b->{id} <=> $a->{id}
2884	} values %{ $self->{item} };	3681	} values %{ $self->{item} };
2885		3682
		3683	$self->{timer}->interval (1);
		3684
2886	my $count = 10 + 1;	3685	my $count = 10 + 1;
2887	for my $item (@items) {	3686	for my $item (@items) {
2888	last unless --$count;	3687	last unless --$count;
2889		3688
2890	push @widgets, $item->{label} ||= do {	3689	my $label = $item->{label} ||= do {
2891	# TODO: doesn't handle markup well (read as: at all)	3690	# TODO: doesn't handle markup well (read as: at all)
2892	my $short = $item->{count} > 1	3691	my $short = $item->{count} > 1
2893	? "<b>$item->{count} ×</b> $item->{text}"	3692	? "<b>$item->{count} ×</b> $item->{text}"
2894	: $item->{text};	3693	: $item->{text};
2895		3694
2896	for ($short) {	3695	for ($short) {
2897	s/^\s+//;	3696	s/^\s+//;
2898	s/\s+/ /g;	3697	s/\s+/ /g;
2899	}	3698	}
2900		3699
2901	new CFClient::UI::Label	3700	new CFPlus::UI::Label
2902	markup => $short,	3701	markup => $short,
2903	tooltip => $item->{tooltip},	3702	tooltip => $item->{tooltip},
2904	tooltip_font => $::FONT_PROP,	3703	tooltip_font => $::FONT_PROP,
2905	tooltip_width => 0.67,	3704	tooltip_width => 0.67,
2906	fontsize => $item->{fontsize} || $self->{fontsize},	3705	fontsize => $item->{fontsize} || $self->{fontsize},
2907	max_w => $::WIDTH * 0.44,	3706	max_w => $::WIDTH * 0.44,
2908	fg => $item->{fg},	3707	fg => [@{ $item->{fg} }],
2909	can_events => 1,	3708	can_events => 1,
2910	can_hover => 1	3709	can_hover => 1
2911	};	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;
2912	}	3723	}
2913		3724
2914	$self->clear;	3725	$self->clear;
2915	$self->SUPER::add (reverse @widgets);	3726	$self->SUPER::add (reverse @widgets);
2916	}	3727	}
…		…
2921	$text =~ s/^\s+//;	3732	$text =~ s/^\s+//;
2922	$text =~ s/\s+$//;	3733	$text =~ s/\s+$//;
2923		3734
2924	return unless $text;	3735	return unless $text;
2925		3736
2926	my $timeout = time + ((delete $arg{timeout}) || 60);	3737	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2927		3738
2928	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	3739	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2929		3740
2930	if (my $item = $self->{item}{$group}) {	3741	if (my $item = $self->{item}{$group}) {
2931	if ($item->{text} eq $text) {	3742	if ($item->{text} eq $text) {
2932	$item->{count}++;	3743	$item->{count}++;
2933	} else {	3744	} else {
2934	$item->{count} = 1;	3745	$item->{count} = 1;
2935	$item->{text} = $item->{tooltip} = $text;	3746	$item->{text} = $item->{tooltip} = $text;
2936	}	3747	}
2937	$item->{id} = ++$self->{id};	3748	$item->{id} += 0.2;#d#
2938	$item->{timeout} = $timeout;	3749	$item->{timeout} = $timeout;
2939	delete $item->{label};	3750	delete $item->{label};
2940	} else {	3751	} else {
2941	$self->{item}{$group} = {	3752	$self->{item}{$group} = {
2942	id => ++$self->{id},	3753	id => ++$self->{id},
…		…
2948	count => 1,	3759	count => 1,
2949	%arg,	3760	%arg,
2950	};	3761	};
2951	}	3762	}
2952		3763
		3764	$ROOT->on_refresh (reorder => sub {
2953	$self->reorder;	3765	$self->reorder;
		3766	});
2954	}	3767	}
2955		3768
2956	sub reconfigure {	3769	sub reconfigure {
2957	my ($self) = @_;	3770	my ($self) = @_;
2958		3771
…		…
2961		3774
2962	$self->reorder;	3775	$self->reorder;
2963	$self->SUPER::reconfigure;	3776	$self->SUPER::reconfigure;
2964	}	3777	}
2965		3778
		3779	sub destroy {
		3780	my ($self) = @_;
		3781
		3782	$self->{timer}->cancel;
		3783
		3784	$self->SUPER::destroy;
		3785	}
		3786
2966	#############################################################################	3787	#############################################################################
2967		3788
2968	package CFClient::UI::Inventory;
2969
2970	our @ISA = CFClient::UI::ScrolledWindow::;
2971
2972	sub new {
2973	my $class = shift;
2974
2975	my $self = $class->SUPER::new (
2976	scrolled => (new CFClient::UI::Table col_expand => [0, 1, 0]),
2977	@_,
2978	);
2979
2980	$self
2981	}
2982
2983	sub set_items {
2984	my ($self, $items) = @_;
2985
2986	$self->{scrolled}->clear;
2987	return unless $items;
2988
2989	my @items = sort {
2990	($a->{type} <=> $b->{type})
2991	or ($a->{name} cmp $b->{name})
2992	} @$items;
2993
2994	$self->{real_items} = \@items;
2995
2996	my $row = 0;
2997	for my $item (@items) {
2998	CFClient::Item::update_widgets $item;
2999
3000	$self->{scrolled}->add (0, $row, $item->{face_widget});
3001	$self->{scrolled}->add (1, $row, $item->{desc_widget});
3002	$self->{scrolled}->add (2, $row, $item->{weight_widget});
3003
3004	$row++;
3005	}
3006	}
3007
3008	#############################################################################
3009
3010	package CFClient::UI::BindEditor;
3011
3012	our @ISA = CFClient::UI::FancyFrame::;
3013
3014	sub new {
3015	my $class = shift;
3016
3017	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3018
3019	$self->add (my $vb = new CFClient::UI::VBox);
3020
3021
3022	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3023	text => "start recording",
3024	tooltip => "Start/Stops recording of actions."
3025	."All subsequent actions after the recording started will be captured."
3026	."The actions are displayed after the record was stopped."
3027	."To bind the action you have to click on the 'Bind' button",
3028	on_activate => sub {
3029	unless ($self->{recording}) {
3030	$self->start;
3031	} else {
3032	$self->stop;
3033	}
3034	});
3035
3036	$vb->add (new CFClient::UI::Label text => "Actions:");
3037	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3038
3039	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3040	$vb->add (my $hb = new CFClient::UI::HBox);
3041	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3042	$hb->add (new CFClient::UI::Button
3043	text => "bind",
3044	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3045	on_activate => sub {
3046	$self->ask_for_bind;
3047	});
3048
3049	$vb->add (my $hb = new CFClient::UI::HBox);
3050	$hb->add (new CFClient::UI::Button
3051	text => "ok",
3052	expand => 1,
3053	tooltip => "This closes the binding editor and saves the binding",
3054	on_activate => sub {
3055	$self->hide;
3056	$self->commit;
3057	});
3058
3059	$hb->add (new CFClient::UI::Button
3060	text => "cancel",
3061	expand => 1,
3062	tooltip => "This closes the binding editor without saving",
3063	on_activate => sub {
3064	$self->hide;
3065	$self->{binding_cancel}->()
3066	if $self->{binding_cancel};
3067	});
3068
3069	$self->update_binding_widgets;
3070
3071	$self
3072	}
3073
3074	sub commit {
3075	my ($self) = @_;
3076	my ($mod, $sym, $cmds) = $self->get_binding;
3077	if ($sym != 0 && @$cmds > 0) {
3078	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3079	."'. Don't forget 'Save Config'!");
3080	$self->{binding_change}->($mod, $sym, $cmds)
3081	if $self->{binding_change};
3082	} else {
3083	$::STATUSBOX->add ("No action bound, no key or action specified!");
3084	$self->{binding_cancel}->()
3085	if $self->{binding_cancel};
3086	}
3087	}
3088
3089	sub start {
3090	my ($self) = @_;
3091
3092	$self->{rec_btn}->set_text ("stop recording");
3093	$self->{recording} = 1;
3094	$self->clear_command_list;
3095	$::CONN->start_record if $::CONN;
3096	}
3097
3098	sub stop {
3099	my ($self) = @_;
3100
3101	$self->{rec_btn}->set_text ("start recording");
3102	$self->{recording} = 0;
3103
3104	my $rec;
3105	$rec = $::CONN->stop_record if $::CONN;
3106	return unless ref $rec eq 'ARRAY';
3107	$self->set_command_list ($rec);
3108	}
3109
3110	# if $commit is true, the binding will be set after the user entered a key combo
3111	sub ask_for_bind {
3112	my ($self, $commit) = @_;
3113
3114	CFClient::Binder::open_binding_dialog (sub {
3115	my ($mod, $sym) = @_;
3116	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3117	$self->update_binding_widgets;
3118	$self->commit if $commit;
3119	});
3120	}
3121
3122	# $mod and $sym are the modifiers and key symbol
3123	# $cmds is a array ref of strings (the commands)
3124	# $cb is the callback that is executed on OK
3125	# $ccb is the callback that is executed on CANCEL and
3126	# when the binding was unsuccessful on OK
3127	sub set_binding {
3128	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3129
3130	$self->clear_command_list;
3131	$self->{recording} = 0;
3132	$self->{rec_btn}->set_text ("start recording");
3133
3134	$self->{binding} = [$mod, $sym];
3135	$self->{commands} = $cmds;
3136
3137	$self->{binding_change} = $cb;
3138	$self->{binding_cancel} = $ccb;
3139
3140	$self->update_binding_widgets;
3141	}
3142
3143	# this is a shortcut method that asks for a binding
3144	# and then just binds it.
3145	sub do_quick_binding {
3146	my ($self, $cmds) = @_;
3147	$self->set_binding (undef, undef, $cmds, sub {
3148	$::CFG->{bindings}->{$_[0]}->{$_[1]} = $_[2];
3149	});
3150	$self->ask_for_bind (1);
3151	}
3152
3153	sub update_binding_widgets {
3154	my ($self) = @_;
3155	my ($mod, $sym, $cmds) = $self->get_binding;
3156	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3157	$self->set_command_list ($cmds);
3158	}
3159
3160	sub get_binding {
3161	my ($self) = @_;
3162	return (
3163	$self->{binding}->[0],
3164	$self->{binding}->[1],
3165	[ grep { defined $_ } @{$self->{commands}} ]
3166	);
3167	}
3168
3169	sub clear_command_list {
3170	my ($self) = @_;
3171	$self->{cmdbox}->clear ();
3172	}
3173
3174	sub set_command_list {
3175	my ($self, $cmds) = @_;
3176
3177	$self->{cmdbox}->clear ();
3178	$self->{commands} = $cmds;
3179
3180	my $idx = 0;
3181
3182	for (@$cmds) {
3183	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3184
3185	my $i = $idx;
3186	$hb->add (new CFClient::UI::Label text => $_);
3187	$hb->add (new CFClient::UI::Button
3188	text => "delete",
3189	tooltip => "Deletes the action from the record",
3190	on_activate => sub {
3191	$self->{cmdbox}->remove ($hb);
3192	$cmds->[$i] = undef;
3193	});
3194
3195
3196	$idx++
3197	}
3198	}
3199
3200	#############################################################################
3201
3202	package CFClient::UI::SpellList;
3203
3204	our @ISA = CFClient::UI::FancyFrame::;
3205
3206	sub new {
3207	my $class = shift;
3208
3209	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3210
3211	$self->add (new CFClient::UI::ScrolledWindow
3212	scrolled => $self->{spellbox} = new CFClient::UI::Table);
3213
3214	$self;
3215	}
3216
3217	# XXX: Do sorting? Argl...
3218	sub add_spell {
3219	my ($self, $spell) = @_;
3220	$self->{spells}->{$spell->{name}} = $spell;
3221
3222	$self->{spellbox}->add (0, $self->{tbl_idx}, new CFClient::UI::Face
3223	face => $spell->{face},
3224	can_hover => 1,
3225	can_events => 1,
3226	tooltip => $spell->{message});
3227
3228	$self->{spellbox}->add (1, $self->{tbl_idx}, new CFClient::UI::Label
3229	text => $spell->{name},
3230	can_hover => 1,
3231	can_events => 1,
3232	tooltip => $spell->{message},
3233	expand => 1);
3234
3235	$self->{spellbox}->add (2, $self->{tbl_idx}, new CFClient::UI::Label
3236	text => (sprintf "lvl: %2d sp: %2d dmg: %2d",
3237	$spell->{level}, ($spell->{mana} || $spell->{grace}), $spell->{damage}),
3238	expand => 1);
3239
3240	$self->{spellbox}->add (3, $self->{tbl_idx}++, new CFClient::UI::Button
3241	text => "bind to key",
3242	on_activate => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) });
3243	}
3244
3245	sub rebuild_spell_list {
3246	my ($self) = @_;
3247	$self->{tbl_idx} = 0;
3248	$self->add_spell ($_) for values %{$self->{spells}};
3249	}
3250
3251	sub remove_spell {
3252	my ($self, $spell) = @_;
3253	delete $self->{spells}->{$spell->{name}};
3254	$self->rebuild_spell_list;
3255	}
3256
3257	#############################################################################
3258
3259	package CFClient::UI::Root;	3789	package CFPlus::UI::Root;
3260		3790
3261	our @ISA = CFClient::UI::Container::;	3791	our @ISA = CFPlus::UI::Container::;
3262		3792
		3793	use List::Util qw(min max);
		3794
3263	use CFClient::OpenGL;	3795	use CFPlus::OpenGL;
3264		3796
3265	sub new {	3797	sub new {
3266	my $class = shift;	3798	my $class = shift;
3267		3799
3268	my $self = $class->SUPER::new (	3800	my $self = $class->SUPER::new (
3269	visible => 1,	3801	visible => 1,
3270	@_,	3802	@_,
3271	);	3803	);
3272		3804
3273	Scalar::Util::weaken ($self->{root} = $self);	3805	CFPlus::weaken ($self->{root} = $self);
3274		3806
3275	$self	3807	$self
3276	}	3808	}
3277		3809
3278	sub size_request {	3810	sub size_request {
…		…
3293	$coord = $max - $size if $coord > $max - $size;	3825	$coord = $max - $size if $coord > $max - $size;
3294		3826
3295	int $coord + 0.5	3827	int $coord + 0.5
3296	}	3828	}
3297		3829
3298	sub size_allocate {	3830	sub invoke_size_allocate {
3299	my ($self, $w, $h) = @_;	3831	my ($self, $w, $h) = @_;
3300		3832
3301	for my $child ($self->children) {	3833	for my $child ($self->children) {
3302	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)};
3303		3835
…		…
3307	$X = _to_pixel $X, $W, $self->{w};	3839	$X = _to_pixel $X, $W, $self->{w};
3308	$Y = _to_pixel $Y, $H, $self->{h};	3840	$Y = _to_pixel $Y, $H, $self->{h};
3309		3841
3310	$child->configure ($X, $Y, $W, $H);	3842	$child->configure ($X, $Y, $W, $H);
3311	}	3843	}
		3844
		3845	1
3312	}	3846	}
3313		3847
3314	sub coord2local {	3848	sub coord2local {
3315	my ($self, $x, $y) = @_;	3849	my ($self, $x, $y) = @_;
3316		3850
…		…
3372	$_->()	3906	$_->()
3373	for values %{delete $self->{refresh_hook}};	3907	for values %{delete $self->{refresh_hook}};
3374	}	3908	}
3375		3909
3376	if ($self->{realloc}) {	3910	if ($self->{realloc}) {
		3911	my %queue;
3377	my @queue;	3912	my @queue;
		3913	my $widget;
3378		3914
		3915	outer:
3379	while () {	3916	while () {
3380	if ($self->{realloc}) {	3917	if (my $realloc = delete $self->{realloc}) {
3381	#TODO use array-of-depth approach	3918	for $widget (values %$realloc) {
		3919	$widget->{visible} or next; # do not resize invisible widgets
3382		3920
3383	use sort 'stable';	3921	$queue{$widget+0}++ and next; # duplicates are common
3384		3922
3385	@queue = sort { $a->{visible} <=> $b->{visible} }	3923	push @{ $queue[$widget->{visible}] }, $widget;
3386	@queue, values %{delete $self->{realloc}};	3924	}
3387	}	3925	}
3388		3926
		3927	while () {
		3928	@queue or last outer;
		3929
3389	my $widget = pop @queue || last;	3930	$widget = pop @{ $queue[-1] || [] }
		3931	and last;
		3932
		3933	pop @queue;
		3934	}
3390		3935
3391	$widget->{visible} or last; # do not resize invisible widgets	3936	delete $queue{$widget+0};
3392		3937
3393	my ($w, $h) = $widget->size_request;	3938	my ($w, $h) = $widget->size_request;
3394		3939
3395	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;	3940	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3396	$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};
3397		3945
3398	$w = $widget->{force_w} if exists $widget->{force_w};	3946	$w = $widget->{force_w} if exists $widget->{force_w};
3399	$h = $widget->{force_h} if exists $widget->{force_h};	3947	$h = $widget->{force_h} if exists $widget->{force_h};
3400		3948
3401	if ($widget->{req_w} != $w || $widget->{req_h} != $h	3949	if ($widget->{req_w} != $w || $widget->{req_h} != $h
…		…
3404	$widget->{req_h} = $h;	3952	$widget->{req_h} = $h;
3405		3953
3406	$self->{size_alloc}{$widget+0} = $widget;	3954	$self->{size_alloc}{$widget+0} = $widget;
3407		3955
3408	if (my $parent = $widget->{parent}) {	3956	if (my $parent = $widget->{parent}) {
3409	$self->{realloc}{$parent+0} = $parent;	3957	$self->{realloc}{$parent+0} = $parent
3410	#unshift @queue, $parent;	3958	unless $queue{$parent+0};
		3959
3411	$parent->{force_size_alloc} = 1;	3960	$parent->{force_size_alloc} = 1;
3412	$self->{size_alloc}{$parent+0} = $parent;	3961	$self->{size_alloc}{$parent+0} = $parent;
3413	}	3962	}
3414	}	3963	}
3415		3964
…		…
3427	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3976	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3428		3977
3429	$w = 0 if $w < 0;	3978	$w = 0 if $w < 0;
3430	$h = 0 if $h < 0;	3979	$h = 0 if $h < 0;
3431		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
3432	$w = int $w + 0.5;	3990	$w = int $w + 0.5;
3433	$h = int $h + 0.5;	3991	$h = int $h + 0.5;
3434		3992
3435	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
3436	$widget->{w} = $w;	3997	$widget->{w} = $w;
3437	$widget->{h} = $h;	3998	$widget->{h} = $h;
3438		3999
3439	$widget->emit (size_allocate => $w, $h);	4000	$widget->emit (size_allocate => $w, $h);
3440	}	4001	}
…		…
3455	glLoadIdentity;	4016	glLoadIdentity;
3456	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4017	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3457	glMatrixMode GL_MODELVIEW;	4018	glMatrixMode GL_MODELVIEW;
3458	glLoadIdentity;	4019	glLoadIdentity;
3459		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
3460	$self->_draw;	4027	$self->_draw;
		4028	}
3461	}	4029	}
3462		4030
3463	#############################################################################	4031	#############################################################################
3464		4032
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