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.437 by root, Wed Aug 22 22:36:26 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 $self->{cur_x} + $self->{ox} + .5, $self->{cur_y} + $self->{oy};
1742	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};	2239	glVertex $self->{cur_x} + $self->{ox} + .5, $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 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
		2245	glLineWidth 1;
		2246
		2247	} else {
		2248	glColor @{$self->{outline}};
		2249	glBegin GL_LINE_STRIP;
		2250	glVertex .5, $self->{h} * .5;
		2251	glVertex .5, $self->{h} - 2.5;
		2252	glVertex $self->{w} - .5, $self->{h} - 2.5;
		2253	glVertex $self->{w} - .5, $self->{h} * .5;
		2254	glEnd;
		2255	}
		2256	}
		2257
		2258	#############################################################################
		2259
1747	package CFClient::UI::Entry;	2260	package CFPlus::UI::Entry;
1748		2261
1749	our @ISA = CFClient::UI::EntryBase::;	2262	our @ISA = CFPlus::UI::EntryBase::;
1750		2263
1751	use CFClient::OpenGL;	2264	use CFPlus::OpenGL;
1752		2265
1753	sub key_down {	2266	sub invoke_key_down {
1754	my ($self, $ev) = @_;	2267	my ($self, $ev) = @_;
1755		2268
1756	my $sym = $ev->{sym};	2269	my $sym = $ev->{sym};
1757		2270
1758	if ($sym == 13) {	2271	if ($ev->{uni} == 0x0d || $sym == 13) {
1759	unshift @{$self->{history}},	2272	unshift @{$self->{history}},
1760	my $txt = $self->get_text;	2273	my $txt = $self->get_text;
		2274
1761	$self->{history_pointer} = -1;	2275	$self->{history_pointer} = -1;
1762	$self->{history_saveback} = '';	2276	$self->{history_saveback} = '';
1763	$self->_emit (activate => $txt);	2277	$self->emit (activate => $txt);
1764	$self->update;	2278	$self->update;
1765		2279
1766	} elsif ($sym == CFClient::SDLK_UP) {	2280	} elsif ($sym == CFPlus::SDLK_UP) {
1767	if ($self->{history_pointer} < 0) {	2281	if ($self->{history_pointer} < 0) {
1768	$self->{history_saveback} = $self->get_text;	2282	$self->{history_saveback} = $self->get_text;
1769	}	2283	}
1770	if (@{$self->{history} || []} > 0) {	2284	if (@{$self->{history} || []} > 0) {
1771	$self->{history_pointer}++;	2285	$self->{history_pointer}++;
…		…
1773	$self->{history_pointer} = @{$self->{history} || []} - 1;	2287	$self->{history_pointer} = @{$self->{history} || []} - 1;
1774	}	2288	}
1775	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2289	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1776	}	2290	}
1777		2291
1778	} elsif ($sym == CFClient::SDLK_DOWN) {	2292	} elsif ($sym == CFPlus::SDLK_DOWN) {
1779	$self->{history_pointer}--;	2293	$self->{history_pointer}--;
1780	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2294	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1781		2295
1782	if ($self->{history_pointer} >= 0) {	2296	if ($self->{history_pointer} >= 0) {
1783	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2297	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1784	} else {	2298	} else {
1785	$self->set_text ($self->{history_saveback});	2299	$self->set_text ($self->{history_saveback});
1786	}	2300	}
1787		2301
1788	} else {	2302	} else {
1789	$self->SUPER::key_down ($ev);	2303	return $self->SUPER::invoke_key_down ($ev)
		2304	}
		2305
1790	}	2306	1
1791
1792	}	2307	}
1793		2308
1794	#############################################################################	2309	#############################################################################
1795		2310
		2311	package CFPlus::UI::TextEdit;
		2312
		2313	our @ISA = CFPlus::UI::EntryBase::;
		2314
		2315	use CFPlus::OpenGL;
		2316
		2317	sub move_cursor_ver {
		2318	my ($self, $dy) = @_;
		2319
		2320	my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
		2321
		2322	$y += $dy;
		2323
		2324	if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
		2325	$self->{cursor} = $index;
		2326	delete $self->{cur_h};
		2327	$self->update;
		2328	return;
		2329	}
		2330	}
		2331
		2332	sub invoke_key_down {
		2333	my ($self, $ev) = @_;
		2334
		2335	my $sym = $ev->{sym};
		2336
		2337	if ($sym == CFPlus::SDLK_UP) {
		2338	$self->move_cursor_ver (-1);
		2339	} elsif ($sym == CFPlus::SDLK_DOWN) {
		2340	$self->move_cursor_ver (+1);
		2341	} else {
		2342	return $self->SUPER::invoke_key_down ($ev)
		2343	}
		2344
		2345	1
		2346	}
		2347
		2348	#############################################################################
		2349
1796	package CFClient::UI::Button;	2350	package CFPlus::UI::ButtonBin;
1797		2351
1798	our @ISA = CFClient::UI::Label::;	2352	our @ISA = CFPlus::UI::Bin::;
1799		2353
1800	use CFClient::OpenGL;	2354	use CFPlus::OpenGL;
1801		2355
1802	my @tex =	2356	my @tex =
1803	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2357	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1804	qw(b1_button_active.png);	2358	qw(b1_button_inactive.png b1_button_active.png);
1805		2359
1806	sub new {	2360	sub new {
1807	my $class = shift;	2361	my $class = shift;
1808		2362
1809	$class->SUPER::new (	2363	$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,	2364	can_hover => 1,
1815	align => 0,	2365	align => 0,
1816	valign => 0,	2366	valign => 0,
1817	can_events => 1,	2367	can_events => 1,
1818	@_	2368	@_
1819	)	2369	)
1820	}	2370	}
1821		2371
1822	sub activate { }
1823
1824	sub button_up {	2372	sub invoke_button_up {
1825	my ($self, $ev, $x, $y) = @_;	2373	my ($self, $ev, $x, $y) = @_;
1826		2374
1827	$self->emit ("activate")	2375	$self->emit ("activate")
1828	if $x >= 0 && $x < $self->{w}	2376	if $x >= 0 && $x < $self->{w}
1829	&& $y >= 0 && $y < $self->{h};	2377	&& $y >= 0 && $y < $self->{h};
		2378
		2379	1
1830	}	2380	}
1831		2381
1832	sub _draw {	2382	sub _draw {
1833	my ($self) = @_;	2383	my ($self) = @_;
1834
1835	local $self->{fg} = $self->{fg};
1836
1837	if ($GRAB == $self) {
1838	$self->{fg} = $self->{active_fg};
1839	}
1840		2384
1841	glEnable GL_TEXTURE_2D;	2385	glEnable GL_TEXTURE_2D;
1842	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2386	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1843	glColor 0, 0, 0, 1;	2387	glColor 0, 0, 0, 1;
1844		2388
		2389	my $tex = $tex[$GRAB == $self];
1845	$tex[0]->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	2390	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
1846		2391
1847	glDisable GL_TEXTURE_2D;	2392	glDisable GL_TEXTURE_2D;
1848		2393
1849	$self->SUPER::_draw;	2394	$self->SUPER::_draw;
1850	}	2395	}
1851		2396
1852	#############################################################################	2397	#############################################################################
1853		2398
1854	package CFClient::UI::CheckBox;	2399	package CFPlus::UI::Button;
1855		2400
1856	our @ISA = CFClient::UI::DrawBG::;	2401	our @ISA = CFPlus::UI::Label::;
		2402
		2403	use CFPlus::OpenGL;
1857		2404
1858	my @tex =	2405	my @tex =
1859	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2406	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
		2407	qw(b1_button_inactive.png b1_button_active.png);
		2408
		2409	sub new {
		2410	my $class = shift;
		2411
		2412	$class->SUPER::new (
		2413	padding_x => 4,
		2414	padding_y => 4,
		2415	fg => [1.0, 1.0, 1.0],
		2416	active_fg => [0.8, 0.8, 0.8],
		2417	can_hover => 1,
		2418	align => 0,
		2419	valign => 0,
		2420	can_events => 1,
		2421	@_
		2422	)
		2423	}
		2424
		2425	sub invoke_button_up {
		2426	my ($self, $ev, $x, $y) = @_;
		2427
		2428	$self->emit ("activate")
		2429	if $x >= 0 && $x < $self->{w}
		2430	&& $y >= 0 && $y < $self->{h};
		2431
		2432	1
		2433	}
		2434
		2435	sub _draw {
		2436	my ($self) = @_;
		2437
		2438	local $self->{fg} = $GRAB == $self ? $self->{active_fg} : $self->{fg};
		2439
		2440	glEnable GL_TEXTURE_2D;
		2441	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2442	glColor 0, 0, 0, 1;
		2443
		2444	my $tex = $tex[$GRAB == $self];
		2445	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
		2446
		2447	glDisable GL_TEXTURE_2D;
		2448
		2449	$self->SUPER::_draw;
		2450	}
		2451
		2452	#############################################################################
		2453
		2454	package CFPlus::UI::CheckBox;
		2455
		2456	our @ISA = CFPlus::UI::DrawBG::;
		2457
		2458	my @tex =
		2459	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1860	qw(c1_checkbox_bg.png c1_checkbox_active.png);	2460	qw(c1_checkbox_bg.png c1_checkbox_active.png);
