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.377 by root, Mon Jul 16 20:20:30 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
		273	sub TO_JSON {
		274	{ __widget_ref__ => $_[0]{s_id} }
		275	}
		276
247	sub show {	277	sub show {
248	my ($self) = @_;	278	my ($self) = @_;
249		279
250	return if $self->{parent};	280	return if $self->{parent};
251		281
252	$CFClient::UI::ROOT->add ($self);	282	$CFPlus::UI::ROOT->add ($self);
253	}	283	}
254		284
255	sub set_visible {	285	sub set_visible {
256	my ($self) = @_;	286	my ($self) = @_;
257		287
…		…
278	delete $self->{root};	308	delete $self->{root};
279		309
280	undef $GRAB if $GRAB == $self;	310	undef $GRAB if $GRAB == $self;
281	undef $HOVER if $HOVER == $self;	311	undef $HOVER if $HOVER == $self;
282		312
283	$CFClient::UI::TOOLTIP_WATCHER->cb->()	313	$CFPlus::UI::TOOLTIP_WATCHER->cb->()
284	if $TOOLTIP->{owner} == $self;	314	if $TOOLTIP->{owner} == $self;
285		315
286	$self->emit ("focus_out");	316	$self->emit ("focus_out");
287	$self->emit (visibility_change => 0);	317	$self->emit (visibility_change => 0);
288	}	318	}
…		…
290	sub set_visibility {	320	sub set_visibility {
291	my ($self, $visible) = @_;	321	my ($self, $visible) = @_;
292		322
293	return if $self->{visible} == $visible;	323	return if $self->{visible} == $visible;
294		324
295	$visible ? $self->hide	325	$visible ? $self->show
296	: $self->show;	326	: $self->hide;
297	}	327	}
298		328
299	sub toggle_visibility {	329	sub toggle_visibility {
300	my ($self) = @_;	330	my ($self) = @_;
301		331
…		…
335	sub size_request {	365	sub size_request {
336	require Carp;	366	require Carp;
337	Carp::confess "size_request is abstract";	367	Carp::confess "size_request is abstract";
338	}	368	}
339		369
		370	sub baseline_shift {
		371	0
		372	}
		373
340	sub configure {	374	sub configure {
341	my ($self, $x, $y, $w, $h) = @_;	375	my ($self, $x, $y, $w, $h) = @_;
342		376
343	if ($self->{aspect}) {	377	if ($self->{aspect}) {
344	my ($ow, $oh) = ($w, $h);	378	my ($ow, $oh) = ($w, $h);
345		379
346	$w = List::Util::min $w, int $h * $self->{aspect};	380	$w = List::Util::min $w, CFPlus::ceil $h * $self->{aspect};
347	$h = List::Util::min $h, int $w / $self->{aspect};	381	$h = List::Util::min $h, CFPlus::ceil $w / $self->{aspect};
348		382
349	# use alignment to adjust x, y	383	# use alignment to adjust x, y
350		384
351	$x += int 0.5 * ($ow - $w);	385	$x += int 0.5 * ($ow - $w);
352	$y += int 0.5 * ($oh - $h);	386	$y += int 0.5 * ($oh - $h);
…		…
393		427
394	return if $self->{tooltip} eq $tooltip;	428	return if $self->{tooltip} eq $tooltip;
395		429
396	$self->{tooltip} = $tooltip;	430	$self->{tooltip} = $tooltip;
397		431
398	if ($CFClient::UI::TOOLTIP->{owner} == $self) {	432	if ($CFPlus::UI::TOOLTIP->{owner} == $self) {
399	delete $CFClient::UI::TOOLTIP->{owner};	433	delete $CFPlus::UI::TOOLTIP->{owner};
400	$CFClient::UI::TOOLTIP_WATCHER->cb->();	434	$CFPlus::UI::TOOLTIP_WATCHER->cb->();
401	}	435	}
402	}	436	}
403		437
404	# translate global coordinates to local coordinate system	438	# translate global coordinates to local coordinate system
405	sub coord2local {	439	sub coord2local {
406	my ($self, $x, $y) = @_;	440	my ($self, $x, $y) = @_;
407		441
		442	Carp::confess unless $self->{parent};#d#
		443
408	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})	444	$self->{parent}->coord2local ($x - $self->{x}, $y - $self->{y})
409	}	445	}
410		446
411	# translate local coordinates to global coordinate system	447	# translate local coordinates to global coordinate system
412	sub coord2global {	448	sub coord2global {
413	my ($self, $x, $y) = @_;	449	my ($self, $x, $y) = @_;
414		450
		451	Carp::confess unless $self->{parent};#d#
		452
415	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})	453	$self->{parent}->coord2global ($x + $self->{x}, $y + $self->{y})
416	}	454	}
417		455
418	sub invoke_focus_in {	456	sub invoke_focus_in {
419	my ($self) = @_;	457	my ($self) = @_;
420		458
421	return if $FOCUS == $self;	459	return if $FOCUS == $self;
422	return unless $self->{can_focus};	460	return unless $self->{can_focus};
423		461
424	my $focus = $FOCUS; $FOCUS = $self;	462	$FOCUS = $self;
425		463
426	$focus->update if $focus;	464	$self->update;
427	$FOCUS->update;
428		465
429	0	466	0
430	}	467	}
431		468
432	sub invoke_focus_out {	469	sub invoke_focus_out {
433	my ($self) = @_;	470	my ($self) = @_;
434		471
435	return unless $FOCUS == $self;	472	return unless $FOCUS == $self;
436		473
437	my $focus = $FOCUS; undef $FOCUS;	474	undef $FOCUS;
438		475
439	$focus->update if $focus; #?	476	$self->update;
440		477
441	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus	478	$::MAPWIDGET->grab_focus #d# focus mapwidget if no other widget has focus
442	unless $FOCUS;	479	unless $FOCUS;
443		480
444	0	481	0
445	}	482	}
446		483
447	sub grab_focus {	484	sub grab_focus {
448	my ($self) = @_;	485	my ($self) = @_;
449		486
		487	$FOCUS->emit ("focus_out") if $FOCUS;
450	$self->emit ("focus_in");	488	$self->emit ("focus_in");
451	}	489	}
452		490
453	sub invoke_mouse_motion { 1 }	491	sub invoke_mouse_motion { 0 }
454	sub invoke_button_up { 1 }	492	sub invoke_button_up { 0 }
455	sub invoke_key_down { 1 }	493	sub invoke_key_down { 0 }
456	sub invoke_key_up { 1 }	494	sub invoke_key_up { 0 }
		495	sub invoke_mouse_wheel { 0 }
457		496
458	sub invoke_button_down {	497	sub invoke_button_down {
459	my ($self, $ev, $x, $y) = @_;	498	my ($self, $ev, $x, $y) = @_;
460		499
461	$self->grab_focus;	500	$self->grab_focus;
462		501
463	1	502	0
464	}	503	}
465		504
466	sub connect {	505	sub connect {
467	my ($self, $signal, $cb) = @_;	506	my ($self, $signal, $cb) = @_;
468		507
469	push @{ $self->{signal_cb}{$signal} }, $cb;	508	push @{ $self->{signal_cb}{$signal} }, $cb;
		509
		510	defined wantarray and CFPlus::guard {
		511	@{ $self->{signal_cb}{$signal} } = grep $_ != $cb,
		512	@{ $self->{signal_cb}{$signal} };
		513	}
470	}	514	}
		515
		516	sub disconnect_all {
		517	my ($self, $signal) = @_;
		518
		519	delete $self->{signal_cb}{$signal};
		520	}
		521
		522	my %has_coords = (
		523	button_down => 1,
		524	button_up => 1,
		525	mouse_motion => 1,
		526	mouse_wheel => 1,
		527	);
471		528
472	sub emit {	529	sub emit {
473	my ($self, $signal, @args) = @_;	530	my ($self, $signal, @args) = @_;
474		531
475	#d##TODO# stop propagating at first true, do not use sum	532	# 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	533	# and needlessly verbose code, either.
		534	my @append
		535	= $has_coords{$signal}
		536	? $args[0]->xy ($self)
		537	: ();
		538
		539	#warn +(caller(1))[3] . "emit $signal on $self (parent $self->{parent})\n";#d#
		540
		541	for my $cb (
		542	@{$self->{signal_cb}{$signal} || []}, # before
477	|| ($self->can ("invoke_$signal") || sub { 1 })->($self, @args) # closure	543	($self->can ("invoke_$signal") || sub { 1 }), # closure
		544	) {
		545	return $cb->($self, @args, @append) || next;
		546	}
		547
		548	# parent
478	|| ($self->{parent} && $self->{parent}->emit ($signal, @args)) # parent	549	$self->{parent} && $self->{parent}->emit ($signal, @args)
479	}	550	}
480		551
481	sub find_widget {	552	sub find_widget {
482	my ($self, $x, $y) = @_;	553	my ($self, $x, $y) = @_;
483		554
…		…
491	}	562	}
492		563
493	sub set_parent {	564	sub set_parent {
494	my ($self, $parent) = @_;	565	my ($self, $parent) = @_;
495		566
496	Scalar::Util::weaken ($self->{parent} = $parent);	567	CFPlus::weaken ($self->{parent} = $parent);
497	$self->set_visible if $parent->{visible};	568	$self->set_visible if $parent->{visible};
498	}	569	}
499		570
500	sub realloc {	571	sub realloc {
501	my ($self) = @_;	572	my ($self) = @_;
…		…
535	return unless $self->{h} && $self->{w};	606	return unless $self->{h} && $self->{w};
536		607
537	# update screen rectangle	608	# update screen rectangle
538	local $draw_x = $draw_x + $self->{x};	609	local $draw_x = $draw_x + $self->{x};
539	local $draw_y = $draw_y + $self->{y};	610	local $draw_y = $draw_y + $self->{y};
540	local $draw_w = $draw_x + $self->{w};
541	local $draw_h = $draw_y + $self->{h};
542		611
543	# skip widgets that are entirely outside the drawing area	612	# skip widgets that are entirely outside the drawing area
544	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)	613	return if ($draw_x + $self->{w} < 0) || ($draw_x >= $draw_w)
545	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);	614	|| ($draw_y + $self->{h} < 0) || ($draw_y >= $draw_h);
546		615
…		…
569	glVertex $self->{w} - 1, 0;	638	glVertex $self->{w} - 1, 0;
570	glVertex $self->{w} - 1, $self->{h} - 1;	639	glVertex $self->{w} - 1, $self->{h} - 1;
571	glVertex 0 , $self->{h} - 1;	640	glVertex 0 , $self->{h} - 1;
572	glEnd;	641	glEnd;
573	glPopMatrix;	642	glPopMatrix;
574	#CFClient::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;	643	#CFPlus::UI::Label->new (w => $self->{w}, h => $self->{h}, text => $self, fontsize => 0)->_draw;
575	}	644	}
576		645
577	$self->_draw;	646	$self->_draw;
578	glPopMatrix;	647	glPopMatrix;
579	}	648	}
…		…
582	my ($self) = @_;	651	my ($self) = @_;
583		652
584	warn "no draw defined for $self\n";	653	warn "no draw defined for $self\n";
585	}	654	}
586		655
		656	my $cntx;#d#
587	sub DESTROY {	657	sub DESTROY {
588	my ($self) = @_;	658	my ($self) = @_;
589		659
590	delete $WIDGET{$self+0};	660	return if CFPlus::in_destruct;
591		661
592	eval { $self->destroy };	662	eval { $self->destroy };
593	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;	663	warn "exception during widget destruction: $@" if $@ & $@ != /during global destruction/;
		664
		665	delete $WIDGET{$self+0};
594	}	666	}
595		667
596	#############################################################################	668	#############################################################################
597		669
598	package CFClient::UI::DrawBG;	670	package CFPlus::UI::DrawBG;
599		671
600	our @ISA = CFClient::UI::Base::;	672	our @ISA = CFPlus::UI::Base::;
601		673
602	use strict;	674	use strict;
603	use CFClient::OpenGL;	675	use CFPlus::OpenGL;
604		676
605	sub new {	677	sub new {
606	my $class = shift;	678	my $class = shift;
607		679
608	# range [value, low, high, page]	680	# range [value, low, high, page]
…		…
639	}	711	}
640	}	712	}
641		713
642	#############################################################################	714	#############################################################################
643		715
644	package CFClient::UI::Empty;	716	package CFPlus::UI::Empty;
645		717
646	our @ISA = CFClient::UI::Base::;	718	our @ISA = CFPlus::UI::Base::;
647		719
648	sub new {	720	sub new {
649	my ($class, %arg) = @_;	721	my ($class, %arg) = @_;
650	$class->SUPER::new (can_events => 0, %arg);	722	$class->SUPER::new (can_events => 0, %arg);
651	}	723	}
…		…
658		730
659	sub draw { }	731	sub draw { }
660		732
661	#############################################################################	733	#############################################################################
662		734
663	package CFClient::UI::Container;	735	package CFPlus::UI::Container;
664		736
665	our @ISA = CFClient::UI::Base::;	737	our @ISA = CFPlus::UI::Base::;
666		738
667	sub new {	739	sub new {
668	my ($class, %arg) = @_;	740	my ($class, %arg) = @_;
669		741
670	my $children = delete $arg{children};	742	my $children = delete $arg{children};
…		…
679	if $children;	751	if $children;
680		752
681	$self	753	$self
682	}	754	}
683		755
		756	sub realloc {
		757	my ($self) = @_;
		758
		759	$self->{force_realloc} = 1;
		760	$self->{force_size_alloc} = 1;
		761	$self->SUPER::realloc;
		762	}
		763
