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.309 by elmex, Wed Jun 21 12:59:23 2006 UTC vs.
Revision 1.367 by root, Fri Apr 27 00:59:14 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) {
98		116	if ($ev->{button} == 4 || $ev->{button} == 5) {
99	$GRAB->emit (button_down => $ev, $GRAB->coord2local ($x, $y))	117	# mousewheel
100	if $GRAB;	118	$ev->{dx} = 0;
		119	$ev->{dy} = $ev->{button} * 2 - 9;
		120	$GRAB->emit (mouse_wheel => $ev);
		121	} else {
		122	$GRAB->emit (button_down => $ev)
		123	}
		124	}
101	}	125	}
102		126
103	sub feed_sdl_button_up_event {	127	sub feed_sdl_button_up_event {
104	my ($ev) = @_;	128	my ($ev) = @_;
105	my ($x, $y) = ($ev->{x}, $ev->{y});
106		129
107	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	130	my $widget = $GRAB || $ROOT->find_widget ($ev->{x}, $ev->{y});
108		131
109	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));	132	$BUTTON_STATE &= ~(1 << ($ev->{button} - 1));
110		133
111	$GRAB->emit (button_up => $ev, $GRAB->coord2local ($x, $y))	134	$GRAB->emit (button_up => $ev)
112	if $GRAB;	135	if $GRAB && $ev->{button} != 4 && $ev->{button} != 5;
113		136
114	if (!$BUTTON_STATE) {	137	unless ($BUTTON_STATE) {
115	my $grab = $GRAB; undef $GRAB;	138	my $grab = $GRAB; undef $GRAB;
116	$grab->update if $grab;	139	$grab->update if $grab;
117	$GRAB->update if $GRAB;	140	$GRAB->update if $GRAB;
118		141
		142	check_hover $widget;
119	$TOOLTIP_WATCHER->cb->();	143	$TOOLTIP_WATCHER->cb->();
120	}	144	}
121	}	145	}
122		146
123	sub feed_sdl_motion_event {	147	sub feed_sdl_motion_event {
124	my ($ev) = @_;	148	my ($ev) = @_;
125	my ($x, $y) = ($ev->{x}, $ev->{y});	149	my ($x, $y) = ($ev->{x}, $ev->{y});
126		150
127	my $widget = $GRAB || $ROOT->find_widget ($x, $y);	151	my $widget = $GRAB || $ROOT->find_widget ($x, $y);
128		152
129	if ($widget != $HOVER) {	153	check_hover $widget;
130	my $hover = $HOVER; $HOVER = $widget;
131		154
132	$hover->update if $hover && $hover->{can_hover};	155	$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;	156	if $HOVER;
140	}	157	}
141		158
142	# convert position array to integers	159	# convert position array to integers
143	sub harmonize {	160	sub harmonize {
…		…
193	reconfigure_widgets;	210	reconfigure_widgets;
194	}	211	}
195		212
196	#############################################################################	213	#############################################################################
197		214
		215	package CFPlus::UI::Event;
		216
		217	sub xy {
		218	$_[1]->coord2local ($_[0]{x}, $_[0]{y})
		219	}
		220
		221	#############################################################################
		222
198	package CFClient::UI::Base;	223	package CFPlus::UI::Base;
199		224
200	use strict;	225	use strict;
201		226
202	use CFClient::OpenGL;	227	use CFPlus::OpenGL;
203		228
204	sub new {	229	sub new {
205	my $class = shift;	230	my $class = shift;
206		231
207	my $self = bless {	232	my $self = bless {
…		…
212	h => undef,	237	h => undef,
213	can_events => 1,	238	can_events => 1,
214	@_	239	@_
215	}, $class;	240	}, $class;
216		241
217	Scalar::Util::weaken ($CFClient::UI::WIDGET{$self+0} = $self);	242	CFPlus::weaken ($CFPlus::UI::WIDGET{$self+0} = $self);
218		243
219	for (keys %$self) {	244	for (keys %$self) {
220	if (/^on_(.*)$/) {	245	if (/^on_(.*)$/) {
221	$self->connect ($1 => delete $self->{$_});	246	$self->connect ($1 => delete $self->{$_});
222	}	247	}
223	}	248	}
224		249
225	if (my $layout = $CFClient::UI::LAYOUT->{$self->{name}}) {	250	if (my $layout = $CFPlus::UI::LAYOUT->{$self->{name}}) {
226	$self->{x} = $layout->{x} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{x};	251	$self->{x} = $layout->{x} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{x};
227	$self->{y} = $layout->{y} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{y};	252	$self->{y} = $layout->{y} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{y};
228	$self->{force_w} = $layout->{w} * $CFClient::UI::ROOT->{alloc_w} if exists $layout->{w};	253	$self->{force_w} = $layout->{w} * $CFPlus::UI::ROOT->{alloc_w} if exists $layout->{w};
229	$self->{force_h} = $layout->{h} * $CFClient::UI::ROOT->{alloc_h} if exists $layout->{h};	254	$self->{force_h} = $layout->{h} * $CFPlus::UI::ROOT->{alloc_h} if exists $layout->{h};
230		255
231	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};	256	$self->{x} -= $self->{force_w} * 0.5 if exists $layout->{x};
232	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};	257	$self->{y} -= $self->{force_h} * 0.5 if exists $layout->{y};
233		258
234	$self->show if $layout->{show};	259	$self->show if $layout->{show};
…		…
239		264
240	sub destroy {	265	sub destroy {
241	my ($self) = @_;	266	my ($self) = @_;
242		267
243	$self->hide;	268	$self->hide;
		269	$self->emit ("destroy");
244	%$self = ();	270	%$self = ();
245	}	271	}
246		272
247	sub show {	273	sub show {
248	my ($self) = @_;	274	my ($self) = @_;
249		275
250	return if $self->{parent};	276	return if $self->{parent};
251		277
252	$CFClient::UI::ROOT->add ($self);	278	$CFPlus::UI::ROOT->add ($self);
253	}	279	}
254		280
255	sub set_visible {	281	sub set_visible {
256	my ($self) = @_;	282	my ($self) = @_;
257		283
…		…
278	delete $self->{root};	304	delete $self->{root};
279		305
280	undef $GRAB if $GRAB == $self;	306	undef $GRAB if $GRAB == $self;
281	undef $HOVER if $HOVER == $self;	307	undef $HOVER if $HOVER == $self;
282		308
283	$CFClient::UI::TOOLTIP_WATCHER->cb->()	309	$CFPlus::UI::TOOLTIP_WATCHER->cb->()
284	if $TOOLTIP->{owner} == $self;	310	if $TOOLTIP->{owner} == $self;
285		311
286	$self->emit ("focus_out");	312	$self->emit ("focus_out");
287	$self->emit (visibility_change => 0);	313	$self->emit (visibility_change => 0);
288	}	314	}
…		…
335	sub size_request {	361	sub size_request {
336	require Carp;	362	require Carp;
337	Carp::confess "size_request is abstract";	363	Carp::confess "size_request is abstract";
338	}	364	}
339		365
		366	sub baseline_shift {
		367	0
		368	}
		369
340	sub configure {	370	sub configure {
341	my ($self, $x, $y, $w, $h) = @_;	371	my ($self, $x, $y, $w, $h) = @_;
342		372
343	if ($self->{aspect}) {	373	if ($self->{aspect}) {
344	my ($ow, $oh) = ($w, $h);	374	my ($ow, $oh) = ($w, $h);
345		375
346	$w = List::Util::min $w, int $h * $self->{aspect};	376	$w = List::Util::min $w, CFPlus::ceil $h * $self->{aspect};
347	$h = List::Util::min $h, int $w / $self->{aspect};	377	$h = List::Util::min $h, CFPlus::ceil $w / $self->{aspect};
348		378
349	# use alignment to adjust x, y	379	# use alignment to adjust x, y
350		380
351	$x += int 0.5 * ($ow - $w);	381	$x += int 0.5 * ($ow - $w);
352	$y += int 0.5 * ($oh - $h);	382	$y += int 0.5 * ($oh - $h);
…		…
393		423
394	return if $self->{tooltip} eq $tooltip;	424	return if $self->{tooltip} eq $tooltip;
395		425
396	$self->{tooltip} = $tooltip;	426	$self->{tooltip} = $tooltip;
397		427
398	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	428	if ($CFPlus::UI::TOOLTIP->{owner} == $self) {
399	delete $CFClient::UI::TOOLTIP->{owner};	429	delete $CFPlus::UI::TOOLTIP->{owner};
400	$CFClient::UI::TOOLTIP_WATCHER->cb->();	430	$CFPlus::UI::TOOLTIP_WATCHER->cb->();
401	}	431	}
402	}	432	}
403		433
404	# translate global coordinates to local coordinate system	434	# translate global coordinates to local coordinate system
405	sub coord2local {	435	sub coord2local {
406	my ($self, $x, $y) = @_;	436	my ($self, $x, $y) = @_;
407		437
		438	Carp::confess unless $self->{parent};#d#
		439
408	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})	440	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
409	}	441	}
410		442
411	# translate local coordinates to global coordinate system	443	# translate local coordinates to global coordinate system
412	sub coord2global {	444	sub coord2global {
413	my ($self, $x, $y) = @_;	445	my ($self, $x, $y) = @_;
414		446
		447	Carp::confess unless $self->{parent};#d#
		448
415	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	449	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
416	}	450	}
417		451
418	sub invoke_focus_in {	452	sub invoke_focus_in {
419	my ($self) = @_;	453	my ($self) = @_;
420		454
421	return if $FOCUS == $self;	455	return if $FOCUS == $self;
422	return unless $self->{can_focus};	456	return unless $self->{can_focus};
423		457
424	my $focus = $FOCUS; $FOCUS = $self;	458	$FOCUS = $self;
425		459
426	$focus->update if $focus;	460	$self->update;
427	$FOCUS->update;
428		461
429	0	462	0
430	}	463	}
431		464
432	sub invoke_focus_out {	465	sub invoke_focus_out {
433	my ($self) = @_;	466	my ($self) = @_;
434		467
435	return unless $FOCUS == $self;	468	return unless $FOCUS == $self;
436		469
437	my $focus = $FOCUS; undef $FOCUS;	470	undef $FOCUS;
438		471
439	$focus->update if $focus; #?	472	$self->update;
440		473
441	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus	474	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
442	unless $FOCUS;	475	unless $FOCUS;
443		476
444	0	477	0
445	}	478	}
446		479
447	sub grab_focus {	480	sub grab_focus {
448	my ($self) = @_;	481	my ($self) = @_;
449		482
		483	$FOCUS->emit ("focus_out") if $FOCUS;
450	$self->emit ("focus_in");	484	$self->emit ("focus_in");
451	}	485	}
452		486
453	sub invoke_mouse_motion { 1 }	487	sub invoke_mouse_motion { 0 }
454	sub invoke_button_up { 1 }	488	sub invoke_button_up { 0 }
455	sub invoke_key_down { 1 }	489	sub invoke_key_down { 0 }
456	sub invoke_key_up { 1 }	490	sub invoke_key_up { 0 }
		491	sub invoke_mouse_wheel { 0 }
457		492
458	sub invoke_button_down {	493	sub invoke_button_down {
459	my ($self, $ev, $x, $y) = @_;	494	my ($self, $ev, $x, $y) = @_;
460		495
461	$self->grab_focus;	496	$self->grab_focus;
462		497
463	1	498	0
464	}	499	}
465		500
466	sub connect {	501	sub connect {
467	my ($self, $signal, $cb) = @_;	502	my ($self, $signal, $cb) = @_;
468		503
469	push @{ $self->{signal_cb}{$signal} }, $cb;	504	push @{ $self->{signal_cb}{$signal} }, $cb;
		505
		506	defined wantarray and CFPlus::guard {
		507	@{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
		508	@{ $self->{signal_cb}{$signal} };
		509	}
470	}	510	}
		511
		512	sub disconnect_all {
		513	my ($self, $signal) = @_;
		514
		515	delete $self->{signal_cb}{$signal};
		516	}
		517
		518	my %has_coords = (
		519	button_down => 1,
		520	button_up => 1,
		521	mouse_motion => 1,
		522	mouse_wheel => 1,
		523	);
471		524
472	sub emit {	525	sub emit {
473	my ($self, $signal, @args) = @_;	526	my ($self, $signal, @args) = @_;
474		527
475	#d##TODO# stop propagating at first true, do not use sum	528	# I do not really like this solution, but I do not like duplication
476	(List::Util::sum map $_->($self, @args), @{$self->{signal_cb}{$signal} || []}) # before	529	# and needlessly verbose code, either.
		530	my @append
		531	= $has_coords{$signal}
		532	? $args[0]->xy ($self)
		533	: ();
		534
		535	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		536
		537	for my $cb (
		538	@{$self->{signal_cb}{$signal} || []}, # before
477	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure	539	($self->can ("invoke_$signal") || sub { 1 }), # closure
		540	) {
		541	return $cb->($self, @args, @append) || next;
		542	}
		543
		544	# parent
478	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent	545	$self->{parent} && $self->{parent}->emit ($signal, @args)
479	}	546	}
480		547
481	sub find_widget {	548	sub find_widget {
482	my ($self, $x, $y) = @_;	549	my ($self, $x, $y) = @_;
483		550
…		…
491	}	558	}
492		559
493	sub set_parent {	560	sub set_parent {
494	my ($self, $parent) = @_;	561	my ($self, $parent) = @_;
495		562
496	Scalar::Util::weaken ($self->{parent} = $parent);	563	CFPlus::weaken ($self->{parent} = $parent);
497	$self->set_visible if $parent->{visible};	564	$self->set_visible if $parent->{visible};
498	}	565	}
499		566
500	sub realloc {	567	sub realloc {
501	my ($self) = @_;	568	my ($self) = @_;
…		…
535	return unless $self->{h} && $self->{w};	602	return unless $self->{h} && $self->{w};
536		603
537	# update screen rectangle	604	# update screen rectangle
538	local $draw_x = $draw_x + $self->{x};	605	local $draw_x = $draw_x + $self->{x};
539	local $draw_y = $draw_y + $self->{y};	606	local $draw_y = $draw_y + $self->{y};
540	local $draw_w = $draw_x + $self->{w};
541	local $draw_h = $draw_y + $self->{h};
542		607
543	# skip widgets that are entirely outside the drawing area	608	# skip widgets that are entirely outside the drawing area
544	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)	609	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
545	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);	610	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
546		611
…		…
569	glVertex $self->{w} - 1, 0;	634	glVertex $self->{w} - 1, 0;
570	glVertex $self->{w} - 1, $self->{h} - 1;	635	glVertex $self->{w} - 1, $self->{h} - 1;
571	glVertex 0 , $self->{h} - 1;	636	glVertex 0 , $self->{h} - 1;
572	glEnd;	637	glEnd;
573	glPopMatrix;	638	glPopMatrix;
574	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	639	#CFPlus::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
575	}	640	}
576		641
577	$self->_draw;	642	$self->_draw;
578	glPopMatrix;	643	glPopMatrix;
579	}	644	}
…		…
582	my ($self) = @_;	647	my ($self) = @_;
583		648
584	warn "no draw defined for $self\n";	649	warn "no draw defined for $self\n";
585	}	650	}
586		651
		652	my $cntx;#d#
