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.266 by root, Thu Jun 1 03:42:58 2006 UTC vs.
Revision 1.436 by root, Wed Aug 22 21:40:57 2007 UTC

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

Diff Legend

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