684	sub add {	764	sub add {
685	my ($self, @widgets) = @_;	765	my ($self, @widgets) = @_;
686		766
687	$_->set_parent ($self)	767	$_->set_parent ($self)
688	for @widgets;	768	for @widgets;
…		…
748	$_->draw for @{$self->{children}};	828	$_->draw for @{$self->{children}};
749	}	829	}
750		830
751	#############################################################################	831	#############################################################################
752		832
753	package CFClient::UI::Bin;	833	package CFPlus::UI::Bin;
754		834
755	our @ISA = CFClient::UI::Container::;	835	our @ISA = CFPlus::UI::Container::;
756		836
757	sub new {	837	sub new {
758	my ($class, %arg) = @_;	838	my ($class, %arg) = @_;
759		839
760	my $child = (delete $arg{child}) || new CFClient::UI::Empty::;	840	my $child = (delete $arg{child}) || new CFPlus::UI::Empty::;
761		841
762	$class->SUPER::new (children => [$child], %arg)	842	$class->SUPER::new (children => [$child], %arg)
763	}	843	}
764		844
765	sub add {	845	sub add {
…		…
772	sub remove {	852	sub remove {
773	my ($self, $widget) = @_;	853	my ($self, $widget) = @_;
774		854
775	$self->SUPER::remove ($widget);	855	$self->SUPER::remove ($widget);
776		856
777	$self->{children} = [new CFClient::UI::Empty]	857	$self->{children} = [new CFPlus::UI::Empty]
778	unless @{$self->{children}};	858	unless @{$self->{children}};
779	}	859	}
780		860
781	sub child { $_[0]->{children}[0] }	861	sub child { $_[0]->{children}[0] }
782		862
…		…
794		874
795	#############################################################################	875	#############################################################################
796		876
797	# back-buffered drawing area	877	# back-buffered drawing area
798		878
799	package CFClient::UI::Window;	879	package CFPlus::UI::Window;
800		880
801	our @ISA = CFClient::UI::Bin::;	881	our @ISA = CFPlus::UI::Bin::;
802		882
803	use CFClient::OpenGL;	883	use CFPlus::OpenGL;
804		884
805	sub new {	885	sub new {
806	my ($class, %arg) = @_;	886	my ($class, %arg) = @_;
807		887
808	my $self = $class->SUPER::new (%arg);	888	my $self = $class->SUPER::new (%arg);
…		…
830	}	910	}
831		911
832	sub render_child {	912	sub render_child {
833	my ($self) = @_;	913	my ($self) = @_;
834		914
835	$self->{texture} = new_from_opengl CFClient::Texture $self->{w}, $self->{h}, sub {	915	$self->{texture} = new_from_opengl CFPlus::Texture $self->{w}, $self->{h}, sub {
836	glClearColor 0, 0, 0, 0;	916	glClearColor 0, 0, 0, 0;
837	glClear GL_COLOR_BUFFER_BIT;	917	glClear GL_COLOR_BUFFER_BIT;
838		918
839	{	919	{
840	package CFClient::UI::Base;	920	package CFPlus::UI::Base;
841		921
842	($draw_x, $draw_y, $draw_w, $draw_h) =	922	local ($draw_x, $draw_y, $draw_w, $draw_h) =
843	(0, 0, $self->{w}, $self->{h});	923	(0, 0, $self->{w}, $self->{h});
		924
		925	$self->_render;
844	}	926	}
845
846	$self->_render;
847	};	927	};
848	}	928	}
849		929
850	sub _draw {	930	sub _draw {
851	my ($self) = @_;	931	my ($self) = @_;
852
853	my ($w, $h) = @$self{qw(w h)};
854		932
855	my $tex = $self->{texture}	933	my $tex = $self->{texture}
856	or return;	934	or return;
857		935
858	glEnable GL_TEXTURE_2D;	936	glEnable GL_TEXTURE_2D;
859	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	937	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
860	glColor 0, 0, 0, 1;	938	glColor 0, 0, 0, 1;
861		939
862	$tex->draw_quad_alpha_premultiplied (0, 0, $w, $h);	940	$tex->draw_quad_alpha_premultiplied (0, 0);
863		941
864	glDisable GL_TEXTURE_2D;	942	glDisable GL_TEXTURE_2D;
865	}	943	}
866		944
867	#############################################################################	945	#############################################################################
868		946
869	package CFClient::UI::ViewPort;	947	package CFPlus::UI::ViewPort;
870		948
		949	use List::Util qw(min max);
		950
871	our @ISA = CFClient::UI::Window::;	951	our @ISA = CFPlus::UI::Window::;
872		952
873	sub new {	953	sub new {
874	my $class = shift;	954	my $class = shift;
875		955
876	$class->SUPER::new (	956	$class->SUPER::new (
…		…
906	}	986	}
907		987
908	sub set_offset {	988	sub set_offset {
909	my ($self, $x, $y) = @_;	989	my ($self, $x, $y) = @_;
910		990
911	$self->{view_x} = int $x;	991	$self->{view_x} = max 0, min $self->child->{w} - $self->{w}, int $x;
912	$self->{view_y} = int $y;	992	$self->{view_y} = max 0, min $self->child->{h} - $self->{h}, int $y;
913		993
		994	$self->emit (changed => $self->{view_x}, $self->{view_y});
914	$self->update;	995	$self->update;
915	}	996	}
916		997
917	# hmm, this does not work for topleft of $self... but we should not ask for that	998	# hmm, this does not work for topleft of $self... but we should not ask for that
918	sub coord2local {	999	sub coord2local {
…		…
936	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}	1017	if ( $x >= $self->{x} && $x < $self->{x} + $self->{w}
937	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}	1018	&& $y >= $self->{y} && $y < $self->{y} + $self->{h}
938	) {	1019	) {
939	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})	1020	$self->child->find_widget ($x + $self->{view_x}, $y + $self->{view_y})
940	} else {	1021	} else {
941	$self->CFClient::UI::Base::find_widget ($x, $y)	1022	$self->CFPlus::UI::Base::find_widget ($x, $y)
942	}	1023	}
943	}	1024	}
944		1025
945	sub _render {	1026	sub _render {
946	my ($self) = @_;	1027	my ($self) = @_;
947		1028
948	local $CFClient::UI::Base::draw_x = $CFClient::UI::Base::draw_x - $self->{view_x};	1029	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};	1030	local $CFPlus::UI::Base::draw_y = $CFPlus::UI::Base::draw_y - $self->{view_y};
950		1031
951	CFClient::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};	1032	CFPlus::OpenGL::glTranslate -$self->{view_x}, -$self->{view_y};
952		1033
953	$self->SUPER::_render;	1034	$self->SUPER::_render;
954	}	1035	}
955		1036
956	#############################################################################	1037	#############################################################################
957		1038
958	package CFClient::UI::ScrolledWindow;	1039	package CFPlus::UI::ScrolledWindow;
959		1040
960	our @ISA = CFClient::UI::HBox::;	1041	our @ISA = CFPlus::UI::Table::;
961		1042
962	sub new {	1043	sub new {
963	my ($class, %arg) = @_;	1044	my ($class, %arg) = @_;
964		1045
965	my $child = delete $arg{child};	1046	my $child = delete $arg{child};
966		1047
967	my $self;	1048	my $self;
968		1049
969	my $slider = new CFClient::UI::Slider	1050	my $hslider = new CFPlus::UI::Slider
		1051	vertical => 0,
		1052	range => [0, 0, 1, 0.01], # HACK fix
		1053	on_changed => sub {
		1054	$self->{hpos} = $_[1];
		1055	$self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
		1056	},
		1057	;
		1058
		1059	my $vslider = new CFPlus::UI::Slider
970	vertical => 1,	1060	vertical => 1,
971	range => [0, 0, 1, 0.01], # HACK fix	1061	range => [0, 0, 1, 0.01], # HACK fix
972	on_changed => sub {	1062	on_changed => sub {
973	$self->{vp}->set_offset (0, $_[1]);	1063	$self->{vpos} = $_[1];
		1064	$self->{vp}->set_offset ($self->{hpos}, $self->{vpos});
974	},	1065	},
975	;	1066	;
976		1067
977	$self = $class->SUPER::new (	1068	$self = $class->SUPER::new (
978	vp => (new CFClient::UI::ViewPort expand => 1),	1069	scroll_x => 0,
		1070	scroll_y => 1,
		1071	can_events => 1,
979	slider => $slider,	1072	hslider => $hslider,
		1073	vslider => $vslider,
		1074	col_expand => [1, 0],
		1075	row_expand => [1, 0],
980	%arg,	1076	%arg,
981	);	1077	);
982		1078
		1079	$self->{vp} = new CFPlus::UI::ViewPort
		1080	expand => 1,
		1081	scroll_x => $self->{scroll_x},
		1082	scroll_y => $self->{scroll_y},
		1083	on_changed => sub {
		1084	my ($vp, $x, $y) = @_;
		1085
		1086	$vp->{parent}{hslider}->set_value ($x);
		1087	$vp->{parent}{vslider}->set_value ($y);
		1088
		1089	0
		1090	},
		1091	;
		1092
983	$self->SUPER::add ($self->{vp}, $self->{slider});	1093	$self->SUPER::add (0, 0, $self->{vp});
		1094
984	$self->add ($child) if $child;	1095	$self->add ($child) if $child;
985		1096
986	$self	1097	$self
987	}	1098	}
		1099
		1100	#TODO# update range on size_allocate depending on child
988		1101
989	sub add {	1102	sub add {
990	my ($self, $widget) = @_;	1103	my ($self, $widget) = @_;
991		1104
992	$self->{vp}->add ($self->{child} = $widget);	1105	$self->{vp}->add ($self->{child} = $widget);
993	}	1106	}
994		1107
		1108	sub update_slider {
		1109	my ($self) = @_;
		1110
		1111	my $child = ($self->{vp} or return)->child;
		1112
		1113	my ($w1, $w2) = ($child->{w}, $self->{vp}{w});
		1114	$self->{hslider}->set_range ([$self->{hslider}{range}[0], 0, $w1, $w2, 1]);
		1115
		1116	my $visible = $w1 > $w2;
		1117	if ($visible != $self->{hslider}{visible}) {
		1118	$visible ? $self->SUPER::add (0, 1, $self->{hslider})
		1119	: $self->{hslider}->hide;
		1120	}
		1121
		1122	my ($h1, $h2) = ($child->{h}, $self->{vp}{h});
		1123	$self->{vslider}->set_range ([$self->{vslider}{range}[0], 0, $h1, $h2, 1]);
		1124
		1125	my $visible = $h1 > $h2;
		1126	if ($visible != $self->{vslider}{visible}) {
		1127	$visible ? $self->SUPER::add (1, 0, $self->{vslider})
		1128	: $self->{vslider}->hide;
		1129	}
		1130	}
		1131