587	sub DESTROY {	653	sub DESTROY {
588	my ($self) = @_;	654	my ($self) = @_;
589		655
590	delete $WIDGET{$self+0};	656	return if CFPlus::in_destruct;
591		657
592	eval { $self->destroy };	658	eval { $self->destroy };
593	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;	659	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
		660
		661	delete $WIDGET{$self+0};
594	}	662	}
595		663
596	#############################################################################	664	#############################################################################
597		665
598	package CFClient::UI::DrawBG;	666	package CFPlus::UI::DrawBG;
599		667
600	our @ISA = CFClient::UI::Base::;	668	our @ISA = CFPlus::UI::Base::;
601		669
602	use strict;	670	use strict;
603	use CFClient::OpenGL;	671	use CFPlus::OpenGL;
604		672
605	sub new {	673	sub new {
606	my $class = shift;	674	my $class = shift;
607		675
608	# range [value, low, high, page]	676	# range [value, low, high, page]
…		…
639	}	707	}
640	}	708	}
641		709
642	#############################################################################	710	#############################################################################
643		711
644	package CFClient::UI::Empty;	712	package CFPlus::UI::Empty;
645		713
646	our @ISA = CFClient::UI::Base::;	714	our @ISA = CFPlus::UI::Base::;
647		715
648	sub new {	716	sub new {
649	my ($class, %arg) = @_;	717	my ($class, %arg) = @_;
650	$class->SUPER::new (can_events => 0, %arg);	718	$class->SUPER::new (can_events => 0, %arg);
651	}	719	}
…		…
658		726
659	sub draw { }	727	sub draw { }
660		728
661	#############################################################################	729	#############################################################################
662		730
663	package CFClient::UI::Container;	731	package CFPlus::UI::Container;
664		732
665	our @ISA = CFClient::UI::Base::;	733	our @ISA = CFPlus::UI::Base::;
666		734
667	sub new {	735	sub new {
668	my ($class, %arg) = @_;	736	my ($class, %arg) = @_;
669		737
670	my $children = delete $arg{children};	738	my $children = delete $arg{children};
…		…
679	if $children;	747	if $children;
680		748
681	$self	749	$self
682	}	750	}
683		751
		752	sub realloc {
		753	my ($self) = @_;
		754
		755	$self->{force_realloc} = 1;
		756	$self->{force_size_alloc} = 1;
		757	$self->SUPER::realloc;
		758	}
		759
684	sub add {	760	sub add {
685	my ($self, @widgets) = @_;	761	my ($self, @widgets) = @_;
686		762
687	$_->set_parent ($self)	763	$_->set_parent ($self)
688	for @widgets;	764	for @widgets;
…		…
748	$_->draw for @{$self->{children}};	824	$_->draw for @{$self->{children}};
749	}	825	}
750		826
751	#############################################################################	827	#############################################################################
752		828
753	package CFClient::UI::Bin;	829	package CFPlus::UI::Bin;
754		830
755	our @ISA = CFClient::UI::Container::;	831	our @ISA = CFPlus::UI::Container::;
756		832
757	sub new {	833	sub new {
758	my ($class, %arg) = @_;	834	my ($class, %arg) = @_;
759		835
760	my $child = (delete $arg{child}) || new CFClient::UI::Empty::;	836	my $child = (delete $arg{child}) || new CFPlus::UI::Empty::;
761		837
762	$class->SUPER::new (children => [$child], %arg)	838	$class->SUPER::new (children => [$child], %arg)
763	}	839	}
764		840
765	sub add {	841	sub add {
…		…
772	sub remove {	848	sub remove {
773	my ($self, $widget) = @_;	849	my ($self, $widget) = @_;
774		850
775	$self->SUPER::remove ($widget);	851	$self->SUPER::remove ($widget);
776		852
777	$self->{children} = [new CFClient::UI::Empty]	853	$self->{children} = [new CFPlus::UI::Empty]
778	unless @{$self->{children}};	854	unless @{$self->{children}};
779	}	855	}
780		856
781	sub child { $_[0]->{children}[0] }	857	sub child { $_[0]->{children}[0] }
782		858
…		…
794		870
795	#############################################################################	871	#############################################################################
796		872
797	# back-buffered drawing area	873	# back-buffered drawing area
798		874
799	package CFClient::UI::Window;	875	package CFPlus::UI::Window;
800		876
801	our @ISA = CFClient::UI::Bin::;	877	our @ISA = CFPlus::UI::Bin::;
802		878
803	use CFClient::OpenGL;	879	use CFPlus::OpenGL;
804		880
805	sub new {	881	sub new {
806	my ($class, %arg) = @_;	882	my ($class, %arg) = @_;
807		883
808	my $self = $class->SUPER::new (%arg);	884	my $self = $class->SUPER::new (%arg);
…		…
830	}	906	}
831		907
832	sub render_child {	908	sub render_child {
833	my ($self) = @_;	909	my ($self) = @_;
834		910
835	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	911	$self->{texture} = new_from_opengl CFPlus::Texture $self->{w}, $self->{h}, sub {
836	glClearColor 0, 0, 0, 0;	912	glClearColor 0, 0, 0, 0;
837	glClear GL_COLOR_BUFFER_BIT;	913	glClear GL_COLOR_BUFFER_BIT;
838		914
839	{	915	{
840	package CFClient::UI::Base;	916	package CFPlus::UI::Base;
841		917
842	($draw_x, $draw_y, $draw_w, $draw_h) =	918	local ($draw_x, $draw_y, $draw_w, $draw_h) =
843	(0, 0, $self->{w}, $self->{h});	919	(0, 0, $self->{w}, $self->{h});
		920
		921	$self->_render;
844	}	922	}
845
846	$self->_render;
847	};	923	};
848	}	924	}
849		925
850	sub _draw {	926	sub _draw {
851	my ($self) = @_;	927	my ($self) = @_;
852
853	my ($w, $h) = @$self{qw(w h)};
854		928
855	my $tex = $self->{texture}	929	my $tex = $self->{texture}
856	or return;	930	or return;
857		931
858	glEnable GL_TEXTURE_2D;	932	glEnable GL_TEXTURE_2D;
859	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	933	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
860	glColor 0, 0, 0, 1;	934	glColor 0, 0, 0, 1;
861		935
862	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	936	$tex->draw_quad_alpha_premultiplied (0, 0);
863		937
864	glDisable GL_TEXTURE_2D;	938	glDisable GL_TEXTURE_2D;
865	}	939	}
866		940
867	#############################################################################	941	#############################################################################
868		942
869	package CFClient::UI::ViewPort;	943	package CFPlus::UI::ViewPort;
870		944
871	our @ISA = CFClient::UI::Window::;	945	our @ISA = CFPlus::UI::Window::;
872		946
873	sub new {	947	sub new {
874	my $class = shift;	948	my $class = shift;
875		949
876	$class->SUPER::new (	950	$class->SUPER::new (
…		…
936	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}	1010	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
937	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}	1011	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
938	) {	1012	) {
939	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})	1013	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
940	} else {	1014	} else {
941	$self->CFClient::UI::Base::find_widget ($x, $y)	1015	$self->CFPlus::UI::Base::find_widget ($x, $y)
942	}	1016	}
943	}	1017	}
944		1018
945	sub _render {	1019	sub _render {
946	my ($self) = @_;	1020	my ($self) = @_;
947		1021
948	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};	1022	local $CFPlus::UI::Base::draw_x = $CFPlus::UI::Base::draw_x - $self->{view_x};
949	local $CFClient::UI::Base::draw_y = $CFClient::UI::Base::draw_y - $self->{view_y};	1023	local $CFPlus::UI::Base::draw_y = $CFPlus::UI::Base::draw_y - $self->{view_y};
950		1024
951	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	1025	CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
952		1026
953	$self->SUPER::_render;	1027	$self->SUPER::_render;
954	}	1028	}
955		1029
956	#############################################################################	1030	#############################################################################
957		1031
958	package CFClient::UI::ScrolledWindow;	1032	package CFPlus::UI::ScrolledWindow;
959		1033
960	our @ISA = CFClient::UI::HBox::;	1034	our @ISA = CFPlus::UI::HBox::;
961		1035
962	sub new {	1036	sub new {
963	my ($class, %arg) = @_;	1037	my ($class, %arg) = @_;
964		1038
965	my $child = delete $arg{child};	1039	my $child = delete $arg{child};
966		1040
967	my $self;	1041	my $self;
968		1042
969	my $slider = new CFClient::UI::Slider	1043	my $slider = new CFPlus::UI::Slider
970	vertical => 1,	1044	vertical => 1,
971	range => [0, 0, 1, 0.01], # HACK fix	1045	range => [0, 0, 1, 0.01], # HACK fix
972	on_changed => sub {	1046	on_changed => sub {
973	$self->{vp}->set_offset (0, $_[1]);	1047	$self->{vp}->set_offset (0, $_[1]);
974	},	1048	},
975	;	1049	;
976		1050
977	$self = $class->SUPER::new (	1051	$self = $class->SUPER::new (
978	vp => (new CFClient::UI::ViewPort expand => 1),	1052	vp => (new CFPlus::UI::ViewPort expand => 1),
		1053	can_events => 1,
979	slider => $slider,	1054	slider => $slider,
980	%arg,	1055	%arg,
981	);	1056	);
982		1057
983	$self->SUPER::add ($self->{vp}, $self->{slider});	1058	$self->SUPER::add ($self->{vp}, $self->{slider});
984	$self->add ($child) if $child;	1059	$self->add ($child) if $child;
985		1060
986	$self	1061	$self
987	}	1062	}
988		1063
		1064	#TODO# update range on size_allocate depending on child
		1065
989	sub add {	1066	sub add {
990	my ($self, $widget) = @_;	1067	my ($self, $widget) = @_;
991		1068
992	$self->{vp}->add ($self->{child} = $widget);	1069	$self->{vp}->add ($self->{child} = $widget);
993	}	1070	}
994		1071
		1072	sub invoke_mouse_wheel {
		1073	my ($self, $ev) = @_;
		1074
		1075	return 0 unless $ev->{dy}; # only vertical movements
		1076
		1077	$self->{slider}->emit (mouse_wheel => $ev);
		1078
		1079	1
		1080	}
		1081
		1082	sub update_slider {
		1083	my ($self) = @_;
		1084
		1085	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $self->{vp}->child->{h}, $self->{vp}{h}, 1]);
		1086	}
		1087