1861		2461
1862	use CFClient::OpenGL;	2462	use CFPlus::OpenGL;
1863		2463
1864	sub new {	2464	sub new {
1865	my $class = shift;	2465	my $class = shift;
1866		2466
1867	$class->SUPER::new (	2467	$class->SUPER::new (
…		…
1881	my ($self) = @_;	2481	my ($self) = @_;
1882		2482
1883	(6) x 2	2483	(6) x 2
1884	}	2484	}
1885		2485
		2486	sub toggle {
		2487	my ($self) = @_;
		2488
		2489	$self->{state} = !$self->{state};
		2490	$self->emit (changed => $self->{state});
		2491	$self->update;
		2492	}
		2493
1886	sub button_down {	2494	sub invoke_button_down {
1887	my ($self, $ev, $x, $y) = @_;	2495	my ($self, $ev, $x, $y) = @_;
1888		2496
1889	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}	2497	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
1890	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {	2498	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
1891	$self->{state} = !$self->{state};	2499	$self->toggle;
1892	$self->_emit (changed => $self->{state});	2500	} else {
		2501	return 0
		2502	}
		2503
1893	}	2504	1
1894	}	2505	}
1895		2506
1896	sub _draw {	2507	sub _draw {
1897	my ($self) = @_;	2508	my ($self) = @_;
1898		2509
1899	$self->SUPER::_draw;	2510	$self->SUPER::_draw;
1900		2511
1901	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;	2512	glTranslate $self->{padding_x}, $self->{padding_y}, 0;
1902		2513
1903	my ($w, $h) = @$self{qw(w h)};	2514	my ($w, $h) = @$self{qw(w h)};
1904		2515
1905	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;	2516	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
1906		2517
…		…
1913	glDisable GL_TEXTURE_2D;	2524	glDisable GL_TEXTURE_2D;
1914	}	2525	}
1915		2526
1916	#############################################################################	2527	#############################################################################
1917		2528
1918	package CFClient::UI::Image;	2529	package CFPlus::UI::Image;
1919		2530
1920	our @ISA = CFClient::UI::Base::;	2531	our @ISA = CFPlus::UI::Base::;
1921		2532
1922	use CFClient::OpenGL;	2533	use CFPlus::OpenGL;
1923	use Carp qw/confess/;
1924		2534
1925	our %loaded_images;	2535	our %texture_cache;
1926		2536
1927	sub new {	2537	sub new {
1928	my $class = shift;	2538	my $class = shift;
1929		2539
1930	my $self = $class->SUPER::new (can_events => 0, @_);	2540	my $self = $class->SUPER::new (
		2541	can_events => 0,
		2542	scale => 1,
		2543	@_,
		2544	);
1931		2545
1932	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";	2546	$self->{path} || $self->{tex}
		2547	or Carp::croak "'path' or 'tex' attributes required";
1933		2548
1934	$loaded_images{$self->{image}} ||=	2549	$self->{tex} ||= $texture_cache{$self->{path}} ||=
1935	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;	2550	new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
1936		2551
1937	my $tex = $self->{tex} = $loaded_images{$self->{image}};	2552	CFPlus::weaken $texture_cache{$self->{path}};
1938		2553
1939	Scalar::Util::weaken $loaded_images{$self->{image}};	2554	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
1940
1941	$self->{aspect} = $tex->{w} / $tex->{h};
1942		2555
1943	$self	2556	$self
1944	}	2557	}
1945		2558
		2559	sub STORABLE_freeze {
		2560	my ($self, $cloning) = @_;
		2561
		2562	$self->{path}
		2563	or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
		2564
		2565	$self->{path}
		2566	}
		2567
		2568	sub STORABLE_attach {
		2569	my ($self, $cloning, $path) = @_;
		2570
		2571	$self->new (path => $path)
		2572	}
		2573
1946	sub size_request {	2574	sub size_request {
1947	my ($self) = @_;	2575	my ($self) = @_;
1948		2576
1949	($self->{tex}->{w}, $self->{tex}->{h})	2577	(int $self->{tex}{w} * $self->{scale}, int $self->{tex}{h} * $self->{scale})
1950	}	2578	}
1951		2579
1952	sub _draw {	2580	sub _draw {
1953	my ($self) = @_;	2581	my ($self) = @_;
1954		2582
…		…
1971	glDisable GL_TEXTURE_2D;	2599	glDisable GL_TEXTURE_2D;
1972	}	2600	}
1973		2601
1974	#############################################################################	2602	#############################################################################
1975		2603
		2604	package CFPlus::UI::ImageButton;
		2605
		2606	our @ISA = CFPlus::UI::Image::;
		2607
		2608	use CFPlus::OpenGL;
		2609
		2610	my %textures;
		2611
		2612	sub new {
		2613	my $class = shift;
		2614
		2615	my $self = $class->SUPER::new (
		2616	padding_x => 4,
		2617	padding_y => 4,
		2618	fg => [1, 1, 1],
		2619	active_fg => [0, 0, 1],
		2620	can_hover => 1,
		2621	align => 0,
		2622	valign => 0,
		2623	can_events => 1,
		2624	@_
		2625	);
		2626	}
		2627
		2628	sub invoke_button_down {
		2629	my ($self, $ev, $x, $y) = @_;
		2630
		2631	1
		2632	}
		2633
		2634	sub invoke_button_up {
		2635	my ($self, $ev, $x, $y) = @_;
		2636
		2637	$self->emit ("activate")
		2638	if $x >= 0 && $x < $self->{w}
		2639	&& $y >= 0 && $y < $self->{h};
		2640
		2641	1
		2642	}
		2643
		2644	#############################################################################
		2645
1976	package CFClient::UI::VGauge;	2646	package CFPlus::UI::VGauge;
1977		2647
1978	our @ISA = CFClient::UI::Base::;	2648	our @ISA = CFPlus::UI::Base::;
1979		2649
1980	use List::Util qw(min max);	2650	use List::Util qw(min max);
1981		2651
1982	use CFClient::OpenGL;	2652	use CFPlus::OpenGL;
1983		2653
1984	my %tex = (	2654	my %tex = (
1985	food => [	2655	food => [
1986	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2656	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1987	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2657	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
1988	],	2658	],
1989	grace => [	2659	grace => [
1990	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2660	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/	2661	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
1992	],	2662	],
1993	hp => [	2663	hp => [
1994	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2664	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1995	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2665	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
1996	],	2666	],
1997	mana => [	2667	mana => [
1998	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2668	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/	2669	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2000	],	2670	],
2001	);	2671	);
2002		2672
2003	# eg. VGauge->new (gauge => 'food'), default gauge: food	2673	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2063	my $ycut1 = max 0, min 1, $ycut;	2733	my $ycut1 = max 0, min 1, $ycut;
2064	my $ycut2 = max 0, min 1, $ycut - 1;	2734	my $ycut2 = max 0, min 1, $ycut - 1;
2065		2735
2066	my $h1 = $self->{h} * (1 - $ycut1);	2736	my $h1 = $self->{h} * (1 - $ycut1);
2067	my $h2 = $self->{h} * (1 - $ycut2);	2737	my $h2 = $self->{h} * (1 - $ycut2);
		2738	my $h3 = $self->{h};
		2739
		2740	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2068		2741
2069	glEnable GL_BLEND;	2742	glEnable GL_BLEND;
2070	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;	2743	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
		2744	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2071	glEnable GL_TEXTURE_2D;	2745	glEnable GL_TEXTURE_2D;
2072	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	2746	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2073		2747
2074	glBindTexture GL_TEXTURE_2D, $t1->{name};	2748	glBindTexture GL_TEXTURE_2D, $t1->{name};
2075	glBegin GL_QUADS;	2749	glBegin GL_QUADS;
…		…
2090		2764
2091	if ($t3) {	2765	if ($t3) {
2092	glBindTexture GL_TEXTURE_2D, $t3->{name};	2766	glBindTexture GL_TEXTURE_2D, $t3->{name};
2093	glBegin GL_QUADS;	2767	glBegin GL_QUADS;
2094	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2768	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2095	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2769	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2096	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2770	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2097	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2771	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2098	glEnd;	2772	glEnd;
2099	}	2773	}
2100		2774
2101	glDisable GL_BLEND;	2775	glDisable GL_BLEND;
2102	glDisable GL_TEXTURE_2D;	2776	glDisable GL_TEXTURE_2D;
2103	}	2777	}
2104		2778
2105	#############################################################################	2779	#############################################################################
2106		2780
		2781	package CFPlus::UI::Progress;
		2782
		2783	our @ISA = CFPlus::UI::Label::;
		2784
		2785	use CFPlus::OpenGL;
		2786
		2787	sub new {
		2788	my ($class, %arg) = @_;
		2789
		2790	my $self = $class->SUPER::new (
		2791	fg => [1, 1, 1],
		2792	bg => [0, 0, 1, 0.2],
		2793	bar => [0.7, 0.5, 0.1, 0.8],
		2794	outline => [0.4, 0.3, 0],
		2795	fontsize => 0.9,
		2796	valign => 0,
		2797	align => 0,
		2798	can_events => 1,
		2799	ellipsise => 1,
		2800	label => "%d%%",
		2801	%arg,
		2802	);
		2803
		2804	$self->set_value ($arg{value} || -1);
		2805
		2806	$self
		2807	}
		2808
		2809	sub set_label {
		2810	my ($self, $label) = @_;
		2811
		2812	return if $self->{label} eq $label;
		2813	$self->{label} = $label;
		2814
		2815	$self->CFPlus::UI::Progress::set_value (0 + delete $self->{value});
		2816	}
		2817
		2818	sub set_value {
		2819	my ($self, $value) = @_;
		2820
		2821	if ($self->{value} ne $value) {
		2822	$self->{value} = $value;
		2823
		2824	if ($value < 0) {
		2825	$self->set_text ("-");
		2826	} else {
		2827	$self->set_text (sprintf $self->{label}, $value * 100);
		2828	}
		2829
		2830	$self->update;
		2831	}
		2832	}
		2833
		2834	sub _draw {
		2835	my ($self) = @_;
		2836
		2837	glEnable GL_BLEND;
		2838	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		2839
		2840	if ($self->{value} >= 0) {
		2841	my $s = int 2 + ($self->{w} - 4) * $self->{value};
		2842
		2843	glColor_premultiply @{$self->{bar}};
		2844	glRect 2, 2, $s, $self->{h} - 2;
		2845	glColor_premultiply @{$self->{bg}};
		2846	glRect $s, 2, $self->{w} - 2, $self->{h} - 2;
		2847	}
		2848
		2849	glColor_premultiply @{$self->{outline}};
		2850	glRect_lineloop 1.5, 1.5, $self->{w} - 1.5, $self->{h} - 1.5;
		2851
		2852	glDisable GL_BLEND;
		2853
		2854	{
		2855	local $self->{bg}; # do not draw background
		2856	$self->SUPER::_draw;
		2857	}
		2858	}
		2859
		2860	#############################################################################
		2861
		2862	package CFPlus::UI::ExperienceProgress;
		2863
		2864	our @ISA = CFPlus::UI::Progress::;
		2865
		2866	sub new {
		2867	my ($class, %arg) = @_;
		2868
		2869	my $self = $class->SUPER::new (
		2870	tooltip => sub {
		2871	my ($self) = @_;
		2872
		2873	sprintf "level %d\n%s points\n%s next level\n%s to go",
		2874	$self->{lvl},
		2875	::formsep ($self->{exp}),
		2876	::formsep ($self->{nxt}),
		2877	::formsep ($self->{nxt} - $self->{exp}),
		2878	},
		2879	%arg
		2880	);
		2881
		2882	$::CONN->{on_exp_update}{$self+0} = sub { $self->set_value ($self->{value}) }
		2883	if $::CONN;
		2884
		2885	$self
		2886	}
		2887
		2888	sub DESTROY {
		2889	my ($self) = @_;
		2890
		2891	delete $::CONN->{on_exp_update}{$self+0}
		2892	if $::CONN;
		2893
		2894	$self->SUPER::DESTROY;
		2895	}
		2896
		2897	sub set_value {
		2898	my ($self, $lvl, $exp) = @_;
		2899
		2900	$self->{lvl} = $lvl;
		2901	$self->{exp} = $exp;
		2902
		2903	my $v = -1;
		2904
		2905	if ($::CONN && (my $table = $::CONN->{exp_table})) {
		2906	my $l0 = $table->[$lvl - 1];
		2907	my $l1 = $table->[$lvl];
		2908
		2909	$self->{nxt} = $l1;
		2910
		2911	$v = ($exp - $l0) / ($l1 - $l0);
		2912	}
		2913
		2914	$self->SUPER::set_value ($v);
		2915	}
		2916
		2917	#############################################################################
		2918