995	sub update {	1132	sub update {
996	my ($self) = @_;	1133	my ($self) = @_;
997		1134
998	$self->SUPER::update;	1135	$self->SUPER::update;
		1136	$self->update_slider;
		1137	}
999		1138
1000	# todo: overwrite size_allocate of child	1139	sub invoke_mouse_wheel {
1001	my $child = $self->{vp}->child;	1140	my ($self, $ev) = @_;
1002	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);	1141
		1142	return 0 unless $ev->{dy}; # only vertical movements for now
		1143
		1144	$self->{vslider}->emit (mouse_wheel => $ev);
		1145
		1146	1
		1147	}
		1148
		1149	sub invoke_button_down {
		1150	my ($self, $ev, $x, $y) = @_;
		1151
		1152	if ($ev->{button} == 2) {
		1153	$self->grab_focus;
		1154
		1155	my $ox = $self->{vp}{view_x} + $ev->{x};
		1156	my $oy = $self->{vp}{view_y} + $ev->{y};
		1157
		1158	$self->{motion} = sub {
		1159	my ($ev, $x, $y) = @_;
		1160
		1161	$self->{vp}->set_offset ($ox - $ev->{x}, $oy - $ev->{y});
		1162	$self->update;
		1163	};
		1164
		1165	return 1;
		1166	}
		1167
		1168	0
		1169	}
		1170
		1171	sub invoke_button_up {
		1172	my ($self, $ev, $x, $y) = @_;
		1173
		1174	if (delete $self->{motion}) {
		1175	return 1;
		1176	}
		1177
		1178	0
		1179	}
		1180
		1181	sub invoke_mouse_motion {
		1182	my ($self, $ev, $x, $y) = @_;
		1183
		1184	if ($self->{motion}) {
		1185	$self->{motion}->($ev, $x, $y);
		1186	return 1;
		1187	}
		1188
		1189	0
1003	}	1190	}
1004		1191
1005	sub invoke_size_allocate {	1192	sub invoke_size_allocate {
1006	my ($self, $w, $h) = @_;	1193	my ($self, $w, $h) = @_;
1007		1194
1008	my $child = $self->{vp}->child;	1195	$self->update_slider;
1009	$self->{slider}->set_range ([$self->{slider}{range}[0], 0, $child->{h}, $self->{vp}{h}, 1]);
1010
1011	$self->SUPER::invoke_size_allocate ($w, $h)	1196	$self->SUPER::invoke_size_allocate ($w, $h)
1012	}	1197	}
1013		1198
1014	#TODO# update range on size_allocate depending on child
1015	# update viewport offset on scroll
1016
1017	#############################################################################	1199	#############################################################################
1018		1200
1019	package CFClient::UI::Frame;	1201	package CFPlus::UI::Frame;
1020		1202
1021	our @ISA = CFClient::UI::Bin::;	1203	our @ISA = CFPlus::UI::Bin::;
1022		1204
1023	use CFClient::OpenGL;	1205	use CFPlus::OpenGL;
1024		1206
1025	sub new {	1207	sub new {
1026	my $class = shift;	1208	my $class = shift;
1027		1209
1028	$class->SUPER::new (	1210	$class->SUPER::new (
…		…
1054	$self->SUPER::_draw;	1236	$self->SUPER::_draw;
1055	}	1237	}
1056		1238
1057	#############################################################################	1239	#############################################################################
1058		1240
1059	package CFClient::UI::FancyFrame;	1241	package CFPlus::UI::FancyFrame;
1060		1242
1061	our @ISA = CFClient::UI::Bin::;	1243	our @ISA = CFPlus::UI::Bin::;
1062		1244
1063	use CFClient::OpenGL;	1245	use CFPlus::OpenGL;
		1246
		1247	sub new {
		1248	my ($class, %arg) = @_;
		1249
		1250	if ((exists $arg{label}) && !ref $arg{label}) {
		1251	$arg{label} = new CFPlus::UI::Label
		1252	align => 1,
		1253	valign => 0,
		1254	text => $arg{label},
		1255	fontsize => ($arg{border} || 0.8) * 0.75;
		1256	}
		1257
		1258	my $self = $class->SUPER::new (
		1259	# label => "",
		1260	fg => [0.6, 0.3, 0.1],
		1261	border => 0.8,
		1262	style => 'single',
		1263	%arg,
		1264	);
		1265
		1266	$self
		1267	}
		1268
		1269	sub add {
		1270	my ($self, @widgets) = @_;
		1271
		1272	$self->SUPER::add (@widgets);
		1273	$self->CFPlus::UI::Container::add ($self->{label}) if $self->{label};
		1274	}
		1275
		1276	sub border {
		1277	int $_[0]{border} * $::FONTSIZE
		1278	}
		1279
		1280	sub size_request {
		1281	my ($self) = @_;
		1282
		1283	($self->{label_w}, undef) = $self->{label}->size_request
		1284	if $self->{label};
		1285
		1286	my ($w, $h) = $self->SUPER::size_request;
		1287
		1288	(
		1289	$w + $self->border * 2,
		1290	$h + $self->border * 2,
		1291	)
		1292	}
		1293
		1294	sub invoke_size_allocate {
		1295	my ($self, $w, $h) = @_;
		1296
		1297	my $border = $self->border;
		1298
		1299	$w -= List::Util::max 0, $border * 2;
		1300	$h -= List::Util::max 0, $border * 2;
		1301
		1302	if (my $label = $self->{label}) {
		1303	$label->{w} = List::Util::max 0, List::Util::min $self->{label_w}, $w - $border * 2;
		1304	$label->{h} = List::Util::min $h, $border;
		1305	$label->invoke_size_allocate ($label->{w}, $label->{h});
		1306	}
		1307
		1308	$self->child->configure ($border, $border, $w, $h);
		1309
		1310	1
		1311	}
		1312
		1313	sub _draw {
		1314	my ($self) = @_;
		1315
		1316	my $child = $self->{children}[0];
		1317
		1318	my $border = $self->border;
		1319	my ($w, $h) = ($self->{w}, $self->{h});
		1320
		1321	$child->draw;
		1322
		1323	glColor @{$self->{fg}};
		1324	glBegin GL_LINE_STRIP;
		1325	glVertex $border * 1.5 , $border * 0.5 + 0.5;
		1326	glVertex $border * 0.5 + 0.5, $border * 0.5 + 0.5;
		1327	glVertex $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
		1328	glVertex $w - $border * 0.5 + 0.5, $h - $border * 0.5 + 0.5;
		1329	glVertex $w - $border * 0.5 + 0.5, $border * 0.5 + 0.5;
		1330	glVertex $self->{label} ? $border * 2 + $self->{label}{w} : $border * 1.5, $border * 0.5 + 0.5;
		1331	glEnd;
		1332
		1333	if ($self->{label}) {
		1334	glTranslate $border * 2, 0;
		1335	$self->{label}->_draw;
		1336	}
		1337	}
		1338
		1339	#############################################################################
		1340
		1341	package CFPlus::UI::Toplevel;
		1342
		1343	our @ISA = CFPlus::UI::Bin::;
		1344
		1345	use CFPlus::OpenGL;
1064		1346
1065	my $bg =	1347	my $bg =
1066	new_from_file CFClient::Texture CFClient::find_rcfile "d1_bg.png",	1348	new_from_file CFPlus::Texture CFPlus::find_rcfile "d1_bg.png",
1067	mipmap => 1, wrap => 1;	1349	mipmap => 1, wrap => 1;
1068		1350
1069	my @border =	1351	my @border =
1070	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	1352	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);	1353	qw(d1_border_top.png d1_border_right.png d1_border_left.png d1_border_bottom.png);
1072		1354
1073	sub new {	1355	sub new {
1074	my ($class, %arg) = @_;	1356	my ($class, %arg) = @_;
1075		1357
1076	my $self = $class->SUPER::new (	1358	my $self = $class->SUPER::new (
1077	bg => [1, 1, 1, 1],	1359	bg => [1, 1, 1, 1],
1078	border_bg => [1, 1, 1, 1],	1360	border_bg => [1, 1, 1, 1],
1079	border => 0.6,	1361	border => 0.6,
1080	can_events => 1,	1362	can_events => 1,
1081	min_w => 16,	1363	min_w => 64,
1082	min_h => 16,	1364	min_h => 32,
1083	%arg,	1365	%arg,
1084	);	1366	);
1085		1367
1086	$self->{title_widget} = new CFClient::UI::Label	1368	$self->{title_widget} = new CFPlus::UI::Label
1087	align => 0,	1369	align => 0,
1088	valign => 1,	1370	valign => 1,
1089	text => $self->{title},	1371	text => $self->{title},
1090	fontsize => $self->{border},	1372	fontsize => $self->{border},
1091	if exists $self->{title};	1373	if exists $self->{title};
1092		1374
1093	if ($self->{has_close_button}) {	1375	if ($self->{has_close_button}) {
1094	$self->{close_button} =	1376	$self->{close_button} =
1095	new CFClient::UI::ImageButton	1377	new CFPlus::UI::ImageButton
1096	image => 'x1_close.png',	1378	path => 'x1_close.png',
1097	on_activate => sub { $self->hide };	1379	on_activate => sub { $self->emit ("delete") };
1098		1380
1099	$self->CFClient::UI::Container::add ($self->{close_button});	1381	$self->CFPlus::UI::Container::add ($self->{close_button});
1100	}	1382	}
1101		1383
1102	$self	1384	$self
1103	}	1385	}
1104		1386
1105	sub add {	1387	sub add {
1106	my ($self, @widgets) = @_;	1388	my ($self, @widgets) = @_;
1107		1389
1108	$self->SUPER::add (@widgets);	1390	$self->SUPER::add (@widgets);
1109	$self->CFClient::UI::Container::add ($self->{close_button}) if $self->{close_button};	1391	$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};	1392	$self->CFPlus::UI::Container::add ($self->{title_widget}) if $self->{title_widget};
1111	}	1393	}
1112		1394
1113	sub border {	1395	sub border {
1114	int $_[0]{border} * $::FONTSIZE	1396	int $_[0]{border} * $::FONTSIZE
1115	}	1397	}
…		…
1148	$self->child->configure ($border, $border, $w, $h);	1430	$self->child->configure ($border, $border, $w, $h);
1149		1431
1150	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)	1432	$self->{close_button}->configure ($self->{w} - $border, 0, $border, $border)
1151	if $self->{close_button};	1433	if $self->{close_button};
1152		1434
		1435	1
		1436	}
		1437
		1438	sub invoke_delete {
		1439	my ($self) = @_;
		1440
		1441	$self->hide;
		1442
1153	1	1443	1
1154	}	1444	}
1155		1445
1156	sub invoke_button_down {	1446	sub invoke_button_down {
1157	my ($self, $ev, $x, $y) = @_;	1447	my ($self, $ev, $x, $y) = @_;
…		…
1215	$self->{motion}->($ev, $x, $y) if $self->{motion};	1505	$self->{motion}->($ev, $x, $y) if $self->{motion};
1216		1506
1217	! ! $self->{motion}	1507	! ! $self->{motion}
1218	}	1508	}
1219		1509
		1510	sub invoke_visibility_change {
		1511	my ($self, $visible) = @_;
		1512
		1513	delete $self->{motion} unless $visible;
		1514
		1515	0
		1516	}
		1517
1220	sub _draw {	1518	sub _draw {
1221	my ($self) = @_;	1519	my ($self) = @_;
1222		1520
1223	my $child = $self->{children}[0];	1521	my $child = $self->{children}[0];
1224		1522
…		…
1261	if $self->{close_button};	1559	if $self->{close_button};
1262	}	1560	}
1263		1561
1264	#############################################################################	1562	#############################################################################
1265		1563
1266	package CFClient::UI::Table;	1564	package CFPlus::UI::Table;
1267		1565
1268	our @ISA = CFClient::UI::Base::;	1566	our @ISA = CFPlus::UI::Base::;
1269		1567
1270	use List::Util qw(max sum);	1568	use List::Util qw(max sum);
1271		1569
1272	use CFClient::OpenGL;	1570	use CFPlus::OpenGL;
1273		1571
1274	sub new {	1572	sub new {
1275	my $class = shift;	1573	my $class = shift;
1276		1574
1277	$class->SUPER::new (	1575	$class->SUPER::new (
		1576	children => [],
1278	col_expand => [],	1577	col_expand => [],
		1578	row_expand => [],
1279	@_,	1579	@_,
1280	)	1580	)
1281	}	1581	}
1282		1582
1283	sub children {	1583	sub children {
1284	grep $_, map @$_, grep $_, @{ $_[0]{children} }	1584	grep $_, map @$_, grep $_, @{ $_[0]{children} }
1285	}	1585	}
1286		1586
		1587	# TODO: store row/col info in child widget and use standard add/del
1287	sub add {	1588	sub add {
1288	my ($self, $x, $y, $child) = @_;	1589	my ($self) = shift;
1289		1590
		1591	while (@_) {
		1592	my ($x, $y, $child) = splice @_, 0, 3, ();
1290	$child->set_parent ($self);	1593	$child->set_parent ($self);
1291	$self->{children}[$y][$x] = $child;	1594	$self->{children}[$y][$x] = $child;
		1595	}
1292		1596
		1597	$self->{force_realloc} = 1;
		1598	$self->{force_size_alloc} = 1;
1293	$self->realloc;	1599	$self->realloc;
1294	}	1600	}
1295		1601
1296	sub remove {	1602	sub remove {
1297	my ($self, $child) = @_;	1603	my ($self, $child) = @_;
1298		1604
1299	# TODO: not yet implemented	1605	for (@{ $self->{children} }) {
		1606	for (@{ $_ || [] }) {
		1607	$_ = undef if $_ == $child;
		1608	}
		1609	}
1300	}	1610	}
1301		1611
1302	# TODO: move to container class maybe? send children a signal on removal?	1612	# TODO: move to container class maybe? send children a signal on removal?
1303	sub clear {	1613	sub clear {
1304	my ($self) = @_;	1614	my ($self) = @_;
…		…
1353	my ($ws, $hs) = $self->get_wh;	1663	my ($ws, $hs) = $self->get_wh;
1354		1664
1355	my $req_w = (sum @$ws) || 1;	1665	my $req_w = (sum @$ws) || 1;
1356	my $req_h = (sum @$hs) || 1;	1666	my $req_h = (sum @$hs) || 1;
1357		1667
1358	# TODO: nicer code && do row_expand	1668	# TODO: nicer code
1359	my @col_expand = @{$self->{col_expand}};	1669	my @col_expand = @{$self->{col_expand}};
1360	@col_expand = (1) x @$ws unless @col_expand;	1670	@col_expand = (1) x @$ws unless @col_expand;
1361	my $col_expand = (sum @col_expand) || 1;	1671	my $col_expand = (sum @col_expand) || 1;
1362		1672
1363	# linearly scale sizes
1364	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;	1673	$ws->[$_] += $col_expand[$_] / $col_expand * ($w - $req_w) for 0 .. $#$ws;
1365	$hs->[$_] *= 1 * $h / $req_h for 0 .. $#$hs;
1366		1674
1367	CFClient::UI::harmonize $ws;	1675	CFPlus::UI::harmonize $ws;
		1676
		1677	my @row_expand = @{$self->{row_expand}};
		1678	@row_expand = (1) x @$ws unless @row_expand;
		1679	my $row_expand = (sum @row_expand) || 1;
		1680
		1681	$hs->[$_] += $row_expand[$_] / $row_expand * ($h - $req_h) for 0 .. $#$hs;
		1682
1368	CFClient::UI::harmonize $hs;	1683	CFPlus::UI::harmonize $hs;
1369		1684
1370	my $y;	1685	my $y;
1371		1686
1372	for my $r (0 .. $#{$self->{children}}) {	1687	for my $r (0 .. $#{$self->{children}}) {
1373	my $row = $self->{children}[$r]	1688	my $row = $self->{children}[$r]
…		…
1416	}	1731	}
1417	}	1732	}
1418		1733
1419	#############################################################################	1734	#############################################################################
1420		1735
1421	package CFClient::UI::Box;	1736	package CFPlus::UI::Fixed;
1422		1737
		1738	use List::Util qw(min max);
		1739
1423	our @ISA = CFClient::UI::Container::;	1740	our @ISA = CFPlus::UI::Container::;
		1741
		1742	sub add {
		1743	my ($self, $child, $posmode, $x, $y, $sizemode, $w, $h) = @_;
		1744
		1745	$child->{_fixed} = [$posmode, $x, $y, $sizemode, $w, $h];
		1746	$self->SUPER::add ($child);
		1747	}
		1748
		1749	sub _scale($$$) {
		1750	my ($mode, $val, $max) = @_;
		1751
		1752	$mode eq "abs" ? $val
		1753	: $mode eq "rel" ? $val * $max
		1754	: 0
		1755	}
		1756
		1757	sub size_request {
		1758	my ($self) = @_;
		1759
		1760	my ($x1, $y1, $x2, $y2) = (0, 0, 0, 0);
		1761
		1762	# determine overall size by querying abs widgets
		1763	for my $child ($self->visible_children) {
		1764	my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };
		1765
		1766	if ($pos eq "abs") {
		1767	$w = _scale $size, $w, $child->{req_w};
		1768	$h = _scale $size, $h, $child->{req_h};
		1769
		1770	$x1 = min $x1, $x; $x2 = max $x2, $x + $w;
		1771	$y1 = min $y1, $y; $y2 = max $y2, $y + $h;
		1772	}
		1773	}
		1774
		1775	my $W = $x2 - $x1;
		1776	my $H = $y2 - $y1;
		1777
		1778	# now layout remaining widgets
		1779	for my $child ($self->visible_children) {
		1780	my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };
		1781
		1782	if ($pos ne "abs") {
		1783	$x = _scale $pos, $x, $W;
		1784	$y = _scale $pos, $x, $H;
		1785	$w = _scale $size, $w, $child->{req_w};
		1786	$h = _scale $size, $h, $child->{req_h};
		1787
		1788	$x1 = min $x1, $x; $x2 = max $x2, $x + $w;
		1789	$y1 = min $y1, $y; $y2 = max $y2, $y + $h;
		1790	}
		1791	}
		1792
		1793	my $W = $x2 - $x1;
		1794	my $H = $y2 - $y1;
		1795
		1796	($W, $H)
		1797	}
		1798
		1799	sub invoke_size_allocate {
		1800	my ($self, $W, $H) = @_;
		1801
		1802	for my $child ($self->visible_children) {
		1803	my ($pos, $x, $y, $size, $w, $h) = @{ $child->{_fixed} };
		1804
		1805	$x = _scale $pos, $x, $W;
		1806	$y = _scale $pos, $x, $H;
		1807	$w = _scale $size, $w, $child->{req_w};
		1808	$h = _scale $size, $h, $child->{req_h};
		1809
		1810	$child->configure ($x, $y, $w, $h);
		1811	}
		1812
		1813	1
		1814	}
		1815
		1816	#############################################################################
		1817
		1818	package CFPlus::UI::Box;
		1819
		1820	our @ISA = CFPlus::UI::Container::;