995	sub update {	1088	sub update {
996	my ($self) = @_;	1089	my ($self) = @_;
997		1090
998	$self->SUPER::update;	1091	$self->SUPER::update;
999		1092
1000	# todo: overwrite size_allocate of child	1093	$self->update_slider;
1001	my $child = $self->{vp}->child;
1002	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1003	}	1094	}
1004		1095
1005	sub invoke_size_allocate {	1096	sub invoke_size_allocate {
1006	my ($self, $w, $h) = @_;	1097	my ($self, $w, $h) = @_;
1007		1098
1008	my $child = $self->{vp}->child;	1099	$self->update_slider;
1009	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1010		1100
1011	$self->SUPER::invoke_size_allocate ($w, $h)	1101	$self->SUPER::invoke_size_allocate ($w, $h)
1012	}	1102	}
1013		1103
1014	#TODO# update range on size_allocate depending on child
1015	# update viewport offset on scroll
1016
1017	#############################################################################	1104	#############################################################################
1018		1105
1019	package CFClient::UI::Frame;	1106	package CFPlus::UI::Frame;
1020		1107
1021	our @ISA = CFClient::UI::Bin::;	1108	our @ISA = CFPlus::UI::Bin::;
1022		1109
1023	use CFClient::OpenGL;	1110	use CFPlus::OpenGL;
1024		1111
1025	sub new {	1112	sub new {
1026	my $class = shift;	1113	my $class = shift;
1027		1114
1028	$class->SUPER::new (	1115	$class->SUPER::new (
…		…
1054	$self->SUPER::_draw;	1141	$self->SUPER::_draw;
1055	}	1142	}
1056		1143
1057	#############################################################################	1144	#############################################################################
1058		1145
1059	package CFClient::UI::FancyFrame;	1146	package CFPlus::UI::FancyFrame;
1060		1147
1061	our @ISA = CFClient::UI::Bin::;	1148	our @ISA = CFPlus::UI::Bin::;
1062		1149
1063	use CFClient::OpenGL;	1150	use CFPlus::OpenGL;
		1151
		1152	sub new {
		1153	my ($class, %arg) = @_;
		1154
		1155	if ((exists $arg{label}) && !ref $arg{label}) {
		1156	$arg{label} = new CFPlus::UI::Label
		1157	align => 1,
		1158	valign => 0,
		1159	text => $arg{label},
		1160	fontsize => ($arg{border} || 0.8) * 0.75;
		1161	}
		1162
		1163	my $self = $class->SUPER::new (
		1164	# label => "",
		1165	fg => [0.6, 0.3, 0.1],
		1166	border => 0.8,
		1167	style => 'single',
		1168	%arg,
		1169	);
		1170
		1171	$self
		1172	}
		1173
		1174	sub add {
		1175	my ($self, @widgets) = @_;
		1176
		1177	$self->SUPER::add (@widgets);
		1178	$self->CFPlus::UI::Container::add ($self->{label}) if $self->{label};
		1179	}
		1180
		1181	sub border {
		1182	int $_[0]{border} * $::FONTSIZE
		1183	}
		1184
		1185	sub size_request {
		1186	my ($self) = @_;
		1187
		1188	($self->{label_w}, undef) = $self->{label}->size_request
		1189	if $self->{label};
		1190
		1191	my ($w, $h) = $self->SUPER::size_request;
		1192
		1193	(
		1194	$w + $self->border * 2,
		1195	$h + $self->border * 2,
		1196	)
		1197	}
		1198
		1199	sub invoke_size_allocate {
		1200	my ($self, $w, $h) = @_;
		1201
		1202	my $border = $self->border;
		1203
		1204	$w -= List::Util::max 0, $border * 2;
		1205	$h -= List::Util::max 0, $border * 2;
		1206
		1207	if (my $label = $self->{label}) {
		1208	$label->{w} = List::Util::max 0, List::Util::min $self->{label_w}, $w - $border * 2;
		1209	$label->{h} = List::Util::min $h, $border;
		1210	$label->invoke_size_allocate ($label->{w}, $label->{h});
		1211	}
		1212
		1213	$self->child->configure ($border, $border, $w, $h);
		1214
		1215	1
		1216	}
		1217
		1218	sub _draw {
		1219	my ($self) = @_;
		1220
		1221	my $child = $self->{children}[0];
		1222
		1223	my $border = $self->border;
		1224	my ($w, $h) = ($self->{w}, $self->{h});
		1225
		1226	$child->draw;
		1227
		1228	glColor @{$self->{fg}};
		1229	glBegin GL_LINE_STRIP;
		1230	glVertex $border * 1.5 , $border * 0.5 + 0.5;
		1231	glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5;
		1232	glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
		1233	glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
		1234	glVertex $w - $border * 0.5 + 0.5, $border * 0.5 + 0.5;
		1235	glVertex $self->{label} ? $border * 2 + $self->{label}{w} : $border * 1.5, $border * 0.5 + 0.5;
		1236	glEnd;
		1237
		1238	if ($self->{label}) {
		1239	glTranslate $border * 2, 0;
		1240	$self->{label}->_draw;
		1241	}
		1242	}
		1243
		1244	#############################################################################
		1245
		1246	package CFPlus::UI::Toplevel;
		1247
		1248	our @ISA = CFPlus::UI::Bin::;
		1249
		1250	use CFPlus::OpenGL;
1064		1251
1065	my $bg =	1252	my $bg =
1066	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",	1253	new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png",
1067	mipmap => 1, wrap => 1;	1254	mipmap => 1, wrap => 1;
1068		1255
1069	my @border =	1256	my @border =
1070	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1257	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1071	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);	1258	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1072		1259
1073	sub new {	1260	sub new {
1074	my ($class, %arg) = @_;	1261	my ($class, %arg) = @_;
1075		1262
1076	my $self = $class->SUPER::new (	1263	my $self = $class->SUPER::new (
1077	bg => [1, 1, 1, 1],	1264	bg => [1, 1, 1, 1],
1078	border_bg => [1, 1, 1, 1],	1265	border_bg => [1, 1, 1, 1],
1079	border => 0.6,	1266	border => 0.6,
1080	can_events => 1,	1267	can_events => 1,
1081	min_w => 16,	1268	min_w => 64,
1082	min_h => 16,	1269	min_h => 32,
1083	%arg,	1270	%arg,
1084	);	1271	);
1085		1272
1086	$self->{title_widget} = new CFClient::UI::Label	1273	$self->{title_widget} = new CFPlus::UI::Label
1087	align => 0,	1274	align => 0,
1088	valign => 1,	1275	valign => 1,
1089	text => $self->{title},	1276	text => $self->{title},
1090	fontsize => $self->{border},	1277	fontsize => $self->{border},
1091	if exists $self->{title};	1278	if exists $self->{title};
1092		1279
1093	if ($self->{has_close_button}) {	1280	if ($self->{has_close_button}) {
1094	$self->{close_button} =	1281	$self->{close_button} =
1095	new CFClient::UI::ImageButton	1282	new CFPlus::UI::ImageButton
1096	image => 'x1_close.png',	1283	path => 'x1_close.png',
1097	on_activate => sub { $self->hide };	1284	on_activate => sub { $self->emit ("delete") };
1098		1285
1099	$self->CFClient::UI::Container::add ($self->{close_button});	1286	$self->CFPlus::UI::Container::add ($self->{close_button});
1100	}	1287	}
1101		1288
1102	$self	1289	$self
1103	}	1290	}
1104		1291
1105	sub add {	1292	sub add {
1106	my ($self, @widgets) = @_;	1293	my ($self, @widgets) = @_;
1107		1294
1108	$self->SUPER::add (@widgets);	1295	$self->SUPER::add (@widgets);
1109	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};	1296	$self->CFPlus::UI::Container::add ($self->{close_button}) if $self->{close_button};
1110	$self->CFClient::UI::Container::add ($self->{title_widget}) if $self->{title_widget};	1297	$self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1111	}	1298	}
1112		1299
1113	sub border {	1300	sub border {
1114	int $_[0]{border} * $::FONTSIZE	1301	int $_[0]{border} * $::FONTSIZE
1115	}	1302	}
…		…
1148	$self->child->configure ($border, $border, $w, $h);	1335	$self->child->configure ($border, $border, $w, $h);
1149		1336
1150	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)	1337	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1151	if $self->{close_button};	1338	if $self->{close_button};
1152		1339
		1340	1
		1341	}
		1342
		1343	sub invoke_delete {
		1344	my ($self) = @_;
		1345
		1346	$self->hide;
		1347
1153	1	1348	1
1154	}	1349	}
1155		1350
1156	sub invoke_button_down {	1351	sub invoke_button_down {
1157	my ($self, $ev, $x, $y) = @_;	1352	my ($self, $ev, $x, $y) = @_;
…		…
1215	$self->{motion}->($ev, $x, $y) if $self->{motion};	1410	$self->{motion}->($ev, $x, $y) if $self->{motion};
1216		1411
1217	! ! $self->{motion}	1412	! ! $self->{motion}
1218	}	1413	}
1219		1414
		1415	sub invoke_visibility_change {
		1416	my ($self, $visible) = @_;
		1417
		1418	delete $self->{motion} unless $visible;
		1419
		1420	0
		1421	}
		1422
