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.260 by elmex, Tue May 30 14:35:09 2006 UTC vs.
Revision 1.377 by root, Mon Jul 16 20:20:30 2007 UTC

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

Diff Legend

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