1424		1821
1425	sub size_request {	1822	sub size_request {
1426	my ($self) = @_;	1823	my ($self) = @_;
1427		1824
1428	$self->{vertical}	1825	$self->{vertical}
…		…
1438		1835
1439	sub invoke_size_allocate {	1836	sub invoke_size_allocate {
1440	my ($self, $w, $h) = @_;	1837	my ($self, $w, $h) = @_;
1441		1838
1442	my $space = $self->{vertical} ? $h : $w;	1839	my $space = $self->{vertical} ? $h : $w;
1443	my $children = $self->{children};	1840	my @children = $self->visible_children;
1444		1841
1445	my @req;	1842	my @req;
1446		1843
1447	if ($self->{homogeneous}) {	1844	if ($self->{homogeneous}) {
1448	@req = ($space / (@$children || 1)) x @$children;	1845	@req = ($space / (@children || 1)) x @children;
1449	} else {	1846	} else {
1450	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @$children;	1847	@req = map $_->{$self->{vertical} ? "req_h" : "req_w"}, @children;
1451	my $req = List::Util::sum @req;	1848	my $req = List::Util::sum @req;
1452		1849
1453	if ($req > $space) {	1850	if ($req > $space) {
1454	# ah well, not enough space	1851	# ah well, not enough space
1455	$_ *= $space / $req for @req;	1852	$_ *= $space / $req for @req;
1456	} else {	1853	} else {
1457	my $expand = (List::Util::sum map $_->{expand}, @$children) || 1;	1854	my $expand = (List::Util::sum map $_->{expand}, @children) || 1;
1458		1855
1459	$space = ($space - $req) / $expand; # remaining space to give away	1856	$space = ($space - $req) / $expand; # remaining space to give away
1460		1857
1461	$req[$_] += $space * $children->[$_]{expand}	1858	$req[$_] += $space * $children[$_]{expand}
1462	for 0 .. $#$children;	1859	for 0 .. $#children;
1463	}	1860	}
1464	}	1861	}
1465		1862
1466	CFClient::UI::harmonize \@req;	1863	CFPlus::UI::harmonize \@req;
1467		1864
1468	my $pos = 0;	1865	my $pos = 0;
1469	for (0 .. $#$children) {	1866	for (0 .. $#children) {
1470	my $alloc = $req[$_];	1867	my $alloc = $req[$_];
1471	$children->[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));	1868	$children[$_]->configure ($self->{vertical} ? (0, $pos, $w, $alloc) : ($pos, 0, $alloc, $h));
1472		1869
1473	$pos += $alloc;	1870	$pos += $alloc;
1474	}	1871	}
1475		1872
1476	1	1873	1
1477	}	1874	}
1478		1875
1479	#############################################################################	1876	#############################################################################
1480		1877
1481	package CFClient::UI::HBox;	1878	package CFPlus::UI::HBox;
1482		1879
1483	our @ISA = CFClient::UI::Box::;	1880	our @ISA = CFPlus::UI::Box::;
1484		1881
1485	sub new {	1882	sub new {
1486	my $class = shift;	1883	my $class = shift;
1487		1884
1488	$class->SUPER::new (	1885	$class->SUPER::new (
…		…
1491	)	1888	)
1492	}	1889	}
1493		1890
1494	#############################################################################	1891	#############################################################################
1495		1892
1496	package CFClient::UI::VBox;	1893	package CFPlus::UI::VBox;
1497		1894
1498	our @ISA = CFClient::UI::Box::;	1895	our @ISA = CFPlus::UI::Box::;
1499		1896
1500	sub new {	1897	sub new {
1501	my $class = shift;	1898	my $class = shift;
1502		1899
1503	$class->SUPER::new (	1900	$class->SUPER::new (
…		…
1506	)	1903	)
1507	}	1904	}
1508		1905
1509	#############################################################################	1906	#############################################################################
1510		1907
1511	package CFClient::UI::Label;	1908	package CFPlus::UI::Label;
1512		1909
1513	our @ISA = CFClient::UI::DrawBG::;	1910	our @ISA = CFPlus::UI::DrawBG::;
1514		1911
1515	use CFClient::OpenGL;	1912	use CFPlus::OpenGL;
1516		1913
1517	sub new {	1914	sub new {
1518	my ($class, %arg) = @_;	1915	my ($class, %arg) = @_;
1519		1916
1520	my $self = $class->SUPER::new (	1917	my $self = $class->SUPER::new (
…		…
1523	#active_bg => none	1920	#active_bg => none
1524	#font => default_font	1921	#font => default_font
1525	#text => initial text	1922	#text => initial text
1526	#markup => initial narkup	1923	#markup => initial narkup
1527	#max_w => maximum pixel width	1924	#max_w => maximum pixel width
		1925	#style => 0, # render flags
1528	ellipsise => 3, # end	1926	ellipsise => 3, # end
1529	layout => (new CFClient::Layout),	1927	layout => (new CFPlus::Layout),
1530	fontsize => 1,	1928	fontsize => 1,
1531	align => -1,	1929	align => -1,
1532	valign => -1,	1930	valign => -1,
1533	padding_x => 2,	1931	padding_x => 2,
1534	padding_y => 2,	1932	padding_y => 2,
1535	can_events => 0,	1933	can_events => 0,
1536	%arg	1934	%arg
1537	);	1935	);
1538		1936
1539	if (exists $self->{template}) {	1937	if (exists $self->{template}) {
1540	my $layout = new CFClient::Layout;	1938	my $layout = new CFPlus::Layout;
1541	$layout->set_text (delete $self->{template});	1939	$layout->set_text (delete $self->{template});
1542	$self->{template} = $layout;	1940	$self->{template} = $layout;
1543	}	1941	}
1544		1942
1545	if (exists $self->{markup}) {	1943	if (exists $self->{markup}) {
…		…
1549	}	1947	}
1550		1948
1551	$self	1949	$self
1552	}	1950	}
1553		1951
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 {	1952	sub update {
1565	my ($self) = @_;	1953	my ($self) = @_;
1566		1954
1567	delete $self->{texture};	1955	delete $self->{texture};
1568	$self->SUPER::update;	1956	$self->SUPER::update;
…		…
1579	my ($self, $text) = @_;	1967	my ($self, $text) = @_;
1580		1968
1581	return if $self->{text} eq "T$text";	1969	return if $self->{text} eq "T$text";
1582	$self->{text} = "T$text";	1970	$self->{text} = "T$text";
1583		1971
1584	$self->{layout} = new CFClient::Layout if $self->{layout}->is_rgba;
1585	$self->{layout}->set_text ($text);	1972	$self->{layout}->set_text ($text);
1586		1973
1587	delete $self->{size_req};	1974	delete $self->{size_req};
1588	$self->realloc;	1975	$self->realloc;
1589	$self->update;	1976	$self->update;
…		…
1595	return if $self->{text} eq "M$markup";	1982	return if $self->{text} eq "M$markup";
1596	$self->{text} = "M$markup";	1983	$self->{text} = "M$markup";
1597		1984
1598	my $rgba = $markup =~ /span.*(?:foreground|background)/;	1985	my $rgba = $markup =~ /span.*(?:foreground|background)/;
1599		1986
1600	$self->{layout} = new CFClient::Layout $rgba if $self->{layout}->is_rgba != $rgba;
1601	$self->{layout}->set_markup ($markup);	1987	$self->{layout}->set_markup ($markup);
1602		1988
1603	delete $self->{size_req};	1989	delete $self->{size_req};
1604	$self->realloc;	1990	$self->realloc;
1605	$self->update;	1991	$self->update;
…		…
1617		2003
1618	my ($w, $h) = $self->{layout}->size;	2004	my ($w, $h) = $self->{layout}->size;
1619		2005
1620	if (exists $self->{template}) {	2006	if (exists $self->{template}) {
1621	$self->{template}->set_font ($self->{font}) if $self->{font};	2007	$self->{template}->set_font ($self->{font}) if $self->{font};
		2008	$self->{template}->set_width ($self->{max_w} || -1);
1622	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);	2009	$self->{template}->set_height ($self->{fontsize} * $::FONTSIZE);
1623		2010
1624	my ($w2, $h2) = $self->{template}->size;	2011	my ($w2, $h2) = $self->{template}->size;
1625		2012
1626	$w = List::Util::max $w, $w2;	2013	$w = List::Util::max $w, $w2;
…		…
1631	};	2018	};
1632		2019
1633	@{ $self->{size_req} }	2020	@{ $self->{size_req} }
1634	}	2021	}
1635		2022
		2023	sub baseline_shift {
		2024	$_[0]{layout}->descent
		2025	}
		2026
1636	sub invoke_size_allocate {	2027	sub invoke_size_allocate {
1637	my ($self, $w, $h) = @_;	2028	my ($self, $w, $h) = @_;
1638		2029
1639	delete $self->{ox};	2030	delete $self->{ox};
1640		2031
…		…
1646		2037
1647	sub set_fontsize {	2038	sub set_fontsize {
1648	my ($self, $fontsize) = @_;	2039	my ($self, $fontsize) = @_;
1649		2040
1650	$self->{fontsize} = $fontsize;	2041	$self->{fontsize} = $fontsize;
		2042	delete $self->{size_req};
1651	delete $self->{texture};	2043	delete $self->{texture};
1652		2044
1653	$self->realloc;	2045	$self->realloc;
1654	}	2046	}
1655		2047
1656	sub reconfigure {	2048	sub reconfigure {
1657	my ($self) = @_;	2049	my ($self) = @_;
1658		2050
1659	delete $self->{size_req};	2051	delete $self->{size_req};
		2052	delete $self->{texture};
1660		2053
1661	$self->SUPER::reconfigure;	2054	$self->SUPER::reconfigure;
1662	}	2055	}
1663		2056
1664	sub _draw {	2057	sub _draw {
1665	my ($self) = @_;	2058	my ($self) = @_;
1666		2059
1667	$self->SUPER::_draw; # draw background, if applicable	2060	$self->SUPER::_draw; # draw background, if applicable
1668		2061
1669	my $tex = $self->{texture} ||= do {	2062	my $size = $self->{texture} ||= do {
1670	$self->{layout}->set_foreground (@{$self->{fg}});	2063	$self->{layout}->set_foreground (@{$self->{fg}});
1671	$self->{layout}->set_font ($self->{font}) if $self->{font};	2064	$self->{layout}->set_font ($self->{font}) if $self->{font};
1672	$self->{layout}->set_width ($self->{w});	2065	$self->{layout}->set_width ($self->{w});
1673	$self->{layout}->set_ellipsise ($self->{ellipsise});	2066	$self->{layout}->set_ellipsise ($self->{ellipsise});
1674	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});	2067	$self->{layout}->set_single_paragraph_mode ($self->{ellipsise});
1675	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	2068	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
1676		2069
1677	new_from_layout CFClient::Texture $self->{layout}	2070	[$self->{layout}->size]
1678	};	2071	};
1679		2072
1680	unless (exists $self->{ox}) {	2073	unless (exists $self->{ox}) {
1681	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}	2074	$self->{ox} = int ($self->{align} < 0 ? $self->{padding_x}
1682	: $self->{align} > 0 ? $self->{w} - $tex->{w} - $self->{padding_x}	2075	: $self->{align} > 0 ? $self->{w} - $size->[0] - $self->{padding_x}
1683	: ($self->{w} - $tex->{w}) * 0.5);	2076	: ($self->{w} - $size->[0]) * 0.5);
1684		2077
1685	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}	2078	$self->{oy} = int ($self->{valign} < 0 ? $self->{padding_y}
1686	: $self->{valign} > 0 ? $self->{h} - $tex->{h} - $self->{padding_y}	2079	: $self->{valign} > 0 ? $self->{h} - $size->[1] - $self->{padding_y}
1687	: ($self->{h} - $tex->{h}) * 0.5);	2080	: ($self->{h} - $size->[1]) * 0.5);
1688	};	2081	};
1689		2082
1690	glEnable GL_TEXTURE_2D;
1691
1692	my $w = List::Util::min $self->{w} + 4, $tex->{w};	2083	my $w = List::Util::min $self->{w} + 4, $size->[0];
1693	my $h = List::Util::min $self->{h} + 2, $tex->{h};	2084	my $h = List::Util::min $self->{h} + 2, $size->[1];
1694		2085
1695	if ($tex->{format} == GL_ALPHA) {	2086	$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	}	2087	}
1706		2088
1707	#############################################################################	2089	#############################################################################
1708		2090
1709	package CFClient::UI::EntryBase;	2091	package CFPlus::UI::EntryBase;
1710		2092
1711	our @ISA = CFClient::UI::Label::;	2093	our @ISA = CFPlus::UI::Label::;
1712		2094
1713	use CFClient::OpenGL;	2095	use CFPlus::OpenGL;
1714		2096
1715	sub new {	2097	sub new {
1716	my $class = shift;	2098	my $class = shift;
1717		2099
1718	$class->SUPER::new (	2100	$class->SUPER::new (
…		…
1722	active_fg => [0, 0, 0],	2104	active_fg => [0, 0, 0],
1723	can_hover => 1,	2105	can_hover => 1,
1724	can_focus => 1,	2106	can_focus => 1,
1725	valign => 0,	2107	valign => 0,
1726	can_events => 1,	2108	can_events => 1,
		2109	ellipsise => 0,
1727	#text => ...	2110	#text => ...
1728	#hidden => "*",	2111	#hidden => "*",
1729	@_	2112	@_
1730	)	2113	)
1731	}	2114	}
…		…
1776	my $sym = $ev->{sym};	2159	my $sym = $ev->{sym};
1777	my $uni = $ev->{unicode};	2160	my $uni = $ev->{unicode};
1778		2161
1779	my $text = $self->get_text;	2162	my $text = $self->get_text;
1780		2163
		2164	$self->{cursor} = List::Util::max 0, List::Util::min $self->{cursor}, length $text;
		2165
