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

Diff Legend

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