2107	package CFClient::UI::Gauge;	2919	package CFPlus::UI::Gauge;
2108		2920
2109	our @ISA = CFClient::UI::VBox::;	2921	our @ISA = CFPlus::UI::VBox::;
2110		2922
2111	sub new {	2923	sub new {
2112	my ($class, %arg) = @_;	2924	my ($class, %arg) = @_;
2113		2925
2114	my $self = $class->SUPER::new (	2926	my $self = $class->SUPER::new (
…		…
2116	can_hover => 1,	2928	can_hover => 1,
2117	can_events => 1,	2929	can_events => 1,
2118	%arg,	2930	%arg,
2119	);	2931	);
2120		2932
2121	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2933	$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);	2934	$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");	2935	$self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2124		2936
2125	$self	2937	$self
2126	}	2938	}
2127		2939
2128	sub set_fontsize {	2940	sub set_fontsize {
…		…
2149	$self->{value}->set_text ($val);	2961	$self->{value}->set_text ($val);
2150	}	2962	}
2151		2963
2152	#############################################################################	2964	#############################################################################
2153		2965
2154	package CFClient::UI::Slider;	2966	package CFPlus::UI::Slider;
2155		2967
2156	use strict;	2968	use strict;
2157		2969
2158	use CFClient::OpenGL;	2970	use CFPlus::OpenGL;
2159		2971
2160	our @ISA = CFClient::UI::DrawBG::;	2972	our @ISA = CFPlus::UI::DrawBG::;
2161		2973
2162	my @tex =	2974	my @tex =
2163	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2975	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2164	qw(s1_slider.png s1_slider_bg.png);	2976	qw(s1_slider.png s1_slider_bg.png);
2165		2977
2166	sub new {	2978	sub new {
2167	my $class = shift;	2979	my $class = shift;
2168		2980
…		…
2189	$self->update;	3001	$self->update;
2190		3002
2191	$self	3003	$self
2192	}	3004	}
2193		3005
2194	sub changed { }
2195
2196	sub set_range {	3006	sub set_range {
2197	my ($self, $range) = @_;	3007	my ($self, $range) = @_;
2198		3008
2199	($range, $self->{range}) = ($self->{range}, $range);	3009	($range, $self->{range}) = ($self->{range}, $range);
2200		3010
2201	$self->update
2202	if "@$range" ne "@{$self->{range}}";	3011	if ("@$range" ne "@{$self->{range}}") {
		3012	$self->update;
		3013	$self->set_value ($self->{range}[0]);
		3014	}
2203	}	3015	}
2204		3016
2205	sub set_value {	3017	sub set_value {
2206	my ($self, $value) = @_;	3018	my ($self, $value) = @_;
2207		3019
…		…
2218	if $unit;	3030	if $unit;
2219		3031
2220	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);	3032	@{$self->{range}} = ($value, $lo, $hi, $page, $unit);
2221		3033
2222	if ($value != $old_value) {	3034	if ($value != $old_value) {
2223	$self->_emit (changed => $value);	3035	$self->emit (changed => $value);
2224	$self->update;	3036	$self->update;
2225	}	3037	}
2226	}	3038	}
2227		3039
2228	sub size_request {	3040	sub size_request {
2229	my ($self) = @_;	3041	my ($self) = @_;
2230		3042
2231	($self->{req_w}, $self->{req_h})	3043	($self->{req_w}, $self->{req_h})
2232	}	3044	}
2233		3045
2234	sub button_down {	3046	sub invoke_button_down {
2235	my ($self, $ev, $x, $y) = @_;	3047	my ($self, $ev, $x, $y) = @_;
2236		3048
2237	$self->SUPER::button_down ($ev, $x, $y);	3049	$self->SUPER::invoke_button_down ($ev, $x, $y);
2238		3050
2239	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];	3051	$self->{click} = [$self->{range}[0], $self->{vertical} ? $y : $x];
2240		3052
2241	$self->mouse_motion ($ev, $x, $y);	3053	$self->invoke_mouse_motion ($ev, $x, $y);
2242	}
2243		3054
		3055	1
		3056	}
		3057
2244	sub mouse_motion {	3058	sub invoke_mouse_motion {
2245	my ($self, $ev, $x, $y) = @_;	3059	my ($self, $ev, $x, $y) = @_;
2246		3060
2247	if ($GRAB == $self) {	3061	if ($GRAB == $self) {
2248	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});	3062	my ($x, $w) = $self->{vertical} ? ($y, $self->{h}) : ($x, $self->{w});
2249		3063
2250	my (undef, $lo, $hi, $page) = @{$self->{range}};	3064	my (undef, $lo, $hi, $page) = @{$self->{range}};
2251		3065
2252	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});	3066	$x = ($x - $self->{click}[1]) / ($w * $self->{scale});
2253		3067
2254	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));	3068	$self->set_value ($self->{click}[0] + $x * ($hi - $page - $lo));
		3069	} else {
		3070	return 0;
		3071	}
		3072