1220	sub _draw {	1423	sub _draw {
1221	my ($self) = @_;	1424	my ($self) = @_;
1222		1425
1223	my $child = $self->{children}[0];	1426	my $child = $self->{children}[0];
1224		1427
…		…
1261	if $self->{close_button};	1464	if $self->{close_button};
1262	}	1465	}
1263		1466
1264	#############################################################################	1467	#############################################################################
1265		1468
1266	package CFClient::UI::Table;	1469	package CFPlus::UI::Table;
1267		1470
1268	our @ISA = CFClient::UI::Base::;	1471	our @ISA = CFPlus::UI::Base::;
1269		1472
1270	use List::Util qw(max sum);	1473	use List::Util qw(max sum);
1271		1474
1272	use CFClient::OpenGL;	1475	use CFPlus::OpenGL;
1273		1476
1274	sub new {	1477	sub new {
1275	my $class = shift;	1478	my $class = shift;
1276		1479
1277	$class->SUPER::new (	1480	$class->SUPER::new (
…		…
1283	sub children {	1486	sub children {
1284	grep $_, map @$_, grep $_, @{ $_[0]{children} }	1487	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1285	}	1488	}
1286		1489
1287	sub add {	1490	sub add {
1288	my ($self, $x, $y, $child) = @_;	1491	my ($self) = shift;
1289		1492
		1493	while (@_) {
		1494	my ($x, $y, $child) = splice @_, 0, 3, ();
1290	$child->set_parent ($self);	1495	$child->set_parent ($self);
1291	$self->{children}[$y][$x] = $child;	1496	$self->{children}[$y][$x] = $child;
		1497	}
1292		1498
		1499	$self->{force_realloc} = 1;
		1500	$self->{force_size_alloc} = 1;
1293	$self->realloc;	1501	$self->realloc;
1294	}	1502	}
1295		1503
1296	sub remove {	1504	sub remove {
1297	my ($self, $child) = @_;	1505	my ($self, $child) = @_;
…		…
1362		1570
1363	# linearly scale sizes	1571	# linearly scale sizes
1364	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;	1572	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1365	$hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;	1573	$hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1366		1574
1367	CFClient::UI::harmonize $ws;	1575	CFPlus::UI::harmonize $ws;
1368	CFClient::UI::harmonize $hs;	1576	CFPlus::UI::harmonize $hs;
1369		1577
1370	my $y;	1578	my $y;
1371		1579
1372	for my $r (0 .. $#{$self->{children}}) {	1580	for my $r (0 .. $#{$self->{children}}) {
1373	my $row = $self->{children}[$r]	1581	my $row = $self->{children}[$r]
…		…
1416	}	1624	}
1417	}	1625	}
1418		1626
1419	#############################################################################	1627	#############################################################################
1420		1628
1421	package CFClient::UI::Box;	1629	package CFPlus::UI::Box;
1422		1630
1423	our @ISA = CFClient::UI::Container::;	1631	our @ISA = CFPlus::UI::Container::;
1424		1632
1425	sub size_request {	1633	sub size_request {
1426	my ($self) = @_;	1634	my ($self) = @_;
1427		1635
1428	$self->{vertical}	1636	$self->{vertical}
…		…
1438		1646
1439	sub invoke_size_allocate {	1647	sub invoke_size_allocate {
1440	my ($self, $w, $h) = @_;	1648	my ($self, $w, $h) = @_;
1441		1649
1442	my $space = $self->{vertical} ? $h : $w;	1650	my $space = $self->{vertical} ? $h : $w;
1443	my $children = $self->{children};	1651	my @children = $self->visible_children;
1444		1652
1445	my @req;	1653	my @req;
1446		1654
1447	if ($self->{homogeneous}) {	1655	if ($self->{homogeneous}) {
1448	@req = ($space / (@$children || 1)) x @$children;	1656	@req = ($space / (@children || 1)) x @children;
1449	} else {	1657	} else {
1450	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1658	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1451	my $req = List::Util::sum @req;	1659	my $req = List::Util::sum @req;
1452		1660
1453	if ($req > $space) {	1661	if ($req > $space) {
1454	# ah well, not enough space	1662	# ah well, not enough space
1455	$_ *= $space / $req for @req;	1663	$_ *= $space / $req for @req;
1456	} else {	1664	} else {
1457	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1665	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1458		1666
1459	$space = ($space - $req) / $expand; # remaining space to give away	1667	$space = ($space - $req) / $expand; # remaining space to give away
1460		1668
1461	$req[$_] += $space * $children->[$_]{expand}	1669	$req[$_] += $space * $children[$_]{expand}
1462	for 0 .. $#$children;	1670	for 0 .. $#children;
1463	}	1671	}
1464	}	1672	}
1465		1673
1466	CFClient::UI::harmonize \@req;	1674	CFPlus::UI::harmonize \@req;
1467		1675
1468	my $pos = 0;	1676	my $pos = 0;
1469	for (0 .. $#$children) {	1677	for (0 .. $#children) {
1470	my $alloc = $req[$_];	1678	my $alloc = $req[$_];
1471	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1679	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1472		1680
1473	$pos += $alloc;	1681	$pos += $alloc;
1474	}	1682	}
1475		1683
1476	1	1684	1
1477	}	1685	}
1478		1686
1479	#############################################################################	1687	#############################################################################
1480		1688
1481	package CFClient::UI::HBox;	1689	package CFPlus::UI::HBox;
1482		1690
1483	our @ISA = CFClient::UI::Box::;	1691	our @ISA = CFPlus::UI::Box::;
1484		1692
1485	sub new {	1693	sub new {
1486	my $class = shift;	1694	my $class = shift;
1487		1695
1488	$class->SUPER::new (	1696	$class->SUPER::new (
…		…
1491	)	1699	)
1492	}	1700	}
1493		1701
1494	#############################################################################	1702	#############################################################################
1495		1703
1496	package CFClient::UI::VBox;	1704	package CFPlus::UI::VBox;
1497		1705
1498	our @ISA = CFClient::UI::Box::;	1706	our @ISA = CFPlus::UI::Box::;
1499		1707
1500	sub new {	1708	sub new {
1501	my $class = shift;	1709	my $class = shift;
1502		1710
1503	$class->SUPER::new (	1711	$class->SUPER::new (
…		…
1506	)	1714	)
1507	}	1715	}
1508		1716
1509	#############################################################################	1717	#############################################################################
1510		1718
1511	package CFClient::UI::Label;	1719	package CFPlus::UI::Label;
1512		1720
1513	our @ISA = CFClient::UI::DrawBG::;	1721	our @ISA = CFPlus::UI::DrawBG::;
1514		1722
1515	use CFClient::OpenGL;	1723	use CFPlus::OpenGL;
1516		1724
1517	sub new {	1725	sub new {
1518	my ($class, %arg) = @_;	1726	my ($class, %arg) = @_;
1519		1727
1520	my $self = $class->SUPER::new (	1728	my $self = $class->SUPER::new (
…		…
1523	#active_bg => none	1731	#active_bg => none
1524	#font => default_font	1732	#font => default_font
1525	#text => initial text	1733	#text => initial text
1526	#markup => initial narkup	1734	#markup => initial narkup
1527	#max_w => maximum pixel width	1735	#max_w => maximum pixel width
		1736	#style => 0, # render flags
1528	ellipsise => 3, # end	1737	ellipsise => 3, # end
1529	layout => (new CFClient::Layout),	1738	layout => (new CFPlus::Layout),
1530	fontsize => 1,	1739	fontsize => 1,
1531	align => -1,	1740	align => -1,
1532	valign => -1,	1741	valign => -1,
1533	padding_x => 2,	1742	padding_x => 2,
1534	padding_y => 2,	1743	padding_y => 2,
1535	can_events => 0,	1744	can_events => 0,
1536	%arg	1745	%arg
1537	);	1746	);
1538		1747
1539	if (exists $self->{template}) {	1748	if (exists $self->{template}) {
1540	my $layout = new CFClient::Layout;	1749	my $layout = new CFPlus::Layout;
1541	$layout->set_text (delete $self->{template});	1750	$layout->set_text (delete $self->{template});
1542	$self->{template} = $layout;	1751	$self->{template} = $layout;
1543	}	1752	}
1544		1753
1545	if (exists $self->{markup}) {	1754	if (exists $self->{markup}) {
…		…
1549	}	1758	}
1550		1759
1551	$self	1760	$self
1552	}	1761	}
1553		1762
1554	sub escape($) {
1555	local $_ = $_[0];
1556
1557	s/&/&amp;/g;
1558	s/>/&gt;/g;
1559	s/</&lt;/g;
1560
1561	$_
1562	}
1563
1564	sub update {	1763	sub update {
1565	my ($self) = @_;	1764	my ($self) = @_;
1566		1765
1567	delete $self->{texture};	1766	delete $self->{texture};
1568	$self->SUPER::update;	1767	$self->SUPER::update;
…		…
1579	my ($self, $text) = @_;	1778	my ($self, $text) = @_;
1580		1779
1581	return if $self->{text} eq "T$text";	1780	return if $self->{text} eq "T$text";
1582	$self->{text} = "T$text";	1781	$self->{text} = "T$text";
1583		1782
1584	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1585	$self->{layout}->set_text ($text);	1783	$self->{layout}->set_text ($text);
1586		1784
1587	delete $self->{size_req};	1785	delete $self->{size_req};
1588	$self->realloc;	1786	$self->realloc;
1589	$self->update;	1787	$self->update;
…		…
1595	return if $self->{text} eq "M$markup";	1793	return if $self->{text} eq "M$markup";
1596	$self->{text} = "M$markup";	1794	$self->{text} = "M$markup";
1597		1795
1598	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1796	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1599		1797
1600	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1601	$self->{layout}->set_markup ($markup);	1798	$self->{layout}->set_markup ($markup);
1602		1799
1603	delete $self->{size_req};	1800	delete $self->{size_req};
1604	$self->realloc;	1801	$self->realloc;
1605	$self->update;	1802	$self->update;
…		…
1617		1814
1618	my ($w, $h) = $self->{layout}->size;	1815	my ($w, $h) = $self->{layout}->size;
1619		1816
1620	if (exists $self->{template}) {	1817	if (exists $self->{template}) {
1621	$self->{template}->set_font ($self->{font}) if $self->{font};	1818	$self->{template}->set_font ($self->{font}) if $self->{font};
		1819	$self->{template}->set_width ($self->{max_w} || -1);
1622	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	1820	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1623		1821
1624	my ($w2, $h2) = $self->{template}->size;	1822	my ($w2, $h2) = $self->{template}->size;
1625		1823
1626	$w = List::Util::max $w, $w2;	1824	$w = List::Util::max $w, $w2;
…		…
1631	};	1829	};
1632		1830
1633	@{ $self->{size_req} }	1831	@{ $self->{size_req} }
1634	}	1832	}
1635		1833
		1834	sub baseline_shift {
		1835	$_[0]{layout}->descent
		1836	}
		1837
1636	sub invoke_size_allocate {	1838	sub invoke_size_allocate {
1637	my ($self, $w, $h) = @_;	1839	my ($self, $w, $h) = @_;
1638		1840
1639	delete $self->{ox};	1841	delete $self->{ox};
1640		1842
…		…
1646		1848
1647	sub set_fontsize {	1849	sub set_fontsize {
1648	my ($self, $fontsize) = @_;	1850	my ($self, $fontsize) = @_;
1649		1851
1650	$self->{fontsize} = $fontsize;	1852	$self->{fontsize} = $fontsize;
		1853	delete $self->{size_req};
1651	delete $self->{texture};	1854	delete $self->{texture};
1652		1855
1653	$self->realloc;	1856	$self->realloc;
1654	}	1857	}
1655		1858
1656	sub reconfigure {	1859	sub reconfigure {
1657	my ($self) = @_;	1860	my ($self) = @_;
1658		1861
1659	delete $self->{size_req};	1862	delete $self->{size_req};
		1863	delete $self->{texture};
1660		1864
1661	$self->SUPER::reconfigure;	1865	$self->SUPER::reconfigure;
1662	}	1866	}
1663		1867
1664	sub _draw {	1868	sub _draw {
1665	my ($self) = @_;	1869	my ($self) = @_;
1666		1870
1667	$self->SUPER::_draw; # draw background, if applicable	1871	$self->SUPER::_draw; # draw background, if applicable
1668		1872
1669	my $tex = $self->{texture} ||= do {	1873	my $size = $self->{texture} ||= do {
1670	$self->{layout}->set_foreground (@{$self->{fg}});	1874	$self->{layout}->set_foreground (@{$self->{fg}});
1671	$self->{layout}->set_font ($self->{font}) if $self->{font};	1875	$self->{layout}->set_font ($self->{font}) if $self->{font};
1672	$self->{layout}->set_width ($self->{w});	1876	$self->{layout}->set_width ($self->{w});
1673	$self->{layout}->set_ellipsise ($self->{ellipsise});	1877	$self->{layout}->set_ellipsise ($self->{ellipsise});
1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	1878	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	1879	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1676		1880
1677	new_from_layout CFClient::Texture $self->{layout}	1881	[$self->{layout}->size]
1678	};	1882	};
1679		1883
1680	unless (exists $self->{ox}) {	1884	unless (exists $self->{ox}) {
1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	1885	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	1886	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1683	: ($self->{w} - $tex->{w}) * 0.5);	1887	: ($self->{w} - $size->[0]) * 0.5);
1684		1888
1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	1889	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	1890	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1687	: ($self->{h} - $tex->{h}) * 0.5);	1891	: ($self->{h} - $size->[1]) * 0.5);
1688	};	1892	};
1689		1893
1690	glEnable GL_TEXTURE_2D;
1691
1692	my $w = List::Util::min $self->{w} + 4, $tex->{w};	1894	my $w = List::Util::min $self->{w} + 4, $size->[0];
1693	my $h = List::Util::min $self->{h} + 2, $tex->{h};	1895	my $h = List::Util::min $self->{h} + 2, $size->[1];
1694		1896
1695	if ($tex->{format} == GL_ALPHA) {	1897	$self->{layout}->render ($self->{ox}, $self->{oy}, $self->{style});
1696	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE;
1697	glColor @{$self->{fg}};
1698	$tex->draw_quad_alpha ($self->{ox}, $self->{oy}, $w, $h);
1699	} else {
1700	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
1701	$tex->draw_quad_alpha_premultiplied ($self->{ox}, $self->{oy}, $w, $h);
1702	}
1703
1704	glDisable GL_TEXTURE_2D;
1705	}	1898	}
1706		1899
1707	#############################################################################	1900	#############################################################################
1708		1901
1709	package CFClient::UI::EntryBase;	1902	package CFPlus::UI::EntryBase;
1710		1903
1711	our @ISA = CFClient::UI::Label::;	1904	our @ISA = CFPlus::UI::Label::;
1712		1905
1713	use CFClient::OpenGL;	1906	use CFPlus::OpenGL;
1714		1907
1715	sub new {	1908	sub new {
1716	my $class = shift;	1909	my $class = shift;
1717		1910
1718	$class->SUPER::new (	1911	$class->SUPER::new (
…		…
1722	active_fg => [0, 0, 0],	1915	active_fg => [0, 0, 0],
1723	can_hover => 1,	1916	can_hover => 1,
1724	can_focus => 1,	1917	can_focus => 1,
1725	valign => 0,	1918	valign => 0,
1726	can_events => 1,	1919	can_events => 1,
		1920	ellipsise => 0,
1727	#text => ...	1921	#text => ...
1728	#hidden => "*",	1922	#hidden => "*",
1729	@_	1923	@_
1730	)	1924	)
1731	}	1925	}
…		…
1776	my $sym = $ev->{sym};	1970	my $sym = $ev->{sym};
1777	my $uni = $ev->{unicode};	1971	my $uni = $ev->{unicode};
1778		1972
1779	my $text = $self->get_text;	1973	my $text = $self->get_text;
1780		1974
		1975	$self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;
		1976
1781	if ($uni == 8) {	1977	if ($uni == 8) {
1782	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	1978	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1783	} elsif ($uni == 127) {	1979	} elsif ($uni == 127) {
1784	substr $text, $self->{cursor}, 1, "";	1980	substr $text, $self->{cursor}, 1, "";
1785	} elsif ($sym == CFClient::SDLK_LEFT) {	1981	} elsif ($sym == CFPlus::SDLK_LEFT) {
1786	--$self->{cursor} if $self->{cursor};	1982	--$self->{cursor} if $self->{cursor};
1787	} elsif ($sym == CFClient::SDLK_RIGHT) {	1983	} elsif ($sym == CFPlus::SDLK_RIGHT) {
1788	++$self->{cursor} if $self->{cursor} < length $self->{text};	1984	++$self->{cursor} if $self->{cursor} < length $self->{text};
1789	} elsif ($sym == CFClient::SDLK_HOME) {	1985	} elsif ($sym == CFPlus::SDLK_HOME) {
		1986	# what a hack
		1987	$self->{cursor} =
		1988	(substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
		1989	? length $1
		1990	: 0;
		1991	} elsif ($sym == CFPlus::SDLK_END) {
		1992	# uh, again
		1993	$self->{cursor} =
		1994	(substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
		1995	? $self->{cursor} + length $1
		1996	: length $self->{text};
		1997	} elsif ($uni == 21) { # ctrl-u
		1998	$text = "";
1790	$self->{cursor} = 0;	1999	$self->{cursor} = 0;
1791	} elsif ($sym == CFClient::SDLK_END) {
1792	$self->{cursor} = length $text;
1793	} elsif ($uni == 27) {	2000	} elsif ($uni == 27) {
1794	$self->emit ('escape');	2001	$self->emit ('escape');
1795	} elsif ($uni) {	2002	} elsif ($uni == 0x0d) {
		2003	substr $text, $self->{cursor}++, 0, "\012";
		2004	} elsif ($uni >= 0x20) {
1796	substr $text, $self->{cursor}++, 0, chr $uni;	2005	substr $text, $self->{cursor}++, 0, chr $uni;
1797	} else {	2006	} else {
1798	return 0;	2007	return 0;
1799	}	2008	}
1800		2009
1801	$self->_set_text ($text);	2010	$self->_set_text ($text);
1802		2011
1803	$self->realloc;	2012	$self->realloc;
		2013	$self->update;
1804		2014
1805	1	2015	1
1806	}	2016	}
1807		2017
1808	sub invoke_focus_in {	2018	sub invoke_focus_in {
…		…
1820		2030
1821	my $idx = $self->{layout}->xy_to_index ($x, $y);	2031	my $idx = $self->{layout}->xy_to_index ($x, $y);
1822		2032
1823	# byte-index to char-index	2033	# byte-index to char-index
1824	my $text = $self->{text};	2034	my $text = $self->{text};
1825	utf8::encode $text;	2035	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1826	$self->{cursor} = length substr $text, 0, $idx;	2036	$self->{cursor} = length $text;
1827		2037
1828	$self->_set_text ($self->{text});	2038	$self->_set_text ($self->{text});
1829	$self->update;	2039	$self->update;
1830		2040
1831	1	2041	1
…		…
1870	utf8::encode $text;	2080	utf8::encode $text;
1871		2081
1872	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)	2082	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1873	}	2083	}
1874		2084
1875	glColor @{$self->{fg}};
1876	glBegin GL_LINES;	2085	glBegin GL_LINES;
1877	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};	2086	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};
1878	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};	2087	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1879	glEnd;	2088	glEnd;
1880	}	2089	}
1881	}	2090	}
1882		2091
		2092	#############################################################################
		2093
1883	package CFClient::UI::Entry;	2094	package CFPlus::UI::Entry;
1884		2095
1885	our @ISA = CFClient::UI::EntryBase::;	2096	our @ISA = CFPlus::UI::EntryBase::;
1886		2097
1887	use CFClient::OpenGL;	2098	use CFPlus::OpenGL;
1888		2099
1889	sub invoke_key_down {	2100	sub invoke_key_down {
1890	my ($self, $ev) = @_;	2101	my ($self, $ev) = @_;
1891		2102
1892	my $sym = $ev->{sym};	2103	my $sym = $ev->{sym};
1893		2104
1894	if ($sym == 13) {	2105	if ($ev->{uni} == 0x0d || $sym == 13) {
1895	unshift @{$self->{history}},	2106	unshift @{$self->{history}},
1896	my $txt = $self->get_text;	2107	my $txt = $self->get_text;
1897		2108
1898	$self->{history_pointer} = -1;	2109	$self->{history_pointer} = -1;
1899	$self->{history_saveback} = '';	2110	$self->{history_saveback} = '';
1900	$self->emit (activate => $txt);	2111	$self->emit (activate => $txt);
1901	$self->update;	2112	$self->update;
1902		2113
1903	} elsif ($sym == CFClient::SDLK_UP) {	2114	} elsif ($sym == CFPlus::SDLK_UP) {
1904	if ($self->{history_pointer} < 0) {	2115	if ($self->{history_pointer} < 0) {
1905	$self->{history_saveback} = $self->get_text;	2116	$self->{history_saveback} = $self->get_text;
1906	}	2117	}
1907	if (@{$self->{history} || []} > 0) {	2118	if (@{$self->{history} || []} > 0) {
1908	$self->{history_pointer}++;	2119	$self->{history_pointer}++;
…		…
1910	$self->{history_pointer} = @{$self->{history} || []} - 1;	2121	$self->{history_pointer} = @{$self->{history} || []} - 1;
1911	}	2122	}
1912	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2123	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1913	}	2124	}
1914		2125
1915	} elsif ($sym == CFClient::SDLK_DOWN) {	2126	} elsif ($sym == CFPlus::SDLK_DOWN) {
1916	$self->{history_pointer}--;	2127	$self->{history_pointer}--;
1917	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2128	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1918		2129
1919	if ($self->{history_pointer} >= 0) {	2130	if ($self->{history_pointer} >= 0) {
1920	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2131	$self->set_text ($self->{history}->[$self->{history_pointer}]);
…		…
1929	1	2140	1
1930	}	2141	}
1931		2142
1932	#############################################################################	2143	#############################################################################
1933		2144
		2145	package CFPlus::UI::TextEdit;
		2146
		2147	our @ISA = CFPlus::UI::EntryBase::;
		2148
		2149	use CFPlus::OpenGL;
		2150
		2151	sub move_cursor_ver {
		2152	my ($self, $dy) = @_;
		2153
		2154	my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
		2155
		2156	$y += $dy;
		2157
		2158	if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
		2159	$self->{cursor} = $index;
		2160	delete $self->{cur_h};
		2161	$self->update;
		2162	return;
		2163	}
		2164	}
		2165
		2166	sub invoke_key_down {
		2167	my ($self, $ev) = @_;
		2168
		2169	my $sym = $ev->{sym};
		2170
		2171	if ($sym == CFPlus::SDLK_UP) {
		2172	$self->move_cursor_ver (-1);
		2173	} elsif ($sym == CFPlus::SDLK_DOWN) {
		2174	$self->move_cursor_ver (+1);
		2175	} else {
		2176	return $self->SUPER::invoke_key_down ($ev)
		2177	}
		2178
		2179	1
		2180	}
		2181
		2182	#############################################################################
		2183
1934	package CFClient::UI::Button;	2184	package CFPlus::UI::Button;
1935		2185
1936	our @ISA = CFClient::UI::Label::;	2186	our @ISA = CFPlus::UI::Label::;
1937		2187
1938	use CFClient::OpenGL;	2188	use CFPlus::OpenGL;
1939		2189
1940	my @tex =	2190	my @tex =
1941	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2191	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1942	qw(b1_button_active.png);	2192	qw(b1_button_active.png);
1943		2193
1944	sub new {	2194	sub new {
1945	my $class = shift;	2195	my $class = shift;
1946		2196
…		…
1983	$self->SUPER::_draw;	2233	$self->SUPER::_draw;
1984	}	2234	}
1985		2235
1986	#############################################################################	2236	#############################################################################
1987		2237
		2238	package CFPlus::UI::CheckBox;
		2239
		2240	our @ISA = CFPlus::UI::DrawBG::;
		2241
		2242	my @tex =
		2243	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
		2244	qw(c1_checkbox_bg.png c1_checkbox_active.png);
		2245
		2246	use CFPlus::OpenGL;
		2247
		2248	sub new {
		2249	my $class = shift;
		2250
		2251	$class->SUPER::new (
		2252	padding_x => 2,
		2253	padding_y => 2,
		2254	fg => [1, 1, 1],
		2255	active_fg => [1, 1, 0],
		2256	bg => [0, 0, 0, 0.2],
		2257	active_bg => [1, 1, 1, 0.5],
		2258	state => 0,
		2259	can_hover => 1,
		2260	@_
		2261	)
		2262	}
		2263
		2264	sub size_request {
		2265	my ($self) = @_;
		2266
		2267	(6) x 2
		2268	}
		2269
		2270	sub toggle {
		2271	my ($self) = @_;
		2272
		2273	$self->{state} = !$self->{state};
		2274	$self->emit (changed => $self->{state});
		2275	$self->update;
		2276	}
		2277
		2278	sub invoke_button_down {
		2279	my ($self, $ev, $x, $y) = @_;
		2280
		2281	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
		2282	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
		2283	$self->toggle;
		2284	} else {
		2285	return 0
		2286	}
		2287
		2288	1
		2289	}
		2290
		2291	sub _draw {
		2292	my ($self) = @_;
		2293
		2294	$self->SUPER::_draw;
		2295
		2296	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
		2297
		2298	my ($w, $h) = @$self{qw(w h)};
		2299
		2300	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
		2301
		2302	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
		2303
		2304	my $tex = $self->{state} ? $tex[1] : $tex[0];
		2305
		2306	glEnable GL_TEXTURE_2D;
		2307	$tex->draw_quad_alpha (0, 0, $s, $s);
		2308	glDisable GL_TEXTURE_2D;
		2309	}
		2310
		2311	#############################################################################
		2312
		2313	package CFPlus::UI::Image;
		2314
		2315	our @ISA = CFPlus::UI::Base::;
		2316
		2317	use CFPlus::OpenGL;
		2318
		2319	our %texture_cache;
		2320
		2321	sub new {
		2322	my $class = shift;
		2323
		2324	my $self = $class->SUPER::new (
		2325	can_events => 0,
		2326	@_,
		2327	);
		2328
		2329	$self->{path} || $self->{tex}
		2330	or Carp::croak "'path' or 'tex' attributes required";
		2331
		2332	$self->{tex} ||= $texture_cache{$self->{path}} ||=
		2333	new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
		2334
		2335	CFPlus::weaken $texture_cache{$self->{path}};
		2336
		2337	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
		2338
		2339	$self
		2340	}
		2341
		2342	sub STORABLE_freeze {
		2343	my ($self, $cloning) = @_;
		2344
		2345	$self->{path}
		2346	or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
		2347
		2348	$self->{path}
		2349	}
		2350
		2351	sub STORABLE_attach {
		2352	my ($self, $cloning, $path) = @_;
		2353
		2354	$self->new (path => $path)
		2355	}
		2356
		2357	sub size_request {
		2358	my ($self) = @_;
		2359
		2360	($self->{tex}{w}, $self->{tex}{h})
		2361	}
		2362
		2363	sub _draw {
		2364	my ($self) = @_;
		2365
		2366	my $tex = $self->{tex};
		2367
		2368	my ($w, $h) = ($self->{w}, $self->{h});
		2369
		2370	if ($self->{rot90}) {
		2371	glRotate 90, 0, 0, 1;
		2372	glTranslate 0, -$self->{w}, 0;
		2373
		2374	($w, $h) = ($h, $w);
		2375	}
		2376
		2377	glEnable GL_TEXTURE_2D;
		2378	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2379
		2380	$tex->draw_quad (0, 0, $w, $h);
		2381
		2382	glDisable GL_TEXTURE_2D;
		2383	}
		2384
		2385	#############################################################################
		2386
