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

Diff Legend

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