1781	if ($uni == 8) {	2166	if ($uni == 8) {
1782	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};	2167	substr $text, --$self->{cursor}, 1, "" if $self->{cursor};
1783	} elsif ($uni == 127) {	2168	} elsif ($uni == 127) {
1784	substr $text, $self->{cursor}, 1, "";	2169	substr $text, $self->{cursor}, 1, "";
1785	} elsif ($sym == CFClient::SDLK_LEFT) {	2170	} elsif ($sym == CFPlus::SDLK_LEFT) {
1786	--$self->{cursor} if $self->{cursor};	2171	--$self->{cursor} if $self->{cursor};
1787	} elsif ($sym == CFClient::SDLK_RIGHT) {	2172	} elsif ($sym == CFPlus::SDLK_RIGHT) {
1788	++$self->{cursor} if $self->{cursor} < length $self->{text};	2173	++$self->{cursor} if $self->{cursor} < length $self->{text};
1789	} elsif ($sym == CFClient::SDLK_HOME) {	2174	} elsif ($sym == CFPlus::SDLK_HOME) {
		2175	# what a hack
		2176	$self->{cursor} =
		2177	(substr $self->{text}, 0, $self->{cursor}) =~ /^(.*\012)/
		2178	? length $1
		2179	: 0;
		2180	} elsif ($sym == CFPlus::SDLK_END) {
		2181	# uh, again
		2182	$self->{cursor} =
		2183	(substr $self->{text}, $self->{cursor}) =~ /^([^\012]*)\012/
		2184	? $self->{cursor} + length $1
		2185	: length $self->{text};
		2186	} elsif ($uni == 21) { # ctrl-u
		2187	$text = "";
1790	$self->{cursor} = 0;	2188	$self->{cursor} = 0;
1791	} elsif ($sym == CFClient::SDLK_END) {
1792	$self->{cursor} = length $text;
1793	} elsif ($uni == 27) {	2189	} elsif ($uni == 27) {
1794	$self->emit ('escape');	2190	$self->emit ('escape');
1795	} elsif ($uni) {	2191	} elsif ($uni == 0x0d) {
		2192	substr $text, $self->{cursor}++, 0, "\012";
		2193	} elsif ($uni >= 0x20) {
1796	substr $text, $self->{cursor}++, 0, chr $uni;	2194	substr $text, $self->{cursor}++, 0, chr $uni;
1797	} else {	2195	} else {
1798	return 0;	2196	return 0;
1799	}	2197	}
1800		2198
1801	$self->_set_text ($text);	2199	$self->_set_text ($text);
1802		2200
1803	$self->realloc;	2201	$self->realloc;
		2202	$self->update;
1804		2203
1805	1	2204	1
1806	}	2205	}
1807		2206
1808	sub invoke_focus_in {	2207	sub invoke_focus_in {
…		…
1820		2219
1821	my $idx = $self->{layout}->xy_to_index ($x, $y);	2220	my $idx = $self->{layout}->xy_to_index ($x, $y);
1822		2221
1823	# byte-index to char-index	2222	# byte-index to char-index
1824	my $text = $self->{text};	2223	my $text = $self->{text};
1825	utf8::encode $text;	2224	utf8::encode $text; $text = substr $text, 0, $idx; utf8::decode $text;
1826	$self->{cursor} = length substr $text, 0, $idx;	2225	$self->{cursor} = length $text;
1827		2226
1828	$self->_set_text ($self->{text});	2227	$self->_set_text ($self->{text});
1829	$self->update;	2228	$self->update;
1830		2229
1831	1	2230	1
…		…
1870	utf8::encode $text;	2269	utf8::encode $text;
1871		2270
1872	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)	2271	@$self{qw(cur_x cur_y cur_h)} = $self->{layout}->cursor_pos (length $text)
1873	}	2272	}
1874		2273
1875	glColor @{$self->{fg}};
1876	glBegin GL_LINES;	2274	glBegin GL_LINES;
1877	glVertex $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy};	2275	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};	2276	glVertex 0.5 + $self->{cur_x} + $self->{ox}, $self->{cur_y} + $self->{oy} + $self->{cur_h};
1879	glEnd;	2277	glEnd;
1880	}	2278	}
1881	}	2279	}
1882		2280
		2281	#############################################################################
		2282
1883	package CFClient::UI::Entry;	2283	package CFPlus::UI::Entry;
1884		2284
1885	our @ISA = CFClient::UI::EntryBase::;	2285	our @ISA = CFPlus::UI::EntryBase::;
1886		2286
1887	use CFClient::OpenGL;	2287	use CFPlus::OpenGL;
1888		2288
1889	sub invoke_key_down {	2289	sub invoke_key_down {
1890	my ($self, $ev) = @_;	2290	my ($self, $ev) = @_;
1891		2291
1892	my $sym = $ev->{sym};	2292	my $sym = $ev->{sym};
1893		2293
1894	if ($sym == 13) {	2294	if ($ev->{uni} == 0x0d || $sym == 13) {
1895	unshift @{$self->{history}},	2295	unshift @{$self->{history}},
1896	my $txt = $self->get_text;	2296	my $txt = $self->get_text;
1897		2297
1898	$self->{history_pointer} = -1;	2298	$self->{history_pointer} = -1;
1899	$self->{history_saveback} = '';	2299	$self->{history_saveback} = '';
1900	$self->emit (activate => $txt);	2300	$self->emit (activate => $txt);
1901	$self->update;	2301	$self->update;
1902		2302
1903	} elsif ($sym == CFClient::SDLK_UP) {	2303	} elsif ($sym == CFPlus::SDLK_UP) {
1904	if ($self->{history_pointer} < 0) {	2304	if ($self->{history_pointer} < 0) {
1905	$self->{history_saveback} = $self->get_text;	2305	$self->{history_saveback} = $self->get_text;
1906	}	2306	}
1907	if (@{$self->{history} || []} > 0) {	2307	if (@{$self->{history} || []} > 0) {
1908	$self->{history_pointer}++;	2308	$self->{history_pointer}++;
…		…
1910	$self->{history_pointer} = @{$self->{history} || []} - 1;	2310	$self->{history_pointer} = @{$self->{history} || []} - 1;
1911	}	2311	}
1912	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2312	$self->set_text ($self->{history}->[$self->{history_pointer}]);
1913	}	2313	}
1914		2314
1915	} elsif ($sym == CFClient::SDLK_DOWN) {	2315	} elsif ($sym == CFPlus::SDLK_DOWN) {
1916	$self->{history_pointer}--;	2316	$self->{history_pointer}--;
1917	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;	2317	$self->{history_pointer} = -1 if $self->{history_pointer} < 0;
1918		2318
1919	if ($self->{history_pointer} >= 0) {	2319	if ($self->{history_pointer} >= 0) {
1920	$self->set_text ($self->{history}->[$self->{history_pointer}]);	2320	$self->set_text ($self->{history}->[$self->{history_pointer}]);
…		…
1929	1	2329	1
1930	}	2330	}
1931		2331
1932	#############################################################################	2332	#############################################################################
1933		2333
		2334	package CFPlus::UI::TextEdit;
		2335
		2336	our @ISA = CFPlus::UI::EntryBase::;
		2337
		2338	use CFPlus::OpenGL;
		2339
		2340	sub move_cursor_ver {
		2341	my ($self, $dy) = @_;
		2342
		2343	my ($y, $x) = $self->{layout}->index_to_line_x ($self->{cursor});
		2344
		2345	$y += $dy;
		2346
		2347	if (defined (my $index = $self->{layout}->line_x_to_index ($y, $x))) {
		2348	$self->{cursor} = $index;
		2349	delete $self->{cur_h};
		2350	$self->update;
		2351	return;
		2352	}
		2353	}
		2354
		2355	sub invoke_key_down {
		2356	my ($self, $ev) = @_;
		2357
		2358	my $sym = $ev->{sym};
		2359
		2360	if ($sym == CFPlus::SDLK_UP) {
		2361	$self->move_cursor_ver (-1);
		2362	} elsif ($sym == CFPlus::SDLK_DOWN) {
		2363	$self->move_cursor_ver (+1);
		2364	} else {
		2365	return $self->SUPER::invoke_key_down ($ev)
		2366	}
		2367
		2368	1
		2369	}
		2370
		2371	#############################################################################
		2372
1934	package CFClient::UI::Button;	2373	package CFPlus::UI::Button;
1935		2374
1936	our @ISA = CFClient::UI::Label::;	2375	our @ISA = CFPlus::UI::Label::;
1937		2376
1938	use CFClient::OpenGL;	2377	use CFPlus::OpenGL;
1939		2378
1940	my @tex =	2379	my @tex =
1941	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2380	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
1942	qw(b1_button_active.png);	2381	qw(b1_button_active.png);
1943		2382
1944	sub new {	2383	sub new {
1945	my $class = shift;	2384	my $class = shift;
1946		2385
…		…
1983	$self->SUPER::_draw;	2422	$self->SUPER::_draw;
1984	}	2423	}
1985		2424
1986	#############################################################################	2425	#############################################################################
1987		2426
		2427	package CFPlus::UI::CheckBox;
		2428
		2429	our @ISA = CFPlus::UI::DrawBG::;
		2430
		2431	my @tex =
		2432	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
		2433	qw(c1_checkbox_bg.png c1_checkbox_active.png);
		2434
		2435	use CFPlus::OpenGL;
		2436
		2437	sub new {
		2438	my $class = shift;
		2439
		2440	$class->SUPER::new (
		2441	padding_x => 2,
		2442	padding_y => 2,
		2443	fg => [1, 1, 1],
		2444	active_fg => [1, 1, 0],
		2445	bg => [0, 0, 0, 0.2],
		2446	active_bg => [1, 1, 1, 0.5],
		2447	state => 0,
		2448	can_hover => 1,
		2449	@_
		2450	)
		2451	}
		2452
		2453	sub size_request {
		2454	my ($self) = @_;
		2455
		2456	(6) x 2
		2457	}
		2458
		2459	sub toggle {
		2460	my ($self) = @_;
		2461
		2462	$self->{state} = !$self->{state};
		2463	$self->emit (changed => $self->{state});
		2464	$self->update;
		2465	}
		2466
		2467	sub invoke_button_down {
		2468	my ($self, $ev, $x, $y) = @_;
		2469
		2470	if ($x >= $self->{padding_x} && $x < $self->{w} - $self->{padding_x}
		2471	&& $y >= $self->{padding_y} && $y < $self->{h} - $self->{padding_y}) {
		2472	$self->toggle;
		2473	} else {
		2474	return 0
		2475	}
		2476
		2477	1
		2478	}
		2479
		2480	sub _draw {
		2481	my ($self) = @_;
		2482
		2483	$self->SUPER::_draw;
		2484
		2485	glTranslate $self->{padding_x} + 0.375, $self->{padding_y} + 0.375, 0;
		2486
		2487	my ($w, $h) = @$self{qw(w h)};
		2488
		2489	my $s = List::Util::min $w - $self->{padding_x} * 2, $h - $self->{padding_y} * 2;
		2490
		2491	glColor @{ $FOCUS == $self ? $self->{active_fg} : $self->{fg} };
		2492
		2493	my $tex = $self->{state} ? $tex[1] : $tex[0];
		2494
		2495	glEnable GL_TEXTURE_2D;
		2496	$tex->draw_quad_alpha (0, 0, $s, $s);
		2497	glDisable GL_TEXTURE_2D;
		2498	}
		2499
		2500	#############################################################################
		2501
		2502	package CFPlus::UI::Image;
		2503
		2504	our @ISA = CFPlus::UI::Base::;
		2505
		2506	use CFPlus::OpenGL;
		2507
		2508	our %texture_cache;
		2509
		2510	sub new {
		2511	my $class = shift;
		2512
		2513	my $self = $class->SUPER::new (
		2514	can_events => 0,
		2515	@_,
		2516	);
		2517
		2518	$self->{path} || $self->{tex}
		2519	or Carp::croak "'path' or 'tex' attributes required";
		2520
		2521	$self->{tex} ||= $texture_cache{$self->{path}} ||=
		2522	new_from_file CFPlus::Texture CFPlus::find_rcfile $self->{path}, mipmap => 1;
		2523
		2524	CFPlus::weaken $texture_cache{$self->{path}};
		2525
		2526	$self->{aspect} ||= $self->{tex}{w} / $self->{tex}{h};
		2527
		2528	$self
		2529	}
		2530
		2531	sub STORABLE_freeze {
		2532	my ($self, $cloning) = @_;
		2533
		2534	$self->{path}
		2535	or die "cannot serialise CFPlus::UI::Image on non-loadable images\n";
		2536
		2537	$self->{path}
		2538	}
		2539
		2540	sub STORABLE_attach {
		2541	my ($self, $cloning, $path) = @_;
		2542
		2543	$self->new (path => $path)
		2544	}
		2545
		2546	sub size_request {
		2547	my ($self) = @_;
		2548
		2549	($self->{tex}{w}, $self->{tex}{h})
		2550	}
		2551
		2552	sub _draw {
		2553	my ($self) = @_;
		2554
		2555	my $tex = $self->{tex};
		2556
		2557	my ($w, $h) = ($self->{w}, $self->{h});
		2558
		2559	if ($self->{rot90}) {
		2560	glRotate 90, 0, 0, 1;
		2561	glTranslate 0, -$self->{w}, 0;
		2562
		2563	($w, $h) = ($h, $w);
		2564	}
		2565
		2566	glEnable GL_TEXTURE_2D;
		2567	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
		2568
		2569	$tex->draw_quad (0, 0, $w, $h);
		2570
		2571	glDisable GL_TEXTURE_2D;
		2572	}
		2573
		2574	#############################################################################
		2575
1988	package CFClient::UI::ImageButton;	2576	package CFPlus::UI::ImageButton;
1989		2577
1990	our @ISA = CFClient::UI::Image::;	2578	our @ISA = CFPlus::UI::Image::;
1991		2579
1992	use CFClient::OpenGL;	2580	use CFPlus::OpenGL;
1993		2581
1994	my %textures;	2582	my %textures;
1995		2583
1996	sub new {	2584	sub new {
1997	my $class = shift;	2585	my $class = shift;
…		…
2019	1	2607	1
2020	}	2608	}
2021		2609
2022	#############################################################################	2610	#############################################################################
2023		2611
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;	2612	package CFPlus::UI::VGauge;
2093		2613
2094	our @ISA = CFClient::UI::Base::;	2614	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		2615
2154	use List::Util qw(min max);	2616	use List::Util qw(min max);
2155		2617
2156	use CFClient::OpenGL;	2618	use CFPlus::OpenGL;
2157		2619
2158	my %tex = (	2620	my %tex = (
2159	food => [	2621	food => [
2160	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2622	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2161	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/	2623	qw/g1_food_gauge_empty.png g1_food_gauge_full.png/
2162	],	2624	],
2163	grace => [	2625	grace => [
2164	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2626	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/	2627	qw/g1_grace_gauge_empty.png g1_grace_gauge_full.png g1_grace_gauge_overflow.png/
2166	],	2628	],
2167	hp => [	2629	hp => [
2168	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2630	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_, mipmap => 1 }
2169	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/	2631	qw/g1_hp_gauge_empty.png g1_hp_gauge_full.png/
2170	],	2632	],
2171	mana => [	2633	mana => [
2172	map { new_from_file CFClient::Texture CFClient::find_rcfile $_, mipmap => 1 }	2634	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/	2635	qw/g1_mana_gauge_empty.png g1_mana_gauge_full.png g1_mana_gauge_overflow.png/
2174	],	2636	],
2175	);	2637	);
2176		2638
2177	# eg. VGauge->new (gauge => 'food'), default gauge: food	2639	# eg. VGauge->new (gauge => 'food'), default gauge: food
…		…
2237	my $ycut1 = max 0, min 1, $ycut;	2699	my $ycut1 = max 0, min 1, $ycut;
2238	my $ycut2 = max 0, min 1, $ycut - 1;	2700	my $ycut2 = max 0, min 1, $ycut - 1;
2239		2701
2240	my $h1 = $self->{h} * (1 - $ycut1);	2702	my $h1 = $self->{h} * (1 - $ycut1);
2241	my $h2 = $self->{h} * (1 - $ycut2);	2703	my $h2 = $self->{h} * (1 - $ycut2);
		2704	my $h3 = $self->{h};
		2705
		2706	$_ = $_ * (284-4)/288 + 4/288 for ($h1, $h2, $h3);
2242		2707
2243	glEnable GL_BLEND;	2708	glEnable GL_BLEND;
2244	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,	2709	glBlendFuncSeparate GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
2245	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;	2710	GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
2246	glEnable GL_TEXTURE_2D;	2711	glEnable GL_TEXTURE_2D;
…		…
2265		2730
2266	if ($t3) {	2731	if ($t3) {
2267	glBindTexture GL_TEXTURE_2D, $t3->{name};	2732	glBindTexture GL_TEXTURE_2D, $t3->{name};
2268	glBegin GL_QUADS;	2733	glBegin GL_QUADS;
2269	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;	2734	glTexCoord 0 , $t3->{t} * (1 - $ycut2); glVertex 0 , $h2;
2270	glTexCoord 0 , $t3->{t}; glVertex 0 , $self->{h};	2735	glTexCoord 0 , $t3->{t}; glVertex 0 , $h3;
2271	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $self->{h};	2736	glTexCoord $t3->{s}, $t3->{t}; glVertex $w, $h3;
2272	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;	2737	glTexCoord $t3->{s}, $t3->{t} * (1 - $ycut2); glVertex $w, $h2;
2273	glEnd;	2738	glEnd;
2274	}	2739	}
2275		2740
2276	glDisable GL_BLEND;	2741	glDisable GL_BLEND;
2277	glDisable GL_TEXTURE_2D;	2742	glDisable GL_TEXTURE_2D;
2278	}	2743	}
2279		2744
2280	#############################################################################	2745	#############################################################################
2281		2746
2282	package CFClient::UI::Gauge;	2747	package CFPlus::UI::Gauge;
2283		2748
2284	our @ISA = CFClient::UI::VBox::;	2749	our @ISA = CFPlus::UI::VBox::;
2285		2750
2286	sub new {	2751	sub new {
2287	my ($class, %arg) = @_;	2752	my ($class, %arg) = @_;
2288		2753
2289	my $self = $class->SUPER::new (	2754	my $self = $class->SUPER::new (
…		…
2291	can_hover => 1,	2756	can_hover => 1,
2292	can_events => 1,	2757	can_events => 1,
2293	%arg,	2758	%arg,
2294	);	2759	);
2295		2760
2296	$self->add ($self->{value} = new CFClient::UI::Label valign => +1, align => 0, template => "999");	2761	$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);	2762	$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");	2763	$self->add ($self->{max} = new CFPlus::UI::Label valign => -1, align => 0, template => "999");
2299		2764
2300	$self	2765	$self
2301	}	2766	}
2302		2767
2303	sub set_fontsize {	2768	sub set_fontsize {
…		…
2324	$self->{value}->set_text ($val);	2789	$self->{value}->set_text ($val);
2325	}	2790	}
2326		2791
2327	#############################################################################	2792	#############################################################################
2328		2793
2329	package CFClient::UI::Slider;	2794	package CFPlus::UI::Slider;
2330		2795
2331	use strict;	2796	use strict;
2332		2797
2333	use CFClient::OpenGL;	2798	use CFPlus::OpenGL;
2334		2799
2335	our @ISA = CFClient::UI::DrawBG::;	2800	our @ISA = CFPlus::UI::DrawBG::;
2336		2801
2337	my @tex =	2802	my @tex =
2338	map { new_from_file CFClient::Texture CFClient::find_rcfile $_ }	2803	map { new_from_file CFPlus::Texture CFPlus::find_rcfile $_ }
2339	qw(s1_slider.png s1_slider_bg.png);	2804	qw(s1_slider.png s1_slider_bg.png);
2340		2805
2341	sub new {	2806	sub new {
2342	my $class = shift;	2807	my $class = shift;
2343		2808
…		…
2432	}	2897	}
2433		2898
2434	1	2899	1
2435	}	2900	}
2436		2901
		2902	sub invoke_mouse_wheel {
		2903	my ($self, $ev) = @_;
		2904
		2905	my $delta = $self->{vertical} ? $ev->{dy} : $ev->{dx};
		2906
		2907	my $pagepart = $ev->{mod} & CFPlus::KMOD_SHIFT ? 1 : 0.2;
		2908
		2909	$self->set_value ($self->{range}[0] + $delta * $self->{range}[3] * $pagepart);
		2910
		2911	! ! $delta
		2912	}
		2913