1988	package CFClient::UI::ImageButton;	2387	package CFPlus::UI::ImageButton;
1989		2388
1990	our @ISA = CFClient::UI::Image::;	2389	our @ISA = CFPlus::UI::Image::;
1991		2390
1992	use CFClient::OpenGL;	2391	use CFPlus::OpenGL;
1993		2392
1994	my %textures;	2393	my %textures;
1995		2394
1996	sub new {	2395	sub new {
1997	my $class = shift;	2396	my $class = shift;
…		…
2019	1	2418	1
2020	}	2419	}
2021		2420
2022	#############################################################################	2421	#############################################################################
2023		2422
2024	package CFClient::UI::CheckBox;
2025
2026	our @ISA = CFClient::UI::DrawBG::;
2027
2028	my @tex =
2029	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }
2030	qw(c1_checkbox_bg.png c1_checkbox_active.png);
2031
2032	use CFClient::OpenGL;
2033
2034	sub new {
2035	my $class = shift;
2036
2037	$class->SUPER::new (
2038	padding_x => 2,
2039	padding_y => 2,
2040	fg => [1, 1, 1],
2041	active_fg => [1, 1, 0],
2042	bg => [0, 0, 0, 0.2],
2043	active_bg => [1, 1, 1, 0.5],
2044	state => 0,
2045	can_hover => 1,
2046	@_
2047	)
2048	}
2049
2050	sub size_request {
2051	my ($self) = @_;
2052
2053	(6) x 2
2054	}
2055
2056	sub invoke_button_down {
2057	my ($self, $ev, $x, $y) = @_;
2058
2059	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
2060	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
2061	$self->{state} = !$self->{state};
2062	$self->emit (changed => $self->{state});
2063	} else {
2064	return 0
2065	}
2066
2067	1
2068	}
2069
2070	sub _draw {
2071	my ($self) = @_;
2072
2073	$self->SUPER::_draw;
2074
2075	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
2076
2077	my ($w, $h) = @$self{qw(w h)};
2078
2079	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
2080
2081	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
2082
2083	my $tex = $self->{state} ? $tex[1] : $tex[0];
2084
2085	glEnable GL_TEXTURE_2D;
2086	$tex->draw_quad_alpha (0, 0, $s, $s);
2087	glDisable GL_TEXTURE_2D;
2088	}
2089
2090	#############################################################################
2091
2092	package CFClient::UI::Image;	2423	package CFPlus::UI::VGauge;
2093		2424
2094	our @ISA = CFClient::UI::Base::;	2425	our @ISA = CFPlus::UI::Base::;
2095
2096	use CFClient::OpenGL;
2097	use Carp qw/confess/;
2098
2099	our %loaded_images;
2100
2101	sub new {
2102	my $class = shift;
2103
2104	my $self = $class->SUPER::new (can_events => 0, @_);
2105
2106	$self->{image} or confess "Image has 'image' not set. This is a fatal error!";
2107
2108	$loaded_images{$self->{image}} ||=
2109	new_from_file CFClient::Texture CFClient::find_rcfile $self->{image}, mipmap => 1;
2110
2111	my $tex = $self->{tex} = $loaded_images{$self->{image}};
2112
2113	Scalar::Util::weaken $loaded_images{$self->{image}};
2114
2115	$self->{aspect} = $tex->{w} / $tex->{h};
2116
2117	$self
2118	}
2119
2120	sub size_request {
2121	my ($self) = @_;
2122
2123	($self->{tex}->{w}, $self->{tex}->{h})
2124	}
2125
2126	sub _draw {
2127	my ($self) = @_;
2128
2129	my $tex = $self->{tex};
2130
2131	my ($w, $h) = ($self->{w}, $self->{h});
2132
2133	if ($self->{rot90}) {
2134	glRotate 90, 0, 0, 1;
2135	glTranslate 0, -$self->{w}, 0;
2136
2137	($w, $h) = ($h, $w);
2138	}
2139
2140	glEnable GL_TEXTURE_2D;
2141	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2142
2143	$tex->draw_quad_alpha (0, 0, $w, $h);
2144
2145	glDisable GL_TEXTURE_2D;
2146	}
2147
2148	#############################################################################
2149
2150	package CFClient::UI::VGauge;
2151
2152	our @ISA = CFClient::UI::Base::;
2153		2426
2154	use List::Util qw(min max);	2427	use List::Util qw(min max);
2155		2428
2156	use CFClient::OpenGL;	2429	use CFPlus::OpenGL;
2157		2430
2158	my %tex = (	2431	my %tex = (
2159	food => [	2432	food => [
2160	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2433	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2161	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2434	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2162	],	2435	],
2163	grace => [	2436	grace => [
2164	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2437	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2165	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/	2438	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2166	],	2439	],
2167	hp => [	2440	hp => [
2168	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2441	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2169	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2442	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2170	],	2443	],
2171	mana => [	2444	mana => [
2172	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2445	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2173	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/	2446	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2174	],	2447	],
2175	);	2448	);
2176		2449
2177	# eg. VGauge->new (gauge => 'food'), default gauge: food	2450	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2237	my $ycut1 = max 0, min 1, $ycut;	2510	my $ycut1 = max 0, min 1, $ycut;
2238	my $ycut2 = max 0, min 1, $ycut - 1;	2511	my $ycut2 = max 0, min 1, $ycut - 1;
2239		2512
2240	my $h1 = $self->{h} * (1 - $ycut1);	2513	my $h1 = $self->{h} * (1 - $ycut1);
2241	my $h2 = $self->{h} * (1 - $ycut2);	2514	my $h2 = $self->{h} * (1 - $ycut2);
		2515	my $h3 = $self->{h};
		2516
		2517	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2242		2518
2243	glEnable GL_BLEND;	2519	glEnable GL_BLEND;
2244	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2520	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2245	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2521	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2246	glEnable GL_TEXTURE_2D;	2522	glEnable GL_TEXTURE_2D;
…		…
2265		2541
2266	if ($t3) {	2542	if ($t3) {
2267	glBindTexture GL_TEXTURE_2D, $t3->{name};	2543	glBindTexture GL_TEXTURE_2D, $t3->{name};
2268	glBegin GL_QUADS;	2544	glBegin GL_QUADS;
2269	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2545	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2270	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2546	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2271	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2547	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2272	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2548	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2273	glEnd;	2549	glEnd;
2274	}	2550	}
2275		2551
2276	glDisable GL_BLEND;	2552	glDisable GL_BLEND;
2277	glDisable GL_TEXTURE_2D;	2553	glDisable GL_TEXTURE_2D;
2278	}	2554	}
2279		2555
2280	#############################################################################	2556	#############################################################################
2281		2557
2282	package CFClient::UI::Gauge;	2558	package CFPlus::UI::Gauge;
2283		2559
2284	our @ISA = CFClient::UI::VBox::;	2560	our @ISA = CFPlus::UI::VBox::;
2285		2561
2286	sub new {	2562	sub new {
2287	my ($class, %arg) = @_;	2563	my ($class, %arg) = @_;
2288		2564
2289	my $self = $class->SUPER::new (	2565	my $self = $class->SUPER::new (
…		…
2291	can_hover => 1,	2567	can_hover => 1,
2292	can_events => 1,	2568	can_events => 1,
2293	%arg,	2569	%arg,
2294	);	2570	);
2295		2571
2296	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2572	$self->add ($self->{value} = new CFPlus::UI::Label valign => +1, align => 0, template => "999");
2297	$self->add ($self->{gauge} = new CFClient::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);	2573	$self->add ($self->{gauge} = new CFPlus::UI::VGauge type => $self->{type}, expand => 1, can_hover => 1);
2298	$self->add ($self->{max} = new CFClient::UI::Label valign => -1, align => 0, template => "999");	2574	$self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2299		2575
2300	$self	2576	$self
2301	}	2577	}
2302		2578
2303	sub set_fontsize {	2579	sub set_fontsize {
…		…
2324	$self->{value}->set_text ($val);	2600	$self->{value}->set_text ($val);
2325	}	2601	}
2326		2602
2327	#############################################################################	2603	#############################################################################
2328		2604
2329	package CFClient::UI::Slider;	2605	package CFPlus::UI::Slider;
2330		2606
2331	use strict;	2607	use strict;
2332		2608
2333	use CFClient::OpenGL;	2609	use CFPlus::OpenGL;
2334		2610
2335	our @ISA = CFClient::UI::DrawBG::;	2611	our @ISA = CFPlus::UI::DrawBG::;
2336		2612
2337	my @tex =	2613	my @tex =
2338	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2614	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2339	qw(s1_slider.png s1_slider_bg.png);	2615	qw(s1_slider.png s1_slider_bg.png);
2340		2616
2341	sub new {	2617	sub new {
2342	my $class = shift;	2618	my $class = shift;
2343		2619
…		…
2432	}	2708	}
2433		2709
2434	1	2710	1
2435	}	2711	}
2436		2712
		2713	sub invoke_mouse_wheel {
		2714	my ($self, $ev) = @_;
		2715
		2716	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2717
		2718	my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;
		2719
		2720	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
		2721
		2722	! ! $delta
		2723	}
		2724