2255	}	3073	1
		3074	}
		3075
		3076	sub invoke_mouse_wheel {
		3077	my ($self, $ev) = @_;
		3078
		3079	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		3080
		3081	my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;
		3082
		3083	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
		3084
		3085	1
2256	}	3086	}
2257		3087
2258	sub update {	3088	sub update {
2259	my ($self) = @_;	3089	my ($self) = @_;
2260		3090
2261	$CFClient::UI::ROOT->on_post_alloc ($self => sub {	3091	delete $self->{knob_w};
		3092	$self->SUPER::update;
		3093	}
		3094
		3095	sub _draw {
		3096	my ($self) = @_;
		3097
		3098	unless ($self->{knob_w}) {
2262	$self->set_value ($self->{range}[0]);	3099	$self->set_value ($self->{range}[0]);
2263		3100
2264	my ($value, $lo, $hi, $page) = @{$self->{range}};	3101	my ($value, $lo, $hi, $page) = @{$self->{range}};
2265	my $range = ($hi - $page - $lo) || 1e-100;	3102	my $range = ($hi - $page - $lo) || 1e-100;
2266		3103
…		…
2272	$value = ($value - $lo) / $range;	3109	$value = ($value - $lo) / $range;
2273	$value = $value * $self->{scale} + $self->{offset};	3110	$value = $value * $self->{scale} + $self->{offset};
2274		3111
2275	$self->{knob_x} = $value - $knob_w * 0.5;	3112	$self->{knob_x} = $value - $knob_w * 0.5;
2276	$self->{knob_w} = $knob_w;	3113	$self->{knob_w} = $knob_w;
2277	});	3114	}
2278
2279	$self->SUPER::update;
2280	}
2281
2282	sub _draw {
2283	my ($self) = @_;
2284		3115
2285	$self->SUPER::_draw ();	3116	$self->SUPER::_draw ();
2286		3117
2287	glScale $self->{w}, $self->{h};	3118	glScale $self->{w}, $self->{h};
2288		3119
…		…
2308	glDisable GL_TEXTURE_2D;	3139	glDisable GL_TEXTURE_2D;
2309	}	3140	}
2310		3141
2311	#############################################################################	3142	#############################################################################
2312		3143
2313	package CFClient::UI::ValSlider;	3144	package CFPlus::UI::ValSlider;
2314		3145
2315	our @ISA = CFClient::UI::HBox::;	3146	our @ISA = CFPlus::UI::HBox::;
2316		3147
2317	sub new {	3148	sub new {
2318	my ($class, %arg) = @_;	3149	my ($class, %arg) = @_;
2319		3150
2320	my $range = delete $arg{range};	3151	my $range = delete $arg{range};
2321		3152
2322	my $self = $class->SUPER::new (	3153	my $self = $class->SUPER::new (
2323	slider => (new CFClient::UI::Slider expand => 1, range => $range),	3154	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2324	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	3155	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2325	to_value => sub { shift },	3156	to_value => sub { shift },
2326	from_value => sub { shift },	3157	from_value => sub { shift },
2327	%arg,	3158	%arg,
2328	);	3159	);
2329		3160
…		…
2349	sub set_range { shift->{slider}->set_range (@_) }	3180	sub set_range { shift->{slider}->set_range (@_) }
2350	sub set_value { shift->{slider}->set_value (@_) }	3181	sub set_value { shift->{slider}->set_value (@_) }
2351		3182
2352	#############################################################################	3183	#############################################################################
2353		3184
2354	package CFClient::UI::TextView;	3185	package CFPlus::UI::TextScroller;
2355		3186
2356	our @ISA = CFClient::UI::HBox::;	3187	our @ISA = CFPlus::UI::HBox::;
2357		3188
2358	use CFClient::OpenGL;	3189	use CFPlus::OpenGL;
2359		3190
2360	sub new {	3191	sub new {
2361	my $class = shift;	3192	my $class = shift;
2362		3193
2363	my $self = $class->SUPER::new (	3194	my $self = $class->SUPER::new (
2364	fontsize => 1,	3195	fontsize => 1,
2365	can_events => 0,	3196	can_events => 1,
		3197	indent => 0,
2366	#font => default_font	3198	#font => default_font
2367	@_,	3199	@_,
2368		3200
2369	layout => (new CFClient::Layout 1),	3201	layout => (new CFPlus::Layout),
2370	par => [],	3202	par => [],
		3203	max_par => 0,
2371	height => 0,	3204	height => 0,
2372	children => [	3205	children => [
2373	(new CFClient::UI::Empty expand => 1),	3206	(new CFPlus::UI::Empty expand => 1),
2374	(new CFClient::UI::Slider vertical => 1),	3207	(new CFPlus::UI::Slider vertical => 1),
2375	],	3208	],
2376	);	3209	);
2377		3210
2378	$self->{children}[1]->connect (changed => sub { $self->update });	3211	$self->{children}[1]->connect (changed => sub { $self->update });
2379		3212
…		…
2385		3218
2386	$self->{fontsize} = $fontsize;	3219	$self->{fontsize} = $fontsize;
2387	$self->reflow;	3220	$self->reflow;
2388	}	3221	}
2389		3222
		3223	sub size_request {
		3224	my ($self) = @_;
		3225
		3226	my ($empty, $slider) = $self->visible_children;
		3227
		3228	local $self->{children} = [$empty, $slider];
		3229	$self->SUPER::size_request
		3230	}
		3231
2390	sub size_allocate {	3232	sub invoke_size_allocate {
2391	my ($self, $w, $h) = @_;	3233	my ($self, $w, $h) = @_;
2392		3234
2393	$self->SUPER::size_allocate ($w, $h);	3235	my ($empty, $slider, @other) = @{ $self->{children} };
		3236	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
2394		3237
2395	$self->{layout}->set_font ($self->{font}) if $self->{font};	3238	$self->{layout}->set_font ($self->{font}) if $self->{font};
2396	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	3239	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2397	$self->{layout}->set_width ($self->{children}[0]{w});	3240	$self->{layout}->set_width ($empty->{w});
		3241	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2398		3242
2399	$self->reflow;	3243	$self->reflow;
2400	}
2401		3244
2402	sub text_size {	3245	local $self->{children} = [$empty, $slider];
		3246	$self->SUPER::invoke_size_allocate ($w, $h)
		3247	}
		3248
		3249	sub invoke_mouse_wheel {
2403	my ($self, $text, $indent) = @_;	3250	my ($self, $ev) = @_;
		3251
		3252	return 0 unless $ev->{dy}; # only vertical movements
		3253
		3254	$self->{children}[1]->emit (mouse_wheel => $ev);
		3255
		3256	1
		3257	}
		3258
		3259	sub get_layout {
		3260	my ($self, $para) = @_;
2404		3261
2405	my $layout = $self->{layout};	3262	my $layout = $self->{layout};
2406		3263
		3264	$layout->set_font ($self->{font}) if $self->{font};
		3265	$layout->set_foreground (@{$para->{fg}});
2407	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	3266	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2408	$layout->set_width ($self->{children}[0]{w} - $indent);	3267	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
		3268	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2409	$layout->set_markup ($text);	3269	$layout->set_markup ($para->{markup});
		3270
		3271	$layout->set_shapes (
		3272	map
		3273	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		3274	@{$para->{widget}}
2410		3275	);
		3276
2411	$layout->size	3277	$layout
2412	}	3278	}
2413		3279
2414	sub reflow {	3280	sub reflow {
2415	my ($self) = @_;	3281	my ($self) = @_;
2416		3282
…		…
2423		3289
2424	# todo: base offset on lines or so, not on pixels	3290	# todo: base offset on lines or so, not on pixels
2425	$self->{children}[1]->set_value ($offset);	3291	$self->{children}[1]->set_value ($offset);
2426	}	3292	}
2427		3293
		3294	sub current_paragraph {
		3295	my ($self) = @_;
		3296
		3297	$self->{top_paragraph} - 1
		3298	}
		3299
		3300	sub scroll_to {
		3301	my ($self, $para) = @_;
		3302
		3303	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		3304
		3305	$self->{scroll_to} = $para;
		3306	$self->update;
		3307	}
		3308
2428	sub clear {	3309	sub clear {
2429	my ($self) = @_;	3310	my ($self) = @_;
		3311
		3312	my (undef, undef, @other) = @{ $self->{children} };
		3313	$self->remove ($_) for @other;
2430		3314
2431	$self->{par} = [];	3315	$self->{par} = [];
2432	$self->{height} = 0;	3316	$self->{height} = 0;
2433	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	3317	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2434	}	3318	}
2435		3319
2436	sub add_paragraph {	3320	sub add_paragraph {
2437	my ($self, $color, $text, $indent) = @_;	3321	my $self = shift;
2438		3322
2439	for my $line (split /\n/, $text) {	3323	for my $para (@_) {
2440	my ($w, $h) = $self->text_size ($line);	3324	$para = {
		3325	fg => [1, 1, 1, 1],
		3326	indent => 0,
		3327	markup => "",
		3328	widget => [],
		3329	ref $para ? %$para : (markup => $para),
		3330	w => 1e10,
		3331	wrapped => 1,
		3332	};
		3333
		3334	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		3335	push @{$self->{par}}, $para;
		3336	}
		3337
		3338	if (my $max = $self->{max_par}) {
		3339	shift @{$self->{par}} while @{$self->{par}} > $max;
		3340	}
		3341
		3342	$self->{need_reflow}++;
		3343	$self->update;
		3344	}
		3345
		3346	sub scroll_to_bottom {
		3347	my ($self) = @_;
		3348
		3349	$self->{scroll_to} = $#{$self->{par}};
		3350	$self->update;
		3351	}
		3352
		3353	sub force_uptodate {
		3354	my ($self) = @_;
		3355
		3356	if (delete $self->{need_reflow}) {
		3357	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		3358
		3359	my $height = 0;
		3360
		3361	for my $para (@{$self->{par}}) {
		3362	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		3363	my $layout = $self->get_layout ($para);
		3364	my ($w, $h) = $layout->size;
		3365
		3366	$para->{w} = $w + $para->{indent};
		3367	$para->{h} = $h;
		3368	$para->{wrapped} = $layout->has_wrapped;
		3369	}
		3370
		3371	$para->{y} = $height;
		3372	$height += $para->{h};
		3373	}
		3374
2441	$self->{height} += $h;	3375	$self->{height} = $height;
2442	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3376	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2443	}
2444		3377
2445	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	3378	delete $self->{texture};
		3379	}
		3380
		3381	if (my $paridx = delete $self->{scroll_to}) {
		3382	$self->{children}[1]->set_value ($self->{par}[$paridx]{y});
		3383	}
2446	}	3384	}
2447		3385
2448	sub update {	3386	sub update {
2449	my ($self) = @_;	3387	my ($self) = @_;
2450		3388
…		…
2452		3390
2453	return unless $self->{h} > 0;	3391	return unless $self->{h} > 0;
2454		3392
2455	delete $self->{texture};	3393	delete $self->{texture};
2456		3394
2457	$ROOT->on_post_alloc ($self, sub {	3395	$ROOT->on_post_alloc ($self => sub {
		3396	$self->force_uptodate;
		3397
2458	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3398	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2459		3399
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 {	3400	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2487	glClearColor 0.5, 0.5, 0.5, 0;	3401	glClearColor 0, 0, 0, 0;
2488	glClear GL_COLOR_BUFFER_BIT;	3402	glClear GL_COLOR_BUFFER_BIT;
2489		3403
		3404	package CFPlus::UI::Base;
		3405	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		3406	(0, 0, $self->{w}, $self->{h});
		3407
		3408	my $top = int $self->{children}[1]{range}[0];
		3409
		3410	my $paridx = 0;
		3411	my $top_paragraph;
2490	my $top = int $self->{children}[1]{range}[0];	3412	my $top = int $self->{children}[1]{range}[0];
2491		3413
2492	my $y0 = $top;	3414	my $y0 = $top;
2493	my $y1 = $top + $H;	3415	my $y1 = $top + $H;
2494		3416
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}}) {	3417	for my $para (@{$self->{par}}) {
2506	my $h = $par->[1];	3418	my $h = $para->{h};
		3419	my $y = $para->{y};
2507		3420
2508	if ($y0 < $y + $h && $y < $y1) {	3421	if ($y0 < $y + $h && $y < $y1) {
2509	$layout->set_foreground (@{ $par->[2] });	3422	my $layout = $self->get_layout ($para);
2510	$layout->set_width ($W - $par->[3]);
2511	$layout->set_markup ($par->[4]);
2512		3423
2513	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3424	$layout->render ($para->{indent}, $y - $y0);
		3425	$layout->draw;
2514		3426
2515	glRasterPos $par->[3], $y - $y0;	3427	if (my @w = @{ $para->{widget} }) {
2516	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3428	my @s = $layout->get_shapes;
		3429
		3430	for (@w) {
		3431	my ($dx, $dy) = splice @s, 0, 2, ();
		3432
		3433	$_->{x} = $dx + $para->{indent};
		3434	$_->{y} = $dy + $y - $y0;
		3435
		3436	$_->draw;
		3437	}
		3438	}
2517	}	3439	}
2518		3440
2519	$y += $h;	3441	$paridx++;
		3442	$top_paragraph ||= $paridx if $y >= $top;
2520	}	3443	}
2521		3444
2522	glDisable GL_BLEND;	3445	$self->{top_paragraph} = $top_paragraph;
2523	};	3446	};
2524	});	3447	});
2525	}	3448	}
2526		3449
		3450	sub reconfigure {
		3451	my ($self) = @_;
		3452
		3453	$self->SUPER::reconfigure;
		3454
		3455	$_->{w} = 1e10 for @{ $self->{par} };
		3456	$self->reflow;
		3457	}
		3458