2437	sub update {	2914	sub update {
2438	my ($self) = @_;	2915	my ($self) = @_;
2439		2916
2440	delete $self->{knob_w};	2917	delete $self->{knob_w};
2441	$self->SUPER::update;	2918	$self->SUPER::update;
…		…
2488	glDisable GL_TEXTURE_2D;	2965	glDisable GL_TEXTURE_2D;
2489	}	2966	}
2490		2967
2491	#############################################################################	2968	#############################################################################
2492		2969
2493	package CFClient::UI::ValSlider;	2970	package CFPlus::UI::ValSlider;
2494		2971
2495	our @ISA = CFClient::UI::HBox::;	2972	our @ISA = CFPlus::UI::HBox::;
2496		2973
2497	sub new {	2974	sub new {
2498	my ($class, %arg) = @_;	2975	my ($class, %arg) = @_;
2499		2976
2500	my $range = delete $arg{range};	2977	my $range = delete $arg{range};
2501		2978
2502	my $self = $class->SUPER::new (	2979	my $self = $class->SUPER::new (
2503	slider => (new CFClient::UI::Slider expand => 1, range => $range),	2980	slider => (new CFPlus::UI::Slider expand => 1, range => $range),
2504	entry => (new CFClient::UI::Label text => "", template => delete $arg{template}),	2981	entry => (new CFPlus::UI::Label text => "", template => delete $arg{template}),
2505	to_value => sub { shift },	2982	to_value => sub { shift },
2506	from_value => sub { shift },	2983	from_value => sub { shift },
2507	%arg,	2984	%arg,
2508	);	2985	);
2509		2986
…		…
2529	sub set_range { shift->{slider}->set_range (@_) }	3006	sub set_range { shift->{slider}->set_range (@_) }
2530	sub set_value { shift->{slider}->set_value (@_) }	3007	sub set_value { shift->{slider}->set_value (@_) }
2531		3008
2532	#############################################################################	3009	#############################################################################
2533		3010
2534	package CFClient::UI::TextScroller;	3011	package CFPlus::UI::TextScroller;
2535		3012
2536	our @ISA = CFClient::UI::HBox::;	3013	our @ISA = CFPlus::UI::HBox::;
2537		3014
2538	use CFClient::OpenGL;	3015	use CFPlus::OpenGL;
2539		3016
2540	sub new {	3017	sub new {
2541	my $class = shift;	3018	my $class = shift;
2542		3019
2543	my $self = $class->SUPER::new (	3020	my $self = $class->SUPER::new (
2544	fontsize => 1,	3021	fontsize => 1,
2545	can_events => 0,	3022	can_events => 1,
2546	indent => 0,	3023	indent => 0,
2547	#font => default_font	3024	#font => default_font
2548	@_,	3025	@_,
2549		3026
2550	layout => (new CFClient::Layout 1),	3027	layout => (new CFPlus::Layout),
2551	par => [],	3028	par => [],
		3029	max_par => 0,
2552	height => 0,	3030	height => 0,
2553	children => [	3031	children => [
2554	(new CFClient::UI::Empty expand => 1),	3032	(new CFPlus::UI::Empty expand => 1),
2555	(new CFClient::UI::Slider vertical => 1),	3033	(new CFPlus::UI::Slider vertical => 1),
2556	],	3034	],
2557	);	3035	);
2558		3036
2559	$self->{children}[1]->connect (changed => sub { $self->update });	3037	$self->{children}[1]->connect (changed => sub { $self->update });
2560		3038
…		…
2566		3044
2567	$self->{fontsize} = $fontsize;	3045	$self->{fontsize} = $fontsize;
2568	$self->reflow;	3046	$self->reflow;
2569	}	3047	}
2570		3048
		3049	sub size_request {
		3050	my ($self) = @_;
		3051
		3052	my ($empty, $slider) = @{ $self->{children} };
		3053
		3054	local $self->{children} = [$empty, $slider];
		3055	$self->SUPER::size_request
		3056	}
		3057
2571	sub invoke_size_allocate {	3058	sub invoke_size_allocate {
2572	my ($self, $w, $h) = @_;	3059	my ($self, $w, $h) = @_;
2573		3060
		3061	my ($empty, $slider, @other) = @{ $self->{children} };
		3062	$_->configure (@$_{qw(x y req_w req_h)}) for @other;
		3063
2574	$self->{layout}->set_font ($self->{font}) if $self->{font};	3064	$self->{layout}->set_font ($self->{font}) if $self->{font};
2575	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);	3065	$self->{layout}->set_height ($self->{fontsize} * $::FONTSIZE);
2576	$self->{layout}->set_width ($self->{children}[0]{w});	3066	$self->{layout}->set_width ($empty->{w});
2577	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	3067	$self->{layout}->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2578		3068
2579	$self->reflow;	3069	$self->reflow;
2580		3070
		3071	local $self->{children} = [$empty, $slider];
2581	$self->SUPER::invoke_size_allocate ($w, $h)	3072	$self->SUPER::invoke_size_allocate ($w, $h)
2582	}	3073	}
2583		3074
2584	sub text_size {	3075	sub invoke_mouse_wheel {
2585	my ($self, $text, $indent) = @_;	3076	my ($self, $ev) = @_;
		3077
		3078	return 0 unless $ev->{dy}; # only vertical movements
		3079
		3080	$self->{children}[1]->emit (mouse_wheel => $ev);
		3081
		3082	1
		3083	}
		3084
		3085	sub get_layout {
		3086	my ($self, $para) = @_;
2586		3087
2587	my $layout = $self->{layout};	3088	my $layout = $self->{layout};
2588		3089
		3090	$layout->set_font ($self->{font}) if $self->{font};
		3091	$layout->set_foreground (@{$para->{fg}});
2589	$layout->set_height ($self->{fontsize} * $::FONTSIZE);	3092	$layout->set_height ($self->{fontsize} * $::FONTSIZE);
2590	$layout->set_width ($self->{children}[0]{w} - $indent);	3093	$layout->set_width ($self->{children}[0]{w} - $para->{indent});
2591	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});	3094	$layout->set_indent ($self->{fontsize} * $::FONTSIZE * $self->{indent});
2592	$layout->set_markup ($text);	3095	$layout->set_markup ($para->{markup});
		3096
		3097	$layout->set_shapes (
		3098	map
		3099	+(0, $_->baseline_shift +$_->{padding_y} - $_->{h}, $_->{w}, $_->{h}),
		3100	@{$para->{widget}}
2593		3101	);
		3102
2594	$layout->size	3103	$layout
2595	}	3104	}
2596		3105
2597	sub reflow {	3106	sub reflow {
2598	my ($self) = @_;	3107	my ($self) = @_;
2599		3108
…		…
2606		3115
2607	# todo: base offset on lines or so, not on pixels	3116	# todo: base offset on lines or so, not on pixels
2608	$self->{children}[1]->set_value ($offset);	3117	$self->{children}[1]->set_value ($offset);
2609	}	3118	}
2610		3119
		3120	sub current_paragraph {
		3121	my ($self) = @_;
		3122
		3123	$self->{top_paragraph} - 1
		3124	}
		3125
		3126	sub scroll_to {
		3127	my ($self, $para) = @_;
		3128
		3129	$para = List::Util::max 0, List::Util::min $#{$self->{par}}, $para;
		3130
		3131	$self->{scroll_to} = $para;
		3132	$self->update;
		3133	}
		3134
