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

Diff Legend

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