2527	sub _draw {	3459	sub _draw {
2528	my ($self) = @_;	3460	my ($self) = @_;
2529		3461
2530	glEnable GL_TEXTURE_2D;	3462	glEnable GL_TEXTURE_2D;
2531	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3463	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2532	glColor 1, 1, 1, 1;	3464	glColor 0, 0, 0, 1;
2533	$self->{texture}->draw_quad_alpha (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	3465	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2534	glDisable GL_TEXTURE_2D;	3466	glDisable GL_TEXTURE_2D;
2535		3467
2536	$self->{children}[1]->draw;	3468	$self->{children}[1]->draw;
2537
2538	}	3469	}
2539		3470
2540	#############################################################################	3471	#############################################################################
2541		3472
2542	package CFClient::UI::Animator;	3473	package CFPlus::UI::Animator;
2543		3474
2544	use CFClient::OpenGL;	3475	use CFPlus::OpenGL;
2545		3476
2546	our @ISA = CFClient::UI::Bin::;	3477	our @ISA = CFPlus::UI::Bin::;
2547		3478
2548	sub moveto {	3479	sub moveto {
2549	my ($self, $x, $y) = @_;	3480	my ($self, $x, $y) = @_;
2550		3481
2551	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3482	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2579	glPopMatrix;	3510	glPopMatrix;
2580	}	3511	}
2581		3512
2582	#############################################################################	3513	#############################################################################
2583		3514
2584	package CFClient::UI::Flopper;	3515	package CFPlus::UI::Flopper;
2585		3516
2586	our @ISA = CFClient::UI::Button::;	3517	our @ISA = CFPlus::UI::Button::;
2587		3518
2588	sub new {	3519	sub new {
2589	my $class = shift;	3520	my $class = shift;
2590		3521
2591	my $self = $class->SUPER::new (	3522	my $self = $class->SUPER::new (
…		…
2603	$self->{other}->toggle_visibility;	3534	$self->{other}->toggle_visibility;
2604	}	3535	}
2605		3536
2606	#############################################################################	3537	#############################################################################
2607		3538
2608	package CFClient::UI::Tooltip;	3539	package CFPlus::UI::Tooltip;
2609		3540
2610	our @ISA = CFClient::UI::Bin::;	3541	our @ISA = CFPlus::UI::Bin::;
2611		3542
2612	use CFClient::OpenGL;	3543	use CFPlus::OpenGL;
2613		3544
2614	sub new {	3545	sub new {
2615	my $class = shift;	3546	my $class = shift;
2616		3547
2617	$class->SUPER::new (	3548	$class->SUPER::new (
…		…
2621	}	3552	}
2622		3553
2623	sub set_tooltip_from {	3554	sub set_tooltip_from {
2624	my ($self, $widget) = @_;	3555	my ($self, $widget) = @_;
2625		3556
2626	my $tooltip = $widget->{tooltip};	3557	my $tip = $widget->{tooltip};
		3558	$tip = $tip->($widget) if "CODE" eq ref $tip;
		3559
		3560	$tip = CFPlus::Pod::section_label tooltip => $1
		3561	if $tip =~ /^#(.*)$/;
2627		3562
2628	if ($ENV{CFPLUS_DEBUG} & 2) {	3563	if ($ENV{CFPLUS_DEBUG} & 2) {
2629	$tooltip .= "\n\n" . (ref $widget) . "\n"	3564	$tip .= "\n\n" . (ref $widget) . "\n"
2630	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"	3565	. "$widget->{x} $widget->{y} $widget->{w} $widget->{h}\n"
2631	. "req $widget->{req_w} $widget->{req_h}\n"	3566	. "req $widget->{req_w} $widget->{req_h}\n"
2632	. "visible $widget->{visible}";	3567	. "visible $widget->{visible}";
2633	}	3568	}
2634		3569
		3570	$tip =~ s/^\n+//;
		3571	$tip =~ s/\n+$//;
		3572
2635	$self->add (new CFClient::UI::Label	3573	$self->add (new CFPlus::UI::Label
2636	markup => $tooltip,	3574	markup => $tip,
2637	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3575	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2638	fontsize => 0.8,	3576	fontsize => 0.8,
2639	fg => [0, 0, 0, 1],	3577	style => 1, # FLAG_INVERSE
2640	ellipsise => 0,	3578	ellipsise => 0,
2641	font => ($widget->{tooltip_font} || $::FONT_PROP),	3579	font => ($widget->{tooltip_font} || $::FONT_PROP),
2642	);	3580	);
2643	}	3581	}
2644		3582
…		…
2648	my ($w, $h) = @{$self->child}{qw(req_w req_h)};	3586	my ($w, $h) = @{$self->child}{qw(req_w req_h)};
2649		3587
2650	($w + 4, $h + 4)	3588	($w + 4, $h + 4)
2651	}	3589	}
2652		3590
2653	sub size_allocate {	3591	sub invoke_size_allocate {
2654	my ($self, $w, $h) = @_;	3592	my ($self, $w, $h) = @_;
2655		3593
2656	$self->SUPER::size_allocate ($w - 4, $h - 4);	3594	$self->SUPER::invoke_size_allocate ($w - 4, $h - 4)
2657	}	3595	}
2658		3596
2659	sub visibility_change {	3597	sub invoke_visibility_change {
2660	my ($self, $visible) = @_;	3598	my ($self, $visible) = @_;
2661		3599
2662	return unless $visible;	3600	return unless $visible;
2663		3601
2664	$self->{root}->on_post_alloc ("move_$self" => sub {	3602	$self->{root}->on_post_alloc ("move_$self" => sub {
2665	my $widget = $self->{owner}	3603	my $widget = $self->{owner}
2666	or return;	3604	or return;
2667		3605
		3606	if ($widget->{visible}) {
2668	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3607	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2669		3608
2670	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3609	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2671	if $x + $self->{w} > $::WIDTH;	3610	if $x + $self->{w} > $self->{root}{w};
2672		3611
2673	$self->move_abs ($x, $y);	3612	$self->move_abs ($x, $y);
		3613	} else {
		3614	$self->hide;
		3615	}
2674	});	3616	});
2675	}	3617	}
2676		3618
2677	sub _draw {	3619	sub _draw {
2678	my ($self) = @_;	3620	my ($self) = @_;
2679		3621
2680	glTranslate 0.375, 0.375;
2681
2682	my ($w, $h) = @$self{qw(w h)};	3622	my ($w, $h) = @$self{qw(w h)};
2683		3623
2684	glColor 1, 0.8, 0.4;	3624	glColor 1, 0.8, 0.4;
2685	glBegin GL_QUADS;	3625	glRect 0, 0, $w, $h;
2686	glVertex 0 , 0;
2687	glVertex 0 , $h;
2688	glVertex $w, $h;
2689	glVertex $w, 0;
2690	glEnd;
2691		3626
2692	glColor 0, 0, 0;	3627	glColor 0, 0, 0;
2693	glBegin GL_LINE_LOOP;	3628	glRect_lineloop .5, .5, $w + .5, $h + .5;
2694	glVertex 0 , 0;
2695	glVertex 0 , $h;
2696	glVertex $w, $h;
2697	glVertex $w, 0;
2698	glEnd;
2699		3629
2700	glTranslate 2 - 0.375, 2 - 0.375;	3630	glTranslate 2, 2;
2701		3631
2702	$self->SUPER::_draw;	3632	$self->SUPER::_draw;
2703	}	3633	}
2704		3634
2705	#############################################################################	3635	#############################################################################
2706		3636
2707	package CFClient::UI::Face;	3637	package CFPlus::UI::Face;
2708		3638
2709	our @ISA = CFClient::UI::Base::;	3639	our @ISA = CFPlus::UI::DrawBG::;
2710		3640
2711	use CFClient::OpenGL;	3641	use CFPlus::OpenGL;
2712		3642
2713	sub new {	3643	sub new {
2714	my $class = shift;	3644	my $class = shift;
2715		3645
2716	my $self = $class->SUPER::new (	3646	my $self = $class->SUPER::new (
		3647	size_w => 32,
		3648	size_h => 8,
2717	aspect => 1,	3649	aspect => 1,
2718	can_events => 0,	3650	can_events => 0,
2719	@_,	3651	@_,
2720	);	3652	);
2721		3653
2722	if ($self->{anim} && $self->{animspeed}) {	3654	if ($self->{anim} && $self->{animspeed}) {
2723	Scalar::Util::weaken (my $widget = $self);	3655	CFPlus::weaken (my $widget = $self);
2724		3656
		3657	$widget->{animspeed} = List::Util::max 0.05, $widget->{animspeed};
		3658	$widget->{anim_start} = $self->{animspeed} * int Event::time / $self->{animspeed};
2725	$self->{timer} = Event->timer (	3659	$self->{timer} = Event->timer (
2726	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2727	hard => 1,	3660	parked => 1,
2728	interval => $self->{animspeed},
2729	cb => sub {	3661	cb => sub {
		3662	return unless $::CONN;
		3663
		3664	my $w = $widget
		3665	or return;
		3666
2730	++$widget->{frame};	3667	++$w->{frame};
		3668	$w->update_face;
		3669
		3670	# somehow, $widget can go away
2731	$widget->update;	3671	$w->update;
		3672	$w->update_timer;
2732	},	3673	},
2733	);	3674	);
		3675
		3676	$self->update_face;
		3677	$self->update_timer;
2734	}	3678	}
2735		3679
2736	$self	3680	$self
2737	}	3681	}
2738		3682
		3683	sub update_timer {
		3684	my ($self) = @_;
		3685
		3686	return unless $self->{timer};
		3687
		3688	if ($self->{visible}) {
		3689	$self->{timer}->at (
		3690	$self->{anim_start}
		3691	+ $self->{animspeed}
		3692	* int 1.5 + (Event::time - $self->{anim_start}) / $self->{animspeed}
		3693	);
		3694	$self->{timer}->start;
		3695	} else {
		3696	$self->{timer}->stop;
		3697	}
		3698	}
		3699
		3700	sub update_face {
		3701	my ($self) = @_;
		3702
		3703	if ($::CONN) {
		3704	if (my $anim = $::CONN->{anim}[$self->{anim}]) {
		3705	if ($anim && @$anim) {
		3706	$self->{face} = $anim->[ $self->{frame} % @$anim ];
		3707	delete $self->{face_change_cb};
		3708
		3709	if (my $tex = $self->{tex} = $::CONN->{texture}[ $::CONN->{face}[$self->{face}]{id} ]) {
		3710	unless ($tex->{name} || $tex->{loading}) {
		3711	$tex->upload (sub { $self->reconfigure });
		3712	}
		3713	}
		3714	}
		3715	}
		3716	}
		3717	}
		3718
2739	sub size_request {	3719	sub size_request {
2740	(32, 8)	3720	my ($self) = @_;
		3721
		3722	if ($::CONN) {
		3723	if (my $faceid = $::CONN->{face}[$self->{face}]{id}) {
		3724	if (my $tex = $self->{tex} = $::CONN->{texture}[$faceid]) {
		3725	if ($tex->{name}) {
		3726	return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
		3727	} elsif (!$tex->{loading}) {
		3728	$tex->upload (sub { $self->reconfigure });
		3729	}
		3730	}
		3731
		3732	$self->{face_change_cb} ||= $::CONN->on_face_change ($self->{face}, sub { $self->reconfigure });
		3733	}
		3734	}
		3735
		3736	($self->{size_w} || 8, $self->{size_h} || 8)
2741	}	3737	}
2742		3738
2743	sub update {	3739	sub update {
2744	my ($self) = @_;	3740	my ($self) = @_;
2745		3741
2746	return unless $self->{visible};	3742	return unless $self->{visible};
2747		3743
2748	$self->SUPER::update;	3744	$self->SUPER::update;
2749	}	3745	}
2750		3746
		3747	sub invoke_visibility_change {
		3748	my ($self) = @_;
		3749
		3750	$self->update_timer;
		3751
		3752	0
		3753	}
		3754
2751	sub _draw {	3755	sub _draw {
2752	my ($self) = @_;	3756	my ($self) = @_;
2753		3757
2754	return unless $::CONN;	3758	$self->SUPER::_draw;
2755		3759
2756	my $face;	3760	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;	3761	glEnable GL_TEXTURE_2D;
2769	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3762	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2770	glColor 1, 1, 1, 1;	3763	glColor 0, 0, 0, 1;
2771	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});	3764	$tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
2772	glDisable GL_TEXTURE_2D;	3765	glDisable GL_TEXTURE_2D;
2773	}	3766	}
2774	}	3767	}
2775		3768
2776	sub DESTROY {	3769	sub destroy {
2777	my ($self) = @_;	3770	my ($self) = @_;
2778		3771
2779	$self->{timer}->cancel	3772	(delete $self->{timer})->cancel
2780	if $self->{timer};	3773	if $self->{timer};
2781		3774
2782	$self->SUPER::DESTROY;	3775	$self->SUPER::destroy;
2783	}	3776	}
2784		3777
2785	#############################################################################	3778	#############################################################################
2786		3779
		3780	package CFPlus::UI::Buttonbar;
		3781
		3782	our @ISA = CFPlus::UI::HBox::;
		3783
		3784	# TODO: should actually wrap buttons and other goodies.
		3785
		3786	#############################################################################
		3787