2437	sub update {	2725	sub update {
2438	my ($self) = @_;	2726	my ($self) = @_;
2439		2727
2440	delete $self->{knob_w};	2728	delete $self->{knob_w};
2441	$self->SUPER::update;	2729	$self->SUPER::update;
…		…
2488	glDisable GL_TEXTURE_2D;	2776	glDisable GL_TEXTURE_2D;
2489	}	2777	}
2490		2778
2491	#############################################################################	2779	#############################################################################
2492		2780
2493	package CFClient::UI::ValSlider;	2781	package CFPlus::UI::ValSlider;
2494		2782
2495	our @ISA = CFClient::UI::HBox::;	2783	our @ISA = CFPlus::UI::HBox::;
2496		2784
2497	sub new {	2785	sub new {
2498	my ($class, %arg) = @_;	2786	my ($class, %arg) = @_;
2499		2787
2500	my $range = delete $arg{range};	2788	my $range = delete $arg{range};
2501		2789
2502	my $self = $class->SUPER::new (	2790	my $self = $class->SUPER::new (
2503	slider => (new CFClient::UI::Slider expand => 1, range => $range),	2791	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2504	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	2792	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2505	to_value => sub { shift },	2793	to_value => sub { shift },
2506	from_value => sub { shift },	2794	from_value => sub { shift },
2507	%arg,	2795	%arg,
2508	);	2796	);
2509		2797
…		…
2529	sub set_range { shift->{slider}->set_range (@_) }	2817	sub set_range { shift->{slider}->set_range (@_) }
2530	sub set_value { shift->{slider}->set_value (@_) }	2818	sub set_value { shift->{slider}->set_value (@_) }
2531		2819
2532	#############################################################################	2820	#############################################################################
2533		2821
2534	package CFClient::UI::TextScroller;	2822	package CFPlus::UI::TextScroller;
2535		2823
2536	our @ISA = CFClient::UI::HBox::;	2824	our @ISA = CFPlus::UI::HBox::;
2537		2825
2538	use CFClient::OpenGL;	2826	use CFPlus::OpenGL;
2539		2827
2540	sub new {	2828	sub new {
2541	my $class = shift;	2829	my $class = shift;
2542		2830
2543	my $self = $class->SUPER::new (	2831	my $self = $class->SUPER::new (
2544	fontsize => 1,	2832	fontsize => 1,
2545	can_events => 0,	2833	can_events => 1,
2546	indent => 0,	2834	indent => 0,
2547	#font => default_font	2835	#font => default_font
2548	@_,	2836	@_,
2549		2837
2550	layout => (new CFClient::Layout 1),	2838	layout => (new CFPlus::Layout),
2551	par => [],	2839	par => [],
		2840	max_par => 0,
2552	height => 0,	2841	height => 0,
2553	children => [	2842	children => [
2554	(new CFClient::UI::Empty expand => 1),	2843	(new CFPlus::UI::Empty expand => 1),
2555	(new CFClient::UI::Slider vertical => 1),	2844	(new CFPlus::UI::Slider vertical => 1),
2556	],	2845	],
2557	);	2846	);
2558		2847
2559	$self->{children}[1]->connect (changed => sub { $self->update });	2848	$self->{children}[1]->connect (changed => sub { $self->update });
2560		2849
…		…
2566		2855
2567	$self->{fontsize} = $fontsize;	2856	$self->{fontsize} = $fontsize;
2568	$self->reflow;	2857	$self->reflow;
2569	}	2858	}
2570		2859
		2860	sub size_request {
		2861	my ($self) = @_;
		2862
		2863	my ($empty, $slider) = @{ $self->{children} };
		2864
		2865	local $self->{children} = [$empty, $slider];
		2866	$self->SUPER::size_request
		2867	}
		2868
2571	sub invoke_size_allocate {	2869	sub invoke_size_allocate {
2572	my ($self, $w, $h) = @_;	2870	my ($self, $w, $h) = @_;
2573		2871
		2872	my ($empty, $slider, @other) = @{ $self->{children} };
		2873	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
		2874
2574	$self->{layout}->set_font ($self->{font}) if $self->{font};	2875	$self->{layout}->set_font ($self->{font}) if $self->{font};
2575	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2876	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2576	$self->{layout}->set_width ($self->{children}[0]{w});	2877	$self->{layout}->set_width ($empty->{w});
2577	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2878	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2578		2879
2579	$self->reflow;	2880	$self->reflow;
2580		2881
		2882	local $self->{children} = [$empty, $slider];
2581	$self->SUPER::invoke_size_allocate ($w, $h)	2883	$self->SUPER::invoke_size_allocate ($w, $h)
2582	}	2884	}
2583		2885
2584	sub text_size {	2886	sub invoke_mouse_wheel {
2585	my ($self, $text, $indent) = @_;	2887	my ($self, $ev) = @_;
		2888
		2889	return 0 unless $ev->{dy}; # only vertical movements
		2890
		2891	$self->{children}[1]->emit (mouse_wheel => $ev);
		2892
		2893	1
		2894	}
		2895
		2896	sub get_layout {
		2897	my ($self, $para) = @_;
2586		2898
2587	my $layout = $self->{layout};	2899	my $layout = $self->{layout};
2588		2900
		2901	$layout->set_font ($self->{font}) if $self->{font};
		2902	$layout->set_foreground (@{$para->{fg}});
2589	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	2903	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2590	$layout->set_width ($self->{children}[0]{w} - $indent);	2904	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2591	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	2905	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2592	$layout->set_markup ($text);	2906	$layout->set_markup ($para->{markup});
		2907
		2908	$layout->set_shapes (
		2909	map
		2910	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		2911	@{$para->{widget}}
2593		2912	);
		2913
2594	$layout->size	2914	$layout
2595	}	2915	}
2596		2916
2597	sub reflow {	2917	sub reflow {
2598	my ($self) = @_;	2918	my ($self) = @_;
2599		2919
…		…
2606		2926
2607	# todo: base offset on lines or so, not on pixels	2927	# todo: base offset on lines or so, not on pixels
2608	$self->{children}[1]->set_value ($offset);	2928	$self->{children}[1]->set_value ($offset);
2609	}	2929	}
2610		2930
		2931	sub current_paragraph {
		2932	my ($self) = @_;
		2933
		2934	$self->{top_paragraph} - 1
		2935	}
		2936
		2937	sub scroll_to {
		2938	my ($self, $para) = @_;
		2939
		2940	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		2941
		2942	$self->{scroll_to} = $para;
		2943	$self->update;
		2944	}
		2945
2611	sub clear {	2946	sub clear {
2612	my ($self) = @_;	2947	my ($self) = @_;
		2948
		2949	my (undef, undef, @other) = @{ $self->{children} };
		2950	$self->remove ($_) for @other;
2613		2951
2614	$self->{par} = [];	2952	$self->{par} = [];
2615	$self->{height} = 0;	2953	$self->{height} = 0;
2616	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	2954	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2617	}	2955	}
2618		2956
2619	sub add_paragraph {	2957	sub add_paragraph {
2620	my ($self, $color, $text, $indent) = @_;	2958	my $self = shift;
2621		2959
2622	for my $line (split /\n/, $text) {	2960	for my $para (@_) {
2623	my ($w, $h) = $self->text_size ($line);	2961	$para = {
		2962	fg => [1, 1, 1, 1],
		2963	indent => 0,
		2964	markup => "",
		2965	widget => [],
		2966	ref $para ? %$para : (markup => $para),
		2967	w => 1e10,
		2968	wrapped => 1,
		2969	};
		2970
		2971	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		2972	push @{$self->{par}}, $para;
		2973	}
		2974
		2975	if (my $max = $self->{max_par}) {
		2976	shift @{$self->{par}} while @{$self->{par}} > $max;
		2977	}
		2978
		2979	$self->{need_reflow}++;
		2980	$self->update;
		2981	}
		2982
		2983	sub scroll_to_bottom {
		2984	my ($self) = @_;
		2985
		2986	$self->{scroll_to} = $#{$self->{par}};
		2987	$self->update;
		2988	}
		2989
		2990	sub force_uptodate {
		2991	my ($self) = @_;
		2992
		2993	if (delete $self->{need_reflow}) {
		2994	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		2995
		2996	my $height = 0;
		2997
		2998	for my $para (@{$self->{par}}) {
		2999	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		3000	my $layout = $self->get_layout ($para);
		3001	my ($w, $h) = $layout->size;
		3002
		3003	$para->{w} = $w + $para->{indent};
		3004	$para->{h} = $h;
		3005	$para->{wrapped} = $layout->has_wrapped;
		3006	}
		3007
		3008	$para->{y} = $height;
		3009	$height += $para->{h};
		3010	}
		3011
2624	$self->{height} += $h;	3012	$self->{height} = $height;
2625	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3013	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2626	}
2627		3014
2628	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	3015	delete $self->{texture};
		3016	}
		3017
		3018	if (my $paridx = delete $self->{scroll_to}) {
		3019	$self->{children}[1]->set_value ($self->{par}[$paridx]{y});
		3020	}
2629	}	3021	}
2630		3022
2631	sub update {	3023	sub update {
2632	my ($self) = @_;	3024	my ($self) = @_;
2633		3025
…		…
2636	return unless $self->{h} > 0;	3028	return unless $self->{h} > 0;
2637		3029
2638	delete $self->{texture};	3030	delete $self->{texture};
2639		3031
2640	$ROOT->on_post_alloc ($self => sub {	3032	$ROOT->on_post_alloc ($self => sub {
		3033	$self->force_uptodate;
		3034
2641	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3035	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2642		3036
2643	if (delete $self->{need_reflow}) {
2644	my $height = 0;
2645
2646	my $layout = $self->{layout};
2647
2648	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2649
2650	for (@{$self->{par}}) {
2651	if (1 || $_->[0] >= $W) { # TODO: works,but needs reconfigure etc. support
2652	$layout->set_width ($W - $_->[3]);
2653	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2654	$layout->set_markup ($_->[4]);
2655	my ($w, $h) = $layout->size;
2656	$_->[0] = $w + $_->[3];
2657	$_->[1] = $h;
2658	}
2659
2660	$height += $_->[1];
2661	}
2662
2663	$self->{height} = $height;
2664
2665	$self->{children}[1]->set_range ([$height, 0, $height, $H, 1]);
2666
2667	delete $self->{texture};
2668	}
2669
2670	$self->{texture} ||= new_from_opengl CFClient::Texture $W, $H, sub {	3037	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2671	glClearColor 0, 0, 0, 0;	3038	glClearColor 0, 0, 0, 0;
2672	glClear GL_COLOR_BUFFER_BIT;	3039	glClear GL_COLOR_BUFFER_BIT;
2673		3040
		3041	package CFPlus::UI::Base;
		3042	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		3043	(0, 0, $self->{w}, $self->{h});
		3044
		3045	my $top = int $self->{children}[1]{range}[0];
		3046
		3047	my $paridx = 0;
		3048	my $top_paragraph;
2674	my $top = int $self->{children}[1]{range}[0];	3049	my $top = int $self->{children}[1]{range}[0];
2675		3050
2676	my $y0 = $top;	3051	my $y0 = $top;
2677	my $y1 = $top + $H;	3052	my $y1 = $top + $H;
2678		3053
2679	my $y = 0;
2680
2681	my $layout = $self->{layout};
2682
2683	$layout->set_font ($self->{font}) if $self->{font};
2684
2685	glEnable GL_BLEND;
2686	#TODO# not correct in windows where rgba is forced off
2687	glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2688
2689	for my $par (@{$self->{par}}) {	3054	for my $para (@{$self->{par}}) {
2690	my $h = $par->[1];	3055	my $h = $para->{h};
		3056	my $y = $para->{y};
2691		3057
2692	if ($y0 < $y + $h && $y < $y1) {	3058	if ($y0 < $y + $h && $y < $y1) {
2693	$layout->set_foreground (@{ $par->[2] });	3059	my $layout = $self->get_layout ($para);
2694	$layout->set_width ($W - $par->[3]);
2695	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2696	$layout->set_markup ($par->[4]);
2697		3060
2698	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3061	$layout->render ($para->{indent}, $y - $y0);
2699		3062
2700	glRasterPos $par->[3], $y - $y0;	3063	if (my @w = @{ $para->{widget} }) {
2701	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3064	my @s = $layout->get_shapes;
		3065
		3066	for (@w) {
		3067	my ($dx, $dy) = splice @s, 0, 2, ();
		3068
		3069	$_->{x} = $dx + $para->{indent};
		3070	$_->{y} = $dy + $y - $y0;
		3071
		3072	$_->draw;
		3073	}
		3074	}
2702	}	3075	}
2703		3076
2704	$y += $h;	3077	$paridx++;
		3078	$top_paragraph ||= $paridx if $y >= $top;
2705	}	3079	}
2706		3080
2707	glDisable GL_BLEND;	3081	$self->{top_paragraph} = $top_paragraph;
2708	};	3082	};
2709	});	3083	});
		3084	}
		3085
		3086	sub reconfigure {
		3087	my ($self) = @_;
		3088
		3089	$self->SUPER::reconfigure;
		3090
		3091	$_->{w} = 1e10 for @{ $self->{par} };
		3092	$self->reflow;
2710	}	3093	}
2711		3094
2712	sub _draw {	3095	sub _draw {
2713	my ($self) = @_;	3096	my ($self) = @_;
2714		3097
…		…
2717	glColor 0, 0, 0, 1;	3100	glColor 0, 0, 0, 1;
2718	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	3101	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2719	glDisable GL_TEXTURE_2D;	3102	glDisable GL_TEXTURE_2D;
2720		3103
2721	$self->{children}[1]->draw;	3104	$self->{children}[1]->draw;
2722
2723	}	3105	}
2724		3106
2725	#############################################################################	3107	#############################################################################
2726		3108
2727	package CFClient::UI::Animator;	3109	package CFPlus::UI::Animator;
2728		3110
2729	use CFClient::OpenGL;	3111	use CFPlus::OpenGL;
2730		3112
2731	our @ISA = CFClient::UI::Bin::;	3113	our @ISA = CFPlus::UI::Bin::;
2732		3114
2733	sub moveto {	3115	sub moveto {
2734	my ($self, $x, $y) = @_;	3116	my ($self, $x, $y) = @_;
2735		3117
2736	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3118	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2764	glPopMatrix;	3146	glPopMatrix;
2765	}	3147	}
2766		3148
2767	#############################################################################	3149	#############################################################################
2768		3150
2769	package CFClient::UI::Flopper;	3151	package CFPlus::UI::Flopper;
2770		3152
2771	our @ISA = CFClient::UI::Button::;	3153	our @ISA = CFPlus::UI::Button::;
2772		3154
2773	sub new {	3155	sub new {
2774	my $class = shift;	3156	my $class = shift;
2775		3157
2776	my $self = $class->SUPER::new (	3158	my $self = $class->SUPER::new (
…		…
2788	$self->{other}->toggle_visibility;	3170	$self->{other}->toggle_visibility;
2789	}	3171	}
2790		3172
2791	#############################################################################	3173	#############################################################################
2792		3174
2793	package CFClient::UI::Tooltip;	3175	package CFPlus::UI::Tooltip;
2794		3176
2795	our @ISA = CFClient::UI::Bin::;	3177	our @ISA = CFPlus::UI::Bin::;
2796		3178
2797	use CFClient::OpenGL;	3179	use CFPlus::OpenGL;
2798		3180
2799	sub new {	3181	sub new {
2800	my $class = shift;	3182	my $class = shift;
2801		3183
2802	$class->SUPER::new (	3184	$class->SUPER::new (
…		…
2805	)	3187	)
2806	}	3188	}
2807		3189
2808	sub set_tooltip_from {	3190	sub set_tooltip_from {
2809	my ($self, $widget) = @_;	3191	my ($self, $widget) = @_;
		3192
		3193	$widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
		3194	if $widget->{tooltip} =~ /^#(.*)$/;
2810		3195
2811	my $tooltip = $widget->{tooltip};	3196	my $tooltip = $widget->{tooltip};
2812		3197
2813	if ($ENV{CFPLUS_DEBUG} & 2) {	3198	if ($ENV{CFPLUS_DEBUG} & 2) {
2814	$tooltip .= "\n\n" . (ref $widget) . "\n"	3199	$tooltip .= "\n\n" . (ref $widget) . "\n"
…		…
2818	}	3203	}
2819		3204
2820	$tooltip =~ s/^\n+//;	3205	$tooltip =~ s/^\n+//;
2821	$tooltip =~ s/\n+$//;	3206	$tooltip =~ s/\n+$//;
2822		3207
2823	$self->add (new CFClient::UI::Label	3208	$self->add (new CFPlus::UI::Label
2824	markup => $tooltip,	3209	markup => $tooltip,
2825	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3210	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2826	fontsize => 0.8,	3211	fontsize => 0.8,
2827	fg => [0, 0, 0, 1],	3212	style => 1, # FLAG_INVERSE
2828	ellipsise => 0,	3213	ellipsise => 0,
2829	font => ($widget->{tooltip_font} || $::FONT_PROP),	3214	font => ($widget->{tooltip_font} || $::FONT_PROP),
2830	);	3215	);
2831	}	3216	}
2832		3217
…		…
2851		3236
2852	$self->{root}->on_post_alloc ("move_$self" => sub {	3237	$self->{root}->on_post_alloc ("move_$self" => sub {
2853	my $widget = $self->{owner}	3238	my $widget = $self->{owner}
2854	or return;	3239	or return;
2855		3240
		3241	if ($widget->{visible}) {
2856	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3242	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2857		3243
2858	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3244	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2859	if $x + $self->{w} > $self->{root}{w};	3245	if $x + $self->{w} > $self->{root}{w};
2860		3246
2861	$self->move_abs ($x, $y);	3247	$self->move_abs ($x, $y);
		3248	} else {
		3249	$self->hide;
		3250	}
2862	});	3251	});
2863	}	3252	}
2864		3253
2865	sub _draw {	3254	sub _draw {
2866	my ($self) = @_;	3255	my ($self) = @_;
…		…
2890	$self->SUPER::_draw;	3279	$self->SUPER::_draw;
2891	}	3280	}
2892		3281
2893	#############################################################################	3282	#############################################################################
2894		3283
2895	package CFClient::UI::Face;	3284	package CFPlus::UI::Face;
2896		3285
2897	our @ISA = CFClient::UI::Base::;	3286	our @ISA = CFPlus::UI::DrawBG::;
2898		3287
2899	use CFClient::OpenGL;	3288	use CFPlus::OpenGL;
2900		3289
2901	sub new {	3290	sub new {
2902	my $class = shift;	3291	my $class = shift;
2903		3292
2904	my $self = $class->SUPER::new (	3293	my $self = $class->SUPER::new (
…		…
2906	can_events => 0,	3295	can_events => 0,
2907	@_,	3296	@_,
2908	);	3297	);
2909		3298
2910	if ($self->{anim} && $self->{animspeed}) {	3299	if ($self->{anim} && $self->{animspeed}) {
2911	Scalar::Util::weaken (my $widget = $self);	3300	CFPlus::weaken (my $widget = $self);
2912		3301
2913	$self->{timer} = Event->timer (	3302	$self->{timer} = Event->timer (
2914	at => $self->{animspeed} * int $::NOW / $self->{animspeed},	3303	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2915	hard => 1,	3304	hard => 1,
2916	interval => $self->{animspeed},	3305	interval => $self->{animspeed},
…		…
2939	sub _draw {	3328	sub _draw {
2940	my ($self) = @_;	3329	my ($self) = @_;
2941		3330
2942	return unless $::CONN;	3331	return unless $::CONN;
2943		3332
		3333	$self->SUPER::_draw;
		3334
2944	my $face;	3335	my $face;
2945		3336
2946	if ($self->{frame}) {	3337	if ($self->{frame}) {
2947	my $anim = $::CONN->{anim}[$self->{anim}];	3338	my $anim = $::CONN->{anim}[$self->{anim}];
2948		3339
…		…
2970	$self->SUPER::destroy;	3361	$self->SUPER::destroy;
2971	}	3362	}
2972		3363
2973	#############################################################################	3364	#############################################################################
2974		3365
2975	package CFClient::UI::Buttonbar;	3366	package CFPlus::UI::Buttonbar;
2976		3367
2977	our @ISA = CFClient::UI::HBox::;	3368	our @ISA = CFPlus::UI::HBox::;
2978		3369
2979	# TODO: should actualyl wrap buttons and other goodies.	3370	# TODO: should actually wrap buttons and other goodies.
2980		3371
2981	#############################################################################	3372	#############################################################################
2982		3373
2983	package CFClient::UI::Menu;	3374	package CFPlus::UI::Menu;
2984		3375
2985	our @ISA = CFClient::UI::FancyFrame::;	3376	our @ISA = CFPlus::UI::Toplevel::;
2986		3377
2987	use CFClient::OpenGL;	3378	use CFPlus::OpenGL;
2988		3379
2989	sub new {	3380	sub new {
2990	my $class = shift;	3381	my $class = shift;
2991		3382
2992	my $self = $class->SUPER::new (	3383	my $self = $class->SUPER::new (
2993	items => [],	3384	items => [],
2994	z => 100,	3385	z => 100,
2995	@_,	3386	@_,
2996	);	3387	);
2997		3388
2998	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3389	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2999		3390
3000	for my $item (@{ $self->{items} }) {	3391	for my $item (@{ $self->{items} }) {
3001	my ($widget, $cb, $tooltip) = @$item;	3392	my ($widget, $cb, $tooltip) = @$item;
3002		3393
3003	# handle various types of items, only text for now	3394	# handle various types of items, only text for now
3004	if (!ref $widget) {	3395	if (!ref $widget) {
		3396	if ($widget =~ /\t/) {
		3397	my ($left, $right) = split /\t/, $widget, 2;
		3398
3005	$widget = new CFClient::UI::Label	3399	$widget = new CFPlus::UI::HBox
3006	can_hover => 1,	3400	can_hover => 1,
3007	can_events => 1,	3401	can_events => 1,
		3402	tooltip => $tooltip,
		3403	children => [
		3404	(new CFPlus::UI::Label markup => $left, expand => 1),
		3405	(new CFPlus::UI::Label markup => $right, align => +1),
		3406	],
		3407	;
		3408
		3409	} else {
		3410	$widget = new CFPlus::UI::Label
		3411	can_hover => 1,
		3412	can_events => 1,
3008	markup => $widget,	3413	markup => $widget,
3009	tooltip => $tooltip	3414	tooltip => $tooltip;
		3415	}
3010	}	3416	}
3011		3417
3012	$self->{item}{$widget} = $item;	3418	$self->{item}{$widget} = $item;
3013		3419
3014	$self->{vbox}->add ($widget);	3420	$self->{vbox}->add ($widget);
…		…
3057	1	3463	1
3058	}	3464	}
3059		3465
3060	#############################################################################	3466	#############################################################################
3061		3467
3062	package CFClient::UI::Multiplexer;	3468	package CFPlus::UI::Multiplexer;
3063		3469
3064	our @ISA = CFClient::UI::Container::;	3470	our @ISA = CFPlus::UI::Container::;
3065		3471
3066	sub new {	3472	sub new {
3067	my $class = shift;	3473	my $class = shift;
3068		3474
3069	my $self = $class->SUPER::new (	3475	my $self = $class->SUPER::new (
…		…
3083		3489
3084	$self->{current} = $self->{children}[0]	3490	$self->{current} = $self->{children}[0]
3085	if @{ $self->{children} };	3491	if @{ $self->{children} };
3086	}	3492	}
3087		3493
		3494	sub get_current_page {
		3495	my ($self) = @_;
		3496
		3497	$self->{current}
		3498	}
		3499
3088	sub set_current_page {	3500	sub set_current_page {
3089	my ($self, $page_or_widget) = @_;	3501	my ($self, $page_or_widget) = @_;
3090		3502
3091	my $widget = ref $page_or_widget	3503	my $widget = ref $page_or_widget
3092	? $page_or_widget	3504	? $page_or_widget
…		…
3124	$self->{current}->draw;	3536	$self->{current}->draw;
3125	}	3537	}
3126		3538
3127	#############################################################################	3539	#############################################################################
3128		3540
3129	package CFClient::UI::Notebook;	3541	package CFPlus::UI::Notebook;
3130		3542
3131	our @ISA = CFClient::UI::VBox::;	3543	our @ISA = CFPlus::UI::VBox::;
3132		3544
3133	sub new {	3545	sub new {
3134	my $class = shift;	3546	my $class = shift;
3135		3547
3136	my $self = $class->SUPER::new (	3548	my $self = $class->SUPER::new (
3137	buttonbar => (new CFClient::UI::Buttonbar),	3549	buttonbar => (new CFPlus::UI::Buttonbar),
3138	multiplexer => (new CFClient::UI::Multiplexer expand => 1),	3550	multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
3139	# filter => # will be put between multiplexer and $self	3551	# filter => # will be put between multiplexer and $self
3140	@_,	3552	@_,
3141	);	3553	);
3142		3554
3143	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};	3555	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
…		…
3147	}	3559	}
3148		3560
3149	sub add {	3561	sub add {
3150	my ($self, $title, $widget, $tooltip) = @_;	3562	my ($self, $title, $widget, $tooltip) = @_;
3151		3563
3152	Scalar::Util::weaken $self;	3564	CFPlus::weaken $self;
3153		3565
3154	$self->{buttonbar}->add (new CFClient::UI::Button	3566	$self->{buttonbar}->add (new CFPlus::UI::Button
3155	markup => $title,	3567	markup => $title,
3156	tooltip => $tooltip,	3568	tooltip => $tooltip,
3157	on_activate => sub { $self->set_current_page ($widget) },	3569	on_activate => sub { $self->set_current_page ($widget) },
3158	);	3570	);
3159		3571
3160	$self->{multiplexer}->add ($widget);	3572	$self->{multiplexer}->add ($widget);
3161	}	3573	}
3162		3574
		3575	sub get_current_page {
		3576	my ($self) = @_;
		3577
		3578	$self->{multiplexer}->get_current_page
		3579	}
		3580
3163	sub set_current_page {	3581	sub set_current_page {
3164	my ($self, $page) = @_;	3582	my ($self, $page) = @_;
3165		3583
3166	$self->{multiplexer}->set_current_page ($page);	3584	$self->{multiplexer}->set_current_page ($page);
3167	$self->emit (page_changed => $self->{multiplexer}{current});	3585	$self->emit (page_changed => $self->{multiplexer}{current});
3168	}	3586	}
3169		3587
3170	#############################################################################	3588	#############################################################################
3171		3589
3172	package CFClient::UI::Combobox;	3590	package CFPlus::UI::Selector;
3173		3591
3174	use utf8;	3592	use utf8;
3175		3593
3176	our @ISA = CFClient::UI::Button::;	3594	our @ISA = CFPlus::UI::Button::;
3177		3595
3178	sub new {	3596	sub new {
3179	my $class = shift;	3597	my $class = shift;
3180		3598
3181	my $self = $class->SUPER::new (	3599	my $self = $class->SUPER::new (
…		…
3198	my ($value, $title, $tooltip) = @$_;	3616	my ($value, $title, $tooltip) = @$_;
3199		3617
3200	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];	3618	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3201	}	3619	}
3202		3620
3203	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);	3621	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
3204	}	3622	}
3205		3623
3206	sub _set_value {	3624	sub _set_value {
3207	my ($self, $value) = @_;	3625	my ($self, $value) = @_;
3208		3626
…		…
3223	$self->emit (changed => $value);	3641	$self->emit (changed => $value);
3224	}	3642	}
3225		3643
3226	#############################################################################	3644	#############################################################################
3227		3645
3228	package CFClient::UI::Statusbox;	3646	package CFPlus::UI::Statusbox;
3229		3647
3230	our @ISA = CFClient::UI::VBox::;	3648	our @ISA = CFPlus::UI::VBox::;
3231		3649
3232	sub new {	3650	sub new {
3233	my $class = shift;	3651	my $class = shift;
3234		3652
3235	my $self = $class->SUPER::new (	3653	my $self = $class->SUPER::new (
3236	fontsize => 0.8,	3654	fontsize => 0.8,
3237	@_,	3655	@_,
3238	);	3656	);
3239		3657
3240	Scalar::Util::weaken (my $this = $self);	3658	CFPlus::weaken (my $this = $self);
3241		3659
3242	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });	3660	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
3243		3661
3244	$self	3662	$self
3245	}	3663	}
…		…
3247	sub reorder {	3665	sub reorder {
3248	my ($self) = @_;	3666	my ($self) = @_;
3249	my $NOW = Time::HiRes::time;	3667	my $NOW = Time::HiRes::time;
3250		3668
3251	# freeze display when hovering over any label	3669	# freeze display when hovering over any label
3252	return if $CFClient::UI::TOOLTIP->{owner}	3670	return if $CFPlus::UI::TOOLTIP->{owner}
3253	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},	3671	&& grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
3254	values %{ $self->{item} };	3672	values %{ $self->{item} };
3255		3673
3256	while (my ($k, $v) = each %{ $self->{item} }) {	3674	while (my ($k, $v) = each %{ $self->{item} }) {
3257	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3675	delete $self->{item}{$k} if $v->{timeout} < $NOW;
3258	}	3676	}
…		…
3279	for ($short) {	3697	for ($short) {
3280	s/^\s+//;	3698	s/^\s+//;
3281	s/\s+/ /g;	3699	s/\s+/ /g;
3282	}	3700	}
3283		3701
3284	new CFClient::UI::Label	3702	new CFPlus::UI::Label
3285	markup => $short,	3703	markup => $short,
3286	tooltip => $item->{tooltip},	3704	tooltip => $item->{tooltip},
3287	tooltip_font => $::FONT_PROP,	3705	tooltip_font => $::FONT_PROP,
3288	tooltip_width => 0.67,	3706	tooltip_width => 0.67,
3289	fontsize => $item->{fontsize} || $self->{fontsize},	3707	fontsize => $item->{fontsize} || $self->{fontsize},
…		…
3343	count => 1,	3761	count => 1,
3344	%arg,	3762	%arg,
3345	};	3763	};
3346	}	3764	}
3347		3765
		3766	$ROOT->on_refresh (reorder => sub {
3348	$self->reorder;	3767	$self->reorder;
		3768	});
3349	}	3769	}
3350		3770
3351	sub reconfigure {	3771	sub reconfigure {
3352	my ($self) = @_;	3772	my ($self) = @_;
3353		3773
…		…
3366	$self->SUPER::destroy;	3786	$self->SUPER::destroy;
3367	}	3787	}
3368		3788
3369	#############################################################################	3789	#############################################################################
3370		3790
3371	package CFClient::UI::Inventory;
3372
3373	our @ISA = CFClient::UI::ScrolledWindow::;
3374
3375	sub new {
3376	my $class = shift;
3377
3378	my $self = $class->SUPER::new (
3379	child => (new CFClient::UI::Table col_expand => [0, 1, 0]),
3380	@_,
3381	);
3382
3383	$self
3384	}
3385
3386	sub set_items {
3387	my ($self, $items) = @_;
3388
3389	$self->{child}->clear;
3390	return unless $items;
3391
3392	my @items = sort {
3393	($a->{type} <=> $b->{type})
3394	or ($a->{name} cmp $b->{name})
3395	} @$items;
3396
3397	$self->{real_items} = \@items;
3398
3399	my $row = 0;
3400	for my $item (@items) {
3401	CFClient::Item::update_widgets $item;
3402
3403	$self->{child}->add (0, $row, $item->{face_widget});
3404	$self->{child}->add (1, $row, $item->{desc_widget});
3405	$self->{child}->add (2, $row, $item->{weight_widget});
3406
3407	$row++;
3408	}
3409	}
3410
3411	#############################################################################
3412
3413	package CFClient::UI::BindEditor;
3414
3415	our @ISA = CFClient::UI::FancyFrame::;
3416
3417	sub new {
3418	my $class = shift;
3419
3420	my $self = $class->SUPER::new (binding => [], commands => [], @_);
3421
3422	$self->add (my $vb = new CFClient::UI::VBox);
3423
3424
3425	$vb->add ($self->{rec_btn} = new CFClient::UI::Button
3426	text => "start recording",
3427	tooltip => "Start/Stops recording of actions."
3428	."All subsequent actions after the recording started will be captured."
3429	."The actions are displayed after the record was stopped."
3430	."To bind the action you have to click on the 'Bind' button",
3431	on_activate => sub {
3432	unless ($self->{recording}) {
3433	$self->start;
3434	} else {
3435	$self->stop;
3436	}
3437	});
3438
3439	$vb->add (new CFClient::UI::Label text => "Actions:");
3440	$vb->add ($self->{cmdbox} = new CFClient::UI::VBox);
3441
3442	$vb->add (new CFClient::UI::Label text => "Bound to: ");
3443	$vb->add (my $hb = new CFClient::UI::HBox);
3444	$hb->add ($self->{keylbl} = new CFClient::UI::Label expand => 1);
3445	$hb->add (new CFClient::UI::Button
3446	text => "bind",
3447	tooltip => "This opens a query where you have to press the key combination to bind the recorded actions",
3448	on_activate => sub {
3449	$self->ask_for_bind;
3450	});
3451
3452	$vb->add (my $hb = new CFClient::UI::HBox);
3453	$hb->add (new CFClient::UI::Button
3454	text => "ok",
3455	expand => 1,
3456	tooltip => "This closes the binding editor and saves the binding",
3457	on_activate => sub {
3458	$self->hide;
3459	$self->commit;
3460	});
3461
3462	$hb->add (new CFClient::UI::Button
3463	text => "cancel",
3464	expand => 1,
3465	tooltip => "This closes the binding editor without saving",
3466	on_activate => sub {
3467	$self->hide;
3468	$self->{binding_cancel}->()
3469	if $self->{binding_cancel};
3470	});
3471
3472	$self->update_binding_widgets;
3473
3474	$self
3475	}
3476
3477	sub cfg_bind {
3478	my ($self, $mod, $sym, $cmds) = @_;
3479	$::CFG->{profile}{default}{bindings}{$mod}{$sym} = $cmds;
3480	::update_bindings ();
3481	}
3482
3483	sub cfg_unbind {
3484	my ($self, $mod, $sym, $cmds) = @_;
3485	delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
3486	::update_bindings ();
3487	}
3488
3489	sub commit {
3490	my ($self) = @_;
3491	my ($mod, $sym, $cmds) = $self->get_binding;
3492	if ($sym != 0 && @$cmds > 0) {
3493	$::STATUSBOX->add ("Bound actions to '".CFClient::Binder::keycombo_to_name ($mod, $sym)
3494	."'. Don't forget 'Save Config'!");
3495	$self->{binding_change}->($mod, $sym, $cmds)
3496	if $self->{binding_change};
3497	} else {
3498	$::STATUSBOX->add ("No action bound, no key or action specified!");
3499	$self->{binding_cancel}->()
3500	if $self->{binding_cancel};
3501	}
3502	}
3503
3504	sub start {
3505	my ($self) = @_;
3506
3507	$self->{rec_btn}->set_text ("stop recording");
3508	$self->{recording} = 1;
3509	$self->clear_command_list;
3510	$::CONN->start_record if $::CONN;
3511	}
3512
3513	sub stop {
3514	my ($self) = @_;
3515
3516	$self->{rec_btn}->set_text ("start recording");
3517	$self->{recording} = 0;
3518
3519	my $rec;
3520	$rec = $::CONN->stop_record if $::CONN;
3521	return unless ref $rec eq 'ARRAY';
3522	$self->set_command_list ($rec);
3523	}
3524
3525
3526	sub ask_for_bind_and_commit {
3527	my ($self) = @_;
3528	$self->ask_for_bind (1);
3529	}
3530
3531	sub ask_for_bind {
3532	my ($self, $commit, $end_cb) = @_;
3533
3534	CFClient::Binder::open_binding_dialog (sub {
3535	my ($mod, $sym) = @_;
3536	$self->{binding} = [$mod, $sym]; # XXX: how to stop that memleak?
3537	$self->update_binding_widgets;
3538	$self->commit if $commit;
3539	$end_cb->() if $end_cb;
3540	});
3541	}
3542
3543	# $mod and $sym are the modifiers and key symbol
3544	# $cmds is a array ref of strings (the commands)
3545	# $cb is the callback that is executed on OK
3546	# $ccb is the callback that is executed on CANCEL and
3547	# when the binding was unsuccessful on OK
3548	sub set_binding {
3549	my ($self, $mod, $sym, $cmds, $cb, $ccb) = @_;
3550
3551	$self->clear_command_list;
3552	$self->{recording} = 0;
3553	$self->{rec_btn}->set_text ("start recording");
3554
3555	$self->{binding} = [$mod, $sym];
3556	$self->{commands} = $cmds;
3557
3558	$self->{binding_change} = $cb;
3559	$self->{binding_cancel} = $ccb;
3560
3561	$self->update_binding_widgets;
3562	}
3563
3564	# this is a shortcut method that asks for a binding
3565	# and then just binds it.
3566	sub do_quick_binding {
3567	my ($self, $cmds, $end_cb) = @_;
3568	$self->set_binding (undef, undef, $cmds, sub { $self->cfg_bind (@_) });
3569	$self->ask_for_bind (1, $end_cb);
3570	}
3571
3572	sub update_binding_widgets {
3573	my ($self) = @_;
3574	my ($mod, $sym, $cmds) = $self->get_binding;
3575	$self->{keylbl}->set_text (CFClient::Binder::keycombo_to_name ($mod, $sym));
3576	$self->set_command_list ($cmds);
3577	}
3578
3579	sub get_binding {
3580	my ($self) = @_;
3581	return (
3582	$self->{binding}->[0],
3583	$self->{binding}->[1],
3584	[ grep { defined $_ } @{$self->{commands}} ]
3585	);
3586	}
3587
3588	sub clear_command_list {
3589	my ($self) = @_;
3590	$self->{cmdbox}->clear ();
3591	}
3592
3593	sub set_command_list {
3594	my ($self, $cmds) = @_;
3595
3596	$self->{cmdbox}->clear ();
3597	$self->{commands} = $cmds;
3598
3599	my $idx = 0;
3600
3601	for (@$cmds) {
3602	$self->{cmdbox}->add (my $hb = new CFClient::UI::HBox);
3603
3604	my $i = $idx;
3605	$hb->add (new CFClient::UI::Label text => $_);
3606	$hb->add (new CFClient::UI::Button
3607	text => "delete",
3608	tooltip => "Deletes the action from the record",
3609	on_activate => sub {
3610	$self->{cmdbox}->remove ($hb);
3611	$cmds->[$i] = undef;
3612	});
3613
3614
3615	$idx++
3616	}
3617	}
3618
3619	#############################################################################
3620
3621	package CFClient::UI::SpellList;
3622
3623	our @ISA = CFClient::UI::Table::;
3624
3625	sub new {
3626	my $class = shift;
3627
3628	my $self = $class->SUPER::new (
3629	binding => [],
3630	commands => [],
3631	@_,
3632	)
3633	}
3634
3635	my $TOOLTIP_ALL = "\n\n<small>Left click - ready spell\nMiddle click - invoke spell\nRight click - further options</small>";
3636
3637	my @TOOLTIP_NAME = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3638	"<b>Name</b>. The name of the spell.$TOOLTIP_ALL");
3639	my @TOOLTIP_SKILL = (align => -1, can_events => 1, can_hover => 1, tooltip =>
3640	"<b>Skill</b>. The skill (or magic school) required to be able to attempt casting this spell.$TOOLTIP_ALL");
3641	my @TOOLTIP_LVL = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3642	"<b>Level</b>. Minimum level the caster needs in the associated skill to be able to attempt casting this spell.$TOOLTIP_ALL");
3643	my @TOOLTIP_SP = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3644	"<b>Spell points / Grace points</b>. Amount of spell or grace points used by each invocation.$TOOLTIP_ALL");
3645	my @TOOLTIP_DMG = (align => 1, can_events => 1, can_hover => 1, tooltip =>
3646	"<b>Damage</b>. The amount of damage the spell deals when it hits.$TOOLTIP_ALL");
3647
3648	sub rebuild_spell_list {
3649	my ($self) = @_;
3650
3651	$CFClient::UI::ROOT->on_refresh ($self => sub {
3652	$self->clear;
3653
3654	return unless $::CONN;
3655
3656	$self->add (1, 0, new CFClient::UI::Label text => "Spell Name", @TOOLTIP_NAME);
3657	$self->add (2, 0, new CFClient::UI::Label text => "Skill", @TOOLTIP_SKILL);
3658	$self->add (3, 0, new CFClient::UI::Label text => "Lvl" , @TOOLTIP_LVL);
3659	$self->add (4, 0, new CFClient::UI::Label text => "Sp/Gp", @TOOLTIP_SP);
3660	$self->add (5, 0, new CFClient::UI::Label text => "Dmg" , @TOOLTIP_DMG);
3661
3662	my $row = 0;
3663
3664	for (sort { $a cmp $b } keys %{ $self->{spell} }) {
3665	my $spell = $self->{spell}{$_};
3666
3667	$row++;
3668
3669	my $spell_cb = sub {
3670	my ($widget, $ev) = @_;
3671
3672	if ($ev->{button} == 1) {
3673	$::CONN->user_send ("cast $spell->{name}");
3674	} elsif ($ev->{button} == 2) {
3675	$::CONN->user_send ("invoke $spell->{name}");
3676	} elsif ($ev->{button} == 3) {
3677	(new CFClient::UI::Menu
3678	items => [
3679	["bind <i>cast $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["cast $spell->{name}"]) }],
3680	["bind <i>invoke $spell->{name}</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["invoke $spell->{name}"]) }],
3681	],
3682	)->popup ($ev);
3683	} else {
3684	return 0;
3685	}
3686
3687	1
3688	};
3689
3690	my $tooltip = "$spell->{message}$TOOLTIP_ALL";
3691
3692	#TODO: add path info to tooltip
3693	#$self->add (6, $row, new CFClient::UI::Label text => $spell->{path});
3694
3695	$self->add (0, $row, new CFClient::UI::Face
3696	face => $spell->{face},
3697	can_hover => 1,
3698	can_events => 1,
3699	tooltip => $tooltip,
3700	on_button_down => $spell_cb,
3701	);
3702
3703	$self->add (1, $row, new CFClient::UI::Label
3704	expand => 1,
3705	text => $spell->{name},
3706	can_hover => 1,
3707	can_events => 1,
3708	tooltip => $tooltip,
3709	on_button_down => $spell_cb,
3710	);
3711
3712	$self->add (2, $row, new CFClient::UI::Label text => $::CONN->{skill_info}{$spell->{skill}}, @TOOLTIP_SKILL);
3713	$self->add (3, $row, new CFClient::UI::Label text => $spell->{level}, @TOOLTIP_LVL);
3714	$self->add (4, $row, new CFClient::UI::Label text => $spell->{mana} || $spell->{grace}, @TOOLTIP_SP);
3715	$self->add (5, $row, new CFClient::UI::Label text => $spell->{damage}, @TOOLTIP_DMG);
3716	}
3717	});
3718	}
3719
3720	sub add_spell {
3721	my ($self, $spell) = @_;
3722
3723	$self->{spell}->{$spell->{name}} = $spell;
3724	$self->rebuild_spell_list;
3725	}
3726
3727	sub remove_spell {
3728	my ($self, $spell) = @_;
3729
3730	delete $self->{spell}->{$spell->{name}};
3731	$self->rebuild_spell_list;
3732	}
3733
3734	sub clear_spells {
3735	my ($self) = @_;
3736
3737	$self->{spell} = {};
3738	$self->rebuild_spell_list;
3739	}
3740
3741	#############################################################################
3742
3743	package CFClient::UI::Root;	3791	package CFPlus::UI::Root;
3744		3792
3745	our @ISA = CFClient::UI::Container::;	3793	our @ISA = CFPlus::UI::Container::;
3746		3794
3747	use List::Util qw(min max);	3795	use List::Util qw(min max);
3748		3796
3749	use CFClient::OpenGL;	3797	use CFPlus::OpenGL;
3750		3798
3751	sub new {	3799	sub new {
3752	my $class = shift;	3800	my $class = shift;
3753		3801
3754	my $self = $class->SUPER::new (	3802	my $self = $class->SUPER::new (
3755	visible => 1,	3803	visible => 1,
3756	@_,	3804	@_,
3757	);	3805	);
3758		3806
3759	Scalar::Util::weaken ($self->{root} = $self);	3807	CFPlus::weaken ($self->{root} = $self);
3760		3808
3761	$self	3809	$self
3762	}	3810	}
3763		3811
3764	sub size_request {	3812	sub size_request {
…		…
3930	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	3978	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3931		3979
3932	$w = 0 if $w < 0;	3980	$w = 0 if $w < 0;
3933	$h = 0 if $h < 0;	3981	$h = 0 if $h < 0;
3934		3982
		3983	$w = max $widget->{min_w}, $w;
		3984	$h = max $widget->{min_h}, $h;
		3985
		3986	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		3987	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		3988
		3989	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		3990	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		3991
3935	$w = int $w + 0.5;	3992	$w = int $w + 0.5;
3936	$h = int $h + 0.5;	3993	$h = int $h + 0.5;
3937		3994
3938	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	3995	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3939	$widget->{old_w} = $widget->{w};	3996	$widget->{old_w} = $widget->{w};
…		…
3962	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4019	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3963	glMatrixMode GL_MODELVIEW;	4020	glMatrixMode GL_MODELVIEW;
3964	glLoadIdentity;	4021	glLoadIdentity;
3965		4022
3966	{	4023	{
3967	package CFClient::UI::Base;	4024	package CFPlus::UI::Base;
3968		4025
3969	($draw_x, $draw_y, $draw_w, $draw_h) =	4026	local ($draw_x, $draw_y, $draw_w, $draw_h) =
3970	(0, 0, $self->{w}, $self->{h});	4027	(0, 0, $self->{w}, $self->{h});
3971	}
3972		4028
3973	$self->_draw;	4029	$self->_draw;
		4030	}
3974	}	4031	}
3975		4032
3976	#############################################################################	4033	#############################################################################
3977		4034
3978	package CFClient::UI;	4035	package CFPlus::UI;
3979		4036
3980	$ROOT = new CFClient::UI::Root;	4037	$ROOT = new CFPlus::UI::Root;
3981	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4038	$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
3982		4039
3983	1	4040	1
3984		4041

Diff Legend

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