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.272 by root, Sat Jun 3 01:47:14 2006 UTC vs.
Revision 1.442 by root, Mon Oct 8 17:01:03 2007 UTC

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

Diff Legend

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