2611	sub clear {	3135	sub clear {
2612	my ($self) = @_;	3136	my ($self) = @_;
		3137
		3138	my (undef, undef, @other) = @{ $self->{children} };
		3139	$self->remove ($_) for @other;
2613		3140
2614	$self->{par} = [];	3141	$self->{par} = [];
2615	$self->{height} = 0;	3142	$self->{height} = 0;
2616	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);	3143	$self->{children}[1]->set_range ([0, 0, 0, 1, 1]);
2617	}	3144	}
2618		3145
2619	sub add_paragraph {	3146	sub add_paragraph {
2620	my ($self, $color, $text, $indent) = @_;	3147	my $self = shift;
2621		3148
2622	for my $line (split /\n/, $text) {	3149	for my $para (@_) {
2623	my ($w, $h) = $self->text_size ($line);	3150	$para = {
		3151	fg => [1, 1, 1, 1],
		3152	indent => 0,
		3153	markup => "",
		3154	widget => [],
		3155	ref $para ? %$para : (markup => $para),
		3156	w => 1e10,
		3157	wrapped => 1,
		3158	};
		3159
		3160	$self->add (@{ $para->{widget} }) if @{ $para->{widget} };
		3161	push @{$self->{par}}, $para;
		3162	}
		3163
		3164	if (my $max = $self->{max_par}) {
		3165	shift @{$self->{par}} while @{$self->{par}} > $max;
		3166	}
		3167
		3168	$self->{need_reflow}++;
		3169	$self->update;
		3170	}
		3171
		3172	sub scroll_to_bottom {
		3173	my ($self) = @_;
		3174
		3175	$self->{scroll_to} = $#{$self->{par}};
		3176	$self->update;
		3177	}
		3178
		3179	sub force_uptodate {
		3180	my ($self) = @_;
		3181
		3182	if (delete $self->{need_reflow}) {
		3183	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
		3184
		3185	my $height = 0;
		3186
		3187	for my $para (@{$self->{par}}) {
		3188	if ($para->{w} != $W && ($para->{wrapped} || $para->{w} > $W)) {
		3189	my $layout = $self->get_layout ($para);
		3190	my ($w, $h) = $layout->size;
		3191
		3192	$para->{w} = $w + $para->{indent};
		3193	$para->{h} = $h;
		3194	$para->{wrapped} = $layout->has_wrapped;
		3195	}
		3196
		3197	$para->{y} = $height;
		3198	$height += $para->{h};
		3199	}
		3200
2624	$self->{height} += $h;	3201	$self->{height} = $height;
2625	push @{$self->{par}}, [$w + $indent, $h, $color, $indent, $line];	3202	$self->{children}[1]->set_range ([$self->{children}[1]{range}[0], 0, $height, $H, 1]);
2626	}
2627		3203
2628	$self->{children}[1]->set_range ([$self->{height}, 0, $self->{height}, $self->{h}, 1]);	3204	delete $self->{texture};
		3205	}
		3206
		3207	if (my $paridx = delete $self->{scroll_to}) {
		3208	$self->{children}[1]->set_value ($self->{par}[$paridx]{y});
		3209	}
2629	}	3210	}
2630		3211
2631	sub update {	3212	sub update {
2632	my ($self) = @_;	3213	my ($self) = @_;
2633		3214
…		…
2636	return unless $self->{h} > 0;	3217	return unless $self->{h} > 0;
2637		3218
2638	delete $self->{texture};	3219	delete $self->{texture};
2639		3220
2640	$ROOT->on_post_alloc ($self => sub {	3221	$ROOT->on_post_alloc ($self => sub {
		3222	$self->force_uptodate;
		3223
2641	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};	3224	my ($W, $H) = @{$self->{children}[0]}{qw(w h)};
2642		3225
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 {	3226	$self->{texture} ||= new_from_opengl CFPlus::Texture $W, $H, sub {
2671	glClearColor 0, 0, 0, 0;	3227	glClearColor 0, 0, 0, 0;
2672	glClear GL_COLOR_BUFFER_BIT;	3228	glClear GL_COLOR_BUFFER_BIT;
2673		3229
		3230	package CFPlus::UI::Base;
		3231	local ($draw_x, $draw_y, $draw_w, $draw_h) =
		3232	(0, 0, $self->{w}, $self->{h});
		3233
		3234	my $top = int $self->{children}[1]{range}[0];
		3235
		3236	my $paridx = 0;
		3237	my $top_paragraph;
2674	my $top = int $self->{children}[1]{range}[0];	3238	my $top = int $self->{children}[1]{range}[0];
2675		3239
2676	my $y0 = $top;	3240	my $y0 = $top;
2677	my $y1 = $top + $H;	3241	my $y1 = $top + $H;
2678		3242
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}}) {	3243	for my $para (@{$self->{par}}) {
2690	my $h = $par->[1];	3244	my $h = $para->{h};
		3245	my $y = $para->{y};
2691		3246
2692	if ($y0 < $y + $h && $y < $y1) {	3247	if ($y0 < $y + $h && $y < $y1) {
2693	$layout->set_foreground (@{ $par->[2] });	3248	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		3249
2698	my ($w, $h, $data, $format, $internalformat) = $layout->render;	3250	$layout->render ($para->{indent}, $y - $y0);
2699		3251
2700	glRasterPos $par->[3], $y - $y0;	3252	if (my @w = @{ $para->{widget} }) {
2701	glDrawPixels $w, $h, $format, GL_UNSIGNED_BYTE, $data;	3253	my @s = $layout->get_shapes;
		3254
		3255	for (@w) {
		3256	my ($dx, $dy) = splice @s, 0, 2, ();
		3257
		3258	$_->{x} = $dx + $para->{indent};
		3259	$_->{y} = $dy + $y - $y0;
		3260
		3261	$_->draw;
		3262	}
		3263	}
2702	}	3264	}
2703		3265
2704	$y += $h;	3266	$paridx++;
		3267	$top_paragraph ||= $paridx if $y >= $top;
2705	}	3268	}
2706		3269
2707	glDisable GL_BLEND;	3270	$self->{top_paragraph} = $top_paragraph;
2708	};	3271	};
2709	});	3272	});
		3273	}
		3274
		3275	sub reconfigure {
		3276	my ($self) = @_;
		3277
		3278	$self->SUPER::reconfigure;
		3279
		3280	$_->{w} = 1e10 for @{ $self->{par} };
		3281	$self->reflow;
2710	}	3282	}
2711		3283
2712	sub _draw {	3284	sub _draw {
2713	my ($self) = @_;	3285	my ($self) = @_;
2714		3286
…		…
2717	glColor 0, 0, 0, 1;	3289	glColor 0, 0, 0, 1;
2718	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});	3290	$self->{texture}->draw_quad_alpha_premultiplied (0, 0, $self->{children}[0]{w}, $self->{children}[0]{h});
2719	glDisable GL_TEXTURE_2D;	3291	glDisable GL_TEXTURE_2D;
2720		3292
2721	$self->{children}[1]->draw;	3293	$self->{children}[1]->draw;
2722
2723	}	3294	}
2724		3295
2725	#############################################################################	3296	#############################################################################
2726		3297
2727	package CFClient::UI::Animator;	3298	package CFPlus::UI::Animator;
2728		3299
2729	use CFClient::OpenGL;	3300	use CFPlus::OpenGL;
2730		3301
2731	our @ISA = CFClient::UI::Bin::;	3302	our @ISA = CFPlus::UI::Bin::;
2732		3303
2733	sub moveto {	3304	sub moveto {
2734	my ($self, $x, $y) = @_;	3305	my ($self, $x, $y) = @_;
2735		3306
2736	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];	3307	$self->{moveto} = [$self->{x}, $self->{y}, $x, $y];
…		…
2764	glPopMatrix;	3335	glPopMatrix;
2765	}	3336	}
2766		3337
2767	#############################################################################	3338	#############################################################################
2768		3339
2769	package CFClient::UI::Flopper;	3340	package CFPlus::UI::Flopper;
2770		3341
2771	our @ISA = CFClient::UI::Button::;	3342	our @ISA = CFPlus::UI::Button::;
2772		3343
2773	sub new {	3344	sub new {
2774	my $class = shift;	3345	my $class = shift;
2775		3346
2776	my $self = $class->SUPER::new (	3347	my $self = $class->SUPER::new (
…		…
2788	$self->{other}->toggle_visibility;	3359	$self->{other}->toggle_visibility;
2789	}	3360	}
2790		3361
2791	#############################################################################	3362	#############################################################################
2792		3363
2793	package CFClient::UI::Tooltip;	3364	package CFPlus::UI::Tooltip;
2794		3365
2795	our @ISA = CFClient::UI::Bin::;	3366	our @ISA = CFPlus::UI::Bin::;
2796		3367
2797	use CFClient::OpenGL;	3368	use CFPlus::OpenGL;
2798		3369
2799	sub new {	3370	sub new {
2800	my $class = shift;	3371	my $class = shift;
2801		3372
2802	$class->SUPER::new (	3373	$class->SUPER::new (
…		…
2805	)	3376	)
2806	}	3377	}
2807		3378
2808	sub set_tooltip_from {	3379	sub set_tooltip_from {
2809	my ($self, $widget) = @_;	3380	my ($self, $widget) = @_;
		3381
		3382	$widget->{tooltip} = CFPlus::Pod::section_label tooltip => $1
		3383	if $widget->{tooltip} =~ /^#(.*)$/;
2810		3384
2811	my $tooltip = $widget->{tooltip};	3385	my $tooltip = $widget->{tooltip};
2812		3386
2813	if ($ENV{CFPLUS_DEBUG} & 2) {	3387	if ($ENV{CFPLUS_DEBUG} & 2) {
2814	$tooltip .= "\n\n" . (ref $widget) . "\n"	3388	$tooltip .= "\n\n" . (ref $widget) . "\n"
…		…
2818	}	3392	}
2819		3393
2820	$tooltip =~ s/^\n+//;	3394	$tooltip =~ s/^\n+//;
2821	$tooltip =~ s/\n+$//;	3395	$tooltip =~ s/\n+$//;
2822		3396
2823	$self->add (new CFClient::UI::Label	3397	$self->add (new CFPlus::UI::Label
2824	markup => $tooltip,	3398	markup => $tooltip,
2825	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,	3399	max_w => ($widget->{tooltip_width} || 0.25) * $::WIDTH,
2826	fontsize => 0.8,	3400	fontsize => 0.8,
2827	fg => [0, 0, 0, 1],	3401	style => 1, # FLAG_INVERSE
2828	ellipsise => 0,	3402	ellipsise => 0,
2829	font => ($widget->{tooltip_font} || $::FONT_PROP),	3403	font => ($widget->{tooltip_font} || $::FONT_PROP),
2830	);	3404	);
2831	}	3405	}
2832		3406
…		…
2851		3425
2852	$self->{root}->on_post_alloc ("move_$self" => sub {	3426	$self->{root}->on_post_alloc ("move_$self" => sub {
2853	my $widget = $self->{owner}	3427	my $widget = $self->{owner}
2854	or return;	3428	or return;
2855		3429
		3430	if ($widget->{visible}) {
2856	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);	3431	my ($x, $y) = $widget->coord2global ($widget->{w}, 0);
2857		3432
2858	($x, $y) = $widget->coord2global (-$self->{w}, 0)	3433	($x, $y) = $widget->coord2global (-$self->{w}, 0)
2859	if $x + $self->{w} > $self->{root}{w};	3434	if $x + $self->{w} > $self->{root}{w};
2860		3435
2861	$self->move_abs ($x, $y);	3436	$self->move_abs ($x, $y);
		3437	} else {
		3438	$self->hide;
		3439	}
2862	});	3440	});
2863	}	3441	}
2864		3442
2865	sub _draw {	3443	sub _draw {
2866	my ($self) = @_;	3444	my ($self) = @_;
…		…
2890	$self->SUPER::_draw;	3468	$self->SUPER::_draw;
2891	}	3469	}
2892		3470
2893	#############################################################################	3471	#############################################################################
2894		3472
2895	package CFClient::UI::Face;	3473	package CFPlus::UI::Face;
2896		3474
2897	our @ISA = CFClient::UI::Base::;	3475	our @ISA = CFPlus::UI::DrawBG::;
2898		3476
2899	use CFClient::OpenGL;	3477	use CFPlus::OpenGL;
2900		3478
2901	sub new {	3479	sub new {
2902	my $class = shift;	3480	my $class = shift;
2903		3481
2904	my $self = $class->SUPER::new (	3482	my $self = $class->SUPER::new (
		3483	size_w => 32,
		3484	size_h => 8,
2905	aspect => 1,	3485	aspect => 1,
2906	can_events => 0,	3486	can_events => 0,
2907	@_,	3487	@_,
2908	);	3488	);
2909		3489
2910	if ($self->{anim} && $self->{animspeed}) {	3490	if ($self->{anim} && $self->{animspeed}) {
2911	Scalar::Util::weaken (my $widget = $self);	3491	CFPlus::weaken (my $widget = $self);
2912		3492
2913	$self->{timer} = Event->timer (	3493	$self->{timer} = Event->timer (
2914	at => $self->{animspeed} * int $::NOW / $self->{animspeed},	3494	at => $self->{animspeed} * int $::NOW / $self->{animspeed},
2915	hard => 1,	3495	hard => 1,
2916	interval => $self->{animspeed},	3496	interval => $self->{animspeed},
2917	cb => sub {	3497	cb => sub {
		3498	return unless $::CONN;
		3499
2918	++$widget->{frame};	3500	++$widget->{frame};
		3501	$self->update_face;
2919	$widget->update;	3502	$self->update;
2920	},	3503	},
2921	);	3504	);
		3505
		3506	$self->update_face;
2922	}	3507	}
2923		3508
2924	$self	3509	$self
2925	}	3510	}
2926		3511
		3512	sub update_face {
		3513	my ($self) = @_;
		3514
		3515	return unless $::CONN;
		3516
		3517	if (my $anim = $::CONN->{anim}[$self->{anim}]) {
		3518	if ($anim && @$anim) {
		3519	delete $self->{wait_face};
		3520	$self->{face} = $anim->[ $self->{frame} % @$anim ];
		3521	}
		3522	}
		3523	}
		3524