2787	package CFClient::UI::Menu;	3788	package CFPlus::UI::Menu;
2788		3789
2789	our @ISA = CFClient::UI::FancyFrame::;	3790	our @ISA = CFPlus::UI::Toplevel::;
2790		3791
2791	use CFClient::OpenGL;	3792	use CFPlus::OpenGL;
2792		3793
2793	sub new {	3794	sub new {
2794	my $class = shift;	3795	my $class = shift;
2795		3796
2796	my $self = $class->SUPER::new (	3797	my $self = $class->SUPER::new (
2797	items => [],	3798	items => [],
2798	z => 100,	3799	z => 100,
2799	@_,	3800	@_,
2800	);	3801	);
2801		3802
2802	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3803	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2803		3804
2804	for my $item (@{ $self->{items} }) {	3805	for my $item (@{ $self->{items} }) {
2805	my ($widget, $cb) = @$item;	3806	my ($widget, $cb, $tooltip) = @$item;
2806		3807
2807	# handle various types of items, only text for now	3808	# handle various types of items, only text for now
2808	if (!ref $widget) {	3809	if (!ref $widget) {
		3810	if ($widget =~ /\t/) {
		3811	my ($left, $right) = split /\t/, $widget, 2;
		3812
2809	$widget = new CFClient::UI::Label	3813	$widget = new CFPlus::UI::HBox
2810	can_hover => 1,	3814	can_hover => 1,
2811	can_events => 1,	3815	can_events => 1,
		3816	tooltip => $tooltip,
		3817	children => [
		3818	(new CFPlus::UI::Label markup => $left, expand => 1),
		3819	(new CFPlus::UI::Label markup => $right, align => +1),
		3820	],
		3821	;
		3822
		3823	} else {
		3824	$widget = new CFPlus::UI::Label
		3825	can_hover => 1,
		3826	can_events => 1,
2812	text => $widget;	3827	markup => $widget,
		3828	tooltip => $tooltip;
		3829	}
2813	}	3830	}
2814		3831
2815	$self->{item}{$widget} = $item;	3832	$self->{item}{$widget} = $item;
2816		3833
2817	$self->{vbox}->add ($widget);	3834	$self->{vbox}->add ($widget);
…		…
2822		3839
2823	# popup given the event (must be a mouse button down event currently)	3840	# popup given the event (must be a mouse button down event currently)
2824	sub popup {	3841	sub popup {
2825	my ($self, $ev) = @_;	3842	my ($self, $ev) = @_;
2826		3843
2827	$self->_emit ("popdown");	3844	$self->emit ("popdown");
2828		3845
2829	# maybe save $GRAB? must be careful about events...	3846	# maybe save $GRAB? must be careful about events...
2830	$GRAB = $self;	3847	$GRAB = $self;
2831	$self->{button} = $ev->{button};	3848	$self->{button} = $ev->{button};
2832		3849
2833	$self->show;	3850	$self->show;
2834	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);	3851	$self->move_abs ($ev->{x} - $self->{w} * 0.5, $ev->{y} - $self->{h} * 0.5);
2835	}	3852	}
2836		3853
2837	sub mouse_motion {	3854	sub invoke_mouse_motion {
2838	my ($self, $ev, $x, $y) = @_;	3855	my ($self, $ev, $x, $y) = @_;
2839		3856
2840	# TODO: should use vbox->find_widget or so	3857	# TODO: should use vbox->find_widget or so
2841	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});	3858	$HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
2842	$self->{hover} = $self->{item}{$HOVER};	3859	$self->{hover} = $self->{item}{$HOVER};
2843	}
2844		3860
		3861	0
		3862	}
		3863
2845	sub button_up {	3864	sub invoke_button_up {
2846	my ($self, $ev, $x, $y) = @_;	3865	my ($self, $ev, $x, $y) = @_;
2847		3866
2848	if ($ev->{button} == $self->{button}) {	3867	if ($ev->{button} == $self->{button}) {
2849	undef $GRAB;	3868	undef $GRAB;
2850	$self->hide;	3869	$self->hide;
2851		3870
2852	$self->_emit ("popdown");	3871	$self->emit ("popdown");
2853	$self->{hover}[1]->() if $self->{hover};	3872	$self->{hover}[1]->() if $self->{hover};
		3873	} else {
		3874	return 0
		3875	}
		3876
2854	}	3877	1
2855	}	3878	}
2856		3879
2857	#############################################################################	3880	#############################################################################
2858		3881
2859	package CFClient::UI::Statusbox;	3882	package CFPlus::UI::Multiplexer;
2860		3883
2861	our @ISA = CFClient::UI::VBox::;	3884	our @ISA = CFPlus::UI::Container::;
2862		3885
2863	sub new {	3886	sub new {
2864	my $class = shift;	3887	my $class = shift;
2865		3888
2866	$class->SUPER::new (	3889	my $self = $class->SUPER::new (
		3890	@_,
		3891	);
		3892
		3893	$self->{current} = $self->{children}[0]
		3894	if @{ $self->{children} };
		3895
		3896	$self
		3897	}
		3898
		3899	sub add {
		3900	my ($self, @widgets) = @_;
		3901
		3902	$self->SUPER::add (@widgets);
		3903
		3904	$self->{current} = $self->{children}[0]
		3905	if @{ $self->{children} };
		3906	}
		3907
		3908	sub get_current_page {
		3909	my ($self) = @_;
		3910
		3911	$self->{current}
		3912	}
		3913
		3914	sub set_current_page {
		3915	my ($self, $page_or_widget) = @_;
		3916
		3917	my $widget = ref $page_or_widget
		3918	? $page_or_widget
		3919	: $self->{children}[$page_or_widget];
		3920
		3921	$self->{current} = $widget;
		3922	$self->{current}->configure (0, 0, $self->{w}, $self->{h});
		3923
		3924	$self->emit (page_changed => $self->{current});
		3925
		3926	$self->realloc;
		3927	}
		3928
		3929	sub visible_children {
		3930	$_[0]{current}
		3931	}
		3932
		3933	sub size_request {
		3934	my ($self) = @_;
		3935
		3936	$self->{current}->size_request
		3937	}
		3938
		3939	sub invoke_size_allocate {
		3940	my ($self, $w, $h) = @_;
		3941
		3942	$self->{current}->configure (0, 0, $w, $h);
		3943
		3944	1
		3945	}
		3946
		3947	sub _draw {
		3948	my ($self) = @_;
		3949
		3950	$self->{current}->draw;
		3951	}
		3952
		3953	#############################################################################
		3954
		3955	package CFPlus::UI::Notebook;
		3956
		3957	use CFPlus::OpenGL;
		3958
		3959	our @ISA = CFPlus::UI::VBox::;
		3960
		3961	sub new {
		3962	my $class = shift;
		3963
		3964	my $self = $class->SUPER::new (
		3965	buttonbar => (new CFPlus::UI::Buttonbar),
		3966	multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
		3967	active_outline => [.7, .7, 0.2],
		3968	# filter => # will be put between multiplexer and $self
		3969	@_,
		3970	);
		3971
		3972	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
		3973	$self->SUPER::add ($self->{buttonbar}, $self->{filter} || $self->{multiplexer});
		3974
		3975	{
		3976	Scalar::Util::weaken (my $wself = $self);
		3977
		3978	$self->{multiplexer}->connect (c_add => sub {
		3979	my ($mplex, $widgets) = @_;
		3980
		3981	for my $child (@$widgets) {
		3982	Scalar::Util::weaken $child;
		3983	$child->{c_tab_} ||= do {
		3984	my $tab =
		3985	(UNIVERSAL::isa $child->{c_tab}, "CFPlus::UI::Base")
		3986	? $child->{c_tab}
		3987	: new CFPlus::UI::Button markup => $child->{c_tab}[0], tooltip => $child->{c_tab}[1];
		3988
		3989	$tab->connect (activate => sub {
		3990	$wself->set_current_page ($child);
		3991	});
		3992
		3993	$tab
		3994	};
		3995
		3996	$self->{buttonbar}->add ($child->{c_tab_});
		3997	}
		3998	});
		3999
		4000	$self->{multiplexer}->connect (c_remove => sub {
		4001	my ($mplex, $widgets) = @_;
		4002
		4003	for my $child (@$widgets) {
		4004	$wself->{buttonbar}->remove ($child->{c_tab_});
		4005	}
		4006	});
		4007	}
		4008
		4009	$self
		4010	}
		4011
		4012	sub add {
		4013	my ($self, @widgets) = @_;
		4014
		4015	$self->{multiplexer}->add (@widgets)
		4016	}
		4017
		4018	sub remove {
		4019	my ($self, @widgets) = @_;
		4020
		4021	$self->{multiplexer}->remove (@widgets)
		4022	}
		4023
		4024	sub pages {
		4025	my ($self) = @_;
		4026	$self->{multiplexer}->children
		4027	}
		4028
		4029	sub add_tab {
		4030	my ($self, $title, $widget, $tooltip) = @_;
		4031
		4032	$title = [$title, $tooltip] unless ref $title;
		4033	$widget->{c_tab} = $title;
		4034
		4035	$self->add ($widget);
		4036	}
		4037
		4038	sub get_current_page {
		4039	my ($self) = @_;
		4040
		4041	$self->{multiplexer}->get_current_page
		4042	}
		4043
		4044	sub set_current_page {
		4045	my ($self, $page) = @_;
		4046
		4047	$self->{multiplexer}->set_current_page ($page);
		4048	$self->emit (page_changed => $self->{multiplexer}{current});
		4049	}
		4050
		4051	sub _draw {
		4052	my ($self) = @_;
		4053
		4054	$self->SUPER::_draw ();
		4055
		4056	if (my $cur = $self->{multiplexer}{current}) {
		4057	if ($cur = $cur->{c_tab_}) {
		4058	glTranslate $self->{buttonbar}{x} + $cur->{x},
		4059	$self->{buttonbar}{y} + $cur->{y};
		4060	glLineWidth 3;
		4061	#glEnable GL_BLEND;
		4062	#glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
		4063	glColor @{$self->{active_outline}};
		4064	glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
		4065	glLineWidth 1;
		4066	#glDisable GL_BLEND;
		4067	}
		4068	}
		4069	}
		4070
		4071	#############################################################################
		4072
		4073	package CFPlus::UI::Selector;
		4074
		4075	use utf8;
		4076
		4077	our @ISA = CFPlus::UI::Button::;
		4078
		4079	sub new {
		4080	my $class = shift;
		4081
		4082	my $self = $class->SUPER::new (
		4083	options => [], # [value, title, longdesc], ...
		4084	value => undef,
		4085	@_,
		4086	);
		4087
		4088	$self->_set_value ($self->{value});
		4089
		4090	$self
		4091	}
		4092
		4093	sub invoke_button_down {
		4094	my ($self, $ev) = @_;
		4095
		4096	my @menu_items;
		4097
		4098	for (@{ $self->{options} }) {
		4099	my ($value, $title, $tooltip) = @$_;
		4100
		4101	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
		4102	}
		4103
		4104	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
		4105	}
		4106
		4107	sub _set_value {
		4108	my ($self, $value) = @_;
		4109
		4110	my ($item) = grep $_->[0] eq $value, @{ $self->{options} }
		4111	or return;
		4112
		4113	$self->{value} = $item->[0];
		4114	$self->set_markup ("$item->[1] ⇓");
		4115	$self->set_tooltip ($item->[2]);
		4116	}
		4117
		4118	sub set_value {
		4119	my ($self, $value) = @_;
		4120
		4121	return unless $self->{value} ne $value;
		4122
		4123	$self->_set_value ($value);
		4124	$self->emit (changed => $value);
		4125	}
		4126
		4127	#############################################################################
		4128
		4129	package CFPlus::UI::Statusbox;
		4130
		4131	our @ISA = CFPlus::UI::VBox::;
		4132
		4133	sub new {
		4134	my $class = shift;
		4135
		4136	my $self = $class->SUPER::new (
2867	fontsize => 0.8,	4137	fontsize => 0.8,
2868	@_,	4138	@_,
2869	)	4139	);
		4140
		4141	CFPlus::weaken (my $this = $self);
		4142
		4143	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
		4144
		4145	$self
2870	}	4146	}
2871		4147
2872	sub reorder {	4148	sub reorder {
2873	my ($self) = @_;	4149	my ($self) = @_;
2874	my $NOW = time;	4150	my $NOW = Time::HiRes::time;
		4151
		4152	# freeze display when hovering over any label
		4153	return if $CFPlus::UI::TOOLTIP->{owner}
		4154	&& grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
		4155	values %{ $self->{item} };
2875		4156
2876	while (my ($k, $v) = each %{ $self->{item} }) {	4157	while (my ($k, $v) = each %{ $self->{item} }) {
2877	delete $self->{item}{$k} if $v->{timeout} < $NOW;	4158	delete $self->{item}{$k} if $v->{timeout} < $NOW;
2878	}	4159	}
2879		4160
…		…
2882	my @items = sort {	4163	my @items = sort {
2883	$a->{pri} <=> $b->{pri}	4164	$a->{pri} <=> $b->{pri}
2884	or $b->{id} <=> $a->{id}	4165	or $b->{id} <=> $a->{id}
2885	} values %{ $self->{item} };	4166	} values %{ $self->{item} };
2886		4167
		4168	$self->{timer}->interval (1);
		4169
2887	my $count = 10 + 1;	4170	my $count = 10 + 1;
2888	for my $item (@items) {	4171	for my $item (@items) {
2889	last unless --$count;	4172	last unless --$count;
2890		4173
2891	push @widgets, $item->{label} ||= do {	4174	my $label = $item->{label} ||= do {
2892	# TODO: doesn't handle markup well (read as: at all)	4175	# TODO: doesn't handle markup well (read as: at all)
2893	my $short = $item->{count} > 1	4176	my $short = $item->{count} > 1
2894	? "<b>$item->{count} ×</b> $item->{text}"	4177	? "<b>$item->{count} ×</b> $item->{text}"
2895	: $item->{text};	4178	: $item->{text};
2896		4179
2897	for ($short) {	4180	for ($short) {
2898	s/^\s+//;	4181	s/^\s+//;
2899	s/\s+/ /g;	4182	s/\s+/ /g;
2900	}	4183	}
2901		4184
2902	new CFClient::UI::Label	4185	new CFPlus::UI::Label
2903	markup => $short,	4186	markup => $short,
2904	tooltip => $item->{tooltip},	4187	tooltip => $item->{tooltip},
2905	tooltip_font => $::FONT_PROP,	4188	tooltip_font => $::FONT_PROP,
2906	tooltip_width => 0.67,	4189	tooltip_width => 0.67,
2907	fontsize => $item->{fontsize} || $self->{fontsize},	4190	fontsize => $item->{fontsize} || $self->{fontsize},
2908	max_w => $::WIDTH * 0.44,	4191	max_w => $::WIDTH * 0.44,
2909	fg => $item->{fg},	4192	fg => [@{ $item->{fg} }],
2910	can_events => 1,	4193	can_events => 1,
2911	can_hover => 1	4194	can_hover => 1
2912	};	4195	};
		4196
		4197	if ((my $diff = $item->{timeout} - $NOW) < 2) {
		4198	$label->{fg}[3] = ($item->{fg}[3] || 1) * $diff / 2;
		4199	$label->update;
		4200	$label->set_max_size (undef, $label->{req_h} * $diff)
		4201	if $diff < 1;
		4202	$self->{timer}->interval (1/30);
		4203	} else {
		4204	$label->{fg}[3] = $item->{fg}[3] || 1;
		4205	}
		4206
		4207	push @widgets, $label;
2913	}	4208	}
2914		4209
2915	$self->clear;	4210	$self->clear;
2916	$self->SUPER::add (reverse @widgets);	4211	$self->SUPER::add (reverse @widgets);
2917	}	4212	}
…		…
2922	$text =~ s/^\s+//;	4217	$text =~ s/^\s+//;
2923	$text =~ s/\s+$//;	4218	$text =~ s/\s+$//;
2924		4219
2925	return unless $text;	4220	return unless $text;
2926		4221
2927	my $timeout = time + ((delete $arg{timeout}) || 60);	4222	my $timeout = (int time) + ((delete $arg{timeout}) || 60);
2928		4223
2929	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};	4224	my $group = exists $arg{group} ? $arg{group} : ++$self->{id};
2930		4225
2931	if (my $item = $self->{item}{$group}) {	4226	if (my $item = $self->{item}{$group}) {
2932	if ($item->{text} eq $text) {	4227	if ($item->{text} eq $text) {
2933	$item->{count}++;	4228	$item->{count}++;
2934	} else {	4229	} else {
2935	$item->{count} = 1;	4230	$item->{count} = 1;
2936	$item->{text} = $item->{tooltip} = $text;	4231	$item->{text} = $item->{tooltip} = $text;
2937	}	4232	}
2938	$item->{id} = ++$self->{id};	4233	$item->{id} += 0.2;#d#
2939	$item->{timeout} = $timeout;	4234	$item->{timeout} = $timeout;
2940	delete $item->{label};	4235	delete $item->{label};
2941	} else {	4236	} else {
2942	$self->{item}{$group} = {	4237	$self->{item}{$group} = {
2943	id => ++$self->{id},	4238	id => ++$self->{id},
…		…
2949	count => 1,	4244	count => 1,
2950	%arg,	4245	%arg,
2951	};	4246	};
2952	}	4247	}
2953		4248
		4249	$ROOT->on_refresh (reorder => sub {
2954	$self->reorder;	4250	$self->reorder;
		4251	});
