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

Diff Legend

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