2927	sub size_request {	3525	sub size_request {
2928	(32, 8)	3526	my ($self) = @_;
		3527
		3528	if ($::CONN) {
		3529	if (my $faceid = $::CONN->{faceid}[$self->{face}]) {
		3530	if (my $tex = $::CONN->{texture}[$faceid]) {
		3531	return ($self->{size_w} || $tex->{w}, $self->{size_h} || $tex->{h});
		3532	} else {
		3533	$self->{wait_face} ||= $::CONN->connect_face_update ($faceid, sub {
		3534	$self->realloc;
		3535	});
		3536	}
		3537	}
		3538	}
		3539
		3540	($self->{size_w} || 8, $self->{size_h} || 8)
2929	}	3541	}
2930		3542
2931	sub update {	3543	sub update {
2932	my ($self) = @_;	3544	my ($self) = @_;
2933		3545
…		…
2939	sub _draw {	3551	sub _draw {
2940	my ($self) = @_;	3552	my ($self) = @_;
2941		3553
2942	return unless $::CONN;	3554	return unless $::CONN;
2943		3555
2944	my $face;	3556	$self->SUPER::_draw;
2945		3557
2946	if ($self->{frame}) {
2947	my $anim = $::CONN->{anim}[$self->{anim}];	3558	my $faceid = $::CONN->{faceid}[$self->{face}]
2948		3559	or return;
2949	$face = $anim->[ $self->{frame} % @$anim ]
2950	if $anim && @$anim;
2951	}
2952		3560
2953	my $tex = $::CONN->{texture}[$::CONN->{faceid}[$face || $self->{face}]];	3561	my $tex = $::CONN->{texture}[$faceid];
2954		3562
2955	if ($tex) {	3563	if ($tex) {
2956	glEnable GL_TEXTURE_2D;	3564	glEnable GL_TEXTURE_2D;
2957	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;	3565	glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
2958	glColor 0, 0, 0, 1;	3566	glColor 0, 0, 0, 1;
…		…
2970	$self->SUPER::destroy;	3578	$self->SUPER::destroy;
2971	}	3579	}
2972		3580
2973	#############################################################################	3581	#############################################################################
2974		3582
2975	package CFClient::UI::Buttonbar;	3583	package CFPlus::UI::Buttonbar;
2976		3584
2977	our @ISA = CFClient::UI::HBox::;	3585	our @ISA = CFPlus::UI::HBox::;
2978		3586
2979	# TODO: should actualyl wrap buttons and other goodies.	3587	# TODO: should actually wrap buttons and other goodies.
2980		3588
2981	#############################################################################	3589	#############################################################################
2982		3590
2983	package CFClient::UI::Menu;	3591	package CFPlus::UI::Menu;
2984		3592
2985	our @ISA = CFClient::UI::FancyFrame::;	3593	our @ISA = CFPlus::UI::Toplevel::;
2986		3594
2987	use CFClient::OpenGL;	3595	use CFPlus::OpenGL;
2988		3596
2989	sub new {	3597	sub new {
2990	my $class = shift;	3598	my $class = shift;
2991		3599
2992	my $self = $class->SUPER::new (	3600	my $self = $class->SUPER::new (
2993	items => [],	3601	items => [],
2994	z => 100,	3602	z => 100,
2995	@_,	3603	@_,
2996	);	3604	);
2997		3605
2998	$self->add ($self->{vbox} = new CFClient::UI::VBox);	3606	$self->add ($self->{vbox} = new CFPlus::UI::VBox);
2999		3607
3000	for my $item (@{ $self->{items} }) {	3608	for my $item (@{ $self->{items} }) {
3001	my ($widget, $cb, $tooltip) = @$item;	3609	my ($widget, $cb, $tooltip) = @$item;
3002		3610
3003	# handle various types of items, only text for now	3611	# handle various types of items, only text for now
3004	if (!ref $widget) {	3612	if (!ref $widget) {
		3613	if ($widget =~ /\t/) {
		3614	my ($left, $right) = split /\t/, $widget, 2;
		3615
3005	$widget = new CFClient::UI::Label	3616	$widget = new CFPlus::UI::HBox
3006	can_hover => 1,	3617	can_hover => 1,
3007	can_events => 1,	3618	can_events => 1,
		3619	tooltip => $tooltip,
		3620	children => [
		3621	(new CFPlus::UI::Label markup => $left, expand => 1),
		3622	(new CFPlus::UI::Label markup => $right, align => +1),
		3623	],
		3624	;
		3625
		3626	} else {
		3627	$widget = new CFPlus::UI::Label
		3628	can_hover => 1,
		3629	can_events => 1,
3008	markup => $widget,	3630	markup => $widget,
3009	tooltip => $tooltip	3631	tooltip => $tooltip;
		3632	}
3010	}	3633	}
3011		3634
3012	$self->{item}{$widget} = $item;	3635	$self->{item}{$widget} = $item;
3013		3636
3014	$self->{vbox}->add ($widget);	3637	$self->{vbox}->add ($widget);
…		…
3057	1	3680	1
3058	}	3681	}
3059		3682
3060	#############################################################################	3683	#############################################################################
3061		3684
3062	package CFClient::UI::Multiplexer;	3685	package CFPlus::UI::Multiplexer;
3063		3686
3064	our @ISA = CFClient::UI::Container::;	3687	our @ISA = CFPlus::UI::Container::;
3065		3688
3066	sub new {	3689	sub new {
3067	my $class = shift;	3690	my $class = shift;
3068		3691
3069	my $self = $class->SUPER::new (	3692	my $self = $class->SUPER::new (
…		…
3083		3706
3084	$self->{current} = $self->{children}[0]	3707	$self->{current} = $self->{children}[0]
3085	if @{ $self->{children} };	3708	if @{ $self->{children} };
3086	}	3709	}
3087		3710
		3711	sub get_current_page {
		3712	my ($self) = @_;
		3713
		3714	$self->{current}
		3715	}
		3716
3088	sub set_current_page {	3717	sub set_current_page {
3089	my ($self, $page_or_widget) = @_;	3718	my ($self, $page_or_widget) = @_;
3090		3719
3091	my $widget = ref $page_or_widget	3720	my $widget = ref $page_or_widget
3092	? $page_or_widget	3721	? $page_or_widget
…		…
3124	$self->{current}->draw;	3753	$self->{current}->draw;
3125	}	3754	}
3126		3755
3127	#############################################################################	3756	#############################################################################
3128		3757
3129	package CFClient::UI::Notebook;	3758	package CFPlus::UI::Notebook;
3130		3759
3131	our @ISA = CFClient::UI::VBox::;	3760	our @ISA = CFPlus::UI::VBox::;
3132		3761
3133	sub new {	3762	sub new {
3134	my $class = shift;	3763	my $class = shift;
3135		3764
3136	my $self = $class->SUPER::new (	3765	my $self = $class->SUPER::new (
3137	buttonbar => (new CFClient::UI::Buttonbar),	3766	buttonbar => (new CFPlus::UI::Buttonbar),
3138	multiplexer => (new CFClient::UI::Multiplexer expand => 1),	3767	multiplexer => (new CFPlus::UI::Multiplexer expand => 1),
3139	# filter => # will be put between multiplexer and $self	3768	# filter => # will be put between multiplexer and $self
3140	@_,	3769	@_,
3141	);	3770	);
3142		3771
3143	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};	3772	$self->{filter}->add ($self->{multiplexer}) if $self->{filter};
…		…
3147	}	3776	}
3148		3777
3149	sub add {	3778	sub add {
3150	my ($self, $title, $widget, $tooltip) = @_;	3779	my ($self, $title, $widget, $tooltip) = @_;
3151		3780
3152	Scalar::Util::weaken $self;	3781	CFPlus::weaken $self;
3153		3782
3154	$self->{buttonbar}->add (new CFClient::UI::Button	3783	$self->{buttonbar}->add (new CFPlus::UI::Button
3155	markup => $title,	3784	markup => $title,
3156	tooltip => $tooltip,	3785	tooltip => $tooltip,
3157	on_activate => sub { $self->set_current_page ($widget) },	3786	on_activate => sub { $self->set_current_page ($widget) },
3158	);	3787	);
3159		3788
3160	$self->{multiplexer}->add ($widget);	3789	$self->{multiplexer}->add ($widget);
3161	}	3790	}
3162		3791
		3792	sub get_current_page {
		3793	my ($self) = @_;
		3794
		3795	$self->{multiplexer}->get_current_page
		3796	}
		3797
3163	sub set_current_page {	3798	sub set_current_page {
3164	my ($self, $page) = @_;	3799	my ($self, $page) = @_;
3165		3800
3166	$self->{multiplexer}->set_current_page ($page);	3801	$self->{multiplexer}->set_current_page ($page);
3167	$self->emit (page_changed => $self->{multiplexer}{current});	3802	$self->emit (page_changed => $self->{multiplexer}{current});
3168	}	3803	}
3169		3804
3170	#############################################################################	3805	#############################################################################
3171		3806
3172	package CFClient::UI::Combobox;	3807	package CFPlus::UI::Selector;
3173		3808
3174	use utf8;	3809	use utf8;
3175		3810
3176	our @ISA = CFClient::UI::Button::;	3811	our @ISA = CFPlus::UI::Button::;
3177		3812
3178	sub new {	3813	sub new {
3179	my $class = shift;	3814	my $class = shift;
3180		3815
3181	my $self = $class->SUPER::new (	3816	my $self = $class->SUPER::new (
…		…
3198	my ($value, $title, $tooltip) = @$_;	3833	my ($value, $title, $tooltip) = @$_;
3199		3834
3200	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];	3835	push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
3201	}	3836	}
3202		3837
3203	CFClient::UI::Menu->new (items => \@menu_items)->popup ($ev);	3838	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
3204	}	3839	}
3205		3840
3206	sub _set_value {	3841	sub _set_value {
3207	my ($self, $value) = @_;	3842	my ($self, $value) = @_;
3208		3843
…		…
3223	$self->emit (changed => $value);	3858	$self->emit (changed => $value);
3224	}	3859	}
3225		3860
3226	#############################################################################	3861	#############################################################################
3227		3862
3228	package CFClient::UI::Statusbox;	3863	package CFPlus::UI::Statusbox;
3229		3864
3230	our @ISA = CFClient::UI::VBox::;	3865	our @ISA = CFPlus::UI::VBox::;
3231		3866
3232	sub new {	3867	sub new {
3233	my $class = shift;	3868	my $class = shift;
3234		3869
3235	my $self = $class->SUPER::new (	3870	my $self = $class->SUPER::new (
3236	fontsize => 0.8,	3871	fontsize => 0.8,
3237	@_,	3872	@_,
3238	);	3873	);
3239		3874
3240	Scalar::Util::weaken (my $this = $self);	3875	CFPlus::weaken (my $this = $self);
3241		3876
3242	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });	3877	$self->{timer} = Event->timer (after => 1, interval => 1, cb => sub { $this->reorder });
3243		3878
3244	$self	3879	$self
3245	}	3880	}
…		…
3247	sub reorder {	3882	sub reorder {
3248	my ($self) = @_;	3883	my ($self) = @_;
3249	my $NOW = Time::HiRes::time;	3884	my $NOW = Time::HiRes::time;
3250		3885
3251	# freeze display when hovering over any label	3886	# freeze display when hovering over any label
3252	return if $CFClient::UI::TOOLTIP->{owner}	3887	return if $CFPlus::UI::TOOLTIP->{owner}
3253	&& grep $CFClient::UI::TOOLTIP->{owner} == $_->{label},	3888	&& grep $CFPlus::UI::TOOLTIP->{owner} == $_->{label},
3254	values %{ $self->{item} };	3889	values %{ $self->{item} };
3255		3890
3256	while (my ($k, $v) = each %{ $self->{item} }) {	3891	while (my ($k, $v) = each %{ $self->{item} }) {
3257	delete $self->{item}{$k} if $v->{timeout} < $NOW;	3892	delete $self->{item}{$k} if $v->{timeout} < $NOW;
3258	}	3893	}
…		…
3279	for ($short) {	3914	for ($short) {
3280	s/^\s+//;	3915	s/^\s+//;
3281	s/\s+/ /g;	3916	s/\s+/ /g;
3282	}	3917	}
3283		3918
3284	new CFClient::UI::Label	3919	new CFPlus::UI::Label
3285	markup => $short,	3920	markup => $short,
3286	tooltip => $item->{tooltip},	3921	tooltip => $item->{tooltip},
3287	tooltip_font => $::FONT_PROP,	3922	tooltip_font => $::FONT_PROP,
3288	tooltip_width => 0.67,	3923	tooltip_width => 0.67,
3289	fontsize => $item->{fontsize} || $self->{fontsize},	3924	fontsize => $item->{fontsize} || $self->{fontsize},
…		…
3343	count => 1,	3978	count => 1,
3344	%arg,	3979	%arg,
3345	};	3980	};
3346	}	3981	}
3347		3982
		3983	$ROOT->on_refresh (reorder => sub {
3348	$self->reorder;	3984	$self->reorder;
		3985	});
3349	}	3986	}
3350		3987
3351	sub reconfigure {	3988	sub reconfigure {
3352	my ($self) = @_;	3989	my ($self) = @_;
3353		3990
…		…
3366	$self->SUPER::destroy;	4003	$self->SUPER::destroy;
3367	}	4004	}
3368		4005
3369	#############################################################################	4006	#############################################################################
3370		4007
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;	4008	package CFPlus::UI::Root;
3744		4009
3745	our @ISA = CFClient::UI::Container::;	4010	our @ISA = CFPlus::UI::Container::;
3746		4011
3747	use List::Util qw(min max);	4012	use List::Util qw(min max);
3748		4013
3749	use CFClient::OpenGL;	4014	use CFPlus::OpenGL;
3750		4015
3751	sub new {	4016	sub new {
3752	my $class = shift;	4017	my $class = shift;
3753		4018
3754	my $self = $class->SUPER::new (	4019	my $self = $class->SUPER::new (
3755	visible => 1,	4020	visible => 1,
3756	@_,	4021	@_,
3757	);	4022	);
3758		4023
3759	Scalar::Util::weaken ($self->{root} = $self);	4024	CFPlus::weaken ($self->{root} = $self);
3760		4025
3761	$self	4026	$self
3762	}	4027	}
3763		4028
3764	sub size_request {	4029	sub size_request {
…		…
3930	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};	4195	my ($w, $h) = @$widget{qw(alloc_w alloc_h)};
3931		4196
3932	$w = 0 if $w < 0;	4197	$w = 0 if $w < 0;
3933	$h = 0 if $h < 0;	4198	$h = 0 if $h < 0;
3934		4199
		4200	$w = max $widget->{min_w}, $w;
		4201	$h = max $widget->{min_h}, $h;
		4202
		4203	# $w = min $self->{w} - $widget->{x}, $w if $self->{w};
		4204	# $h = min $self->{h} - $widget->{y}, $h if $self->{h};
		4205
		4206	$w = min $widget->{max_w}, $w if exists $widget->{max_w};
		4207	$h = min $widget->{max_h}, $h if exists $widget->{max_h};
		4208
3935	$w = int $w + 0.5;	4209	$w = int $w + 0.5;
3936	$h = int $h + 0.5;	4210	$h = int $h + 0.5;
3937		4211
3938	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {	4212	if ($widget->{w} != $w || $widget->{h} != $h || delete $widget->{force_size_alloc}) {
3939	$widget->{old_w} = $widget->{w};	4213	$widget->{old_w} = $widget->{w};
…		…
3962	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;	4236	glOrtho 0, $::WIDTH, $::HEIGHT, 0, -10000, 10000;
3963	glMatrixMode GL_MODELVIEW;	4237	glMatrixMode GL_MODELVIEW;
3964	glLoadIdentity;	4238	glLoadIdentity;
3965		4239
3966	{	4240	{
3967	package CFClient::UI::Base;	4241	package CFPlus::UI::Base;
3968		4242
3969	($draw_x, $draw_y, $draw_w, $draw_h) =	4243	local ($draw_x, $draw_y, $draw_w, $draw_h) =
3970	(0, 0, $self->{w}, $self->{h});	4244	(0, 0, $self->{w}, $self->{h});
3971	}
3972		4245
3973	$self->_draw;	4246	$self->_draw;
		4247	}
3974	}	4248	}
3975		4249
3976	#############################################################################	4250	#############################################################################
3977		4251
3978	package CFClient::UI;	4252	package CFPlus::UI;
3979		4253
3980	$ROOT = new CFClient::UI::Root;	4254	$ROOT = new CFPlus::UI::Root;
3981	$TOOLTIP = new CFClient::UI::Tooltip z => 900;	4255	$TOOLTIP = new CFPlus::UI::Tooltip z => 900;
3982		4256
3983	1	4257	1
3984		4258

Diff Legend

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