2955	}	4252	}
2956		4253
2957	sub reconfigure {	4254	sub reconfigure {
2958	my ($self) = @_;	4255	my ($self) = @_;
2959		4256
…		…
2962		4259
2963	$self->reorder;	4260	$self->reorder;
2964	$self->SUPER::reconfigure;	4261	$self->SUPER::reconfigure;
2965	}	4262	}
2966		4263
		4264	sub destroy {
		4265	my ($self) = @_;
		4266
		4267	$self->{timer}->cancel;
		4268
		4269	$self->SUPER::destroy;
		4270	}
		4271
2967	#############################################################################	4272	#############################################################################
2968		4273
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;	4274	package CFPlus::UI::Root;
3261		4275
3262	our @ISA = CFClient::UI::Container::;	4276	our @ISA = CFPlus::UI::Container::;
3263		4277
		4278	use List::Util qw(min max);
		4279
3264	use CFClient::OpenGL;	4280	use CFPlus::OpenGL;
3265		4281
3266	sub new {	4282	sub new {
3267	my $class = shift;	4283	my $class = shift;
3268		4284
3269	my $self = $class->SUPER::new (	4285	my $self = $class->SUPER::new (
3270	visible => 1,	4286	visible => 1,
3271	@_,	4287	@_,
3272	);	4288	);
3273		4289
3274	Scalar::Util::weaken ($self->{root} = $self);	4290	CFPlus::weaken ($self->{root} = $self);
3275		4291
3276	$self	4292	$self
3277	}	4293	}
3278		4294
3279	sub size_request {	4295	sub size_request {
…		…
3294	$coord = $max - $size if $coord > $max - $size;	4310	$coord = $max - $size if $coord > $max - $size;
3295		4311
3296	int $coord + 0.5	4312	int $coord + 0.5
3297	}	4313	}
3298		4314
3299	sub size_allocate {	4315	sub invoke_size_allocate {
3300	my ($self, $w, $h) = @_;	4316	my ($self, $w, $h) = @_;
3301		4317
3302	for my $child ($self->children) {	4318	for my $child ($self->children) {
3303	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};	4319	my ($X, $Y, $W, $H) = @$child{qw(x y req_w req_h)};
3304		4320
…		…
3308	$X = _to_pixel $X, $W, $self->{w};	4324	$X = _to_pixel $X, $W, $self->{w};
3309	$Y = _to_pixel $Y, $H, $self->{h};	4325	$Y = _to_pixel $Y, $H, $self->{h};
3310		4326
3311	$child->configure ($X, $Y, $W, $H);	4327	$child->configure ($X, $Y, $W, $H);
3312	}	4328	}
		4329
		4330	1
3313	}	4331	}
3314		4332
3315	sub coord2local {	4333	sub coord2local {
3316	my ($self, $x, $y) = @_;	4334	my ($self, $x, $y) = @_;
3317		4335
…		…
3325	}	4343	}
3326		4344
3327	sub update {	4345	sub update {
3328	my ($self) = @_;	4346	my ($self) = @_;
3329		4347
3330	$::WANT_REFRESH++;	4348	$::WANT_REFRESH->start;
3331	}	4349	}
3332		4350
3333	sub add {	4351	sub add {
3334	my ($self, @children) = @_;	4352	my ($self, @children) = @_;
3335		4353
…		…
3372	while ($self->{refresh_hook}) {	4390	while ($self->{refresh_hook}) {
3373	$_->()	4391	$_->()
3374	for values %{delete $self->{refresh_hook}};	4392	for values %{delete $self->{refresh_hook}};
3375	}	4393	}
3376		4394
3377	if ($self->{realloc}) {	4395	while ($self->{realloc}) {
3378	my %queue;	4396	my %queue;
3379	my @queue;	4397	my @queue;
3380	my $widget;	4398	my $widget;
3381		4399
3382	outer:	4400	outer:
…		…
3402		4420
3403	delete $queue{$widget+0};	4421	delete $queue{$widget+0};
3404		4422
3405	my ($w, $h) = $widget->size_request;	4423	my ($w, $h) = $widget->size_request;
3406		4424
3407	$w = List::Util::max $widget->{min_w}, $w + $widget->{padding_x} * 2;	4425	$w = max $widget->{min_w}, $w + $widget->{padding_x} * 2;
3408	$h = List::Util::max $widget->{min_h}, $h + $widget->{padding_y} * 2;	4426	$h = max $widget->{min_h}, $h + $widget->{padding_y} * 2;
		4427
		4428	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		4429	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
3409		4430
3410	$w = $widget->{force_w} if exists $widget->{force_w};	4431	$w = $widget->{force_w} if exists $widget->{force_w};
3411	$h = $widget->{force_h} if exists $widget->{force_h};	4432	$h = $widget->{force_h} if exists $widget->{force_h};
3412		4433
3413	if ($widget->{req_w} != $w || $widget->{req_h} != $h	4434	if ($widget->{req_w} != $w || $widget->{req_h} != $h
…		…
3426	}	4447	}
3427	}	4448	}
3428		4449
3429	delete $self->{realloc}{$widget+0};	4450	delete $self->{realloc}{$widget+0};
3430	}	4451	}
3431	}
3432		4452
3433	while (my $size_alloc = delete $self->{size_alloc}) {	4453	while (my $size_alloc = delete $self->{size_alloc}) {
3434	my @queue = sort { $b->{visible} <=> $a->{visible} }	4454	my @queue = sort { $a->{visible} <=> $b->{visible} }
3435	values %$size_alloc;	4455	values %$size_alloc;
3436		4456
3437	while () {	4457	while () {
3438	my $widget = pop @queue || last;	4458	my $widget = pop @queue || last;
3439		4459
3440	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	4460	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3441		4461
3442	$w = 0 if $w < 0;	4462	$w = max $widget->{min_w}, $w;
3443	$h = 0 if $h < 0;	4463	$h = max $widget->{min_h}, $h;
3444		4464
		4465	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		4466	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		4467
		4468	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		4469	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		4470
3445	$w = int $w + 0.5;	4471	$w = int $w + 0.5;
3446	$h = int $h + 0.5;	4472	$h = int $h + 0.5;
3447		4473
3448	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	4474	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3449	$widget->{old_w} = $widget->{w};	4475	$widget->{old_w} = $widget->{w};
3450	$widget->{old_h} = $widget->{h};	4476	$widget->{old_h} = $widget->{h};
3451		4477
3452	$widget->{w} = $w;	4478	$widget->{w} = $w;
3453	$widget->{h} = $h;	4479	$widget->{h} = $h;
3454		4480
3455	$widget->emit (size_allocate => $w, $h);	4481	$widget->emit (size_allocate => $w, $h);
		4482	}
3456	}	4483	}
3457	}	4484	}
3458	}	4485	}
3459		4486
3460	while ($self->{post_alloc_hook}) {	4487	while ($self->{post_alloc_hook}) {
3461	$_->()	4488	$_->()
3462	for values %{delete $self->{post_alloc_hook}};	4489	for values %{delete $self->{post_alloc_hook}};
3463	}	4490	}
3464
3465		4491
3466	glViewport 0, 0, $::WIDTH, $::HEIGHT;	4492	glViewport 0, 0, $::WIDTH, $::HEIGHT;
3467	glClearColor +($::CFG->{fow_intensity}) x 3, 1;	4493	glClearColor +($::CFG->{fow_intensity}) x 3, 1;
3468	glClear GL_COLOR_BUFFER_BIT;	4494	glClear GL_COLOR_BUFFER_BIT;
3469		4495
…		…
3471	glLoadIdentity;	4497	glLoadIdentity;
3472	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4498	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3473	glMatrixMode GL_MODELVIEW;	4499	glMatrixMode GL_MODELVIEW;
3474	glLoadIdentity;	4500	glLoadIdentity;
3475		4501
		4502	{
		4503	package CFPlus::UI::Base;
		4504
		4505	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		4506	(0, 0, $self->{w}, $self->{h});
		4507
3476	$self->_draw;	4508	$self->_draw;
		4509	}
3477	}	4510	}
3478		4511
3479	#############################################################################	4512	#############################################################################
3480		4513
3481	package CFClient::UI;	4514	package CFPlus::UI;
3482		4515
3483	$ROOT = new CFClient::UI::Root;	4516	$ROOT = new CFPlus::UI::Root;
3484	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4517	$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
3485		4518
3486	1	4519	1
3487		4520

Diff Legend

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